home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Oakland CPM Archive
/
oakcpm.iso
/
cpmug
/
cpmug018.ark
/
MATH.ASM
< prev
next >
Wrap
Assembly Source File
|
1984-04-29
|
40KB
|
1,469 lines
; REF. NO. BC3
; PROGRAM TITLE MATH
;
;
;
;
;
;ARITHMETIC ROUTINES-MODIFIED 23 APR. 1976
;BY C.B. FALCONER, YALE UNIVERSITY, NEW HAVEN, CONN.
;
;
FALSE EQU 0
TRUE EQU NOT FALSE
DEBUG EQU TRUE
;
;
; FLOATING POINT REPRESENTATION CAN EXPRESS VALUES
; IN THE RANGE +-.735*10^-39 TO +-.85*10^38 (DECIMAL)
; WITH BETWEEN 4 AND 5 DECIMAL DIGIT ACCURACY
; A FLOATING POINT VAUE IS REPRESENTED BY A 2'S
; COMPEMENT 16 BIT MANTISSA, WHOSE VALUE IS IN THE
; RANGE 0.5 > MANTISSA >= -0.5. THE MANTISSA CAN BE
; CONSIDERED AS THE SIGNED INTEGER VALUE/65536.
; LEFTMOST BIT OF THE MANTISSA. IS REPRESENTED BY
; AND 8 BIT 2'S COMPLEMENT INTEGER. POSITIVE VALUES
; SPECIFY RIGHTWARDS MOVEMENT OF THE BINARY POINT. ETC
;
; "FIXED" POINT REPRESENTATION OF THESE VALUE CONSISTS
; OF A 16 BIT 2'S COMPLEMENT INTEGER (IN THE RANGE
; -32768 TO 32767), AND AN 8 BIT 2'S COMPLEMENT DECIMAL
; EXPONENT WHICH REPRESENTS A POWER OF THEN MULTIPLIER
; THIS REPRESENTATION IS USEDFOR INPUT/OUTPUT ONLY
;
; ROUTINE "FIX" CONVERTS FLOATING TO FIXED REPRESENTATION
; ROUTINE "FLOT" CONVERTS FIXEDTO FLOATING REPRESENTATION
;
IF NOT DEBUG
ORG 3000H
;
CIN EQU 3803H
COUT EQU 3808H
TSTR EQU 3D81H
CRLF EQU 3DC5H
CECHO EQU 3E83H
EXDG EQU 36D2H
TDZS EQU 36FFH
ENDIF
;
IF DEBUG
;
ORG 2000H
;
LXI SP,2E8AH ; FOR YALE OS 2.3 & 12K CORE
JMP TEST ;CONECTOR
CIN: JMP 3803H
COUT: CALL 3809H
MOV A,C ;ENDURE VALUE IN (A)
RET
ENDIF
;
; INDFX (HL)+4*(A)->HL
; A.F.H.L (1)
INDX4: ADD A
;
; INDFX (HL)+2*(A)->(HL)
; A,F,H,L (I)
INDX2: ADD A
;
; INDEX (HL)+(A)->(HL)
; A,F,H,L (1)
INDEX: ADD L
MOV L,A
RNC
INR H
RET
;
; SUBTRACT (BC) FROM (HL) SUBROUTINE
; CARRY IF ORIGINALLY (BC) > (HL)
; A,F,H,L (1)
SUBBC: MOV A,L
SUB C
MOV L,A
MOV A,H
SBB B
MOV B,A
RET
;
; SUBTRACT (DE) FROM (HL)
; CARRY ID ORIGINAL (DE) > (HL)
; A,F,H,L (1)
SUBDE: MOV A,L
SUB E
MOV L,A
MOV A,H
SBB D
MOV H,A
RET
;
; MULTIPLY (HL) BY 10
; H,L (2)
MUL10: PUSH D
PUSH H
POP D ;COPY HL TO DE
DAD D ; 2*
DAD H ; 4*
DAD D ; 5*
DAD H ; 10*
POP D ; RESTORE DE
RET
;
; DIVIDE INTEGER (HL) BY 10
; REMAINDER APPEARS IN (A) WITH FLAGS SET
; A,F,H,L (2)
DTEN: PUSH B ;SAVE BC
MVI C,10 ;DIVISOR
DTEN1: XRA A ;CLEAR
MVI B,-16 AND 0FFH ;ITERATION COUNT
DTEN2: DAD H
RAL ;SHIFT OFF INTO (A)
CMP C ;TEST
JC DTEN3 ;NO BIT
SUB C ;BIT=1
DTEN3: INR B ;DONE?
JM DTEN3 ;NO
ORA A ;SET FLAGS FOR REMAINDER, CLEAR CARRY
POP B ;RESTORE
RET
;
; INTEGER DIVIDE 16 BY 8 BIT QUANTITIES
; (HL)/(A) => (HL); REMAINDER => (A)
; SET CARRY FPR DIVISION BY ZERO, PRESERVE HL
;* DTEN
; A,F,H,L (2)
DQUIK: ORA A
STC
RZ ;DIVISION BY ZERO
PUSH B
MOV C,A
JMP DTEN1
;
; 2'S COMPLEMENT (BC)
; A,B,C (1)
C2BC: DCX B
;
; 1'S COMPLEMENT (BC)
; A,B,C (1)
CIBC: MOV A,C
CMA
MOV C,A
MOV A,B
CMA
MOV H,A
RET
;
; 2'S COMPLEMENT (DE)
; A,D,E (1)
C2DE: DCX D
;
; 1'S COMPLEMENT (DE)
; A,D,E (1)
CIDE: MOV A,E
CMA
MOV E,A
MOV A,D
CMA
MOV D,A
RET
;
; 2'S COMPLEMENT (DEHL)
;* C2DE,CIDE
; A,F,D,E,H,L (2)
C2DHL: XCHG
CALL C2DE
XCHG
CALL CIDE
MOV A,H
ORA L
RNZ
INX D ;PROPAGATE CARRY
RET
;
; (BC) LEFT SHIFT, ZERO INSERT
; A,F,B,C (1)
BCLZ: ORA A ;CLEAR CARRY
;
; (BC) LEFT SHIFT, CARRY INSERT
; A,F,B,C (1)
BCLC: MOV A,C
RAL
MOV C,A
MOV A,B
RAL
MOV B,A
RET
;
; ARITH. SHIFT RIGHT (BC)
; A,F,B,C (1)
BCRA: MOV A,B
RAL
;
; (BC) RIGHT SHIFT, CARRY IN
; A,F,B,C (1)
BCRC: MOV A,B
RAR
MOV B,A
MOV A,C
RAR
MOV C,A
RET
;
; ARITHMETIC RIGHT SHIFT (DE)
; A,F,D,E (1)
DERA: MOV A,D
RAL
JMP DERC
;
; (DE) RIGHT SHIFT, ZERO INSERT (DE)
; A,F,D,E, (1)
DERZ: ORA A ;CLEAR CARRY
;
; (DE) RIGHT SHIFT, ZERO INSERT
; A,F,D,E (1)
DERC: MOV A,D
RAR
MOV D,A
MOV A,E
RAR
MOV E,A
RET
;
; ARITH. RIGHT SHIFT (DE) (A) TIMES
;* DERA
; A,F,D,E (3)
DERN: ORA A
DERN1: RZ ;ZERO COUNT
PUSH PSW
CALL DERA ;ARITH. RIGHT SHIFT
POP PSW
DCR A
JMP DERN1
;
; INTEGER (POA.) MULTIPLY DE*BC->DEHL
; D,E,H,L (3)
IMUL: PUSH PSW
LXI H,0 ;CLEAR ACCUMULATOR
MVI A,-16 AND 0FFH ;ITERAITION COUNT
IMUL1: PUSH PSW ;SAVE ITERATION
DAD H ;LEFT SHIFT, CARRY OUT
MOV A,E ;LEFT SH M'PLIER INSERT O'FLOW
RAL
MOV E,A
MOV A,D
RAL
MOV D,A
JNC IMUL2 ;NO BIT
DAD B ;ADD IN MULTIPLICAND
JNC IMUL2 ; NO OVERFLOW
INX D ;KEEP OVERFLOW
IMUL2: POP PSW ;ITERATION COUNT
INR A
JM IMUL1 ;DO AGAIN
POP PSW ;RESTORE
RET
;
; INTEGER (POS.) DIVIDE. (DEHL)/(BC)=>(DDE)
; REMAINDER APPEARS IN (HL)
; CARRY FOR OV, WHEN REGISTERS UNCHANGED
;* C2BC
; F,D,E,H,L (3)
IDIV: PUSH PSW
MOV A,E ;CHECK FOR OVERFLOW
SUB C
MOV A,D
SBB B
JC IDIV1 ;NO OVERFLOW
POP PSW ;RESTPRE (A)
STC
RET
IDIV1: CALL C2BC ;CHANGE (BC) SIGN
XCHG ;DO ARITHMETIC IN (HL)
MVI A,-16 AND 0FFH ;ITERATION COUNT
IDIV2: PUSH PSW ;SAVE ITERATION COUNT
DAD H ;LEFT SHIFT (HLDE)
RAR ;SAVE CARRY OUT
XCHG
DAD H
XCHG
JNC IDIV3 ;NO CRRY INTO L
INX H
IDIV3: RAL ;REGAIN CARRY FROM H
JC IDIV4 ;YES, GENERATE QUOTIENT BIT
MOV A,L
ADD C ;TEST FOR QUOTIENT BIT
MOV A,H
ADC H
JNC IDIV5 ;NO BIT
IDIV4: DAD B ;AUBTRACT
INX D ;INSERT QUOTIENT BIT
IDIV5: POP PSW ;GET ITERATION COUNT
INR A
JM IDIV2 ;NOT DONE
CALL C2BC ;RESTORE BC
POP PSW ;RESTORE A
ORA A ;CLEAR ANY CARRY , NO OVERFLOW
RET
;
; SIGNED MULTIPLY (DE)*(BC)->(DEHL)
;* IMUL,CEBC,C2BC,C2DE,C2DHL
;F,D,E,H,HL (6)
MUL: PUSH PSW
PUSH B
MOV A,D
ORA A
JM MUL5 ; (DE) -VE
MOV A,B
ORA A
JM MUL3 ; (DE) +VE, (BC) -VE
MUL1: CALL IMUL ;RESULT +VE
MUL2: POP B
POP PSW
ORA A ;RESET CARRY, NO OV.
RET
MUL3: CALL C2BC ;2'S COMP. BC
MUL4: CALL IMUL ;RESULT -VE
CALL C2DHL ;2'S COMPLEMENT DEHL
JMP MUL2
MUL5: CALL C2DE ; (DE) -VE
MOV A,B
ORA A
JP MUL4 ; (DE) -VE, (BC) +VE
CALL C2BC ; (DE) -VE, (BC) -VE
JMP MUL1
;
; DO IDIV ON SIGNED + NO'S & CHECK O'FLOW
; EXPECTING +VE RESULT
;* IDIV
; A,F,D,E,H,L (4)
IDIVQ: CALL IDIV
RC
MOV A,D
RAL
RET ;RESET SHOULD BE +VE
;
; DO IDIV ON SIGNED +NO'S & CHECK OVERFLOW
; INPUTS MAY INCLUDE 8000 HEX
; EXPECTING -VE RESULT, ALLOW 8000 HEX
;* C2DE,IDIV
; A,F,D,E,H,L(4)
IDIVN: CALL IDIV
RC ;OVERFLOW
CALL C2DE ;COMPLEMENT QUOTIENT
MOV A,D
ORA A ;RESULT SHOULD BE -VE
RM
STC
RET ;OVERFLOW
;
; SIGNED DIVIDE (DEHL)/(BC)->(DE)
; REMAINDER APPEARS IN (HL)
; CARRY INDICATES OVERFLOW
; WHEN INPUTS ARE PRESERVED, EXCEPT FLAGS
;* C2BC,C2DE,CEDHL,IDIVN,IDIVQ
; F,D,E,H,L (9)
DIV: PUSH PSW
PUSH B
PUSH D
PUSH H ;SAVE IN CASE OF OVERFLOW
MOV A,D
ORA D
JM DIV4 ;DIVIDEND NEGATIVE
ORA B
JM DIV2 ;+/-
CALL IDIVQ ;+/+
JC DIV3 ;OVERFLOW
DIV1: POP B ;PURGE ATACK, NO OVERFLOW
POP B ;
POP B ;RESTORE (BC)
POP PSW
ORA A ;RESET CARRY, NO OVERFLOW
RET
DIV2: CALL C2BC ;+/-, COMPLEMENT BC
CALL IDIVN
JNC DIV1 ;NO OVERFLOW
DIV3: POP H ;RESTORE ENTRY, OVERFLOW
POP D
POP B
POP PSW
STC ;MARK OVERFLOW WITH CARRY
RET
DIV4: CALL C2DHL ;-/?, COMP. DEHL
MOV A,B
ORA A
JM DIV1 ;-/-
CALL IDIVN
JC DIV3 ;OVERFLOW
DIV5: XCHG
CALL C2DE
XCHG ;COMPLEMENT REMAINDER
JMP DIV1
DIV6: CALL C2BC ;-/-, COMPLEMENT BC
JC DIV3 ;OVERFLOW
JMP DIV5
;
; NORMALIZE (DE) LEFT, EXPONENT IN (L)
; ZERO FLAG FOR ZERO VALUE
; A,F,D,E,L (1)
NDEL: MOV A,E
ORA D
JNZ NDEL2 ;NON-ZERO
MOV L,A ;SET EXPONENT ZERO
NDEL1: ORA L ;SET /REST ZERO FLAG
RET
NDEL2: MOV A,D
ANI 0C0H ;SET FLAGS & CLEAR CARRY
RPO ;DONE
MOV A,L
CPI 80H
JZ NDEL1 ;NECT SHIFT OVERFLOWS EXPONENT
XCHG ;LEFT SHIFT
DAD H
XCHG
DCR L ;CORRECT EXPONENT
JMP NDEL2
;
; NORMALIZE (BC) LEFT, EXPONENT IN (H)
; ZERO FLAG FOR ZERO VALUE
;* BCLZ
; A,F,B,C,H (2)
NBCL: MOV A,B
ORA C
JNZ NBCL2 ;NON ZERO
MOV H,A ; SET EXPONENT ZERO
NBCL1: ORA H ;SET/RESET ZERO FLAG
RET
NBCL2: MOV A,B
ANI 0C0H ;SET FLAGS & CLEAR CARRY
RPO ;DONE
MOV A,H
CPI 80H
JZ NBCL1 ;NEXT SHIFT OVERFLOWS EXPONENT
CALL BCLZ ;LEFT SHIFT
DCR H
JMP NBCL2
;
; 2'S COMPLEMENT AD (A)+(H)+(L)->(L)
; CARRY FOR OV. WHEN RETURN WRONG SIGN,NO DATA
;* (ADDL)
; A.F.L (2)
ADXP: ORA A ;CHECK 1ST SIGN
PUSH PSW ;SAVE
JM ADXP2 ;-VE
ORA H
ORA L
JP ADXP3 ;ALL +VE
ADXP1: POP PSW
CALL ADDL
MOV A,H
JNC ADDL ;2 OR 0 OV'S ALLOWED
CALL ADDL ;NEED 2ND OV
CMC
RET
ADXP2: ANA H ;1ST VALUE WAS -VE
ANA L
JP ADXP1 ;NOT ALL -VE
ADXP3: POP PSW ;RESTORE, ALL SAME SIGN
CALL ADDL
RC ;1ST OV IS TOO MANY
MOV A,H
;
; 2'S COMPLEMENT ADD (A) +(L)->(L)
; CARRY FOR OV. RETURN RESULT WITH WRONG SIGN
; A,F,L (1)
ADDL: XRA L
JP ADDL1 ;SIGN SAME
XRA L ;RESTORE, SIGNA DIFF., NO OV
ADD L
MOV L,A
ORA A ;NO OV, CLEAR CARRRY
RET
ADDL1: XRA L ;RESTORE A
ADD L
XRA L
JP ADDL2 ;RESULT SAME SIGN, NO OV
XRA L ;OV. RESTORE RESULT W/WRONG SIGN
MOV L,A
STC
RET
ADDL2: XRA L ;RESTORE RESULT
MOV L,A ;NO OV. OCCURRED
RET
;
; ROUND OFF DIVISION QUOTIENT ON BASIC FOR RDR
; (A) RETURNS NEGATIVE SHIFT COUNT
; RESULT ROUNDED TO 16 BIT QUANTITY
;* (NROS), BCRA, NDRDS
; A,F,H,L (3)
RNDQ: PUSH H
CALL BCRA
MOV A,B
XRA H
JM RNDQ1 ;REMAINDER & QUOTIENT DIFF. SIGNS
CALL C2BC
DAD B ; FORM REMAINDER-DIVISOR/2
MOV A,H
CMA
MVI L,0
ANI 80H
JMP RNDQ2
RNDQ1: DAD B ;FROM REMAINDER+DIVISIOR/2
MOV A,H
MVI L,0
ANI 80H
JP RNDQ2 ;NO ROUND
DCX D
RNDQ2: MOV H,A
POP B
;
; NORMALIZE LEFT AND ROUND (DEHL)
; (A) RETURNS REGATIVE SHIFT COUNT
; RESULT ROUNDED TO 16 BIT QUANTITY
;* DERZ
; A,F,D,E,H,L (3)
NRDS: MOV A,D
ORA E
ORA H
ORA L
RZ ;ZERP VALUE
XRA A ;CLEAR SHIFT COUNT
NRDS1: PUSH PSW ;SAVE SHIFT COUNT
MOV A,D
ANI 0C0H
JPO NRDS3 ;LEFT NORMALIZED, NOW ROUND
XCHG
DAD H ;LEFT IF (DEHL)
XCHG
DAD H
JNC NRDS2 ;NO BIT ACROSS DE.HL BOUNDARY
INX D
NRDS2: POP PSW ;SHIFT COUNT
DCR A
JMP NRDS1 ;DO AGAIN
NRDS3: JM NRDS4 ;TRUNCATION ROUNDS -VE
ORA H
JP NRDS4 ;NO BIT, NO ROUND
INX D ;ROUND
ANA D
JP NRDS4 ;RESULT NOT 800H
CALL DERZ ;CORRECT OVERFLOW
POP PSW ;REGAIN SHIFT COUNT
INR A ;XORRECT FOR RET
NRDS4: POP PSW ;SHIFT
RET
;
; MULTIPLY ((DE)*2^(L)) BY 10
;* (FMUL,OVEX,OVMX), NBCL,NDEL,NRDS,MUL
; A,F,B,C,E,H,L (8)
FMULT: LXI B,5000H ;NORMALIZED TEN
MVI H,5 ;AND EXPONENT
;
; FLOATING MULTIPLY
; ((BC)*2^(H)*((DE)*2^(L))=>(DE)*2^(L)
; CARRY FOR OVERFLOW, WHEN RETURN EXTREME VALUES
; (BC)*2^(H) WILL BE LEFT NORMALIZED
; UNLESS (DE) IA ZERO
;* (OVEX,OVMX), NBCL,NDEL,MUL,NRDS
; A,F,D,EL (8)
FMUL: CALL NDEL
RZ ;(DE) ZERO
CALL NBCL
JNZ FMUL1 ;BC NON-ZERO
MOV D,B
MOV E,C
MOV L,H ;PRODUCT IS ZERO
RET
FMUL1: PUSH H ;SAVE EXPONENTS
CALL MUL
CALL NRDS ;ROUND OFF
POP H ;REGAIN EXPONENTS
CALL ADXP ;FORM RESULT EXPONENT
RNC ;NO OVERFLOW
;
; EXPONENT OVERFLOW AET EXTREME VALUES
; (L) HAS WRONG EXPONENT SIGN
;* (OVMX)
; A,F,S,E,L (1)
OVEX: MOV A,L
ORA A
JM OVMX ;REAL EXPONENT +VE
LXI D,0 ;REAL EXPONENT -VE, SET 0 VALUE
MOV L,D
STC ;MARK OVERFLOW
RET
;
; OVERFLOW TO MAXIMUM VALUES
; SET EXTREME VALUE IN (DE)*2^(L). PRESERVE SIGN
; A,F,D,E,L (1)
OVMX: MOV A,D ;SET RESULT SIGN
ORA A
LXI D,7FFFH ;SET + FULL SCALE
MOV L,D ;AND MAX EXPONENT
CM CIDE ;-VE, SET - FULL SCALE
STC ;MARK OVERFLOW
RET
;
; DIVIDE ((DE)*2^(L)) BY TEN
; CARRY FOR OVERFLOW, RETURNS EXTREME VALUES
;* (FDIV). NDEL,NBCL,OVMX,DIV,DERA,DERC,RNDQ,ADXP,OVEX
; A,F,B,C,E,H,L (12)
FDIVT: LXI H,5000H ;NORMALIZED TEN
MVI H,5 ;AND EXPONENT
;
; FLOATING DIVIDE (DE)*2^(L)/(BC)*2^(H)->(DE)*2^(L)
; (BC)*2^(L) WILL BE LEFT NORMALIZED UNLESS (DE)=0
; CARRY FOR OVERFLOW, RETURNS EXTREME VALUES
;* NDEL,NBCL,OVMX,DERA,RNDQ,ADXP,OVEX
; A,F,D,E,L (12)
FDIV: CALL NDEL
RZ ;DIVIDEND IS ZERO
CALL NBCL ;NORMALIZE BOTH INPUTS
JZ OVMX ;DIVISION BY ZERO
PUSH H ;SAVE EXPONENTS
LXI H,0 ;EXTEND DIVIDEND
XRA A ;ANTI OVERFLOW SHIFT COUNT
PUSH PSW ;TO STACK
FDIV1: CALL DERA ;REDUCE DIVIDEND TO AVOID OV
XCHG
CALL DERC
XCHG
POP PSW
INR A ;COUNT F RA SHIFTS
PUSH PSW ;SAVE OVERFLOW SHIFT COUNT
CALL DIV ;DO DIVISION
JC FDIV1 ;OVERFLOW RESULTED
CALL RNDQ ;ROUND OFF QUOTIENT
POP H
ADD H ;ADD OV SHIFTS TO NORM. COUNT
POP H ;RESTORE EXPONENTS
PUsH H ;AND SAVE ON STACK
PUSH PSW ;SAVE NORMALIZE COUNT
MOV A,H
CMA ;COMPLEMENT DIVISOR EXPONENT
MOV H,A
POP PSW ;RESTORE SHIFT COUNT
INR A ;2'S COMP. HERE SO ADXP CAN OV
CALL ADXP
MOV A,L ;QUOTIENT EXPONENT
FDIV3: POP H ;RESTORE ORIGINAL EXPONENT
MOV L,A ;SET QUOTIENT EXPONENT
JC OVEX ;OVERFLOW RESULTED
RET
;
; EXCHANGE FLOATING OPERANDS
; (BC)*2^(H) <=> (DE)*2^(L)
; B,C,D,E,H,L (3)
TRADE: PUSH B
PUSH D
POP B
POP D
PUSH PSW
MOV A,L
MOV L,H
MOV H,A
POP PSW
RET
;
; TRADE OPERANDS & PERFORM FDIV
;* TRADE, FDIV
; A,F,B,C,D,E,H,L
FDIVX: CALL TRADE ;TRADE OPERANDS
JMP FDIV
;
; FLOATING SUBTRACT (BC)*2^(H)-(DE)*2^(L)=>(DE)*2^(L)
; (BC)*2^(L) WILL BE LEFT NORMALIZED
; CARRY FOR OV, WHEN RETURN EXTREME VALUES
;* (FADD), NBC,NDEL,ADDL,DERN,DERC,TRADE
; A,F,D,E,L (8)
FSUB: CALL C2DE ;CHANE SI
;
; FLOATING ADD (BC)*2^(H)+8DE)*2^(L)->(DE)*2^(L)
; (BC)*2^(L) WILL BE LEFT NORMALIZED
; CARRY FOR OV, WHEN RVVALUES
;*NBCL,NDEL,ADDL,DERN,DERC,TRADE
; A,F,D,E,L (8)
FADD: CALL NBCL
RZ ;ADDEND IS ZERO
CALL NDEL ;NORMALIZE BOTH
JZ FADD8 ; (DE)=0
FADD2: MOV A,L
CMA ;ERROR BY 1
PUSH H
MOV L,H
CALL ADDL ;FORM EXPONENT DIFF -1
MOV A,L
POP H
JC FADD7 ;OVERFLOW, RESULT SIGN WRONG
ORA A
JM FADD6 ; (DE) >= (BC)
INR A ;CORRECT
JM FADD8 ;VAUE WAS 7F, (DE)=0
CPI 16
JNC FADD8 ;2ND OPERAND EFFECTIVELY ZERO
FADD3: CALL DERN ;ALIGN, (BC) > (DE)
XCHG
MOV A,B
XRA H
JM FADD4 ;SIGNS STILL SAME, NO OV.
DAD B
MOV A,B
XRA H
JP FADD5 ;SIGNS STILL SAME, NO OV.
XCHG
MOV A,D
RAL
CMC
CALL DERC ;CORRECT
INR L ;CORRECT FOR SHIFT
MOV A,L
CPI 80H
JZ OVEX ;OVERFLOW
ORA A ;RESET CARRY
RET
FADD4: DAD B ;ADD
FADD5: XCHG ;RESULT TO (DE)
MOV L,H ;RESLT HAS EXPONENT OF (BC)
ORA A ;RESULT CARRY, NO OV.
RET
FADD6: INR A ;CORRECT
JZ FADD3 ; (DE) & (BC) SAME MAGNITUDE
PUSH H ;SAVE EXPONENTS
PUSH B ;AND (BC)
CALL TRADE ;TRADE OPENANDS
CALL FADD2 ;NOW (BC) > (DE)
MOV A,L ;RESULT EXPONENT
POP B ;RESTORE OPERAND IN (BC)
POP H ;AND ITS EXPONENT
MOV L,A ;RESULT EXPONENT
RET
FADD7: ORA A ;ONE OPERAND EFFECTIVELY ZERO
RP ;(BC) << (DE)
FADD8: MOV L,H
MOV D,B ; (DE) << (BC)
MOV E,C
RET
;
; COMPARE (DE) WITH 3276. USE ARS. VALUENUS FLAG IF < 3276. ELSE PLUS
; A,F (1)
CPMX: MOV A,D
ORA A
MOV A,E
JM CPMX1 ;-VE VALUE
SUI 3276 MOD 256
MOV A,D
SBI 3276/256
RET
CPMX1: ADI 3276 MOD 256
MOV A,D
ACI 3276/256
CMA
ORA A ;SET FLAGS
RET
;
; NORMALIZE (DE)*2^(L) RIGHT UNTIL
; MANTISSA INTEGRAL OR RB BIT NON-ZERO
; ZERO FLAG FOR INTEGER REPRESENTATION
; ELSE MINUS FLAG FOR OVERANGE INTEGER
; OR PLUS FLAG FOR A FRACTIONAL SEGMENT
;* DERA
; A,F,D,E,L (2)
NDER: MOV A,L
ORA A
NDER1: JM NDER2 ;PURELY FRACTIONAL
MVI A,16
CMP L
RZ ;INTEGER REPRESENTATION
RM ;OVERRANE INTEGER
NDER2: MOV A,E ;(L) < 16
ANI 1
RNZ ;FRACTIONAL PART REMAINS
CALL DERA ;ARITH. RIGHT SHIFT
INR L ;CORRECT EXPONENT
JMP NDER1
;
; CONVERT (DE)*2^(L) TO INTEGER (DE)*10^(L)
; ON INPUT +1 > (DE) >= -1
; ON OUTPUT 32767 >= (DE) >= -32768
;* FDIVT,DERA,NDER,CPMX,FMULT
; A,F,D,E,L (16)
FIX: PUSH H
PUSH H
MVI B,0
MOV A,L
ORA A
JM FIX7 ;VALUE
CPI 16
JM FIX7 ;FRACTIONAL PART
JZ FIX6 ;INTEGER
FIX1: PUSH B
CALL FDIVT ;RESCALE
POP B
INR B ;ADVANCE DECIMAL EXPONENT
FIX2: MOV A,L
CPI 16
JZ FIX6 ;REDUCED TO INTERGER
JP FIX1 ;OVERANGE INTEGER
FIX3: SUI 15
MOV L,A
JZ FIX5 ;MAGNITUDE 2*INTEGER
FIX4: CALL DERA ;MAGNITUDE > 2*INTEGER
INR L
JM FIX4 ;STILL TOO LARGE MAGNITUDE
FIX5: CALL DERA ;REMOVE LAST FRACTIONAL BIT
JNC FIX6 ;NO ROUNDING
MOV A,D
ORA A
JM FIX6 ;TRUNCATION ROUNDS -VE
INX D
FIX6: POP H
MOV L,B ;SAVE DEC. EXPONENT
POP B
RET
FIX7: CALL NDER ;POSSIBLY FRACTIONAL
JZ FIX6 ;INTEGER
MOV A,L
ORA A
JM FIX9
CPI 13
JM FIX9
JNZ FIX8 ;MAY BE >= 3276
CALL CPMX
JM FIX9
JP FIX2
FIX8: CALL CPMX
MOV A,L
JP FIX3 ; >= 3276, DONE SCALING
FIX9: PUSH B
CALL FMULT ; ADJUST SCALE
POP B
DCR B
DCR B ;AND DEC. EXPONENT
JMP FIX7
;
; ROUND "FIXED" SIGNED VALUE (DE)*10^(L) TO 4 DIGITS
;* RD4D, C2DE
; A,F,D,E,H,L (6)
RDS4D: MOV A,D
ORA A
JP RD4D ;POSITIVE
CALL C2DE ;INVERT SIGN
CALL RD4D
JMP C2DE ;RESTORE SIGN
;
; RUND "FIXED" SIGNED VALUE (DE)*10^(L) TO 3 DIGITS
;* RD3D, C2DE
; A,F,D,E,6)
RDS3D: MOV A,D
ORA A
JP RD3D ;POSITIVE
CALL C2DE ;INVERT SIGN
CALL RD3D
JMP C2DE ;RESTORE SIGN
;
; ROUND "FIXED" +VE VALUE (DE)*10^(L) TO 4 DIGITS
;* (RD3D), DTEN
; A,F,D,E,L (6)
RD4D: PUSH B
LXI B,10000
JMP RD3D1
;
; ROUND "FIXED" +VE VALUE (DE)*10^(L) TO 3 DIGITS
;* DTEN
; A,F,D,E,L (6)
RD3D: PUSH B
LXI B,-1000
RD3D1: XCHG
PUSH H
DAD B
POP H
JNC RD3D3 ;LESS THAN 1000 (10000)
RD3D2: CALL DTEN
INR E
PUSH H
DAD B
POP H
JC RD3D2 ;> 1000 (10000)
CPI 5 ;CHECK REMAINDER FOR ROUNDING
JC RD3D3 ;NO ROUNDING NEEDED
INX H
PUSH H
DAD B
POP H
JC RD3D2 ;ROUNDED TO 1000 (10000)
RD3D3: POP B ;RESTORE
XCHG
RET
;
; T10^(L)
;* C2DE,COUT,EXDG,TDZS
TFIX: PUSH PSW
PUSH B
MVI B,4
TFIX0: PUSH D
PUSH H
MOV A,D
ORA A
JP TFIX1 ;+VE VALUE
CALL C2DE ;-VE VALUE
MVI C,'-'
CALL COUT
TFIX1: XCHG
MOV A,E
ADI 5
MOV E,A
TFIX2: DCR E
JM TFIX7 ;FLOT ;-VE
JZ TFIX7 ;DECIMAL PT. HERE
CALL EXDG
JNZ TFIX9 ;NON-ZERO, END SUPPRESS
DCR B
JNZ TFIX2
CALL COUT ;AT LEAST 1 DIGIT
MVI C,'.'
CALL COUT
DCR B
JZ TFIX5 ;VALUE < 10000
TFIX3: MVI C,'E'
TFIX4: CALL COUT
MOV L,E
MVI H,0
CALL TDZS ;DUMP POSITIVE EXPONENT
TFIX5: POP H
POP D
POP B
POP PSW
RET
TFIX6: DCR E
JNZ TFIX8 ;DEC. PT. NOT HERE
TFIX7: MVI C,'.'
CALL COUT
TFIX8: CALL EXDG
TFIX9: CALL COUT
DCR E
JNZ TFIX6
DCR B
JNZ TFIX5 ;NO EXPONENT NEEDED
JP TFIX3 ; +VE EXPONENT
MOV A,E
ADI 4
JP TFIX5 ;NO NFG. EXPONENT
CMA
INR A
MOV E,A ;COMPLEMENT -VE EXPONENT
MVI C,'E'
CALL COUT
MVI C,'-'
JMP TFIX4
;
; TYPE A FLOATING VALUE TO 4 DECIMAL DIGIT
;* FIX,RDS4D,TFIX
TFLT: PUSH PSW
PUSH B
PUSH D
PUSH B
CALL FIX
CALL RDS4D ;ROUND 4 DIGIT
CALL TFIX ;TYPE I)
POP B
POP D
POP H
POP PSW
RET
;
; GET A PRINTING CHARACTER
;* CECHO
; A,F
GPRT: CALL CECHD
INR A
ANI 7FH
CPI ' '+2 ;IGNORE SPACE, RUB, CONTROL
JC GPRT
DCR A
RET
;
; INPUT AND ECHO A CHARACTER. CONVERT TO DECIMAL
; TO HEX, ELSE RETURN CARRY & CHARACTER
; CARRY & ZERO FLAGS IF CHAR. = '.' OR ';'
; IGNORE SPACE, RUB & CONTROOL CODES
;* GPRT
; A,F
CECHD: CALL GPRT
CPI '.'
STC
RZ
CPI '0'
RC ; < 0
CPI '9'+1
CMC
RC ; > 9
ANI 0FH
RET
;
; COMBINE DIGIT N (A) WITH VALUE IN (HL)
; INPUT IS DECIMAL. RETURN CARRY IF RESULT > 3275
;* MUL10,INDEX
; A,F,H,L (4)
DIGIN: CALL MUL10
CALL INDEX
MOV A,L
SUI 3276 MOD 256
MOV A,H
SBI 3276/256
CMC
RET
;
; READ 2 DIGIT DECIMAL VALUE TO (R)
; CONVERT TO BINARY IN 8. SAVE EXIT CHAR IN (A)
;* CECHO
; A,F,B (RECURSIVE)
R2DC: MVI B,0
R2DC1: CALL CECHD
R2DC2: JNC R2DC3 ;DIGIT
CPI '+'
JZ R2DC1 ;IGNORE UNARY +
CPI '-'
RNZ ;EXIT. NOT -
CALL R2DC ;UNARY -
PUSH PSW ;SAVE EXIT CHAR
MOV A,B
CMA
INR A
MOV B,A ;CHANGE SIGN
POP PSW
POP PSW ;RESTORE EXIT CHAR.
RET
R2DC3: PUSH D
PUSH B
MOV C,B
R2DC4: MOV B,C ;PREV. DIGIT
MOV C,A ;THIS DIGIT
CALL CECHD ;GET NEXT DIGIT
JNC R2DC4 ;VALID DIGIT
PUSH PSW ;SAVE EXIT CHAR.
MOV A,B ;MS DIGIT
ADD A ; 2*
ADD A ; 4*
ADD B ; 5*
ADD A ; 10*
ADD C ; LS DIGIT
MOV D,A ;SAVE TEMPORARY
POP PSW ; RESTORE EXIT CHAR
POP B ; RESTORE C
MOV B,D ; OUTPUT VALUE
POP D ; RESTORE D
RET
;
; READ EXPONENT IF CHAR='E'
; DECIMAL VALUE IS SUMMED WITH (L)
;* R2DC
; A,F,L (RECURSIVE)
REXP: CPI 'E'
RNZ ;NO EXPONENT
PUSH B
CALL R2DC ;GET EXPONENT VALUE TO B
PUSH PSW ;SAVE EXIT CHAR
MOV A,B
ADD L
MOV L,A ;FROM ACTUAL EXPONENT
POP PSW ;RESTORE EXIT CHAR
POP B ;RESTORE
RET
;
; INPUT A FLOATING POINT VALUE FROM CONSOLE
; TO (DE)*2^(L)
; SET CARRY FOR INPUT OUT OF RANGE
; LOAD WITH 2.7183 FOR "E", 3.1416 FOR "P"
; RETURN EXIT CHARACTER IN (A)
;* (FLOT), CECHD,CEDE,DIGIN,FMULT,FDIVT
; A,F,D,E,L (RECURSIVE)
FIN: PUSH B
PUSH H
XRA A
MOV B,A ;DECIMAL EXPONENT
LXI H,0 ;CLEAR ACCUMULATOR
FIN0: CALL CECHD
JNC FIN3 ;DIGIT
JZ FIN4 ; . OR ;
CPI '+'
JZ FIN0 ;IGNORE UNARY +
CPI '-'
JZ FIN2 ;UNARY -
CPI 'E'
JZ FIN1 ;LOAD 2.7183
CPI 'P'
JNZ FIN9 ;NOT
LXI H,31416 ;VALUE OF PI
MVI B,-4 AND 0FFH ;AND EXPONENT
JMP FIN6 ;WAIT FOR EXIT
FIN1: LXI H,27183 ;VALUE OF E
MVI B,-4 AND 0FFH ;AND EXPONENT
JMP FIN6 ;WAIT FOR EXIT
FIN2: CALL FIN
PUSH PSW ;SAVE EXIT CHAR
CALL C2DE ;CHANGE SIGN
POP PSW ;EXIT CHAR.
MOV C,L
POP H
MOV L,C
POP B
RET
FIN3: CALL DIGIN
JC FIN8 ;NO MORE ROOM
CALL CECHD
JNC FIN3
JNZ FIN9 ;'.'
FIN4: CALL CECHD ;DECIMAL SET
JNC FIN5 ;VALID INPUT
JZ FIN4 ;IGNORE FURTHER '.'
JMP FIN9 ;EXIT
FIN5: CALL DIGIN
DCR B
JNC FIN4 ;ROOM FOR MORE DIGITS
FIN6: CALL CECHD
JNC FIN6 ;WAIT FOR EXIT
JZ FIN6 ;WAIT FOR EXIT
JMP FIN9
FIN7: INR B ;ADVANCE DEC. EXPONENT
FIN8: CALL CECHD
JNC FIN7 ;VALID DIGIT
JZ FIN6 ;DEC. PT., WAIT FOR EXIT
FIN9: XCHG ;VALUE TO (DE)
POP H
MOV L,B ;DECIMAL EXPONENT
POP B
CALL REXP ;GET EXPONENT. IF ANY
;
; CONVERT (DE)*10^(L) TO (DE)*2^(L)
; ON INPUT 32767 >= (DE) > -32768
; ON OUTPUT +1 >= (DE) > -1
; SET CARRY FOR INPUT OUT OF RANCE
;* FMUL,FDIVT
; B,D,E,L (17)
FLOT: PUSH PSW
PUSH H
PUSH B
MOV H,L ;DECIMAL EXPONENT
MVI L,16 ;DEFAULT BINARY POINT
MOV A,B
ORA A
JZ FLOT2 ;INTEGRAL VALUE
JM FLOT4 ;DEC. EXPONENT <0
FLOT1: PUSH B
CALL FMULT ;RESCALF
POP H
JC FLOT5 ;OVERRANGE
DCR B
JNZ FLOT1 ;AGAIN
FLOT2: POP B
MOV A,L
POP H
MOV L,A
POP PSW
ORA A ;RERRY
RET
FLOT3: INR B
JZ FLOT2 ;DONE
FLOT4: PUSH B
CALL FDIVT ;RESCALE
POP B
JNC FLOT3 ;NOT OVERRANGE
FLOT5: POP B ;RESTORE
MOV A,L ;KEEP OVERFLOWED EXPONENT
POP H ;RESTORE
MOV L,A ;SET OUTPUT EXPONENT
POP PSW
STC ;MARK OVERFLOW
RET
;
; SEARCH TABLE FOR (A); RETURN INDEX OF ENTRY
; RETURNED VALUE OF 0 FOR ENTRY NOT FOUND
; 1ST TABLE ENTRY IS TABLE LENGTH, RANGE 1-255
; TABLE IS IDENTIFIED ON INPUT BY (HL)
; A,F (3)
STBL: PUSH B
PUSH H ;SAVE TABLE ID
MOV C,M ;GET LENGTH. ASSUMED NON-ZERO
INR C
STBL1: DCR C
JZ STBL2 ;ENTRY NOT FOUND
INX H
CMP M
JNZ STBL1 ;NOT THIS ENTRY
POP H ;RESTORE TABLE ID
MOV A,M ;GET LENGHT
SUB C ;FORM ENTRY INDEX
INR A
POP B ;RESTORE
RET
STBL2: POP H
POP B
XRA A ;RETURN ZERO VALUE & FLAG
RET
;
; NULL OPERATOR
NULL: RET
; REDUCE ALGERAIC PAIR
; [(BC)*2^(H)] OP'N [(DE)*2^ ] -> (DE)*2^(L)
; "OP'N" IS 4TH BYTE FROM TOP OF CALLING ROUTINES
; STACK, WHERE THE 1ST BYTE IS TOP OF STACK
; A,F,D,E,L
RED: PUSH H
LXI H,7
DAD SP ;POINT TO "LAST"
MOV A,M ;GET LAST
POP H
;
; JUMP INDIRECT A (A)TH OF TABLE
; A,F
JINXT: PUSH H ;SAVE HL
LXI H,TBL
CALL INDX2 ;INDEX IT
MOV A,M ;LOW ADR. BYTE
INX H
MOV H,M ;HI ADR. BYTE
MOV L,A
XTHL ;RESTORE HL, PLACE ADR. ON STACK
RET ;TRANSFER TO CALCULATED LOCATION
;
; GET AN OPERATION.
; IF ILLEGAL SET CARRY, RETURN ZERO
; ELSE SET ZERO FLAG FOR "("
; SET MINUS FLAG FOR "+-*/"
; SET PLUS FLAG FOR RN OPCODE
; A,F
GOPN: CALL GPRT
;
; TFST ASCII CHARACTER (A) AGAINST OPCODE TABLE
; IF ILLEGAL SET CARRY, RETURN ZERO
; ELSE SET ZERO FLAG FOR "("
; SET MINUS FLAG FOR "+-*/"
; SET PLUS FLAG FOR ")="
; RETURN OPCODE
; A,F
TOPCD: PUSH H
LXI H,OPTBL
CALL STBL
POP H
STC
RZ ;NOT FOUND, ERROR
CPI 5 ;OPCODE FOR "("
STC
CMC ;CLEAR CARRY
RET
;
; EVALUATE EXPRESSIONS FROM LEFT TO RIGHT
; WITH NO OPERATOR PRECEDENCE
; RETURN RESULT AS (DE)*2^(L)
; SET CARRY FOR ERROR RETURN
; (A) = 0 FOR SYNTAX ERROR
; 1 FOR OVERFLOW ERROR
; 6 FOR EXPRESSION TERM. BY ")"
; 7 FOR EXPRESSION TERM. BY "="
; A,F,D,E,L (RECURSIVE)
EVAL: XRA A ;THIS:=NULL
EVAL1: PUSH B ;ENTRY WHEN OP'N DETERMINED
PUSH H
EVAL2: PUSH PSW ;LAST:=THIS
MOV B,D
MOV C,E
MOV H,L ;OP1:=OP2
CALL FIN ;OP2:=VALUE; THIS:=OP'N
JC EVALV ;INPUT OVERRANGE ERROR
EVAL3: CALL TOPCD ;TEST OPCODE & INTERPRET
JC EVALX ;SYNTAX ERROR
JZ EVAL5 ;(
PUSH PSW ;SAVE THIS
CALL RED ;REDUCE EXPRESSION
JC EVAL0 ;OVERFLOW ERROR
POP PSW ;GET THIS
POP B ;PURGE LAST
JM EVAL2 ;THIS IS */+-
MOV C,L
POP H ;RESTORE
MOV L,C
POP B
RET
EVAL4: CALL GPRT ;GET NEXT OP'N
JMP EVAL3
EVAL5: MOV A,D
ORA E
JNZ EVALX ;I.E. "VALUE("
EVAL6: CALL EVAL1
EVAL7: JC EVAL9 ;ERROR
CPI 6
JZ EVAL4 ;), TERM COMPLETE
CALL TFLT ;=, LTST TERM
CALL GOPN ;GET NEXT OPERATOR
JM EVAL6 ;*/+- DETERMINED
JNZ EVAL7 ;= ( IS ERROR
EVALX: XRA A ;SYNXX ERROR
JMP EVAL9
EVAL0: POP B
EVALV: MVI A,1 ;OVERFLOW ERROR
EVAL9: POP B ;PURGE STACK
POP H
POP B ;RESTORE ENTRY (BC) & (H) ON ERROR
STC ;MARK ERROR
RET
;
; MASTER CONTROL
TEST1: ORA A ;CHECK ERROR CODE
LXI H,OVM
JNZ TEST3 ;OVERFLOW ERROR
TEST2: LXI H,ERRM ;SYNTAX ERROR
TEST3: CALL TSTR
TEST: CALL CRLF
CALL EVAL
JC TEST1
SUI 7 ;CHECK FOR '='
JNZ TEST2 ;NOT =, ERROR
CALL TFLT
JMP TEST
;
OPTBL: DB 7,'*/'
DB '+-()'
DB '='
;
; OPERATOR TABLE
TBL: DW NULL
DW FMUL,FDIVX
DW FADD,FSUB
;
OVM: DB ' '
DB 'OVER'
DB 'FLOW'
ERRM: DB ' ERR'
DB 'OR '
DB '***',0
;
IF DEBUG
;
; COPIES OF ROUTINE FROM YALVER. 2.3
; INCLUDED FOR COMPLETENESS ONLY
;
CR EQU 0DH ;ASCII CR
LF EQU 0AH ;ASCII LF
;
CRLFM: DB CR,LF,0
;
; TYPE STRING ON CONSOLE TILL 0 BYTE
; H,L
TSTR: PUSH PSW
PUSH B ;SAVE
TSTR1: CALL SEXIT
CALL COUT ;OUT TO CONSOLE
JMP TSTR1 ;GET NEXT
;
; SRING OUTPUT EXIT TEST
; RESTORES BC & PSW FROM CALLING ROUTINES STACK
; AND EXITS TO ROUTINE THAT CALLED CALLING ROUTINE
SEXIT: MOV A,M
INX H ;ADVANCE POINTER
MOV C,A ;PREPARE FOR OUTPUT
ORA A ;TEST FOR ZERO BYTE
RNZ ;NOT END OF STRING
POP B ;DOWN IN STACK, PURGE RETURN ADR.
POP B ;RESTORE ORIGINAL BC
POP PSW ;RESTORE A,FLAGS
RET
;
; CR & LF TO CONNSOLE
CRLF: PUSH H ;SAVE
LXI H,CRLFM
CALL TSTR
POP H
RET
;
; INPUT FROM CONSOLE, ECHOED & RETURNED IN A
; LF APP TO CR. RESULT COMPARED TO CR
; A,F
CECHO: CALL CINX
CPI CR
JZ CRLF
;
; OUTPUT (A) TO CONSOLE
; A,F
COUTA: PUSH B
MOV C,A
CALL COUT
POP B
CPI CR
RET
;
; CONSOLE INPUT AND MASK OFFO BIT 8
; A,F
CINX: CALL CIN
ANI 7FH
RET
;
; EXTRACT A DEC. DIGIT, 10^((B)-1), FROM (HL)
; MORE SIG, DIGIT HAVE BEEN EXTRACTED
; ASCII DIGIT RETURED IN (C) & (A)
; WITH ZERO FLAG FOR DIGIT=ZERO
; A,F,C,H,L
EXDG: PUSH D
PUSH H ;SAVE VALUE
LXI H,TPWRT-2
MOV A,B
CALL INDX2 ;POINT TO POWER OF TEN
MOV E,M
INX H
MVI C,'0'-1
EXDG1: INR C
DAD D
JC EXDG1 ;DO AGAIN
CALL SUBDE ;OVER, DO AGAIN
MOV A,C ;RESULT
POP D ;RESTORE
MOV C,A
CPI '0' ;COMPARE WITH ZERO
RET
;
; TABLE OF -10^N
TPWRT: DW -1
DW -10,-100
DW -1000,-10000
;
; TYPE (HL) IN DECIMAL ON CONSOL
; SUPPRESS LEADING ZEROES
TDZS: PUSH H
PUSH B
PUSH PSW
TDZS1: MVI B,5
TDZS2: CALL EXDG ;EXTRACT A DIGIT
JNZ TDZS6 ;NON-ZERO, END SUPPRESS
DCR B
JNZ TDZS2 ;CONTINUE SUPPRESSION
TDZS3: CALL COUT ;PRINT LAST DIGIT
TDZS4: POP PSW
POP B
POP H
RET
TDZS5: CALL EXDG ;GET NEXT DIGIT
TDZS6: CALL COUT
DCR B
JNZ TDZS5
JMP TDZS4
;
; END OF COPIED ROUTINES
;
ENDIF
;
END