.TITLE	IBMFLT	;CONVERT FLOATING TO IBM FLOATING
			;POINT 32 BIT NUMBER
;
;CALL:
;	R=IBMFLT(X)
;		WHERE X IS PDP11/VAX SINGLE PRECISION
;			FLOATING POINT NUMBER
;RESULT IS IBM HEX-NORMALIZED FLOATING POINT NUMBER.
;	REGISTERS CLOBBERED ON RETURN
;	RESULT RETURNS IN R0,R1
;	R0=(EXP, H.O. MANTISSA)
;	R1=(L.O. MANTISSA)
; NOTE THIS IS NOT DIRECTLY COMPATIBLE WITH F4P CALL CONVENTION
; WHICH USES AC0 FOR RETURN.
; IF XF4P.. IS NOT DEFINED, RESULT ALSO RETURNS IN AC0 HOWEVER.
AC0=%0
IBMFLT::
	.IIF NDF,XF4P.., CLRF AC0
	.IIF NDF,XF4P.., SETF
;
	MOV	2(R5),R1	;ADDR OF DATA
	MOV	(R1)+,R0	;DEC EXP AND H.O. MANTISSA
	MOV	(R1),R1		;L.O. DEC MANTISSA
	MOV	R0,R2		;TEST FOR EXACT 0
	BIS	R1,R2		;BY ORING THE 2 WORDS
	BEQ	99$
	MOV	R0,R4		;COPY THE EXPONENT PART
	ASH	#-7,R4		;MAKE IT LOW PART OF WORD
	SUB	#200,R4		;CORRECT FOR EXCESS-200
	BIC	#^C377,R4	;ZAP OFF ANY SIGN EXTENSIONS
;NOW SHIFT THE MANTISSA RIGHT BY COUNT=(LO 2 BITS OF EXP)
	MOV	R0,R2		;GET H.O. PART
	MOV	R1,R3		;AND L.O. PART
	BIC	#^C177,R2	;MASK MANTISSA
	BIS	#200,R2		;AND ADD IN HIDDEN HIGH BIT
	MOV	R4,-(SP)	;KEEP A SHIFT COUNT ON STACK
	BIC	#^C3,(SP)	;NOW HAVE THE COUNT
	BEQ	1$		;IF 0 ALL'S WELL
	NEG	@SP		;ELSE SUBT FROM 4
	ADD	#4,@SP		;TO GET DIFF
	ADD	#4,R4		;AND ALSO ADJUST EXPONENT	
1$:	TST	@SP		;ANY MORE SHIFTS TO DO?
	BLE	2$		;IF NOT, DONE NOW
	ASR	R2		;IF SO SHIFT MANTISSA DOWN
	ROR	R3		;BY 1 PLACE AND TRY AGAIN
	DEC	@SP
	BGT	1$		;GO BACK IF ANY MORE SHIFTS NEEDED
2$:	TST	(SP)+		;FIX UP STACK
	ASH	#-2,R4		;MAKE THE EXPONENT A HEX EXPONENT
	ADD	#100,R4		;MAKE IT EXCESS 64 NEXT
	BIC	#^C100000,R0	;REMOVE ALL BUT SIGN BIT
	ASH	#8.,R4		;SHIFT EXPONENT INTO POSITION
	BIS	R4,R0		;NOW OR IN THE EXPONENT
	BIS	R2,R0		;AND H.O. MANTISSA
	MOV	R3,R1		;ALSO FILL IN L.O. MANTISSA
;VIOLA! IBM FLOATING NUMBER IS NOW IN R0,R1!
	.IF	NDF,XF4P..
	MOV	R1,-(SP)
	MOV	R0,-(SP)	;PUT THE NUMBER IN MEMORY, H.O. FIRST
	LDF	(SP)+,AC0	;AND PUT IT INTO FPU NEXT.
	.ENDC
99$:	RTS	PC
	.END