home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpmug / cpmug018.ark / MATH.ASM < prev    next >
Assembly Source File  |  1984-04-29  |  40KB  |  1,469 lines
  1.  
  2. ; REF. NO. BC3
  3. ; PROGRAM TITLE MATH
  4.  
  5. ;
  6. ;
  7. ;
  8. ;
  9. ;
  10. ;ARITHMETIC ROUTINES-MODIFIED 23 APR. 1976
  11. ;BY C.B. FALCONER, YALE UNIVERSITY, NEW HAVEN, CONN.
  12. ;
  13. ;
  14. FALSE   EQU     0
  15. TRUE    EQU     NOT FALSE
  16. DEBUG   EQU     TRUE
  17. ;
  18. ;
  19. ; FLOATING POINT REPRESENTATION CAN EXPRESS VALUES
  20. ; IN THE RANGE +-.735*10^-39 TO +-.85*10^38 (DECIMAL)
  21. ; WITH BETWEEN 4 AND 5 DECIMAL DIGIT ACCURACY
  22. ; A FLOATING POINT VAUE IS REPRESENTED BY A 2'S
  23. ; COMPEMENT 16 BIT MANTISSA, WHOSE VALUE IS IN THE
  24. ; RANGE 0.5 > MANTISSA >= -0.5. THE MANTISSA CAN BE
  25. ; CONSIDERED AS THE SIGNED INTEGER VALUE/65536.
  26. ; LEFTMOST BIT OF THE MANTISSA. IS REPRESENTED BY
  27. ; AND 8 BIT 2'S COMPLEMENT INTEGER. POSITIVE VALUES
  28. ; SPECIFY RIGHTWARDS MOVEMENT OF THE BINARY POINT. ETC
  29. ;
  30. ; "FIXED" POINT REPRESENTATION OF THESE VALUE CONSISTS
  31. ; OF A 16 BIT 2'S COMPLEMENT INTEGER (IN THE RANGE
  32. ; -32768 TO 32767), AND AN 8 BIT 2'S COMPLEMENT DECIMAL
  33. ; EXPONENT WHICH REPRESENTS A POWER OF THEN MULTIPLIER
  34. ; THIS REPRESENTATION IS USEDFOR INPUT/OUTPUT ONLY
  35. ;
  36. ; ROUTINE "FIX" CONVERTS FLOATING TO FIXED REPRESENTATION
  37. ; ROUTINE "FLOT" CONVERTS FIXEDTO FLOATING REPRESENTATION
  38. ;
  39.         IF      NOT DEBUG
  40.         ORG     3000H
  41. ;
  42. CIN     EQU     3803H
  43. COUT    EQU     3808H
  44. TSTR    EQU     3D81H
  45. CRLF    EQU     3DC5H
  46. CECHO   EQU     3E83H
  47. EXDG    EQU     36D2H
  48. TDZS    EQU     36FFH
  49.         ENDIF
  50. ;
  51.         IF      DEBUG
  52. ;
  53.         ORG     2000H
  54. ;
  55.         LXI     SP,2E8AH        ; FOR YALE OS 2.3 & 12K CORE
  56.         JMP     TEST            ;CONECTOR
  57. CIN:    JMP     3803H
  58. COUT:   CALL    3809H
  59.         MOV     A,C             ;ENDURE VALUE IN (A)
  60.         RET
  61.         ENDIF
  62. ;
  63. ; INDFX (HL)+4*(A)->HL
  64. ; A.F.H.L   (1)
  65.  
  66. INDX4:  ADD     A
  67. ;
  68. ; INDFX (HL)+2*(A)->(HL)
  69. ; A,F,H,L       (I)
  70. INDX2:  ADD     A
  71. ;
  72. ; INDEX (HL)+(A)->(HL)
  73. ; A,F,H,L       (1)
  74. INDEX:  ADD     L
  75.         MOV     L,A
  76.         RNC     
  77.         INR     H
  78.         RET
  79. ;
  80. ; SUBTRACT (BC) FROM (HL) SUBROUTINE
  81. ; CARRY IF ORIGINALLY (BC) > (HL)
  82. ; A,F,H,L       (1)
  83. SUBBC:  MOV     A,L
  84.        SUB     C
  85.         MOV     L,A
  86.         MOV     A,H
  87.         SBB     B
  88.         MOV     B,A
  89.         RET
  90. ;
  91. ; SUBTRACT (DE) FROM (HL)
  92. ; CARRY ID ORIGINAL (DE) > (HL)
  93. ; A,F,H,L       (1)
  94. SUBDE:  MOV     A,L
  95.         SUB     E
  96.         MOV     L,A
  97.         MOV     A,H
  98.         SBB     D
  99.         MOV     H,A
  100.         RET
  101. ;
  102. ; MULTIPLY (HL) BY 10
  103. ; H,L   (2)
  104. MUL10:  PUSH    D
  105.         PUSH    H
  106.         POP     D       ;COPY HL TO DE
  107.         DAD     D       ; 2*
  108.         DAD     H       ; 4*
  109.         DAD     D       ; 5*
  110.         DAD     H       ; 10*
  111.         POP     D       ; RESTORE DE
  112.         RET
  113.  
  114. ;
  115. ; DIVIDE INTEGER (HL) BY 10
  116. ; REMAINDER APPEARS IN (A) WITH FLAGS SET
  117. ; A,F,H,L       (2)
  118. DTEN:   PUSH    B       ;SAVE BC
  119.         MVI     C,10    ;DIVISOR
  120. DTEN1:  XRA     A       ;CLEAR
  121.         MVI     B,-16 AND 0FFH   ;ITERATION COUNT
  122. DTEN2:  DAD     H
  123.         RAL             ;SHIFT OFF INTO (A)
  124.         CMP     C       ;TEST
  125.         JC      DTEN3   ;NO BIT
  126.         SUB     C       ;BIT=1
  127. DTEN3:    INR    B    ;DONE?
  128.         JM      DTEN3   ;NO
  129.         ORA     A       ;SET FLAGS FOR REMAINDER, CLEAR CARRY
  130.         POP     B       ;RESTORE
  131.         RET
  132. ;
  133. ; INTEGER DIVIDE 16 BY 8 BIT QUANTITIES
  134. ; (HL)/(A) => (HL); REMAINDER => (A)
  135. ; SET CARRY FPR DIVISION BY ZERO, PRESERVE HL
  136. ;* DTEN
  137. ; A,F,H,L       (2)
  138. DQUIK:  ORA     A
  139.         STC     
  140.         RZ              ;DIVISION BY ZERO
  141.         PUSH    B       
  142.         MOV     C,A
  143.         JMP     DTEN1
  144. ;
  145. ; 2'S COMPLEMENT (BC)
  146. ; A,B,C (1)
  147. C2BC:   DCX     B
  148. ;
  149. ; 1'S COMPLEMENT (BC)
  150. ; A,B,C         (1)
  151. CIBC:   MOV     A,C
  152.         CMA     
  153.         MOV     C,A
  154.         MOV     A,B
  155.         CMA     
  156.         MOV     H,A
  157.         RET
  158. ;
  159. ; 2'S COMPLEMENT (DE)
  160. ; A,D,E (1)
  161. C2DE:   DCX     D
  162. ;
  163. ; 1'S COMPLEMENT (DE)
  164. ; A,D,E (1)
  165. CIDE:   MOV     A,E
  166.         CMA     
  167.         MOV     E,A
  168.         MOV     A,D
  169.         CMA
  170.         MOV     D,A
  171.         RET
  172. ;
  173. ; 2'S COMPLEMENT (DEHL)
  174. ;* C2DE,CIDE
  175. ; A,F,D,E,H,L   (2)
  176. C2DHL:  XCHG
  177.     CALL    C2DE
  178.         XCHG
  179.         CALL    CIDE
  180.         MOV     A,H
  181.         ORA     L
  182.         RNZ
  183.         INX     D       ;PROPAGATE CARRY
  184.         RET
  185. ;
  186. ; (BC) LEFT SHIFT, ZERO INSERT
  187. ; A,F,B,C       (1)
  188. BCLZ:   ORA     A       ;CLEAR CARRY
  189. ;
  190. ; (BC) LEFT SHIFT, CARRY INSERT
  191. ; A,F,B,C       (1)
  192. BCLC:   MOV     A,C
  193.         RAL
  194.         MOV     C,A
  195.         MOV     A,B
  196.         RAL
  197.         MOV     B,A
  198.         RET
  199. ;
  200. ; ARITH. SHIFT RIGHT (BC)
  201. ; A,F,B,C       (1)
  202. BCRA:   MOV     A,B
  203.         RAL
  204. ;
  205. ;       (BC) RIGHT SHIFT, CARRY IN
  206. ; A,F,B,C       (1)
  207. BCRC:   MOV     A,B
  208.         RAR
  209.         MOV     B,A
  210.         MOV     A,C
  211.         RAR
  212.         MOV     C,A
  213.         RET
  214. ;
  215. ; ARITHMETIC RIGHT SHIFT (DE)
  216. ; A,F,D,E       (1)
  217. DERA:   MOV     A,D
  218.         RAL
  219.         JMP     DERC
  220. ;
  221. ; (DE) RIGHT SHIFT, ZERO  INSERT (DE)
  222. ; A,F,D,E,  (1)
  223. DERZ:   ORA     A       ;CLEAR CARRY
  224. ;
  225. ; (DE) RIGHT SHIFT, ZERO INSERT
  226. ; A,F,D,E       (1)
  227. DERC:   MOV     A,D
  228.         RAR
  229.         MOV     D,A
  230.         MOV     A,E
  231.         RAR
  232.         MOV     E,A
  233.         RET
  234. ;
  235. ; ARITH. RIGHT SHIFT (DE) (A) TIMES
  236. ;* DERA
  237. ; A,F,D,E       (3)
  238. DERN:   ORA     A
  239. DERN1:  RZ              ;ZERO COUNT
  240.         PUSH    PSW
  241.         CALL    DERA    ;ARITH. RIGHT SHIFT
  242.         POP     PSW
  243.         DCR     A
  244.         JMP     DERN1
  245. ;
  246. ; INTEGER (POA.) MULTIPLY DE*BC->DEHL
  247. ; D,E,H,L       (3)
  248. IMUL:   PUSH    PSW
  249.         LXI     H,0     ;CLEAR ACCUMULATOR
  250.         MVI     A,-16 AND 0FFH   ;ITERAITION COUNT
  251. IMUL1:  PUSH    PSW     ;SAVE ITERATION
  252.  
  253.         DAD     H       ;LEFT SHIFT, CARRY OUT
  254.         MOV     A,E     ;LEFT SH M'PLIER INSERT O'FLOW
  255.         RAL
  256.         MOV     E,A
  257.         MOV     A,D
  258.         RAL
  259.         MOV     D,A
  260.         JNC     IMUL2   ;NO BIT
  261.         DAD     B       ;ADD IN MULTIPLICAND
  262.         JNC     IMUL2   ; NO OVERFLOW
  263.         INX     D       ;KEEP OVERFLOW
  264. IMUL2:  POP     PSW     ;ITERATION COUNT
  265.         INR     A
  266.         JM      IMUL1   ;DO AGAIN
  267.         POP     PSW     ;RESTORE
  268.         RET
  269. ;
  270. ; INTEGER (POS.) DIVIDE. (DEHL)/(BC)=>(DDE)
  271. ; REMAINDER APPEARS IN (HL)
  272. ; CARRY FOR OV, WHEN REGISTERS UNCHANGED
  273. ;* C2BC
  274. ; F,D,E,H,L     (3)
  275.  
  276. IDIV:   PUSH    PSW
  277.         MOV     A,E     ;CHECK FOR OVERFLOW
  278.         SUB     C
  279.         MOV     A,D
  280.         SBB     B
  281.         JC      IDIV1   ;NO OVERFLOW
  282.         POP     PSW     ;RESTPRE (A)
  283.         STC     
  284.         RET
  285. IDIV1:  CALL    C2BC    ;CHANGE (BC) SIGN
  286.         XCHG            ;DO ARITHMETIC IN (HL)
  287.         MVI     A,-16 AND 0FFH   ;ITERATION COUNT
  288. IDIV2:  PUSH    PSW     ;SAVE ITERATION COUNT
  289.         DAD     H       ;LEFT SHIFT (HLDE)
  290.         RAR             ;SAVE CARRY OUT
  291.         XCHG    
  292.         DAD     H
  293.         XCHG
  294.         JNC     IDIV3   ;NO CRRY INTO L
  295.         INX     H
  296. IDIV3:  RAL             ;REGAIN CARRY FROM H
  297.         JC      IDIV4   ;YES, GENERATE QUOTIENT BIT
  298.         MOV     A,L
  299.         ADD     C       ;TEST FOR QUOTIENT BIT
  300.         MOV     A,H
  301.         ADC     H
  302.         JNC     IDIV5   ;NO BIT
  303. IDIV4:  DAD     B       ;AUBTRACT
  304.     INX    D    ;INSERT QUOTIENT BIT
  305. IDIV5:  POP     PSW     ;GET ITERATION COUNT
  306.         INR     A       
  307.         JM      IDIV2   ;NOT DONE
  308.         CALL    C2BC    ;RESTORE BC
  309.         POP     PSW     ;RESTORE A
  310.         ORA     A       ;CLEAR ANY CARRY ,  NO OVERFLOW
  311.         RET
  312. ;
  313. ; SIGNED MULTIPLY (DE)*(BC)->(DEHL)
  314. ;* IMUL,CEBC,C2BC,C2DE,C2DHL
  315. ;F,D,E,H,HL     (6)
  316. MUL:    PUSH    PSW
  317.         PUSH    B
  318.         MOV     A,D
  319.         ORA     A
  320.         JM      MUL5    ; (DE) -VE
  321.         MOV     A,B     
  322.         ORA     A
  323.         JM      MUL3    ; (DE) +VE, (BC) -VE
  324. MUL1:   CALL    IMUL    ;RESULT +VE
  325. MUL2:   POP     B
  326.         POP     PSW
  327.         ORA     A       ;RESET CARRY, NO OV.
  328.         RET
  329. MUL3:   CALL    C2BC    ;2'S COMP. BC
  330.  
  331.  
  332. MUL4:   CALL    IMUL    ;RESULT -VE
  333.         CALL    C2DHL   ;2'S COMPLEMENT DEHL
  334.         JMP     MUL2
  335. MUL5:   CALL    C2DE    ; (DE) -VE
  336.         MOV     A,B
  337.         ORA     A
  338.         JP      MUL4    ; (DE) -VE, (BC) +VE
  339.         CALL    C2BC    ; (DE) -VE, (BC) -VE
  340.     JMP    MUL1
  341. ;
  342. ; DO IDIV ON SIGNED + NO'S & CHECK O'FLOW
  343. ; EXPECTING +VE RESULT
  344. ;* IDIV
  345. ; A,F,D,E,H,L (4)
  346. IDIVQ:  CALL    IDIV
  347.         RC      
  348.         MOV     A,D
  349.         RAL     
  350.         RET             ;RESET SHOULD BE +VE
  351. ;
  352. ; DO IDIV ON SIGNED +NO'S & CHECK OVERFLOW
  353. ; INPUTS MAY INCLUDE 8000 HEX
  354. ; EXPECTING -VE RESULT, ALLOW 8000 HEX
  355. ;* C2DE,IDIV
  356. ; A,F,D,E,H,L(4)
  357. IDIVN:  CALL    IDIV
  358.         RC              ;OVERFLOW
  359.         CALL    C2DE    ;COMPLEMENT QUOTIENT
  360.         MOV     A,D
  361.         ORA     A       ;RESULT SHOULD BE -VE
  362.         RM
  363.         STC
  364.         RET             ;OVERFLOW
  365. ;
  366. ; SIGNED DIVIDE (DEHL)/(BC)->(DE)
  367. ; REMAINDER APPEARS IN  (HL)
  368. ; CARRY INDICATES OVERFLOW
  369. ; WHEN INPUTS ARE PRESERVED, EXCEPT FLAGS
  370. ;* C2BC,C2DE,CEDHL,IDIVN,IDIVQ
  371. ; F,D,E,H,L     (9)
  372. DIV:    PUSH    PSW
  373.         PUSH    B
  374.         PUSH    D
  375.         PUSH    H       ;SAVE IN CASE OF OVERFLOW
  376.         MOV     A,D
  377.         ORA     D
  378.         JM      DIV4    ;DIVIDEND NEGATIVE
  379.         ORA     B
  380.         JM     DIV2    ;+/-
  381.         CALL    IDIVQ   ;+/+
  382.         JC      DIV3    ;OVERFLOW
  383. DIV1:   POP     B       ;PURGE ATACK, NO OVERFLOW
  384.         POP     B       ;
  385.         POP     B       ;RESTORE (BC)
  386.         POP     PSW
  387.         ORA     A       ;RESET CARRY, NO OVERFLOW
  388.         RET
  389.  
  390. DIV2:   CALL    C2BC    ;+/-, COMPLEMENT BC
  391.         CALL    IDIVN
  392.         JNC     DIV1    ;NO OVERFLOW
  393. DIV3:   POP     H       ;RESTORE ENTRY, OVERFLOW
  394.         POP     D
  395.         POP     B
  396.         POP     PSW
  397.         STC             ;MARK OVERFLOW WITH CARRY
  398.         RET
  399. DIV4:   CALL    C2DHL   ;-/?, COMP. DEHL
  400.         MOV     A,B
  401.         ORA     A
  402.         JM      DIV1    ;-/-
  403.         CALL    IDIVN
  404.         JC      DIV3    ;OVERFLOW
  405. DIV5:   XCHG
  406.         CALL    C2DE
  407.         XCHG            ;COMPLEMENT REMAINDER
  408.         JMP     DIV1
  409. DIV6:   CALL    C2BC    ;-/-, COMPLEMENT BC
  410.         JC      DIV3    ;OVERFLOW
  411.         JMP     DIV5
  412. ;
  413. ; NORMALIZE (DE) LEFT, EXPONENT IN (L)
  414. ; ZERO FLAG FOR ZERO VALUE
  415. ; A,F,D,E,L    (1)
  416. NDEL:    MOV    A,E
  417.         ORA     D
  418.         JNZ     NDEL2   ;NON-ZERO
  419.  
  420.         MOV     L,A     ;SET EXPONENT ZERO
  421. NDEL1:  ORA     L       ;SET /REST ZERO FLAG
  422.         RET
  423. NDEL2:  MOV     A,D
  424.         ANI     0C0H    ;SET FLAGS & CLEAR CARRY
  425.         RPO             ;DONE
  426.         MOV     A,L
  427.         CPI     80H
  428.         JZ      NDEL1   ;NECT SHIFT OVERFLOWS EXPONENT
  429.         XCHG            ;LEFT SHIFT
  430.         DAD     H
  431.         XCHG
  432.         DCR     L       ;CORRECT EXPONENT
  433.         JMP     NDEL2
  434. ;
  435. ; NORMALIZE (BC) LEFT, EXPONENT IN (H)
  436. ; ZERO FLAG FOR ZERO VALUE
  437. ;* BCLZ
  438. ; A,F,B,C,H     (2)
  439. NBCL:   MOV     A,B
  440.         ORA     C
  441.         JNZ     NBCL2   ;NON ZERO
  442.         MOV     H,A     ; SET EXPONENT ZERO
  443. NBCL1:  ORA     H       ;SET/RESET ZERO FLAG
  444.         RET
  445.  
  446.  
  447. NBCL2:  MOV     A,B
  448.         ANI     0C0H    ;SET FLAGS & CLEAR CARRY
  449.         RPO             ;DONE
  450.         MOV     A,H
  451.         CPI     80H
  452.         JZ      NBCL1   ;NEXT SHIFT OVERFLOWS EXPONENT
  453.         CALL    BCLZ    ;LEFT SHIFT
  454.     DCR     H
  455.         JMP     NBCL2
  456. ;
  457. ; 2'S COMPLEMENT AD (A)+(H)+(L)->(L)
  458. ; CARRY FOR OV. WHEN RETURN WRONG SIGN,NO DATA
  459. ;* (ADDL)
  460. ; A.F.L  (2)
  461. ADXP:   ORA     A       ;CHECK 1ST SIGN
  462.         PUSH    PSW     ;SAVE
  463.         JM      ADXP2   ;-VE
  464.         ORA     H
  465.         ORA     L
  466.         JP      ADXP3   ;ALL +VE
  467. ADXP1:  POP     PSW
  468.         CALL    ADDL
  469.         MOV     A,H
  470.         JNC     ADDL    ;2 OR 0 OV'S ALLOWED
  471.         CALL    ADDL    ;NEED 2ND OV
  472.         CMC     
  473.         RET
  474. ADXP2:  ANA     H       ;1ST VALUE WAS -VE
  475.         ANA     L
  476.         JP      ADXP1   ;NOT ALL -VE
  477. ADXP3:  POP     PSW     ;RESTORE, ALL SAME SIGN
  478.         CALL    ADDL
  479.         RC              ;1ST OV IS TOO MANY
  480.         MOV     A,H
  481. ;
  482. ; 2'S COMPLEMENT ADD (A) +(L)->(L)
  483. ; CARRY FOR OV. RETURN RESULT WITH WRONG SIGN
  484. ; A,F,L (1)
  485. ADDL:   XRA L
  486.         JP      ADDL1   ;SIGN SAME
  487.         XRA     L       ;RESTORE, SIGNA DIFF., NO OV
  488.         ADD     L
  489.         MOV     L,A
  490.         ORA     A       ;NO OV, CLEAR CARRRY
  491.     RET
  492. ADDL1:  XRA     L       ;RESTORE A
  493.         ADD     L
  494.         XRA     L
  495.         JP      ADDL2   ;RESULT SAME SIGN, NO OV
  496.         XRA     L       ;OV. RESTORE RESULT W/WRONG SIGN
  497.         MOV     L,A
  498.         STC     
  499.         RET
  500. ADDL2:  XRA     L       ;RESTORE RESULT
  501.         MOV     L,A     ;NO OV. OCCURRED
  502.         RET
  503. ;
  504. ; ROUND OFF DIVISION QUOTIENT ON BASIC FOR RDR
  505. ; (A) RETURNS NEGATIVE SHIFT COUNT
  506. ; RESULT ROUNDED TO 16 BIT QUANTITY
  507. ;* (NROS), BCRA, NDRDS
  508. ; A,F,H,L       (3)
  509. RNDQ:   PUSH    H
  510.         CALL    BCRA    
  511.         MOV     A,B
  512.         XRA     H
  513.         JM      RNDQ1   ;REMAINDER & QUOTIENT DIFF. SIGNS
  514.         CALL    C2BC    
  515.         DAD     B       ; FORM REMAINDER-DIVISOR/2
  516.         MOV     A,H
  517.         CMA
  518.         MVI     L,0
  519.         ANI     80H
  520.         JMP     RNDQ2
  521. RNDQ1:  DAD     B       ;FROM REMAINDER+DIVISIOR/2
  522.         MOV     A,H
  523.         MVI     L,0
  524.         ANI     80H
  525.         JP      RNDQ2   ;NO ROUND
  526.         DCX     D
  527. RNDQ2:  MOV     H,A
  528.     POP    B
  529. ;
  530. ; NORMALIZE LEFT AND ROUND (DEHL)
  531. ; (A) RETURNS REGATIVE SHIFT COUNT
  532. ; RESULT ROUNDED TO 16 BIT QUANTITY
  533. ;* DERZ
  534. ; A,F,D,E,H,L   (3)
  535. NRDS:   MOV     A,D     
  536.         ORA     E
  537.         ORA     H
  538.         ORA     L
  539.         RZ              ;ZERP VALUE
  540.         XRA     A       ;CLEAR SHIFT COUNT
  541. NRDS1:  PUSH    PSW     ;SAVE SHIFT COUNT
  542.         MOV     A,D
  543.         ANI     0C0H
  544.         JPO     NRDS3   ;LEFT NORMALIZED, NOW ROUND
  545.         XCHG
  546.         DAD     H       ;LEFT IF  (DEHL)
  547.         XCHG
  548.         DAD     H
  549.         JNC     NRDS2   ;NO BIT ACROSS DE.HL BOUNDARY
  550.         INX     D
  551.  
  552. NRDS2:  POP     PSW     ;SHIFT COUNT
  553.         DCR     A
  554.         JMP     NRDS1   ;DO AGAIN
  555. NRDS3:  JM      NRDS4   ;TRUNCATION ROUNDS -VE
  556.         ORA     H       
  557.         JP      NRDS4   ;NO BIT, NO ROUND
  558.         INX     D       ;ROUND
  559.         ANA     D
  560.         JP      NRDS4   ;RESULT NOT 800H
  561.         CALL    DERZ    ;CORRECT OVERFLOW
  562.         POP     PSW     ;REGAIN SHIFT COUNT
  563.         INR     A       ;XORRECT FOR         RET
  564. NRDS4:  POP     PSW     ;SHIFT
  565.         RET
  566. ;
  567. ; MULTIPLY ((DE)*2^(L)) BY 10
  568. ;* (FMUL,OVEX,OVMX), NBCL,NDEL,NRDS,MUL
  569. ; A,F,B,C,E,H,L (8)
  570. FMULT:  LXI     B,5000H ;NORMALIZED TEN
  571.         MVI     H,5     ;AND EXPONENT
  572. ;
  573. ; FLOATING MULTIPLY
  574. ; ((BC)*2^(H)*((DE)*2^(L))=>(DE)*2^(L)
  575. ; CARRY FOR OVERFLOW, WHEN RETURN EXTREME VALUES
  576. ; (BC)*2^(H) WILL BE LEFT NORMALIZED
  577. ;  UNLESS (DE) IA ZERO
  578. ;* (OVEX,OVMX), NBCL,NDEL,MUL,NRDS
  579. ; A,F,D,EL  (8)
  580. FMUL:   CALL    NDEL
  581.         RZ              ;(DE) ZERO
  582.         CALL    NBCL
  583.         JNZ     FMUL1   ;BC NON-ZERO
  584.         MOV     D,B
  585.         MOV     E,C
  586.         MOV     L,H     ;PRODUCT IS ZERO
  587.         RET
  588. FMUL1:  PUSH    H               ;SAVE EXPONENTS
  589.         CALL    MUL     
  590.         CALL    NRDS    ;ROUND OFF
  591.         POP     H       ;REGAIN EXPONENTS
  592.         CALL    ADXP    ;FORM RESULT EXPONENT
  593.         RNC             ;NO OVERFLOW
  594. ;
  595. ; EXPONENT OVERFLOW AET EXTREME VALUES
  596. ; (L) HAS WRONG EXPONENT SIGN
  597. ;* (OVMX)
  598. ; A,F,S,E,L     (1)
  599. OVEX:    MOV    A,L
  600.         ORA     A       
  601.         JM      OVMX    ;REAL EXPONENT +VE
  602.         LXI     D,0     ;REAL EXPONENT -VE, SET 0 VALUE
  603.         MOV     L,D     
  604.         STC             ;MARK OVERFLOW
  605.         RET
  606. ;
  607. ; OVERFLOW TO MAXIMUM VALUES
  608. ; SET EXTREME VALUE IN (DE)*2^(L). PRESERVE SIGN
  609. ; A,F,D,E,L     (1)
  610. OVMX:   MOV     A,D     ;SET RESULT SIGN
  611.         ORA     A
  612.         LXI     D,7FFFH ;SET + FULL SCALE
  613.         MOV     L,D     ;AND MAX EXPONENT
  614.         CM      CIDE    ;-VE, SET - FULL SCALE
  615.         STC             ;MARK OVERFLOW
  616.         RET
  617. ;
  618. ; DIVIDE ((DE)*2^(L)) BY TEN
  619. ; CARRY FOR OVERFLOW, RETURNS EXTREME VALUES
  620. ;* (FDIV). NDEL,NBCL,OVMX,DIV,DERA,DERC,RNDQ,ADXP,OVEX
  621. ; A,F,B,C,E,H,L (12)
  622. FDIVT:  LXI     H,5000H ;NORMALIZED TEN
  623.         MVI     H,5     ;AND EXPONENT
  624. ;
  625. ; FLOATING DIVIDE (DE)*2^(L)/(BC)*2^(H)->(DE)*2^(L)
  626. ; (BC)*2^(L) WILL BE LEFT NORMALIZED UNLESS (DE)=0
  627.  
  628. ; CARRY FOR OVERFLOW, RETURNS EXTREME VALUES
  629. ;* NDEL,NBCL,OVMX,DERA,RNDQ,ADXP,OVEX
  630. ; A,F,D,E,L     (12)
  631. FDIV:    CALL    NDEL
  632.         RZ              ;DIVIDEND IS ZERO
  633.         CALL    NBCL    ;NORMALIZE BOTH INPUTS
  634.         JZ      OVMX    ;DIVISION BY ZERO
  635.         PUSH    H       ;SAVE EXPONENTS
  636.         LXI     H,0     ;EXTEND DIVIDEND
  637.         XRA     A       ;ANTI OVERFLOW SHIFT COUNT
  638.         PUSH    PSW     ;TO STACK
  639. FDIV1:  CALL    DERA    ;REDUCE DIVIDEND TO AVOID OV
  640.         XCHG
  641.         CALL    DERC
  642.         XCHG
  643.         POP     PSW
  644.         INR     A       ;COUNT F  RA SHIFTS
  645.         PUSH    PSW     ;SAVE OVERFLOW SHIFT COUNT
  646.         CALL    DIV     ;DO DIVISION
  647.         JC      FDIV1   ;OVERFLOW RESULTED
  648.         CALL    RNDQ    ;ROUND OFF QUOTIENT
  649.         POP     H
  650.         ADD     H       ;ADD OV SHIFTS TO NORM. COUNT
  651.         POP     H       ;RESTORE EXPONENTS
  652.         PUsH    H       ;AND SAVE ON STACK
  653.         PUSH    PSW     ;SAVE NORMALIZE COUNT
  654.         MOV     A,H
  655.         CMA             ;COMPLEMENT DIVISOR EXPONENT
  656.         MOV     H,A
  657.         POP     PSW     ;RESTORE SHIFT COUNT
  658.     INR    A    ;2'S COMP. HERE SO ADXP CAN OV
  659.         CALL    ADXP
  660.         MOV     A,L     ;QUOTIENT EXPONENT
  661. FDIV3:  POP     H       ;RESTORE ORIGINAL EXPONENT
  662.         MOV     L,A     ;SET QUOTIENT EXPONENT
  663.         JC      OVEX    ;OVERFLOW RESULTED
  664.         RET
  665. ;
  666. ; EXCHANGE FLOATING OPERANDS
  667. ; (BC)*2^(H) <=> (DE)*2^(L)
  668. ; B,C,D,E,H,L   (3)
  669. TRADE:  PUSH    B
  670.         PUSH    D
  671.         POP     B
  672.         POP     D
  673.         PUSH    PSW
  674.         MOV     A,L
  675.         MOV     L,H
  676.         MOV     H,A
  677.         POP     PSW
  678.         RET
  679. ;
  680. ; TRADE OPERANDS & PERFORM FDIV
  681. ;* TRADE, FDIV
  682. ; A,F,B,C,D,E,H,L
  683. FDIVX:  CALL    TRADE   ;TRADE OPERANDS
  684.         JMP     FDIV
  685. ;
  686. ; FLOATING SUBTRACT (BC)*2^(H)-(DE)*2^(L)=>(DE)*2^(L)
  687. ; (BC)*2^(L) WILL BE LEFT NORMALIZED
  688. ; CARRY FOR OV, WHEN RETURN EXTREME VALUES
  689. ;* (FADD), NBC,NDEL,ADDL,DERN,DERC,TRADE
  690. ; A,F,D,E,L     (8)
  691. FSUB:   CALL    C2DE    ;CHANE SI
  692. ;
  693. ; FLOATING ADD (BC)*2^(H)+8DE)*2^(L)->(DE)*2^(L)
  694. ; (BC)*2^(L) WILL BE LEFT NORMALIZED
  695. ; CARRY FOR OV, WHEN RVVALUES
  696. ;*NBCL,NDEL,ADDL,DERN,DERC,TRADE
  697. ; A,F,D,E,L     (8)
  698. FADD:   CALL    NBCL
  699.         RZ              ;ADDEND IS ZERO
  700.         CALL    NDEL    ;NORMALIZE BOTH
  701.         JZ      FADD8   ; (DE)=0
  702. FADD2:  MOV     A,L     
  703.         CMA             ;ERROR BY 1
  704.         PUSH    H
  705.         MOV     L,H
  706.  
  707.         CALL    ADDL    ;FORM EXPONENT DIFF -1
  708.         MOV     A,L
  709.         POP     H
  710.         JC      FADD7   ;OVERFLOW, RESULT SIGN WRONG
  711.         ORA     A
  712.         JM      FADD6   ; (DE) >= (BC)
  713.         INR     A       ;CORRECT
  714.         JM      FADD8   ;VAUE WAS 7F, (DE)=0
  715.         CPI     16
  716.         JNC     FADD8   ;2ND OPERAND EFFECTIVELY ZERO
  717. FADD3:  CALL    DERN    ;ALIGN, (BC) > (DE)
  718.         XCHG
  719.         MOV     A,B
  720.         XRA     H
  721.         JM      FADD4   ;SIGNS STILL SAME, NO OV.
  722.         DAD     B
  723.         MOV     A,B
  724.         XRA     H
  725.         JP      FADD5   ;SIGNS STILL SAME, NO OV.
  726.         XCHG
  727.         MOV     A,D
  728.         RAL
  729.         CMC
  730.         CALL    DERC    ;CORRECT
  731.         INR     L       ;CORRECT FOR SHIFT
  732.         MOV     A,L
  733.         CPI     80H
  734.         JZ      OVEX    ;OVERFLOW
  735.         ORA     A       ;RESET CARRY
  736.         RET
  737. FADD4:  DAD     B       ;ADD
  738. FADD5:  XCHG            ;RESULT TO (DE)
  739.         MOV     L,H     ;RESLT HAS EXPONENT OF (BC)
  740.         ORA     A       ;RESULT CARRY, NO OV.
  741.         RET
  742. FADD6:  INR     A       ;CORRECT
  743.         JZ      FADD3   ; (DE) & (BC) SAME MAGNITUDE
  744.         PUSH    H       ;SAVE EXPONENTS
  745.         PUSH    B       ;AND (BC)
  746.         CALL    TRADE   ;TRADE OPENANDS
  747.         CALL    FADD2   ;NOW (BC) > (DE)
  748.         MOV     A,L     ;RESULT EXPONENT
  749.         POP     B       ;RESTORE OPERAND IN (BC)
  750.         POP     H       ;AND ITS EXPONENT
  751.         MOV     L,A     ;RESULT EXPONENT
  752.         RET
  753. FADD7:  ORA     A       ;ONE OPERAND EFFECTIVELY ZERO
  754.         RP              ;(BC) << (DE)
  755. FADD8:  MOV     L,H     
  756.         MOV     D,B     ; (DE) << (BC)
  757.         MOV     E,C
  758.         RET
  759. ;
  760. ; COMPARE (DE) WITH 3276. USE ARS. VALUENUS FLAG IF < 3276. ELSE PLUS
  761. ; A,F   (1)
  762.  
  763. CPMX:   MOV     A,D
  764.         ORA     A
  765.         MOV     A,E
  766.         JM      CPMX1   ;-VE VALUE
  767.         SUI     3276 MOD 256
  768.         MOV     A,D
  769.         SBI     3276/256
  770.         RET
  771. CPMX1:  ADI     3276 MOD 256
  772.         MOV     A,D
  773.         ACI     3276/256
  774.         CMA     
  775.         ORA     A       ;SET FLAGS
  776.         RET
  777. ;
  778. ; NORMALIZE (DE)*2^(L) RIGHT UNTIL
  779. ; MANTISSA INTEGRAL OR RB BIT NON-ZERO
  780. ; ZERO FLAG FOR INTEGER REPRESENTATION
  781. ; ELSE MINUS FLAG FOR OVERANGE INTEGER
  782. ; OR PLUS FLAG FOR A FRACTIONAL SEGMENT
  783. ;* DERA
  784. ; A,F,D,E,L  (2)
  785. NDER:   MOV     A,L
  786.         ORA     A
  787. NDER1:  JM      NDER2   ;PURELY FRACTIONAL
  788.         MVI     A,16    
  789.         CMP     L
  790.         RZ              ;INTEGER REPRESENTATION
  791.         RM              ;OVERRANE INTEGER
  792. NDER2:  MOV     A,E     ;(L) < 16
  793.         ANI     1       
  794.         RNZ             ;FRACTIONAL PART REMAINS
  795.         CALL    DERA    ;ARITH. RIGHT SHIFT
  796.         INR     L       ;CORRECT EXPONENT
  797. JMP     NDER1
  798. ;
  799. ; CONVERT (DE)*2^(L) TO INTEGER (DE)*10^(L)
  800. ; ON INPUT +1 > (DE) >= -1
  801. ; ON OUTPUT 32767 >= (DE) >= -32768
  802. ;* FDIVT,DERA,NDER,CPMX,FMULT
  803. ; A,F,D,E,L     (16)
  804. FIX:    PUSH    H
  805.         PUSH    H
  806.         MVI     B,0
  807.         MOV     A,L
  808.         ORA     A
  809.         JM      FIX7    ;VALUE
  810.         CPI     16
  811.         JM      FIX7    ;FRACTIONAL PART
  812.         JZ      FIX6    ;INTEGER
  813. FIX1:   PUSH    B
  814.         CALL    FDIVT   ;RESCALE        
  815.         POP     B
  816.         INR     B       ;ADVANCE DECIMAL EXPONENT
  817. FIX2:   MOV     A,L     
  818.         CPI     16
  819.         JZ      FIX6    ;REDUCED TO INTERGER
  820.         JP      FIX1    ;OVERANGE INTEGER
  821. FIX3:   SUI     15
  822.         MOV     L,A
  823.         JZ      FIX5    ;MAGNITUDE 2*INTEGER
  824. FIX4:   CALL    DERA    ;MAGNITUDE > 2*INTEGER
  825.         INR     L
  826.         JM      FIX4    ;STILL TOO LARGE MAGNITUDE
  827. FIX5:   CALL    DERA    ;REMOVE LAST FRACTIONAL BIT
  828.         JNC     FIX6    ;NO ROUNDING
  829.         MOV     A,D
  830.         ORA     A
  831.     JM    FIX6    ;TRUNCATION ROUNDS -VE
  832.         INX     D
  833. FIX6:   POP     H
  834.         MOV     L,B     ;SAVE DEC. EXPONENT
  835.         POP     B
  836.         RET
  837. FIX7:   CALL    NDER    ;POSSIBLY FRACTIONAL
  838.         JZ      FIX6    ;INTEGER
  839.         MOV     A,L
  840.         ORA     A
  841.         JM      FIX9
  842.         CPI     13
  843.         JM      FIX9
  844.         JNZ     FIX8    ;MAY BE >= 3276
  845.         CALL    CPMX
  846.         JM      FIX9
  847.         JP      FIX2
  848. FIX8:   CALL    CPMX
  849.         MOV     A,L
  850.         JP      FIX3    ; >= 3276, DONE SCALING
  851. FIX9:   PUSH    B
  852.         CALL    FMULT   ; ADJUST SCALE
  853.         POP     B
  854.         DCR     B
  855.         DCR     B       ;AND DEC. EXPONENT
  856.         JMP     FIX7
  857. ;
  858. ; ROUND "FIXED" SIGNED VALUE (DE)*10^(L) TO 4 DIGITS
  859. ;* RD4D, C2DE
  860. ; A,F,D,E,H,L   (6)
  861. RDS4D:  MOV     A,D
  862.         ORA     A
  863.         JP      RD4D    ;POSITIVE
  864.         CALL    C2DE    ;INVERT SIGN
  865.         CALL    RD4D
  866.         JMP     C2DE    ;RESTORE SIGN
  867. ;
  868. ; RUND "FIXED" SIGNED VALUE (DE)*10^(L) TO 3 DIGITS
  869. ;* RD3D, C2DE
  870. ; A,F,D,E,6)
  871. RDS3D:  MOV     A,D
  872.         ORA     A
  873.         JP      RD3D    ;POSITIVE
  874.         CALL    C2DE    ;INVERT SIGN
  875.         CALL    RD3D
  876.         JMP     C2DE    ;RESTORE SIGN
  877. ;
  878. ; ROUND "FIXED" +VE VALUE (DE)*10^(L) TO 4 DIGITS
  879. ;* (RD3D), DTEN
  880. ; A,F,D,E,L     (6)
  881. RD4D:   PUSH    B
  882.         LXI     B,10000
  883.         JMP     RD3D1
  884. ;
  885. ; ROUND "FIXED" +VE VALUE (DE)*10^(L) TO 3 DIGITS
  886. ;* DTEN
  887. ; A,F,D,E,L     (6)
  888. RD3D:   PUSH    B
  889.         LXI     B,-1000
  890. RD3D1:  XCHG
  891.         PUSH    H
  892.         DAD     B
  893.         POP     H       
  894.         JNC     RD3D3   ;LESS THAN 1000 (10000)
  895. RD3D2:  CALL    DTEN
  896.         INR     E
  897.         PUSH    H
  898.         DAD     B
  899.         POP     H
  900.         JC      RD3D2   ;> 1000 (10000)
  901.         CPI     5       ;CHECK REMAINDER FOR ROUNDING
  902.         JC      RD3D3   ;NO ROUNDING NEEDED
  903.         INX     H
  904.         PUSH    H
  905.         DAD     B
  906.         POP     H
  907.         JC      RD3D2   ;ROUNDED TO 1000 (10000)
  908. RD3D3:  POP     B       ;RESTORE
  909.         XCHG
  910.         RET
  911. ;
  912. ; T10^(L)
  913. ;* C2DE,COUT,EXDG,TDZS
  914. TFIX:   PUSH    PSW
  915.         PUSH    B
  916.         MVI     B,4
  917. TFIX0:  PUSH    D
  918.         PUSH    H
  919.         MOV     A,D
  920.         ORA     A
  921.         JP      TFIX1   ;+VE VALUE
  922.  
  923.         CALL    C2DE    ;-VE VALUE
  924.         MVI     C,'-'
  925.         CALL    COUT
  926. TFIX1:  XCHG
  927.         MOV     A,E
  928.         ADI     5
  929.         MOV     E,A
  930. TFIX2:  DCR     E
  931.         JM      TFIX7   ;FLOT ;-VE
  932.         JZ      TFIX7   ;DECIMAL PT. HERE
  933.         CALL    EXDG
  934.         JNZ     TFIX9   ;NON-ZERO, END SUPPRESS
  935.         DCR     B
  936.         JNZ     TFIX2
  937.         CALL    COUT    ;AT LEAST 1 DIGIT
  938.         MVI     C,'.'
  939.         CALL    COUT
  940.         DCR     B
  941.         JZ      TFIX5   ;VALUE < 10000
  942. TFIX3:  MVI     C,'E'
  943. TFIX4:  CALL    COUT
  944.         MOV     L,E
  945.         MVI     H,0
  946.         CALL    TDZS    ;DUMP POSITIVE EXPONENT
  947. TFIX5:  POP     H
  948.         POP     D
  949.         POP     B
  950.         POP     PSW
  951.         RET
  952. TFIX6:  DCR     E
  953.         JNZ     TFIX8   ;DEC. PT. NOT HERE
  954. TFIX7:    MVI    C,'.'
  955.     CALL    COUT
  956. TFIX8:  CALL    EXDG
  957. TFIX9:  CALL    COUT
  958.         DCR     E
  959.         JNZ     TFIX6
  960.         DCR     B
  961.         JNZ     TFIX5   ;NO EXPONENT NEEDED
  962.         JP      TFIX3   ; +VE EXPONENT
  963.         MOV     A,E
  964.         ADI     4
  965.         JP      TFIX5   ;NO NFG. EXPONENT
  966.         CMA
  967.         INR     A
  968.         MOV     E,A     ;COMPLEMENT -VE EXPONENT
  969.         MVI     C,'E'
  970.         CALL    COUT
  971.         MVI     C,'-'
  972.         JMP     TFIX4
  973. ;
  974. ; TYPE A FLOATING VALUE TO 4 DECIMAL DIGIT
  975. ;* FIX,RDS4D,TFIX
  976. TFLT:   PUSH    PSW
  977.         PUSH    B
  978.         PUSH    D
  979.         PUSH    B
  980.         CALL    FIX
  981.         CALL    RDS4D   ;ROUND  4 DIGIT
  982.         CALL    TFIX    ;TYPE I)
  983.         POP     B
  984.         POP     D
  985.         POP     H
  986.         POP     PSW
  987.         RET
  988. ;
  989. ; GET A PRINTING CHARACTER
  990. ;* CECHO
  991. ; A,F
  992. GPRT:   CALL    CECHD
  993.         INR     A
  994.         ANI     7FH
  995.         CPI     ' '+2   ;IGNORE SPACE, RUB, CONTROL
  996.         JC      GPRT
  997.         DCR     A
  998.         RET
  999. ;
  1000. ; INPUT AND ECHO A CHARACTER. CONVERT TO DECIMAL
  1001. ; TO HEX, ELSE RETURN CARRY & CHARACTER
  1002. ; CARRY & ZERO FLAGS IF CHAR. = '.' OR ';'
  1003. ; IGNORE SPACE, RUB & CONTROOL CODES
  1004. ;* GPRT
  1005. ; A,F
  1006. CECHD:  CALL    GPRT
  1007.         CPI     '.'
  1008.         STC     
  1009.         RZ
  1010.         CPI     '0'
  1011.         RC              ; < 0
  1012.         CPI     '9'+1
  1013.         CMC
  1014.         RC              ; > 9
  1015.         ANI     0FH
  1016.         RET
  1017. ;
  1018. ; COMBINE DIGIT N (A) WITH VALUE IN (HL)
  1019. ; INPUT IS DECIMAL. RETURN CARRY IF RESULT > 3275
  1020. ;* MUL10,INDEX
  1021. ; A,F,H,L   (4)
  1022. DIGIN:  CALL    MUL10
  1023.         CALL    INDEX
  1024.         MOV     A,L
  1025.         SUI     3276 MOD 256
  1026.         MOV     A,H
  1027.         SBI     3276/256
  1028.         CMC
  1029.         RET
  1030. ;
  1031. ; READ 2 DIGIT DECIMAL VALUE TO (R)
  1032. ; CONVERT TO BINARY IN 8. SAVE EXIT CHAR IN (A)
  1033. ;* CECHO
  1034. ; A,F,B   (RECURSIVE)
  1035. R2DC:   MVI     B,0
  1036. R2DC1:  CALL    CECHD
  1037. R2DC2:  JNC     R2DC3   ;DIGIT
  1038.         CPI     '+'
  1039.         JZ      R2DC1   ;IGNORE UNARY +
  1040.         CPI     '-'
  1041.         RNZ             ;EXIT. NOT -
  1042.     CALL    R2DC    ;UNARY -
  1043.         PUSH    PSW     ;SAVE EXIT CHAR
  1044.         MOV     A,B
  1045.         CMA
  1046.         INR     A
  1047.         MOV     B,A     ;CHANGE SIGN
  1048.         POP     PSW
  1049.         POP     PSW     ;RESTORE EXIT CHAR.
  1050.         RET
  1051. R2DC3:  PUSH    D
  1052.         PUSH    B
  1053.         MOV     C,B
  1054. R2DC4:  MOV     B,C     ;PREV. DIGIT
  1055.         MOV     C,A     ;THIS DIGIT
  1056.         CALL    CECHD   ;GET NEXT DIGIT
  1057.         JNC     R2DC4   ;VALID DIGIT
  1058.         PUSH    PSW     ;SAVE EXIT CHAR.
  1059.         MOV     A,B     ;MS DIGIT
  1060.         ADD     A       ; 2*
  1061.         ADD     A       ; 4*
  1062.         ADD     B       ; 5*
  1063.         ADD     A       ; 10*
  1064.         ADD     C       ; LS DIGIT
  1065.         MOV     D,A     ;SAVE TEMPORARY
  1066.         POP     PSW     ; RESTORE EXIT CHAR
  1067.         POP     B       ; RESTORE C
  1068.         MOV     B,D     ; OUTPUT VALUE
  1069.         POP     D       ; RESTORE D
  1070.         RET
  1071. ;
  1072. ; READ EXPONENT IF CHAR='E'
  1073. ; DECIMAL VALUE IS SUMMED WITH (L)
  1074. ;* R2DC
  1075. ; A,F,L  (RECURSIVE)
  1076. REXP:   CPI     'E'
  1077.         RNZ                 ;NO EXPONENT
  1078.         PUSH    B       
  1079.         CALL    R2DC    ;GET EXPONENT VALUE TO B
  1080.         PUSH    PSW     ;SAVE EXIT CHAR
  1081.         MOV     A,B
  1082.         ADD     L
  1083.         MOV     L,A     ;FROM ACTUAL EXPONENT
  1084.         POP     PSW     ;RESTORE EXIT CHAR
  1085.         POP     B       ;RESTORE
  1086.         RET
  1087. ;
  1088. ; INPUT A FLOATING POINT VALUE FROM CONSOLE
  1089. ; TO (DE)*2^(L)
  1090. ; SET CARRY FOR INPUT OUT OF RANGE
  1091. ; LOAD WITH 2.7183 FOR "E", 3.1416 FOR "P"
  1092. ; RETURN EXIT CHARACTER IN (A)
  1093. ;* (FLOT), CECHD,CEDE,DIGIN,FMULT,FDIVT
  1094. ; A,F,D,E,L  (RECURSIVE)
  1095. FIN:    PUSH    B
  1096.         PUSH    H
  1097.         XRA     A
  1098.         MOV     B,A     ;DECIMAL EXPONENT
  1099.         LXI     H,0     ;CLEAR ACCUMULATOR
  1100. FIN0:   CALL    CECHD   
  1101.         JNC     FIN3    ;DIGIT
  1102.         JZ      FIN4    ; . OR ;
  1103.         CPI     '+'
  1104.         JZ      FIN0    ;IGNORE UNARY +
  1105.         CPI     '-'
  1106.         JZ      FIN2    ;UNARY -
  1107.         CPI     'E'
  1108.         JZ      FIN1    ;LOAD 2.7183
  1109.         CPI     'P'
  1110.     JNZ    FIN9    ;NOT
  1111.         LXI     H,31416 ;VALUE OF PI
  1112.         MVI     B,-4 AND 0FFH    ;AND EXPONENT
  1113.         JMP     FIN6    ;WAIT FOR EXIT
  1114. FIN1:   LXI     H,27183 ;VALUE OF E
  1115.         MVI     B,-4 AND 0FFH    ;AND EXPONENT
  1116.         JMP     FIN6    ;WAIT FOR EXIT
  1117. FIN2:   CALL    FIN     
  1118.         PUSH    PSW     ;SAVE EXIT CHAR
  1119.         CALL    C2DE    ;CHANGE SIGN
  1120.         POP     PSW     ;EXIT CHAR.
  1121.         MOV     C,L
  1122.         POP     H
  1123.         MOV     L,C
  1124.         POP     B
  1125.         RET
  1126. FIN3:   CALL    DIGIN
  1127.         JC      FIN8    ;NO MORE ROOM
  1128.         CALL    CECHD
  1129.         JNC     FIN3
  1130.         JNZ     FIN9    ;'.'
  1131. FIN4:   CALL    CECHD   ;DECIMAL SET
  1132.         JNC     FIN5    ;VALID INPUT
  1133.         JZ      FIN4    ;IGNORE FURTHER '.'
  1134.         JMP     FIN9    ;EXIT
  1135. FIN5:   CALL    DIGIN   
  1136.         DCR     B
  1137.         JNC     FIN4    ;ROOM FOR MORE DIGITS
  1138. FIN6:   CALL    CECHD   
  1139.         JNC     FIN6    ;WAIT FOR EXIT
  1140.         JZ      FIN6    ;WAIT FOR EXIT
  1141.         JMP     FIN9
  1142. FIN7:    INR    B    ;ADVANCE DEC. EXPONENT
  1143. FIN8:    CALL    CECHD
  1144.         JNC     FIN7    ;VALID DIGIT
  1145.         JZ      FIN6    ;DEC. PT., WAIT FOR EXIT
  1146. FIN9:   XCHG            ;VALUE TO (DE)
  1147.         POP     H
  1148.         MOV     L,B     ;DECIMAL EXPONENT
  1149.         POP     B       
  1150.         CALL    REXP    ;GET EXPONENT. IF ANY
  1151. ;
  1152. ; CONVERT (DE)*10^(L) TO (DE)*2^(L)
  1153. ; ON INPUT 32767 >= (DE) > -32768
  1154. ; ON OUTPUT +1 >= (DE) > -1
  1155. ; SET CARRY FOR INPUT OUT OF RANCE
  1156. ;* FMUL,FDIVT
  1157. ; B,D,E,L (17)
  1158. FLOT:   PUSH    PSW
  1159.         PUSH    H
  1160.         PUSH    B
  1161.         MOV     H,L     ;DECIMAL EXPONENT
  1162.         MVI     L,16    ;DEFAULT BINARY POINT
  1163.         MOV     A,B     
  1164.         ORA     A
  1165.         JZ      FLOT2   ;INTEGRAL VALUE
  1166.         JM      FLOT4   ;DEC. EXPONENT <0
  1167. FLOT1:  PUSH    B
  1168.         CALL    FMULT   ;RESCALF
  1169.         POP     H
  1170.         JC      FLOT5   ;OVERRANGE
  1171.         DCR     B
  1172.         JNZ     FLOT1   ;AGAIN
  1173. FLOT2:  POP     B
  1174.         MOV     A,L
  1175.         POP      H
  1176.         MOV     L,A
  1177.         POP     PSW
  1178.         ORA     A       ;RERRY
  1179.         RET
  1180. FLOT3:  INR     B
  1181.         JZ      FLOT2   ;DONE
  1182. FLOT4:  PUSH    B
  1183.         CALL    FDIVT   ;RESCALE
  1184.         POP     B
  1185.         JNC     FLOT3   ;NOT OVERRANGE
  1186. FLOT5:  POP     B       ;RESTORE
  1187.         MOV     A,L     ;KEEP OVERFLOWED EXPONENT
  1188.         POP     H       ;RESTORE
  1189.         MOV     L,A     ;SET OUTPUT EXPONENT
  1190.         POP     PSW
  1191.         STC             ;MARK OVERFLOW
  1192.         RET
  1193. ;
  1194. ; SEARCH TABLE FOR (A); RETURN INDEX OF ENTRY
  1195. ; RETURNED VALUE OF 0 FOR ENTRY NOT FOUND
  1196. ; 1ST TABLE ENTRY IS TABLE LENGTH, RANGE 1-255
  1197. ; TABLE IS IDENTIFIED ON INPUT BY (HL)
  1198. ; A,F   (3)
  1199. STBL:   PUSH    B
  1200.         PUSH    H       ;SAVE TABLE ID
  1201.         MOV     C,M     ;GET LENGTH. ASSUMED NON-ZERO
  1202.         INR     C
  1203. STBL1:  DCR     C
  1204.         JZ      STBL2   ;ENTRY NOT FOUND
  1205.         INX     H
  1206.         CMP     M
  1207.         JNZ     STBL1   ;NOT THIS ENTRY
  1208.         POP     H       ;RESTORE TABLE ID
  1209.         MOV     A,M     ;GET LENGHT
  1210.         SUB     C       ;FORM ENTRY INDEX
  1211.     INR    A
  1212.     POP    B    ;RESTORE
  1213.         RET
  1214. STBL2:  POP     H
  1215.         POP     B
  1216.         XRA     A       ;RETURN ZERO VALUE & FLAG
  1217.         RET
  1218. ;
  1219. ; NULL OPERATOR
  1220. NULL:   RET
  1221. ; REDUCE ALGERAIC PAIR
  1222. ; [(BC)*2^(H)] OP'N [(DE)*2^  ] -> (DE)*2^(L)
  1223. ; "OP'N" IS 4TH BYTE FROM TOP OF CALLING ROUTINES
  1224. ; STACK, WHERE THE 1ST BYTE IS TOP OF STACK
  1225. ; A,F,D,E,L
  1226. RED:    PUSH    H
  1227.         LXI     H,7
  1228.         DAD     SP      ;POINT TO "LAST"
  1229.         MOV     A,M     ;GET LAST
  1230.         POP     H
  1231. ;
  1232. ; JUMP INDIRECT A (A)TH OF TABLE
  1233. ; A,F
  1234. JINXT:  PUSH    H       ;SAVE HL
  1235.         LXI     H,TBL   
  1236.         CALL    INDX2   ;INDEX IT
  1237.         MOV     A,M     ;LOW ADR. BYTE
  1238.         INX     H
  1239.         MOV     H,M     ;HI ADR. BYTE
  1240.         MOV     L,A     
  1241.         XTHL            ;RESTORE HL, PLACE ADR. ON STACK
  1242.         RET             ;TRANSFER TO CALCULATED LOCATION
  1243. ;
  1244. ; GET AN  OPERATION.
  1245. ; IF ILLEGAL SET CARRY, RETURN ZERO
  1246. ; ELSE SET ZERO FLAG FOR "("
  1247. ;      SET MINUS FLAG FOR "+-*/"
  1248. ;      SET PLUS FLAG FOR RN OPCODE
  1249. ; A,F
  1250. GOPN:   CALL    GPRT
  1251. ;
  1252. ; TFST ASCII CHARACTER (A) AGAINST OPCODE TABLE
  1253. ; IF ILLEGAL SET CARRY, RETURN ZERO
  1254. ; ELSE SET ZERO FLAG FOR "("
  1255. ;      SET MINUS FLAG FOR "+-*/"
  1256. ;      SET PLUS FLAG FOR ")="
  1257. ; RETURN OPCODE
  1258. ; A,F
  1259. TOPCD:  PUSH    H
  1260.         LXI     H,OPTBL
  1261.         CALL    STBL
  1262.         POP     H
  1263.         STC             
  1264.         RZ              ;NOT FOUND, ERROR
  1265.         CPI     5       ;OPCODE FOR "("
  1266.         STC     
  1267.         CMC             ;CLEAR CARRY
  1268.         RET
  1269. ;
  1270. ; EVALUATE EXPRESSIONS FROM LEFT TO RIGHT
  1271. ; WITH NO OPERATOR PRECEDENCE
  1272. ; RETURN RESULT AS (DE)*2^(L)
  1273. ; SET CARRY FOR ERROR RETURN
  1274. ;  (A) = 0  FOR SYNTAX ERROR
  1275. ;        1  FOR OVERFLOW ERROR
  1276. ;        6  FOR EXPRESSION TERM. BY ")"
  1277. ;        7  FOR EXPRESSION TERM. BY "="
  1278. ; A,F,D,E,L  (RECURSIVE)
  1279. EVAL:   XRA     A       ;THIS:=NULL
  1280. EVAL1:  PUSH    B       ;ENTRY WHEN OP'N DETERMINED
  1281.         PUSH    H
  1282. EVAL2:  PUSH    PSW     ;LAST:=THIS
  1283.         MOV     B,D
  1284.         MOV     C,E
  1285.     MOV    H,L    ;OP1:=OP2
  1286.         CALL    FIN     ;OP2:=VALUE; THIS:=OP'N
  1287.         JC      EVALV   ;INPUT OVERRANGE ERROR
  1288. EVAL3:  CALL    TOPCD   ;TEST OPCODE & INTERPRET
  1289.         JC      EVALX   ;SYNTAX ERROR
  1290.         JZ      EVAL5   ;(
  1291.         PUSH    PSW     ;SAVE THIS
  1292.         CALL    RED     ;REDUCE EXPRESSION
  1293.         JC      EVAL0   ;OVERFLOW ERROR
  1294.         POP     PSW     ;GET THIS
  1295.         POP     B       ;PURGE LAST
  1296.         JM      EVAL2   ;THIS IS */+-
  1297.         MOV     C,L
  1298.         POP     H       ;RESTORE
  1299.         MOV     L,C
  1300.         POP     B
  1301.         RET
  1302. EVAL4:  CALL    GPRT    ;GET NEXT OP'N
  1303.         JMP     EVAL3
  1304. EVAL5:  MOV     A,D
  1305.         ORA     E
  1306.         JNZ     EVALX   ;I.E. "VALUE("
  1307. EVAL6:  CALL    EVAL1
  1308. EVAL7:  JC      EVAL9   ;ERROR
  1309.         CPI     6
  1310.         JZ      EVAL4   ;), TERM COMPLETE
  1311.         CALL    TFLT    ;=, LTST TERM
  1312.         CALL    GOPN    ;GET NEXT OPERATOR
  1313.         JM      EVAL6   ;*/+- DETERMINED
  1314.         JNZ     EVAL7   ;=       ( IS ERROR
  1315. EVALX:  XRA     A       ;SYNXX ERROR
  1316.         JMP     EVAL9
  1317. EVAL0:  POP     B       
  1318. EVALV:  MVI     A,1     ;OVERFLOW ERROR
  1319. EVAL9:  POP     B       ;PURGE STACK
  1320.         POP     H       
  1321.         POP     B       ;RESTORE ENTRY (BC) & (H) ON ERROR
  1322.         STC             ;MARK ERROR
  1323.         RET
  1324. ;
  1325. ; MASTER CONTROL
  1326. TEST1:  ORA     A       ;CHECK ERROR CODE
  1327.         LXI     H,OVM
  1328.         JNZ     TEST3   ;OVERFLOW ERROR
  1329. TEST2:  LXI     H,ERRM  ;SYNTAX ERROR
  1330. TEST3:  CALL    TSTR
  1331. TEST:   CALL    CRLF
  1332.         CALL    EVAL
  1333.         JC      TEST1
  1334.         SUI     7       ;CHECK FOR '='
  1335.         JNZ     TEST2   ;NOT =, ERROR
  1336.         CALL    TFLT
  1337.         JMP     TEST
  1338. ;
  1339. OPTBL:  DB      7,'*/'
  1340.         DB      '+-()'
  1341.         DB      '='
  1342. ;
  1343. ; OPERATOR TABLE
  1344. TBL:    DW      NULL
  1345.         DW      FMUL,FDIVX
  1346.         DW      FADD,FSUB
  1347. ;
  1348. OVM:    DB      ' '
  1349.         DB      'OVER'
  1350.         DB      'FLOW'
  1351. ERRM:   DB      ' ERR'
  1352.         DB      'OR '
  1353.         DB      '***',0
  1354. ;
  1355.         IF      DEBUG
  1356. ;
  1357. ; COPIES OF ROUTINE FROM YALVER. 2.3
  1358. ; INCLUDED FOR COMPLETENESS ONLY
  1359. ;
  1360. CR      EQU     0DH     ;ASCII CR
  1361. LF      EQU     0AH     ;ASCII LF
  1362. ;
  1363. CRLFM:  DB      CR,LF,0
  1364. ;
  1365. ; TYPE STRING ON CONSOLE TILL 0 BYTE
  1366. ; H,L
  1367. TSTR:   PUSH    PSW
  1368.         PUSH    B       ;SAVE
  1369. TSTR1:  CALL    SEXIT
  1370.         CALL    COUT    ;OUT TO CONSOLE
  1371.         JMP     TSTR1   ;GET NEXT
  1372. ;
  1373. ; SRING OUTPUT EXIT TEST
  1374. ; RESTORES BC & PSW FROM CALLING ROUTINES STACK
  1375. ; AND EXITS TO ROUTINE THAT CALLED CALLING ROUTINE
  1376. SEXIT:  MOV     A,M
  1377.         INX     H       ;ADVANCE POINTER
  1378.         MOV     C,A     ;PREPARE FOR OUTPUT
  1379.         ORA     A       ;TEST FOR ZERO BYTE
  1380.         RNZ             ;NOT END OF STRING
  1381.         POP     B       ;DOWN IN STACK, PURGE RETURN ADR.
  1382.         POP     B       ;RESTORE ORIGINAL BC
  1383.         POP     PSW     ;RESTORE A,FLAGS
  1384.         RET
  1385. ;
  1386. ; CR & LF TO CONNSOLE
  1387. CRLF:   PUSH    H       ;SAVE
  1388.         LXI     H,CRLFM
  1389.         CALL    TSTR
  1390.         POP     H
  1391.         RET
  1392. ;
  1393. ; INPUT FROM CONSOLE, ECHOED & RETURNED IN A
  1394. ; LF APP  TO CR. RESULT COMPARED TO CR
  1395. ; A,F
  1396. CECHO:  CALL CINX
  1397.         CPI     CR
  1398.         JZ      CRLF
  1399. ;
  1400. ; OUTPUT (A) TO CONSOLE
  1401. ; A,F
  1402. COUTA:  PUSH    B
  1403.         MOV     C,A
  1404.         CALL    COUT
  1405.         POP     B
  1406.         CPI     CR
  1407.         RET
  1408. ;
  1409. ; CONSOLE INPUT AND MASK OFFO BIT 8
  1410. ; A,F
  1411. CINX:   CALL    CIN
  1412.         ANI     7FH
  1413.         RET
  1414. ;
  1415. ; EXTRACT A DEC. DIGIT, 10^((B)-1), FROM (HL)
  1416. ; MORE SIG, DIGIT HAVE BEEN EXTRACTED
  1417. ; ASCII DIGIT RETURED IN (C) & (A)
  1418. ; WITH ZERO FLAG FOR DIGIT=ZERO
  1419. ; A,F,C,H,L
  1420. EXDG:   PUSH    D
  1421.         PUSH    H       ;SAVE VALUE
  1422.         LXI     H,TPWRT-2
  1423.         MOV     A,B
  1424.         CALL    INDX2   ;POINT TO POWER OF TEN
  1425.         MOV     E,M
  1426.         INX     H
  1427.         MVI     C,'0'-1
  1428. EXDG1:  INR     C
  1429.         DAD     D
  1430.         JC      EXDG1   ;DO AGAIN
  1431.         CALL    SUBDE   ;OVER, DO AGAIN
  1432.         MOV     A,C     ;RESULT
  1433.         POP     D       ;RESTORE
  1434.         MOV     C,A     
  1435.         CPI     '0'     ;COMPARE WITH ZERO
  1436.         RET
  1437. ;
  1438. ; TABLE OF -10^N
  1439. TPWRT:  DW      -1
  1440.         DW      -10,-100
  1441.         DW      -1000,-10000
  1442. ;
  1443. ; TYPE (HL) IN DECIMAL ON CONSOL
  1444. ; SUPPRESS LEADING ZEROES
  1445. TDZS:   PUSH    H
  1446.         PUSH    B
  1447.         PUSH    PSW
  1448. TDZS1:  MVI     B,5
  1449. TDZS2:  CALL    EXDG    ;EXTRACT A DIGIT
  1450.         JNZ     TDZS6   ;NON-ZERO, END SUPPRESS
  1451.         DCR     B
  1452.         JNZ     TDZS2   ;CONTINUE SUPPRESSION
  1453. TDZS3:  CALL    COUT    ;PRINT LAST DIGIT
  1454. TDZS4:  POP     PSW
  1455.         POP     B
  1456.         POP     H
  1457.         RET
  1458. TDZS5:  CALL    EXDG    ;GET NEXT DIGIT
  1459. TDZS6:  CALL    COUT    
  1460.         DCR     B
  1461.         JNZ     TDZS5
  1462.         JMP     TDZS4
  1463. ;
  1464. ; END OF COPIED ROUTINES
  1465. ;
  1466.         ENDIF
  1467. ;
  1468.         END     
  1469.