CP/M

home *** CD-ROM | disk | FTP | other *** search

/ CP/M / CPM_CDROM.iso / simtel / cpmug / cpmug018.ark / MATH.ASM < prev next >

Wrap

Assembly Source File | 1984-04-29 | 38.7 KB | 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