home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / sharew / exoten / rec / flt87.asm < prev    next >
Encoding:
Assembly Source File  |  1986-08-15  |  24.9 KB  |  952 lines

  1. ;    ==============================================================
  2. ;
  3. ;    REC module for some of the operators and predicates concerning
  4. ;    numeric operands.  These comprise:
  5. ;
  6. ;    conversion, including compilation of numbers:
  7. ;
  8. ;        [-]{d}.{d} | [-]d{d} | -{d}.{d}<E|D>[-|+]{d} |
  9. ;        [-]d{d}<E|D>[-|+]{d} :  numeric constant
  10. ;        O :    decimal ascii string to number
  11. ;        # :    number to decimal ascii string
  12. ;
  13. ;    arithmetic:
  14. ;
  15. ;        ~ :    complement or negative
  16. ;
  17. ;    --------------------------------------------------------------
  18. ;
  19. ;            FLT87 - Copyright (c) 1986
  20. ;            Gerardo Cisneros & Harold V. McIntosh
  21. ;            Derechos Reservados
  22. ;
  23. ;            [Gerardo Cisneros, 11 April 1984]
  24. ;
  25. ;    7 Feb 1986 - 8087 support added - GCS
  26. ;    ==============================================================
  27.  
  28. ;    Compile a decimal number, which requires reading any
  29. ;    further digits that follow including decimal point and
  30. ;    exponent, and saving the terminator.
  31.  
  32. RECDD:    mov    FRST,al        ;save first character
  33.     push    dx        ;save compilation address
  34.     push    cx        ;save execution address
  35.     call    word ptr read    ;fetch next character
  36.     call    recds        ;build string
  37.     pop    cx        ;recover execution address
  38. DD1:    pop    dx        ;recover compilation pointer
  39.     push    ax        ;save terminating character
  40.     call    recop        ;compile subroutine call
  41.     mov    al,NSIZ        ;get final constant size
  42.     mov    di,dx
  43.     mov    cs:[di],al    ;save in calling sequence
  44.     inc    di
  45.     mov    si,(offset ARG1)
  46.     mov    cl,al
  47.     mov    ch,0
  48.     mov    bp,cs
  49.     call    xf2
  50.     mov    dx,di        ;updated exec ptr back to DX
  51.     pop    ax        ;recover terminating character
  52.     jmp    skp86        ;skip over character read call
  53.  
  54. ;    (O) Transform an ASCII character string on the PDL into a
  55. ;    two or four byte integer or a single or double precision
  56. ;    floating point number.  Predicate - false if the argument
  57. ;    is not a digit string or null, leaving the argument unchanged.
  58.  
  59. UCO:    mov    byte ptr NSIZ,2    ;assume two-byte digit will be produced
  60.     mov    read,(offset pty)    ;make buffer out of arg
  61.     mov    bx,PX    ;start of the string
  62.     mov    RX,bx
  63.     mov    bx,PY    ;end of the string, plus 1
  64.     mov    (byte ptr[bx]),00    ;add a NUL at the end
  65.     inc    bx
  66.     mov    RY,bx
  67.     mov    RSEG,ds
  68.     call    word ptr read
  69.     or    al,al
  70.     jnz    nnul    ;skip if string not null
  71.     mov    word ptr ARG1,0000    ;null string, make 0
  72.     jmp    short o1
  73.  
  74. nnul:    mov    FRST,al    ;save first character
  75.     call    word ptr read    ;get next character
  76.     call    recds    ;and gather rest of number
  77.     test    al,al    ;returned character must be NUL
  78.     jz    o1
  79.     ret        ;return FALSE if not
  80. o1:    mov    cl,NSIZ    ;else we have a number of size (nsiz)
  81.     mov    ch,00    ;set up (BC) to allocate space on PDL
  82.     call    OARG    ;get it
  83.     mov    PY,bx
  84.     sub    bx,cx    ;recompute PX
  85.     mov    di,bx
  86.     mov    si,(offset ARG1)
  87.     call    xf1    ;move to PDL from arg1 onward
  88.     jmp    SKP    ;take TRUE exit
  89.  
  90. ;    The heart of number parsing and conversion
  91.  
  92. recds:    push    ax    ;save second character
  93.     mov    byte ptr NSIZ,2    ;assume 2 byte integer
  94.     call    dsinit    ;initialize number gathering areas and flags
  95.     mov    al,FRST    ;start parsing
  96.     cmp    al,'-'
  97.     jz    ds1
  98.     cmp    al,'0'    ;leading 0 may mean 4 byte integer
  99.     jz    ds4
  100.     cmp    al,'.'    ;floating point implied by period
  101.     jz    ds5
  102.     pop    bx    ;get second char, foreseeing ret in rnd
  103.     call    RND    ;return if not a digit at this point
  104.     mov    byte ptr ARG1,al    ;put in the digit-gathering buffer
  105.     mov    al,bl    ;get second character
  106.     jmp    short ds6    ;go ahead with rest
  107.  
  108. ds1:    pop    ax    ;negative number, examine next char.
  109.     cmp    al,'.'
  110.     jnz    ds3
  111. ds2:    mov    DCPT,al    ;period after minus or zero; record fact,
  112.     call    word ptr read    ;get next character
  113.     jmp    short ds5a    ;and go indicate floating point size
  114.  
  115. ds3:    call    RND    ;return if not period and not digit after sign
  116.     jnz    ds3b    ;if not zero, restore to ascii
  117. ds3a:    mov    byte ptr NSIZ,4    ;set to gather a 4-byte integer
  118. ds3b:    add    al,'0'    ;restore to ascii before continuing to gather
  119.     jmp    short ds6
  120.  
  121. ds4:    pop    ax    ;character following 0 may be:
  122.     cmp    al,'E'    ;    E, single precision exponent
  123.     jz    ds6
  124.     cmp    al,'D'    ;    D, double precision exponent
  125.     jz    ds6
  126.     cmp    al,'.'    ;    ., decimal point
  127.     jz    ds2
  128.     call    RND    ;    or digit; in the latter case
  129.     jmp    ds3a    ;we set up for a 4-byte integer
  130.  
  131. ds5:    mov    DCPT,al    ;period as first character, record found
  132.     pop    ax    ;fetch 2nd char before going on
  133. ds5a:    mov    byte ptr NSIZ,5    ;record size of single precision operand
  134.  
  135. ds6:    call    dsgath    ;go gather rest
  136.     push    ax    ;save terminating character
  137.     call    dsend    ;do final number-building
  138.     pop    ax    ;put terminating character back in A
  139.     ret        ;done
  140.  
  141. ;    digit-gathering loop
  142.  
  143. dsg1:    call    word ptr read
  144. dsgath: cmp    al,'.'    ;check decimal point first
  145.     jnz    dsg2
  146.     mov    ah,DCPT
  147.     test    ah,ah
  148.     jz    dsg1a
  149.     ret        ;period found twice, return
  150. dsg1a:    mov    DCPT,al        ;first one, record fact
  151.     mov    byte ptr NSIZ,5    ;set single precision size
  152.     jmp    short dsg1
  153.  
  154. dsg2:    cmp    al,'E'    ;check S.P. exponent
  155.     jnz    dsg3
  156.     mov    ah,5
  157. dsg2a:    mov    NSIZ,ah    ;S.P. size
  158.     jmp    short dsxpt    ;go gather exponent
  159.  
  160. dsg3:    cmp    al,'D'    ;check D.P. exponent
  161.     mov    ah,8
  162.     jz    dsg2a
  163.  
  164.     call    RND    ;finally, check for digit
  165.     mov    cx,ax    ;save digit in b
  166.     mov    al,ARG1H    ;high order byte of significand
  167.     and    al,0F0H    ;check highest nibble
  168.     jz    dsg3a    ;skip if high nibble = 0
  169.  
  170.     xor    al,al    ;else drop, but check if digit dropped
  171.     or    al,DCPT    ;belongs to integer or fractional part:
  172.     jnz    dsg1    ;continue gathering if fractional part
  173.  
  174.     inc    DDCT    ;else add 1 to partial exponent due to dropping
  175.     jmp    short dsg1    ;of integer part digit and continue gathering
  176.  
  177. dsg3a:    xor    al,al
  178.     or    al,DCPT    ;if decimal point not recorded
  179.     jz    dsg4    ;proceed to tack on this digit,
  180.     dec    DDCT    ;else decr.partl expt due to incl of fract dig
  181.  
  182. dsg4:    push    cx    ;save digit
  183.     call    txp    ;multiply current mantissa by 10
  184.     mov    di,(offset ARG2)    ;set up alternate buffer
  185.     call    zarg    ;to receive the next digit
  186.     pop    ax    ;retrieve digit into ax
  187.     mov    byte ptr ARG2,al
  188.     call    add8    ;add it to previous mantissa
  189.     jmp    short dsg1    ;and continue gathering
  190.  
  191. ;    Exponent-gathering
  192.  
  193. dsxpt:    call    word ptr read    ;get next character
  194.     mov    DXSG,al    ;save as indicator of decimal exponent sign
  195.     mov    bx,0    ;exponent will be put together in HL
  196.     cmp    al,'-'    ;negative?
  197.     jz    dsx2    ;yes, go to next char
  198.     cmp    al,'+'    ;explicit positive sign?
  199.     jnz    dsx3    ;no, go check if digit
  200.  
  201. dsx2:    call    word ptr read    ;fetch next character
  202. dsx3:    mov    DCXPT,bx    ;save partially gathered exponent
  203.     call    RND    ;terminate if not a digit
  204.     mov    cx,bx    ;copy HL into BC
  205.     sal    bx,1    ;multiply HL by 4
  206.     sal    bx,1
  207.     add    bx,cx    ;make it 5
  208.     sal    bx,1    ;twice again, to make it times 10
  209.     add    bx,ax    ;add current digit
  210.     test    bh,0FCH    ;check for exponent overflow
  211.     jz    dsx2
  212.     mov    bx,03FFH    ;set large decimal exponent
  213.     jmp    dsx2
  214.  
  215. ;    Final number buildup
  216.  
  217. dsend:    cmp    byte ptr NSIZ,5
  218.     jc    dsn0
  219.     call    dnd0    ;put together F.P. numbers
  220. dsn0:    cmp    byte ptr FRST,'-'    ;take care of initial sign
  221.     jz    dsn1
  222.     ret
  223. dsn1:    mov    al,NSIZ
  224.     mov    bx,(offset ARG1)
  225.  
  226. ;    Subroutine for negation of numeric arguments
  227.  
  228. negn:    cmp    al,5
  229.     mov    cl,al
  230.     mov    ch,0
  231.     jnc    negr    ;negate F.P. numbers
  232. ngn1:    clc        ;clear carry
  233.     shr    cx,1    ;divide count by 2 to do it by words
  234. ngn0:    mov    ax,0000    ;negate multi-byte integer
  235.     sbb    ax,[bx]
  236.     mov    [bx],ax
  237.     inc    bx
  238.     inc    bx
  239.     loop    ngn0
  240.     ret
  241.  
  242. negr:    dec    cx    ;find exponent byte
  243.     add    bx,cx    ;got it
  244. negr1:    mov    al,[bx]
  245.     mov    cl,al    ;save it
  246.     dec    bx
  247.     or    al,[bx]
  248.     jz    negr2    ;return if operand is zero
  249.     xor    cl,80H    ;complement sign bit
  250.     inc    bx    ;point back to high byte
  251.     mov    [bx],cl    ;restore exponent with changed mantissa sign
  252. negr2:    ret        ;done
  253.  
  254. ;    check if argument has size 0, 1, 2, 4, 5 or 8.
  255. ;    zero flag is returned if size is 5 or 8
  256.  
  257. numchk: mov    bx,PX
  258.     mov    cx,PY
  259.     mov    dx,cx    ;a copy of PY into DX
  260.     sub    cx,bx
  261.     test    ch,ch
  262.     jnz    nch1    ;no large arguments
  263.     cmp    cl,8
  264.     jz    nch0
  265.     jnc    nch1    ;no args of size gt 8
  266.     cmp    cl,5
  267.     jz    nch0
  268.     jnc    nch1    ;no size 6 or 7 args
  269.     cmp    cl,3
  270.     jz    nch1    ;no size 3 args
  271. nch0:    ret
  272. nch1:    jmp    RER
  273.  
  274. ;    (~)  Complement or negate the top of the PDL
  275.  
  276. comp:    call    numchk
  277.     jz    negr    ;negate F.P. argument
  278.     test    cl,cl
  279.     jz    cmp0    ;leave null string as is
  280.     cmp    cl,2
  281.     jnc    ngn1    ;negate 2 or 4-byte integer
  282.     not    byte ptr[bx]    ;1-byte argument, do a log. complement
  283. cmp0:    ret
  284.  
  285. ;    Final assembly of floating point operands
  286.  
  287. dnd0:    cmp    byte ptr DXSG,'-'    ;set proper decimal exponent sign
  288.     jnz    dnd1    ;skip if not negative
  289.     neg    DCXPT
  290.  
  291. dnd1:    mov    al,DDCT    ;fetch partial exponent due to digit-gathering
  292.     cbw        ;extend its sign into ah
  293.     add    ax,DCXPT    ;compute final decimal exponent in HL
  294.     mov    DCXPT,ax    ;and save it
  295.     call    zach    ;check if arg1=0
  296.     jnz    dnd1a
  297.     ret        ;done if mantissa is zero
  298. dnd1a:    mov    dx,043EH    ;else compute biased binary exponent
  299.  
  300. dnd3:    push    dx    ;save binexpt
  301.     jmp    short dnd3b
  302. dnd3a:    call    div10b    ;mantissa will be divided by 10 if DCXPT<0
  303. dnd3b:    call    norg1    ;normalize arg1 (shift until high bit = 1)
  304.     jz    dnd3c
  305.     pop    bx
  306.     add    dx,bx    ;reduce binexpt by amount shifted
  307.     jnc    ufl
  308.     push    dx
  309. dnd3c:    mov    bx,DCXPT    ;check DCXPT sign
  310.     test    bx,bx
  311.     js    dnd3a    ;go divide by 10 if dec. expt. negative
  312.     jz    dspack    ;zero, do final packing
  313.     call    m58thb    ;mult by 10/16 if positive
  314.     jnc    dnd3    ;beware of bin. expt. overflow
  315.     jmp    short ovf
  316.  
  317. ;    Pack up exponent and mantissa
  318.  
  319. dspack: pop    word ptr BINXPT    ;retrieve binary exponent
  320.     mov    di,(offset ARG2)    ;first do rounding of the mantissa
  321.     call    zarg
  322.     mov    bx,(offset ARG2B)
  323.     cmp    byte ptr NSIZ,8    ;set rounding bit according to size
  324.     jnz    dsp0
  325.     shr    al,1    ;make it a 4 to be the
  326.     dec    bx    ; next to high bit of next to low nibble
  327.     jmp    short dsp0a
  328. dsp0:    mov    al,80H    ;high bit
  329.     inc    bx    ; of 5th mantissa byte for SP
  330.     inc    bx    ;of 4th byte when 8087 is used
  331. dsp0a:    mov    (byte ptr[bx]),al    ;store
  332.     call    add8    ;round
  333.     jnc    dsp1    ;skip if rounding produced no carry
  334.     mov    byte ptr ARG1H,080H    ;else set MSbit of mantissa
  335.     inc    word ptr BINXPT    ;and adjust bin. expt.
  336.     jz    ovf    ;skip to overflow if it became 0
  337.  
  338. dsp1:    cmp    byte ptr NSIZ,5    ;which size
  339.     jnz    dsp2        ;skip if D.P.
  340.     mov    ax,0FC80H    ;constant to adjust S.P. bias
  341.     add    ax,word ptr BINXPT
  342.     jz    ufl    ;0 means underflow
  343.     jnc    ufl
  344.     test    ah,ah    ;(HL) must end up between 1 and 0FEH
  345.     jnz    ovf
  346.     mov    ah,al
  347.     inc    al
  348.     jz    ovf    ;0FFH also invalid
  349.     mov    al,byte ptr ARG1H    ;MSByte to al
  350.     rol    al,1    ;get rid of MSbit
  351.     shr    ax,1    ;binexpt LSbit into its place, 0 to sign
  352.     mov    word ptr ARG1H,ax
  353.     mov    di,(offset ARG1)    ;shift S.P. number down 4 bytes
  354.     mov    si,(offset ARG1M)
  355.     mov    byte ptr [si],0    ;clear 5th byte (lowest) when using 8087
  356.     mov    cx,5
  357.     jmp    xf1    ;shift the upper 5 bytes
  358.  
  359. ;    Handle underflow in binary exponent
  360.  
  361. ufl:    call    zarg1    ;make it all zero
  362.     mov    FRST,al    ;including the sign
  363.     ret
  364.  
  365. ;    Handle overflow in binary exponent
  366.  
  367. ovf:    call    zarg1        ;set up infinite operand
  368.     mov    cx,7F80H    ;first two bytes of SP infinite
  369.     cmp    byte ptr NSIZ,5        ;set rightmost bits of exponent
  370.     jnz    ov1        ;according to size of operand
  371.     mov    word ptr(ARG1M-1),cx
  372.     ret
  373.  
  374. ov1:    or    cl,70H        ;D.P. handled here
  375.     mov    word ptr ARG1B,cx    ;set next byte
  376.     ret
  377.  
  378. dsp2:    mov    dx,word ptr BINXPT
  379.     cmp    dx,07FFH
  380.     jnb    ovf    ;07FFH or bigger is an overflow
  381.     call    halve    ;shift mantissa down 3 bits
  382.     call    halve
  383.     call    halve
  384.     mov    cl,4
  385.     sal    dx,cl    ;and shift exponent up 4 bits
  386.     mov    al,0FH
  387.     and    al,ARG1H    ;mask implicit bit off
  388.     or    dl,al        ;insert lower 4 bits of exponent
  389.     mov    word ptr ARG1H,dx    ;store it
  390.     mov    di,(offset ARG1)    ;shift one byte down
  391.     mov    si,di
  392.     inc    si
  393.     mov    cx,8
  394.     jmp    xf1    ;done when finished shifting
  395.  
  396. ;    (#)  Change binary number into a decimal-based ASCII
  397. ;    string as follows:
  398. ;        size of     max. size    form
  399. ;        number      of string
  400. ;         0         1        0
  401. ;         1         3        d{d}
  402. ;         2         5        d{d}
  403. ;         4        12        [-]0d{d}
  404. ;         5        15        [-]d{d}.{d}[E[s]d{d}]
  405. ;         8        21        [-]d{d}.{d}D[s]d{d}
  406.  
  407. ns:    call    numchk    ;check for numerical argument
  408.     mov    NSIZ,cl    ;record size in memory
  409.     mov    al,cl    ;and in AL
  410.     shl    cl,1    ;compute size of maximum string
  411.     inc    cl
  412.     cmp    cl,11    ;is it FP?
  413.     jc    nsaa
  414.     and    cl,0FDH    ;drop 2 if S.P. when using 8087
  415.     inc    cl    ;yes, make it 1 longer
  416. nsaa:    cmp    cl,9    ;is it 4 bytes or longer?
  417.     jc    nsbb
  418.     add    cl,3    ;yes, make it 3 longer
  419. nsbb:    call    OARG    ;and find out whether there is enough space for it
  420.     mov    si,PY    ;load source index before modifying py
  421.     sub    bx,cx    ;recompute PX
  422.     mov    PY,bx    ;close interval before string production
  423.     cmp    al,4
  424.     jnc    nslrg    ;jump on long operands
  425.     mov    cl,al
  426.     mov    ax,0000    ;put zero in DE for default
  427.     jcxz    ns1    ;load nothing
  428.     mov    al,[bx]    ;load low byte
  429.     dec    cx    ;test for one byte
  430.     jcxz    ns1    ;only byte and it's loaded
  431.     mov    ah,1[bx]    ;load high byte
  432.  
  433. ;    The following code is also used to convert exponents of
  434. ;    floating point operands and long integers whose high
  435. ;    word is null.
  436.  
  437. ns1:    mov    bp,bx        ;save pointer for ASCII string
  438.     mov    cl,'0'        ;prepare to write a zero
  439.     mov    bx,-10000    ;will there be 5 digits?
  440.     add    bx,ax        ;
  441.     jb    ns2
  442.     mov    bx,-1000        ;will there be 4 digits?
  443.     add    bx,ax        ;
  444.     jb    ns3
  445.     mov    bx,-100        ;will there be 3 digits?
  446.     add    bx,ax        ;
  447.     jb    ns4
  448.     mov    bx,-10        ;will there be 2 digits?
  449.     add    bx,ax        ;
  450.     jb    ns5
  451.     jmp    ns6        ;write one no matter what
  452. ns2:    mov    bx,10000    ;ten thousands digit
  453.     call    nsa        ;
  454. ns3:    mov    bx,1000        ;thousands digit
  455.     call    nsa        ;
  456. ns4:    mov    bx,100        ;hundreds digit
  457.     call    nsa        ;
  458. ns5:    mov    bx,10        ;tens digit
  459.     call    nsa        ;
  460. ns6:    add    cl,al        ;units digit
  461.     mov    ds:[bp],cl    ;store the digit
  462.     inc    bp        ;position pointer for next byte
  463.     mov    PY,bp        ;done, store it as terminator
  464.     ret
  465.  
  466. nsa:    mov    dx,0000        ;clear extension for div
  467.     div    bx        ;div bx into axdx
  468.     add    cl,al        ;form ASCII digit
  469.     mov    ax,dx        ;put remainder in ax
  470.     mov    ds:[bp],cl    ;store new digit
  471.     inc    bp        ;advance pointer
  472.     mov    cl,'0'        ;load a fresh ASCII zero
  473.     ret
  474.  
  475. ;    Long number conversion to ASCII starts here.
  476. ;    HL contains (px) on entry.
  477.  
  478. nslrg:    call    dsinit        ;clear all number buffers
  479.     mov    cl,NSIZ
  480.     mov    di,(offset arghh)    ;get destination address +1
  481.     call    mduc        ;move by decrement until count
  482.     cld            ;note: es=ds by call to mduc
  483.     mov    di,PY        ;get ptr to next available byte for string
  484.     cmp    byte ptr NSIZ,4        ;do we have an integer?
  485.     jnz    nsflt        ;no, jump to F.P. processor
  486.     mov    al,ARG1H    ;yes, check its sign
  487.     test    al,al
  488.     jns    nsl2
  489.     mov    bx,(offset ARG1M)    ;negate the 4-byte operand
  490.     mov    cx,4
  491.     call    ngn1
  492.     mov    al,'-'
  493.     stosb            ;record the negative sign
  494. nsl2:    mov    al,'0'
  495.     stosb            ;long integers have a leading 0
  496.     mov    PY,di        ;save
  497.     mov    bx,word ptr ARG1B    ;get high word of operand
  498.     test    bx,bx
  499.     jnz    nsl3        ;greater than 2**16 - 1?
  500.     mov    ax,word ptr ARG1M    ;no, get it into HL
  501.     mov    bx,di        ;put PDL pointer in bx
  502.     jmp    ns1        ;and treat it as a 2 byte operand
  503.  
  504. nsl3:    mov    dx,20H        ;make it look like a floating point number
  505.     call    nsdnor        ;normalize decimal
  506.     mov    al,byte ptr DCXPT    ;get dec. exponent (=# of dec. digits)
  507.     call    mkstr        ;go make the string
  508.     mov    bx,PY        ;pointer to start of string
  509.     add    bx,word ptr BINXPT    ;length of produced string
  510.     mov    PY,bx        ;make address of next free PDL byte
  511.     ret            ;done
  512.  
  513. ;    Real number strings produced here
  514.  
  515. nsflt:    mov    al,ARG1H    ;examine sign of operand
  516.     or    al,al
  517.     jns    nsf1
  518.     mov    al,'-'
  519.     stosb            ;insert sign right away
  520. nsf1:    mov    PY,di        ;save pointer to the string
  521.     call    unpak        ;unpack the operand
  522.     call    nsdnor        ;normalize decimal
  523.     mov    al,NSIZ        ;compute how many digits to produce
  524.     and    al,0CH    ;use 4 or 8 when using 8087
  525.     sal    al,1
  526.     dec    al
  527.     call    mkstr        ;produce them
  528.     mov    ax,DCXPT    ;the decimal exponent
  529.     test    ah,ah
  530.     jnz    insxp        ;force exponent insertion if >255 or <0
  531.     cmp    al,7        ;and also
  532.     jnc    insxp        ;if >6
  533.     mov    bx,py
  534.     add    bx,ax        ;determine where to insert dec. point
  535.     call    shstr        ;insert point, shift string, drop trailing 0s
  536.     inc    bx        ;update pointer
  537.     mov    PY,bx
  538.     cmp    al,'.'        ;see if the last character was the period
  539.     jnz    nsfdp        ;if not, go insert D0 if DP number
  540.     mov    ax,bx        ;else make sure we have at least one digit
  541.     mov    dx,PX
  542.     sub    ax,dx
  543.     cmp    al,3
  544.     jnc    nsfdp        ;we do, insert DP expt if necessary
  545.     mov    bx,dx        ;make bx point at start of string
  546.     mov    al,(byte ptr[bx])    ;we don't, fix it
  547.     cmp    al,'.'        ;is the first character a period?
  548.     jnz    nsf4
  549.     mov    (byte ptr[bx]),'0'    ;yes, insert 0 in its place
  550.     inc    bx        ;and put the period after it
  551.     mov    (byte ptr[bx]),al
  552.     dec    bx
  553. nsf4:    cmp    al,'-'        ;was it a -?
  554.     jnz    nsf5
  555.     mov    (byte ptr[bx]),'0'    ;yes, but next is sure to be a period
  556. nsf5:    inc    bx
  557.     inc    bx    ;keep PDL pointer updated
  558.     mov    PY,bx
  559.  
  560. nsfdp:    cmp    byte ptr NSIZ,5        ;was this a DP operand?
  561.     jnz    nsf6
  562.     ret            ;no, we're done
  563. nsf6:    mov    (word ptr[bx]),'0D'    ;yes, insert D0
  564.     inc    bx
  565.     inc    bx
  566.     mov    PY,bx    ;update pointer
  567.     ret        ;and quit
  568.  
  569. ;    FP exponent insertion
  570.  
  571. insxp:    dec    ax        ;decrement dec. expt., we will insert
  572.     mov    DCXPT,ax    ;dec. point after first digit
  573.     mov    bx,PY        ;get start of string
  574.     inc    bx        ;point it to start of move
  575.     mov    al,1        ;bytes NOT to move
  576.     call    shstr        ;insert period, shift, drop trailing zeros
  577.     inc    bx        ;advance pointer
  578.     mov    ch,'E'        ;prepare to insert exponent
  579.     cmp    byte ptr NSIZ,5        ;but first ch kind to insert
  580.     jz    insx1
  581.     mov    ch,'D'        ;DP exponent
  582. insx1:    mov    (byte ptr[bx]),ch    ;insert the letter
  583.     inc    bx        ;advance the pointer
  584.     mov    ax,DCXPT    ;get the decimal exponent
  585.     test    ah,ah        ;examine its sign
  586.     js    insx2
  587.     jmp    ns1        ;positive, insert it and quit
  588. insx2:    mov    (byte ptr[bx]),'-'    ;insert sign
  589.     inc    bx        ;keep pointer updated
  590.     neg    ax        ;negate the exponent
  591.     jmp    ns1        ;insert it and quit
  592.  
  593. ;    Insert period, shift string, drop trailing zeros
  594.  
  595. shstr:    mov    cx,word ptr BINXPT    ;total length of digit string
  596.     sub    cl,al        ;minus digits to be left in place
  597.     mov    al,'.'        ;prepare period
  598. shst1:    mov    ah,(byte ptr[bx])    ;start moving
  599.     mov    (byte ptr[bx]),al
  600.     mov    al,ah
  601.     inc    bx    ;next
  602.     loop    shst1
  603.     mov    (byte ptr[bx]),al    ;last
  604. shst2:    cmp    al,'0'    ;while last character is zero, drop it
  605.     jz    shst3
  606.     ret
  607. shst3:    dec    bx    ;back up
  608.     mov    al,(byte ptr[bx])
  609.     jmp    shst2
  610.  
  611. ;    Unpack floating point number
  612.  
  613. unpak:    mov    bx,(offset ARG1H)    ;get address of high byte
  614. unpk1:    dec    bx
  615.     mov    dx,[bx]        ;check for zero
  616.     mov    DXSG,dh        ;save sign-containing byte
  617.     test    dx,dx
  618.     jnz    up0
  619.     ret
  620.  
  621. up0:    mov    cl,NSIZ
  622.     cmp    cl,5
  623.     jnz    updp        ;jump if DP
  624.     dec    cl        ;set up count for shlby1
  625.     sal    dx,1        ;move LSbit of exponent to MSBit of AH
  626.     stc            ;set "implicit" bit
  627.     rcr    dl,1        ;got full mantissa byte and LSbit of
  628.     mov    (byte ptr[bx]),dl    ; exponent in Carry
  629.     inc    bx    ;point to MSbyte
  630.     mov    dl,dh    ;exponent to LSbyte of AX
  631.     mov    dh,0    ;zero to high byte of AX
  632.     mov    (byte ptr[bx]),dh    ;and to high byte of arg1
  633.     mov    ax,0FF82H    ;bias to subtract (-07EH)
  634.     jmp    short up2
  635.  
  636. updp:    mov    al,dl        ;save lower byte in al
  637.     and    dl,0FH        ;select mantissa nibble
  638.     or    dl,10H        ;and set "implicit" bit
  639.     mov    (byte ptr[bx]),dl    ;put it back
  640.     inc    bx
  641.     mov    (byte ptr[bx]),0    ;clear highest byte
  642.     and    dh,07FH        ;clear high bit
  643.     mov    dl,al        ;restore low byte
  644.     mov    cl,4        ;set shift count
  645.     shr    dx,cl        ;and divide by 16
  646.     mov    cl,7        ;set up count for shlby1
  647.     mov    ax,0FC05H    ;bias to subtract (-3FFH + 1/2 byte)
  648. up2:    add    dx,ax        ;subtract bias
  649.     mov    di,bx
  650.     mov    ch,0        ;clear upper half of count reg.
  651.     call    shlby1        ;move mantissa up one byte
  652.     stc            ;set carry to indicate nonzero operand
  653.     ret            ;and quit
  654.  
  655. ;    Decimal normalization: reduce binary exponent to zero
  656. ;    while computing decimal exponent and keeping mantissa
  657. ;    between 0.1 and 1.
  658.  
  659. nsdnor: mov    word ptr BINXPT,dx    ;save the unbiased binary exponent
  660.     jmp    short nsdn1a
  661. nsdn1:    call    div10a        ;divide by 10 while BINXPT>0
  662. nsdn1a: call    norg1        ;keep mantissa normalized
  663.     add    dx,word ptr BINXPT    ;and binary expt correct
  664.     mov    word ptr BINXPT,dx    ;but test it
  665.     test    dx,dx
  666.     jnz    nsdn1b
  667.     ret            ;return when bin. expt. is zero
  668. nsdn1b: jns    nsdn1        ;divide by 10 while positive
  669.     push    dx
  670.     add    dx,3        ;else see if number between 0.1 and 1.
  671.     jc    nsdn3        ;if not less than -3, almost there
  672.     call    m58tha        ;else multiply by 10/16 and
  673.     jmp    short nsdnor        ;keep at it
  674.  
  675. nsdn3:    test    dx,dx        ;almost there
  676.     pop    dx
  677.     jnz    nsdn4        ;done if -3<BINXPT<0 (# between .125 and 1.)
  678.     push    dx        ;save binexpt in stack for m58tha
  679.     mov    di,PY    ;save mantissa in PDL, we may have to restore it
  680.     mov    si,(offset ARG1)
  681.     mov    cx,8
  682.     call    xf1
  683.     call    m58tha        ;try product by 10/16 one last time
  684.     mov    ah,arg1h    ;get highest mantissa byte
  685.     test    ah,ah        ;see if we overflowed
  686.     jns    nsdnor        ;if not, normalize again
  687.     mov    si,PY        ;if it did, we must undo it and quit:
  688.     mov    di,(offset ARG1)    ;retrieve mantissa from PDL
  689.     mov    cx,8
  690.     call    xf1
  691.     inc    DCXPT        ;restore DCXPT to what it was
  692.     mov    dx,0FFFDH    ;value of l when we came in at nsdn3 (-3)
  693. nsdn4:    neg    dx        ;final value of -(BINXPT)
  694.     mov    di,(offset ARG1H)    ; mantissa to the right
  695.     call    shr1
  696.     ret
  697.  
  698. ;    Generate (A) decimal digits from mantissa at arg1
  699.  
  700. mkstr:    mov    bx,PY
  701.     mov    (byte ptr[bx]),'0'
  702. mkstr2: inc    al    ;one extra digit to use for rounding
  703.     mov    cl,al
  704.     mov    ch,0
  705. mkstr3: inc    bx        ;point to next byte on PDL
  706.     push    cx        ;save counter
  707.     push    bx        ;and pointer
  708.     push    bx        ;once more for the benefit of m58thc
  709.     call    m58thc
  710.     pop    bx        ;retrieve pointer
  711.     mov    al,ARG1H    ;high byte, whose high nibble
  712.     mov    cl,4
  713.     shr    al,cl        ;contains the next decimal digit
  714.     add    al,'0'        ;which we translate to ASCII
  715.     mov    (byte ptr[bx]),al    ;save on the PDL
  716.     mov    bp,bx
  717.     mov    dl,4    ;and drop from the mantissa
  718. mk4:    call    twice
  719.     dec    dl
  720.     jnz    mk4
  721.     mov    bx,bp
  722.     pop    cx    ;retrieve counter
  723.     loop    mkstr3    ;and keep at it till we're through
  724.     mov    word ptr BINXPT,bx    ;use BINXPT to point at the last char
  725.     mov    ch,5
  726. mk5:    mov    al,(byte ptr[bx])    ;do a decimal round on the string
  727.     add    al,ch
  728.     cmp    al,'9'+1
  729.     jc    mk6
  730.     sub    al,10    ;decimal carry ocurred, propagate it
  731.     mov    (byte ptr[bx]),al
  732.     mov    ch,1
  733.     dec    bx
  734.     jmp    mk5
  735.  
  736. mk6:    mov    [bx],al    ;return the last decimal digit rounded
  737.     mov    bx,PY
  738.     mov    al,[bx]
  739.     sub    word ptr BINXPT,bx    ;compute string length
  740.     cmp    al,'0'
  741.     jz    mk7        ;all the way
  742.     inc    word ptr DCXPT    ;if it did, adjust the decimal exponent
  743.     ret
  744.  
  745. mk7:    dec    word ptr BINXPT    ;no carry propagated, get rid of extra 0
  746.     mov    cx,word ptr BINXPT    ;adjust length and use it to shift:
  747.     mov    si,PY        ;prepare to shift string down one digit
  748.     mov    di,si        ;get start of digit string
  749.     inc    si        ;point source index to 1st nonzero digit
  750. ;                ;run into xf1 to do the transfer
  751.  
  752. ;    --------------------------------------------------------------
  753. ;    Service routines for the preceding conversion operators
  754. ;    --------------------------------------------------------------
  755.  
  756. ;    transfer in increasing memory direction
  757.  
  758. xf1:    mov    bp,ds
  759. xf2:    mov    es,bp
  760.     cld
  761.     repnz    movsb
  762.     ret
  763.  
  764. ;    transfer in decreasing memory direction
  765.  
  766. mduc:    mov    bp,ds
  767.     mov    es,bp
  768. mduc1:    dec    di
  769.     dec    si
  770.     std
  771.     repnz    movsb
  772.     ret
  773.  
  774. ;    Clear number buffers
  775.  
  776. dsinit: mov    di,(offset ARG1)    ;starting byte to clear
  777.     mov    cx,22    ;number of bytes to clear
  778.     jmp    short zar1
  779.  
  780. ;    Clear 8 bytes or (CX) bytes starting at (DI)
  781.  
  782. zarg1:    mov    di,(offset ARG1)
  783. zarg:    mov    cx,8
  784. zar1:    mov    ax,ds
  785.     mov    es,ax
  786.     mov    ax,0000
  787.     cld
  788.     repnz    stosb
  789.     ret
  790.  
  791. ;    arg1 times 10
  792.  
  793. txp:    call    cop    ;copy to arg2
  794.     call    twice    ;multiply by fos
  795.     call    twice
  796.     call    add8    ;add it to make 5 and run into twice
  797.  
  798. ;    arg1 times 2
  799.  
  800. twice:    mov    cx,4
  801. twi0:    mov    bx,(offset ARG1)
  802. twi1:    clc
  803. tw1:    rcl    word ptr [bx],1
  804.     inc    bx
  805.     inc    bx
  806.     loop    tw1
  807.     ret
  808.  
  809. ;    copy arg1 to arg2
  810.  
  811. cop:    mov    si,(offset ARG1)
  812.     mov    di,(offset ARG2)
  813.     mov    cx,8
  814.     jmp    xf1
  815.  
  816. ;    shift right one nibble argument pointed to by DE
  817.  
  818. shrnib: mov    dl,4
  819. shr1:    mov    bx,di
  820.     call    halv2
  821.     dec    dl
  822.     jnz    shr1
  823.     ret
  824.  
  825. ;    halve arg1
  826.  
  827. halve:    mov    bx,(offset ARG1H)
  828. halv2:    clc
  829. halvc:    mov    cx,8    ;this entry to shift right with initial carry
  830. hal1:    rcr    byte ptr [bx],1
  831.     dec    bx
  832.     loop    hal1
  833.     ret
  834.  
  835. ;    add arg2 to arg1
  836.  
  837. add8:    mov    cx,4
  838. adda:    mov    bx,(offset ARG1)
  839. addb:    mov    bp,(offset ARG2)
  840. addc:    clc
  841. ad1:    mov    ax,ds:[bp]
  842.     adc    [bx],ax
  843.     inc    bx
  844.     inc    bx
  845.     inc    bp
  846.     inc    bp
  847.     loop    ad1
  848.     ret
  849.  
  850. ;    shift left arg1 a full byte
  851.  
  852. shlby:    mov    di,(offset ARG1H)
  853. shlby0: mov    cx,7
  854. shlby1: mov    si,di
  855.     dec    si
  856.     std
  857.     mov    bp,ds
  858.     mov    es,bp
  859.     repnz    movsb
  860.     mov    al,ch        ;clear AL
  861.     stosb            ;clear LSbyte
  862.     ret
  863.  
  864. ;    multiply arg1 by 10/16
  865.  
  866. m58tha: mov    bx,DCXPT
  867. m58thb: dec    bx    ;subtract one from dec. exponent
  868.     mov    DCXPT,bx
  869. m58thc: call    halve
  870.     call    cop
  871.     call    halve
  872.     call    halve
  873.     call    add8
  874.     pop    bp
  875.     pop    dx
  876.     add    dx,4    ;add 4 to bin. exponent
  877.     jmp    bp
  878.  
  879. ;    divide arg1 by 10
  880.  
  881. div10a: mov    bx,DCXPT
  882. div10b: inc    bx    ;add 1 to decimal exponent
  883.     mov    DCXPT,bx
  884.     call    halve
  885.     call    cop
  886.     call    halve
  887.     call    add8    ;here we have 3/4 of original mantissa
  888.     call    cop    ;which we copy into arg2
  889.     mov    cx,15    ;nibbles in 8 bytes, minus one
  890. dv1:    push    cx    ;this loop multiplies arg1 by 16/15 (approx)
  891.     mov    di,(offset ARG2H)
  892.     call    shrnib
  893.     call    add8
  894.     pop    cx
  895.     loop    dv1    ;when done, we have 4/5 of original arg1
  896.     call    halve    ;divide by 8 to make 1/10
  897.     call    halve
  898.     call    halve
  899.     ret
  900.  
  901. ;    normalize arg1
  902.  
  903. norg1:    mov    dx,0
  904. nr0:    mov    al,ARG1H
  905.     test    al,al
  906.     jnz    nr2    ;determine whether a byte shift is needed
  907.     mov    al,dl    ;it is
  908.     sub    al,38H    ;max number of shifts (7 bytes)
  909.     jnz    nr1
  910.     mov    dl,al    ;arg1 was 0
  911.     ret
  912. nr1:    add    al,40H    ;restore the subtracted 38H, add 8 more
  913.     mov    dl,al    ; and save in c
  914.     call    shlby    ;shift left a full byte
  915.     jmp    nr0    ;start over
  916.  
  917. nr2:    js    nr3    ;high bit on means we're done
  918.     call    twice    ;otherwise shift left one bit
  919.     inc    dl    ;record the fact
  920.     jns    nr0    ;and test again
  921.  
  922. nr3:    neg    dx    ;negate the shift count
  923.     ret
  924.  
  925. ;    Return if not decimal. A unchanged if not decimal, else
  926. ;    reduced to binary.
  927.  
  928. RND:    cmp    al,':'        ;colon follows 9 in ASCII alphabet
  929.     jnb    RTN
  930.     cmp    al,'0'        ;ASCII zero is lower limit
  931.     jb    RTN
  932.     sub    al,'0'        ;normalize to get binary values
  933.     mov    ah,00        ;zero for uncomplicated arithmetic
  934.     ret
  935. RTN:    inc    sp
  936.     inc    sp
  937.     ret
  938.  
  939. ;    Check if arg1=0
  940.  
  941. zach:    xor    ax,ax
  942.     mov    bx,(offset ARG1)
  943.     mov    cx,4
  944. zch0:    or    ax,(word ptr[bx])    ;pile up mantissa bytes on A
  945.     inc    bx
  946.     inc    bx
  947.     loop    zch0
  948.     test    ax,ax
  949.     ret
  950.  
  951. ;    end
  952.