NAME	FPINT
	CSEG
;
;
;	LINK TO EXTERNAL REFERENCES
;
	EXTRN	FSTOR,FLOAD,FADD,FTEST,FZERO,FABS,FMUL,FDIV
	EXTRN	FFLOAT,FFIX,FCHS,FSUB
	EXTRN	OVER
	EXTRN	OVERF,ACC2,ACCE
	EXTRN	SEED
	PUBLIC	IDV,FCOSH,FSQRT,FSIN,FCOS,FATAN,FSINH,FEXP,FLOG
	PUBLIC	RAND
;
;	ENTRY IDV - INVERSE FDIVIDE
;
;	STORAGE IN SCRATCH PAD
	SCRT:	DS	25
IDVT	EQU	SCRT + 00H
;
IDV:	PUSH	H
	CALL	FTEST	;FLOATING POINT ACCUMULATOR TO REGISTERS
	LXI	H,IDVT
	CALL	FSTOR	;FDIVISOR TO STORAGE
	POP	H
	CALL	FLOAD	;FDIVIDEND TO FLOATING POINT ACCUMULATOR
	LXI	H,IDVT
	JMP	FDIV	;RETURN THROUGH DIV ROUTINE
;
;
;
;	FLOATING POINT SQUARE ROOT ROUTINE BY NEWTONIAN ITERATION
;
;	THE SQUARE ROOT OF THE FABSOLUTE VALUE OF THE
;	CONTENTS OF THE FLOATING POINT ACCUMULATOR IS
;	RETURNED IN THE FLOATING POINT ACCUMULATOR.
;
;
;	STORAGE IN SCRATCH BANK
FSQRN	EQU	SCRT + 00H
FSQRX	EQU	SCRT + 04H
;
FSQRT:	CALL	FABS	;FORCE ARGUMENT POSITIVE, SET ZERO FLAG
	RZ		;RETURN ON ZERO
	LXI	H,FSQRN
	CALL	FSTOR
	ANA	A	;RESET CARRY BIT
	RAR		;HALVE THE EXPONENT
	ADI	40H	;RESTORE THE OFFSET
	LXI	H,FSQRX
	CALL	FSTOR
	MVI	D,5	;ITERATION COUNT
	PUSH	D	;STACKED
FSQRL:	LXI	H,FSQRN
	CALL	FLOAD
	LXI	H,FSQRX
	CALL	FDIV
	LXI	H,FSQRX
	CALL	FADD
	SUI	1	;HALVE THE RESULT
	LXI	H,FSQRX
	CALL	FSTOR
	POP	D	;RESTORE ITERATION COUNT
	DCR	D	;TALLY
	JZ	FSQRE	;EXIT WHEN COUNT EXHAUSTED
	PUSH	D	;SAVE IT OTHERWISE
	JMP	FSQRL	;TO NEXT ITERATION
FSQRE:	LXI	H,FSQRX	;RESULT TO ACCUMULATOR
	CALL	FLOAD
	RET
;
;	EVALUATION OF ELEMENTARY FUNCTION MACLAURIN SERIES
;
;
;	ENTRY FMACE FOR EXPONENTIAL TYPE SERIES, E.G.
;	SINH(Z) = Z/1 + Z^3/6 + Z^5/120 + ...
;		S(I-1) = (1. + X*S(I)/A(I)), S(N) = 1.
;
;	ENTRY FMACL FOR LOGARITHMIC TYPE SERIES, E.G.
;	ARCTAN(Z) = Z/1 - Z^3/3 + Z^5/5 - ...
;		S(I-1) = (1./A(I) + X*S(I)), S(N) = 0.
;
;	IN BOTH SERIES DEL^2(A(I)) MUST BE CONSTANT.
;	ENTER WITH X IN FMACX, A(N) IN D, D(A(N-1)) IN C,
;		D^2(A(1)) IN B.
;	RESULT IN FMACS, WHEN A(I) <= 0.
;
;	STORAGE IN SCRATCH BANK
FMACX	EQU	SCRT+00H
FMACS	EQU	SCRT+04H
FMACT	EQU	SCRT+08H
FMACG	EQU	SCRT+0CH
;
;	TWO SUBROUTINE LEVELS USED
;
FMACL:	XRA	A	;CLEAR A REGISTER FOR LOG TYPE SERIES
	LXI	H,FMACS	;POINT TO SIGMA
	MOV	M,A	;ZERO STORED
	LXI	H,FMACB	;PRESET BRANCH B
	JMP	FMACC	;JOINT CODE
FMACE:	LHLD	FONE	;MOVE 1.0 TO SIGMA FOR EXP TYPE SERIES
	SHLD	FMACS
	LHLD	FONE+2
	SHLD	FMACS+2
	LXI	H,FMACA	;PRESET BRANCH A
FMACC:	SHLD	FMACG	;STORE PRESET BRANCH
	MVI	E,32	;COUNT FOR THE FLOATING OF A(I)
FMACD:	PUSH	B	;CHAIN RULE LOOP
	PUSH	D	;SAVE A(I), D(A(I)), D^2(A(1))
	XRA	A	;ZERO THE LEAD POSITIONS OF A(I)
	MOV	B,A
	MOV	C,A
	CALL	FFLOAT	;FLOAT A(I)
	LXI	H,FMACT
	CALL	FSTOR
	LXI	H,FMACX
	CALL	FLOAD
	LXI	H,FMACS
	CALL	FMUL
	LHLD	FMACG	;CHOOSE THE BRANCH
	PCHL
FMACA:	LXI	H,FMACT
	CALL	FDIV
	LXI	H,FONE	;POINTS TO 1.0
	JMP	FMACF	;REJOIN COMMON CODE
FMACB:	LXI	H,FMACS
	CALL	FSTOR	;X*SIGMA
	LXI	H,FONE	;LOAD 1.0
	CALL	FLOAD
	LXI	H,FMACT
	CALL	FDIV	;1/A(I)
	LXI	H,FMACS
FMACF:	CALL	FADD
	LXI	H,FMACS
	CALL	FSTOR
	POP	D	;A(I) AND 32
	POP	B	;D(A) AND D^2(A)
	MOV	A,D
	SUB	C
	RZ	;DONE IF ZERO
	RC	;OR NEGATIVE
	MOV	D,A	;A(I-1)
	MOV	A,C	;D(A(I-1))
	SUB	B
	MOV	C,A	;D(A(I-2))
	JMP	FMACD	;NEXT ITERATION
FONE:	DB	81H,0,0,0	;CAN BE IN ROM
FPIV2:	DB	81H,49H,0FH,0DCH;PI/2
FLN2:	DB	80H,31H,72H,18H;LN 2
;
;
;	SINE-COSINE ROUTINE USING MACLAURIN SERIES
;
;
;	ENTRY FSIN FOR SIN(X)
;	ENTRY FCOS FOR COS(X)
;	ENTER WITH X IN RADIANS IN FLOATING POINT ACCUMULATOR
;	RETURNS WITH FUNCTION IN FLOATIG POINT ACCUMULATOR
;	(IF FABS(X) >= 2^24*PI, OVERFLOW FLAG IS SET)
;
;	STORAGE IN SCRATCH BANK
FSINX	EQU	SCRT+10H
;
;	THREE LEVELS OF SUBROUTINES USED
;
FCOS:	CALL	FCHS	;COMPLEMENT THE ANGLE
	LXI	H,FPIV2
	CALL	FADD
FSIN:	CALL	FTEST	;FETCH ARGUMENT
	LXI	H,FSINX
	CALL	FSTOR
	LXI	H,FPIV2	;REDUCE X TO REVOLUTIONS*4
	CALL	FDIV
	MVI	E,26	;REVOLUTIONS AT BINARY SCALE 24
	CALL	FFIX
	JC	OVERF	;QUIT IF ANGLE TO LARGE
	MVI	E,26
	MVI	D,0	;WIPE OUT FRACTIONAL REVOLUTIONS
	CALL	FFLOAT	;INTEGER PART OF REVOLUTIONS
	LXI	H,FPIV2	;TO RADIANS
	CALL	FMUL
	CALL	FCHS
FSINA:	LXI	H,FSINX
	CALL	FADD
	LXI	H,FSINX
	CALL	FSTOR
	CALL	FABS	;FORCE ANGLE INTO REDUCED RANGE
	LXI	H,FPIV2
	CALL	FSUB
	JM	FSINB	;IF NEGATIVE OR ZERO
	JZ	FSINB	;THEN ANDGLE IS REDUCED
	LXI	H,FPIV2	;FABS(X)-PI
	CALL	FSUB
	MOV	E,A	;SAVE A REGISTER
	LXI	H,FSINX+1
	MOV	A,M
	ANI	80H	;SIGN OF X
	XRI	80H	;INVERTED
	XRA	B	;-SIGN(X)*(FABS(X)-PI)
	MOV	B,A
	MOV	A,E	;RESTORE A REGISTER
	DCX	H	;POINT TO FSINX
	CALL	FSTOR	;REDUCED X
	CALL	FZERO	;CLEAR ACCUMULATOR
	JMP	FSINA	;REPEAT UNTIL FABS(X) <= PI/2
;
FSINB:	LXI	H,FSINX
	CALL	FLOAD
	LXI	H,FSINX
	CALL	FMUL
	CALL	FCHS	;-X^2
	LXI	H,FMACX
	CALL	FSTOR	;TO MACLAURIN SERIES
	MVI	D,72	;9*8, 11 TERM DISCARDED, 18 BITS PRECISION
	MVI	C,30	;9*8 - 7*6
	MVI	B,8	;(9*8 - 7*6) - (7*6 - 5*4)
	CALL	FMACE
	LXI	H,FMACS
	CALL	FLOAD
	LXI	H,FSINX
	CALL	FMUL
	CPI	81H	;SEE IF TAIL NEEDS CLEANING
	JC	FSINC	;NO, MAGNITUDE IS < 1.0
	LXI	H,ACC2
	XRA	A
	MOV	M,A
	INR	L
	MOV	M,A
FSINC:	CALL	FTEST	;RESTORE FLAGS AND REGISTERS FOR EXIT
	RET
;
;
;	ARCTAN ROUTINE USING MACLAURIN SERIES
;
;
;
;	ENTRY FATAN FOR ARCTAN(X), WITH X IN FLOATING POINT ACCUMULATOR
;	RESULT RETURNED IN FLOATING POINT ACCUMULATOR
;
;	STORAGE IN SCRATCH BANK
FATNT	EQU	SCRT+10H
FATNU	EQU	SCRT+14H
;
;	FOUR LEVELS OF STACK USED
;
FATAN:	CALL	FTEST	;GET F.P. ACC. INTO REGISTERS
	RZ
	CPI	81H	;TEST EXPONENT
	JC	FATN1	;RETURN TO CALLER FROM FATN1
	LXI	H,FONE	;1.0
	CALL	IDV	;1.0/X
	CALL	FATN1	;ARCTAN(1/X)
	LXI	H,FATNU
	CALL	FSTOR
	LXI	H,FPIV2	;PI/2
	CALL	FLOAD
	MOV	E,A	;SAVE A REGISTER
	LXI	H,FATNU+1	;SIGN(T)
	MOV	A,M	;TO A REGISTER
	ANI	80H
	ORA	B	;ATTACH TO PI/2
	MOV	B,A
	MOV	A,E	;RESTORE A REGISTER
	LXI	H,FATNT
	CALL	FSTOR
	LXI	H,FATNT
	CALL	FLOAD
	LXI	H,FATNU	;-SIGN(T)*(PI/S-FABS(T))
	CALL	FSUB	;=SIGN(T)*FABS(T) = T
	RET
;
;	EVALUATE ARCTAN OF ARGUMENTS < 1.0
FATN1:	LXI	H,FATNT	;POINT TO TEMP
	CALL	FSTOR	;TAN(T)
	LXI	H,FATNT
	CALL	FMUL	;TAN(T)^2
	LXI	H,FONE	;1.0
	CALL	FADD
	CALL	FSQRT
	LXI	H,FONE
	CALL	FADD	;1.0+SQRT(TAN(T)^2+1.0)
	LXI	H,FATNT
	CALL	IDV	;TAN(T/2)
	LXI	H,FATNT
	CALL	FSTOR
	LXI	H,FATNU
	INR	A	;2*TAN(T/2)
	CALL	FSTOR
	LXI	H,FATNT
	CALL	FMUL
	CALL	FCHS	;-TAN(T/2)^2
	LXI	H,FMACX
	CALL	FSTOR
	MVI	D,11	;TERM 13 DISCARDED, 16 BITS PRECISION IN RANGE
	MVI	C,2	;(11-9)
	MVI	B,0	;(11-9)-(9-7)
	CALL	FMACL
	LXI	H,FMACS
	CALL	FLOAD
	LXI	H,FATNU
	CALL	FMUL
	RET
;
;
;
;	HYPERBOLIC COSINE ROUTINE USING MACLAURIN SERIES
;
;
;
;	ENTRY FCOSH FOR COSH(X), WITH X IN THE FLOATING POINT ACCUMULATOR
;	THE RESULT IS RETURNED IN THE F.P. ACCUMULATOR.
;	IF FABS(X) > 88.0 THE OVERFLOW FLAG IS SET.
;
;	STORAGE IN SCRATCH BANK
FCSHD	EQU	SCRT+0EH	;DOUBLING COUNTER
;
;	THREE LEVELS OF STACK USED
;
FCOSH:	CALL	FTEST	;GET ARGUMENT INTO REGISTERS
	LXI	H,FMACX
	CALL	FSTOR
	LXI	H,FCSHD
	MVI	M,0
	SUI	80H	;REMOVE EXPONENT OFFSET
	JM	FCSHA	;DOUBLING COUNT AND X ARE OK
	CPI	8	;ELIMINATE OVERSIZE DOUBLING COUNT
	JP	OVERF	;RETURN THROUGH OVERFLOW ROUTINE
	MOV	M,A	;SAVE THE DOUBLING COUNT
	LXI	H,FMACX
	MVI	M,80H
	CALL	FLOAD	;PUT X INTO ACC
FCSHA:	LXI	H,FMACX
	CALL	FMUL	;X^2
	LXI	H,FMACX
	CALL	FSTOR
	MVI	D,56	;8*7, 10 TERM DISCARDED, 21 BITS PRECISION
	MVI	C,26	;(8*7-6*5)
	MVI	B,8	;(8*7-6*5) - (6*5-4*3)
	CALL	FMACE
FCSHB:	LXI	H,FCSHD	;ADDRESS THE DOUBLING COUNT
	DCR	M	;TALLY AT LOOP TOP
	JM	FCSHC	;DONE WHEN COUNT IS NEGATIVE
	LXI	H,FMACS	;FETCH COSH(X/2)
	CALL	FLOAD
	LXI	H,FMACS
	CALL	FMUL	;COSH(X/2)^2
	LXI	H,ACCE
	INR	M	;2*COSH(X/2)^2
	LXI	H,FONE	;-1.0
	CALL	FSUB	;=COSH(X)
	LXI	H,FMACS
	CALL	FSTOR
	JMP	FCSHB	;TEST DOUBLING COUNT
FCSHC:	CALL	FTEST	;RESTORE REGISTERS AND FLAGS
	RET
;
;
;
;	EXPONENTIAL AND HYPERBOLIC SIN ROUTINE
;
;
;	SCRATCH BANK STORAGE
FSNHD	EQU	SCRT+0EH
FEXOV	EQU	SCRT+0FH
FSNHX	EQU	SCRT+10H
;
;
;	ENTRY FEXP FOR EXP(X)
;	ENTRY SSINH FOR SINH(X)
;		ENTRY WITH X IN FP ACCUMULATOR
;		RETURNS WITH FUNCTION IN FP ACCUMULATOR.
;		IF FUNCTION EXCEEDS 2^127M OVERFLOW FLAG WILL BE SET
;
FSINH:	CALL	FTEST	;FETCH FP ACCUMULATOR
	LXI	H,FSNHX	;SAVE ARGUMENT
	CALL	FSTOR
	LXI	H,FSNHD	;ADDRESS DOUBLING COUNTER
	MVI	M,0
	SUI	80H	;REMOVE OFFSET FROM A
	JM	FSNHA	;DOUBLING COUNT AND X ARE OK
	CPI	8	;ELIMINATE OVERSIZE DOUBLING COUNT
	JP	OVERF	;RETURN THROUGH OVERFLOW ROUTINE
	MOV	M,A	;SAVE DOUBLING COUNT
	LXI	H,FSNHX	;BRING ARGUMENT INTO RANGE
	MVI	M,80H
	CALL	FLOAD	;PUT X INTO FLOATING ACCUMULATOR
FSNHA:	LXI	H,FSNHX
	CALL	FMUL	;X^2
	LXI	H,FMACX
	CALL	FSTOR
	MVI	D,42	;7*6, 9 TERM DISCARDED, 18 BITS PRECISION
	MVI	C,22	;7*6-5*4
	MVI	B,8	;(7*6-5*4)-(F*4-3*2)
	CALL	FMACE
	LXI	H,FMACS
	CALL	FLOAD
	LXI	H,FSNHX
	CALL	FMUL
	LXI	H,FSNHX	;SINH(X)
	CALL	FSTOR
	LXI	H,FSNHX	;SINH(X)^2
	CALL	FMUL
	LXI	H,FONE	;+1.0
	CALL	FADD
	CALL	FSQRT	;COSH(X) FOR DOUBLINE AND FOR EXP(X9
	LXI	H,FMACX	;TEMP
	CALL	FSTOR
FSNHB:	LXI	H,FSNHD	;ADDRESS DOUBLING COUNT
	DCR	M	;TALLY AT LOOP TOP
	JM	FSNHC	;DONE WHEN NEGATIVE
	LXI	H,FMACX	;COSH(X/2)
	CALL	FLOAD
	LXI	H,FSNHX	;SINH(X/2)
	CALL	FMUL
	INR	A	;2.*SINH(X/2)*COSH(X/2)
	LXI	H,FSNHX	;SINH(X)
	CALL	FSTOR
	LXI	H,FMACX	;COSH(X/2)
	CALL	FLOAD
	LXI	H,FMACX
	CALL	FMUL
	LXI	H,ACCE	;2.*COSH(X/2)^2
	INR	M
	LXI	H,FONE	;-1
	CALL	FSUB
	LXI	H,FMACX	;=COSH(X)
	CALL	FSTOR
	JMP	FSNHB	;TEST THE DOUBLING COUNT
FSNHC:	LXI	H,FSNHX
	CALL	FLOAD
	RET
FEXP:	CALL	FTEST
	JP	FEXPP
	LXI	H,OVER	;SAVE OVERFLOW FLAG
	MOV	E,M
	MVI	M,0
        LXI	H,FEXOV
	MOV	M,E	;OLD FLAG TO SAVE CELL
	CALL	FABS
	CALL	FEXPP	;EXP(-X) IN ACC
	LXI	H,FEXOV	;GET OLD OVERFLOW FLAG BACK
	MOV	E,M
	LXI	H,OVER	;PICK UP NEW ONE TO TEST
	MOV	A,M
	MOV	M,E	;RESTORE OLD OVERFLOW FLAG
	ANA	A	;SET FLAGS
	JNZ	FZERO	;RECIPROCAL OF OVERFLOW IS ZERO
	LXI	H,FONE
	CALL	IDV	;1./EXP(-X) = EXP(X)
	RET
FEXPP:	CALL	FSINH	;SINH(X)
	LXI	H,FMACX	;+COSH(X)
	CALL	FADD	;=EXP(X)
	RET
;
;
;
;	NATURAL LOGARITHM ROUTINE USING MACLAURIN SERIES
;
;
;
;
;	ENTRY POINTS IN MACLAURIN SERIES
;	STORAGE IN SCRATCH BANK
FLOGE	EQU	SCRT+0EH
FLOGX	EQU	SCRT+10H
;
;
;	ENTRY FLOG FOR LN(FABS(X)), WITH X IN F.P. ACCUMULATOR
;	RESULT IS RETURNED IN FLOATING POINT ACCUMULATOR
;	IF X = 0 THE OVERFLOW FLAG IS SET
;
;	3 LEVELS OF SUBROUTINES USED
;
FLOG:	CALL	FABS	;FORCE ARGUMENT POSITIVE, SET ZERO FLAG
	JZ	OVERF	;RETURN THROUGH OVERFLOW ROUTINE
	SUI	81H	;REMOVE EXPONENT OFFSET
	LXI	H,FLOGE
	MOV	M,A
	MVI	A,81H	;NORMALIZE ARGUMENT
	LXI	H,FLOGX
	CALL	FSTOR	;CALL IT X
	LXI	H,FLOGX
	CALL	FLOAD
	LXI	H,FONE
	CALL	FADD
	LXI	H,FMACS
	CALL	FSTOR	;X+1.0
	LXI	H,FLOGX
	CALL	FLOAD
	LXI	H,FONE
	CALL	FSUB	;X-1.0
	LXI	H,FMACS
	CALL	FDIV
	LXI	H,FLOGX
	CALL	FSTOR	;(X-1.0)/(X+1.0)
	LXI	H,FLOGX
	CALL	FMUL
	LXI	H,FMACX
	CALL	FSTOR	;((X-1.0)/(X+1.0))^2
	MVI	D,9	;DISCARD 11 TERM FOR 18 BITS PRECISION
	MVI	C,2	;9-7
	MVI	B,0	;(9-7)-(7-5)
	CALL	FMACL
	LXI	H,FMACS
	INR	M	;DOUBLE THE SUM
	CALL	FLOAD
	LXI	H,FLOGX
	CALL	FMUL	;LOGARITHM OF FRACTIONAL PART
	LXI	H,FLOGX
	CALL	FSTOR
	LXI	H,FLOGE
	MOV	A,M
	MVI	B,0
	MOV	C,B
	MOV	D,B
	MVI	E,8	;BINARY SCALE FACTOR FOR EXPONENT
	CALL	FFLOAT
	LXI	H,FLN2
	CALL	FMUL	;LOGARITHM OF 2^EXPONENT
	LXI	H,FLOGX	;LOG OF FRACTIONAL PART
	CALL	FADD
	RET
;
;	RANDOM NUMBER GENERATOR
;
;
RAND:	;COMPUTE NEXT RANDOM NUMBER, AND LEAVE AT SEED
	LXI	H,SEED
	MOV	C,M	;GET LEAST SIGNIFICANT BYTE
	INR	L
	MOV	B,M	;X(N) IN B,C
	DCR	L	;ADDRESS SEED FOR SBR2
	CALL	AROUT	;CALCUALTE X(N)*2053D
	LXI	H,CNST	;ADDRESS CONSTANT 13849
	CALL	SBR2
	LXI	H,SEED	;ADDRESS SEED AGAIN
	MOV	M,C	;STORE NEW SEED
	INR	L
	MOV	M,B
	RET		;WITH SEED SET TO RANDOM NUMBER
;
CNST:	DW	13849
;
AROUT:	;COMPUTE X(N)*2053D TO B,C
	MVI	D,9	;X(N)*2**9
	CALL	SBR1
	CALL	SBR2	;X(N)+X(N)*2**9
	MVI	D,2	;2**2*(X(N)+X(N)*2**9)
	CALL	SBR1
	CALL	SBR2	;ADD TO X(N)
	RET
;
SBR1:	;FORMS (B AND C)*2**D
	SUB	A	;CLEAR A AND CARRY
	MOV	A,C	;SHIFT C LEFT
	RAL
	MOV	C,A
	MOV	A,B	;SHIFT B LEFT
	RAL
	MOV	B,A
	DCR	D	;TEST D=0
	RZ		;IF YES, RETURN
	JMP	SBR1	;NO, SHIFT AGAIN
;
SBR2:	;16-BIT ADD OF B,C TO M(H,L), RESULT TO B,C
	SUB	A	;CLEAR A AND CARRY
	MOV	A,M	;LOAD LOW BYTE
	ADD	C	;M(H,L)+C
	MOV	C,A
	INR	L	;M(H,L+1)
	MOV	A,M
	ADC	B
	MOV	B,A
	DCR	L	;RESTORE H,L FOR NEXT OPERATION
	RET
	END