mirror of
https://github.com/SEPPDROID/Digital-Research-Source-Code.git
synced 2025-10-22 07:54:25 +00:00
578 lines
12 KiB
Plaintext
578 lines
12 KiB
Plaintext
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
|