FLOATFROMREAL MACRO

;;
;;	LAST UPDATE: DECEMBER 20, 1979
;;


;;
;;	FLOATING POINT CONVERSION, INTERNAL TO ASCII
;;


;;

FLTOUT:	XCHG		;;HL POINTS TO X
	LXI D,LOCLX
	CALL COPY4	;;COPY X TO LOCAL STORAGE
	PUSH B		;;SAVE C
	CALL TEQ0	;;MANT=0
	JNZ FLO05	;;NO
;;
;;	MANT=0. PRINT 0.0 & SKIP C+3 SPACES
;;
	MVI C,'0'
	CALL OUTCHR
	MVI C,'.'
	CALL OUTCHR
	MVI C,'0'
	CALL OUTCHR
	POP B		;;RETRIEVE # OF CHARS IN MANT
	MOV A,C
	ADI 3
	MOV B,A		;;# OF SPACES
;;
;;	OUTPUT 'B' SPACES
;;	ALTERS A,B, & C
SPACES:	MVI C,' '
	CALL OUTCHR
	DCR B
	JNZ SPACES
	RET
;;
FLO05:	MVI A,'+'	;;CLEAR SEXP
	STA SEXP
;;
;;	OUTPUT SIGN THEN SET X=ABS(X)
;;
	CALL OUTSGN
	MVI C,'.'	;;OUTPUT DP
	CALL OUTCHR
;;
;;	IF X=0, SET PWR = 0. THERWISE SET PWR=18
;;
	LXI H,PWR
	MVI M,0
	CALL TEQ0	;;TEST M(DE)=0
	JZ FLO70	;;X=0
;;
	MVI M,18	;;X.NE.0 SET PWR=18
;;
;;	TEST FOR NEG. EXP.
;;
	LXI H,PWR10	;;HL POINTS TO 1.0
	CALL FOCOMP
	JM FLO40
;;
;;	POSITIVE EXPONENT
;;
;;	BEGIN LOOP TO SEARCH TABLE OF POWERS OF 10
;;
FLO10:	LXI H,PWR10
	LDA PWR
	CALL TINDEX	;;HL = ADR(PWR10(PWR))
	PUSH H
	CALL FOCOMP
	POP H
	JP FLO20
	LXI H,PWR	;;DEC. PWR
	DCR M
	JMP FLO10
;;
;;	NOW 10**PWR.LE.X.LT.10**(PWR+1)
;;	OR .1.LE.X/10**(PWR+1) TO MAKE .1.LE.X.LT.1.
;;	BECAUSE OF TRUNCATION ERRORS.
;;	10**P / 10**(P+1) < .1
;;	IF X = 10**PWR, SET X = .1 TO CORRECT FOR THIS
;;
FLO20:	ORA B  		
	JNZ FLO25	;;NOT =
	LXI H,TENTH	;;SET M(DE) = 1
	CALL COPY4
	JMP FLO30	;;NO NEED TO DIVIDE
;;
FLO25:	INX H		;;SET H = ADR(10**(PWR+1))
	INX H
	INX H
	INX H
	CALL DIVIDE	;;X = X/10**(PWR+1)
;;
;;	NOW .1.LE.X.LT.1.
;;
FLO30:	LXI H,PWR	;;INC. POWER
	INR M
	JMP FLO60
;;
;;	NEGATIVE EXP
;;	10**(-19).LT.X.LT.1.
;;
;;	BEGIN LOOP TO SEARCH TABLE
;;
FLO40:	PUSH D
	XCHG		;;HL=ADR(X)
	LXI D,PROD
	CALL COPY4	;;PROD = X
	LXI H,PWR10
	LDA PWR
	CALL TINDEX	;;HL = ADR(PWR10(PWR))
	PUSH D
	XCHG
	FINPUSH4
	XCHG
	FINPUSH4
	CALL SWRMUL
	FINSTORE

	LXI H,PWR10	;;HL = ADR(1.0)
	CALL FOCOMP
	JM FLO50	;;PROD < 1. EXIT LOOP
	LXI H,PWR	;;DEC PWR
	DCR M
	POP D
	JMP FLO40
;;
FLO50:	POP D		;;D=ADR(X)
	LXI H,PROD
	CALL COPY4	;;X = X* 10**PWR
;;
;;	NOW .1.LE.X.LT.1 & PWR = POWER OF 10
;;	IF PWR .NE. 0, SET SEXP = '-'
;;
	LDA PWR
	ORA A
	JZ FLO60	;;PWR=0
	MVI A,'-'
	STA SEXP
;;
;;	COMMON CODE FOR POS. & NEG. EXPONENTS
;;	IN EITHER CASE .1.LE.X.LT.1.
;;	ROUND UP BY ADDING 5 TO THE N+1ST DIGIT
;;	POSITION.
;;
FLO60:	POP B		;;RETRIEVE C = # OF DIGITS
	PUSH B
	PUSH D
	LXI D,PROD
	LXI H,HALF
	CALL COPY4	;;PROD = .5
	MOV A,C
	LXI H,PWR10
	CALL TINDEX	;;HL = ADR(PROD)
	CALL DIVIDE
	XCHG
	POP D		;;DE = ADR(X)
	PUSH D
	XCHG
	FINPUSH4
	XCHG
	FINPUSH4
	CALL SWRADD
	FINSTORE
;;
;;	ROUND UP MAY CAUSE X>1
;;	E.G. 997 + .005 = 1.002
;;	IF SO, ADJUST EXP
;;
	LXI H,PWR10
	CALL FOCOMP
	JM FLO70

	LXI H,TENTH	;;X.GE.1. SET X = .1
	CALL COPY4
	LXI H,PWR	;;INC. OR DEC PWR
	INR M		;;ASSUME + EXP
	LDA SEXP
	CPI '-'
	JNZ FLO70	;;EXP IS +
	DCR M		;;- EXP. DEC.
	DCR M
;;
;;	BINARY EXP IS BETWEEN -3 & 0.  SHIFT MANTISSA
;;	LEFT INTO THE EXP BYTE 0-3 TIMES SO THAT
;;	THE MANTISSA CAN BE TREATED AS A FIXED
;;	POINT NUMBER WHOSE BINARY POINT IS BETWEEN
;;	BITS 2 & 3 OF THE MS BYTE
;;
FLO70:	LDAX D		;;A=BIN. EXP.
	ADI 3		;;SHIFT COUNT = EXP+3
	ANI 7FH		;;MASK OUT SIGN
	MOV C,A
	XRA A		;;SET MSBYTE=0
	STAX D
	CALL LSHQ	;;LEFT SHIFT EXP+3 TIMES
;;
;;	CONVERT MANTISSA TO DECIMAL STARTING WITH
;;	MSD.  WHEN MANT. IS MULTIPLIED BY 10, THE
;;	INTEGER PORTION WILL OVERFLOW INTO BITS 7-4
;;	OF THE MS BYTE
;;
FLO80:	XCHG
	LXI D,PROD
	CALL COPY4
	PUSH B
	MVI B,9
FLO80A:
	CALL ADD4
	DCR B
	JNZ FLO80A
	POP B
	XCHG

	LDAX D		;;A = MSBYTE
	RRC		;;RIGHT JUSTIFY
	RRC
	RRC
	ANI 0FH
	ADI '0'		;;CONV. TO ASCII
	MOV C,A
	CALL OUTCHR	;;OUTPUT DIGIT
	LDAX D		;;MASK OUT INTG. PART
	ANI 7
	STAX D
	POP B		;;C = # OF DIGITS IN MANT.
	DCR C
	PUSH B
	JNZ FLO80
;;
	POP B		;;RESTORE STACK
	MVI C,'E'
	CALL OUTCHR	;;OUTPUT SIGN OF EXP
	LDA SEXP
	MOV C,A
	CALL OUTCHR	;;OUTPUT SIGN OF EXPONENT
	LDA PWR
	MVI B,0
;;
;;	BEGIN LOOP TO DIVIDE BY 10
;;
FLO90:	SUI 10
	JC FO100	;;OVFL. EXIT LOOP
	INR B
	JMP FLO90
;;
FO100:	ADI 10		;;RESTORE
	PUSH PSW	;;SAVE REMAINDER
	MOV A,B
	ADI '0'		;;CONVERT TO ASCII
	MOV C,A
	CALL OUTCHR	;;PRINT MSD OF EXP
	POP PSW
	ADI '0'		;;CONVERT TO ASCII
	MOV C,A
	JMP OUTCHR	;;PRINT LSD OF EXP & RET

FOCOMP:
	PUSH D
	XCHG
	FINPUSH4
	XCHG
	FINPUSH4
	CALL SWRSUB
	POP B
	MOV A,C
	POP H
	ORA A
	POP D
	RET

DIVIDE:
	PUSH D
	XCHG
	FINPUSH4
	XCHG
	FINPUSH4
	CALL SWRDIV
	FINSTORE
	RET

	ENDM