.TITLE	FLTIBM	;MAKE DEC FLOATING POINT FROM IBM
			;FLOATING POINT (SINGLE PRECISION)
			;NUMBERS.
	.IDENT	/GCE001/	;G.C. EVERHART
AC0=%0
AC1=%1
AC2=%2
AC3=%3	;DEFINE FPP REGISTERS
	.GLOBL	FLTIBM
;
;	THIS PROGRAM WILL RETURN THE FORTRAN CALLER THE
;	PDP11 EQUIVALENT OF THE CALLED ARGUMENT.
;
;	X = FLTIBM(IBM F.P. NO)
;		DOES THE RETURN.
;	RESULT RETURNS IN AC0. FPP REGS OTHER THAN AC0 UNDISTURBED.
;	ALL CPU REGS REMAIN UNCHANGED
;
FLTIBM::
	MOV	R0,-(SP)	;PRESERVE REGISTERS ACROSS CALL
	MOV	R1,-(SP)
	MOV	R2,-(SP)
	MOV	R3,-(SP)
	MOV	R4,-(SP)
;LEAVE R5 ALONE SO WE CAN ACCESS ARGUMENT
	MOV	2(R5),R0	;ADDRESS OF IBM NUMBER
	MOV	(R0)+,R4	;HIGH WORD OF IBM NUMBER
	MOV	(R0),R3		;LOW WORD OF IBM NUMBER
	MOV	R3,R0
	BIS	R4,R0		;TEST FOR EXACT 0
	BEQ	EXIT		;IF ALL BITS OFF, WE HAVE A ZERO
	MOV	R4,R0		;GET EXPONENT NOW
	BIC	#100377,R0	;LEAVE 7 BITS
	ASH	#-8.,R0		;MAKE A 7 BIT EXCESS-64 NUMBER
	SUB	#101,R0		;SUBTRACT OFFSET
	ADD	#3,R0		;BIN. EXPONENT IS 3 MORE THAN HEX
	ADD	#201,R0		;MAKE EXCESS-200 AS IN PDP11. COMPENSATE
				; FOR BINARY POINT.
	BIC	#177400,R0	;MAKE AN 8 BIT EXPONENT. TRUNCATE IF TOO BIG
	MOV	R4,R1		;COPY FOR HIGH MANTISSA NOW
	ASH	#7,R0		;SHIFT UP PDP11 EXPONENT
	BIC	#77600,R4	;ZOT OUT IBM EXPONENT (AND HI MANTISSA BIT)
	BIS	R0,R4		;PUT PDP11 EXPONENT IN.
	MOV	#4.,R2		;MAX SHIFT COUNT TO ALLOW (+1 FOR SAFETY)
;NOW MUST CORRECT FOR IBM NORMALIZATION.
1$:	BIT	#200,R1		;IS MANTISSA HIGH BIT NOW SET? (WHEN SO,
				; NORMALIZATION IS OK AND EXPONENT IS RIGHT)
	BNE	2$		;WHEN DONE SHIFTS, GO SLAP IN THE MANTISSA
;NOT NORMALIZED RIGHT FOR PDP11. BUMP EXPONENT. (ADD 200 TO R4; LOW 3 BITS OF
;			EXPONENT ARE INITIALLY FORCED TO BE 0)
	SUB	#200,R4		;BUMP PDP11 EXPONENT DOWN
	ASL	R3		;SHIFT UP LOW MANTISSA, HI BIT TO CARRY
	ROL	R1		;THEN SHIFT UP MANTISSA
	DEC	R2
	BGT	1$		;KEEP IT UP IF NOT DONE
;DECLARE NUMBER TO BE 0 IF NORMALIZED WRONG.
	CLR	R1
	CLR	R4
	CLR	R3		;SET UP PDP11 ZERO
2$:	BIC	#177600,R1
	BIC	#177,R4		;CLEAR OUT BITS
	BIS	R1,R4		;SET UP HI MANTISSA RIGHT
;NOW ALL SET
EXIT:
	MOV	R4,10(SP)	;FUNCT. RETURN HIGH WORD
	MOV	R3,6(SP)	;AND LOW WORD IN RETURN R0,R1
	MOV	(SP)+,R4
	MOV	(SP)+,R3
	MOV	(SP)+,R2
	MOV	(SP)+,R1
	MOV	(SP)+,R0
	RTS	PC		;RETURN
	.END