-- IeeeIOB.mesa
-- Last Modified: August 27, 1982 1:05 pm
-- Last Modified By Paul Rovner On May 4, 1983 10:08 am
-- String munging for IO
-- Last Edited by: Levin, August 8, 1983 6:21 pm
-- Last Edited by: MBrown, September 5, 1983 6:57 pm

DIRECTORY
  Ascii USING [CR, DEL, TAB],
  Basics USING [LongNumber],
  ConvertReal USING [],  -- EXPORTS only
  Ieee USING [BitOn, HalfLC, HiBit],
  Real USING [DefaultSinglePrecision, NumberType, PairToReal, RealToPair];

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

  StringBoundsFault: ERROR [s: STRING] = CODE;

  ReadReal: PUBLIC PROC [get: PROC RETURNS [CHARACTER], putback: PROC [CHARACTER]]
    RETURNS [REAL] = {
    InsideProc: PROC RETURNS [REAL] = {
      exp, exp2, cVal, digits: INTEGER _ 0;
      val: REAL;
      intVal: LONG INTEGER _ 0;
      minus, expMinus: BOOLEAN _ FALSE;
      leadZeros: BOOLEAN _ TRUE;
      mode: {firstSymbol, intPart, fracPart, firstExpSymbol, expPart} _
	firstSymbol;
      c: CHARACTER;
      Ten: INTEGER = 10;
      DigitLimit: INTEGER = 9; -- digits is a way to prevent overflow of intVal
      DO
	c _ get[];
	cVal _ LOOPHOLE[c - '0, INTEGER];
	SELECT c FROM
	  ' , CR, TAB, DEL => SELECT mode FROM firstSymbol => NULL; ENDCASE => EXIT;
	  '+ =>
	    SELECT mode FROM
	      firstSymbol => mode _ intPart;
	      firstExpSymbol => mode _ expPart;
	      ENDCASE => EXIT;
	  '- =>
	    SELECT mode FROM
	      firstSymbol => {minus _ TRUE; mode _ intPart; };
	      firstExpSymbol => {expMinus _ TRUE; mode _ expPart; };
	      ENDCASE => EXIT;
	  '. =>
	    SELECT mode FROM
	      firstSymbol, intPart => mode _ fracPart;
	      ENDCASE => EXIT;
	  'D, 'E, 'd, 'e =>
	    SELECT mode FROM
	      intPart, fracPart => mode _ firstExpSymbol;
	      ENDCASE => EXIT;
	  IN ['0..'9] =>
	    SELECT mode FROM
	      firstSymbol, intPart =>
		IF digits < DigitLimit THEN {
		  IF cVal # 0 THEN leadZeros _ FALSE;
		  mode _ intPart;
		  intVal _ intVal*Ten + cVal;
		  IF NOT leadZeros THEN digits _ digits + 1;
		  }
		ELSE exp _ exp + 1;
	      fracPart =>
		IF digits < DigitLimit THEN {
		  IF cVal # 0 THEN leadZeros _ FALSE;
		  intVal _ intVal*Ten + cVal;
		  exp _ exp - 1;
		  IF NOT leadZeros THEN digits _ digits + 1;
		  };
	      firstExpSymbol, expPart => {
		mode _ expPart; exp2 _ exp2*10 + cVal; };
	      ENDCASE => EXIT;
	  ENDCASE => EXIT;
	ENDLOOP;
      putback[c]; -- now put it together
      IF expMinus THEN exp2 _ -exp2;
      exp _ exp + exp2;
      val _ PairToReal[intVal, exp];
      IF minus THEN
	LOOPHOLE[val, LONG CARDINAL] _ LOOPHOLE[val, LONG CARDINAL] + HalfLC;
      RETURN[val];
      };
    RETURN[InsideProc[]];
    };

  AppendReal: PUBLIC PROC [
    s: STRING, r: REAL, precision: CARDINAL _ DefaultSinglePrecision,
    forceE: BOOLEAN _ FALSE] = TRUSTED {
    exp: INTEGER;
    z: LONG INTEGER;
    ty: NumberType;
    sign: BOOLEAN;
    Zeros: PROC [n: CARDINAL] = TRUSTED {THROUGH [1..n] DO AppendChar[s, '0]; ENDLOOP; };
    {
    sign _ BitOn[LOOPHOLE[r, Basics.LongNumber].highbits, HiBit];
    [type: ty, fr: z, exp10: exp] _ 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" ELSE "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];
	      };
	    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)];
	  };
	};
    };
    };

  WriteReal: PUBLIC PROC [
    cp: PROC [CHARACTER], r: REAL, precision: CARDINAL _ DefaultSinglePrecision,
    forceE: BOOLEAN _ FALSE] = TRUSTED {
    s: STRING _ [50];
    i: CARDINAL;
    AppendReal[s, r, precision, forceE];
    FOR i IN [0..s.length) DO cp[s[i]]; ENDLOOP;
    };

  -- ripped off from StringsImplA (CompatibilityPackage)
  AppendChar: PROC [s: STRING, c: CHARACTER] =
    TRUSTED BEGIN
    IF s = NIL THEN RETURN;
    IF s.length >= s.maxlength THEN ERROR StringBoundsFault[s];
--    UNTIL s.length < s.maxlength DO s _ SIGNAL StringBoundsFault[s]; ENDLOOP;
    s[s.length] _ c;
    s.length _ s.length + 1;
    RETURN
    END;

  -- ripped off from StringsImplA (CompatibilityPackage)
  AppendString: PROC [to: STRING, from: STRING] =
    TRUSTED BEGIN
    i, j, n: CARDINAL;
    IF to = NIL OR from = NIL THEN RETURN;
    IF from.length + to.length > to.maxlength THEN ERROR StringBoundsFault[to];
--    WHILE from.length + to.length > to.maxlength DO
--      to _ SIGNAL StringBoundsFault[to]; ENDLOOP;
    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;
    RETURN
    END;

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