-- FloatDebug.mesa
-- Copywrite Xerox Corporation 1980
-- Conversion of REALs to and from Strings for the debugger
-- This is a cut down version of FloatIO
-- Last Modified: LStewart September 12, 1979 4:40 PM
DIRECTORY
DebugRealDefs: FROM "DebugRealDefs",
InlineDefs: FROM "InlineDefs",
IODefs: FROM "IODefs",
RealDefs: FROM "RealDefs",
StringDefs: FROM "StringDefs";
FloatDebug: PROGRAM
IMPORTS InlineDefs, RealDefs, StringDefs
EXPORTS DebugRealDefs =
BEGIN OPEN InlineDefs, IODefs, RealDefs, StringDefs;
Zero: REAL ← 0;
One: REAL ← 1;
Ten: REAL ← 10;
ULim: REAL ← 999999;
LLim: REAL ← Ten/10000;
FloatNum: TYPE = RECORD [m2: CARDINAL, sign:[0..1], exp:[0..400B), m1:[0..200B)];
AppendRealNumber: PUBLIC PROCEDURE [s: STRING, r: REAL] =
BEGIN
CharToString: PROCEDURE [ c: CHARACTER ] =
BEGIN
StringDefs.AppendChar[s, c];
END;
AppendFloatTo[R: r, pProc: CharToString, lj: FALSE, lc: 0, rc: 0, EFormat: FALSE];
END;
AppendFloatTo: PROCEDURE [R: REAL, pProc: PROCEDURE [CHARACTER], lj: BOOLEAN, lc: CARDINAL, rc: CARDINAL, EFormat: BOOLEAN] =
BEGIN
Q,M,S: REAL;
pdl: ARRAY [0..40] OF [0..10);
cols, sindex: CARDINAL;
fexp, k, U: INTEGER;
fman, iPart: LONG INTEGER;
expt: INTEGER ← 0;
NotFill, LastWasDot, Digits, DecimalPt: BOOLEAN ← FALSE;
outS: STRING ← [20];
fracS: STRING ← [20];
ExptMark: PROCEDURE =
BEGIN
IF EFormat AND ~DecimalPt THEN
BEGIN
expt ← k;
DecimalPt←TRUE;
END;
END;
Output: PROCEDURE [c: CHARACTER] =
BEGIN
AppendChar[IF DecimalPt THEN fracS ELSE outS, c];
END;
LeftFill: PROCEDURE =
BEGIN
IF NOT EFormat THEN THROUGH [1..k] DO Output[’0]; ENDLOOP;
END;
FracOut: PROCEDURE [i: INTEGER] =
BEGIN
IF i#0 THEN NotFill ← TRUE;
IF NotFill THEN
BEGIN
Output[’0+i];
ExptMark[];
END
ELSE BEGIN IF NOT EFormat THEN Output[’0]; END;
END;
PrintIt: PROCEDURE =
BEGIN
-- Now think about printing the stuff out. We have a string of integer and possible leading ’- in outS, a string of fraction digits in fracS, and possible decimal point and exponent.
cols ← outS.length;
IF EFormat THEN cols ← cols+6;
IF EFormat AND rc>0 THEN rc ← MAX[rc, 1];
IF lc>0 AND cols>lc THEN -- Field overflow.
BEGIN
pProc[’ ];
THROUGH [1..lc) DO pProc[’*]; ENDLOOP;
RETURN;
END;
-- IF EFormat, we already reserved space for the ’. and one fraction digit. If NOT EFormat, we had not reserved space for the ’.. I. e. at this point, cols has the required space, we now adjust it to find the allowable space for the fraction digits.
IF EFormat THEN cols ← cols-1 ELSE cols ← cols+1;
IF rc>0 THEN fracS.length ← MIN[rc, fracS.length];
IF lc>0 THEN fracS.length ← MIN[fracS.length, lc-cols];
-- Now compute the new required space...
cols ← outS.length;
IF EFormat THEN cols ← cols+5+MAX[1, fracS.length]
ELSE BEGIN IF fracS.length>0 THEN cols ← cols+fracS.length+1; END;
cols ← lc-cols;
IF lc>0 AND NOT lj THEN THROUGH [0..cols) DO pProc[’ ]; ENDLOOP;
-- Print leading stuff.
FOR sindex IN [0..outS.length) DO pProc[outS[sindex]]; ENDLOOP;
-- Print fraction, if there.
IF fracS.length>0 THEN
BEGIN
pProc[’.];
FOR sindex IN [0..fracS.length) DO pProc[fracS[sindex]]; ENDLOOP;
END;
-- Print exponent.
IF EFormat THEN
BEGIN
-- EFormat requires at least x.0e+yy.
IF fracS.length=0 THEN
BEGIN pProc[’.]; pProc[’0]; END;
pProc[’e];
IF expt<0 THEN BEGIN pProc[’-]; expt ← -expt; END
ELSE pProc[’+];
pProc[’0+(expt/10)];
pProc[’0+(expt MOD 10)];
END;
IF lc>0 AND lj THEN THROUGH [0..cols) DO pProc[’ ]; ENDLOOP;
END;
IF R=Zero THEN BEGIN Output[’0]; PrintIt[]; RETURN; END;
IF R<Zero THEN
BEGIN
Output[’-];
R ← -R;
END;
-- Force E Format.
IF R NOT IN [LLim..ULim] THEN BEGIN EFormat←TRUE; END;
-- Establish the termination condition mask. The value of mask is 1/2 the value of the least significant bit of the mantissa of R.
[fexp, fman] ← Unpack[R];
M ← Scale[1, fexp-1];
k ← 0;
Q ← R;
S ← 1;
-- Prescale into the range of LONG INTEGER.
WHILE Q>=LAST[LONG INTEGER] DO
pdl[k]←0;
k ← k+1;
Q ← Q/Ten;
S ← S*Ten;
ENDLOOP;
-- Accumulate the rest of the digits of integer representation.
iPart ← Fix[Q];
WHILE iPart>0 DO
pdl[k]←InlineDefs.LowHalf[iPart MOD 10];
iPart ← iPart/10;
k ← k+1;
S ← S*Ten;
ENDLOOP;
Q ← R;
WHILE k>0 DO -- always at least one thing on pdl
k ← k-1;
S ← S/Ten;
U ← pdl[k];
Q ← Q - U*S;
IF Q NOT IN [M..S-M] THEN GO TO MaskExit;
Output[’0+U];
Digits ← TRUE;
ExptMark[];
REPEAT
MaskExit =>
BEGIN
IF 2*Q <=S THEN Output[’0+U]
ELSE Output[’0+U+1];
Digits ← TRUE;
ExptMark[];
LeftFill[];
END;
ENDLOOP;
IF NOT EFormat THEN
BEGIN
IF NOT Digits THEN Output[’0];
DecimalPt ← TRUE;
END;
--now, R has fractional part and S=1
-- Output some fraction digits if there were any. That we will output any fraction digits means that 1) the integer part has been printed exactly, and 2) the Fix below will not trap.
IF fexp<0 THEN
BEGIN
k ← 0;
R ← R-Fix[R]; -- Get fraction part.
IF R#0 THEN BEGIN
M ← Scale[1, fexp-1];
DO
k ← k-1;
R ← R*Ten;
U ← InlineDefs.LowHalf[Fix[R]];
R ← R-U;
M ← M*Ten;
IF R NOT IN [M..1-M] THEN EXIT;
FracOut[U];
ENDLOOP;
IF 2*R<=1 THEN FracOut[U]
ELSE FracOut[U+1];
END;
END;
PrintIt[];
END; --end of WriteFloat
-- Take apart a REAL so that m*2↑e = r
Unpack: PROCEDURE [r: REAL] RETURNS [e: INTEGER, m: LONG INTEGER] =
BEGIN
minus: BOOLEAN ← r<0;
w: LongNumber;
IF minus THEN r ← -r;
w ← LOOPHOLE[r, LongNumber];
e ← BITAND[377B, BITSHIFT[w.highbits, -7]] - 128 - 24;
w.highbits ← BITOR[200B, BITAND[177B, w.highbits]];
m ← IF minus THEN -w.li ELSE w.li;
END;
-- Multiply a REAL by a power of 2
Scale: PROCEDURE [r: REAL, se: INTEGER] RETURNS [REAL] =
BEGIN
f: FloatNum;
minus: BOOLEAN ← r<0;
exp: INTEGER;
IF minus THEN r ← -r;
f ← LOOPHOLE[r, FloatNum];
exp ← f.exp+se;
IF exp<=0 THEN RETURN[LOOPHOLE[FloatNum[0,0,1,0], REAL]];
IF exp>377B THEN
BEGIN
IF minus THEN RETURN[LOOPHOLE[20000000001B, REAL]]
ELSE RETURN[LOOPHOLE[17777777777B, REAL]];
END;
f.exp ← exp;
r ← LOOPHOLE[f, REAL];
IF minus THEN r ← -r;
RETURN[r];
END;
-- Return integer part of a REAL Modulo something
FMod: PROCEDURE [r: REAL, m: LONG INTEGER] RETURNS [LONG INTEGER] =
BEGIN
int: LONG INTEGER ← Fix[r ! FloatingPointError => GOTO GiveUp];
RETURN[int MOD m]
EXITS
GiveUp => RETURN[0];
END;
-- Return fraction part of a REAL
Fraction: PROCEDURE [r: REAL] RETURNS [REAL] =
BEGIN
t: LONG INTEGER ← Fix[r ! FloatingPointError => GOTO GiveUp];
RETURN[r-t];
EXITS
GiveUp => RETURN[0];
END;
StringToRealNumber: PUBLIC PROCEDURE [ s: STRING ] RETURNS [REAL] =
BEGIN
stringIndex: CARDINAL ← 0;
CharProcString: PROCEDURE RETURNS[ CHARACTER ] =
BEGIN
IF stringIndex=s.length THEN RETURN [IODefs.DEL]
ELSE
BEGIN
ch: CHARACTER ← s[stringIndex];
stringIndex ← stringIndex+1;
RETURN[ch];
END;
END;
RETURN [StreamToFloat[ CharProcString ]];
END;
StreamToFloat: PRIVATE PROCEDURE [
charProc: PROCEDURE RETURNS [ CHARACTER ]
] RETURNS [REAL] =
BEGIN ENABLE FloatingPointError => RESUME;
InsideProc: PROCEDURE RETURNS [REAL] =
BEGIN
expPartV: INTEGER ← 0;
val, intVal, fracVal, rcVal, expVal: REAL ← Zero;
fracExp: REAL ← One;
minus, expMinus: BOOLEAN ← FALSE;
mode: {firstSymbol, intPart, fracPart, firstExpSymbol, expPart} ← firstSymbol;
cVal: INTEGER;
c: CHARACTER;
DO
c ← charProc[];
cVal ← LOOPHOLE[c-’0, INTEGER];
rcVal ← cVal;
SELECT c FROM
’ , CR, TAB => SELECT mode FROM
firstSymbol => NULL;
ENDCASE => EXIT;
’+ => SELECT mode FROM
firstSymbol => mode ← intPart;
firstExpSymbol => mode ← expPart;
ENDCASE => EXIT;
’- => SELECT mode FROM
firstSymbol =>
BEGIN minus ← TRUE; mode ← intPart; END;
firstExpSymbol =>
BEGIN expMinus ← TRUE; mode ← expPart; END;
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 =>
BEGIN
mode ← intPart;
intVal ← intVal*Ten + rcVal;
END;
fracPart =>
BEGIN
fracVal ← fracVal*Ten + rcVal;
fracExp ← fracExp*Ten;
END;
firstExpSymbol, expPart =>
BEGIN
mode ← expPart;
expPartV ← expPartV*10 + cVal;
END;
ENDCASE => EXIT;
ENDCASE => EXIT;
ENDLOOP;
-- now put it together
expVal ← One;
THROUGH [1..expPartV] DO
expVal ← expVal*Ten;
ENDLOOP;
val ← intVal+(fracVal/fracExp);
val ← IF expMinus THEN val/expVal ELSE val*expVal;
IF minus THEN val ← -val;
RETURN [val];
END;
RETURN[InsideProc[]];
END;
END.