-- 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