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 / FLTOUT.ASM < prev    next >
Assembly Source File  |  2009-12-11  |  10KB  |  466 lines
  1. ; FLTOUT.ASM
  2. ; ----------
  3. ;
  4. ; See FALCONER.WS4 for doc.
  5. ;
  6. ; (Retyped by Emmanuel ROCHE.)
  7. ;
  8. ;--------------------------------
  9. ; External calls required
  10. ;
  11.     extrn    derc,dten       ; in INTARITH
  12.     extrn    fdivt,fload,fmult  ; in FLTARITH
  13. ;
  14. ;--------------------------------
  15. ; External connectors to list and console drivers
  16. ;
  17.     extrn    lout,cout    ; Undefined in system,
  18.                 ;   output (C), Set (A) := (C).
  19. ;
  20. ;--------------------------------
  21. ; Entry points allowed
  22. ;
  23.     entry    lflt,tflt,oflt,fmat
  24. ;
  25. ;--------------------------------
  26. ; Entry points to utility routines
  27. ;
  28.     entry    exdg,otcbk,otccl
  29.     entry    opt,oneg,odzs
  30. ;
  31. ;--------------------------------
  32. ; Macro definitions
  33. ;--------------------------------
  34. ;
  35. ; Load (reg) from TOS and leave on stack (reg)
  36. ;
  37. ltos    macro    reg
  38.     pop    reg
  39.     push    reg
  40.     endm
  41. ;
  42. ; "Return" and check stacl level zero
  43. ;
  44. rtn    macro
  45.     if    .lvl
  46.     error    "0"+.lvl
  47. .lvl    set    0
  48.     endif
  49.     ret
  50.     endm
  51. ;
  52. ; Trade (A) digits, leave LSB in Carry (A,F)
  53. ;
  54. tdig    macro
  55.     rlc
  56.     rlc
  57.     rlc
  58.     rlc
  59.     endm
  60. ;
  61. ;--------------------------------è; Utility routines
  62. ;--------------------------------
  63. ;
  64. ; Output blank to console/lister
  65. ; Use lister if (A) sign bit=1; else console
  66. ; A,F,C
  67. ;
  68. otcbk:    mvi    c,' '        ; 
  69. ;
  70. ; Output a character
  71. ; Use lister if (A) sign bit=1; else console
  72. ; A,F,C
  73. ;
  74. otccl:    rlc            ; 
  75.     jc    lout        ; 
  76.     jmp    cout        ; On console
  77. ;
  78. ; Output (A) blanks
  79. ; Use lister if (A) sign bit=1; else console
  80. ; A,F
  81. ;
  82. hblk:    push    b        ; 
  83.     mov    b,a        ; 
  84.     jmp    hblk2        ; Check for zero
  85. hblk1:    mov    a,b        ; 
  86.     call    otcbk        ; 
  87.     dcr    b        ; 
  88.     mov    a,b        ; 
  89. hblk2:    ani    7FH        ; 
  90.     jnz    hblk1        ; 
  91.     pop    b        ; 
  92.     rtn            ; 
  93. ;
  94. ; Output a decimal point
  95. ; Use lister if (A) sign bit=1; else console
  96. ; A,F,C
  97. ;
  98. opt:    mvi    c,'.'        ; Decimal point
  99.     jmp    otccl        ; 
  100. ;
  101. ; Output "-"
  102. ; Use lister if (A) sign bit=1; else console
  103. ; A,F,C
  104. ;
  105. oneg:    mvi    c,'-'        ; Negative sign
  106.     jmp    otccl        ; 
  107. ;
  108. ; Output (HL) in decimal, suppress leading zeros
  109. ; Use lister if (A) sign bit=1; else console
  110. ;
  111. odzs:    push    b        ; 
  112.     mvi    b,5        ; 
  113.     push    psw        ; Preserve
  114. odzs2:    call    exdg        ; Extract a digit
  115.     jnz    odzs4        ; Non-zero, end suppress
  116.     dcr    b        ; 
  117.     jnz    odzs2        ; Continue suppression
  118.     inr    b        ; Re-extract final zero and output
  119. odzs3:    call    exdg        ; Get next digit
  120. odzs4:    ltos    psw        ; è    call    otccl        ; Output to console or lister
  121.     dcr    b        ; 
  122.     jnz    odzs3        ; 
  123.     pop    psw        ; 
  124.     pop    b        ; 
  125.     rtn            ; 
  126. ;
  127. ; Extract a decimal digit, 10^((B)-1), from (HL).
  128. ; ASCII digit returned in (C) and (A)
  129. ;   with Zero flag for digit=zero.
  130. ; A,F,C
  131. ;
  132. exdg:    push    h        ; 
  133.     push    b        ; 
  134. exdg1:    call    dten        ; 
  135.     dcr    b        ; 
  136.     jnz    exdg1        ; 
  137.     adi    '0'        ; 
  138.     cpi    '0'        ; 
  139.     pop    b        ; 
  140.     pop    h        ; 
  141.     mov    c,a        ; 
  142.     rtn            ; 
  143. ;
  144. ;--------------------------------
  145. ; End utility routines
  146. ;--------------------------------
  147. ;
  148. ; "Fixed" point representation consist of a 16 bit positive
  149. ; integer (in the range 0 to 65535), and a 7 bit offset (by
  150. ; 40H) integer exponent, which represents a power of ten
  151. ; multiplier. The eighth exponent bit represents the sign
  152. ; of the mantissa. This representation is used for input/
  153. ; output only.
  154. ;
  155. ; Convert "real" format to "fixed" format
  156. ; A,F,D,E,H
  157. ;
  158. fix:    mov    a,h        ; 
  159.     ora    a        ; 
  160.     jnz    fix1        ; Value not zero
  161.     mvi    h,40H        ; 00000
  162.     lxi    d,0        ; 
  163.     rtn            ; 
  164. fix1:    cpi    91H        ; 
  165.     push    b        ; 
  166.     mvi    b,40H        ; Decimal exponent
  167. @01    set    .lvl        ; 
  168.     jnc    fix5        ; > 65535, integer
  169.     cpi    8EH        ; 
  170.     jnc    fix6        ; Treat as left shifted integer
  171. fix2:    call    fmult        ; < 32768
  172.     dcr    b        ; 
  173.     mov    a,h        ; 
  174.     sui    90H        ; 
  175.     jc    fix2        ; Still fractional segment
  176.     jnz    fix5        ; Not now integer
  177. fix3:    mov    a,d        ; 
  178.     ani    80H        ; Extract sign
  179.     ora    b        ; è    mov    h,a        ; 
  180.     mov    a,d        ; 
  181.     ori    80H        ; Set MSbit, range 32768/65535
  182.     mov    d,a        ; 
  183.     pop    b        ; 
  184.     rtn            ; 
  185. .lvl    set    @01        ; 
  186. fix5:    call    fdivt        ; Integer > 65535
  187.     inr    b        ; 
  188.     mov    a,h        ; 
  189. fix6:    sui    90H        ; 
  190.     jz    fix3        ; Now integer representation
  191.     jnc    fix5        ; 
  192.     mov    h,a        ; Range -1 to -4
  193.     mov    a,d        ; 
  194.     ani    80H        ; Result sign
  195.     ora    b        ; 
  196.     mov    b,a        ; 
  197.     mov    a,d        ; 
  198.     ori    80H        ; 
  199.     mov    d,a        ; 
  200. fix7:    ora    a        ; Reset Carry
  201.     call    derc        ; 
  202.     inr    h        ; 
  203.     jnz    fix7        ; Shift off fractional segment
  204.     jnc    fix8        ; No rounding needed
  205.     inx    d        ; 
  206. fix8:    mov    h,b        ; 
  207.     pop    b        ; 
  208.     ora    a        ; Reset Carry
  209.     rtn            ; 
  210. ;
  211. ; ***** Output routines *****
  212. ;
  213. ; Output (DE.H) in "fixed" form
  214. ; Suppress leading zeroes
  215. ; If A >= 0, to console. If a < 0, to lister.
  216. ; A,F,B,C,D,E,H,L
  217. ;
  218. ofix:    push    psw        ; 
  219.     mov    a,h        ; 
  220.     ani    80H        ; 
  221.     jp    ofix1        ; Positive
  222.     ltos    psw        ; Output "-" sign
  223.     call    oneg        ; Send a "-" sign
  224. ofix1:    mov    a,h        ; 
  225.     ani    7FH        ; Remove sign
  226.     sui    40H-6        ; Signed decimal exponent
  227.     mov    h,a        ; 
  228.     xchg            ; Value in HL, exponent in D
  229.     mvi    b,6        ; First digit
  230. ofix2:    dcr    b        ; 
  231. @01    set    .lvl        ; 
  232.     jz    ofixa        ; Done, all digits 0
  233.     dcr    d        ; 
  234.     jz    ofix7        ; Decimal point here
  235.     jm    ofix7        ;  xxxxE-xx
  236.     call    exdg        ; 
  237.     jz    ofix2        ; Suppress a zero
  238. ofix3:    ltos    psw        ; 
  239.     call    otccl        ; List a digitè    dcr    d        ; 
  240.     jnz    ofix4        ; 
  241.     ltos    psw        ; 
  242.     call    opt        ; Decimal point here
  243. ofix4:    dcr    b        ; 
  244.     jz    ofix5        ; All digits listed
  245.     call    exdg        ; 
  246.     jmp    ofix3        ; List next digit
  247. ofix5:    xra    a        ; 
  248.     sub    d        ; 
  249.     jp    ofixb        ; Not xxxx.E+xx
  250.     adi    3        ; 
  251.     jm    ofix6        ; > 9999000
  252.     mvi    c,"0"        ; 
  253.     ltos    psw        ; 
  254.     call    otccl        ; 
  255.     dcr    d        ; 
  256.     jmp    ofix5        ; 
  257. ofix6:    mvi    c,'E'        ; 
  258.     ltos    psw        ; 
  259.     call    otccl        ; 
  260.     mov    l,d        ; 
  261.     mvi    h,0        ; 
  262.     pop    psw        ; 
  263.     jmp    odzs        ; List exponent
  264. .lvl    set    @01        ; 
  265. ofix7:    ltos    psw        ; 
  266.     call    opt        ; .xxxxE-xx
  267. ofix8:    mov    a,d        ; 
  268.     ora    a        ; 
  269.     jz    ofix9        ; Zero exponent
  270.     adi    3        ; 
  271.     jm    ofix9        ; Range -1 to -3, insert 0's
  272.     mvi    c,"0"        ; 
  273.     ltos    psw        ; 
  274.     call    otccl        ; 
  275.     inr    d        ; 
  276.     jmp    ofix8        ; Check for more 0's
  277. ofix9:    call    exdg        ; 
  278.     ltos    psw        ; 
  279.     call    otccl        ; 
  280.     dcr    b        ; 
  281.     jnz    ofix9        ; 
  282.     xra    a        ; 
  283.     mov    h,a        ; 
  284.     sub    d        ; 
  285.     mov    l,a        ; 
  286.     jz    ofixb        ; Ignore zero exponent
  287.     mvi    c,'E'        ; 
  288.     ltos    psw        ; 
  289.     call    otccl        ; 
  290.     ltos    psw        ; 
  291.     call    oneg        ; 
  292.     pop    psw        ; 
  293.     jmp    odzs        ; List exponent and exit
  294. .lvl    set    @01        ; 
  295. ofixa:    ltos    psw        ; 
  296.     call    otccl        ; List a zero
  297. ofixb:    pop    psw        ; 
  298.     rtn            ; 
  299. ;
  300. ; Output "real" (DE.H) to listerè;
  301. lflt:    push    psw        ; 
  302.     mvi    a,-1        ; Identify as lister output
  303.     call    oflt        ; 
  304.     pop    psw        ; 
  305.     rtn            ; 
  306. ;
  307. ; Output "real" (DE.H) to console
  308. ;
  309. tflt:    push    psw        ; 
  310.     mvi    a,0        ; Identify as console output
  311.     call    oflt        ; 
  312.     pop    psw        ; 
  313.     rtn            ; 
  314. ;
  315. ; Output "real"
  316. ; If A < 0, to lister. If A >= 0, to console.
  317. ; A
  318. ;
  319. oflt:    push    b        ; 
  320.     push    d        ; 
  321.     push    h        ; 
  322.     push    psw        ; 
  323.     call    fix        ; 
  324.     pop    psw        ; Get destination
  325.     call    ofix        ; 
  326.     pop    h        ; 
  327.     pop    d        ; 
  328.     pop    b        ; 
  329.     rtn            ; 
  330. ;
  331. ; Output (DE.H) with format specification in (A)
  332. ;
  333. ; (A) bit field        Meaning
  334. ; -------------     -------
  335. ;  0:1 (LH bit)     1=to lister, 0=to console
  336. ;  1:3 (3 bits)     Places to left of decimal point
  337. ;  4:1 (1 bit)      Use free format, ignore places spec
  338. ;  5:3 (3 RH bits)  Places to right of decimal point
  339. ;
  340. fmat:    push    psw        ; 
  341.     push    b        ; 
  342.     push    d        ; 
  343.     push    h        ; 
  344.     push    psw        ; Save places
  345.     call    fix        ; 
  346.     ltos    psw        ; 
  347.     call    ajfx        ; Adjust on right of dec point
  348.     call    tpsn        ; Position the field
  349.     pop    psw        ; For list/console destination
  350.     call    ofix        ; Output the data
  351.     pop    h        ;   and restore registers.
  352.     pop    d        ; 
  353.     pop    b        ; 
  354.     pop    psw        ; 
  355.     rtn            ; 
  356. ;
  357. ; Adjust "fixed" format for (A) digits after decimal point
  358. ; Max digits=7, 8 bit for floating format
  359. ; Round the result
  360. ; D,E,Hè;
  361. ajfx:    push    psw        ; 
  362.     push    b        ; 
  363.     push    h        ; Save BC.L
  364.     ani    15        ; 
  365.     cpi    8        ; 
  366.     jnc    ajfx4        ; Floating format, no adjust
  367.     ani    7        ; 7 digits max
  368.     mov    c,a        ; Digits required
  369. ajfx1:    mov    a,h        ; 
  370.     ani    7FH        ; Remove sign
  371.     sui    40H        ; 
  372.     add    c        ; 
  373.     jp    ajfx4        ; No excess fractional segment
  374.     mov    b,a        ; 
  375.     xchg            ; 
  376. ajfx2:    call    dten        ; Remove a digit
  377.     inr    d        ; Adjust decimal exponent
  378.     inr    b        ; 
  379.     jm    ajfx2        ; Remove more
  380.     cpi    5        ; 
  381.     jc    ajfx3        ; No rounding
  382.     inx    h        ; 
  383. ajfx3:    xchg            ; 
  384.     jmp    ajfx1        ; In case rounding added digit
  385. ajfx4:    pop    b        ; Reload BC.L
  386.     mov    l,c        ; 
  387.     pop    b        ; 
  388.     pop    psw        ; 
  389.     rtn            ; 
  390. ;
  391. ; Control leading blanks via bits 1:3 of (A)
  392. ; Bit 4:1 specifies free format else output blanks
  393. ;   required to place the decimal point at the
  394. ;   field position to right of starting point.
  395. ;
  396. tpsn:    push    psw        ; 
  397.     push    b        ; 
  398.     push    psw        ; 
  399.     ani    8        ; 
  400.     jnz    tpsn9        ; Free format
  401.     pop    psw        ; 
  402.     ani    0F0H        ; 
  403.     mov    b,a        ; 
  404.     ani    70H        ; 
  405.     tdig            ; 
  406.     mov    c,a        ; Count of places needed
  407.     push    b        ; 
  408.     mov    a,h        ; 
  409.     ani    7FH        ; 
  410.     sui    40H        ; Form dp loc wrt right digit
  411.     jm    tpsn5        ; Fract segment
  412.     inr    a        ; 
  413.     cmp    b        ; 
  414.     jnc    tpsn9        ; Too large, use free format
  415.     mvi    a,0        ; Use value zero?
  416. tpsn5:    mov    b,a        ; Negative value
  417.     call    ndig        ; Count of sig digits in value
  418.     add    b        ;   to left of decimal point
  419.     jp    tpsn6        ; There are someè    mvi    a,0        ; One + zeroes after dec point
  420. tpsn6:    pop    b        ; 
  421.     cma            ; 
  422.     inr    a        ; 
  423.     add    c        ; Spaces required
  424.     jp    tpsn8        ; 
  425.     mvi    a,0        ; Can't allow negative count
  426. tpsn8:    mov    c,a        ; 
  427.     mov    a,h        ; 
  428.     ora    a        ; 
  429.     jp    tpsn7        ; Positive value
  430.     dcr    c        ; Allow for - sign
  431.     jp    tpsn7        ; Room
  432.     inr    c        ; No room, move all right
  433. tpsn7:    mov    a,b        ; 
  434.     ani    80H        ; File flag
  435.     ora    c        ; 
  436.     call    hblk        ; Space as required
  437.     push    psw        ; 
  438. tpsn9:    pop    psw        ; 
  439.     pop    b        ; 
  440.     pop    psw        ; 
  441.     rtn            ; 
  442. ;
  443. ; Return count of significant digits in (DE)
  444. ; Treating (DE) as decimal integer with leading
  445. ;   zeroes suppressed. Return 1 for value 00000.
  446. ; A,F
  447. ;
  448. ndig:    push    b        ; 
  449.     push    d        ; 
  450.     xchg            ; 
  451.     mvi    b,0        ; 
  452. ndig1:    inr    b        ; 
  453.     call    dten        ; 
  454.     mov    a,h        ; 
  455.     ora    l        ; 
  456.     jnz    ndig1        ; More digits left
  457.     mov    a,b        ; 
  458.     xchg            ; 
  459.     pop    d        ; 
  460.     pop    b        ; 
  461.     rtn            ; 
  462. ;
  463. ;--------------------------------
  464. ;
  465.     end            ; of FLTOUT.ASM
  466.