-- IeeeIOB.mesa
-- String munging for IO
-- Last Modified By Paul Rovner On May 4, 1983 10:08 am
-- Last Edited by: Levin, August 8, 1983 6:21 pm
-- Last Edited by: MBrown, January 16, 1984 2:51 pm PST

DIRECTORY
  Basics USING [LongNumber],
  ConvertReal USING [],  -- EXPORTS only
  Ieee USING [BitOn, HiBit],
  Real USING [NumberType, RealToPair];

IeeeIOB: CEDAR PROGRAM IMPORTS Ieee, Real EXPORTS ConvertReal =
  BEGIN

  AppendReal: PUBLIC PROC [s: STRING, r: REAL, precision: CARDINAL, forceE: BOOL] =
    TRUSTED {
    exp: INTEGER;
    z: INT;
    ty: Real.NumberType;
    sign: BOOL;
    Zeros: PROC [n: CARDINAL] = TRUSTED {
      THROUGH [1..n] DO AppendChar[s, '0] ENDLOOP
      };
    {
    sign _ Ieee.BitOn[LOOPHOLE[r, Basics.LongNumber].highbits, Ieee.HiBit];
    [type: ty, fr: z, exp10: exp] _ Real.RealToPair[r, precision];
    IF sign THEN z _ -z;
    SELECT ty FROM
      nan => AppendString[to: s, from: ".."];
      infinity => AppendString[to: s, from: IF sign THEN "--" ELSE "++"];
      zero => AppendString[to: s, from: IF sign THEN "-0.0" ELSE "0.0"];
      ENDCASE => GOTO Ok;
    EXITS
      Ok => {
	lds: STRING _ [20];
	rds: STRING _ [20];
	i, digit, digits, ld, rd: CARDINAL;
	IF sign THEN AppendChar[s, '-];
	IF z = 0 THEN { AppendChar[s, '0]; RETURN }; -- leading zeros
	digits _ precision _ MAX[1, MIN[precision, 9]];
	WHILE (z MOD 10) = 0 DO
	  -- strip trailing zeros
	  z _ z/10;
	  exp _ exp + 1;
	  digits _ digits - 1;
	  ENDLOOP;
	IF digits = 0 THEN ERROR;
	rd _ MAX[0, -exp];
	rds.length _ MIN[digits, rd]; -- right digit string
	FOR i DECREASING IN [0..rds.length) DO
	  digit _ LOOPHOLE[z MOD 10, Basics.LongNumber].lowbits;
	  z _ z/10;
	  rds[i] _ digit + '0;
	  ENDLOOP;
	ld _ MAX[0, LOOPHOLE[digits, INTEGER] + exp];
	lds.length _ MIN[digits, ld]; -- left digit string
	FOR i DECREASING IN [0..lds.length) DO
	  digit _ LOOPHOLE[z MOD 10, Basics.LongNumber].lowbits;
	  z _ z/10;
	  lds[i] _ digit + '0;
	  ENDLOOP;
	forceE _ forceE OR ld > 6 OR rd > 6;
	IF NOT forceE THEN
	  SELECT TRUE FROM
	    ld = 0 => {
	      -- number entirely to right of decimal point
	      AppendString[to: s, from: "0."];
	      Zeros[rd - rds.length];
	      AppendString[to: s, from: rds];
	      };
	    rd = 0 => {
	      -- number entirely to left of decimal point
	      AppendString[to: s, from: lds];
	      Zeros[ld - lds.length];
	      AppendString[to: s, from: ".0"];
	      };
	    ENDCASE => {
	      -- some of each
	      AppendString[to: s, from: lds];
	      AppendChar[s, '.];
	      AppendString[to: s, from: rds];
	      }
	ELSE {
	  -- e format
	  AppendString[to: lds, from: rds];
	  AppendChar[s, lds[0]];
	  lds.length _ lds.length;
	  exp _ exp + lds.length - 1;
	  SELECT TRUE FROM
	    precision = 1 => AppendChar[s, '.];
	    lds.length = 1 => AppendString[to: s, from: ".0"];
	    ENDCASE => {
	      AppendChar[s, '.];
	      FOR i IN [1..lds.length) DO AppendChar[s, lds[i]]; ENDLOOP;
	      }; -- print exponent
	  IF exp = 0 THEN RETURN;
	  AppendChar[s, 'e];
	  AppendChar[s, IF exp < 0 THEN '- ELSE '+];
	  exp _ ABS[exp];
	  IF exp > 9 THEN AppendChar[s, '0 + (exp/10)];
	  AppendChar[s, '0 + (exp MOD 10)];
	  };
	};
    };
    };

  AppendChar: PROC [s: STRING, c: CHARACTER] = TRUSTED {
    IF s = NIL THEN RETURN;
    IF s.length >= s.maxlength THEN ERROR;
    s[s.length] _ c;
    s.length _ s.length + 1;
    };

  AppendString: PROC [to: STRING, from: STRING] = TRUSTED {
    i, j, n: CARDINAL;
    IF to = NIL OR from = NIL THEN RETURN;
    IF from.length + to.length > to.maxlength THEN ERROR;
    n _ MIN[from.length, LOOPHOLE[to.maxlength - to.length, CARDINAL]];
    i _ to.length;
    j _ 0;
    WHILE j < n DO to[i] _ from[j]; i _ i + 1; j _ j + 1; ENDLOOP;
    to.length _ i;
    };

END.
L. Stewart, July 12, 1980  10:37 PM, Name changes
L. Stewart, July 13, 1980  8:57 PM, delete WF procwedures (Moved to WFReal)
August 24, 1980  8:42 PM, L. Stewart; formatting, fix ReadReal
December 11, 1980  11:06 AM, L. Stewart; Use Ascii instead of IODefs
June 5, 1982 5:58 pm, L. Stewart, removed STRING conversions
August 27, 1982 1:05 pm, L. Stewart, CEDAR
January 16, 1984 2:35 pm PST, MBrown, toss unused stuff.