-- FloatIOTest.mesa

-- Copywrite Xerox Corporation 1980

-- Program to check out new Floating arithmetic IO

-- Last Modified: LStewart May 27, 1980 12:51 PM

DIRECTORY

InlineDefs: FROM "InlineDefs",

IODefs: FROM "IODefs",

RealDefs: FROM "RealDefs",

StringDefs: FROM "StringDefs",

WF: FROM "WF";

FloatIOTest: PROGRAM

IMPORTS IODefs, RealDefs, StringDefs, WF =

BEGIN OPEN IODefs, RealDefs, StringDefs, WF;

FloatNum: TYPE = RECORD
[m2: CARDINAL, sign:[0..1], exp:[0..400B), m1:[0..200B)];

a: REAL;

c: CHARACTER;

errmsg: ARRAY FloatingError OF STRING ←
[
"noError",
"FixExponentOverflow",
"ExponentOverflow",
"DivideBy0"
];

BEGIN

WFpR: PROCEDURE [p: UNSPECIFIED, form:STRING, wp: PROCEDURE[CHARACTER]] =

BEGIN

fp: POINTER TO REAL ← p;

WriteNum[fp↑];

END;

WriteNum: PROCEDURE [x: REAL] =

BEGIN

mf: FloatNum;

mf ← LOOPHOLE[x, FloatNum];

WF0[" em: "];

PrintReal[x];

END;

PrintReal: PROCEDURE [v: REAL] =

BEGIN

man: InlineDefs.LongNumber;

sign: BOOLEAN;

exp: INTEGER;

mf: FloatNum;

mf ← LOOPHOLE[v, FloatNum];

sign ← mf.sign=1;

IF sign THEN

BEGIN

man.lc ← LOOPHOLE[v,LONG CARDINAL];

man.li ← 0-man.li;

v ← LOOPHOLE[man.lc, REAL];

mf ← LOOPHOLE[v, FloatNum];

END;

man.lowbits ← mf.m2;

man.highbits ← mf.m1+0200B;

IF mf.exp=0 THEN

BEGIN

sign ← FALSE;

exp ← 0;

man.lc←0;

END

ELSE exp ← mf.exp-128;

WF0[IF sign THEN "- " ELSE " "];

-- mantissa should print as 8 octal digits

WF2["e%4d m.%lb", exp, @man.lc];

END;

-- Mainline code

SetCode[ ’R, WFpR];

SetCode[ ’F, WFWriteFloat];

SetCode[ ’E, WFWriteEFloat];

-- WF0["*nFunction (add, imode, subtract, multiply, divide, fix, Float)*n"];

c ← ’a;

DO ENABLE FloatingPointError =>

BEGIN

WF1["*n%s*n",errmsg[f]];

RESUME;

END;

WF0["> "];

-- c ← IODefs.ReadChar[];

-- SELECT c FROM

-- ’i =>

BEGIN

f: STRING ← [20];

s: STRING ← [60];

WF0[":"];

a ← ReadFloat[];

WF0[" form: "];

ReadID[f];

AppendString[s," =*nr: |%R|*nf: |%"];

AppendString[s,f];

AppendString[s,"F|*ne: |%"];

AppendString[s,f];

AppendString[s,"E|*n"];

WF3[s,@a,@a,@a];

WriteNum[a];

WF0["*n"];

END;

-- ENDCASE;

ENDLOOP;

END;

END.