.NLIST	TOC,SYM
.TITLE	$FMUL
.SBTTL	ULBLIB 043	- FLOATING MULTIPLY
.IDENT	\V01.00\
.PSECT	.LIBC.
.ENABL	LC,GBL

; Copyright (c) 1998 by Mentec, Inc., Nashua, NH.
; All rights reserved
;
; This software is furnished under a license for use only on a
; single computer system and  may  be  copied  only  with  the
; inclusion of the above copyright notice.  This software,  or
; any other copies thereof, may not be provided  or  otherwise
; made available to any other person except for  use  on  such
; system and to one who agrees to these license  terms.  Title
; to  and  ownership of the software shall at all times remain
; in Mentec, Inc.
;
; The information in this document is subject to change without
; notice and should not be construed as a commitment by Digital
; Equipment Corporation, or Mentec, Inc.
;
; Digital and Mentec  assume  no  responsibility for the use or
; reliability of its software on equipment which is not supplied
; by Digital  or Mentec,  and listed  in the  Software  Product
; Description.
;+
; $FMUL
; This routine multiplies two floating point numbers, generating a floating
; result.  It yield approximately 24 bits of significance.
;
;	R0	= hi-order multiplicand
;	R1	= lo-order multiplicand
;	R2	= hi-order multiplier
;	R3	= lo-order multiplier
;
;	CALL	$FMUL
;
;	C-bit	= 0 => no error
;	R2	= hi-order result
;	R3	= lo-order result
;
;	C-bit	= 1 => error, overflow or underflow
;	R2	= 0
;	R3	= 0
;-

$FMUL::
	MOV	R3,-(SP)	;Save lo-order multiplier
	BNE	1$		;Branch if low order not 0
	MOV	R1,R3		;If low order 0 switch addin and
	MOV	R0,R1		;Multiplier because routine
	MOV	R2,R0		;Works faster if less trailing 1 bits
	MOV	R1,R2		;In multiplier.
	MOV	@SP,R1
1$:	MOV	R4,@SP		;Save some work regs
	MOV	R5,-(SP)
	ASL	R1		;Scale 1 left
	ROL	R0		;Leaves sign in C-bit
	ROL	R5		;Save sign in low order bit of R5
	MOV	R0,R4		;Copy exp:high byte
	BEQ	3$		;*0., result is 0.
	ASL	R2		;Get sign out of 2
	BEQ	3$		;*0., result is 0.
	ADC	R5		;XORs sign bits to give final sign
	CLRB	R4		;Leave left justified exponent
	ADD	R2,R4		;GIVES FINAL EXP+200
	BCC	2$		;Branch if either undflow or result<1.
	BPL	6$		;Branch if 1.<result<max
	BR	4$		;Set result to zero

2$:	BMI	5$		;Branch if 0.<result<1.
	BR	4$		;Floating multiply underflow

3$:	TST	(PC)+		;Clear C-bit
4$:	SEC			;Set C-bit
	BIC	R2,R2		;Set result to 0.  Don't bother C-bit
	BIC	R3,R2
	BR	13$		;Branch into exit code

5$:	BIT	#77400,R4	;Most negative exp?
	BEQ	4$		;Brranch if yes. thats underflow.
6$:	CLRB	R4		;Remove R2's high byte from result exp
	ADD	#77401,R4	;Setup for C-bit; sub 201 from exp, we
				;Later add the 1 in as implied norm bit
	ROR	R5		;Get result sign
	ROR	R4		;Put back in with exp, set C-bit
	MOV	R4,-(SP)	;Save for later
	RORB	R2		;Put in implied norm bit, C-bit was set!
	SWAB	R3		;Left justify 2 into R2:R3
	SWAB	R2
	CLRB	R2		;Clear 2's exp
	BISB	R3,R2
	CLRB	R3		;Leaves r2:r3 left justified
	ROR	R2		;Leave guard digit, 1 is enough
	ROR	R3		;Because 2^n>2^(n-1)-1+(2^(n-2)-1)+...
	SWAB	R1		;Left justify shifter
	SWAB	R0		;It makes loop faster
	CLRB	R0
	BISB	R1,R0
	CLRB	R1
	MOV	R2,R4		;R2:R3 will be sum, R4:R5 will be addin
	MOV	R3,R5
7$:	ASR	R4		;Shift addin right
	ROR	R5
	ASL	R1		;Shift multiplier left
	BEQ	9$		;See if were done
	ROL	R0		;Shift out 1 bit
	BCC	7$		;Don't add, bit was 0
8$:	ADD	R5,R3		;Form sum
	ADC	R2
	ADD	R4,R2
	BR	7$		;Go until multiplier 0

9$:	ROL	R0		;Shift last bit of R1 in
	BCC	11$		;Don't add if no bit
10$:	ADD	R5,R3		;Form sum
	ADC	R2
	ADD	R4,R2
11$:	ASR	R4		;Shift addin right
	ROR	R5
	ASL	R0		;Comes here if low word 0 to finish up
	BCS	10$		;Bit was 1 so add
	BNE	11$		;Bits still left so continue
	MOV	(SP)+,R4	;Save exponent.
	TST	R2		;Not needed if round by .3 or .6 ok
	BMI	12$		;Branch if result is norm'ed ok
	ROL	R3		;Norm it left 1 bit
	ROL	R2
	BIT	#77600,R4	;Is underflow going to occur?
	BEQ	4$		;Yes. Report it.
	SUB	#200,R4		;Sub 1 from exp because left shift
12$:	ROLB	R3		;Get bit to round by in carry
	ROL	R1		;Put in R1 which had to be 0
	CLRB	R3		;Get rid of extra precision
	BISB	R2,R3		;Get result back into right 3 bytes
	SWAB	R3
	CLRB	R2
	SWAB	R2
	ADD	R4,R2		;Put sign and exp into result
	ADD	R1,R3		;Round low order
	ADC	R2		;Round high order
	CLC			;Indicate no error
13$:	MOV	(SP)+,R5	;Restore regs
	MOV	(SP)+,R4
	RETURN

.END