-- FloatFixTest.mesa

-- Copywrite Xerox Corporation 1980

-- Program to check out new Floating arithmetic

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

DIRECTORY

IODefs: FROM "IODefs",

RealDefs: FROM "RealDefs",

WF: FROM "WF";

FloatFixTest: PROGRAM

IMPORTS RealDefs, IODefs, WF =

BEGIN OPEN RealDefs, IODefs, WF;

x: REAL;

i: INTEGER;

c: CARDINAL;

q: LONG INTEGER;

ch: CHARACTER;

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

BEGIN

MainP: PROCEDURE =

BEGIN

SELECT ch FROM

’c =>

BEGIN

WF0["Fix to Cardinal: "];

x ← ReadFloat[];

c ← FixC[x];

WF2["*nFix: %u Float: %F*n", c,@x];

END;

’i =>

BEGIN

WF0["Fix to Integer: "];

x ← ReadFloat[];

i ← FixI[x];

WF2["*nFix: %d Float: %F*n", i,@x];

END;

’f =>

BEGIN

WF0["Fix to LongInteger: "];

x ← ReadFloat[];

q ← Fix[x];

WF2["*nFix: %lbB Float: %F*n", @q,@x];

END;

ENDCASE;

END;

-- Mainline code

SetCode[ ’F, WFWriteFloat];

WF0["*nFunction: Fix to Integer, Cardinal. LongInteger*n"];

DO ENABLE FloatingPointError =>

BEGIN

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

RESUME;

END;

WF0[": "];

ch ← IODefs.ReadChar[];

MainP[];

ENDLOOP;

END;

END. --of FloatFixTest