; CFFMUL			FAR CALL MODIFICATIONS 1200  2-MAR-81
; CFMUL				VERSION 1.4 1000 10-OCT-79
; RCC86 FLOATING MULTIPLY
CF@CODE	SEGMENT	BYTE PUBLIC
	ASSUME	CS:CF@CODE
	PUBLIC	CF@MUL
CF@MUL	PROC	FAR			;FLOATING MULTIPLY
	PUSH	BP			;SET UP LOCAL FRAME
	MOV	BP,SP
	CMP	DX,0			;CHECK FOR MULTIPLY BY ZERO
	JNE	TEST1ST
	CMP	AX,0			;BOTH HALVES
	JNE	TEST1ST
ANSW	LABEL	NEAR
	POP	BP
	RET	4
;
TEST1ST	LABEL	NEAR			;TEST OTHER OPERAND
	XCHG	DX,[BP+6]
	XCHG	AX,[BP+4]
	CMP	DX,0
	JNE	NOTZERO
	CMP	AX,0
	JE	ANSW
NOTZERO	LABEL	NEAR
	MOV	BX,DX			;COPY TO EXTRACT SIGN
	XOR	BX,[BP+6]		;FORM RESULT SIGN
	AND	BX,80H			;SELECT DESIRED BIT
	PUSH	BX			;SAVE FOR LATER
	MOV	BL,DH			;COPY TO EXTRACT EXPONENT
;					;BH STILL ZERO
	SUB	BX,129			;REMOVE EXCESS 128 AND OFFSET FOR
;					;SHIFT INHERENT IN MULTIPLY
	MOV	CL,[BP+7]		;OTHER EXPONENT
	MOV	CH,0			;WIDEN
	ADD	BX,CX			;RESULT EXPONENT
	PUSH	BX			;SAVE IT
;
	MOV	DH,0			;CLEAR EXPONENT FIELD
	OR	DL,80H			;SET 2**-1
	MOV	CX,0			;CLEAR RESULT
	MOV	BX,CX			;DOUBLE LENGTH
	XCHG	BX,[BP+6]		;GET SECOND OPERAND AND 
	XCHG	CX,[BP+4]		;PUT RESULT IN STACK
	MOV	BH,0			;CLEAR EXPONENT FIELD
	OR	BL,80H			;SET 2**-1
	JMP	STARTL			;NO NEED TO SHIFT ZERO

PLOOP	LABEL	NEAR
	SHR	WORD PTR [BP+6],1	;SCALE RESULT SO FAR
	RCR	WORD PTR [BP+4],1
STARTL	LABEL	NEAR
	SHR	DX,1			;SCALE ADDEND
	RCR	AX,1
	JNB	NOADD
	ADD	[BP+4],CX
	ADC	[BP+6],BX
NOADD	LABEL	NEAR
	CMP	AX,0			;FINISH WHEN AX=DX=0
	JNE	PLOOP
	CMP	DX,0
	JNE	PLOOP
	POP	BX			;RESULT EXPONENT
	POP	CX			;RESULT SIGN
	MOV	AX,[BP+4]
	MOV	DX,[BP+6]
NORM	LABEL	NEAR
	CMP	DX,256			;IS RIGHT SHIFT NEEDED?
	JGE	RIGHT			; JUMP IF SO
	CMP	DX,128
	JGE	NORMEND			;NORMALISED WHEN 2**-1 =1
	DEC	BX			;ADJUST EXPONENT
	SHL	AX,1
	RCL	DX,1
	JMP	NORM
;
RIGHT	LABEL	NEAR
	SHR	DX,1			;DOUBLE RIGHT SHIFT
	RCR	AX,1
	INC	BX			;COMPENSATE EXPONENT
	JMP	NORM			;TRY AGAIN
;
NORMEND	LABEL	NEAR
	CMP	BX,0			;CHECK FOR UNDERFLOW
	JGE	SIGNEXP
	MOV	AX,0
	MOV	DX,AX
	JMP	ANSW
SIGNEXP	LABEL	NEAR
	MOV	DH,BL			;INSERT EXPONENT
	CMP	BH,0			;CHECK FOR OVERFLOW
	JE	SIGN			;OK
	MOV	AX,0FFFFH		;MAXIMUM VALUE ON OVERFLOW
	MOV	DX,AX
SIGN	LABEL	NEAR
	AND	DL,7FH			;CLEAN 2**-1
	OR	DL,CL			;USE FOR SIGN
	JMP	ANSW
;
CF@MUL	ENDP
CF@CODE	ENDS
	END