;FPBCD 11/19/80
;XYBASIC Interpreter Source Module
;Copyright (C) 1980 by Mark Williams Company, Chicago
;BCD floating point package


	if	float and fpbcd
;
;   FORMAT:  6 BYTES
;      BYTE 0
;           BITS 0-6:  EXCESS-64 EXPONENT
;           BIT  7:  SIGN
;      BYTES 1-5:  10-DIGIT BCD FRACTION
;   N = (-1)^S * 10^(E - 64) * 0.DDDDDDDDDD
;
BIAS	EQU	64		;EXPONENT BIAS

;
;  CONSTANT DATA (ROMABLE)
;
EMAX 	DB 	043H,014H,073H,0,0,0 ;MAX. EXP. ARGUMENT
FPMAX 	DB 	07FH,099H,099H,099H,099H,099H
INTMX 	DB 	045H,032H,076H,070H,0,0
INTMN 	DB 	0C5H,032H,076H,080H,0,0
;
; CONSTANTS FOR USE IN FUNCTIONS
ATAN1	DB 	040H		;ARCTAN(1)
	DB	078H,053H,098H,016H,033H
D12PI	DB	040H		;1/(2PI)
	DB 	015H,091H,054H,094H,031H
D1LE4	DB	040H		;1/(LOG E 4)
	DB	057H,056H,046H,027H,031H
D1L10	DB	040H		;1/LN(10)
	DB	043H,042H,094H,048H,019H
D4PI	DB	041H		;4/PI
	DB	012H,073H,023H,095H,045H
DPI2	DB	041H		;PI/2
	DB	015H,070H,079H,063H,027H
DPI4	DB	040H		;PI/4
	DB	078H,053H,098H,016H,034H
DSR22	DB	040H		;SQR(2)/2
	DB	070H,071H,6,078H,010H
HALF	DB	040H,050H,0,0,0,0
LN10	DB	041H		;LN(10)
	DB	023H,2,058H,050H,093H
LN2	DB	040H		;LN(2)
	DB	069H,031H,047H,018H,6 
PI  	DB	041H,031H,041H,059H,026H,054H
SR2M1	DB	040H		;SQR(2) - 1
	DB	041H,042H,013H,056H,020H
SR2P1  DB	041H		;SQR(2) + 1
	DB	024H,014H,021H,035H,062H
SQR10	DB	041H		;SQR(10)
	DB	031H,062H,027H,076H,060H
THIRD	DB	040H,033H,033H	;1/3
	DB	033H,033H,033H
TWO	DB	041H,020H,0
	DB	0,0,0
TWOPI	DB	041H,062H,083H	;2 PI
	DB	018H,053H,7
;
;  COEFFICIENTS FOR FUNCTION EXPANSIONS
;
;  TANGENT
TB3	DB	0C2H,015H,078H
	DB	030H,032H,084H
	DB	0C4H,014H,9
	DB	063H,024H,018H
	DB	0C2H,040H,098H
	DB	017H,8,075H
	DB	0C3H,015H,069H
	DB	020H,4,022H
	DB	0C2H,055H,020H
	DB	040H,041H,071H
	DB	0C1H,094H,038H
	DB	016H,055H,098H
TC0	DB	03FH,035H,091H
	DB	010H,014H,097H
;  COSINE
FPONE	DB	041H,010H,0
	DB	0,0,0
	DB	0C0H,030H,084H
	DB	025H,013H,075H
	DB	03FH,015H,085H
	DB	043H,044H,020H
	DB	0BDH,032H,059H
	DB	091H,089H,0
	DB	03BH,035H,090H
	DB	086H,0,0
CP05	DB	0B9H,024H,061H
	DB	0,0,0
	DB	040H,078H,053H
	DB	098H,016H,034H
	DB	0BFH,080H,074H
	DB	055H,012H,019H
	DB	03EH,024H,090H
  	DB	039H,045H,070H
	DB	0BCH,036H,057H
	DB	062H,0,0
CP14	DB	03AH,031H,033H
	DB	0,0,0
;  ARCTAN
	DB	043H,021H,060H
	DB	062H,030H,079H
	DB	043H,032H,026H
	DB      062H,7,0
	DB	043H,013H,027H
	DB	2,039H,082H
FATP3	DB	042H,012H,088H
	DB	083H,083H,3
	DB	043H,021H,060H
	DB	062H,030H,079H
	DB	043H,039H,046H
	DB	082H,083H,093H
	DB	043H,022H,010H
	DB	050H,088H,030H
FATQ3	DB	042H,038H,050H
	DB	014H,086H,051H
;  EXP
EB2	DB	042H,090H,0      
	DB 	0,0,0
	DB	042H,028H,0
	DB	0,0,0
	DB	043H,033H,0
	DB	0,0,0
	DB	0C5H,014H,058H
	DB	0,0,0
;  NATURAL LOG
LB3	DB	0C1H,013H,012H
	DB	082H,059H,017H
	DB	0C1H,033H,050H
  	DB	025H,024H,081H
	DB	0C1H,025H,084H
	DB	017H,087H,055H
	DB	0C0H,012H,087H
	DB	020H,099H,053H
	DB	0C1H,051H,002H
	DB	099H,053H,028H
	DB	0C1H,059H,041H
	DB	022H,044H,090H
LC0	DB	040H,041H,079H
	DB	059H,018H,037H
;  SQUARE ROOT
	DB	040H,014H,053H
	DB	043H,0,051H
	DB	041H,018H,046H
	DB	072H,073H,095H
	DB	0C1H,018H,078H
	DB	050H,038H,016H
SR3	DB	040H,090H,010H
	DB	015H,056H,4
;  SQUARE ROOT (X >= .25)
	DB	040H,025H,092H
	DB	080H,058H,067H
	DB	041H,010H,052H
	DB	3,026H,060H
SR6	DB	0C0H,031H,063H
	DB	024H,089H,045H
;
;  BINARY-DECIMAL CONVERSION TABLE
BDTAB	DB	0,0,1
	DB	0,0,2
	DB	0,0,4
	DB	0,0,8
	DB	0,0,016H
	DB	0,0,032H
	DB	0,0,064H
	DB	0,1,028H
	DB	0,2,056H
	DB	0,5,012H
	DB	0,010H,024H
	DB	0,020H,048H
	DB	0,040H,096H
	DB	0,081H,092H
	DB	1,063H,084H
	DB	3,027H,068H

;
;  ADDITION  (FACC) <== (FACC) + (H,L)
FADT2	LXI	H,FTMP2
FADD	MOV 	A,M
	ORA	A
	RZ	         	;OP-2 = 0
	LXI  	D,FACC
	LDAX  	D
   	ORA	A
	JZ  	FLOAD		;OP-1 = 0
FADD0	XRA	M
	PUSH   	PSW		;(SF) ==> SUBTRACT
	LDAX 	D
	ANI	080H
	STA	SIGN		;STORE SIGN OF OP-1
	MVI	A,6
	STA   	FLEN		;DEFAULT LENGTH = 6
	MOV  	A,M
	ANI	07FH		;FORM EXP-2
	STA	EXP2
	CALL	UPAC2
	LXI  	H,EXP1
   	MOV  	M,A
	INX	H
	SUB 	M		;A <== EXP1 - EXP2
	MOV 	C,A
	LXI	H,FACC+5
	SHLD	RSLT		;SUM LOCATION
	CPI	-10
	JNC	FAD1		;-10 <= DIFF < 0
	CPI	11
	JC	FAD1		;0 <= DIFF <= 10
	ORA	A
	JP	FAD9		;DONE IF DIFF > 10
;    DIFF < -10
	CALL	FZACC	  	;FACC <== 0
	LDA 	EXP2
	STA	EXP1		;EXP1 <== EXP2
FAD1	MVI     B,0
	PUSH  	B
	XCHG			;(H,L) <== OP-2
	INX  	H		;POINT TO FRACTION
	MVI	C,5
	LXI	D,ACALT+6
	CALL  	FMOVE		;ACALT+6 <== OP-2 FRACTION
	MOV 	H,D		;(H,L) = (D,E) = OP-2
	MOV	L,E
	POP	B
	MOV	A,C
	ORA	A
	JZ 	FAD8		;DIFF = 0
	JM  	FAD4		;DIFF < 0
;     DIFF > 0
	ANI	1
	JZ 	FAD2		;EVEN
;        DIFF > 0 AND ODD
	INX	D
	PUSH	B
	LXI	B,6
	CALL	FD10		;DIV. OP-2 BY 10
	LHLD	RSLT		;DESTINATION
	INX	H		;INCR. IT
	POP	B
	JMP	FAD3
FAD2	LHLD	RSLT
FAD3	MOV	A,C
	RAR
	MOV	C,A		;HALF OF DIFF
	DAD	B		;ADD BYTE SHIFT TO DEST.
        SHLD    RSLT
	LXI	H,FLEN
	ADD	M
	MOV	M,A		;TOTAL FIELD LENGTH
	JMP	FAD8
;     DIFF < 0
FAD4	LXI	H,FACC+1
	ANI	1
	JZ	FAD5		;EVEN
;     ODD AND < 0
	PUSH	B
	LXI 	B,6
	CALL	FD10		;FACC <==  FACC/10
	POP	B
FAD5	XRA	A
	MOV	B,A		;B=0
  	SUB	C		;A = -DIFF
	RAR			;A = BYTE SHIFT
	ANI	07FH
	JZ	FAD7		;NO BYTE SHIFT
	MOV	C,A		;(B,C) <== -DIFF/2
	DAD	B
	DCX	H
	PUSH	D
	CALL	FSTOR		;SHIFT FACC RIGHT
	POP	D
FAD6	DCX	H
	MOV	M,B		;CLEAR START OF FIELD
	DCR	C
	JNZ	FAD6
FAD7	LDA	EXP2
	STA	EXP1		;EXP1 <== LARGER EXP
FAD8	XCHG			;(H,L) <== OP-2
	LXI	B,4
	DAD	B
	XCHG			;(D,E) <== LOW END OP-2
	LHLD	RSLT
	INR	C		;LOOP COUNTER = 6
	INR	C
	POP	PSW		;XOR OF SIGNS
	JM	FSUB1		;SUBTRACT
	CALL	FADDL		;ADD LOOP
	CALL 	FRNRM
	JMP	FRND		;ROUND
FAD9	POP	PSW
	JMP	FRND0
;  ADD LOOP
FADDL	XRA	A		;CLEAR CARRY
FADL1	LDAX	D
	ADC	M
	DAA
	MOV	M,A
	DCX	D
	DCX	H
	DCR	C
	JNZ	FADL1
	RNC			;DONE IF NO CARRY
FADL0   MOV	A,M		;CARRY 1
	ADI	1
	DAA
	MOV	M,A
	DCX	H
	JC	FADL0
	RET
;
;  ABSOLUTE VALUE
FABS	LXI	H,FACC
	MOV	A,M
	ANI	07FH
	MOV	M,A
	RET
;
;  ARCTAN
;  IF ABS(X) > 10 E 10 THEN FATAN(X) = SGN(X) * PI/2
;  IF ABS(X) <= 5 E -4 THEN FATAN(X) = X - X^3/3
;  ELSE  ABS(X) <= SQR(2) -1 :   X0=0, Y=X
;        ABS(X) > SQR(2) + 1 :   X0=INFINITY, Y = -1/X
;        SQR(2) - 1 < ABS(X) < SQR(2)+1:  X0=1, Y=(X-1)/(X+1)
;  FATAN(X) = FATAN(X0) + FATAN(Y) WHERE
;     FATAN(Y) = Y * P(Y^2)/Q(Y^2)
FATAN	LXI	H,FACC
	MOV	A,M
	ANI 	080H
	STA	SIGN1		;SAVE SIGN 
	MOV	A,M
	ANI	07FH
	MOV	M,A		;X <== ABS(X)
 	CPI	BIAS+11
	JNC	FAT97		;EXP > 10
	CPI	BIAS-4
	JC	FAT98		;EXP < -4
	JNZ     FAT0		;EXP > -4
	INX	H		;EXP = -4
	MOV	A,M
 	DCX	H
	CPI	6
	JC	FAT98		;Z <= 5 E (-4)
;     5 E (-4) < X < E 10
FAT0    LXI	H,SR2M1	;SQR(2) - 1
	CALL	FCMP
	JNC	FAT1		;X > SQR(2) -1
;     X <= SQR(2) -1
	LXI 	H,FTMP2
	MVI	C,6
	CALL 	FZERO		;X0 = 0 = ARCTAN(0)
	JMP	FAT4
FAT1    LXI     H,SR2P1
	CALL	FCMP
	JC	FAT2
;     X > SQR(2) + 1
        LXI	H,DPI2
        LXI	D,FTMP2
	CALL	FLOD1		;X0 = PI/2 = ARCTAN(INFINITY)
	CALL	FLINV		;FACC <== 1/X
	CALL	FCHS		;FACC <== -1/X
	JMP	FAT4
;     SQR(2) - 1 < X < SQR(2) + 1
FAT2	LXI	H,ATAN1
	LXI	D,FTMP2
	CALL	FLOD1		;X0 = ARCTAN(1)
	LXI	H,FPONE
	CALL	FADD		;FACC <== X+1
	CALL	FSTT1		;SAVE IN FTMP1
	LXI	H,TWO
	CALL	FSUB		;FACC <== X-1
	LXI	H,FTMP1
	CALL	FDIV		;FACC <== (X-1)/(X+1)
FAT4	CALL	FSTT3		;FTMP3 <== Y
	CALL	FCO35		;FTMP1 <== Y^2
;     RATIONAL FUNCTION
;        DENOMINATOR
	LXI     H,FATQ3 
	MVI 	C,3  
	CALL	FPLY0
	CALL	FSTT4		;STORE DENOM. IN FTMP4
;        NUMERATOR
	LXI	H,FTMP1
	CALL	FLOAD
	LXI	H,FATP3
	MVI	C,3
	CALL	FPOLY
	LXI	H,FTMP3
	CALL	FMUL		; *Y
	LXI	H,FTMP4
	CALL	FDIV		;P/Q
	CALL	FADT2		;+ARCTAN(X0)
FAT6	LXI	H,FACC
	LDA	SIGN1
	ORA	M		;APPEND SIGN
	MOV	M,A
	RET
;     IF X > 1 E 10 THEN FATAN(X) = SGN(X) * PI/2
FAT97	LXI	H,DPI2
	CALL	FLOAD
	JMP	FAT6
;     IF X < 5 E (-4) THEN FATAN(X) = X - X^3/3
FAT98	CALL	FSTT1		;STORE IN FTMP1
	CALL	FMUL		;SQUARE X
        LXI     H,FTMP1
	CALL	FMUL		;CUBE X
	LXI	H,THIRD
	CALL	FMUL
	LXI	H,FTMP1
	CALL	FSUB
	JMP	FAT6
;
;  FLOATING POINT A TO X POWER
FATOX	XCHG
	INX	H
	LDA	FACC
	ORA	A
	JZ	FATX1		;0 TO POWER
	JM	FATX2		;NEG TO POWER
	PUSH	H
FATX0	CALL	FLN
	POP	H
	CALL	FMUL
	JMP	FEXP		;A^X = EXP (X * LN (A))
;     0 TO POWER
FATX1	ORA	M
	JM	FOVER		;0 TO NEGATIVE
	RET
;     NEGATIVE TO POWER
FATX2	PUSH	H
	CALL	FSTT1		;SAVE A IN FTMP1
	POP	H
	PUSH	H
	CALL	FLOAD		;LOAD POWER
	CALL	FSTT2		;AND SAVE IN FTMP2
	CALL	FFIX		;GET INTEGER PART OF POWER
	POP	H
	PUSH	B		;AND SAVE INTEGER PART
	PUSH	H
	CALL	FCMP
	POP	H
	JNZ	FATX4		;NEGATIVE A TO NONINTEGER X
	CALL	FLONE		;LOAD 1 = A^0
	POP	D		;INTEGER POWER TO DE
	LDA	FTMP2
	ORA	A
	RZ			;DONE IF POWER IS 0
	CM	CPLDE		;COMPLEMENT POWER IF NEGATIVE
	MOV	A,D
	ORA	A
	JNZ	FOVER		;POWER TOO HIGH
FATX3	LXI	H,FTMP1
	PUSH 	D
	CALL	FMUL
	POP	D
	DCR	E
   	JNZ	FATX3
	LDA	FTMP2
	ORA	A
	RP			;POSITIVE POWER, DONE
;FACC <== 1/FACC
FLINV	CALL	FSTT1		;STORE FACC IN FTMP1
	CALL	FLONE		;LOAD 1
	LXI	H,FTMP1
	JMP	FDIV		;INVERT
FATX4	XTHL			;POP SAVED POWER, PUSH POWER ADDRESS
	CALL	FCERN		;NONFATAL FC ERROR
	LXI	H,FTMP1
	CALL	FLOAD		;RELOAD A
	CALL	FCHS		;AND FORCE POSITIVE
	JMP	FATX0		;RETURN -A ^ X AS RESULT
;
;  CHANGE SIGN
FCHS	LXI	H,FACC
	MOV	A,M
	XRI	080H
	MOV	M,A
	RET
;
;  COMPARE FACC WITH (H,L)
;     EXIT:  (CF) ==> FACC <= (H,L); (ZF) ==> EQUAL; ELSE >
FCMP	LXI	D,FACC
	LDAX	D
	ORA	A
	JP	FCM0		;FACC >= 0
	XRA	M
	STC
	RM			;SIGNS DIFFER
	XCHG			;BOTH NEGATIVE
	JMP	FCM1
FCM0	ORA	M
	RM			;(H,L) <0
FCM1	MVI	C,6
FCM2	LDAX	D
	SUB	M
	RC
	RNZ
	INX	H
	INX	D
	DCR	C
	JNZ	FCM2
	STC
	RET
;
;  COSINE
;  X <== ABS (X) SINCE COS(-X) = COS(X)
;  X > 10 E 10 NOT PERMITTED
;  IF X > 2 * PI THEN X <== X MOD 2*PI
;  IF X > PI THEN X <== 2*PI - X
;  IF X > PI/2 THEN X <== PI -X AND SIGN FLAG IS SET
;       (I.E., COS(X) = - COS (PI - X) )
;  IF X <= PI/4 THEN Y = 4X/PI, COS(X) = POLYNOMIAL(Y^2)
;  IF PI/4 < X <= PI/2 THEN X1 = PI/2 - X, Y = 4*X1/PI,
;     COS(X) = SIN(X1) = Y * POLYNOMIAL(Y^2)
FCOS	XRA	A
	STA	SIGN1		;SET POSITIVE
	CALL	FABS		;COS(X) = COS(-X)
	CPI	BIAS+11
	JNC	FCERN		;EXP >= 10 NOT VALID
 	LXI	H,TWOPI
	CALL	FCMP
	JC	FCO1		;X <= 2 PI
;     IF X > 2 PI  THEN X <== X (MOD 2 PI)
	CALL	FSTT1		;STORE IN FTMP1
	LXI	H,D12PI
	CALL	FMUL		;DIV BY 2 PI
	CALL	FINT		;INTEGER PART
	LXI	H,TWOPI
	CALL	FMUL
	LXI	H,FTMP1
	CALL	FSUB		;MINUS X
	CALL	FCHS
FCO1	LXI	H,PI
	CALL	FCMP
	JC 	FCO2
;     IF X > PI THEN X <== 2 PI - X
	CALL	FCHS
	LXI 	H,TWOPI
	CALL	FADD
FCO2	LXI	H,DPI2
	CALL	FCMP
	JC	FCO3
;     IF X > PI/2 THEN X <== PI - X AND SIGN = NEGATIVE
	CALL 	FCHS
	LXI	H,PI
	CALL	FADD
	LXI	H,SIGN1
	MOV	A,M
	XRI	080H
	MOV	M,A
FCO3	LXI	H,DPI4
	CALL	FCMP
	JC	FCO5		;X <= PI/4
;   PI/4 < X < PI/2
;     X0 = PI/2 - X; Y = (X0 * 4/PI)^2
	CALL	FCHS
	LXI	H,DPI2
	CALL	FADD		;PI/2 -X
	CALL	FCO34
	CALL	FCO35
;    EVAL. POLYNOMIAL
   	LXI	H,CP14
	MVI	C,4
	CALL	FPOLY
	LXI	H,FTMP2		;Y
	CALL	FMUL
FCO4	LXI	H,FACC
	LDA	SIGN1
	XRA	M		;SET SIGN
	MOV	M,A
	RET
;     X <= PI/4
;       Y = (4X/PI)^2
FCO5	LXI	H,D4PI
	CALL	FMUL
	CALL	FCO35
;     EVAL POLYNOMIAL
	LXI	H,CP05
	MVI	C,5
	CALL	FPOLY
	JMP	FCO4
;     DIVIDE VARIABLE BY PI/4
FCO34	LXI	H,D4PI
FC34A	CALL	FMUL
	JMP	FSTT2		;FTMP2 = 4X/PI
;     SQUARE FACC AND STORE AT FTMP1
FCO35	CALL	FSTT1
	CALL	FMUL
	JMP	FSTT1
;
;  FLOATING POINT DIVISION
;     FACC <== FACC / (H,L)
FDIVD	XCHG
	INX	H
FDIV	MOV	A,M
	ORA	A
	JZ      FOVER		;DIV BY 0
	CALL	UPAC1
	ADI	BIAS+1
	SUB	B		;GET RESULT EXPONENT
	JC	FZACC		;UNDERFLOW
	JZ	FZACC
	JM	FOVER		;OVERFLOW
	STA	EXP1
	LXI	H,FTEMP
	LXI	B,5
	MOV	M,B		;FTEMP 1ST BYTE = 0
	INX 	H
	INX	D
	XCHG
	CALL	FMOVE		;FTEMP <== DIVISOR FRACTION
	LXI	H,FACC+1
	LXI	D,ACALT+2
	MVI	C,5
FD0	MOV	A,M		;ACALT+2 <== DIVIDEND FRACTION
	MOV	M,B		;CLEAR FACC TO 0
	STAX	D
	INX	H
	INX	D
	DCR	C
	JNZ     FD0
	PUSH	H		;SAVE ACALT LOCATION
	MVI	B,11		;NO. OF QUOTIENT DIGITS
;     DIVIDE LOOP
FD1	LXI	H,FTEMP
	LXI	D,ACALT+1	;QUOTIENT LOCATION
	MVI	C,6
FD2	LDAX	D
	CMP	M
	JC	FD5		;DIVIDEND < DIVISOR
	JNZ 	FD3		;DIVISOR < DIVIDEND
	INX	D
	INX	H
	DCR	C
	JNZ 	FD2
FD3	MVI	C,6		;DIVIDEND >= DIVISOR
	LXI	H,FTEMP+5
	LXI	D,ACALT+6
	STC
;        SUBTRACT LOOP
FD4	MVI	A,099H
	ACI	0
	SUB	M
	XCHG
	ADD	M
	DAA
	MOV	M,A
	XCHG
	DCX	H
	DCX	D
	DCR	C
	JNZ     FD4
	POP	H
	PUSH	H
	INR	M		;QUOTIENT DIGIT
	JMP	FD1
FD5	LXI	H,FACC+1
	DCR	B		                        
    	JNZ     FD6             ; NEXT DIGIT
	MOV	A,M		;END OF DIVISION LOOP
	ORA	A
	JNZ     FD7		;DONE
	MVI	B,1		;LEADING 0 - DO ONE MORE DIGIT
	LXI	H,EXP1
	DCR	M		;ADJUST EXP
	LXI	H,FACC+1
FD6	MVI	C,12
	CALL	FM10		;SHIFT RESULT INTO FACC
	JMP	FD1
FD7	MVI	C,6
	CALL	FM10		;SHIFT RESULT INTO PLACE
	POP	H		;CLEAR STACK
	JMP	FRND
;  DIVIDE FLOATING POINT FIELD AT (H,L) BY 10
;     ENTRY: (B,C) = NO OF BYTES
;     EXIT;  (H,L) = START OF FIELD
FD10	DAD	B	;(H,L) = LOW ORDER END
FD11	DCX	H
	MOV	A,M
	RRC
	RRC
	RRC
	RRC
	ANI	0FH
	MOV	B,A		;STORE ONE DIGIT
	DCX	H
	MOV	A,M
	RLC	
	RLC
	RLC
	RLC
	ANI	0F0H
	ORA	B		;APPEND DIGIT
	INX	H
	MOV	M,A
	DCR	C
	JNZ	FD11
	MOV	M,B		;MAKE FIRST DIGIT 0
	RET
;
;  EXP FUNCTION
;  IF X = 0 THEN EXP(X) = 1
;  IF X < 0 THEN EXP(X) = 1 / EXP(-X)
;  ELSE   Z = INT (.5 + X/ LN(10))
;         Y = X / LN(10) - Z
;         B = Y / (4 LOG10 E)     I.E., 0 <= B < .3
;         A = 2 + B^2 * (P1/Q1)
;         EXP(B) = (A + B) / (A - B)
;         EXP(X) = 10^Z * (EXP(B))^4
FEXP	LXI	H,EMAX
	CALL	FCMP
	JNC	FEX31		;> MAX
	XRA	A
	STA	EXP4		;CLEAR INVERT FLAG AND SIGN
	STA	SIGN1
	LXI	H,FACC
	ORA	M
	JZ	FLONE		;EXP(0) = 1
	JP	FEXP1
	STA	EXP4		;FLAG NEGATIVE ARGUMENT
	ANI 	07FH
	MOV	M,A		;MAKE ABS VALUE
FEXP1	LXI	H,D1L10
	CALL	FMUL		;T = X / LN(10)
	CALL	FSTT2		;FTMP2 <== T
	LXI	H,HALF
	CALL	FADD
	CALL	FFIX		;A = INT(.5 + T)
	PUSH	B		;SAVE INT PART
	CALL	FCHS
	CALL	FADT2		;FRAC PART
	LXI	H,D1LE4		;DIVIDE BY 4 LOG E
	CALL	FC34A		;FTMP2 <== Y
	CALL	FCO35		;FTMP1 = T = Y^2
;     EVALUATE CONTINUED FRACTION
   	LXI	H,EB2
	CALL	FTAN6
	LXI	H,FTMP4
	CALL	FLOAD		;LOAD P1
	LXI	H,FTMP3
	CALL	FDIV		;P1/Q1
	LXI	H,FTMP1
	CALL	FMUL		; *T
	LXI	H,TWO
	CALL	FADD		; +2
	CALL	FSTT3		;FTMP3 = A = 2 + T(P1/Q1)
 	LXI	H,FTMP2		;Y
	CALL	FSUB
	CALL	FSTT4		;FTMP4 = A - Y
	LXI	H,FTMP3
	CALL	FLOAD		;Y
	LXI	H,FTMP2
	CALL	FADD		;FACC = A + Y
	LXI	H,FTMP4
	CALL	FDIV 		; (A+Y) / (A - Y)
	CALL  	FCO35		;SQUARE
	CALL	FCO35		;4TH POWER
	CALL	FLONE		;LOAD 1
	POP	B		;GET POWER OF 10
	INR	C
	MOV	A,C
	ADI	BIAS
	STA	FACC		;FACC = 10 TO POWER
	LXI	H,FTMP1
	CALL	FMUL		;MULT BY E TO POWER
	JMP	FTAN5		;SEE WHETHER TO INVERT
FEX31	CALL	FCERN		; > MAX
	LXI	H,FPMAX
	JMP	FLOAD
;  CONVERT FACC TO 16-BIT BINARY INTEGER IN (B,C)
FFIX	LXI	H,INTMX
IINT	EQU	FFIX		;IINT IS SAME AS FFIX IF FPBCD
	CALL	FCMP
	JNC	FFIX1		;OVERFLOW
	LXI	H,INTMN
	CALL	FCMP
	JZ	FF0		;-32768
	JC	FFIX2		;UNDERFLOW
;     RANGE OK
FF0	LXI	H,FACC
	MOV	A,M
	ORA	A
	JNZ	FF1
	LXI	B,0		;ZERO VALUE
	RET
FF1	PUSH	PSW		;SAVE SIGN
	CALL	FINT
	MOV	A,C
	ORA	A
	JNZ	FF3		;NONZERO INTEGER PART
;     INTEGER PART 0
	POP	PSW
	RP			;RETURN IF POSITIVE
	DCX	B		;NEGATIVE FRACTION
	JMP	FF6
FF3	POP	PSW		;REMOVE SAVED SIGN
	MOV	D,C		;D = NO. OF INTEGER DIGITS
	LXI	H,0		;(H,L) = BINARY ACCUMULATOR
	LXI	B,FACC+1	;(B,C) = LOC OF FRACTION
FF4	LDAX	B		;CONVERSION LOOP
	RAR
	RAR
	RAR
	RAR
	CALL	FF7		;LEFT DIGIT
	JZ 	FF5		;END OF INTEGER DIGITS
	LDAX	B
	CALL	FF7		;RIGHT DIGIT
	INX	B		;NEXT BYTE
	JNZ	FF4		;LOOP
FF5	MOV	B,H
	MOV	C,L		;(B,C) <== VALUE
	LDA	FACC
	ORA	A
	RP			;NOT NEGATIVE
	DAD	D		;IF NEGATIVE ROUND DOWN
	MOV	B,H
	MOV	C,L
	XRA	A		;2'S COMPLEMENT
	SUB	C
	MOV	C,A
	MVI	A,0
	SBB	B
	MOV	B,A
FF6	PUSH	B
	CALL	FFLOT		;FACC <== INTEGER PART
	POP	B		;VALUE
	XRA	A		;CLEAR CARRY
	RET
FF7	PUSH	D		;ADD CURRENT DIGIT TO BINARY TOTAL
	DAD	H		;(H,L) <== (H,L) * 10
	MOV	E,L
	MOV	D,H
	DAD	H
	DAD	H
	DAD	D
	ANI	0FH		;GET DIGIT
	MOV	E,A
	MVI	D,0
	DAD	D		;ADD NEW DIGIT
	POP	D
	DCR	D
	RET
FFIX1	LXI	B,32767		;OVERFLOW
	JMP	FF8
FFIX2	LXI	B,-32768	;UNDERFLOW
FF8	CALL	FF6 
	STC
	RET
;
;  FLOAT BINARY VALUE IN (B,C)
;     RESULT IN FACC
FFLOT	PUSH	B
	MVI	C,11
	LXI	H,FACC
	CALL	FZERO
	POP	B
	STA	SIGN		;POSITIVE
	LXI	D,BDTAB-3	;CONVERSION TABLE
	ORA	B
	JM	FFL0  		;VALUE <0
	JNZ	FFL1		;>0
	CMP	C
	RZ
	JMP	FFL1
FFL0	ANI	080H
	STA	SIGN		;NEGATIVE
	XRA	A		;NEGATE (B,C)
	SUB	C
	MOV	C,A
	MVI	A,0
	SBB	B
 	MOV	B,A
;     SHIFT (B,C) RIGHT
FFL1	MOV	A,B
	ORA	A		;TEST FOR 0 AND CLEAR CARRY
	JNZ     FFL2		;B IS NOT 0
        MOV	A,C             ;B=0
	ORA	A
	JNZ	FFL3
;     DONE WHEN (B,C) = 0
	LXI	H,EXP1
	MVI	M,BIAS+6
	JMP	FNORM		;NORMALIZE
FFL2	RAR			;B <== B/10
	MOV	B,A
	MOV	A,C
FFL3	RAR			;C <== C/10
	MOV	C,A 
	INX	D		;NEXT PLACE IN TABLE
	INX	D
	INX	D
	JNC	FFL1		;0-BIT
;     ON 1-BIT ADD VALUE FROM TABLE
	PUSH	D
	PUSH	B
	INX	D
	INX	D
	LXI	H,FACC+3
	MVI	C,3
	CALL	FADDL		;ADD DECIMAL VALUE
	POP	B
	POP	D
	JMP	FFL1
;
;  INPUT FLOATING POINT VALUE FROM STRING
;     RESULT IN FACC
FINP	SHLD	TEXTP		;SAVE STRING POINTER
	CALL	FINP0
	LHLD	TEXTP
	JMP	BAKUP		;BACK UP THE TEXT POINTER
FINP0	LXI	H,FACC
	MVI	C,12
	CALL	FZERO
	MOV	B,A		;B = 0 = EXPONENT
	MOV	E,A		;E = 0 = SIG DIGIT FLAG
	STA	SIGN
	INR	A
	MOV	D,A		;D = DEC. POINT FLAG = 1
FIN00	CALL	FINC		;GET CHARACTER
	JC	FIN1B		;NON NUMERIC
FIN0	CPI 	'0' 
	JNZ     FIN2		;NONZERO DIGIT
	JMP	FIN00		;SKIP A LEADING 0
FIN1	CALL    FINC
FIN1A	JNC	FIN2		;DIGIT
FIN1B	CPI	'9'+1
	JNC	FIN3		;>9
	CPI	'.'
	JNZ	FIN7		; END OF STRING
	XRA	A
	CMP	D
	JZ	FIN7		; 2 DEC. POINTS
	MOV	D,A		;FLAG FOR DEC. POINT
	JMP	FIN1
;     PROCESS DIGIT
FIN2	SUI	'0'		;MAKE NUMERIC
	MOV	C,A
	LDA	FACC+2
 	ANI	0F0H
	JNZ     FIN22		;10 DIGITS ALREADY IN
	PUSH	B
	LXI	H,FACC+1
	MVI	C,6
	CALL	FM10		;FACC <== FACC * 10
	POP	B
	MOV	A,C		;NEW DIGIT
	ADD	M		;ADD IN NEW DIGIT
	MOV	M,A
	MOV	A,C		;RECOVER NEW DIGIT
	ORA	E
	MOV	E,A		;SIG FLAG NONZERO IF SIG DIGIT SEEN
	MOV	A,D		;FETCH DEC PT FLAG
	ORA	A
	JZ	FIN21		;DEC PT SEEN
	INR	B		;DEC PT NOT SEEN YET, BUMP EXPONENT
FIN21	MOV	A,E		;FETCH SIG DIGIT FLAG
	ORA	A
	JNZ	FIN1		;TRY NEXT DIGIT
	DCR	B		;PAST DEC PT AND NO SIG DIGIT, DCR EXPONENT
	JMP	FIN1
;MORE THAN 10 SIGNIFICANT DIGITS
FIN22	MOV	A,D		;FETCH DECIMAL POINT FLAG
	DCR	A
	JNZ	FIN23		;PAST DECIMAL POINT, LEAVE EXPONENT UNCHANGED
	INR	B		;BUMP EXPONENT FOR DIGIT
FIN23	CALL	FINC		;FETCH ANOTHER CHAR
	JC	FIN1B		;NONDIGIT
	JMP	FIN22		;ANOTHER DIGIT
FIN3	CPI	'E'
	JZ	FIN4
	CPI	'E'+20H		;LOWER CASE E
        JNZ     FIN7		;NOT VALID CHARACTER
;     PROCESS EXPONENT
FIN4	MVI	C,0		;EXP. DIGIT COUNT
	MOV	E,C		;BUILD EXPONENT IN E
	CALL	FINC		;GET CHAR
	JNC	FIN4C		;DIGIT
	CPI	MINT
	JZ	FIN4A		;TOKENIZED MINUS SIGN
	CPI	PLUST
	JZ	FIN4B		;TOKENIZED PLUS SIGN
	CPI	'+'
	JZ	FIN4B		;PLUS SIGN
	CPI	'-'
	JNZ     SNERR		;NOT DIGIT, PLUS, MINUS -- SYNTAX ERROR
FIN4A	MVI	A,080H		;MINUS
	STA	SIGN
FIN4B	CALL	FINC
	JC	SNERR		;SYNTAX ERROR IF NONDIGIT FOLLOWS SIGN
FIN4C	CPI	'0'
	JNZ	FIN5
	CALL	FINC		;GET CHAR AFTER LEADING EXPONENT 0
	JC	FIN6		;EXPONENT IS 0
	JMP	FIN4C		;CHECK FOR ANOTHER LEADING 0
FIN5	INR	C
	SUI	'0'
	ADD	E		;ADD TO EXPONENT
	MOV 	E,A
	CALL	FINC
	JC      FIN6		;END
	PUSH	PSW		;ANOTHER EXP. DIGIT
	MOV	A,C
	CPI	3
	JZ	FIN5A		;TOO MANY DIGITS
	MOV	A,E		;E <== E * 10
	ADD	A
	MOV	E,A
	ADD	A
	ADD     A
	ADD	E
	MOV	E,A
	POP	PSW
	JMP	FIN5
FIN5A	POP	PSW
FIN6	LDA	SIGN
	ORA	A
	JZ	FIN7A		;EXP >= 0
	MOV	A,B		;NEGATE EXPONENT
	SUB	E
	ADI	BIAS
	JM	FZACC		;UNDERFLOW
	JZ 	FZACC
	JMP	FIN8
FIN7	MVI	E,0
FIN7A	MOV	A,B		;FORM TOTAL EXPONENT
	ADD	E
	ADI	BIAS
	JM	FOVER		;OVERFLOW
FIN8	STA	EXP1
	LXI	H,FACC
	MVI	C,6
FIN9	INX	H		;FIND NONZERO BYTE
	MOV	A,M
	ORA	A
	JNZ	FIN10
	DCR	C
	RZ			;ZERO RESULT
	JMP	FIN9
FIN10	LXI	D,FACC+1	;NORMALIZE
	CALL	FLOD1		;MOVE OVER TO START OF FACC
	LDAX	D
	CPI	010H
	JNC	FIN11
	LXI	H,FACC+1
	MVI	C,6
	CALL    FM10            ;HALF BYTE SHIFT
FIN11	LXI	H,EXP1
	LDA	TEMP		;SIGN
	ANI	080H
	ORA	M		;APPEND EXP.
	STA	FACC
	XRA	A
	RET
;     GET CHARACTER FROM STRING
;     CF = 1 ==> NOT NUMERIC
FINC	LHLD	TEXTP
	MOV	A,M
	INX	H
	SHLD	TEXTP		;NEW TEXT POINTER
	CPI	'0'
	RC			;<0
	CPI	'9'+1
	CMC
	RET
;
;  FACC <== INTEGER PART (TRUNCATED)
;  EXIT:  (D,E) = 1 IFF NONZERO DIGITS WERE TRUNCATED
;         (B,C) = NO. OF INTEGER DIGITS
FINT	XRA	A
	MOV	E,A
	MOV	D,A
	MOV	B,A
	LXI	H,FACC
	ORA	M
	RZ			;ZERO
	MVI	E,1		;FRACTION FLAG
	ANI	07FH		;GET EXPONENT
	SUI	BIAS
	JZ	FZACC		;PURE FRACTION
	JM	FZACC
	MVI	E,0
	CPI	10
	RNC			;ALREADY INTEGER
	PUSH	PSW		;SAVE NO. OF DIGITS
	ORA	A
	RAR
	PUSH    PSW		;(CF) = 1 IF ODD
	MOV	C,A
	DAD	B
	INX	H		;(H,L)= LOW END OF INTEGER PART
	MVI	A,5
	SUB	C
	MOV	C,A		;C = NO OF BYTES TO CLEAR
	POP	PSW
	JNC	FINT2		;EVEN
	MOV	A,M		;CLEAR RIGHT DIGIT OF BYTE
	ANI  	0FH
	JZ	FINT3		;NO FRACTION DIGIT
	MVI	E,1
	MOV	A,M
	ANI	0F0H
	MOV	M,A
	JMP     FINT3
FINT2	MOV	A,M
	ORA	A
	JZ	FINT3		;ALREADY 0
	MVI	E,1		;FLAG NONZERO FRACTION
	MVI	M,0		;CLEAR BYTE
FINT3	INX	H
	DCR	C
	JNZ	FINT2
	POP	PSW		;NO. OF DIGITS
	MOV	C,A
	RET
;
;  NATURAL LOG
; X = 10^A * Y WHERE .1 <= Y < 1
; Y = 2^M * Z WHERE 1/2 <= Z < 1, M=0,-1,-2,-3
; V = T * T
; LN (V) = LN (1+T)/(1-T) = T * P2(V) / Q2(V)
; LN (X) = A * LN (10) + (M - 1/2) * LN (2) + LN (1+T)/(1-T)
FLN	LXI	H,FPONE
	CALL	FCMP
	JZ	FZACC		;LN(1) = 0
	LXI	H,FACC
	MOV	A,M
	ORA	A
	JM	FL94		;LOG OF NEGATIVE
	JZ	FCERN		;LOG OF 0
	MVI	M,BIAS		;MAKE PURE FRACTION
	SUI	BIAS
	STA     EXP3		;STORE UNBIASED EXP
	MVI	C,0
FL0	INX	H
	MOV	A,M
	CPI     050H
	JNC	FL1		;FRAC >= .5
	PUSH	B
	DCX	H
	PUSH	H
	LXI	H,FTEMP
	CALL	FSTOR
	CALL	FADD		;X <== 2*X
	POP	H
	POP	B
	INR	C		;COUNT
	JMP	FL0
FL1	LXI	H,EXP4
	MOV	M,C		;SAVE SCALE FACTOR
	CALL	FSTT1	 	;FTMP1 = SCALED FRACTION
	LXI	H,DSR22	
	CALL	FADD		;ADD SQR(2)/2
	CALL	FSTT2
	LXI	H,FTMP1
	CALL	FLOAD
	LXI	H,DSR22
	CALL	FSUB
	LXI	H,FTMP2
	CALL	FDIV		;T = (Y - SQR(2)/2) /(Y + ...)
	CALL	FSTT2		;FTMP2 = T
	CALL	FCO35		;FTMP1 = T^2
;     LOG ((1+T)/(1-T)) = CONTINUED FRACTION
	LXI	H,LB3
	CALL	FTAN7
	LXI	H,LC0
	CALL	FADD
	LXI	H,FTMP2
	CALL	FMUL		;T * P/Q
	CALL	FSTT1
	LDA	EXP3
	MOV	C,A
	MVI	B,0		;(B,C) = EXP
	ORA	A
	JP	FL2
	DCR	B		;SIGN EXTEND
FL2	CALL	FFLOT
	LXI	H,LN10
	CALL	FMUL		;FACC <== EXP * LN(10)
	CALL	FSTT2
	LDA	EXP4		;M
	MOV	C,A
	MVI	B,0
	CALL	FFLOT
	LXI	H,HALF
	CALL	FADD
	LXI	H,LN2
	CALL	FMUL		;FACC <== -(M - 1/2) * LN(2)
	CALL	FCHS
	CALL	FADT2
	LXI	H,FTMP1
	JMP 	FADD
FL94	ANI	07FH		;LOG OF NEGATIVE
	MOV	M,A		;MAKE POSTIVE
	CALL    FCERN
	JMP   	FLN
;
;  LOAD FACC FROM (H,L)
;     EXIT:  (D,E) = FACC
FLONE	LXI	H,FPONE		;LOAD 1
FLOAD	LXI	D,FACC
FLOD1	MVI	C,6
;     MOVE FIELD FROM (H,L) TO (D,E)
FMOVE	PUSH 	D
FMOV1 	MOV	A,M
	STAX	D
	INX	H
	INX	D
	DCR	C
	JNZ	FMOV1
	POP	D
	RET
;
;  F.P . MULTIPLY   FACC <== FACC * (H,L)
FMUL	MOV 	A,M
	ORA	A
	JZ      FZACC     	;OP-2 = 0
	CALL	UPAC1
	ADD	B	 	;GET RESULT EXP
	SUI 	BIAS-1
	JZ	FZACC		;UNDERFLOW
	STA     EXP1		;STORE EXP
	XCHG
	LXI	D,FTEMP
        MVI     C,6
	CALL	FMOVE		;MOVE OP-2 TO FTEMP
	XCHG
	MVI	M,0
	LXI	B,5
	DAD	B		;(H,L) = LOW END OF OP-2
	PUSH	H
	LXI	H,HOLD4
	CALL	FSTOR		;HOLD4 <== OP-1
	DCX	H		;(H,L) = END OF HOLD3
	MVI	B,3
	XCHG
FM2	LXI	H,6
	DAD	D		;(H,L) <== END OF HOLD(I+1)
	MVI	C,6
	ORA	A		;CLEAR CARRY
FM3	MOV	A,M		;HOLD(I) <== 2 * HOLD(I+1)
	ADC	A		;DOUBLE IT
	DAA
	STAX	D
	DCX	D
	DCX	H
	DCR	C
	JNZ	FM3
	DCR	B
	JNZ	FM2
	CALL	FZACC		;CLEAR FACC
	POP	H		;(H,L) <== OP-2
	PUSH	H
	CALL	FMLOP	 	;MULT LOOP FOR RIGHT DIGITS
	LXI	H,FACC+1
	MVI	C,10
	CALL	FD10		;FACC <== FACC/10
	LXI	H,FTEMP+1
	MVI	C,5
	CALL    FD10
	POP	H
	CALL	FMLOP		;MULT LOOP FOR LEFT DIGITS
	JMP	FNORM		;NORMALIZE
;   MULTIPLY LOOP
;     FACC <== HOLD1 * RIGHT DIGITS OF FTEMP
FMLOP	MVI	C,5		;OUTER LOOP COUNTER
	LXI	D,FACC+11	;PRODUCT LOCATION
	PUSH	D
	PUSH	H		;END OF MULTIPLIER
FML1	POP	D
	LDAX	D		;GET MULTIPLIER DIGIT
	DCX	D		;NEXT DIGIT
	POP	H		;SUM LOCATION
	DCX	H
	PUSH	H		;NEXT SUM LOCATION
	PUSH	D		;NEXT MPR. DIGIT
	LXI	D,HOLD1+5
	ANI	0FH		;DIGIT
	RLC			;PUT IN LEFT NIBBLE
	RLC
	RLC
	RLC
FML2	ORA	A
	JZ	FML4		;SKIP LOOP ON ZERO DIGIT
	PUSH	H		;ACCUM LOCATION
	ADD	A		;DOUBLE DIGIT
	MOV	B,A
	JNC	FML3		;NO ADD ON 0 BIT
	PUSH	B
	PUSH	D
	MVI	C,6
	CALL	FADDL		;ACCUMULATE PRODUCT
	POP	D
	POP	B
FML3	LXI	H,6
	DAD	D		;NEXT HOLD BUFFER
	XCHG
	POP	H		;ACCUM. LOCATION 
	MOV	A,B		;GET DIGIT
	JMP	FML2		;INNER LOOP
FML4	DCR	C
	JNZ	FML1		;OUTER LOOP (NEXT DIGIT)
	POP	H
	POP	H		;CLEAR STACK
	RET
;  MULTIPLY FLOATING POINT VALUE AT (H,L) BY 10
;   ENTRY:  C = NO OF BYTES IN FIELD
FM10	MOV	A,M
	ANI	0FH
	RAL	
	RAL
	RAL
	RAL
	MOV	M,A
	INX	H
	MOV	A,M
	RAR
	RAR
	RAR
	RAR
	ANI	0FH
	DCX	H
	ORA	M
	MOV	M,A		;STORE DIGIT PAIR
	INX	H
	DCR	C
	JNZ	FM10
	DCX	H
	ANI	0F0H		;LAST DIGIT = 0
	MOV	M,A
	RET
;
;  NORMALIZE
FNORM	LXI	H,FACC+1
	MVI	C,0
FN0	MOV	A,M		;FIND HIGHEST NON-0 DIGIT
	ORA	A
	JNZ	FN1
	INR	C		;COUNT ZEROS
	INR	C
	INX	H
	JMP	FN0
FN1	XRA	A
	CMP	C
	JZ	FN2		;FIRST BYTE NON-0
	DCX	H
	PUSH	B
	CALL    FLOAD           ;MOVE FRACTION LEFT
	POP	B
	LXI	H,FACC+1
FN2	MOV	A,M
	ANI	0F0H
	JNZ	FN3	        ;DONE
	INR	C
	PUSH	B
	LXI	B,6
	CALL	FM10		;SHIFT LEFT 1/2 BYTE
	POP	B
FN3	LXI	H,EXP1
	MOV	A,M
	SUB	C		;ADJUST EXP.
	JZ	FZACC		;UNDERFLOW TO 0
	JC	FZACC
	JM	FOVER		;OVERFLOW
	MOV	M,A
	JMP	FRND
;
;  OUTPUT FROM FLOATING POINT TO STRING
FOUT	LXI	H,BUFAD		;RESULT ADDRESS
	PUSH	H		;SAVE ORIG. BUFAD
	PUSH	H		;CURRENT CHAR. POINTER
	LXI	H,FACC
	MOV	A,M
	ORA     A
	JNZ	FOU1
	POP	H		;ZERO VALUE
	MVI	M,' ' 		;OUTPUT ' 0'
	INX	H
	MVI	M,'0'
	MVI	C,2
	POP	D
	RET
FOU1	ANI     080H		;SIGN
	STA	SIGN
	MOV	A,M
	ANI	07FH
	STA	EXP1		;STORE EXP.
	MVI	M,0		;MAKE FACC PURE FRACTION
	LXI	H,FACC+5
	CALL    FRND1		;ROUND TO 8 PLACES
	POP	H
	MVI	B,' '		;OUTPUT LEADING ' ' OR '-'
	LDA	SIGN
	ORA	A
	JP	FOU2
	MVI	B,'-'
FOU2	MOV	M,B
	MVI	C,1		;CHAR. COUNT
	INX	H
	LDA	EXP1
	SUI	BIAS		;UNBIASED EXPONENT
	MOV	E,A		;E = EXP
	MOV	B,A		;B = INTEGER DIGIT COUNTER
	JM	FOU3		;EXP < 0
	JZ      FOU3		;EXP = 0
	CPI 	9
	JC	FOU4		;EXP <= 8
FOU3	MVI	M,'.'		;LEADING POINT
	INR	C
	INX	H
	CPI	-7
	JC	FOU4		;LARGE NEG EXPONENT, USE E NOTATION
FOU3A	MVI	M,'0'		;ELSE STORE 0 AFTER .
	INR	C
	INX	H
	INR	A
	JNZ	FOU3A
	MVI	E,0		;RESET EXPONENT TO 0
FOU4	PUSH	H		;SAVE OUTPUT POINTER
	LXI	H,FACC
	MVI	D,4		;BYTE COUNTER
;      OUTPUT DIGITS
FOU5	INX	H		;(H,L) = POINTER TO FACC
	MOV 	A,M
	RAR			;LEFT DIGIT
	RAR
	RAR
	RAR
	ANI	0FH
	XTHL			;(H,L) <== OUTPUT POINTER
	CALL	FOUT1		;OUTPUT DIGIT
	XTHL
	MOV 	A,M
	XTHL
	ANI	0FH		;RIGHT DIGIT
	CALL	FOUT1
	XTHL
	DCR	D
	JNZ	FOU5
	POP	H		;CHAR POINTER
FOU6	DCX	H		;BACK UP TO LAST CHAR
	DCR	C
	MOV	A,M
	CPI	'.'
	JZ      FOU7		;DELETE TRAILING POINT
	CPI	'0'
	JZ  	FOU6		;BACK UP TO NONZERO
	INX	H
	INR	C
;     SEE IF 'E' NOTATION NEEDED
FOU7	MOV	A,E
	ORA 	A
	JM	FOU8
	CPI	9
	JC	FOU12		;0 <= EXP <= 8
;     OUTPUT 'E' AND EXPONENT
FOU8	MVI	M,'E'
	INX	H
	INR	C
	ORA	A
	JP	FOU9
	MVI	M,'-'		;NEGATIVE EXP
	INX	H
	INR	C
	XRA	A
	SUB	E		;MAKE EXP POSITIVE
FOU9	CPI	10
	JC	FOU11		;ONE-DIGIT EXP
;  GET FIRST DIGIT OF EXP
   	MVI	D,0		;D <== EXP/10
FOU10 	SUI	10
	INR	D
	CPI	10
	JNC	FOU10
	MOV	E,A		;E <== REMAINDER
	MOV	A,D
	ADI	'0'
	MOV	M,A		;OUTPUT FIRST DIGIT
	INX	H
	INR	C
	MOV	A,E
FOU11	ADI	'0'
	MOV	M,A
	INR	C
FOU12	POP	D		;(D,E) = BUFAD
	RET
;     OUTPUT DIGIT
FOUT1	ADI	'0'  		;MAKE CHARACTER
	MOV	M,A
	INR	C		;CHAR COUNT
	INX	H
	DCR	B		;INTEGER COUNT
	RNZ
	MVI	M,'.'		;DECIMAL POINT
	INR	C
	INX	H
	RET
;  OVERFLOW
FOVER	ERROR	N,O,V
	LXI	H,FPMAX
	CALL	FLOAD		;LOAD MAX VALUE
	LXI	H,FACC
	LDA	SIGN
	ORA	M		;APPEND SIGN
	MOV	M,A
	RET
;
;  EVALUATE POLYNOMIAL
;    ENTRY:  FTMP1 = VARIABLE,  (C) = DEGREE, (H,L) = HIGHEST ORDER COEFFICIENT
; P(Y) = (...(Y*CN+ C(N-1)) * Y + ...) * Y + C0
FPOLY	PUSH  	B
	PUSH	H
	CALL	FMUL		;MULT BY HIGHEST COEFFICIENT
	JMP	FPLY1
FPLY0	PUSH	B
	PUSH	H
	CALL	FADD
	LXI	H,FTMP1
	CALL	FMUL		;MULT BY VARIABLE
FPLY1	POP	H
	POP	B
	LXI	D,-6
	DAD	D		;NEXT COEFFICIENT
	DCR	C		;DEGREE COUNT
	JNZ	FPLY0
	JMP	FADD		;ADD LAST COEFFICIENT
;  RENORMALIZE
FRNRM	LXI	H,FACC
	MOV	A,M
	ORA	A
	RZ			;NO RENORM NEEDED
	LXI	B,7
	CALL	FD10		;SHIFT RIGHT 1/2 BYTE
	LXI	H,EXP1		;INCR. EXP
	INR	M
	JM	FOVER		;OVERFLOW
	RET
;
;  ROUND FLOATING POINT VALUE
FRND	LXI	H,ACALT
	CALL	FRND1 
FRND0	LXI	H,SIGN
	LDA	EXP1
	ORA	M		;REPACK RESULT
	STA	FACC
	RET
FRND1	MOV	A,M
	ADI	050H
	DAA
	RNC			;DONE IF NO CARRY
	DCX	H
	CALL	FADL0		;CARRY ONE
	JMP	FRNRM		;RENORMALIZE
;
;  SINE FUNCTION
; IF ABS(X) < 4 E (-7) RETURN X
; ELSE SIN (X) = COS (X - PI/2)
FSIN	LXI	H,FACC
	MOV	A,M
	ANI	07FH		;GET EXP
	CPI	039H
;     IF ABS(X) < 4 E (-7) THEN RETURN X
	RC			;EXP < -7
	JNZ	FS0
	INX	H
	MOV	A,M
	CPI	040H
	RC
;     ELSE SIN(X) = COS (X - PI/2)
FS0	LXI	H,DPI2
	CALL	FSUB
	JMP	FCOS
;
;  SQUARE ROOT
; X = Y * 10^A WHERE .1 <= Y < 1
; B <== INT (A/2)
; C <== (A - 2*B) * SQR(10)
; Z0 <== POLYNOMIAL(Y)
; Z1 <== 1/2 (Z0 + Y/Z0), ETC.
; SQR(X) = Z * 10^B * SQR(10) IF C=1
;        = Z * 10^B IF C = 0
FSQR	LXI	H,FACC
	MOV	A,M
	ORA	A
	CM	FCERN		;SQR OF NEGATIVE
	ANI	7FH
	MOV	M,A		;FORCE POSITIVE
	SUI	BIAS		;UNBIAS EXP
	RAR			;A <== EXP/2
	PUSH	PSW		;SAVE EVEN/ODD FLAG
	STA	SIGN1		;STORE EXP/2
	MVI	M,BIAS		;SET EXP TO 0
	CALL	FSTT1		;SAVE X
	INX	H
	MOV	A,M
	CPI	025H
	JNC	FSQ4		;X > .25
;     X <= .25
	LXI	H,SR3
	MVI	C,3
FSQ0	CALL	FPOLY		;POLYNOMIAL
;     2 NEWTON-RAPHSON ITERATIONS
	CALL	FSQ2
	CALL	FSQ2
	POP	PSW		;EVEN/ODD FLAG
	JNC	FSQ1		;EVEN
	LXI	H,SQR10
	CALL	FMUL		;IF ODD MULT BY SQR(10)
FSQ1	LXI	H,FACC
	LDA	SIGN1		;GET EXP/2
	ADD	M
	MOV	M,A		; SET RESULT EXP
	RET
;     NEWTON-RAPHSON ITERATION
;       Z1 =   (X/Z0 + Z0) * .5
FSQ2	CALL	FSTT2		;STORE Z
	LXI	H,FTMP1
	CALL	FLOAD
	LXI 	H,FTMP2
	CALL  	FDIV		;X/Z0
	LXI	H,FTMP2
	CALL	FADD
	LXI	H,HALF
	JMP	FMUL
;     X > .25
FSQ4	LXI	H,SR6
	MVI	C,2
	JMP	FSQ0
;
;  STORE FACC AT (H,L)
;     EXIT:  (H,L) = DESTINATION FIELD
FSTT4	LXI	H,FTMP4
	JMP	FSTOR
FSTT3	LXI	H,FTMP3
	JMP	FSTOR
FSTT2	LXI	H,FTMP2
	JMP	FSTOR
FSTT1	LXI	H,FTMP1
FSTOR	PUSH	B
	LXI	B,5
	DAD	B		;(H,L) = LOW END OF FIELD
	INX	B
	LXI	D,FACC+5
FST0	LDAX	D
	MOV	M,A
	DCX	D
	DCX	H
	DCR	C
	JNZ	FST0
	INX	H
	POP	B
	RET
;
;  FLOATING POINT SUBTRACTION		FACC <== FACC - (H,L)
FSUB 	MOV	A,M
	ORA	A
	RZ			;OP - 2 = 0
	LXI	D,FACC
	LDAX	D
	ORA	A
	JZ	FSUB0		;SUBTRACT FROM 0
   	XRI	080H		;REVERSE SIGN
	JMP	FADD0
FSUB0	CALL	FLOAD		;LOAD OP-2
	JMP	FCHS
;  SUBTRACT LOOP
FSUB1	LDA	FLEN
	MOV	C,A		;LENGTH OF LOOP
 	STC
FSU2 	XCHG
	MVI	A,099H
	ACI	0
	SUB	M
	XCHG
	ADD	M
	DAA
	MOV	M,A
	DCX	H
	DCX	D
	DCR	C
	JNZ	FSU2
	JC	FSU4		;FORM CORRECT
	LHLD	RSLT
	LDA	FLEN
	MOV	C,A
	STC
FSU3	MVI	A,099H		;RECOMPLEMENT
	ACI	0
	SUB	M
	ORA	A		;CLEAR ACY  
	DAA
	MOV	M,A
	DCX	H
	DCR	C
	JNZ 	FSU3
	LXI	H,SIGN
	MOV	A,M
	XRI	080H		;REVERSE SIGN ON RECOMPLEMENT
	MOV	M,A
FSU4	LXI	H,FACC+1
	MVI	C,7
FSU5	MOV	A,M		;CHECK FOR 0 RESULT
	ORA	A
	JNZ	FNORM		;NORMALIZE NON-0
	INX	H
 	DCR	C
	JNZ	FSU5	
	RET			;RETURN 0
;
;  TANGENT
; STORE SIGN AND MAKE ABS VALUE
; Y <== 4X/PI
; R <== FRAC(Y)
; A <== INT(Y) (MOD 4)
; IF A > 2 THEN REVERSE SIGN
; IF A IS ODD, R <== 1-R
; IF A = 1 OR 2 (MOD 4) SET COTAN FLAG
; Y <== R * PI/4
; T <== Y * Y
; TAN (X) = X * (C0 + P2(T)/Q2(T))
; IF FLAG IS SET, TAKE COTAN I.E. 1/TAN
; APPEND SIGN
FTAN	XRA	A
 	STA	EXP4		;CLEAR COTAN FLAG
	LXI	H,FACC
	MOV	A,M
	ANI	080H		;GET SIGN
	STA	SIGN1
	MOV	A,M
	ANI	07FH		;GET EXP
	MOV	M,A		;MAKE ABS. VALUE
	CALL	FCO34		;FTMP2 <== 4X/PI
	LXI	H,INTMX
	CALL	FCMP
	JNC	FCERN		;VALUE TOO LARGE
	CALL	FFIX		;GET INTEGER PART
	PUSH	B		;SAVE INT PART
	CALL	FCHS		;GET FRAC PART
	CALL	FADT2		;R = FRAC PART
	POP	B
	MOV	A,C
	ANI	3		;A <== INT PART (MOD 4)
	CPI	2
	JC	FTAN2
	LXI	H,SIGN1		;IF > 2 (MOD 4) REVERSE SIGN
	PUSH	PSW
	MOV	A,M
	XRI	080H
	MOV	M,A
	POP	PSW
FTAN2	PUSH	PSW
	RAR
	JNC	FTAN3		;EVEN
	CALL	FCHS		;IF ODD, R = 1 - R
	LXI	H,FPONE
	CALL	FADD
FTAN3	POP	PSW
	INR	A
	ANI	2
	JZ	FTAN4		;A WAS 0 OR 3 (MOD 4)
	STA	EXP4		;IF 1 OR 2 (MOD 4) SET COTAN FLAG
FTAN4	LXI	H,DPI4
	CALL	FC34A		;FTMP2 = Y = R * PI/4
	CALL	FCO35	 	;FTMP1 = Y^2
	LXI	H,TB3
	CALL	FTAN7		;EVAL. CONTINUED FRAC.
	LXI	H,TC0
	CALL	FADD
	LXI	H,FTMP2
	CALL	FMUL		;*Y
FTAN5	LDA	EXP4		;GET INVERT FLAG
	ORA	A
	CNZ	FLINV		;INVERT IF DESIRED
	JMP	FAT6		;APPEND SIGN
;     EVALUATE CONTINUED FRACTION
; P1 <== C2 (X + B3)
; Q1 <== (X + B2) (X + B3) + C3
; P2 <== C1 * Q1
; Q2 <== (X + B1) * Q1 + P1
FTAN6	PUSH	H
	CALL	FADD		;X + B3
	CALL	FSTT3		;FTMP3 = X + B3
	POP	H
	LXI	D,6
	DAD	D		;NEXT COEFFICIENT
	PUSH	H
	CALL	FMUL		;* C3
	CALL	FSTT4		;FTMP4 = P1
	LXI	H,FTMP1
	CALL	FLOAD		;X
	POP	H
	LXI	D,6
	DAD	D
 	PUSH	H
	CALL	FADD		;+ B2
	LXI	H,FTMP3
	CALL	FMUL		; * (X + B3)
	POP	H
	LXI	D,6
	DAD	D
	PUSH	H
	CALL	FADD		; + C3
	CALL	FSTT3		;FTMP3 = Q1
	POP	H
	RET
FTAN7	CALL	FTAN6
	PUSH	H
	LXI	H,FTMP1
	CALL	FLOAD		;X
	POP	H
	LXI	D,6
	DAD	D
	PUSH	H
	CALL	FADD		; + B1
	LXI	H,FTMP3
	CALL	FMUL		; * Q1
	LXI	H,FTMP4
	CALL	FADD		; + P1
	CALL	FSTT4		; FTMP4 = Q2
	LXI	H,FTMP3
	CALL	FLOAD		; Q1
	POP	H
	LXI	D,6
	DAD	D
	CALL	FMUL		; * C1 = P2
	LXI	H,FTMP4        ; P2/Q2
	JMP	FDIV
;
;  ZERO OUT FACC
FZACC	MVI	C,6
	LXI	H,FACC
;  ZERO OUT FLOATING POINT FIELD AT (H,L)
FZERO	XRA	A
FZER1	MOV	M,A
	INX	H
	DCR	C
	JNZ	FZER1
	RET
;
;  UNPACK FLOATING POINT OPERANDS FOR DIV. AND MULT.
UPAC1	ANI	07FH		;GET EXP-2 
	MOV	B,A		;SAVE EXP-2 IN B
	LXI	D,FACC
	LDAX	D
	ORA	A
	JNZ	UNP1
;     OP-1 = 0
	INX	SP		;EXIT FROM CALL
	INX	SP
	RET			;RETURN 0
UNP1	XRA	M		;GET RESULT SIGN
	ANI	080H
	STA	SIGN
UPAC2	XCHG			;(D,E) = OP-2
	MOV	A,M
	PUSH	PSW		;SAVE EXP-1
	MVI 	M,0		;FACC <== PURE FRACTION
	LXI	H,ACALT
	MVI	C,7
	CALL	FZERO		;CLEAR ACALT
	POP	PSW
	ANI	07FH		;EXP-1
	RET

	endif

;end of module FPBCD
