         Edinburgh IMP77 Compiler - Version 8.4

    1  %external %routine vaxprintfl(%long %real r, %integer places)
    2     {%external} %string (63) %fn ftos(%long %real r, %integer p)
    3        %routine fraction(%long %real r, %integer places, %string (*) %name s)
    4           {%external} %long %real %fn fracpt(%long %real x)
    5              %long %real z
    6              z = x - intpt(x)
    7              z = z + 1.0 %if z < 0
    8              %result = z
    9           %end
   10           %return %if places <= 0
   11           s = s . "."
   12           %while places > 0 %cycle
   13              places = places - 1
   14              r = fracpt(r) * 10
   15              s = s . tostring(intpt(r) + '0')
   16           %repeat
   17        %end
   18        %routine round(%long %real %name v, %integer p)
   19           %long %real x
   20           %return %if v = 0
   21           %if v < 0 %then x = -0.5 %else x = 0.5
   22           %cycle 
   23              p = p - 1
   24              %exit %if p < 0
   25              x = x / 10
   26           %repeat
   27           v = v + x
   28        %end
   29        {XOWN}%string (63) s = ""
   30        %integer exp, sym
   31        p = 7 %if p > 7
   32        %if r < 0 %then sym = '-' %and r = -r %else sym = ' '
   33        %if r = 0 %start
   34           exp = -99
   35        %else
   36           exp = 0
   37           exp = exp + 1 %and r = r / 10 %while r >= 10
   38           exp = exp - 1 %and r = r * 10 %while r < 1
   39        %finish
   40        round(r, p)
   41        exp = exp + 1 %and r = r / 10 %if r >= 10
   42        s = s . tostring(intpt(r) + '0')
   43        fraction(r, p, s)
   44        %result = tostring(sym) . s . "@" . itos(exp, 0)
   45     %end
   46     places = \places %if places < 0
   47     spaces(places - 62)
   48     printstring(ftos(r, places))
   49  %end
   50  
   51  %endoffile

   50 Statements compiled
