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 / FLTINPUT.ASM < prev    next >
Assembly Source File  |  2009-12-11  |  7KB  |  339 lines
  1. ; FLTINPUT.ASM
  2. ; ------------
  3. ;
  4. ; See FALCONER.WS4 for doc.
  5. ;
  6. ; (Retyped by Emmanuel ROCHE.)
  7. ;
  8. ;--------------------------------
  9. ; External routines required
  10. ;
  11.     extrn    fdivt,flotd,fmult    ; in FLTARITH.ASM
  12.     extrn    mul10            ; in INTARITH.ASM
  13. ;
  14. ;--------------------------------
  15. ; Entry points allowed
  16. ; --------------------
  17. ;
  18. ; Utility routines
  19. ;
  20.     entry    deblk,jbc,qmax,qnum
  21. ;
  22. ; Numeric input
  23. ;
  24.     entry    ival,ivalc
  25. ;
  26. ;--------------------------------
  27. ; Macro definitions
  28. ;--------------------------------
  29. ;
  30. ; Execute routine at (BC) [normally get next character]
  31. ;
  32. getch    macro
  33.     call    jbc
  34.     endm
  35. ;
  36. ; Change sign of real operand B or D
  37. ;
  38. fsign    macro    reg
  39.     if    reg*(reg-d)
  40.     error    "R"
  41.     endif
  42.     mov    a,reg
  43.     xri    80H
  44.     mov    reg,a
  45.     endm
  46. ;
  47. ; Reload (BC.L), stored by PUSH B, PUSH H sequence
  48. ;
  49. reload    macro    reg
  50. bc.l    equ    b
  51.     if    reg-b
  52.     error    "R"
  53.     db    0,0,0
  54.     endif
  55.     if    reg-b=0        ; Was IFZ
  56.     pop    b
  57.     mov    l,c
  58.     pop    b
  59.     endif
  60.     endm
  61. ;
  62. ; "Return" and check stacl level zero
  63. ;
  64. rtn    macro
  65.     if    .lvl
  66.     error    '0'+.lvl
  67. .lvl    set    0
  68.     endif
  69.     ret
  70.     endm
  71. ;
  72. ; Save (BC.L), to be restored by RELOAD BC.L later
  73. ;
  74. save    macro    reg
  75.     bc.l    equ    b
  76.     if    reg-b
  77.     error    'R'
  78.     db    0,0
  79.     endif
  80.     if    reg-b=0        ; Was IFZ
  81.     push    b
  82.     push    h
  83.     endif
  84.     endm
  85. ;
  86. ;--------------------------------
  87. ; Start the code
  88. ;--------------------------------
  89. ;
  90. ; Check (A) to be in range 0-9 (ASCII)
  91. ; Return Carry for non-numeric character
  92. ; F
  93. ;
  94. qnum:    cpi    '9'+1        ; This first to speed exit
  95.     cmc            ;   for alpha.
  96.     rc            ; < 0, non-numeric
  97.     cpi    '0'        ; 
  98.     rtn            ; 
  99. ;
  100. ; Check (HL) for value < 6554
  101. ; Set Carry if greater
  102. ; F
  103. ;
  104. qmax:    push    b        ; 
  105.     mov    b,a        ; 
  106.     mov    a,l        ; 
  107.     sui    6554 MOD 256    ; 
  108.     mov    a,h        ; 
  109.     sbi    6554/256    ; 
  110.     cmc            ; 
  111.     mov    a,b        ; 
  112.     pop    b        ; 
  113.     rtn            ; 
  114. ;
  115. ; Transfer control to (BC)
  116. ;
  117. jbc:    push    b        ; Set address on stack
  118. .lvl    set    .lvl-1        ; Compensate for stacked addr
  119.     rtn            ; Go excute
  120. ;
  121. ; Input a character, ignoring blanks
  122. ; A,F
  123. ;
  124. deblk:    getch            ; 
  125.     cpi    ' '        ; 
  126.     rnz            ; 
  127.     jmp    deblk        ; Bypass a blank
  128. ;
  129. ; Input a floating point value from a char string
  130. ; At entry:
  131. ;  (BC) => character input routine
  132. ; At exit:
  133. ;  (A)=(L) = character following numerical string
  134. ;  (DE.H)  = value
  135. ; If error, (A) = error code, (L) = exit char, Carry set
  136. ; Carry for overflow or illegal first char
  137. ; A,F,D,E,H,L
  138. ;
  139. ival:    call    deblk        ; Bypass leading blanks
  140. ;
  141. ; Alternate entry with first char in (A)
  142. ;
  143. ivalc:    cpi    ' '        ; 
  144.     jz    ival        ; Ignore leading spaces
  145.     cpi    '+'        ; 
  146.     jz    ival        ; Ignore unary +
  147.     call    qnum        ; 
  148.     lxi    h,0        ; Clear acc
  149.     mvi    d,40H        ;   and exponent.
  150.     jnc    ival6        ; Initial numeric entry
  151.     cpi    '.'        ; 
  152.     jz    ival1        ; Initial decimal point
  153.     cpi    '-'        ; 
  154.     stc            ; 
  155.     mov    l,a        ;   (A) is illegal char.
  156.     rnz            ; Error, return 0 and Carry,
  157.     call    ival        ; Recursive unary -
  158.     push    psw        ; Save exit char
  159.     fsign    d        ; 
  160.     pop    psw        ; 
  161.     rtn            ; 
  162. ival1:    getch            ; After initial decimal point
  163.     call    qnum        ; 
  164.     jnc    ival4        ; Got the required digit
  165.     mov    l,a        ; Exit char to (L)
  166.     stc            ; 
  167.     rtn            ; Illegal initial char
  168. ival2:    inr    d        ; Incorporate digit
  169.     getch            ; Get next digit
  170.     call    qnum        ; 
  171.     jnc    ival2        ; Still digit string
  172.     cpi    '.'        ; Will be ignored
  173.     jnz    ival8        ; Check for exponent
  174. ival3:    getch            ; Digits after decimal point
  175.     call    qnum        ; 
  176.     jc    ival8        ; Non-digit
  177.     call    qmax        ; 
  178.     jc    ival3        ; No room, ignore
  179.     call    mul10        ; 
  180. ival4:    ani    0FH        ; Mask off digit
  181.     dcr    d        ; Modify exponent digits after
  182.     add    l        ;   decimal point.
  183.     mov    l,a        ; 
  184.     mov    a,h        ; 
  185.     aci    00H        ; 
  186.     mov    h,a        ; 
  187.     jnc    ival3        ; No overflow
  188.     lxi    h,6554        ; Set max
  189.     inr    d        ; 
  190.     jmp    ival3        ; 
  191. ival5:    call    qmax        ; Digits to left of decimal point
  192.     jc    ival2        ; No more digit room
  193.     call    mul10        ; 
  194. ival6:    ani    0FH        ; Mask off digit
  195.     add    l        ; 
  196.     mov    l,a        ; 
  197.     mov    a,h        ; 
  198.     aci    00H        ; 
  199.     mov    h,a        ; Incorporate digit
  200.     jnc    ival7        ; No overflow
  201.     lxi    h,65535        ; Max
  202. ival7:    getch            ; Get next digit/char
  203.     call    qnum        ; 
  204.     jnc    ival5        ; Digit
  205.     cpi    '.'        ; 
  206.     jz    ival3        ; Decimal point
  207. ival8:    cpi    'E'        ; 
  208.     jz    ival9        ; 
  209.     cpi    'e'        ; Lower case allowed
  210. ival9:    xchg            ; 
  211.     stc            ; 
  212.     cmc            ; Clear any Carry
  213.     cz    rexp        ; "E", read exponent
  214.     mov    l,a        ; Exit char
  215.     cnc    unfix        ; Convert format if no overflow yet
  216.     rnc            ; No overflow
  217.     mvi    a,80H        ; Overflow code
  218.     rtn            ; 
  219. ;
  220. ; "Fixed" point representation consists of a 16 bit positive
  221. ; integer (in the range 0 to 65535), and a 7 bit offset (by
  222. ; 40H) integer exponent, which represents a power of ten
  223. ; multiplier. The eighth exponent bit represents the sign
  224. ; of the mantissa. This representation is used for input/
  225. ; output only.
  226. ;
  227. ; Convert "fixed" format to "real"
  228. ; Carry for input out of range
  229. ; F,D,E,H
  230. ;
  231. unfix:    save    bc.l        ; 
  232.     push    psw        ; 
  233.     mov    a,h        ; 
  234.     ani    80H        ; 
  235.     mov    b,a        ; Sign of result
  236.     mov    a,h        ; 
  237.     ani    7FH        ; 
  238.     sui    40H        ; 
  239.     mov    c,a        ; Decimal point
  240.     call    flotd        ; 
  241.     mov    a,h        ; 
  242.     ora    a        ; 
  243.     jz    unfix4        ; Zero value
  244.     mov    a,d        ; 
  245.     ora    b        ; 
  246.     mov    d,a        ; Incorporate sign
  247.     mov    a,c        ; 
  248.     ora    a        ; 
  249. @01    set    .lvl        ; 
  250. unfix1:    jz    unfix4        ; Reduced to real
  251.     jm    unfix3        ; Negative exponent
  252.     call    fmult        ; Positive exponent
  253.     dcr    c        ; 
  254.     jnc    unfix1        ; In range
  255. unfix2:    pop    psw        ; 
  256.     stc            ; 
  257.     jmp    unfix5        ; 
  258. .lvl    set    @01        ; 
  259. unfix3:    call    fdivt        ; Negative exponent
  260.     inr    c        ; 
  261.     jnc    unfix1        ; Continue
  262.     jmp    unfix2        ; Underflow
  263. unfix4:    pop    psw        ; 
  264.     ora    a        ; Reset Carry, no overflow
  265. unfix5:    reload    bc.l        ; 
  266.     rtn            ; 
  267. ;
  268. ; Read 2 digit signed decimal exponent
  269. ;   to (A). Return exit character in (D).
  270. ; A,F,D,E
  271. ;
  272. r2dc:    getch            ; Get char
  273.     call    qnum        ; 
  274.     jc    r2dc3        ; Not digit
  275. r2dc1:    lxi    d,0        ; 
  276. r2dc2:    dcr    d        ; 
  277.     inr    d        ; 
  278.     stc            ; 
  279.     rnz            ; Overflow, 3 digits entered,
  280.     mov    d,e        ;   first non-zero.
  281.     ani    0FH        ; 
  282.     mov    e,a        ; 
  283.     getch            ; 
  284.     call    qnum        ; 
  285.     jnc    r2dc2        ; 
  286.     push    psw        ; 
  287.     mov    a,d        ; 
  288.     add    a        ; 
  289.     add    a        ; 4*
  290.     add    d        ; 
  291.     add    a        ; 10*
  292.     add    e        ; Value MOD 100
  293.     pop    d        ; 
  294.     rtn            ; 
  295. r2dc3:    cpi    '+'        ; 
  296.     jz    r2dc        ; Ignore unary +
  297.     cpi    '-'        ; 
  298.     jnz    r2dc4        ; Not unary -
  299.     call    r2dc        ; 
  300.     cma            ; 
  301.     inr    a        ; 
  302.     rtn            ; 
  303. r2dc4:    mov    d,a        ; 
  304.     mvi    a,0        ; Return 0, none came
  305.     rtn            ; 
  306. ;
  307. ; Read exponent and combine with "fixed" value
  308. ; Return exit char in (A)
  309. ; A,F,D
  310. ;
  311. rexp:    push    d        ; 
  312.     call    r2dc        ; Get exponent
  313.     jc    rexp1        ; Overflow
  314.     push    d        ; Save exit char
  315.     mov    d,a        ; Exponent
  316.     mov    a,h        ; 
  317.     ani    80H        ; 
  318.     mov    e,a        ; Sign
  319.     mov    a,h        ; 
  320.     ani    7FH        ; Exponent alone
  321.     add    d        ; 
  322.     jp    rexp2        ; No overflow
  323. @01    set    .lvl        ; 
  324.     pop    psw        ; Exit char
  325. rexp1:    pop    d        ; 
  326.     stc            ; Signal overflow
  327.     rtn            ; 
  328. .lvl    set    @01        ; 
  329. rexp2:    ora    e        ; Original sign
  330.     mov    h,a        ; Resultant exponent
  331.     pop    psw        ; Restore exit char
  332.     pop    d        ; Restore mantissa
  333.     ora    a        ; Clear Carry, no overflow
  334.     rtn            ; 
  335. ;
  336. ;--------------------------------
  337. ;
  338.     end            ; of FLTINPUT.ASM
  339.