!Revision history:  6-Dec-86 PSR created
!                  12-Mar-87 JF  hex. exponents bug corrected
!                  21-Apr-87 JF  After < 0 signals 5, 10

! ***** NOTE ***** the IBM option has never been tested

{This routine converts a floating point value into its                }
{decimal representation. The output (in buffer) is of the form:       }
{   (minus?) <digit><digit>.....<digit>                               }
{where the first digit is the first digit FOLLOWING the decimal point }
{e.g. convert(-1.234) gives  <-><1><2><3><4>                          }
{It is assumed that the routine is running native on the target system}

! For SUN systems set {SUN} and !IBM! and !VAX!
! For IBM  systems set !SUN! and {IBM} and !VAX!
! For VAX  systems set !SUN! and !IBM! and {VAX}

! the code marked with SUN, IBM or VAX will need to be examined
! on systems which use totally different floating-point formats

%externalroutine Floating to Text %alias "3L___float_to_text" -
                    (%longreal R, %integer  Float, After, X Char, Buffer,
                     %integername Size, Decimal)

   {R        is the value to be converted                          }
   {Float    1 for floating-point, 0 for fixed-point               }
   {After    is the number of places to follow the decimal point   }
   {Xchar    is the exponent character                             }
   {Buffer   is the address of the first byte in the output buffer }
   {Size     returns the number of bytes put into the buffer       }
   {Decimal  returns the address of the decimal point in the buffer}

   %constinteger Significance = 20   {1/4 no of significant decimal digits}

   %integer Sign, Exponent, J, A, B, Fh, Fl
   %integer D, N, Carry, K, Z, Mod, P, Power, Point
   %integer Units, Tens, Hundreds
   %integer Max, Min,
            Max4, Min4, Limit
   %bytearray Bin(1:7)

   %constinteger Min10 = 1000-85,
                 Max10 = 1000+85

  %integerarray Dec(Min10:Max10)

   %routine Mul(%integer Shift)
      %integer Carry, V, J
      %integername N
      Carry = 0
      N == Dec(Max)
      %for J = Max, -1, Min %cycle
         V = N<<Shift+Carry
         N = Rem(V, 10000)
         N == N[-1]
         Carry = V//10000
      %repeat
      {NOTE - N is now == Dec(Min-1)}
      %if Carry # 0 %start
         Min = Min-1;  N = Carry
      %finish
      Max = Max-1 %while Max # Min %and Dec(Max) = 0
      Max = Min+30 %if (Max-Min) > 30
   %end

   %routine Div(%integer Shift, Mask)
      %integer C, V
      C = 0
      D = Min
      %cycle
         V = Dec(D)+C
         Dec(D) = V>>Shift
         C = (V&Mask)*10000
         D = D+1
         %if D > Max %start
            %exit %if C = 0 %or Max = Max10 %or (Max-Min) > Significance
            Max = D
            Dec(D) = 0
         %finish
      %repeat
      Min = Min+1 %while Min # Max %and Dec(Min) = 0
   %end

   {dismantle FP numbers}

   {**************************************************************}
   {this needs to be tailored to suit the particular              }
   {form of floating-point representation used                    }
   {at the end the following variables are set                    }
   { Sign     : the sign bit                                      }
   { Exponent : the actual binary exponent, ie NOT biased         }
   { Fh       : the top 24 bits of the true mantissa, MS bits zero}
   { Fl       : the low bits of the true mantissa, LS bits zero   }
   {   |00bbbbbb|   |bbbbbbb0|                                    }
   {      Fh            Fl                                        }
   {**************************************************************}

   %if R = 0 %start                                 {true zero}
      Bin(1)  = 0
      Exponent = 0
      Sign     = 0
      D        = 1
   %else
      A = Integer(Addr(R)+0)
      B = Integer(Addr(R)+4)

!VAX!      Sign     = A>>15&1                       {sign bit}
!VAX!      Exponent = (A>>7)&255-128                {true exponent}
!VAX!      Fh       = (A&2_1111111)<<16 ! (A>>16)   {top 23 bits of mantissa}
!VAX!      Fl       = (B&16_FFFF)  <<16 ! (B>>16)   {low 32 bits of mantissa}
!VAX!      Fh       = Fh ! (1<<23)                  {hidden mantissa bit}

!IBM!      Sign     = A>>31                         {sign bit}
!IBM!      { IBM/PE has hex exponents, but this means multiplying by 4 }
!IBM!      { (believe me, this is right)                               }
!IBM!      Exponent = ((A>>24)&127 - 64)*4          {true exponent}
!IBM!      Fh       = A&16_00FFFFFF                 {top 24 bits of mantissa}
!IBM!      Fl       = B                             {low 32 bits of mantissa}

{SUN}      Sign     = A>>31                         {sign bit}
{SUN}      Exponent = (A>>20)&16_7FF - 1023+1       {true exponent}
{SUN}      Fh       = (A&16_FFFFF)<<3 ! B>>29       {top 23 bits of mantissa}
{SUN}      Fh       = Fh ! (1<<23)                  {hidden mantissa bit}
{SUN}      Fl       = B<<3                          {low 29 bits of mantissa}

      %for J = 1, 1, 7 %cycle                       {unpack into base 256 units}
         Bin(J) <- (Fh>>16)
         Fh = Fh<<8 ! (Fl>>24)
         Fl = Fl<<8
      %repeat
      D = 7
   %finish

   {convert to base 100}

   Min = 1000+0;  Max = 1000-1
   %cycle
      D = D-1 %while D # 1 %and Bin(D) = 0
      Z = 0
      Carry = 0
      %for K = D, -1, 1 %cycle
         N = Bin(K)*100+Carry
         Bin(K) <- N
         Z = Z!N
         Carry = N>>8
      %repeat
      Max = Max+1;  Dec(Max) = Carry
   %repeat %until Z&255 = 0

   {convert to base 10 000}

   Dec(Max+1) = 0
   D = Max
   N   = 1000-2
   Max = 1000-1
   %cycle
      N = N+2
      %exit %if N > D
      Max = Max+1
      Dec(Max) = Dec(N)*100 + Dec(N+1)
   %repeat

   {Dec now contains the number in the form 0.ABCD EFGH .... with}
   {each 4 decimal digits ABCD etc. in successive elements       }
   {starting at Dec(1000) = ABCD                                 }

   {apply the exponent which is currently BINARY                     }
   {note that 1<<13 = 8196 which is less than each item in Dec (9999)}

   %if Exponent > 0 %start
      Mul(13) %and Exponent = Exponent-13 %while Exponent >= 13
      Mul(Exponent) %if Exponent # 0
   %else %if Exponent < 0
      Exponent = -Exponent
      Div(13, 1<<13-1) %and Exponent = Exponent-13 %while Exponent >= 13
      Div(Exponent, (1<<Exponent)-1) %if Exponent # 0
   %finish

   {the following rounding code uses index values into Dec scaled by 4   }
   {this gives digit index values. 4*X is ten-thousands digit,           }
   {4*X+1 is thousands digit etc                                         }

   P = 1000*4                       {decimal point}
   %if Float # 0 %start             {floating-point}
      P = Min*4                     {point at tens digit}
      N = Dec(Min)
      %if N <= 0999 %start
         P = P+1                    {supress 1 leading zero}
         %if N <= 0099 %start
            P = P+1                 {supress 2 leading zeros}
            %if N <= 0009 %start
               P = P+1              {supress 3 leading zeros}
            %finish
         %finish
      %finish
      P = P+1                       {onto first 'fractional' digit}
   %finish
   P = P+After                      {position 1 digit past last significant one}
   Max4  = P-1                      {digit position of final wanted digit}
   Max = Max*4
   Limit = Max+3

   %if Max4 < Limit %start          {not into zeros implied past MAX}
      Limit = Max4
      %if P&3 = 0 %start
         Mod = 5000                 {round thousands}
      %else %if P&2 = 0
         Mod = 0500                 {round hundreds}
      %else %if P&1 = 0
         Mod = 0050                 {round tens}
      %else
         Mod = 0005                 {round units}
      %finish
      P = P>>2
      %cycle
         Mod = Mod+Dec(P)
         %exit %if Mod <= 9999      {no more carries due to rounding}
         Dec(P) = Mod-10000
         Mod = 1
         P = P-1
         %if P < Min %start         {carry over into new position}
            Min = P
            Max4 = Max4-Float       {adjust limit of significant digits}
            %exit
         %finish
      %repeat %until P < Min
      Dec(P) = Mod
   %finish

   {fill the buffer with the digit sequence}

   Min4  = 4*Min
   Power = 4*1000-Min4

   N = Dec(Min)                 {*** this value is used later ***}

   %if N <= 0009 %start         {3 leading zeros}
      Power = Power-3
      Min4  = Min4+3
   %else %if N <= 0099          {2 leading zeros}
      Power = Power-2
      Min4  = Min4+2
   %else %if N <= 0999          {1 leading zero}
      Power = Power-1
      Min4  = Min4+1
   %finish

   K = Min4
   %if Float = 0 %start      {fixed point}
      Point = Min4+Power
      K = K+Power %if Power < 0
      K = K-1 %if K = Point
   %else                     {floating point}
      Point = K+1
      Power = Power-1        {to get a non-zero first digit}
   %finish
   Power = 0 %if R = 0       {adjust for true zero - otherwise get exponent=-2}
   Mod = 0                   {set following the point}

   Z = Buffer
   %if Sign # 0 %start
      Byte(Buffer) = '-';  Buffer = Buffer+1
   %finish

   N = Dec(Min4>>2)
   A        = N//1000; N = N-A*1000
   Hundreds = N//100;  N = N-Hundreds*100
   Tens     = N//10
   Units    = N-Tens*10

   K = K-1
   %cycle
      K = K+1
      %if K < Min4 %or K > Limit %start
         A = 0
      %else %if K&3 = 0        {thousands digit}
         N = Dec(K>>2)
         A        = N//1000; N = N-A*1000
         Hundreds = N//100;  N = N-Hundreds*100
         Tens     = N//10
         Units    = N-Tens*10
      %else %if K&2 = 0        {hundreds digit}
         A = Hundreds
      %else %if K&1 = 0        {tens digit}
         A = Tens
      %else                    {units digit}
         A = Units
      %finish
      %if Point = K %start
         Decimal = Buffer
         Byte(Buffer) = '.';  Buffer = Buffer+1
         Mod = 1
         %exit %if After = 0
      %finish
      Byte(Buffer) = A+'0';  Buffer = Buffer+1
      %if Mod # 0 %start
         After = After-1
         %exit %if After = 0
      %finish
   %repeat

   %if Float # 0 %start     {floating point}
      Byte(Buffer+0) = X Char
      Byte(Buffer+1) = '+'
      %if Power < 0 %start
         Byte(Buffer+1) = '-'
         Power = -Power
      %finish

{SUN}      Byte(Buffer+2) = (Power//100)+'0'
{SUN}      Byte(Buffer+3) = (Rem(Power//10, 10))+'0'
{SUN}      Byte(Buffer+4) = (Rem(Power, 10))+'0'
{SUN}      Buffer = Buffer+5

!IBM!      Byte(Buffer+2) = (Power//10)+'0'
!IBM!      Byte(Buffer+3) = (Rem(Power, 10))+'0'
!IBM!      Buffer = Buffer+4

!VAX!      Byte(Buffer+2) = (Power//10)+'0'
!VAX!      Byte(Buffer+3) = (Rem(Power, 10))+'0'
!VAX!      Buffer = Buffer+4

   %finish

   Size = Buffer-Z
%end

%externalroutine Output %alias "3L___fpout"  (%longreal V,
                                              %integer  B,
                                                        A,
                                                        Mode,
                                                        Xchar,
                                                        String)
   {V      = value to be processed                                }
   {B      = places before point (a la IMP)                       }
   {A      = places after the point                               }
   {Mode   = 0 for fixed-point, 1 for floating-point              }
   {Xchar  = exponent character                                   }
   {String = 0 for direct output, otherwise address of string(255)}

   %integer Size, Point, Sign, P, Ns, N, Z, Limit
   %bytearray Chars(1:600)
   %signal 5, 10, A %if A < 0
   Sign = 1;  Sign = -1 %and V = -V %if V < 0
   Floating to Text(V, Mode, A, Xchar, Addr(Chars(1)), Size, Point)
   N = Point-Addr(Chars(1))  {leading digits}
   %if B <= 0 %start
      Sign = 0 %if Sign > 0      {suppress leading space}
      Ns = (-B)-N+Sign
   %else
      Ns = B-N
   %finish
   %if String = 0 %start         {print it out directly}
      Spaces(Ns)
      %if Sign > 0 %then Printsymbol(' ') %else -
      %if Sign < 0 %then Printsymbol('-')
      Printsymbol(Chars(N)) %for N = 1, 1, Size
   %else
      Limit = String+255
      Z = String
      %while Ns > 0 %cycle
         Ns = Ns-1
         Z = Z+1;  Byte(Z) = ' '
      %repeat
      %if Sign > 0 %then Z = Z+1 %and Byte(Z) = ' ' %else -
      %if Sign < 0 %then Z = Z+1 %and Byte(Z) = '-'
      %signal 1,3,0 %if Z+Size > Limit
      Z = Z+1 %and Byte(Z) = Chars(N) %for N = 1, 1, Size
      Byte(String) = Z-String
   %finish
%end