home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / DRI-archive / roche / INTARITH.ASM < prev    next >
Assembly Source File  |  2009-12-11  |  9KB  |  423 lines
  1. ; INTARITH.ASM
  2. ; ------------
  3. ;
  4. ; See FALCONER.WS4 for doc.
  5. ;
  6. ; (Retyped by Emmanuel ROCHE.)
  7. ;
  8. ;--------------------------------
  9. ; Allowable entry points
  10. ;
  11.     entry    imul,idiv,mul.div
  12. ;
  13. ;--------------------------------
  14. ; Entry points for utility routines
  15. ;
  16.     entry    stadr.ldes,lbcs.las    ; Stack addressing
  17.     entry    bclz,bclc,bcra,bcrc    ; Shifts and complements
  18.     entry    dhlz,dera,derc        ; 
  19.     entry    c2bc.c1bc,c2de,c1de,c2dhl
  20.     entry    mul10,dten,dquik    ; Fast arithmetic
  21. ;
  22. ;--------------------------------
  23. ; Macro definition
  24. ;
  25. ; "Return" and check stack level zero
  26. ;
  27. rtn    macro
  28.     if    .lvl
  29.     error    "0"+.lvl
  30. .lvl    set    0
  31.     endif
  32.     ret
  33.     endm
  34. ;
  35. ;--------------------------------
  36. ; Utility routines
  37. ;--------------------------------
  38. ;
  39. ; Stack addressing routines operate on an input stack level,
  40. ; supplied via the A-register. This specifies the stack level
  41. ; with respect to the calling routine, derived by counting
  42. ; "pushes" since the item was pushed. If the item was stored
  43. ; by the last "push", its address is zero. The address may
  44. ; not exceed 252.
  45. ;
  46. ; Generate stack absolute address for stack addressing routines
  47. ; A,F,H,L
  48. ;
  49. stadr:    lxi    h,3        ; Allow for push H and 2 RETs
  50.     add    l        ; Max stack level is 252
  51.     mov    l,a        ; 
  52.     dad    h        ; Convert to byte address
  53.     dad    sp        ; Memory address formed
  54.     rtn            ; 
  55. ;
  56. ; Load (DE) from stack level (A)
  57. ; A,F,D,E
  58. ;
  59. ldes:    push    h        ; 
  60.     call    stadr        ; Get absolute address
  61.     mov    e,m        ; 
  62.     inx    h        ; 
  63.     mov    d,m        ; 
  64.     pop    h        ; 
  65.     rtn            ; 
  66. ;
  67. ; Load (BC) from stack level (A)
  68. ; (A) is stack level W.R.T. calling routine
  69. ; A,F,B,C
  70. ;
  71. lbcs:    push    h        ; 
  72.     call    stadr        ; Form absolute address
  73.     mov    c,m        ; 
  74.     inx    h        ; 
  75.     mov    b,m        ; 
  76.     pop    h        ; 
  77.     rtn            ; 
  78. ;
  79. ; Load (A) from stack level (A)
  80. ; Value was stored by push psw
  81. ; A,F
  82. ;
  83. las:    push    h        ; 
  84.     call    stadr        ; Form absolut address
  85.     inx    h        ; 
  86.     mov    a,m        ; 
  87.     pop    h        ; 
  88.     rtn            ; 
  89. ;
  90. ; Shift (DEHL) register left, insert 0
  91. ; Original high order bit to Carry
  92. ; A,F,D,E,H,L  (A=D on exit)
  93. ;
  94. dhlz:    dad    h        ; 
  95.     mov    a,e        ; 
  96.     ral            ; 
  97.     mov    e,a        ; 
  98.     mov    a,d        ; 
  99.     ral            ; 
  100.     mov    d,a        ; 
  101.     rtn            ; 
  102. ;
  103. ; (BC) left shift, zero insert, leave (B) in (A)
  104. ; A,F,B,C
  105. ;
  106. bclz:    ora    a        ; Clear Carry
  107. ;
  108. ; (BC) left shift, Carry insert, leave (B) in (A)
  109. ; A,F,B,C
  110. ;
  111. bclc:    mov    a,c        ; 
  112.     ral            ; 
  113.     mov    c,a        ; 
  114.     mov    a,b        ; 
  115.     ral            ; 
  116.     mov    b,a        ; 
  117.     rtn            ; 
  118. ;
  119. ; Arith shift right (BC), leave (C) in (A)
  120. ; A,F,B,C
  121. ;
  122. bcra:    mov    a,b        ; 
  123.     ral            ; 
  124. ;
  125. ; (BC) right shift, Carry in, leave (C) in (A)
  126. ; A,F,B,C
  127. ;
  128. bcrc:    mov    a,b        ; 
  129.     rar            ; 
  130.     mov    b,a        ; 
  131.     mov    a,c        ; 
  132.     rar            ; 
  133.     mov    c,a        ; 
  134.     rtn            ; 
  135. ;
  136. ; Arithmetic right shift (DE), leave (E) in (A)
  137. ; A,F,D,E
  138. ;
  139. dera:    mov    a,d        ; 
  140.     ral            ; 
  141. ;
  142. ; (DE) right shift, Carry insert, leave (E) in (A)
  143. ; A,F,D,E
  144. ;
  145. derc:    mov    a,d        ; 
  146.     rar            ; 
  147.     mov    d,a        ; 
  148.     mov    a,e        ; 
  149.     rar            ; 
  150.     mov    e,a        ; 
  151.     rtn            ; 
  152. ;
  153. ; 2's complement (BC), leave (B) in (A)
  154. ; A,B,C
  155. ;
  156. c2bc:    dcx    b        ; 
  157. ;
  158. ; 1's complement (DE), leave (B) in (A)
  159. ; A,D,E
  160. ;
  161. c1bc:    mov    a,c        ; 
  162.     cma            ; 
  163.     mov    c,a        ; 
  164.     mov    a,b        ; 
  165.     cma            ; 
  166.     mov    b,a        ; 
  167.     rtn            ; 
  168. ;
  169. ; 2's complement (DE), leave (D) in (A)
  170. ; A,D,E
  171. ;
  172. c2de:    dcx    d        ; 
  173. ;
  174. ; 1's complement (DE), leave (D) in (A)
  175. ; A,D,E
  176. ;
  177. c1de:    mov    a,e        ; 
  178.     cma            ; 
  179.     mov    e,a        ; 
  180.     mov    a,d        ; 
  181.     cma            ; 
  182.     mov    d,a        ; 
  183.     rtn            ; 
  184. ;
  185. ; 2's complement (DEHL)
  186. ; A,F,D,E,H,L
  187. ;
  188. c2dhl:    xchg            ; 
  189.     call    c2de        ; 
  190.     xchg            ; 
  191.     call    c1de        ; 
  192.     mov    a,h        ; 
  193.     ora    l        ; 
  194.     rnz            ; 
  195.     inx    d        ; Propagate Carry
  196.     rtn            ; 
  197. ;
  198. ; Multiply (HL) by 10 (modulo 65536)
  199. ; No overflow signal
  200. ; F,H,L
  201. ;
  202. mul10:    push    d        ; 
  203.     mov    d,h        ; 
  204.     mov    e,l        ; Copy HL to DE
  205.     dad    d        ; 2*
  206.     dad    h        ; 4*
  207.     dad    d        ; 5*
  208.     dad    h        ; 10*
  209.     pop    d        ; Restore DE
  210.     rtn            ; 
  211. ;
  212. ; Divide integer (HL) by 10
  213. ; Remainder appears in (A) with flags set
  214. ; A,F,H,L
  215. ;
  216. dten:    push    b        ; Save BC
  217.     mvi    c,10        ; Divisor
  218. dten1:    xra    a        ; Clear
  219.     mvi    b,-16        ; Iteration count
  220. dten2:    dad    h        ; 
  221.     ral            ; Shift off into (A)
  222.     jc    dten3        ; Allow for DQUIK
  223.     cmp    c        ; Test
  224.     jc    dten4        ; No bit
  225. dten3:    sub    c        ; Bit = 1
  226.     inx    h        ; 
  227. dten4:    inr    b        ; Done?
  228.     jm    dten2        ; No
  229.     ora    a        ; Set flags for RDR., clear Carry
  230.     pop    b        ; Restore
  231.     rtn            ; 
  232. ;
  233. ; *** This routine is not used in the FLTARITH system ***
  234. ; Integer divide 16 by 0 bit quantities
  235. ; (HL)/(A) => (HL); remainder => (A)
  236. ; Set Carry for division by zero. Preserve HL
  237. ; A,F,H,L
  238. ;
  239. dquik:    ora    a        ; 
  240.     stc            ; 
  241.     rz            ; Division by zero
  242.     push    b        ; 
  243. .lvl    set    .lvl-1        ; 
  244.     mov    c,a        ; 
  245.     jmp    dten1        ; 
  246. ;
  247. ; *** End utility routines ***
  248. ; ----------------------------
  249. ;
  250. ; Integer (pos.) multiply DE*BC -> DEHL
  251. ; Operand range 0 to 65535
  252. ; D,E,H,L
  253. ;
  254. imul:    push    psw        ; 
  255.     lxi    h,0        ; Clear Accumulator
  256.     mvi    a,-16        ; Iteration count
  257. imul1:    push    psw        ; Save iteration count
  258.     dad    h        ; Left shift, Carry out
  259.     mov    a,e        ; Left sh m'plier, insert o'flow
  260.     ral            ; 
  261.     mov    e,a        ; 
  262.     mov    a,d        ; 
  263.     ral            ; 
  264.     mov    d,a        ; 
  265.     jnc    imul2        ; No bit
  266.     dad    b        ; Add in multiplicand
  267.     jnc    imul2        ; No overflow
  268. imul2:    pop    psw        ; Iteration count
  269.     inr    a        ; 
  270.     jm    imul1        ; Do again
  271.     pop    psw        ; Restore
  272.     rtn            ; 
  273. ;
  274. ; Integer (pos.) divide (DEHL)/(BC)=>(DE)
  275. ; Remainder appears in (HL)
  276. ; Carry for overflow, when registers unchanged
  277. ; Divisor, remainder and quotient range 0 to 65535
  278. ; Dividend range 0 to 4295*10^6 (approx.)
  279. ; F,D,E,H,L
  280. ;
  281. idiv:    push    psw        ; 
  282.     mov    a,e        ; Check for overflow
  283.     sub    c        ; 
  284.     mov    a,d        ; 
  285.     sbb    b        ; 
  286.     jc    idiv1        ; No overflow
  287.     pop    psw        ; Restore (A)
  288.     stc            ; Mark overflow
  289.     rtn            ; 
  290. .lvl    set    .lvl+1        ; 
  291. idiv1:    push    b        ; 
  292.     call    c2bc        ; Change (BC) sign
  293.     xchg            ; Do arithmetic in (HL)
  294.     mvi    a,-16        ; Iteration count
  295. idiv2:    push    psw        ; Save iteration count
  296.     dad    h        ; Left shift (HLDE)
  297.     rar            ; Save Carry out
  298.     xchg            ; 
  299.     dad    h        ; 
  300.     xchg            ; 
  301.     jnc    idiv3        ; No Carry into L
  302.     inx    h        ; 
  303. idiv3:    ral            ; Regain Carry from H
  304.     jc    idiv4        ; Yes, generate quotient bit
  305.     mov    a,l        ; 
  306.     add    c        ; Test for quotient bit
  307.     mov    a,h        ; 
  308.     adc    b        ; 
  309.     jnc    idiv5        ; No bit
  310. idiv4:    dad    b        ; Subtract
  311.     inx    d        ; Insert quotient bit
  312. idiv5:    pop    psw        ; Get iteration count
  313.     inr    a        ; 
  314.     jm    idiv2        ; Not done
  315.     pop    b        ; Restore BC
  316.     pop    psw        ; Restore A
  317.     ora    a        ; Clear any Carry, no overflow
  318.     rtn            ; 
  319. ;
  320. ; *** This routine is not used in the FLTARITH system ***
  321. ; Signed multiply (DE)*(BC)->(DEHL)
  322. ; F,D,E,H,L
  323. ;
  324. mul:    push    psw        ; 
  325.     push    b        ; 
  326.     mov    a,d        ; 
  327.     ora    a        ; 
  328.     jm    mul3        ; (DE) -ve (negative)
  329.     mov    a,b        ; 
  330.     ora    a        ; 
  331.     jp    mul4        ; Both +ve (positive)
  332. mul1:    call    c2bc        ; 2's complement BC
  333. mul2:    call    imul        ; Result -ve
  334.     call    c2dhl        ; 2's complement DEHL
  335.     jmp    mul5        ; 
  336. mul3:    call    c2de        ; (DE) -ve
  337.     mov    a,e        ; 
  338.     ora    a        ; 
  339.     jp    mul2        ; (DE) -ve, (BC) +ve
  340.     call    c2bc        ; (DE) -ve, (BC) -ve
  341. mul4:    call    imul        ; Result +ve
  342. mul5:    pop    b        ; 
  343.     pop    psw        ; 
  344.     ora    a        ; Reset Carry, no overflow
  345.     rtn            ; 
  346. ;
  347. ; *** This routine is not used in the FLTARITH system ***
  348. ; Do IDIV on signed + ho's & check overflow
  349. ; Expecting +ve result
  350. ; A,F,D,E,H,L
  351. ;
  352. idivq:    call    idiv        ; 
  353.     rc            ; 
  354.     mov    a,d        ; 
  355.     ral            ; 
  356.     rtn            ; Result should be +ve
  357. ;
  358. ; *** This routine is not used in the FLTARITH system ***
  359. ; Do IDIV on signed + ho's & check overflow
  360. ; Inputs may include 8000H
  361. ; Expecting -ve result, allow 8000H
  362. ; A,F,D,E,H,L
  363. ;
  364. idivn:    call    idiv        ; 
  365.     rc            ; Overflow
  366.     call    c2de        ; Complement quotient
  367.     ral            ; Result should be -ve
  368.     cmc            ; 
  369.     rtn            ; 
  370. ;
  371. ; *** This routine is not used in the FLTARITH system ***
  372. ; Signed divide (DEHL)/(BC)->(DE)
  373. ; Remainder appears in (HL)
  374. ; Carry indicates overflow when
  375. ; inputs are preserved, except flags
  376. ; F,D,E,H,L  (9)
  377. ;
  378. div:    push    psw        ; 
  379.     push    b        ; 
  380.     push    d        ; 
  381.     push    h        ; Save in case of overflow
  382.     mov    a,d        ; 
  383.     ora    d        ; 
  384.     jm    div4        ; Dividend negative
  385.     ora    b        ; 
  386. @01    set    .lvl        ;
  387.     jm    div2        ; +/-
  388.     call    idivq        ; +/+
  389.     jc    div3        ; Overflow
  390. div1:    pop    b        ; Purge stack, no overflow
  391.     pop    b        ; 
  392.     pop    b        ; 
  393.     pop    psw        ; 
  394.     ora    a        ; Reset Carry, no overflow
  395.     rtn            ; 
  396. .lvl    set    @01        ; 
  397. div2:    call    c2bc        ; +/-, complement BC
  398.     call    idivn        ; 
  399.     jnc    div1        ; No overflow
  400. div3:    pop    h        ; Restore entry, overflow
  401.     pop    d        ; 
  402.     pop    b        ; 
  403.     pop    psw        ; 
  404.     stc            ; Mark overflow wit Carry
  405.     rtn            ; 
  406. div4:    call    c2dhl        ; -/?, complement DEHL
  407.     mov    a,b        ; 
  408.     ora    a        ; 
  409.     jm    div7        ; -/-
  410.     call    idivn        ; 
  411. div5:    jc    div3        ; Overflow
  412. div6:    xchg            ; 
  413.     call    c2de        ; 
  414.     xchg            ; Complement remainder
  415.     jmp    div1        ; 
  416. div7:    call    c2bc        ; -/-, complement BC
  417.     call    idivq        ; 
  418.     jmp    div5        ;
  419. ;
  420. ;--------------------------------
  421. ;
  422.     END            ; of INTARITH.ASM
  423.