; CFFCFW			FAR CALL MODIFICATIONS 1200  2-MAR-81
; CFCFW				VERSION 2.0 1745 15-OCT-79
; RCC86 FLOATING TO WORD/BYTE
CF@CODE	SEGMENT	BYTE PUBLIC
	ASSUME 	CS:CF@CODE
	PUBLIC	CF@CFW
CF@CFW	PROC	FAR		;FLOATING TO WORD
	CMP	DX,0		;CHECK FOR ZERO INPUT
	JNE	NONZERO
	CMP	AX,0		;BOTH HALVES ZERO FOR 0.0
	JNE	NONZERO
;				;INTEGER ZERO OUTPUT IN AX
	RET
NONZERO	LABEL	NEAR
	CMP	DH,143		;LOOK FOR EXCESSIVE EXPONENT
	JNA	NOFLO
OFLO	LABEL	NEAR		;OVERFLOW MAXIMUM ANSWER
	MOV	AX,7FFFH	;MAX VALUE IF OVERFLOW
TSTSIGN	LABEL	NEAR
	CMP	DL,0		;NEGATE IF REQUIRED
	JGE	DONE
	NEG	AX
DONE	LABEL	NEAR
	RET			;EXIT
NOFLO	LABEL	NEAR
	CMP	DH,127		;LOOK FOR INSIGNIFICANT INPUT
	JA	NUFLO		;UNSIGNED COMPARE
	MOV	AX,0		;RESULT ZERO
	RET
NUFLO	LABEL	NEAR
	MOV	BX,DX
	MOV	CL,152		;COMPUTE ALIGNMENT
	SUB	CL,DH
	MOV	BH,0		;CLEAR EXPONENT BITS
	OR	BL,80H		;SET 2**-1
	CMP	CL,16		;MORE THAN ONE WORD SHIFT?
	JL	SMALLSH		; NO
	MOV	AX,BX	
	MOV	BL,BH		;CLEAR BX
	SUB	CL,16
SMALLSH LABEL	NEAR
	SHR	AX,CL		;DOUBLE LENGTH SHIFT
	PUSHF			;SAVE CARRY FLAG=LAST LOST BIT
	NEG	CL
	ADD	CL,16
	SHL	BX,CL
	OR	AX,BX
	POPF			;RESTORE LAST LOST BIT TO CARRY
	ADC	AX,0
	JO	OFLO
	JMP	TSTSIGN
CF@CFW	ENDP
CF@CODE	ENDS
	END