|
DataMuseum.dkPresents historical artifacts from the history of: CP/M |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about CP/M Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 86912 (0x15380)
Types: TextFile
Names: »D160«
└─⟦ae2411776⟧ Bits:30008864 Diskette med tekster der formodes at være 31-D-152…161
└─⟦this⟧ »D160«
******************************************
DMATHO.S
created 770801; last modified 791023
******************************************
H ADD AND SUBTRACT
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; FLOATING POINT REVERSE SUBTRACT ROUTINE
; NEGATE X AND ADD
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
RSUB LD A,(IX) ; GET MS BYTE OF X
XOR 80H ; NEGATE SIGN
LD D,A ; SAVE IT
LD E,(IY) ; GET MS BYTE OF Y
JP AD05
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; FLOATING POINT SUBTRACT ROUTINE
; NEGATE Y AND ADD
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
SUB LD A,(IY) ; GET MSBYTE OF Y
XOR 80H ; NEGATE SIGN
LD E,A ; SAVE IT
LD D,(IX) ; GET MSBYTE OF X
JP AD05
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; FLOATING POINT ADD ROUTINE
;
; INPUT: IX PTS TO 1ST ARG
; IY PTS TO 2ND ARG
; OUTPUT: IX PTS TO SUM (X IS REPLACED BY SUM, Y IS UNCHANGED)
; ERRORS: EXPONENT OVERFLOW AND UNDERFLOW
; SPECIAL CASES: ZERO ARGUMENT(S)
;
; INPUT FOR AD05: D CONTAINS MS BYTE OF X
; E CONTAINS MS BYTE OF Y
; ALGORITHM: ABSOLUTE VALUE MAGNITUDES ARE COMPARED,
; THE LARGER IS LOADED TO AC1, THE SMALLER TO AC2.
; AC2 IS SHIFTET TO ALIGN DECIMAL POINTS.
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
ADD LD D,(IX) ; GET MS BYTES
LD E,(IY)
;
; CHECK FOR ZERO ARGUMENTS
;
AD05 XOR A ; CLEAR A
CP (IX+7)
JP NZ,AD07 ; X IS NONZERO
CP (IY+7)
RET Z ; Y IS ALSO ZERO
LD A,E ; GET Y MSBYTE
PUSH IY
POP HL
CALL LD ; COPY TO X
LD (IX),A ; STORE MSBYTE
RET
\f
AD07 LD (IX),D ; STRE NEW SIGN IN CASE Y IS 0
CP (IY+7)
RET Z ; Y IS ZERO, RETURN X
;
; LOAD ARGUMENTS, LARGER MAGNITUDE IN AC1
;
PUSH DE ; SAVE MS BYTES
RES 7,D ; CLEAR SIGN BITS
RES 7,E
CALL CP1 ; COMPARE X TO Y IGNORING SIGN
JR C,AD10 ; X < Y
CALL STA1 ; X TO AC1
CALL STYA2 ; Y TO AC2
POP BC ; GET SIGNS
LD A,B
XOR C
LD A,B ; USE SIGN OF X FOR RESULT
JP AD15
AD10 CALL STYA1 ; Y TO AC1
CALL STA2 ; X TO AC2
POP BC ; GET SIGNS
LD A,C
XOR B
LD A,C ; USE SIGN OF Y FOR RESULT
;
; PRENORMALIZE BY SHIFTING AC2 RIGHT
;
AD15 EX AF,AF' ; SAVE RESULT SIGN, XOR FLAGS
LD A,(AC1E) ; GET AC1 EXPONENT
LD HL,AC2E
SUB (HL) ; CALC SHIFT COUNT
JR Z,AD30 ; FRACTIONS ALREADY ALIGNED
CP 13
JP NC,FSTO ; AC2 IS INSIGNIFICANT
LD B,A ; SET COUNTER
AD20 XOR A ; CLEAR A
LD HL,AC2 ; PT TO ACCUM
CALL SRD1 ; SHIFT RT 1 DIGIT
DJNZ AD20 ; COUNTER NOT 0
;
; INITIALIZE FOR ADD OR SUB
;
AD30 LD B,7 ; COUNTER
LD HL,AC20 ; POINTERS
LD DE,AC10
AND A ; CLEAR CY
EX AF,AF' ; GET SIGN & FLAGS
JP M,SB10 ; SIGNS WERE DIFFERENT
;
; ADD
;
EX AF,AF' ; SAVE SIGN OF RESULT
AD40 LD A,(DE)
ADC A,(HL)
DAA
LD (DE),A
DEC DE
DEC HL
DJNZ AD40
\f
;
; POST NORMALIZE, AT MOST 1 SHFT RIGHT
;
LD A,(AC1) ; CHECK FOR OVERFLOW
AND 0F0H
JP Z,FSTO ; ALREADY NORMALIZED
LD HL,AC1E
INC (HL) ; INCREMENT EXPONENT
JP Z,OVERA ; OVERFLOW
LD HL,AC1 ; PT TO ACCUM
CALL SRD1 ; SHIFT RIGHT
JP FSTO
;
; SUB
;
SB10 EX AF,AF' ; SAVE SIGN OF RESULT
SB20 LD A,(DE)
SBC A,(HL)
DAA
LD (DE),A
DEC DE
DEC HL
DJNZ SB20
;
; POST-NORMALIZE BY SHIFTING LEFT
;
LD A,(AC1E) ; PUT EXP IN C
LD C,A
LD HL,AC1
CALL NORML2 ; NORMALIZE FRACTION
JP Z,ZERO ; ZERO FRACTION RESULT
JP C,UNDER ; EXPONENT UNDERFLOW
LD A,C ; STORE EXP
LD (AC1E),A
JP FSTO
;
; COPY AC1 TO (IX) AND SET SIGN OF RESULT
;
FSTO LD HL,AC1 ; PT TO AC1
CALL LD
JP RSTO ; SET SIGN FROM A'
*H MULTIPLY
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; FLOATING POINT MULTIPLY ROUTINE
;
; INPUT: IX PTS TO MULTIPLICAND
; IY PTS TO MULTIPLIER
; OUTPUT: IX PTS TO PRODUCT (PRODUCT REPLACES X, Y IS UNCHANGED)
; ERRORS: EXPONENT OVERFLOW OR UNDERFLOW
; SPECIAL CASES: ARGUMENT(S) ZERO
; ALGORITHM: X, 2X, 4X, and 8X ARE STORED IN TEMPORARY REGS.
; Y IS PLACED IN AC1.
; MULTIPLIER IS EXAMINED BIT AT A TIME WITHIN EACH DIGIT,
; CORRESPONDING TEMP REGS ARE ADDED TO (IX), AND (IX)
; IS SHIFTED RIGHT.
;
; TIMING: APPROX 19814 (16916 IN LOOP)
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
\f
;
; CHECK FOR ZERO OPERANDS
;
MULT XOR A
CP (IX+7)
JP Z,ZERO
CP (IY+7)
JP Z,ZERO
;
; CALCULATE AND SAVE SIGN OF RESULT
;
LD A,(IX) ; MS BYTE OF X
XOR (IY)
EX AF,AF' ; SAVE IN A>
;
; STORE X, 2X, 4X, AND 8X IN TEMP REGISTERS
;
PUSH IX
POP DE
LD HL,6
ADD HL,DE
LD (SAVE),HL ; SAVE PTR TO LS BYTE
EX DE,HL
CALL MDTL
;
; SAVE Y IN AC1 (IN CASE X AND Y ARE SAME)
; CLEAR (IX)
;
CALL STYA1 ; STORE Y IN AC1
LD IY,AC1 ; PT TO Y
CALL ZERO ; CLEAR X
LD B,7 ; LOOP COUNTER
JP ML20 ; SKIP SHIFT OF AC1
;
; SHIFT PRODUCT RIGHT ONE DIGIT
; GET NEXT MULTIPLIER DIGIT
;
ML10 XOR A ; CLEAR A
CALL SRD ; SHFT (IX) RIGHT
CALL MLDIG ; MULTIPLY BY 2ND DIGIT
XOR A
CALL SRD ; SHFT (IX) RIGHT
ML20 LD C,(IY+6) ; GET 2 DIGITS
DEC IY ; DECR PTR
CALL MLDIG ; MULTIPLY BY 1ST DIGIT
DJNZ ML10 ; COUNTER NOT 0
;
; CHECK NORMALIZATION
;
DEC B ; DEFAULT SHIFT COUNT IS -1
LD A,(IX) ; GET MS BYTE
AND 0F0H
JR Z,ML60 ; ALREADY NORMALIZED
INC B ; SET SHIFT COUNT TO 0
XOR A
CALL SRD ; SHIFT 0 INTO (IX)
\f
;
; CALCULATE EXPONENT OF RESULT
;
ML60 LD A,(TEMPOE) ; EXP OF ORIGINAL X
SUB 80H ; REMOVE BIAS
LD C,A
LD A,(IY+14) ; EXP OF ORIGINAL Y
SUB 80H ; REMOVE BIAS
ADD A,C ; ADD TWO EXPONENTS
;
; CHECK EXPONENT CALCULATION FOR ERRORS
;
MCHK JP PO,M10 ; NO OVERFLOW
ADD A,B ; ADD SHIFT COUNT
JP PO,MERR ; NO SECOND OVERFLOW
JP M20
M10 ADD A,B ; ADD SHIFT COUNT
JP PE,MERR ; OVERFLOW
M20 ADD A,80H ; RESTORE BIAS
JP Z,UNDER ; UNDERFLOW
LD (IX+7),A ; STORE EXP
JP RSTO
*H DIVIDE
;
; RECIPROCAL
;
REC CALL STO4 ; SAVE X
LD HL,C1
CALL LD ; GET A 1
LD IY,TEMP4
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; FLOATING POINT DIVISION ROUTINE
;
; INPUT: IX PTS TO DIVIDEND
; IY PTS TO DIVISOR
; OUTPUT: IX PTS TO QUOTIENT (QUOT. REPLACES X, Y UNCHANGED)
; ERRORS: DIVISOR ZERO
; EXPONENT OVERFLOW OR UNDERFLOW
; SPECIAL CASES: DIVIDEND ZERO
; ALGORITHM: Y, 2Y,4Y,8Y ARE STORED IN TEMP. REGS.
; X IS PLACED IN AC1. AC1 IS COMPARED TO THE TEMP
; REGS. A BIT AT A TIME WITHIN EACH DIGIT, SUBTRACTING
; WHEN TEMP <= AC1. RESULT BITS ARE ACCUMULATED IN C,
; AND STORED A BYTE AT A TIME INTO (IX)
; TIMING: APPROX. 22938 (20108 LOOP)
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; CHECK FOR ZERO OPERANDS
;
DIVI XOR A
CP (IY+7)
JP Z,DIVO ; Y IS ZERO
CP (IX+7)
JP Z,ZERO ; X IS ZERO
;
; CALCULATE AND SAVE SIGN OF RESULT
;
LD A,(IX) ; MS BYTE OF X
XOR (IY)
EX AF,AF' ; SAVE IN A>
\f
;
; STORE Y, 2Y, 4Y, AND 8Y IN TEMP REGISTERS
;
PUSH IY
POP HL
CALL MDTL
;
; INITIALIZE AC1
;
PUSH IX ; SAVE IX
CALL STA1 ; STORE X IN AC1
LD BC,701H ; COUNTER IS 7, SHFT COUNT 1
PUSH BC ; SAVE COUNTERS
LD C,OFH ; INIT C
LD HL,TEMP0
CALL DVCP ; COMPARE X TO Y (FRACTIONS)
JR NC,DV30 ; X >= Y
POP BC
DEC C ; DECR SHIFT COUNT
PUSH BC
JP DV20 ; BEGIN WITH SHIFT DIGIT
;
; DIVIDE LOOP
;
DV10 PUSH BC ; SAVE COUNTERS
LD HL,AC1
XOR A
CALL SLD1 ; SHIFT AC1 LEFT 1 DIGIT
CALL DVDIG ; GET 1 DIGIT RESULT
DV20 LD HL,AC1
XOR A
CALL SLD1 ; SHIFT AC1 LEFT A DIGIT
DV30 CALL DVDIG ; GET 2ND DIGIT RESULT
LD A,C ; COMPL RESULT IN A
CPL ; TRUE RESULT
LD (IX),A ; STORE PAIR OF QUOTIENT DIGITS
INC IX
POP BC
DJNZ DV10 ; COUNTER NOT 0
;
; CALCULATE EXPONENT OF RESULT
;
LD B,C ; PUT SHIFT COUNT IN B
LD A,(TEMPOE) ; EXP OF ORIGINAL Y
SUB 80H
LD C,A ; SAVE UNBIASED EXP
LD A,(AC1E) ; EXP OF ORIGINAL X
SUB 80H ; REMOVE BIAS
SUB C ; SUB TWO EXPONENTS
POP IX ; RESTORE IX
JP MCHK ; CHECK FOR ERRORS
*H MULT, DIVI UTILITIES
;
; MLDIG MULTIPLY DIGIT
; INPUT: C CONTAINS DIGIT IN LOW 4 BITS
; (SAVE) IS PTR TO LS BYTE OF ACCUM
; OUTPUT: C IS ROTATED 4 BITS
; PRODUCT OF MPLICAND WITH DIGIT IS
; ADDED TO ACCUM
; TIMING 950
;
\f
MLDIG LD HL,TEMP00 ; PT TO MPLICAND
RR C
CALL C,MLADD ; ADD X
LD HL,TEMP10
RR C
CALL C,MLADD ; ADD 2X
LD HL,TEMP20
RR C
CALL C,MLADD ; ADD 4X
LD HL,TEMP30
RR C
CALL C,MLADD ; ADD 8X
RET
;
; MLADD ADD UTILITY FOR MULTIPLY
;
; INPUT: HL PTS TO NUMBER
; (SAVE) PTS TO LS BYTE OF ACCUM
; OUTPUT: 14 DIGIT NUMBER IS ADDED TO ACCUM
; TIMING 407
;
MLADD LD DE,(SAVE) ; PT TO LS BYTE
AND A ; CLEAR CY
PUSH BC ; SAVE BC
LD B,7 ; SET COUNTER
ML40 LD A,(DE)
ADC A,(HL)
DAA
LD (DE),A
DEC DE
DEC HL
DJNZ ML40
POP BC
RET
;
; RSTO PRODUCES SIGN OF RESULT
; INPUT: IX PTS TO RESULT
; A' BIT 7 IS SIGN BIT
; OUTPUT: IX PTS TO RESULT
; TIMING 74
;
RSTO LD A,(IX) ; GET MS BYTE
AND 0FH ; CLEAR UPPER DIGIT
LD B,A
EX AF,AF' ; GET NEW SIGN BIT
AND 80H
OR B
LD (IX),A ; REPLACE MS BYTE
RET
;
; DVDIG ROUTINE TO DIVIDE 1 DIGIT
; INPUT: AC1 IS CURRENT REMAINDER (DIVIDEND)
; TEMP REGS CONTAIN 1,2,4,8*DIVISOR
; OUTPUT: C CONTAINS QUOTIENT DIGIT IN LOW 4 BITS
; (C ROTATED LEFT)
; AC1 CONTAINS REMAINDER (< DIVISOR)
; TIMING 1162
;
\f
DVDIG LD HL,TEMP3 ; PT TO 8Y
CALL DVCP
JR C,DVD10 ; AC1 < 8Y
LD HL,TEMP30
CALL DVSUB ; 8Y <= AC1
DVD10 RL C ; COMPL RESULT BIT IN C
LD HL,TEMP2 ; PT TO 4Y
CALL DVCP
JR C,DVD20 ; AC1 < 4Y
LD HL,TEMP20
CALL DVSUB ; 4Y < AC1
DVD20 RL C ; COMPL RESULT BIT IN C
LD HL,TEMP1 ; PT TO 2Y
CALL DVCP
JR C,DVD30 ; AC1 < 2Y
LD HL,TEMP10
CALL DVSUB ; 2Y < AC1
DVD30 RL C ; COMPL RESULT BIT IN C
LD HL,TEMP0 ; PT TO Y
CALL DVCP ; COMPARE TO AC1
JR C,DVD40 ; AC1 < Y
LD HL,TEMP00
CALL DVSUB ; Y < AC1
DVD40 RL C ; COMPL RESULT BIT IN C
RET
;
; DVCP ROUTINE TO COMPARE (DE) TO AC1
; RETURNS CY SET IFF (DE) < AC1
; RETURNS Z SET IFF (DE) = AC1
; TIMING APPROX 42
;
DVCP LD DE,AC1 ; PT TO AC1
LD B,7 ; SET COUNTER
DVC10 LD A,(DE) ; GET BYTE
CP (HL)
RET NZ ; < OR >
INC HL ; INC PTRS
INC DE
DJNZ DVC10 ; COUNTER NOT 0
RET
;
; DVSUB ROUTINE TO SUBTRACT (DE) FROM AC1
; ASSUMES 14 DIGIT OPERANDS
; TIMING 376
;
DVSUB LD DE,AC10 ; PT TO ACCUM
AND A ; CLEAR CY
LD B,7
DV40 LD A,(DE)
SBC A,(HL)
DAA
LD (DE),A
DEC DE
DEC HL
DJNZ DV40
RET
;
; ROUTINE TO LOAD TEMP REGISTERS
; TIMING 2014
;
\f
MDTL LD DE,TEMP0 ; FIRST DEST
CALL MOV ; LOAD TEMP0
LD HL,TEMP0 ; PT TO SRC
RES 7,(HL) ; CLEAR SIGN BIT
LD B,3 ; SET COUNTER
;
; LOOP TO COPY TEMPN TO TEMPN+1 & SHFT LFT 1 BIT
;
MDTL1 LD A,B ; SAVE COUNTER
CALL MOV ; MOVE TO NEXT TEMP
LD B,A ; RESTORE COUNTER
AND A ; CLEAR CY
CALL SLB1 ; SHFT LEFT (HL ALREADY OK)
INC HL ; PT TO MSBYTE JUST SHIFTED
DJNZ MDTL1 ; COUNTER NOT 0
RET
;
; DETERMINE OVER OR UNDER
;
MERR JP P,UNDER ; UNDERFLOW
JP OVERA
;
; DIVISION BY ZERO ERROR
;
DIV0 LD HL,ERROR
SET 4,(HL)
JP INF
*H FIX
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; FIX CONVERTS FLOATING POINT NUMBER TO
; 16 BIT 2'S COMPLEMENT INTEGER
; (ROUNDING)
;
; INPUT: IX PTS TO FL PT NUMBER
; OUTPUT: IX PTS TO INTEGER
; ERRORS: OVERFLOW IF X > 32767 OR X < -32768
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
FIX LD IY,C _5
CALL ADD ; ADD .5
CALL FIXA ; CONVERT NUMBER
JR NC,FX10 ; NO OVERFLOW
LD HL,ERROR
SET 6,(HL) ; FLAG OVERFLOW
LD HL,7FFFH ; 32767
BIT 7,(IX)
JR Z,FX10 ; POSITIVE SIGN
LD HL,8000H ; -32768
FX10 LD (IX),L ; STORE INTEGER
LD (IX+1),H
RET
;
; MAIN CONVERSION FOR FIX
;
; RETURNS CY SET IF OVERFLOW
; RETURNS Z SET IF EXACT INTEGER
; HL IS LOW 16 BITS OF INT(X) FOR ALL X < 10 13
;
\f
FIXA XOR A
LD H,A ; CLEAR ACCUM
LD L,A
LD (SAVE),A ; CLEAR FLAG
;
; CALCULATE DIGITS LEFT AND RIGHT OF DECML PT
;
LD A,(IX+7) ; GET EXP
SUB 80H ; SUBTRACT BIAS
JR C,FXA100 ; X < .1
JR Z,FXA100 ; X < 1
LD B,A ; SAVE # LEFT DIGITS
LD A,13
SUB B
JR C,FXA90 ; X >= 10 13
LD C,A ; SAVE RIGHT DIGITS
;
; CONVERT LEFT DIGITS TO BINARY
;
PUSH IX ; SET POINTER
POP IY
LD A,(IY) ; GET FIRST BYTE
INC IY
JP FXA20
FXA10 CALL NZ,FXA110 ; OVERFLOW
LD A,(IY) ; GET NEXT TWO DIGITS
INC IY
PUSH AF ; SAVE THIS BYTE
RRA ; GET LEFT DIGIT
RRA
RRA
RRA
CALL MAD ; CONVERT LEFT DIGIT
DJNZ FXA15 ; COUNTER NOT 0
POP AF ; GET RIGHT DIGIT
AND OFH
JR FXA30
FXA15 CALL NZ,FXA110 ; OVERFLOW
POP AF ; GET SAVED BYTE
FXA20 CALL MAD ; CONVERT RIGHT DIGIT
DJNZ FXA10 ; COUNTER NOT 0
;
; CALCULATE OR OF ALL DIGITS TO RIGHT OF DECML PT
;
XOR A ; INITIALIZE A
FXA30 LD B,C ; USE OTHER COUNTER
SRL B ; DIVIDE BY 2
JR Z,FXA50 ; COUNT IS 0
FXA40 OR (IY) ; OR 2 DIGITS
INC IY
DJNZ FXA40 ; COUNTER NOT 0
;
; CONVERT TO 2'S COMPLEMENT
;
FXA50 BIT 7,(IX)
JR Z,FXA80 ; POSITIVE SIGN
EX DE,HL
LD HL,0
AND A
JR Z,FXA60 ; EXACT INTEGER
INC DE ; CORRECT MAGNITUDE
\f
FXA60 SBC HL,DE ; SUBTRACT FROM 0
JP P,FXA90 ; OVERFLOW
FXA70 AND A ; SET Z OR NZ
LD A,(SAVE) ; GET FLAG
RLA ; PUT IN CY
RET
FXA80 BIT 7,H
JR Z,FXA70 ; NO OVERFLOW
FXA90 AND A ; SET Z OR NZ
SCF ; SET CY
RET
FXA100 LD A,(IX+7) ; A IS 0 IFF FRACTION 0
JP FXA50
FXA110 LD A,(SAVE) ; GET FLAG
OR 80H ; TURN IT ON
LD (SAVE),A
RET
;
; MAD ROUTINE TO MULTIPLY ACCUM BY 10 AND ADD NEW DIGIT
;
MAD LD D,H ; SAVE COPY OF HL
LD E,L
ADD HL,HL ; SHIFT LEFT 2
ADD HL,HL
ADD HL,DE ; ADD COPY
ADD HL,HL ; SHIFT LEFT 1
AND 0FH ; PUT NEW DIGIT IN DE
LD E,A
LD D,0
ADD HL,DE ; ADD NEW DIGIT
LD A,H ; TEST HIGH BITS
AND 0F0H
RET
*H FLOAT
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; FLOAT CONVERTS 16 BIT 2'S COMPLEMENT INTEGER TO
; FLOATING POINT FORMAT
; (FLOAT1 ASSUMES INPUT IS IN HL)
;
; INPUT: IX PTS TO 16 BIT INTEGER
; OUTPUT: IX PTS TO FLOATING PT NUMBER
; ERRORS: NONE
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; TEST INPUT
;
FLOAT LD L,(IX) ; LOAD 16 BIT INTEGER
LD H,(IX+1)
FLOAT1 PUSH HL ; SAVE INTEGER
CALL ZERO ; CLEAR OUTPUT AREA
POP HL
LD A,H ; TEST FOR ZERO
OR L
RET Z ; INPUT WAS ZERO
;
; CONVERT TO SIGN MAGNITUDE, SIGN IN A'
;
LD A,H ; GET SIGN BIT
AND 80H
JR Z,FL10 ; POSITIVE
\f
EX DE,HL
LD HL,0
SBC HL,DE ; NEGATE
;
; CONVERT BINARY TO DECIMAL
;
FL10 EX AF,AF' ; SAVE SIGN BIT
EX DE,HL ; SAVE ACCUM
PUSH IX
POP HL ; PT TO OUTPUT AREA
LD BC,10000
CALL FLDIV ; DIVIDE BY 10000
INC HL ; ADVANCE OUTPUT PTR
LD BC,1000
CALL FLDIV ; DIVIDE BY 1000
LD BC,100
CALL FLDIV ; DIVIDE BY 100
INC HL ; ADVANCE OUTPUT PTR
LD BC,10
CALL FLDIV ; DIVIDE BY 10
LD A,E ; GET REMAINDER
RLD ; ROT INTO OUTPUT
;
; NORMALIZE RESULT, STORE SIGN
;
LD C,85H ; EXPONENT
CALL NORML1
JP RSTO ; STORE SIGN
;
; ROUTINE TO DIVIDE DE BY BC
; 4 BIT QUOTIENT IS ROTATED INTO (HL)
;
FLDIV EX DE,HL ; PUT ACCUM IN HL
XOR A ; CLEAR A, CY
DEC A ; INITIALLY A IS -1
FLDIV1 SBC HL,BC ; SUBTRACT DIVISOR
INC A ; INCR QUOTIENT
JR NC,FLDIV1 ; RESULT NOT NEGATIVE
ADD HL,BC ; RESTORE REMAINDER
EX DE,HL ; SAVE ACCUM, GET PTR
RLD ; STORE QUOTIENT
RET
*H CP
;
; CP FLOATING POINT COMPARE ROUTINE
;
; RETURNS CY SET IF X < Y
; RETURNS Z SET IF X = Y
; CP1 ASSUMES MS BYTES FOR X,Y IN D,E
;
CP LD D,(IX) ; LOAD MS BYTES
LD E,(IY)
CP1 LD A,D ; GET SIGN OF X
AND 80H ; (CY IS OFF)
JR NZ,CP10 ; X IS NEGATIVE
BIT 7,E
RET NZ ; Y IS NEGATIVE
;
; X AND Y ARE BOTH POSITIVE, COMPARE EXPONENTS
;
\f
LD A,(IX+7)
CP (IY+7)
RET NZ ; EXP'S NOT =
;
; COMPARE X FRACTION TO Y FRACTION
;
LD A,D ; MS BYTE
CP E ; (SIGNS ARE EQUAL)
RET NZ
PUSH IX ; SET UP PTRS
PUSH IY
JR CP20
;
; X IS NEGATIVE, CHECK SIGN OF Y
;
CP10 XOR E ; TEST SIGN, SET NZ
RLA ; SIGN BIT IN CY
RET C ; Y WAS POSITIVE
;
; BOTH SIGNS NEGATIVE, TEST EXPONENTS
;
LD A,(IY+7)
CP (IX+7)
RET NZ
;
; COMPARE Y FRACTION TO X FRACTION
;
LD A,E
CP D
RET NZ
PUSH IY ; SET UP PTRS
PUSH IX
;
; LOOP TO COMPARE 6 FRACTION BYTES
;
CP20 POP HL ; GET PTRS
POP DE
INC HL
INC DE
LD B,6 ; COUNTER
CP30 LD A,(DE)
CP (HL)
RET NZ
INC HL
INC DE
DJNZ CP30
RET
*H NORMALIZE
;
; NORMLZ NORMALIZES AN ACCUM BY SHIFTING LEFT
;
; INPUT: IX PTS TO ACCUM (NORMLZ,NORML1)
; HL PTS TO ACCUM (NORML2)
; C CONTAINS BIASED EXP (NORML1,NORML2)
; OUTPUT: NORMAL RETURN - NZ & NC
; ZERO FRACTION - Z & NC
; EXP UNDERFLOW - NZ & C
; C CONTAINS UPDATED EXPONENT
; (IX+7) CONTAINS UPDATED EXPONENT C UNDER C
;
\f
NORMLZ LD C,(IX+7) ; GET EXPONENT
NORML1 PUSH IX ; PT TO ACCUM
POP HL
NORML2 LD A,(HL) ; GET MS BYTE
AND A
JR NZ,NOR15 ; ALREADY NORMALIZED
LD B,12 ; MAX COUNT
XOR A ; CLEAR A
NOR10 DEC C ; DECR EXPONENT
JR Z,NOR20 ; UNDERFLOW
CALL SLD1 ; SHIFT LEFT
INC HL ; PT TO 1ST BYTE
LD A,(HL) ; GET MS BYTE
AND A
JR NZ,NOR15 ; NORMALIZED
DJNZ NOR10 ; COUNTER NOT 0
NOR15 LD (IX+7),C ; STORE EXPONENT
RET
;
; UNDERFLOW. HL PTS TO MS BYTE, A CONTAINS MS BYTE
;
NOR20 INC B ; CALC BYTES LEFT
SRL B
NOR30 INC HL ; ADVANCE PTR
OR (HL) ; COLLECT REMAINING BITS
DJNZ NOR30 ; COUNT NOT 0
RET Z ; FRACTION WAS ZERO
SCF
RET ; (UNDERFLOW)
*H HALF
;
; HALF DIVIDES A FLOATING POINT NUMBER BY 2
; INPUT MUST BE POSITIVE (0 IN SIGN DIGIT)
;
; INPUT: IX PTS TO X (HALF)
; OUTPUT: INPUT REPLACED BY X/2
; FLAGS SET ACCORDING TO NORMLZ
;
HALF AND A ; CLEAR CY
CALL SRB ; DIVIDE FRACTION BY 2
CALL NORMLZ ; NORMALIZE RESULT
RET
*H SHIFT UTILITIES
;
; SLD SHIFT LEFT DIGIT
;
; INPUT: IX PTS TO ACCUM (SLD)
; HL PTS TO ACCUM (SLD1)
; A CONTAINS DIGIT TO SHIFT IN
; OUTPUT: A CONTAINS DIGIT SHIFTED OUT
; HL PTS TO 1 LESS THAN MS BYTE
;
SLD PUSH IX ; SET PTR TO ACCUM
POP HL
SLD1 PUSH BC ; SAVE BC
LD BC,6
ADD HL,BC ; PT TO RIGHT END
LD B,7 ; LOOP COUNTER
SLD10 RLD ; ROT LEFT
\f
DEC HL ; PT TO NEXT BYTE
DJNZ SLD10 ; COUNTER NOT 0
POP BC ; RESTORE BC
RET
;
; SRD SHIFT RIGHT DIGIT
;
; INPUT: IX PTS TO ACCUM (SRD)
; HL PTS TO ACCUM (SRD1)
; A CONTAINS DIGIT TO SHIFT IN
; OUTPUT: A CONTAINS DIGIT SHIFTED OUT
; HL PTS TO 1 MORE THAN LS BYTE
;
SRD PUSH IX ; SET PTR TO ACCUM
POP HL
SRD1 PUSH BC ; SAVE BC
LD B,7 ; COUNTER
SRD10 RRD ; ROT RIGHT
INC HL
DJNZ SRD10 ; COUNTER NOT 0
POP BC ; RESTORE RC
RET
;
; SLB SHIFT LEFT BIT
;
; INPUT: IX PTS TO ACCUM (SLB)
; HL PTS TO ACCUM (SLB1)
; CY CONTAINS BIT TO SHIFT IN
; OUTPUT: CY CONTAINS BIT SHIFTED OUT
; HL PTS TO 1 LESS THAN MS BYTE
;
SLB PUSH IX ; SET PTR TO ACCUM
POP HL
SLB1 PUSH BC ; SAVE BC
LD BC,6
ADD HL,BC ; PT TO RIGHT END
LD B,7 ; LOOP COUNTER
SLB10 LD A,(HL) ; GET BYTE
ADC A,A ; SHIFT LEFT
DAA
LD (HL),A ; REPLACE
DEC HL ; PT TO NEXT BYTE
DJNZ SLB10 ; COUNTER NOT 0
POP BC ; RESTORE BC
RET
;
; SRB SHIFT RIGHT BIT
;
; INPUT: IX PTS TO ACCUM (SRB)
; HL PTS TO ACCUM (SRB1)
; CY CONTAINS BIT TO SHIFT IN
; OUTPUT: CY CONTAINS BIT SHIFTED OUT
; HL PTS TO 1 MORE THAN LS BYTE
;
SRB PUSH IX ; SET PTR TO ACCUM
POP HL
SRB1 PUSH BC ; SAVE BC
LD B,7 ; COUNTER
SRB10 LD A,(HL) ; GET BYTE
RRA ; SHIFT
\f
RR C ; SAVE CY IN C
BIT 7,A
JR Z,SRB20 ; 0 SHIFTED INTO UPPER
SUB 30H ; CORRECTION
SRB20 BIT 3,A
JR Z,SRB30 ; 0 SHIFTED INTO LOWER
SUB 3 ; CORRECTION
SRB30 RL C ; GET CY
LD (HL),A ; STORE BYTE
INC HL
DJNZ SRB10 ; COUNTER NOT 0
POP BC ; RESTORE BC
RET
*H MOVE UTILITIES
;
; MOVE ROUTINES
;
STO4 LD DE,TEMP4
JP STO
STO5 LD DE,TEM5
JP STO
STO6 LD DE,TEM6
STO PUSH IX
POP HL ; SET SRC PTR
MOV LD BC,8
LDIR
RET
LD PUSH IX
POP DE ; SET DEST PTR
JP MOV
;
; SPECIALIZED LOAD ROUTINES, LOAD AC1 AND AC2 WITH ABS VALUE
;
STA1 PUSH IX ; SOURCE WILL BE (IX)
JR ST1
STA2 PUSH IX ; SOURCE WILL BE (IX)
JR ST2
STYA1 PUSH IY ; SOURCE WILL BE (IY)
ST1 POP HL
MV1 LD DE,AC1 ; DEST IS AC1
CALL MOV
LD HL,AC1
LD D,(HL) ; SAVE MS BYTE IN D
RES 7,(HL) ; CLEAR SIGN BIT
RET
STYA2 PUSH IY ; SOURCE WILL BE (IY)
ST2 POP HL
MV2 LD DE,AC2 ; DEST IS AC2
CALL MOV
LD HL,AC2
LD E,(HL) ; SAVE MS BYTE IN E
RES 7,(HL) ; CLEAR SIGN BIT
RET
*H BOOLEAN
;
; LOGICAL OPERATORS
;
IOR LD A,(IX)
OR (IX+1)
OR (IY)
OR (IY+1)
JP INE1
\f
IAND LD A,(IX)
OR (IX+1)
JP Z,IZERO ; X IS ZERO
LD A,(IY)
OR (IY+1)
JP INE1
INOT LD A,(IX)
OR (IX+1)
JR IEQ1
OR LD A,(IX+7)
OR (IY+7)
JP NE1
AND LD A,(IX+7)
AND A
JP Z,ZERO ; X IS ZERO
LD A,(IY+7)
AND A
JR NE1
NOT LD A,(IX+7)
AND A
JR EQ1
;
; RELATIONAL OPERATORS
;
SGT CALL SCP
JR IGT1
SLE CALL SCP
JR ILE1
SLT CALL SCP
JR ILT1
SGE CALL SCP
JR IGE1
SEQ CALL SCP
JR IEQ1
SNE CALL SCP
JR INE1
IGT CALL ICP
IGT1 JR Z,IZERO
JR C,IZERO
JR IONE
ILE CALL ICP
ILE1 JR Z,IONE
JR C,IONE
JR IZERO
ILT CALL ICP
ILT1 JR C,IONE
JR IZERO
IGE CALL ICP
IGE1 JR C,IZERO
JR IONE
IEQ CALL ICP
IEQ1 JR Z,IONE
JR IZERO
INE CALL ICP
INE1 JR Z,IZERO
JR IONE
GT CALL CP
GT1 JR Z,ZERO
JR C,ZERO
JR ONE
\f
LE CALL CP
LE1 JR Z,ONE
JR C,ONE
JR ZERO
LT CALL CP
LT1 JR C,ONE
JR ZERO
GE CALL CP
GE1 JR C,ZERO
JR ONE
EQ CALL CP
EQ1 JR Z,ONE
JR ZERO
NE CALL CP
NE1 JR Z,ZERO
JR ONE
*H CONSTANT FUNCTIONS
;
; PRODUCE UNITY RESULT
;
IONE LD (IX),1
DD (IX+1),0
RET
ONE LD B,7
CALL ZERO1
LD (HL),81H
LD (IX),1
RET
;
; PRODUCE ZERO RESULT
;
IZERO LD (IX),0
LD (IX+1),0
RET
ZERO LD B,8
ZERO1 PUSH IX ; PT TO RESULT
POP HL
ZER10 LD (HL),0
INC HL
DJNZ ZER10
RET
;
; PRODUCE INFINITE RESULT
;
INF PUSH IX ; SET PTR
POP HL
RL (HL) ; GET OLD SIGN
LD (HL),18
RR (HL) ; REPLACE SIGN
INC HL
LD A,99H
LD B,6
INF10 LD (HL),A
INC HL
DJNZ INF10
LD (HL),0FFH ; HIGHEST EXP
RET
;
; FLAG OVERFLOW ERROR, STORE INFINITY
;
\f
OVERA EX AF,AF' ; GET SIGN OF RESULT
LD (IX),A ; STORE IT
OVER LD HL,ERROR
SET 6,(HL) ; FLAG OVERFLOW
JP INF
;
; FLAG UNDERFLOW ERROR, STORE ZERO
;
UNDER LD HL,ERROR
SET 5,(HL) ; FLAG UNDERFLOW
JP ZERO
*H CONSTANTS AND WORK AREAS
C1 DEFW 1
DEFW 0
DEFW 0
DEFW 8100H
C0 DEFW 0
DEFW 0
DEFW 0
DEFW 0
C _5 DEFW 5 ; .5
DEFW 0
DEFW 0
DEFW 8000H
SEED DEFW 0 ; 0
DEFW 0
DEFW 0
DEFW 0
SEED10 EQU SEED+6
CRNDA DEFW 1403H ; 31415 92653 581
DEFW 9215H
DEFW 3565H
DEFW 8081H
CRNDC DEFW 7102H ; 27182 81828 459
DEFW 8182H
DEFW 8482H
DEFW 8059H
CRNDCO EQU CRNDC+6
SAVE DEFS 2
AC1 DEFS 8
AC10 EQU AC1+6
AC1E EQU AC1+7 ; EXPONENT BYTE
AC2 DEFS 8
AC20 EQU AC2+6
AC2E EQU AC2+7 ; EXPONENT BYTE
TEMP0 DEFS 8
TEMP00 EQU TEMP0+6
TEMP0E EQU TEMP0+7
TEMP1 DEFS 8
TEMP10 EQU TEMP1+6
TEMP2 DEFS 8
TEMP20 EQU TEMP2+6
TEMP3 DEFS 8
TEMP30 EQU TEMP3+6
TEMP4 DEFS 8
TEMP5 DEFS 8
TEMP6 DEFS 8
\f
;
; REFERENCES
;
EXTERNAL ERROR,ICP,SCP
GLOBAL ADD,SUB,RSUB,MULT,REC,DIVI
GLOBAL MLDIG,MDTL
GLOBAL FIX,FIXA,FLOAT,FLOAT1,CP,MAD
GLOBAL GT,LE,LT,GE,EQ,NE,OR,AND,NOT
GLOBAL IGT,ILE,ILT,IGE,IEQ,INE,IOR,IAND,INOT
GLOBAL SGT,SLE,SLT,SGE,SEQ,SNE
GLOBAL SEED,SEED10,CRNDA,CRNDC0,C _5,SAVE,C1,C0
GLOBAL OVER,UNDER,ZERO,ONE,INF
GLOBAL NORMLZ,NORML1,NORML2,SLD,SRB,HALF
GLOBAL STO4,STO5,STO6,STO,LD,SRD
GLOBAL TEMP4,TEMP5,TEMP6,AC1,AC10,AC2,AC20
\f
******************************************
DMATH2.S
created 770801; last modified 791023
******************************************
*H POWER
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; X TO THE Y POWER
;
; INPUT: IX PTS TO X
; IY PTS TO Y
; OUTPUT: IX PTS TO X Y
; ERRORS: NONE DIRECTLY
; SPECIAL CASES: IF Y IS 0, RETURN 1
; ALGORITHM: IF Y IS AN EXACT INTEGER -32768 <= Y < 32768
; THEN USE A SEQUENCE OF SQUARING AND
; MULTIPLYING BY X TO PRODUCE RESULT
; OTHERWISE, RESULT IS EXP(Y*LOG(X))
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; DETERMINE IF Y IS AN INTEGER
;
POW PUSH IY ; SAVE PTR TO Y
PUSH IX ; SAVE PTR TO X
PUSH IY ; PT TO Y
POP IX
CALL FIXA ; CONVERT TO INTEGER
POP IX ; RESTORE IX
JR Z,POW10 ; Y WAS AN INTEGER
;
; FOR NONINTEGER Y, TAKE EXP(Y*LOG(X))
;
CALL LOG ; LOG OF X
POP IY ; RESTORE IY
CALL MULT ; MPY BY Y
CALL EXP ; EXP OF PRODUCT
RET
;
; Y IS INTEGER, SET UP FOR LOOP, GET MAGNITUDE
;
POW10 XOR A ; CHECK FOR 0
POP IY ; RESTORE IY
CP (IY+7)
JP Z,ONE ; X TO 0 POWER
PUSH HL ; SAVE Y
BIT 7,H
JR Z,POW15 ; Y IS POSITIVE
EX DE,HL ; NEGATE Y
LD HL,0
AND A
SBC HL,DE
EX (SP),HL ; SAVE NEGATED Y INSTEAD
CALL REC ; CALC 1/X
POW15 CALL ST04 ; SAVE COPY OF X
POP HL ; GET Y
LD B,16 ; SET COUNTER
\f
;
; LOOK FOR FIRST BIT
;
POW20 PUSH BC ; SAVE COUNTER
ADD HL,HL ; SHIFT Y LEFT 1
JR C,POW40 ; 1 BIT FOUND
POP BC ; GET COUNTER
DJNZ POW20 ; COUNTER NOT 0
JP ONE ; THIS JUMP SHOULD NOT HAPPEN
;
; SQUARE FOR EACH ZERO BIT
; SQUARE AND MULTIPLY FOR EACH 1 BIT
;
POW30 PUSH BC ; SAVE COUNTER
ADD HL,HL ; SHIFT Y LEFT 1
PUSH HL ; SAVE Y
PUSH AF ; SAVE CY
CALL STO5 ; SAVE COPY OF ACCUM
LD IY,TEM5
CALL MULT ; SQUARE X
POP AF ; GET CY
JR NC,POW35 ; WAS A 0 BIT
CALL MULT4 ; MPY BY X
POW35 POP HL ; GET Y
POW40 POP BC ; GET COUNTER
DJNZ POW30 ; COUNTER NOT 0
RET
;
; IPOW POWERS FOR INTEGER ARGUMENTS
; USES REAL POW ROUTINE BY FLOATING ARGS
; IN TEMP5, TEMP6, (UNUSED BY POW WHEN Y
; IS INTEGER), CALLING POW, AND FIXING RESULT
;
IPOW PUSH IX ; SAVE ORIGINAL PTR
LD L,(IY) ; GET Y
LD H,(IY+1)
LD IX,TEMP6
CALL FLOAT1 ; FLOAT Y IN TEMP6
POP IX ; GET ORIGINAL PTR
PUSH IX
LD L,(IX) ; GET X
LD H,(IX+1)
LD IX,TEMP5
CALL FLOAT1 ; FLOAT X IN TEMP5
LD IY,TEMP6 ; PT TO Y
CALL POW ; CALL REAL ROUTINE
CALL FIX ; FIX RESULT
POP IX ; GET ORIGINAL PTR
LD (IX),L ; STORE RESULT
LD (IX+1),H
RET
*H SQUARE ROOT
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; SQUARE ROOT FUNCTION
;
; INPUT: IX PTS TO X
; OUTPUT: IX PTS TO SQR(X)
; ERRORS: X IS NEGATIVE, RETURNS SQR(ABS(X))
; SPECIAL CASES: X IS 0
; ALGORITHM: INPUT IS SCALED TO .1 <= X < 1
; BY REMOVING THE EXPONENT. HALF THE
; EXPONENT IS ADDED TO THE RESULT EXPONENT
; AND THE RESULT IS MULTIPLIED BY SQR(10)
; IF THE ORIGINAL EXP WAS ODD.
; AN INITIAL APPROXIMATION IS GIVEN BY
; A 1ST ORDER POLYNOMIAL, AND IMPROVED TO
; REQUIRED ACCURACY IN 4 ITERATIONS OF
; MEWTON'S METHOD
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; CHECK VALID ARGUMENTS
;
SQR LD A,(IX+7)
OR A
JP Z,ZERO ; ZERO INPUT
BIT 7,(IX)
CALL NZ,SQERR ; NEGATIVE INPUT
;
; SCALE BY STRIPPING EXPONENT
;
PUSH AF ; SAVE ORIGINAL EXP
LD (IX+7),80H ; SET ZERO EXP
;
; CALC INITIAL APPROX
;
CALL STO4 ; SAVE X
PUSH IX
LD IX,TEMP4
CALL HALF ; CALC X/2 IN TEMP4
POP IX
LD IY,PSQ00
CALL ADD; INIT APPROX.
;
; PERFORM 4 ITERATIONS
;
LD B,4
SQ10 PUSH BC ; SAVE COUNTER
CALL STO5 ; SAVE LAST APPROX IN TEMP5
LD HL,TEMP4
CALL LD ; GET X/2
LD IY,TEMP5
CALL DIVI ; DIVIDE BY LAST APPROX
PUSH IX
LD IX,TEMP5
CALL HALF ; DIVIDE LAST APPROX BY 2
POP IX
CALL ADD ; CALC NEW APPROX
POP BC
DJNZ SQ10 ; COUNTER NOT 0
\f
;
; CALC EXPONENT, SCALE RESULT
;
POP AF ; GET ORIGINAL EXP
AND A
RRA ; DIVIDE BY TWO
RR B ; SAVE CY
ADD A,40H ; CORRECT THE BIAS
LD (IX+7),A ; STORE IT
BIT 7,B ; TEST ODD OR EVEN
RET Z ; ORIGINAL EXP EVEN
LD IY,SQR10
CALL MULT ; MPY BY SQR(10)
RET
;
; SQUARE ROOT OF NEGATIVE NUMBER
;
SQERR LD HL,ERROR
SET 3,(HL) ; FLAG ERROR
RES 7,(IX) ; MAKE POSITIVE
RET
*H EXP
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; EXPONENTIATION ROUTINE
;
; INPUT: IX PTS TO X
; OUTPUT: IX PTS TO E X
; ERRORS: OVER/UNDERFLOW IN HANDLING EXPONENT PART
; ALGORITHM: X:=X*2*LOG BASE 10 OF E
; SAVE:=INT(X)
; X:=FRACTION PART(X) / 2
; X:=10 X, WHERE 0 <= X < .5
; IF SAVE IS ODD THEN X:=X*SQR(10)
; X:=X*10 INT(SAVE/2)
;
; THE APPROXIMATION TO 10 X IS GIVEN BY :
; (Q(X 2) + X*P(X 2)) / (Q(X 2) - X*P(X 2))
; WHERE Q IS 3RD ORDER POLYNOMIAL, P IS 2ND ORDER.
; REFERENCE IS "COMPUTER APPROXIMATIONS", HART, JOHN F.
; ET AL, FUNCTION NUMBER 1444
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; CONVERT E X TO 10 X
;
EXP LD IY,LOGE2 ; MULT BY 2*LOG10(E)
CALL MULT
;
; GET 8 BIT 2'S COMPL INTEGER PART IN A
;
CALL BRK ; BREAK INTEGER AND FRACTION PARTS
JP C,EXERR1 ; INTEGER PART > 16 bits
LD A,H
RLC L ; SIGN BIT IN CY
ADC A,0
JP NZ,EXERR2 ; INTEGER > 8 BITS
LD A,L
RRCA ; RESTORE 8 BIT INTEGER
PUSH AF ; SAVE IT
\f
;
; SCALE FRACTION PART TO 0 <= X < .5
;
XOR A
CP (IX+7)
JR Z,EX10 ; FRACTION IS ZERO
CALL HALF
JP C,UNDER ; UNDERFLOW
;
; EVALUATE RATIONAL APPROX. TO 10 X
;
EX10 CALL XX2 ; STORE X, X 2 IN TEMP4, 5
LD IY,PEX02
LD B,2 ; 2ND ORDER POLY
CALL POLY ; EVALUATE P(X 2)
CALL MULT4 ; CALC. X*P(X 2)
CALL STO4 ; SAVE X*P IN TEMP4
LD HL,TEMP5
CALL LD ; GET X 2
LD IY,QEX02
LD B,2 ; 3RD ORDER POLY(1)
CALL POLY1 ; EVALUATE Q(X 2)
CALL STO5 ; SAVE Q IN TEMP5
LD IY,TEMP4
CALL SUB
CALL STO6 ; SAVE Q-XP IN TEMP6
LD HL,TEMP5
CALL LD ; GET Q
LD IY,TEMP4
CALL ADD ; CALC. Q+XP
LD IY,TEMP6
CALL DIVI ; FINAL RESULT
;
; POSSIBLE SCALE BY SQR(10)
;
POP AF ; GET 8 BIT INTEGER
SRA A ; DIVIDE BY 2
PUSH AF ; SAVE INTEGER
LD IY,SQR10
CALL C,MULT ; INTEGER WAS ODD
;
; ADD INTEGER PART TO RESULT EXPONENT
;
POP BC ; PUT INTEGER IN B
LD A,(IX+7) ; GET EXP
SUB 80H ; REMOVE BIAS
ADD A,B ; ADD INTEGER PART
JP PE,EXERR3 ; OVER/UNDERFLOW
ADD A,80H ; ADD BIAS
JP Z,UNDER ; UNDERFLOW
LD (IX+7),A ; STORE EXP
RET
;
; EXP ERRORS
;
EXERR1 EX AF,AF' ; GET ORIGINAL SIGN
LD H,A
EXERR2 BIT 7,H
JP NZ,UNDER ; - SIGN
JP OVER
EXERR3 JP P,UNDER ; + SIGN AFTER OVERFLOW
JP OVER
\f
*H LOG
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; LOG ROUTINE
;
; INPUT: IX PTS TO X
; OUTPUT: IX PTS TO NATURAL LOG OF X
; ERRORS: X IS NEGATIVE, RETURN LOG(ABS(X))
; X IS ZERO, RETURN NEGATIVE OVERFLOW
; SPECIAL CASES: X IS 1, RETURN ZERO
; ALGORITHM: SAVE:=INT(X)
; X:=SQR(10)*FRACTION-PART(X)
; X:=LOG BASE E (X), WHERE 1/SQR(10) < X < SQR(10)
; X:=X - LOG BASE E(SQR(10)) + SAVE*LOG BASE E(10)
;
; LOG IS APPROXIMATED BY :
; Z*P(Z 2) / Q(Z 2) WHERE Z = (X-1) / (X+1)
; AND P IS A 3RD ORDER POLYNOMIAL, AND Q IS 4TH ORDER.
; REFERENCE FUNCTION IS 2686.
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; CHECK FOR VALID ARGUMENTS
;
LOG BIT 7,(IX)
CALL NZ,LGERR1 ; NEGATIVE ARG
LD IY,C1
CALL CP
JP Z,ZERO ; LOG(1)
LD A,(IX+7) ; GET EXPONENT
OR A
JP Z,LGERR2 ; ZERO ARG
;
; TAKE LOG OF EXPONENT PART
;
SUB 80H ; REMOVE BIAS
LD L,A ; PUT IN HL
LD H,0 ; SIGN EXTEND
JR NC,LO10 ; + SIGN
LD H,0FFH
LO10 PUSH HL ; SAVE INTEGER
;
; SCALE TO 1/SQR(10) < X < SQR(10)
;
LD (IX+7),80H ; SCALE TO 0 < X < 1
LD IY,SQR10
CALL MULT
;
; APPROXIMATION FOR LOGARITHM
CALL STO4 ; SAVE X IN TEMP4
PUSH IX ; SAVE PTR
LD IX,TEMP4
LD IY,C1
CALL ADD ; X+1 IN TEMP4
POP IX
LD IY,C1
CALL SUB ; x-1 IN (IX)
LD IY,TEMP4
CALL DIVI
\f
CALL XX2 ; STORE Z,Z 2 IN TEMP4,5
LD IY,QL003
LD B,3
CALL POLY1 ; EVALUATE Q(Z 2)
CALL STO6 ; Q IN TEMP6
LD HL,TEMP5
CALL LD ; LOAD Z 2
LD IY,PL003
LD B,3
CALL POLY ; EVALUATE P(Z 2)
CALL MULT4 ; CALC. Z*P(Z 2)
LD IY,TEMP6
CALL DIVI ; CALC ZP/Q
LD IY,LNSQ10
CALL SUB ; SUB LOGE(SQR(10))
CALL STO4 ; SAVE IN TEMP4
;
; CONVERT 16 BIT EXPONENT PART TO FLOATING PT
;
POP HL ; GET INTEGER
CALL FLOAT1 ; FLOAT IT
LD IY,LN10
CALL MULT ; MPY BY LOG BASE E(10)
LD IY,TEMP4
CALL ADD ; FINAL RESULT
RET
;
; ERRORS
;
LGERR1 LD HL,ERROR
SET 2,(HL) ; FLAG LOG OF NEG
RES 7,(HL) ; TAKE ABS VALUE
RET
LGERR2 SET 7,(IX) ; SET NEGATIVE SIGN
JP OVER ; LOG OF ZERO
*H TANGENT
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; TANGENT ROUTINE
;
; INPUT: IX PTS TO X (IN RADIANS)
; OUTPUT: IX PTS TO TAN(X)
; ERRORS: NONE DIRECTLY
; ALGORITHM: X := X*4/PI
; SAVE := INT(X) LAND 3 (SAVE LOW 2 BITS ONLY)
; X := FRACTION-PART(X)
; IF SAVE IS 0,2 THEN X := 1-X
; X := TAN(X*PI/4), WHERE 0 <= X <= PI/4
; IF SAVE IS 0,3 THEN X := 1/X
; IF SAVE IS 0,1 THEN X := -X
;
; THE APPROXIMATION TO TAN(X*PI/4) IS GIVEN BY:
; X*P(X 2) / Q(X 2)
; WHERE P IS ORDER 3 POLYNOMIAL, Q IS ORDER 4
; REFERENCE FUNCTION IS 4286
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
\f
;
; SCALE BY 4/PI
;
TAN LD IY,FOVRPI
CALL MULT
CALL BRK ; GET INTEGER,FRACTION
LD A,L
PUSH AF ; SAVE FLAG BITS
AND 1 ; TEST FLAG
JR Z,TA10 ; FLAG WAS 0 OR 2
LD IY,C1
CALL RSUB ; CALC. 1-FRACTION PART
;
; TAN APPROX
;
TA10 CALL XX2 ; SAVE X,X 2 IN TEMP4,5
LD IY,QTA03
LD B,3
CALL POLY1 ; EVALUATE Q(X 2)
CALL STO6 ; SAVE Q
LD HL,TEMP5
CALL LD ; GET X 2
LD IY,PTA03
LD B,3
CALL POLY ; EVALUATE P(X 2)
CALL MULT4 ; CALC. X*P(X 2)
POP AF ; GET 2 BIT FLAG
PUSH AF
AND 3
JP PE,TA20 ; FLAG WAS 0 OR 3
CALL STO4 ; SAVE X*P
LD HL,TEMP6
CALL LD ; GET Q
LD IY,TEMP4 ; SET FOR Q/XP
JP TA30
TA20 LD IY,TEMP6 ; SET FOR XP/Q
TA30 CALL DIVI
;
; CALC. SIGN OF RESULT
;
POP AF ; GET FLAG
AND 2
RET Z ; ON 0 OR 1
SET 7,(IX)
RET
*H COSINE,SINE
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; COSINE ROUTINE
; EFFECTIVELY ADDS PI/2 AND CALLS SINE
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
COS LD IY,FOVRPI
CALL MULT ; SCALE BY 4/PI
CALL BRK ; GET INTEGER, FRACTION
LD A,L
ADD A,2 ; ADD EFFECTIVE PI/2
JP SI10
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; SINE ROUTINE
;
; INPUT: IX PTS TO X (IN RADIANS)
; OUTPUT: IX PTS TO SIN(X)
; ERRORS: NONE
; ALGORITHM: X := X*4/PI
; SAVE := INT(X) LAND 7
; X := FRACTION-PART(X)
;IF SAVE IS 1,3,5,7 THEN X := 1-X
; IF SAVE IS 0,3,4,7 THEN X := SIN(X*PI/4)
; IF SAVE IS 1,2,5,6 THEN X := COS(X*PI/4)
; IF SAVE IS 4,5,6,7 THEN X := -X
;
; THE SINE APPROX FOR 0 <= X <= PI/4 IS:
; X*P(X 2) / Q(X 2)
; WHERE P IS A 3RD ORDER POLYNOMIAL, Q IS 3RD ORDER.
; REFERENCE FUNCTION IS 3063.
;
; THE COSINE APPROX IS:
; P(X 2) / Q(X 2)
; WHERE P IS A 3RD ORDER POLY, Q IS 3RD ORDER.
; REFERENCE FUNCTION IS 3843.
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
SIN LD IY,FOVRPI
CALL MULT ; SCALE BY 4/PI
CALL BRK ; GET INTEGER AND FRACTION
LD A,L
SI10 PUSH AF ; SAVE 3 BIT FLAG
AND 1
JR Z,SI20 ; FLAG IS 0,2,4,6
LD IY,C1
CALL RSUB ; CALC. 1-X
SI20 POP AF ; GET FLAG
PUSH AF
AND 3
JP PO,SI30 ; 1,2,5,6
;
; SIN APPROX
;
CALL XX2 ; STORE X,X 2 IN TEMP4,5
LD IY,QSI02
LD B,2
CALL POLY1 ; EVALUATE Q(X 2)
CALL STO6 ; SAVE Q
LD HL,TEMP5
CALL LD ; GET X 2
LD IY,PSI03
LD B,3
CALL POLY ; EVALUATE P(X 2)
CALL MULT4 ; CALC. X*P(X 2)
LD IY,TEMP6
CALL DIVI ; CALC. XP/Q
JP SI40
;
; COS APPROX
;
\f
SI30 CALL XX2 ; STORE X,X 2 IN TEMP4,5
LD IY,QC002
LD B,2
CALL POLY1 ; EVALUATE Q(X 2)
CALL STO6
LD HL,TEMP5
CALL LD ; GET X 2
LD IY,PC003
LD B,3
CALL POLY ; EVALUATE P(X 2)
LD IY,TEMP6
CALL DIVI ; CALC. P/Q
;
; CALC SIGN OF RESULT
;
SI40 POP AF ; GET FLAG
AND 4
RET Z ; 0,1,2,3
SET 7,(IX)
RET
*H ARCTANGENT
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; ARCTANGENT ROUTINE
;
; INPUT: IX PTS TO X
; OUTPUT: IX PTS TO ATN(X) (IN RADIANS)
; ERRORS: NONE
; ALGORITHM: SAVE := SGN(X)
; FLAG := 0
; IF TAN(3*PI/8) <= X THEN X:=1/X, FLAG:=1
; IF TAN(PI/8) <= X THEN X:=(X-1)/(X+1), FLAG:=2
; X := ATN(X) , WHERE 0 <= X <= TAN(PI/8)
; IF FLAG = 1 THEN X := X + PI/4
; IF FLAG = 2 THEN X := PI/2 - X
; X := X*SAVE
;
; APPROXIMATION FOR ATN(X) IS:
; X*P(X 2) / Q(X 2)
; WHERE P IS 3RD ORDER POLYNOMIAL, Q IS 4TH ORDER.
; REFERENCE FUNCTION IS 5075
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; TAKE ABS VALUE, DETERMINE RANGE
;
ATN LD A,(IX) ; GET SIGN
AND 80H
PUSH AF ; SAVE SIGN
RES 7,(IX) ; MAKE POSITIVE
LD IY,TAPI8
CALL CP ; COMPARE TO 1ST LIMIT
LD B,0
JR C,AT20 ; < TAN(PI/8)
LD IY,TA3PI8
CALL CP ; COMPARE TO 2ND LIMIT
JR C,AT10 ; < TAN(3*PI/8)
;
; TAN(3*PI/8) <= X
; TAKE 1/X NOW, SUB FROM PI/2 AT END
;
\f
CALL REC ; RECIPROCAL
LD B,2 ; SET FLAG TO 2
JP AT20
;
; TAN (PI/8) < = X < TAN(3*PI/8)
; CALC (X-1)/(X+1) NOW, ADD PI/4 AT END
;
AT10 CALL STO4 ; SAVE X IN TEMP4
PUSH IX
LD IX,TEMP4
LD IY,C1
CALL ADD ; X+1 IN TEMP4
POP IX
LD IY,C1
CALL SUB ; X-1 IN ACCUM
LD IY,TEMP4
CALL DIVI
LD B,1 ; SET FLAG TO 1
;
; APPROX FOR ARCTAN
;
AT20 PUSH BC ; SAVE FLAG
CALL XX2 ; SAVE X,X 2
LD IY,QAT03
LD B,3
CALL POLY1 ; CALC. Q(X 2)
CALL STO6 ; SAVE Q
LD HL,TEMP5
CALL LD ; GET X 2
LD IY,PAT03
LD B,3
CALL POLY ; CALC P(X 2)
CALL MULT4 ; X*P
LD IY,TEMP6
CALL DIVI ; X*P/Q
POP BC ; GET FLAG
BIT 0,B
JR Z,AT30 ; FLAG IS 0 OR 2
; SECOND INTERVAL (FLAG IS 1)
LD IY,PI4
CALL ADD ; ADD PI/4
JP AT40
AT30 BIT 1,B
JR Z,AT40 ; FLAG IS 0
; THIRD INTERVAL (FLAG IS 2)
LD IY,PI2
CALL RSUB ; SUB FROM PI/2
;
; GIVE RESULT SIGN OF ARGUMENT
;
AT40 POP AF ; GET SIGN
RET Z ; SIGN WAS POSITIVE
SET 7,(IX) ; MAKE NEGATIVE
RET
*H POLY
\f
;
; POLYNOMIAL EVALUATOR
;
; INPUT: IX PTS TO ACCUM
; IY PTS TO HIGHEST COEFFICIENT
; TEMP5 CONTAINS X
; B CONTAINS ORDER (ORDER-1 FOR POLY1)
; OUTPUT: IX PTS TO RESULT
; (POLY1 ASSUMES FIRST COEFF. IS 1)
;
POLY PUSH BC ; SAVE COUNTER
PUSH IY ; SAVE COEFF. PTR
JP POLY10
POLY1 PUSH BC ; SAVE COUNTER
PUSH IY ; SAVE PTR
CALL ADD
LD IY,TEMP5 ; PT TO X
POLY10 CALL MULT
POP IY
POP BC
LD DE,-8 ; ADJUST PTR
ADD IY,DE
DJNZ POLY1 ; COUNTER NOT 0
CALL ADD ; FINAL ADD
RET
;
; POLYNOMIAL UTILITIES
;
XX2 CALL STO4 ; STORE X IN TEMP4
CALL MULT4 ; CALC. X 2
CALL STO5
RET
MULT4 LD IY,TEMP4
CALL MULT
RET
*H CONSTANTS
SQR10 DEFW 1603H ; 3.1622 77660 168
DEFW 7722H
DEFW 0166H
DEFW 8168H
LNSQ10 DEFW 1501H ; 1.1512 92546 497
DEFW 9212H
DEFW 6454H
DEFW 8197H
LN10 DEFW 3002H ; 2.3025 85092 994
DEFW 8525H
DEFW 2909H
DEFW 8194H
LOGE2 DEFW 6808H ; .86858 89638 065
DEFW 8958H
DEFW 8063H
DEFW 8065H
FOVRPI DEFW 2701H ; 1.2732 39544 735
DEFW 3932H
DEFW 4754H
DEFW 8135H
TAPI8 DEFW 1404H ; .41421 35623 731
DEFW 3521H
DEFW 3762H
\f
DEFW 8031H
TA3PI8 DEFW 4102H ; 2.4142 13562 373
DEFW 1342H
DEFW 2356H
DEFW 8173H
PI4 DEFW 8507H ; .78539 81633 974
DEFW 8139H
DEFW 3963H
DEFW 8074H
PI2 DEFW 5701H ; 1.5707 96326 795
DEFW 9607H
DEFW 6732H
DEFW 8195H
PSQ00 DEFW 7101H ; .17157 28752 538
DEFW 2857H
DEFW 2575H
DEFW 8038H
PEX00 DEFW 1705H ; 5178.0 91991 516
DEFW 9180H
DEFW 1599H
DEFW 8416H
PEX01 DEFW 3108H ; 831.40 67212 937
DEFW 6740H
DEFW 2921H
DEFW 8337H
PEX02 DEFW 8301H ; 18.312 36015 928
DEFW 3612H
DEFW 5901H
DEFW 8228H
QEX00 DEFW 4904H ; 4497.6 33557 406
DEFW 3376H
DEFW 7455H
DEFW 8406H
QEX01 DEFW 7002H ; 2709.3 16940 852
DEFW 1693H
DEFW 0894H
DEFW 8452H
QEX02 DEFW 5901H ; 159.37 41523 603
DEFW 4137H
DEFW 3652H
DEFW 8303H
; QEX03 IS 1
PL000 DEFW 6502H ; 265.52 24908 516
DEFW 2452H
DEFW 8590H
DEFW 8316H
PL001 DEFW 2984H ; -429.48 34828 658
DEFW 3448H
DEFW 8682H
DEFW 8358H
PL002 DEFW 9701H ; 197.64 46297 035
DEFW 4664H
DEFW 7029H
DEFW 8335H
PL003 DEFW 2782H ; -22.764 76157 115
DEFW 7664H
DEFW 7115H
DEFW 8215H
QL000 DEFW 3201H ; 132.76 12454 159
\f
DEFW 1276H
DEFW 4245H
DEFW 8359H
QL001 DEFW 5882H ; -258.99 54899 200
DEFW 5499H
DEFW 9289H
DEFW 8300H
QL002 DEFW 5801H ; 158.60 18962 727
DEFW 1860H
DEFW 2796H
DEFW 8327H
QL003 DEFW 1483H ; -31.416 48448 282
DEFW 4816H
DEFW 8244H
DEFW 8282H
; QL004 IS 1
PTA00 DEFW 0801H ; 10888 600.43 728
DEFW 6088H
DEFW 3704H
DEFW 8828H
PTA01 DEFW 9588H ; -89588 8.4400 677
DEFW 8488H
DEFW 0640H
DEFW 8677H
PTA02 DEFW 4101H ; 14189. 85425 276
DEFW 8589H
DEFW 5242H
DEFW 8576H
PTA03 DEFW 5684H ; -45649 31943 867
DEFW 3149H
DEFW 3894H
DEFW 8267H
QTA00 DEFW 3801H ; 13863 796.66 357
DEFW 7963H
DEFW 6366H
DEFW 8857H
QTA01 DEFW 9983H ; -39913 09.518 035
DEFW 0913H
DEFW 8051H
DEFW 8735H
QTA02 DEFW 3501H ; 13538 2.7128 051
DEFW 2738H
DEFW 8012H
DEFW 8651H
QTA03 DEFW 0181H ; -1014.6 56190 253
DEFW 5646H
DEFW 0219H
DEFW 8453H
; QTA04 IS 1
PSI00 DEFW 0602H ; 20664 34.333 700
DEFW 3464H
DEFW 3733H
DEFW 8700H
PSI01 DEFW 8181H ; -18160 3.9879 741
DEFW 3960H
DEFW 9787H
DEFW 8641H
PSI02 DEFW 5903H ; 3599.9 30694 964
\f
DEFW 3099H
DEFW 4969H
DEFW 8464H
PSI03 DEFW 0182H ; -20.107 48329 459
DEFW 4807H
DEFW 9432H
DEFW 8259H
QSI00 DEFW 6302H ; 26310 65.910 265
DEFW 6510H
DEFW 0291H
DEFW 8765H
QSI01 DEFW 9203H ; 39270. 24277 465
DEFW 2470H
DEFW 7427H
DEFW 8565H
QSI02 DEFW 7802H ; 278.11 91948 108
DEFW 9111H
DEFW 8194H
DEFW 8308H
; QSI03 IS 1
PC000 DEFW 2901H ; 12905 39.465 904
DEFW 3905H
DEFW 5946H
DEFW 8704H
PC001 DEFW 7483H ; -37456 7.0391 572
DEFW 7056H
DEFW 1539H
DEFW 8672H
PC002 DEFW 3401H ; 13432. 30098 654
DEFW 3032H
DEFW 8609H
DEFW 8554H
PC003 DEFW 1281H ; -112.31 45082 334
DEFW 4531H
DEFW 2308H
DEFW 8334H
QC000 DEFW 2901H ; 12905 39.465 904
DEFW 3905H
DEFW 5946H
DEFW 8704H
QC001 DEFW 3402H ; 23467. 77310 725
DEFW 7767H
DEFW 0731H
DEFW 8525H
QC002 DEFW 0902H ; 209.69 51819 673
DEFW 5169H
DEFW 9681H
DEFW 8373H
; QC003 IS 1
PAT00 DEFW 1602H ; 216.06 23078 972
DEFW 2306H
DEFW 8907H
DEFW 8372H
PAT01 DEFW 2203H ; 322.66 20700 133
DEFW 2066H
DEFW 0170H
DEFW 8333H
PAT02 DEFW 3201H ; 132.70 23981 640
DEFW 2370H
DEFW 1698H
DEFW 8340H
\f
PAT03 DEFW 2801H ; 12.888 38303 416
DEFW 3888H
DEFW 3430H
DEFW 8216H
QAT00 DEFW 1602H ; 216.06 23078 972
DEFW 2306H
DEFW 8907H
DEFW 8372H
QAT01 DEFW 9403H ; 394.68 28393 123
DEFW 2868H
DEFW 3139H
DEFW 8323H
QAT02 DEFW 2102H ; 221.05 08830 284
DEFW 0805H
DEFW 0283H
DEFW 8384H
QAT03 DEFW 8503H ; 38.501 48650 835
DEFW 4801H
DEFW 0865H
DEFW 8235H
; QAT04 IS 1
;
; REFERENCES
;
GLOBAL POW,IPOW,SQR,EXP,LOG,TAN,COS,SIN,ATN
EXTERNAL ERROR,OVER,UNDER,ZERO,ONE,C1
EXTERNAL ADD,SUB,RSUB,MULT,DIVI,REC
EXTERNAL HALF
EXTERNAL STO4,STO5,STO6,TEMP4,TEMP5,TEMP6
EXTERNAL LD,CP,FIX,FIXA,FLOAT,FLOAT1,BRK
EXTERNAL SRB,NORMLZ
\f
******************************************
DMATH1.S
created 770919; last modified 791023
******************************************
*H DECIMAL TO BINARY
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;,,,,,,,,,,,,,,,,,,,,,,
;
; DECIMAL TO BINARY CONVERSION
; INPUT: IX POINTS TO OUTPUT AREA
; OUTPUT: IX POINTS TO FL PT NUMBER
; ERRORS: NO DIGITS IN FRACTION PART
; NO DIGITS IN EXPONENT
; EXPONENT OVERFLOW
; EXPONENT UNDERFLOW
; REGISTER ASSIGNMENT IN MAIN LOOP:
; C - DECIMAL EXPONENT
; B - FLAGS: BIT 6 - DIGITS FOUND
; BIT 7 - FRACTION OVRFLW
; A - NEW DIGIT
; A' - SIGN IN BIT 7
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
DTOB CALL LMARK ; MARK BEGINNING OF SCAN
CALL ZERO ; CLEAR RESULT
XOR A ; CLEAR A
LD B,A ; CLEAR FLAGS
LD C,80H+13 ; INIT EXPONENT
EX AF,AF' ; PUT AWAY SIGN
CALL LIN ; GET FIRST CHAR
CP '+'
JR Z,D10 ; SIGN IS +
CP '-'
JR NZ,D20 ; NO SIGN
EX AF,AF'
OR 80H ; FLAG NEGATIVE SIGN
EX AF,AF'
;
; LOOP TO PROCESS CHARS BEFORE DECIMAL POINT
;
D10 CALL LIN ; GET NEXT CHAR
D20 CP '.'
JR Z,D40 ; DECML PT FOUND
CALL DIGIT?
JR C,D50 ; NOT A DIGIT
SET 6,B ; FLAG DIGIT FOUND
BIT 7,B
JR NZ,D30 ; OVERFLOW
CALL CNV ; CONVERT THIS DIGIT
JP D10
D30 INC C ; INC DECML EXP
JP D10
;
; LOOP TO PROCESS CHARS AFTER DECIMAL POINT
;
D40 CALL LIN ; GET NEXT CHAR
CALL DIGIT?
JR C,D50 ; NOT A DIGIT
\f
SET 6,B ; FLAG DIGIT FOUND
BIT 7,B
JR NZ,D40 ; OVERFLOW
DEC C ; DEC DECML EXP
CALL CNV ; CONVERT THIS DIGIT
JP D40
;
; CHANGE FRACTION TO FLOATING POINT FORMAT
;
D50 BIT 6,B
JP Z,LREST ; NO DIGITS FOUND
LD (SAVE),A ; SAVE THIS CHAR
CALL NORML1
JR Z,D130 ; ZERO FRACTION PART
LD A,(SAVE) ; GET CHAR AGAIN
;
; PROCESS EXPONENT
; REGISTERS:
; B - BIT 7 IS SIGN
; BIT 6 IS DIGIT-FOUND FLAG
; BIT 5 IS DIGIT-OVERFLOW FLAG
; C - IS EXP FROM FRACTION PART
; HL - IS ACCUM FOR D-TO-B CONVERSION
;
LD HL,0 ; INITIALIZE REGISTERS
LD B,L
CP 'E'-'0'
JR NZ,D90 ; NOT AN 'E'
;
; CONVERT SIGN
;
CALL LIN
CP '+'
JR Z,D60 ; SIGN IS +
CP '-'
JR NZ,D70 ; NO SIGN
SET 7,B ; FLAG NEG SIGN
;
; CONVERT DIGITS
;
D60 CALL LIN
D70 CALL DIGIT?
JR C,D80 ; NOT A DIGIT
SET 6,B ; FLAG DIGIT FOUND
BIT 5,B
JR NZ,D100 ; OVER OR UNDERFLOW
CALL MAD ; CONVERT THIS DIGIT
LD A,H ; CHECK FOR OVERFLOW
AND A
JP Z,D60 ; HL < 256
SET 5,B ; SET FLAG
JP D60
;
; TEST FOR ILLEGAL EXPONENT PART
;
D80 BIT 6,B
JR Z,D120 ; NO DIGITS FOUND
;
; CONVERT HL ACCUM TO 2'S COMPLEMENT
;
\f
D90 BIT 7,B
JR Z,D92 ; SIGN IS +
EX DE,HL
LD HL,0
AND A
SBC HL,DE
;
; ADD PREVIOUS EXPONENT (C)
; CHECK FOR OVERFLOW
;
D92 LD B,0
AND A
ADC HL,BC ; ADD TWO EXPONENTS
JP Z,UNDER ; UNDERFLOW
LD A,H
AND A
JR NZ,D96 ; EXP < -128 OR > 127
;
; STORE SIGN AND EXPONENT
;
EX AF,AF' ; GET SIGN
OR (IX)
LD (IX),A ; STORE SIGN
LD (IX+7),L ; STORE EXP
JP RTN
;
; DETERMINE SIGN OF EXP
;
D96 BIT 7,H
JR D105
;
; FINISH SCANNING DIGITS
;
D100 CALL LIN ; FINISH SCANNING DIGITS
CALL DIGIT?
JR NC,D100 ; DIGIT IS FOUND
;
; DETERMINE FROM SIGN BIT WHETHER OVER OR UNDER
;
BIT 7,B
D105 JR NZ,D110 ; SIGN IS NEGATIVE
CALL OVER ; FLAG ERROR
JP RTN
D110 CALL UNDER ; FLAG ERROR
JP RTN
;
; ILLEGAL NUMBER
;
D120 LD HL,ERROR
SET 7,(HL)
JP RTN
;
; ZERO
;
D130 CALL ZERO
JP RTN
*EJECT
;
; SCANNER ROUTINES
;
\f
RTN CALL LBACK ; BACK UP POINTER BY 1
JP RC2 ; GO TO SPECIAL RETURN
;
; DIGIT? ROUTINE CONVERTS ASCII CHAR TO 0-9 VALUE
; RETURNS CY ON IF NOT A DIGIT
;
DIGIT? SUB '0'
RET C ; WAS < 30H
CP 10
CCF ; CY SET IF > 9
RET
;
; CNV ROUTINE TO MULTIPLY DECIMAL ACCUM 1 BY 10 AND ADD
;
CNV CALL SLD ; SHIFT A INTO ACCUM
LD A,(IX) ; GET HIGH BYTE
AND A
RET Z ; < 13 DIGITS
SET 7,B ; FLAG DIGIT OVERFLOW
RET
*H BINARY TO DECIMAL
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; BCD TO DECIMAL CONVERSION
;
; INPUT: IX PTS TO FL PT NUMBER
; HL PTS TO OUTPUT AREA
; OUTPUT: FL PT NUMBER IS MODIFIED
; OUTPUT AREA IS 19 BYTES:
; 1 SIGN (SPACE OR -)
; 13 DIGITS OF FRACTION
; 1 "E"
; 1 SIGN OF EXPONENT (+ OR -)
; 3 DIGITS OF EXPONENT (LEADING ZEROS)
; EXPONENT IS FOR DECIMAL PT AFTER FIRST DIGIT
; A IS 2'S COMPLEMENT EXPONENT (-128<=A<=126)
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; CONVERT SIGN
;
BTOD BIT 7,(IX) ; TEST SIGN
LD (HL), ' ' ; DEFAULT SIGN
JR Z,BD10 ; + SIGN
LD (HL),'-' ; - SIGN
BD10 INC HL
;
; UNPACK FRACTION PART
;
EX DE,HL ; OUTPUT PTR IN DE
CALL SLD ; SHIFT OUT SIGN BYTE
LD B,13 ; COUNTER
LD A,'0'
BD20 CALL SLD ; GET A DIGIT
LD (DE),A ; OUTPUT IT
INC DE
DJNZ BD20 ; COUNTER NOT 0
;
\f
;
; CONVERT EXPONENT SIGN, GET SIGN MAGNITUDE EXP
;
EX DE,HL ; OUTPUT PTR IN HL
LD (HL),'E'
INC HL
LD (HL),'+' ; DEFAULT SIGN
LD A,(IX+7) ; GET BIASED EXP
AND A
JR Z,BD30 ; ZERO EXPON
SUB 81H ; REMOVE BIAS, DECR BY 1
JR NC,BD30 ; POSITIVE EXP
LD (HL),'-' ; - SIGN
NEG ; CALC MAGNITUDE
;
; CONVERT HUNDREDS
;
BD30 INC HL
LD (HL),'0' ; DEFAULT DIGIT
CP 100
JP C,BD40 ; EXP < 100
LD (HL),'1'
SUB 100
;
; DIVIDE BY 100
;
BD40 INC HL
LD B,2FH ; QUOTIENT COUNTER
LD C,10 ; DIVISOR
BD50 SUB C ; SUBTRACT 10
INC B ; INC QUOTIENT
JR NC,BD50 ; RESULT NOT NEGATIVE
ADD A,C ; RESTORE REMAINDER
LD (HL),B ; STORE QUOTIENT DIGIT
INC HL
OR '0'
LD (HL),A ; STORE REMAINDER DIGIT
LD A,(IX+7) ; GET EXPONENT
SUB 80H ; REMOVE BIAS
RET
*H RND
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; RANDOM NUMBER GENERATOR
;
; INPUT: IX PTS TO OUTPUT/WORK AREA
; SEED CONTAINS PREVIOUS RANDOM NUMBER
; OUTPUT: IS PTS TO RANDOM NUMBER
; SEED CONTAINS NEW NUMBER
; ERRORS: NONE
; ALGORITHM: ARITHMETIC DONE MODULO 10 13
; X := 3141592653581 * X + 2718281828459
; RESULT IS DIVIDED BY 10 13, AND NORMALIZED
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; INITIALIZE REGISTERS
;
RND LD IY,CRNDA ; PT TO MPLIER
PUSH IX
\f
POP DE
LD HL,6
ADD HL,DE ; PT TO LS BYTE OF (IX)
LD (SAVE),HL ; SAVE FOR MLDIG
LD HL,SEED ; PT TO LAST NUMBER
CALL MDTL ; SAVE MULTIPLES IN TEMPO-3
CALL ZERO ; CLEAR WORK AREA
LD B,7 ; SET MULTIPLY LOOP COUNTER
JP RN20
;
; MULTIPLICATION, USING (IX) AS ACCUM, (IY) AS
; MULTIPLIER, (SEED) (SEED=IY-8) AS PRODUCT
; MULTIPLY BY 31415 92653 581 (CRNDA)
;
RN10 PUSH AF ; SAVE DIGIT SHIFTED OUT
CALL MLDIG ; MULTIPLY BY 2ND DIGIT
XOR A
CALL SRD ; SHIFT ACCUM RIGHT
RLA ; PUT DIGIT IN HIGH 4 BITS
RLA
RLA
RLA
AND OFOH
LD C,A ; SAVE UPPER DIGIT
POP AF ; GET LAST DIGIT
OR C ; COMBINE
LD (IY-1),A ; STORE IN SEED
RN20 LD C,(IY+6) ; GET NEXT 2 MPLIER DIGITS
DEC IY ; DECR PTR
CALL MLDIG ; MULTIPLY BY 1ST DIGIT
XOR A
CALL SRD ; SHIFT ACCUM RIGHT
DJNZ RN10
LD (IY-1),A ; STORE LAST DIGIT
;
; ADD 27182 81828 459 (CRNDC) TO (SEED)
;
LD B,7 ; LOOP COUNTER
LD HL,CRNDC0 ; PT TO CONSTANT
LD DE,SEED10 ; PT TO LS BYTE OF SEED
AND A ; CLEAR CY
;
; ADD LOOP
;
RN30 LD A,(DE) ; GET 2 DIGITS
ADC A,(HL) ; ADD 2 DIGITS
DAA
LD (DE),A ; STORE SUM
DEC DE
DEC HL
DJNZ RN30 ; COUNTER NOT 0
;
; SCALE AND NORMALIZE RESULT
;
INC DE ; PT TO MS BYTE
AND 0FH ; CLEAR SIGN DIGIT
LD (DE),A
EX DE,HL ; PUT PTR IN HL
CALL LD ; COPY SEED TO (IX)
LD C,80H ; SET EXPONENT
CALL NORML1 ; NORMALIZE
RET
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; RANDOMIZE USES REFRESH REGISTER TO MODIFY SEED
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
RANDMZ LD A,R ; GET REFRESH REGISTER
OR A
DAA ; CONVERT TO DECIMAL
LD (SEED10),A
RET
*H INT
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; INTEGER FUNCTION -- FLOOR FUNCTION
; INPUT,OUTPUT: IX POINTS TO FL PT NUMBER
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
INT XOR A
CP (IX+7)
RET Z ; X WAS ZERO
LD A,8DH
SUB (IX+7) ; # DIGITS RIGHT OF PT
RET C ; X >= 10 13
RET Z ; X >= 10 12
CP 13
JR NC,INT40 ; X < 1
LD B,A
;
; SET POINTER TO 1ST DIGIT RIGHT OF PT
;
LD A,14
SUB B ; 1+# DIGITS LEFT OF PT
LD E,A
SRL E ; # BYTES TO SKIP
LD D,0
PUSH IX ; GET PTR
POP HL
ADD HL,DE
;
; CLEAR FIRST DIGIT IF A IS ODD
;
AND 1
JR Z,INT10 ; DEC PT IS BETWEEN BYTES
LD A,(HL) ; GET BYTE WITH DEC PT
LD C,A ; SAVE RIGHT HALF
AND 0F0H ; CLEAR RIGHT HALF
LD (HL),A ; REPLACE IT
INC HL
LD A,C ; GET RIGHT HALF
AND 0FH
;
; CLEAR REMAINING BYTES, OR-ING EACH INTO A FIRST
;
INT10 SRL B ; CALC # BYTES
JR Z,INT30 ; NONE TO CLEAR
INT20 OR (HL)
LD (HL),0
INC HL
DJNZ INT20
\f
;
; POSSIBLE CORRECTION FOR NEGATIVE NUMBERS
;
INT30 BIT 7,(IX) ;
RET Z; POSITIVE
AND A
RET Z ; INPUT WAS AN INTEGER
LD IY,C1
CALL SUB ; SUBTRACT 1 TO CORRECT
RET
;
; X < 1, NONZERO: OUTPUT 0 IF +, -1 IF -
;
INT40 BIT 7,(IX)
JP Z,ZERO ; POSITIVE FRACTION
CALL ONE
SET 7,(IX) ; NEGATIVE 1
RET
*H SHORT FUNCTIONS
;
; BRK SEPARATES INTEGER AND FRACTION PARTS
;
; INPUT: IX PTS TO X
; OUTPUT: IX PTS TO FRACTIONAL PART OF X (POSITIVE)
; HL CONTAINS 2'S COMPL INTEGER PART OF X,
; LOW ORDER 16 BITS VALID IF X < 10 13
; CY SET IF INTEGER WON'T FIT IN 16 BITS
; Z SET IF EXACT INTEGER
; A' IS ORIGINAL SIGN
;
BRK LD A,(IX) ; GET SIGN
PUSH AF
CALL STO4 ; COPY X
CALL INT ; TAKE INTEGER PART
LD IY,TEMP4
CALL RSUB ; CALC. FRACTION PART
PUSH IX ; SAVE PTR
LD IX,TEMP4
CALL FIXA ; CALC. BINARY INTEGER PART
POP IX
EX AF,AF'
POP AF ; GET ORIGINAL SIGN
EX AF,AF'
RET
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; ABSOLUTE VALUE FUNCTION
; INPUT,OUTPUT: IX POINTS TO FL PT NUMBER
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
ABS RES 7,(IX) ; TURN OFF SIGN BIT
RET
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; SIGN FUNCTION
; INPUT,OUTPUT. IX POINTS TO FL PT NUMBER
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
SGN XOR A ; CLEAR A
CP (IX+7)
\f
RET Z ; ZERO INPUT IS NOP
LD A,(IX) ; GET SIGN
AND 80H
CALL ONE ; OUTPUT 1
OR (IX)
LD (IX),A ; SIGN OF INPUT
RET
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; NEGATE FUNCTION
; INPUT,OUTPUT: IX POINTS TO FL PT NUMBER
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
NEG LD A,(IX) ; GET SIGN BIT
XOR 80H ; COMPLEMENT IT
LD (IX),A ; RESTORE
RET
*H INTEGER ADD AND SUB
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; IADD, ISUB INTEGER ADD AND SUBTRACT
;
; INPUT: IX PTS TO X
; IY PTS TO Y
; OUTPUT: IX PTS TO SUM OR DIFFERENCE
; ERRORS: OVERFLOW (POSITIVE OR NEGATIVE)
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
IADD CALL ASLOAD ; LOAD ARGUMENTS
ADC HL,DE
JP PO,ASSTO ; NO OVERFLOW
ASOV JP P,NINF ; OVFLW SIGN POS
JP PINF
ISUB CALL ASLOAD ; LOAD ARGUMENTS
SBC HL,DE
JP PO,ASSTO ; NO OVERFLOW
JR ASOV
;
; ASLOAD LOADS ARGS TO HL, DE, RESETS CY
;
ASLOAD LD H,(IX+1)
LD L,(IX)
LD D,(IY+1)
LD E,(IY)
AND A
RET
;
; ASSTO STORES HL AS RESULT
;
ASSTO LD (IX),L
LD (IX+1),H
RET
*H INTEGER MULTIPLY
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; IMUL INTEGER MULTIPLY
;
; INPUT: IX PTS TO X
; IY PTS TO Y
; OUTPUT: IX PTS TO PRODUCT
; ERRORS: OVERFLOW (POS OR NEG)
\f
; REGISTERS: DE IS MULTIPLICAND
; AC IS MULTIPLIER AND ACCUM EXTENSION
; HL IS ACCUM
; B IS LOOP COUNTER
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
IMUL CALL MDLOAD ; LOAD ARGS
LD A,B ; X IN AC
;
; 16 BIT BY 16 BIT UNSIGNED MULTIPLY
;
LD HL,0 ; CLEAR ACCUM
LD B,16 ; SET COUNTER
RRA ; INITIALIZE CARRY
RR C
IM10 JR NC,IM20 ; MPLIER BIT IS ZERO
ADD HL,DE ; ADD MULTIPLICAND
IM20 RR H ; ROT ACC-MPLICAND INTO CY
RR L
RRA
RR C
DJNZ IM10 ; COUNTER NOT 0
;
; TEST FOR > 16 BIT PRODUCT
;
LD B,A ; PRODUCT IN BC
LD A,H
OR L
JR NZ,INF? ; OVERFLOW
;
; TEST FOR >15 BITS, AND STORE RESULTS
;
MDSTO EX AF,AF' ; GET SIGN OF RESULT
AND 80H
JR Z,MDS20 ; POS RESULT
;
; NEGATE BC
;
LD HL,0
SBC HL,BC
JR Z,MDS10 ; RESULT WAS ZERO
JP P,NINF ; NEGATIVE OVERFLOW
MDS10 LD (IX),L ; STORE RESULT
LD (IX+1),H
RET
;
; TEST FOR > 15 BITS
;
MDS20 BIT 7,B
JR NZ,PINF ; POSITIVE OVERFLOW
LD (IX),C
LD (IX+1),B
RET
;
; INF? CHECKS SIGN BIT IN A'
; PINF PRODUCES POS OVERFLOW
; NINF PRODUCES NEG OVERFLOW
;
IDVO LD HL,ERROR
SET 4,(HL) ; FLAG ERROR
\f
INF? EX AF,AF' ; GET SIGN BIT
AND 80H
JR NZ,NINF ; NEG SIGN
PINF LD (IX),0FFH ; RESULT IS 7FFFH
LD (IX+1),7FH
JR FINF
NINF LD (IX),0 ; RESULT IS 8000H
LD (IX+1),80H
FINF LD HL,ERROR
SET 6,(HL) ; FLAG ERROR
RET
*H INTEGER DIVIDE
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; IDIV INTEGER DIVIDE
;
; INPUT: IX PTS TO X
; IY PTS TO Y
; OUTPUT: IX PTS TO X/Y
; ERRORS: Y IS ZERO
; ALGORITHM: NON-RESTORING DIVISION, 16 BY 15
; REGISTERS: AC IS DIVIDEND, ACCUM EXT
; DE IS DIVISOR
; HL IS ACCUM, REMAINDER AT END
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
IDIV CALL MDLOAD ; LOAD ARGS
LD A,D
OR E
JR Z,IDV0 ; DIVISOR IS ZERO
LD A,B ; X IN AC
;
; 16 BIT BY 15 BIT UNSIGNED DIVIDE
;
LD HL,0 ; CLEAR ACCUM
LD B,16 ; SET COUNTER
IDV10 ; 0 <= HL < DE
RL C ; ROT ACC-RESULT LEFT
RLA
ADC HL,HL ; NO CY POSSIBLE
SBC HL,DE ; SUB DIVISOR
IDV20 CCF ; CALC RESULT BIT
JR NC,IDV50 ; ACCUM WENT NEGATIVE
IDV30 DJNZ IDV10 ; COUNTER NOT 0
JP IDV60
IDV40 ; DE <= HL < 0
RL C ; RO ACC-RESULT LEFT
RLA
ADC HL,HL
AND A ; TURN OFF CY
ADC HL,DE ; ADD DIVISOR
JR C,IDV30 ; ACCUM WENT POSITIVE
JR Z,IDV20 ; ACCUM BECAME ZERO
IDV50 DJNZ IDV40 ; COUNTER NOT 0
IDV60 RL C ; SHIFT IN LAST RESULT BIT
RLA
LD B,A ; QUOTIENT IN BC
JP MDSTO ; STORE RESULT
;
; MDLOAD LOADS X INTO BC, Y INTO DE
; TAKES ABS OF EACH, STORES XOR OF SIGNS
; IN A' \f
;
MDLOAD LD B,(IX+1) ; LOAD X
LD C,(IX)
LD A,B
AND 80H
JR Z,MDL10 ; X IS POSITIVE
;
; NEGATE X
;
LD HL,0
SBC HL,BC
LD B,H
LD C,L
;
; LOAD Y
;
MDL10 LD D,(IY+1)
LD E,(IY)
XOR D ; FORM SIGN OF RESULT
EX AF,AF' ; SAVE IT
BIT 7,D
RET Z ; Y IS POSITIVE
;
; NEGATE Y
;
LD HL,0
AND A
SBC HL,DE
EX DE,HL
RET
*H IABS AND ISGN
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; IABS, INEG
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
IABS BIT 7,(IX+1)
RET Z ; X IS POSITIVE
INEG LD D,(IX+1) ; LOAD X
LD E,(IX)
LD HL,0 ; NEGATE X
AND A
SBC HL,DE
JP PE,NINF ; NEG OVERFLOW
LD (IX+1),H ; STORE X
LD (IX),L
RET
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; ISGN
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
ISGN LD A,(IX+1) ; GET SIGN
BIT 7,A
JR Z,ISG10 ; X IS NONNEG
LD (IX),0FFH ; STORE -1
LD (IX+1),0FFH
RET
ISG10 OR (IX)
RET Z ; X IS ZERO
\f
LD (IX+1),0 ; STORE +1
LD (IX),1
RET
*H ICP
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; ICP INTEGER COMPARE
;
; RETURNS CY SET IF X < Y
; RETURNS Z SET IF X = Y
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
ICP LD B,(IX+1) ; GET SIGN OF X
LD A,B
AND 80H ; TEST SIGN, CLEAR CY
JR NZ,ICP10 ; X IS NEG
BIT 7,(IY+1)
RET NZ ; Y IS NEG
LD A,B
CP (IY+1) ; SIGNS ARE BOTH POS
RET NZ
LD A,(IX)
CP (IY)
RET
ICP10 XOR (IY+1) ; TEST SIGN, CLEAR Z
RLA ; SIGN BIT INTO CY
RET C ; SIGNS DIFFERENT
LD A,B
CP (IY+1) ; BOTH SIGNS NEG
RET NZ
LD A,(IX)
CP (IY)
RET
;
; REFERENCES
;
EXTERNAL MULT,DIVI,ERROR,OVER,UNDER,SAVE
EXTERNAL SEED,SEED10,CRNDA,CRNDC0
EXTERNAL SRD,LD,MLDIG,MDTL
EXTERNAL ZERO,ONE,NORML1,SLD,SUB,C1,MAD
EXTERNAL STO4,TEMP4,RSUB,FIXA
EXTERNAL LMARK,LREST,LBACK,RC2,LIN
GLOBAL DTOB,BTOD
GLOBAL RND,RANDMZ,INT,BRK,ABS,SGN,NEG
GLOBAL IADD,ISUB,IMUL,IDIV,IABS,ISGN,ICP,INEG
\f
******************************************
DMATHM.S
created 770914; last modified 791023
******************************************
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; MISCELLANEOUS ROUTINES REQUIRED AS EXTERNALS FOR MATH PACKAGE
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
LMARK LD (POINT),HL ; STORE PTR FOR DTOB
RET
LREST RET ; ENTRY FOR UNSUCCESSFUL DTOB (NO DIGITS FOUND)
LBACK RET ; DUMMY ROUTINE (BACK UP PTR FOR BASIC)
RC2 RET ; NORMAL RETURN, IF SOME KIND OF NUMBER FOUND
LIN PUSH HL ; SAVE HL
LD HL,(POINT) ; GET PTR
LIN10 LD A,(HL) ; GET NEXT CHAR
INC HL ; ADVANCE PTR
CP ' '
JR Z,LIN10 ; IGNORE BLANKS
LD (POINT),HL ; SAVE PTR
POP HL ; RESTORE HL
RET
SCP RET ; STRING COMPARE
POINT DEFS 2 ; TEMP PTR STORAGE
ERROR DEFB 0 ; ERROR FLAGS FOR MATH PACKAGE
ILLNUM EQU 7 ; ILLEGAL NUMBER (DTOB)
OVRFLW EQU 6 ; OVERFLOW
UNDFLW EQU 5 ; UNDERFLOW
DVDZRO EQU 4 ; DIVISION BY ZERO
SQRNGN EQU 3 ; SQUARE ROOT OF NEGATIVE NUMBER
LOGNGN EQU 2 ; LOG OF NEGATIVE NUMBER
;
; REFERENCES
;
GLOBAL ERROR,SCP,LMARK,LREST,LBACK,RC2,LIN
\f
DVDIG LD HL,TEMP3 ; PT TO 8Y
CALL DVCP
JR C,DVD10 ; AC1 < 8Y
LD HL,TEMP30
CALL DVSUB ; 8Y <= AC1
DVD10 RL C ; COMPL RESULT BIT IN C
LD HL,TEMP2 ; PT TO 4Y
CALL DVCP
JR C,DVD20 ; AC1 < 4Y
LD HL,TEMP20
CALL DVSUB ; 4Y < AC1
DVD20 RL C ; COMPL RESULT BIT IN C
LD HL,TEMP1 ; PT TO 2Y
CALL DVCP
JR C,DVD30 ; AC1 < 2Y
LD HL,TEMP10
CALL DVSUB ; 2Y < AC1
DVD30 RL C ; COMPL RESULT BIT IN C
LD HL,TEMP0 ; PT TO Y
CALL DVCP ; COMPARE TO AC1
JR C,DVD40 ; AC1 < Y
LD HL,TEMP00
CALL DVSUB ; Y < AC1
DVD40 RL C ; COMPL RESULT BIT IN C
RET
;
; DVCP ROUTINE TO COMPARE (DE) TO AC1
; RETURNS CY SET IFF (DE) < AC1
; RETURNS Z SET IFF (DE) = AC1
; TIMING APPROX 42
;
DVCP LD DE,AC1 ; PT TO AC1
LD B,7 ; SET COUNTER
DVC10 LD A,(DE) ; GET BYTE
CP (HL)
RET NZ ; < OR >
INC HL ; INC PTRS
INC DE
DJNZ DVC10 ; COUNTER NOT 0
RET
;
; DVSUB ROUTINE TO SUBTRACT (DE) FROM AC1
; ASSUMES 14 DIGIT OPERANDS
; TIMING 376
;
DVSUB LD DE,AC10 ; PT TO ACCUM
AND A ; CLEAR CY
LD B,7
DV40 LD A,(DE)
SBC A,(HL)
DAA
LD (DE),A
DEC DE
DEC HL
DJNZ DV40
RET
;
; ROUTINE TO LOAD TEMP REGISTERS
; TIMING 2014
;
\f
MDTL LD DE,TEMP0 ; FIRST DEST
CALL MOV ; LOAD TEMP0
LD HL,TEMP0 ; PT TO SRC
RES 7,(HL) ; CLEAR SIGN BIT
LD B,3 ; SET COUNTER
;
; LOOP TO COPY TEMPN TO TEMPN+1 & SHFT LFT 1 BIT
;
MDTL1 LD A,B ; SAVE COUNTER
CALL MOV ; MOVE TO NEXT TEMP
LD B,A ; RESTORE COUNTER
AND A ; CLEAR CY
CALL SLB1 ; SHFT LEFT (HL ALREADY OK)
INC HL ; PT TO MSBYTE JUST SHIFTED
DJNZ MDTL1 ; COUNTER NOT 0
RET
;
; DETERMINE OVER OR UNDER
;
MERR JP P,UNDER ; UNDERFLOW
JP OVERA
;
; DIVISION BY ZERO ERROR
;
DIV0 LD HL,ERROR
SET 4,(HL)
JP INF
*H FIX
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; FIX CONVERTS FLOATING POINT NUMBER TO
; 16 BIT 2'S COMPLEMENT INTEGER
; (ROUNDING)
;
; INPUT: IX PTS TO FL PT NUMBER
; OUTPUT: IX PTS TO INTEGER
; ERRORS: OVERFLOW IF X > 32767 OR X < -32768
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
FIX LD IY,C _5
CALL ADD ; ADD .5
CALL FIXA ; CONVERT NUMBER
JR NC,FX10 ; NO OVERFLOW
LD HL,ERROR
SET 6,(HL) ; FLAG OVERFLOW
LD HL,7FFFH ; 32767
BIT 7,(IX)
JR Z,FX10 ; POSITIVE SIGN
LD HL,8000H ; -32768
FX10 LD (IX),L ; STORE INTEGER
LD (IX+1),H
RET
;
; MAIN CONVERSION FOR FIX
;
; RETURNS CY SET IF OVERFLOW
; RETURNS Z SET IF EXACT INTEGER
; HL IS LOW 16 BITS OF INT(X) FOR ALL X < 10 13
;
\f
\f
«eof»