-- FloatMCTest.mesa
-- Copywrite Xerox Corporation 1980
-- Program to check out new Floating arithmetic
-- Last Modified: LStewart May 27, 1980 12:54 PM
DIRECTORY
InlineDefs: FROM "InlineDefs",
IODefs: FROM "IODefs",
Mopcodes: FROM "Mopcodes",
RealDefs: FROM "RealDefs",
WF: FROM "WF";
FloatMCTest: PROGRAM
IMPORTS InlineDefs, IODefs, RealDefs, WF =
BEGIN OPEN InlineDefs, IODefs, RealDefs, WF;
FloatNum: TYPE = RECORD
[m2: CARDINAL, sign:[0..1], exp:[0..400B), m1:[0..200B)];
place: ARRAY [0..6) OF CARDINAL;
pplace: POINTER TO UNSPECIFIED ← LOOPHOLE[720B];
a, b, x: REAL;
q: LONG INTEGER;
c: CHARACTER;
uLocMulT: CARDINAL = 446B;
uLocDivT: CARDINAL = 447B;
imode: BOOLEAN ← TRUE;
binmode: BOOLEAN ← FALSE;
errmsg: ARRAY FloatingError OF STRING ←
[
"noError",
"FixExponentOverflow",
"ExponentOverflow",
"DivideBy0"
];
BEGIN
-- These two routines are for looking at the 16 bit integer multiply and divide parts of the float microcode. The appropriate access sections follow:

-- %1,1777,446,ucMulT;Multiply Test
-- %1,1777,447,ucDivT;Subtract Test
-- ; This routine is MulT
--
-- !7,10,MulRet,MulRet1,MulRet2,MulRet3,MulRet4;
-- ucMulT: L←stk0,TASK;
-- Arg0←L;
-- L←stk1,TASK;
-- Arg1←L;
-- L←stk2,TASK;
-- Arg2←L;
-- L←4,:MUL;
-- MulRet4: L←Arg0,TASK;
-- stk0←L;
-- L←Arg1,TASK;
-- stk1←L,:ret;
--
-- ; This routine is DivT
--
-- !7,10,DivRet,DivRet1,DivRet2,DivRet3;
-- ucDivT: L←stk0,TASK;
-- Arg0←L;
-- L←stk1,TASK;
-- Arg1←L;
-- L←stk2,TASK;
-- Arg2←L;
-- L←3,:DIV;
--
-- DivRet3: L←Arg0,TASK;
-- stk0←L;
-- L←Arg1,TASK;
-- stk1←L,:ret;
WFpR: PROCEDURE [p: UNSPECIFIED, form:STRING, wp: PROCEDURE[CHARACTER]] =
BEGIN
fp: POINTER TO REAL ← p;
WriteNum[fp↑];
END;
zMulT: PROCEDURE [a,b,c: CARDINAL] RETURNS [d,e: CARDINAL] =
MACHINE CODE BEGIN
Mopcodes.zLIW, uLocMulT/256, uLocMulT MOD 256;
Mopcodes.zJRAM;
END;
zDivT: PROCEDURE [a,b,c: CARDINAL] RETURNS [d,e: CARDINAL] =
MACHINE CODE BEGIN
Mopcodes.zLIW, uLocDivT/256, uLocDivT MOD 256;
Mopcodes.zJRAM;
END;
WriteNum: PROCEDURE [x: REAL] =
BEGIN
mf: FloatNum;
IF NOT imode THEN WriteFloat[x];
WF0[" "];
mf ← LOOPHOLE[x, FloatNum];
-- WF4[" sgn: %1d, exp: %3bB, m1: %3bB, m2: %6bB*n",mf.sign, mf.exp, mf.m1+200B, mf.m2];
WF0[" em: "];
PrintReal[x];
-- WF4[" S1: %6bB, E1: %6bB, M1: %6bB, N1: %6bB*n",place[0], place[1], place[2], place[3]];
END;
PrintReal: PROCEDURE [v: REAL] =
BEGIN
man: 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;
SqRt: PUBLIC PROCEDURE [x: REAL] RETURNS [REAL] =
BEGIN
magic: CARDINAL ← 200B-22;
t1,t2,t3,t4,y,x1,epsilon: REAL;
fl: FloatNum;
IF x <= 0 THEN RETURN[0];
WF1["arg: %R*n",@x];
fl ← LOOPHOLE[x,FloatNum];
fl.exp ← (fl.exp - 200B)/2 +200B;
y ← LOOPHOLE[fl,REAL];--initial guess = half original exponent
fl ← [sign: 0,exp: magic,m1: 0,m2: 0];
epsilon ← LOOPHOLE[fl,REAL];
WF1["epsilon: %R*n",@epsilon];
WF1["init guess: %R*n",@y];
DO
x1 ← y*y;
WF1["guess,sq: %R*n",@x1];
t1 ← x1-x;
WF1["error: %R*n",@t1];
t2 ← 2*y;
WF1["guessX2: %R*n",@t2];
t3 ← (t1/t2);--slope of the curve here is 1/2
WF1["correction: %R*n",@t3];
y←y-t3;--slope of the curve here is 1/2
WF1["new guess: %R*n",@y];
t4 ← t1/x;
WF1["pct err: %R*n",@t4];
IF ABS[t4] <= ABS[epsilon] THEN EXIT;
ENDLOOP;
RETURN[y];
END;
ReadReal: PROCEDURE RETURNS [v: REAL] =
BEGIN
s: STRING ← [50];
eok, esign, sign: BOOLEAN;
exp: INTEGER;
i: CARDINAL;
man: LongNumber;
mf: FloatNum;
DO
eok ← esign ← sign ← FALSE;
s.length←0;
exp ← 0;
man.lc ← 0;
ReadID[s];
i ← 0;
WHILE i<s.length DO
SELECT s[i] FROM
’- => sign←TRUE;
’+ => sign←FALSE;
’e => BEGIN
WHILE i<s.length DO
SELECT s[i] FROM
’- => BEGIN esign ← eok ← TRUE; END;
’+ => BEGIN esign ← FALSE; eok ← TRUE; END;
IN [’0..’9] => BEGIN
exp ← exp*10+(s[i]-’0);
eok ← TRUE;
END;
ENDCASE => BEGIN
IF eok THEN EXIT;
END;
i ← i+1;
ENDLOOP;
END;
IN [’0..’7] => man.lc ← man.lc*10B + (s[i]-’0);
ENDCASE;
i ← i+1;
ENDLOOP;
IF (exp NOT IN[0..127]) OR (man.lc#0 AND BITAND[man.highbits,200B]=0) THEN
BEGIN
WF0["*n[-]e[-]Exponent(10).Mantissa(8 octal digits)*n"];
END
ELSE EXIT;
ENDLOOP;
IF man.lc=0 THEN RETURN[0];
IF esign THEN exp←0-exp;
mf.exp ← BITAND[exp+128,377B];
mf.m1 ← BITAND[man.highbits,177B];
mf.m2 ← man.lowbits;
IF sign THEN
BEGIN
man.lc ← LOOPHOLE[mf,LONG CARDINAL];
man.li ← 0-man.li;
v ← LOOPHOLE[man.lc,REAL];
END
ELSE v ← LOOPHOLE[mf,REAL];
WF0["*n val= "];
PrintReal[v];
WF0["*n"];
END;
ReadLongDecimal: PROCEDURE RETURNS[z: LONG INTEGER] =
BEGIN
ch: CHARACTER;
sign: BOOLEAN ← FALSE;
z ← 0;
DO
ch ← ReadChar[];
WriteChar[ch];
SELECT ch FROM
’- => sign ← TRUE;
’+ => sign ← FALSE;
IN [’0..’9] => z ← (z*10)+(ch-’0);
ENDCASE => EXIT;
ENDLOOP;
IF sign THEN RETURN[0-z];
END;
ReadArgs: PROCEDURE RETURNS[a, b: REAL] =
BEGIN
WF0[" a: "];
IF binmode THEN a ← ReadReal[]
ELSE IF imode THEN a ← ReadDecimal[] ELSE a ← ReadFloat[];
WF0[" b: "];
IF binmode THEN b ← ReadReal[]
ELSE IF imode THEN b ← ReadDecimal[] ELSE b ← ReadFloat[];
END;
-- Mainline code
-- This pplace stuff is for a version of the float microcode which stored the internal representation in 4 words pointed to by location 720B. The appropriate code fragment follows:

--RePack:
--T←DASTART; this code for debugging
--L←300+T;
--MAR←LastL; save unpacked arg according to pointer in 720
--NOP;
--L←MD,TASK;
--Temp←L;
--MAR←Temp;
--L←Temp+1;
--Temp←L,TASK;
--MD←S1;
--MAR←Temp;
--L←Temp+1;
--Temp←L,TASK;
--MD←E1;
--MAR←Temp;
--L←Temp+1;
--Temp←L,TASK;
--MD←M1;
--MAR←Temp;
--L←Temp+1;
--Temp←L,TASK;
--MD←N1;
-- pplace↑ ← BASE[place];
SetCode[ ’R, WFpR];
SetCode[ ’F, WFWriteFloat];
WF0["*nFunction (add, imode, subtract, multiply, divide, fix, Float)*n"];
WF0["if imode is ON, ReadFloat and WriteFloat won’t be called*n"];
DO ENABLE FloatingPointError =>
BEGIN
WF1["*n%s*n",errmsg[f]];
-- CONTINUE;
RESUME;
END;
place[0] ← place[1] ← place[2] ← place[3] ← 52525B;
WF0["uct: "];
c ← IODefs.ReadChar[];
SELECT c FROM
’a =>
BEGIN
WF0["Add: "];
[a,b] ← ReadArgs[];
x ← a + b;
WF1[" Sum = %R*n",@x];
END;
’c =>
BEGIN
WF0["Compare: "];
[a,b] ← ReadArgs[];
IF a<b THEN WF0[" a less than b*n"];
IF a=b THEN WF0[" a equals b*n"];
IF a>b THEN WF0[" a greater than b*n"];
END;
’b =>
BEGIN
WF0["Binary Mode "];
binmode ← NOT binmode;
IF binmode THEN WF0["ON*n"] ELSE WF0["OFF*n"];
END;
’i =>
BEGIN
WF0["Integer Mode "];
imode ← NOT imode;
IF imode THEN WF0["ON*n"] ELSE WF0["OFF*n"];
END;
’s =>
BEGIN
WF0["Subtract: "];
[a,b] ← ReadArgs[];
x ← a - b;
WF1[" Difference = %R*n",@x];
END;
’M => IF FALSE THEN -- commented out
BEGIN
i,j,k,x,y: CARDINAL;
z: LONG CARDINAL;
WF0["Fixed Multiply (A+(B*C)): "];
WF0["A: "];
i ← ReadDecimal[];
WF0["B: "];
j ← ReadDecimal[];
WF0["C: "];
k ← ReadDecimal[];
[x,y] ← zMulT[i,j,k];
z ← (x*65536)+y;
WF1[" Result = %ld*n",@z];
END;
’D => IF FALSE THEN -- commented out
BEGIN
i,j,k,x,y: CARDINAL;
z: LONG CARDINAL;
WF0["Fixed Divide (A/B): "];
WF0[" A: "];
z ← ReadLongDecimal[];
WF1["(= %ld)",@z];
WF0[" B: "];
i ← ReadDecimal[];
j ← HighHalf[z];
k ← LowHalf[z];
WF0[" Product = "];
[x,y] ← zDivT[j,k,i];
WF2[" Quotient = %d, remainder = %d*n", y, x];
END;
’m =>
BEGIN
WF0["Multiply: "];
[a,b] ← ReadArgs[];
x ← a * b;
WF1[" Product = %R*n",@x];
END;
’d =>
BEGIN
WF0["Divide: "];
[a,b] ← ReadArgs[];
x ← a / b;
WF1[" Quotient = %R*n",@x];
END;
’f =>
BEGIN
WF0["Fix: "];
x ← IF imode THEN ReadDecimal[] ELSE ReadFloat[];
q ← Fix[x];
WF2[" Fix: %iB Float: %R*n", @q,@x];
END;
’F =>
BEGIN
WF0["Float: (16 bit integer) "];
q ← ReadLongDecimal[];
x ← q; -- float
WF2[" Fix: %ld, Float: %R*n", @q, @x];
END;
’S =>
BEGIN
WF0["SqRt: "];
a ← IF binmode THEN ReadReal[] ELSE ReadFloat[];
x ← SqRt[a];
WriteNum[x];
END;
ENDCASE;
ENDLOOP;
END;
END.