home *** CD-ROM | disk | FTP | other *** search
/ The Fred Fish Collection 1.5 / ffcollection-1-5-1992-11.iso / ff_disks / 300-399 / ff339.lzh / PCQ / Runtime.lzh / Runtime / Writers / WriteReal.asm < prev    next >
Assembly Source File  |  1990-03-03  |  4KB  |  136 lines
  1. *
  2. *    WriteReal.asm (of the PCQ Pascal runtime library)
  3. *    Copyright (c) 1989 Patrick Quaid
  4. *
  5.  
  6. *    Write a real value to the appropriate file.
  7.  
  8. *    On entry, this routine expects d0 to hold the FFP value.
  9. *    The word on top of the stack should be the number of fractional
  10. *    digits after the decimal point to write.  The word below that
  11. *    is the minimum field width of the integer part.  The longword
  12. *    below that is the address of the file record
  13.  
  14.     SECTION    WriteReal
  15.  
  16.     XREF    _p%MathBase
  17.     XREF    _LVOSPSub
  18.     XREF    _LVOSPMul
  19.     XREF    _LVOSPAbs
  20.     XREF    _LVOSPFix
  21.     XREF    _LVOSPFlt
  22.     XREF    _LVOSPTst
  23.  
  24.     XREF    _IntToStr
  25.     XREF    _p%WriteText
  26.     XREF    _p%IOResult
  27.     XREF    _p%PadOut
  28.     XREF    outbuffer
  29.  
  30.     XDEF    _p%WriteReal
  31. _p%WriteReal
  32.  
  33.     tst.l    _p%IOResult    ; is IO System in order?
  34.     beq.s    1$        ; if so, skip ahead
  35.     rts
  36.  
  37. 1$    link    a5,#-22
  38.     move.l    d0,-6(a5)    ; -6(a5) holds the value: r
  39.     move.l    _p%MathBase,a6    ; load up the mathffp base
  40.     jsr    _LVOSPFix(a6)    ; get the integer value
  41.  
  42.     bne.s    NotZero        ; if fix(x) >= 1, write int part
  43.     move.l    -6(a5),d1    ; d1 := r
  44.     jsr    _LVOSPTst(a6)    ; test the real value
  45.     sge    d0        ; d0 := r >= 0
  46.     lea    -22(a5),a0    ; get buffer address
  47.     tst.b    d0        ; look at d0
  48.     bne.s    WasGreater    ; if True, skip
  49.     move.b    #'-',(a0)+    ; pre-pend minus sign
  50. WasGreater
  51.     move.b    #'0',(a0)+    ; add zero
  52.     lea    -22(a5),a1    ; get original position
  53.     suba.l    a1,a0        ; get length
  54.     move.l    a0,d3        ; d3 := length
  55.     bra.s    WriteIntPart    ; go write the integer part
  56.  
  57. NotZero
  58.     lea    -22(a5),a0    ; get first buffer position address
  59.     move.l    a0,-(sp)    ; push it onto stack
  60.     move.l    d0,-(sp)    ; push int value
  61.     jsr    _IntToStr    ; get character representation
  62.     addq.l    #8,sp        ; fix stack
  63.     move.l    d0,d3        ; d3 := length
  64.  
  65. WriteIntPart
  66.     move.l    12(a5),a0    ; a0 := file record address
  67.     move.w    10(a5),d0    ; d0 := int part length
  68.     ext.l    d0        ; convert to longword
  69.     sub.l    d3,d0        ; how many spaces ?
  70.     ble.s    NoPadding    ; if none, skip this
  71.     jsr    _p%PadOut    ; otherwise, write spaces
  72. NoPadding
  73.     lea    -22(a5),a1    ; get buffer address
  74.     jsr    _p%WriteText    ; write integer part
  75.  
  76.     tst.w    8(a5)        ; test fractional part length
  77.     ble    _p%2        ; if <= 0, skip all this
  78.  
  79.     move.l    -6(a5),d0    ; get r
  80.     move.l    _p%MathBase,a6
  81.     jsr    _LVOSPAbs(a6)
  82.     move.l    d0,-6(a5)    ; r := abs(r)
  83.  
  84.     cmp.w    #30,8(a5)    ; at most 30 characters, due to |outbuffer|
  85.     ble.s    2$        ; < 9 are significant anyway
  86.     move.w    #30,8(a5)    ; make it 30, just for kicks
  87. 2$    move.l    a4,-(sp)    ; save a4
  88.     move.l    #outbuffer,a4    ; set to outbuffer
  89.     move.b    #46,(a4)+    ; make decimal point
  90.     move.l    -6(a5),d0    ; d0 := r
  91.     jsr    _LVOSPFix(a6)    ; d0 := fix(r)
  92.     jsr    _LVOSPFlt(a6)    ; d0 := flt(fix(r))
  93.     move.l    d0,d1        ;
  94.     move.l    -6(a5),d0    ; d0 := r
  95.     jsr    _LVOSPSub(a6)    ; d0 := r - flt(fix(r)), i.e just frac part
  96.     move.l    d0,d1        ;
  97.     move.l    #$A0000044,d0    ; d0 := 10.0
  98.     jsr    _LVOSPMul(a6)    ; d0 := (r - flt(fix(r))) * 10.0
  99.     move.l    d0,-6(a5)    ; r  := ^
  100.     move.w    #1,-2(a5)    ; set up for loop
  101. _p%3
  102.     move.l    -6(a5),d0    ; get r
  103.     jsr    _LVOSPFix(a6)    ; d0 := fix(r)
  104.     add.b    #'0',d0        ; d0 := r + ord('0')
  105.     move.b    d0,(a4)+    ; put this char into buffer
  106.  
  107.     move.l    -6(a5),d0    ; get r
  108.     jsr    _LVOSPFix(a6)    ; d0 := fix(r)
  109.     jsr    _LVOSPFlt(a6)    ; d0 := flt(fix(r))
  110.     move.l    d0,d1
  111.     move.l    -6(a5),d0
  112.     jsr    _LVOSPSub(a6)    ; d0 := r - flt(fix(r))
  113.     move.l    #$A0000044,d1    ; d1 := 10.0
  114.     jsr    _LVOSPMul(a6)    ; d0 := (r - flt(fix(r)) * 10.0
  115.     move.l    d0,-6(a5)    ; r := --^
  116.  
  117.     add.w    #1,-2(a5)    ; i := i + 1
  118.     move.w    8(a5),d0    ; get frac length
  119.     cmp.w    -2(a5),d0
  120.     bge    _p%3        ; if i < frac length, loop
  121.  
  122.     move.w    8(a5),d3    ; get fractional length back
  123.     ext.l    d3        ; make it 32 bits
  124.     addq.l    #1,d3        ; add one for decimal point
  125.     move.l    #outbuffer,a1    ; get address of buffer
  126.     move.l    12(a5),a0    ; get file record address
  127.     jsr    _p%WriteText    ; and copy it into the buffer
  128.     move.l    (sp)+,a4    ; restore a4
  129. _p%2
  130.     unlk    a5        ; restore stack frame
  131.     rts            ; and get out
  132.  
  133. Hyphen    dc.b    '-',0
  134.  
  135.     END
  136.