*
*
*
*
*             FLOATING POINT MATH FUNCTIONS
*
*
*                DE = # DE
*
*
*        FLOATING POINT EXPONENTIAL
*
*     XC = EXP(LOGE(XA)*XB)    XC=BC, XA=DE, XB=HL
*
FXPN LDAX D  TEST FOR ZERO XA
 ORA A
 JNZ FXP0  NOT ZERO
 DCX H  TEST XB FOR NEG
 MOV A,M
 ORA A
 JNZ NEG  0**(-N) = 1/(0**N) = ERROR
 JMP RFALSE  RETURN A ZERO
*
FXP0 MOV A,M  TEST FOR ZERO XB
 ORA A
 JZ RTRUE  RETURN A 1
*
 SHLD XB  SAVE ADDR OF XB
 XCHG
 SHLD XA  SAVE ADDR OF XA
 MOV H,B
 MOV L,C
 SHLD XC  SAVE ADDR OF XC
*
 LHLD XA
 XCHG .  HL TO DE
 CALL FLOG  XA:=LOGE(XA), WE ASSUME XA=XC (OR XA WILL BE...
*                             CLOBBERED)
*
 LHLD XC  GET ADDR XC
 MOV B,H  ADDR OF XC INTO BC
 MOV C,L
 XCHG .  HL TO DE
 LHLD XB  GET ADDR OF XB
 CALL FMUL  XC:=LOGE(XA)*XB
*
 LHLD XC  GET ADDR OF XC
 XCHG
 CALL FEXP  XC:=EXP(LOGE(XA)*XB)
 RET
*
*
*
*      THIS ROUTINE FORMS SIN(X) BY USING
*          SIN(X) = COS((PI/2)-X)
*
FSIN CALL REDUCE  MAKE ARGUMENT SMALL.
 PUSH D  SAVE FOR AFTER SUBTRACTION.
 MOV B,D  DE TO BC
 MOV C,E
 XCHG .  DE TO HL
 LXI D,PITWO+DIGI1
 CALL FSUB  PI/2-X
 POP D  RESTORE RESULT ADDRESS
 JMP FCOS1  SKIP PAST THE REDUCE IN COSINE.
*
*   THIS ROUTINE FORMS THE COSINE OF A FLOATING POINT
*   VALUE.
*
*  ENTRY PARAMETERS:
*  D,E - ARGUMENT ADDRESS
*  EXIT PARAMETERS
*  RESULT IN ADDRESS POINTED TO BY D,E ON ENTRY
*
FCOS CALL REDUCE  MAKE THE ARGUMENT REASONABLE.
FCOS1 PUSH D  SAVE RESULT ADDRESS
 LXI H,TWOPI+FPSIZ-1
 LXI B,FTEM1+FPSIZ-1
 CALL FDIV
 XRA A
 STA EXPTM-1
 LDA EXPTM
 CALL FRAC
 LXI D,EXPTM
 LXI H,HALF+DIGI1
 CALL FCOMP  COMPARE FRACTIONAL PART
 LXI B,EXPTM  Y=X/2*PI
 MOV L,C
 MOV H,B
 LXI D,CN14+DIGI1
 JC FCOS20
 XCHG
 LXI H,CN34+DIGI1
*
FCOS20 CALL FSUB
 LXI H,EXPTM
 MOV D,H
 MOV E,L
 LXI B,FTEMP+DIGI1
 CALL FMUL  FTEMP=ARGUMENT FOR POLYA
 LXI H,SINCO+DIGI1  COEFFICIENT ADDRESS
 CALL POLYA  EVALUATE POLYNOMICAL
 POP B  RESULT ADDRESS
 LXI D,FTEM2+DIGI1
 LXI H,FTEM1+DIGI1
 JMP FMUL  FORM COSINE AND RETURN
*
*
*  REDUCE A SINE OR COSINE ARGUMENT TO THE RANGE 0 <= X < 2PI
*  AND THEN DIVIDE IT BY 2*PI.
*  SINCE IT ALREADY WILL BE IN MOST CASES A CHECK IS MADE FIRST.
*    ARGUMENT IS IN DE AND IS RETURNED REDUCED IN DE.
*
REDUCE PUSH D  REMEMBER THE ARGUMENT ADDRESS.
 LXI H,TWOPI+FPSIZ-1  SEE IF ARGUMENT IS ALREADY IN RANGE.
 CALL FCOMP  THE COMPARE IGNORES THE SIGN.
 POP D  RESTORE ARGUMENT ADDRESS.
 RC .  IF ARGUMENT WAS < 2PI.
*
 PUSH D  SAVE THE ARGUMENT ADDRESS AGAIN.
 LXI B,FTEM1+FPSIZ-1  WHERE DIVISION RESULT GOES.
 LXI H,TWOPI+FPSIZ-1  DENOMINATOR.
 CALL FDIV  HOW MANY TIMES DOES 2PI GO INTO ARGUMENT?
*
 LXI D,FTEM1+FPSIZ-1  TAKE THE QUOTIENT
 CALL FINT  REMOVE THE FRACTION PART
*
 LXI D,FTEM1+FPSIZ-1  MULTIPLY THE INTEGER BY
 LXI H,TWOPI+FPSIZ-1  2*PI.
 LXI B,FTEM2+FPSIZ-1  PRODUCT ENDS UP HERE.
 CALL FMUL  THE RESULT IS <2PI LESS THAN THE ORIGINAL ARGUMENT.
*
 POP D  GET ARGUMENT ADDRESS BACK AGAIN.
 PUSH D  SAVE SO AS TO BE CORRECT FOR RETURN.
 LXI H,FTEM2+FPSIZ-1  SUBTRACT 2*PI*N FROM ARGUMENT.
 MOV B,D  PUT RESULT INTO ORIGINAL ARGUMENT.
 MOV C,E
 CALL FSUB  DIFFERENCE IS >=0 AND < 2*PI .
*
 POP D  WHERE THE MIRACLE OCCURED.
 RET
*
*
*      FORM FLOATING POINT EXPONENT EXP**X.
*
FEXP PUSH D  SAVE FINAL ADDRESS
 LXI B,FTEM1+DIGI1
 LXI H,CNL10+DIGI1  LOG10(E)
 CALL FMUL  X*LOG10(E)
*  GET N - INTEGER PART OF VALUE
 LXI H,EXPTM-1
 MOV A,M  GET SIGN
 MVI M,0  MAKE POSITIVE
 STA SSIGN  SAVE SIGN
 INX H
 MOV A,M  GET EXPONENT
 CPI 83H  CHECK RANGE
 JNC OVER  ARGUMENT OVERFLOW
 SUI 81H
 MVI E,0  SET INTEGER PART = 0
 JC FEXP20
 INR A
 MOV C,A
* FORM 10**N - MAKE INTEGER PART THE EXPONENT
 LDA FTEM1
 MOV B,A
 RAR
 RAR
 RAR
 RAR
*
FEXP10 ANI 0FH  THIS LOOP CONVERTS BCD TO BINARY (1,2 OR 3 DIGS)
 MOV D,A
 MOV A,E
 ADD A  *2
 ADD A  *4
 ADD E  *5
 ADD A  *10
 ADD D  + NEW DIGIT
 MOV E,A
 MOV A,B
 DCR C
 JNZ FEXP10
*
 LDA EXPTM  GET EXPONENT
 CALL FRAC  GET FRACTIONAL PART
*
FEXP20 MOV A,E
 ADI 81H  FORM FINAL EXPONENT
 STA SEXP  SAVE
* GET MULTIPLE OF .1
 LDA EXPTM  GET EXPONENT
 MVI B,0  SET .1 MULTIPLE = 0
 CPI 80H
 JC FEXP30  VALUE LESS THAN .1
 LXI H,FTEM1
 MOV A,M  GET FIRST DIGIT
 MOV B,A
 ANI 0FH  MAKE DIGIT = 0
 MOV M,A
*
FEXP30 MOV A,B
 STA SVAL  SAVE TENTH DIGIT
 CALL NORM  NORMALIZE VALUE
 MVI B,DIGI2
 LXI H,FTEM1
 LXI D,FTEMP
*
FEXP40 MOV A,M
 STAX D  PUT INTO FTEMP
 INX D
 INX H
 DCR B
 JNZ FEXP40
 LXI H,EXPCO+DIGI1  F(X) COEFFICIENTS
 CALL POLYA  FORM 10**Z
* LOOKUP VALUE OF 10**Y, Y=.1,.2,...,.9
 LDA SVAL  GET TENTHS DIGIT
 ANI 0F0H
 LXI H,CNTEN-1  VALUE TABLE
 LXI D,DIGIT+2
*
FEXP50 DAD D
 SUI 10H
 JNC FEXP50
* FORM FINAL VALUE
 LXI D,FTEM2+DIGI1
 POP B
 PUSH B
 CALL FMUL  (10**Z)*(10**Y)
* GET EXPONENT
 POP B
 LXI H,SEXP
 MOV A,M
 STAX B  PUT IN FINAL VALUE
 DCX H
 MOV A,M  GET SIGN
* CHECK SIGN
 ORA A
 RZ .  SIGN POSITIVE
* SIGN NEGATIVE FORM EXP(-X) = 1/EXP(X)
 LXI D,ONE+DIGI1 1.0
 MOV H,B
 MOV L,C
 JMP FDIV  DO MATH AND RETURN
*
* THIS ROUTINE FORMS THE TANGENT OF A FLOATING POINT
* VALUE. THE ARGUMENT IS IN RADIANS.
*
FTANG PUSH D  SAVE RESULT ADDRESS
 XCHG .  DE TO HL
 LXI D,FTMP1+DIGIT+1
 CALL VCOPY  ARG TO FTMP1
 LXI D,FTMP1+DIGIT+1
 CALL FCOS  TEMP = COS(ARG)
 POP D  GET RESULT ADDRESS
 PUSH D
 CALL FSIN  RESULT = SIN(ARG)
 POP B
 MOV D,B
 MOV E,C
 LXI H,FTMP1+DIGIT+1
 JMP FDIV  DIVIDE AND RETURN; RESULT=SIN(ARG)/COS(ARG)
*
*
* THIS ROUTINE FORMS THE ARCTANGENT OF A FLOATING POINT
* VALUE. THE ARGUMENT IS IN RADIANS.
*
FARCTAN PUSH D  SAVE ADDRESS
 DCX D
 LDAX D  GET SIGN
 STA SSIGN  SAVE SIGN
 XRA A
 STAX D  SET SIGN POSITIVE
* GET INTERVAL OF ARGUMENT
 LXI H,ATIN1+DIGI1
 POP D  GET ARGUMENT
 PUSH D
 MVI C,0  INTERVAL COUNT
 CALL FCOMP  CHECK IF IN THIS INTERVAL
 JC ARCT10
 LXI H,ATIN2+DIGI1  NEXT INTERVAL
 POP D
 PUSH D
 INR C  INCREMENT INTERVAL COUNT
 CALL FCOMP
 JC ARCT10
 LXI H,ATIN3+DIGI1  NEXT INTERVAL
 POP D
 PUSH D
 INR C
 CALL FCOMP  CHECK IF IN INTERVAL 3
 JC ARCT10
 INR C  INTERVAL 4
*
ARCT10 MOV A,C
 STA SEXP  SAVE INTERVAL COUNT
* FORM ADDRESS OF B(K)
 LXI H,BKCN-1
 LXI D,DIGI2
ARCT20 DAD D  FORM ADDRESS
 DCR C
 JP ARCT20
* FORM X=(Z-B(K))/(Z*B(K)+1)
 POP D  GET Z ADDRESS
 PUSH D  SAVE Z ADDRESS
 PUSH H  SAVE B(K) ADDRESS
 LXI B,FTEM2+DIGI1
 PUSH B
 CALL FMUL  Z*B(K)
 POP B
 MOV D,B
 MOV E,C
 LXI H,ONE+DIGI1  1.0
 CALL FADD  Z*B(K)+1
 POP H  B(K) ADDRESS
 POP D  Z ADDRESS
 PUSH D
 LXI B,FTEM1+DIGI1
 PUSH B
 CALL FSUB  Z-B(K)
 POP B FTEM1
 MOV D,B
 MOV E,C
 LXI H,FTEM2+DIGI1  Z*B(K)+1
 CALL FDIV  PUT X IN FTEM1
 LXI B,FTEMP+DIGI1
 LXI H,FTEM1+DIGI1
 MOV D,H
 MOV E,L
 CALL FMUL  X*X IN FTEMP
 LXI H,ATANCO+DIGI1  ATAN COEFFICIENTS
 CALL POLYA  EVALUATE POLYNOMINAL
 LXI B,FTEM2+DIGI1
 LXI D,FTEM1+DIGI1
 MOV H,B
 MOV L,C
 CALL FMUL  X*F(X)
* FORM INDEX AND GET A(K)
 LDA SEXP  GET INTERVAL COUNT
 LXI H,AKCN-1
 LXI D,DIGI2
ARCT30 DAD D  FORM ADDRESS
 DCR A
 JP ARCT30
* FOR A(K)+F(X)
 LXI D,FTEM2+DIGI1
 MOV B,D
 MOV C,E
 CALL FADD  A(K)+F(X)
* MAKE SURE SIGN IS RIGHT
 LDA SSIGN  GET ARGUMENT SIGN
 STA SIGN  SET RESULT SIGN
 JMP ADS2  STORE RESULT AND RETURN
*
*
* THIS ROUTINE FORMS THE COMMON LOGARITHM OF A FLOATING POI
* VALUE.
*
FLOG10 PUSH D  SAVE ARGUMENT ADDRESS
 CALL FLOG  FORM NATURAL LOG
 POP B GET  ARGUMENT ADDRESS
 LXI H,CN23+DIGI1  GET DIVISOR
 MOV D,B
 MOV E,C
 JMP FDIV  FORM COMMON LOG
*
*
* THIS ROUTINE FORMS THE NATURAL LOGARITHM OF A FLOATING
* POINT VALUE
*
FLOG PUSH D  SAVE ARGUMENT ADDRESS
 LDAX D  GET EXPONENT
 STA SEXP  SAVE
 ORA A
 JZ NEG  ARGUMENT = 0
 MVI A,80H
 STAX D  MAKE EXPONENT = 0
 DCX D
 LDAX D  GET SIGN
 ORA A
 JNZ NEG  ARGUMENT LESS THEN 0
 LXI H,-DIGIT
 DAD D  POINT TO FIRST DIGITS
 MOV A,M  GET DIGITS
 CPI 50H  CHECK IF F .GE. .50
 LXI H,LOGN1+DIGI1
 JNC FLO10
 LXI B,DIGI2+DIGI2
 LXI H,-3*DIGI2+LOGN-1
*
FLO05 DAD B  FORM ADDRESS OF N
 SUI 10H
 JNC FLO05
*
FLO10 SHLD SPNT  SAVE ADDRESS
 INX D
 LXI B,FTEM1+DIGI1
 CALL FMUL  F*N
* FORM LOG(F*N) = LOG(Z+A)
 LXI H,FTEM1
 MOV A,M  GET FIRST DIGITS
 MOV B,A
 ANI 0FH  FORM Z = F-A
 MOV M,A
* FORM A IN FTEM2
 LXI H,FTEM2
 MOV A,B
 ANI 0F0H
 STA SVAL  SAVE A
 MOV M,A  PUT IN FTEM2
 INX H
 MVI B,DIGIT
FLO15 MVI M,0  FILL WITH ZEROS
 DCR B
 INX H
 JNZ FLO15
 MVI M,80H  SET EXPONENT = 0
* NORMALIZE FTEM1 = Z
 CALL NORM
* FORM Y = Z/(2A+Z)
 LXI H,FTEM2+DIGI1  GET A
 MOV D,H
 MOV E,L
 MOV B,H
 MOV C,L
 PUSH B
 CALL FADD  FTEM2 = A+A
 POP B
 PUSH B  SAVE FTEM2
 MOV D,B
 MOV E,C
 LXI H,FTEM1+DIGI1 Z
 PUSH H  SAVE FTEM1
 CALL FADD  FTEM2 = 2A+Z
 POP B
 POP H
 MOV D,B
 MOV E,C
 PUSH B  SAVE FTEM1
 CALL FDIV  FTEM1 = Y
 POP D
 LXI B,FTEMP+DIGI1
 MOV H,D
 MOV L,E
 CALL FMUL  FTEMP = Y*Y
 LXI H,LOGCO+DIGI1  LOG COEFFICIENTS
 CALL POLYA  EVALUATE
 LXI H,FTEM2+DIGI1
 LXI D,FTEM1+DIGI1
 MOV B,H
 MOV C,L
 CALL FMUL  Y*F(Y)
* FORM LOG(A)
 LDA SVAL  GET A
 RRC
 RRC
 RRC
 RRC
 SUI 5  A .GE. .5
 LXI H,LOGEA-1  LOG TABLE
 LXI D,DIGI2
*
FLO20 DAD D  FORM ADDRESS OF LOG(A)
 DCR A
 JP FLO20
* FORM LOG(F) = LOG(A)+Y*F(Y)
 LXI D,FTEM2+DIGI1
 MOV B,D
 MOV C,E
 PUSH B  SAVE FTEM2
 CALL FADD
* FORM LOG(N) AND LOG(F)-LOG(N)
 LHLD SPNT  ADDRESS OF N
 LXI D,DIGI2
 DAD D  ADDRESS OF LOG(N)
 POP B  ACCUMULATED SUM
 MOV E,C
 MOV D,B
 CALL FSUB  LOG(F)-LOG(N)
*   FORM LOG(10**E) = 2.3025851*E
 LDA SEXP  GET EXPONENT
 MOV E,A
 RLC .  CHECK SIGN
 CMA
 ANI 1
 STA EXPTM-1  SET SIGN BIT
 JZ FLO25  POSITIVE EXPONENT
 MVI A,80H
 SUB E  NEGATIVE EXPONENT
 JMP FLO30
*
FLO25 MOV A,E
 SUI 80H
FLO30 MOV B,A
 INR B
 MVI A,99H  BCD -1
 MVI H,-1
*   CONVERT BINARY EXPONENT TO DECIMAL VALUE
FLO35 ADI 1
 DAA .   MAKE DECIMAL
 JNC FLO40
 INR H  GET HUNDREDS DIGIT
FLO40 DCR B
 JNZ FLO35
*   FORM EXPONENT OF E AND NORMALIZE
 MOV L,A  H,L CONTAIN VALUE
 MVI C,3  AT MOST 3 DIGITS
FLO50 DAD H  NORMALIZE
 DAD H
 DAD H
 DAD H
 MOV A,H
 CPI 10H  CHECK IF NORMALIZED
 JNC FLO55
 DCR C
 JNZ FLO50
 MVI C,80H  FORCE EXPONENT TO 0
*
FLO55 MOV A,C
 ADI 80H  FORM EXPONENT
 XCHG
 LXI H,FTEM1
 MOV M,D  PUT IN FIRST DIGITS
 INX H
 MOV M,E
 INX H
 MVI B,DIGIT-2
*
FLO60 MVI M,0  ZERO REST OF VALUE
 INX H
 DCR B
 JNZ FLO60
 INX H
 MOV M,A  PUT IN EXPONENT
*   FORM 2.302585*E
 LXI D,CN23+DIGI1
 MOV B,H
 MOV C,L
 PUSH B
 CALL FMUL  FTEM1 = VALUE
*   FORM LOG(X) = 2.3..LOG(E)+LOG(F)-LOG(N)
 POP D
 LXI H,FTEM2+DIGI1
 POP B  GET RESULT ADDRESS
 JMP FADD  ADD AND DONE
*
*
*
* CALCULATE POLYNOMIAL OF FORM A*X**I+A*X**(I-1)+...+A*X+A
*
*     ENTRY PARAMETERS:
*
*   H,L - COEFFICIENT LIST
*   FTEMP - X
*
*     EXIT PARAMETERS:
*
*   FTEMP1 - VALUE OF POLYNOMIAL
*
POLYA CALL POLY
 MOV D,B
 MOV E,C
 JMP FADD
*
* CALCULATE POLYNOMIAL OF FORM A*X**I+A*X**(I-1)+...+A*X
*
POLY LXI B,FTEM2+DIGI1  RESULT ADDRESS
 PUSH H
POLY10 PUSH B
 LXI D,FTEMP+DIGI1  X ADDRESS
 CALL FMUL
 POP B
 POP H
 LXI D,DIGI2+1
 DAD D  GET NEXT COEFFICIENT
 MOV A,M
 DCX H
 CPI 0FFH  END OF POLYNOMIAL
 RZ
 MOV D,B
 MOV E,C
 PUSH H
 PUSH B
 CALL FADD  FORM NEXT TERM
 POP B
 MOV H,B
 MOV L,C
 JMP POLY10
*
*
* THIS ROUTINE COMPARES TWO FLOATING POINT NUMBERS.
* ENTRY PARAMETERS
* D,E - FLOATING POINT VALUE
* H,L - FLOATING POINT VALUE
* EXIT PARAMETERS
* CARRY - C=1 IMPLIES (DE) .LT. (HL)
* CARRY - C=0 IMPLIES (DE) .GE. (HL)
*
FCOMP LDAX D  GET EXPONENT
 CMP M
 RNZ .  EXPONENTS NOT EQUAL
 MVI B,DIGIT
 DCX H  SKIP OVER THE SIGNS
 DCX D
*
FCOM10 DCX H
 DCX D
 LDAX D GET DIGITS
 SBB M
 DCR B
 JNZ FCOM10
 RET
*
*
*  THIS ROUTINE RETURNS THE FRACTIONAL PART OF A FLOATING
*  POINT VALUE
*
*      ENTRY PARAMETERS
*   FTEM1 - FLOATING POINT VALUE
*   A - VALUE EXPONENT
*
*      EXIT PARAMETERS
*   FTEM1 - FRACTIONAL PART OF VALUE
*
FRAC SUI 129
 RC .  ALREADY FRACTION
 MVI B,DIGIT+DIGIT
 CPI DIGIT+DIGIT  CHECK IF COMPLETE INTEGER
 JNC FRAC10
 INR A
 MOV B,A
*
FRAC10 LXI H,EXPTM  GET EXPONENT
 MOV A,M
 SUB B  FORM NEW EXPONENT
 MOV M,A  RESTORE EXPONENT
 MOV A,B
 RLC
 RLC
 MOV B,A
 CALL SHIFT  FORM FRACTIONAL PART AND FALL THROUGH TO NORM
*
*
*   THIS ROUTINE IS USED TO NORMALIZE A FLOATING POINT
*   VALUE.
*
*     ENTRY PARAMETERS
*   FTEM1 - FLOATING POINT VALUE TO NORMALIZE
*
*     EXIT PARAMETERS
*   FTEM1 - NORMALIZED VALUE
*
NORM LXI H,FTEM1  POINT TO VALUE
 LXI B,DIGIT
NORM10 MOV A,M  GET DIGITS
 ORA A  ARE THEY ZERO
 JNZ NORM20
 INX H
 INR B
 INR B
 DCR C
 JNZ NORM10
 XRA A  GET A ZERO
 STA EXPTM  SET VALUE TO ZERO
 RET
*
NORM20 CPI 10H
 JNC NORM30
 INR B
NORM30 LXI H,EXPTM
 MOV A,M  GET EXPONENT
 SUB B
 MOV M,A  ADJUST FOR NORMALIZATION
 MOV A,B
 RLC
 RLC
 MOV B,A  SHIFT COUNT
 JMP SHIFT
*
*
*
*
SHIF3 MOV B,A
 XRA A  GET A ZERO
SHIF4 MOV D,M
 MOV M,A
 MOV A,D
 DCX H
 DCR C
 JNZ SHIF4
*
*   THIS ROUTINE SHIFTS A FLOATING POINT VALUE
*   LEFT AND IS USED FOR NORMALAZATION.
*
*     ENTRY PARAMETERS
*   B - SHIFT COUNT - NUMBER OF DIGITS
*   FTEM1 - VALUE TO SHIFT
*
SHIFT MVI C,DIGI1
 LXI H,FTEM1+3  START OF VALUE
 MOV A,B
 SUI 8
 JNC SHIF3
 DCR B
 RM
 ORA A
SHIF2 MOV A,M
 RAL SHIFT
 MOV M,A
 DCX H
 DCR C
 JNZ SHIF2
 JMP SHIFT
*
*               ERROR EXIT
*
NEG STC .  ERROR
*
*
RETER INX SP
 INX SP
 JC OVER  PRINT "FP ERROR" IFF C=1
 RET
*
*
*
*  FLOATING POINT CONSTANTS FOR EXTENDED FUNCTIONS
*
 COPY BSM:CNT1/1
 COPY BSM:CNT2/1
*
*