-- Mesa-Float.mesa
-- Copywrite Xerox Corporation 1980
-- Mesa implementation of floating point ops
-- Last Modified: LStewart February 26, 1980 1:46 PM
DIRECTORY
InlineDefs: FROM "InlineDefs",
Mopcodes: FROM "Mopcodes",
RealDefs: FROM "RealDefs",
SDDefs: FROM "SDDefs";
Float: PROGRAM
IMPORTS InlineDefs
EXPORTS RealDefs =
BEGIN OPEN InlineDefs, RealDefs;
HiBit: CARDINAL = 100000B;
NotHiBit: CARDINAL = 077777B;
ExponentBias: INTEGER = 128;
ExponentMask: INTEGER = 077600B;
ExponentShift: INTEGER = 7;
ExpSingleMax: INTEGER = 127;
ExpSingleMin: INTEGER = -127;
SingleRound: LONG INTEGER = 0200B;
PlusZero: REAL = LOOPHOLE[LONG[0]];
MinusZero: REAL = LOOPHOLE[LONG[0]];
PlusInfinity: REAL = LOOPHOLE[LAST[LONG INTEGER]];
MinusInfinity: REAL = LOOPHOLE[-LAST[LONG INTEGER]];
Extended: TYPE = RECORD
[
sign: BOOLEAN,
exp: INTEGER,
frac: LongNumber
];
FloatingPointError: PUBLIC SIGNAL[f: RealDefs.FloatingError] = CODE;
-- Add with Carry
ADC3: PROCEDURE [a, b, c: CARDINAL] RETURNS [CARDINAL, CARDINAL] = INLINE
BEGIN
s: LongNumber;
s.lc ← LONG[a]+LONG[b]+LONG[c];
RETURN[s.highbits, s.lowbits];
END;
-- Add two shorts to make a long
ADC2: PROCEDURE [a, b: CARDINAL] RETURNS [CARDINAL, CARDINAL] = INLINE
BEGIN
s: LongNumber;
s.lc ← LONG[a]+LONG[b];
RETURN[s.highbits, s.lowbits];
END;
LN: PROCEDURE [r: LONG UNSPECIFIED] RETURNS [LongNumber] = INLINE
BEGIN
RETURN[LOOPHOLE[r, LongNumber]];
END;
-- Separate the packed REAL into its component elements
Unpack: PROCEDURE [r: REAL, z: POINTER TO Extended] = INLINE
BEGIN
z.sign ← LOOPHOLE[LN[r].highbits, INTEGER]<0;
z.frac.li ← IF z.sign THEN -LN[r].li ELSE LN[r].li; -- Two’s complement sign.
z.exp ← BITSHIFT[BITAND[z.frac.highbits, ExponentMask], -ExponentShift];
-- True zero is zero exponent here...
IF z.exp=0 THEN z.frac.lc ← 0
ELSE
BEGIN
z.exp ← z.exp-ExponentBias;
-- my own inline, z.frac ← LongShift[z.frac, 8];
z.frac.highbits ← BITOR[BITSHIFT[z.frac.highbits, 8], HiBit] + BITSHIFT[z.frac.lowbits, -8];
z.frac.lowbits ← BITSHIFT[z.frac.lowbits, 8];
END;
END;
-- Stuff the components back into the packed REAL. Manage overflow, rounding, etc.
Pack: PROCEDURE [z: POINTER TO Extended] RETURNS [REAL] = INLINE
BEGIN
-- Check for Zero
IF z.frac.highbits=0 THEN RETURN [IF z.sign THEN MinusZero ELSE PlusZero];
-- Round
z.frac.lc ← z.frac.lc+SingleRound;
IF LOOPHOLE[z.frac.highbits, INTEGER]>=0 THEN
BEGIN
z.frac ← RSHIFT1[z.frac];
-- we don’t really need to set HiBit, since it is cleared below
-- z.frac.highbits ← BITOR[z.frac.highbits, HiBit];
z.exp ← z.exp+1;
END;
-- Check for overflow conditions.
IF z.exp<ExpSingleMin THEN RETURN [IF z.sign THEN MinusZero ELSE PlusZero];
IF z.exp>ExpSingleMax THEN
BEGIN
SIGNAL FloatingPointError[ExponentOverflow];
RETURN [IF z.sign THEN MinusInfinity ELSE PlusInfinity];
END;
-- my own inline version, z.frac ← LongShift[z.frac, -8];
z.frac.lowbits ← BITSHIFT[z.frac.highbits, 8] +BITSHIFT[z.frac.lowbits, -8];
-- clear hidden bit at same time
z.frac.highbits ← BITSHIFT[BITAND[z.frac.highbits, NotHiBit], -8];
z.frac.highbits ← BITOR[z.frac.highbits, BITSHIFT[z.exp+ExponentBias, ExponentShift]];
RETURN [LOOPHOLE[IF z.sign THEN -z.frac.li ELSE z.frac.li, REAL]];
END;
-- Post Normalize
PostNormalize: PROCEDURE [x: POINTER TO Extended] = INLINE
BEGIN
IF x.frac.lc=0 THEN x.exp ← 0
ELSE
WHILE LOOPHOLE[x.frac.highbits, INTEGER]>=0 DO
-- x.frac ← LongShift[x.frac, 1];
x.frac.lc ← x.frac.lc+x.frac.lc;
x.exp ← x.exp-1;
ENDLOOP;
END;
-- Works only to right (count<0 is to right)
LongShift: PROCEDURE [y: LongNumber, count: INTEGER] RETURNS [LongNumber] = INLINE
BEGIN
SELECT count FROM
IN (-16..0) =>
BEGIN
y.lowbits ← BITSHIFT[y.lowbits, count] + BITSHIFT[y.highbits,count+16];
y.highbits ← BITSHIFT[y.highbits, count];
END;
IN (-32..-16] => y ← LongNumber[num[highbits: 0, lowbits: BITSHIFT[y.highbits,count+16]]];
0 => NULL;
<= -32 => RETURN[LongNumber[lc[lc: 0]]];
ENDCASE => ERROR;
RETURN[y];
END;
RSHIFT1: PROCEDURE [y: LongNumber] RETURNS [LongNumber] = INLINE
BEGIN
y.lowbits ← BITSHIFT[y.lowbits, -1];
IF BITAND[y.highbits, 1]#0 THEN y.lowbits ← BITOR[y.lowbits, HiBit];
y.highbits ← BITSHIFT[y.highbits, -1];
RETURN[y];
END;
AddCommon: PROCEDURE [x, y: Extended] RETURNS [REAL] = INLINE
BEGIN
ediff: INTEGER ← x.exp-y.exp;
IF ediff>0 THEN y.frac ← LongShift[y.frac, -ediff]
ELSE
BEGIN
x.frac ← LongShift[x.frac, ediff];
x.exp ← y.exp;
END;
IF x.sign#y.sign THEN
BEGIN
IF x.frac.lc>=y.frac.lc THEN x.frac.lc ← x.frac.lc-y.frac.lc
ELSE
BEGIN
x.frac.lc ← y.frac.lc-x.frac.lc;
x.sign ← y.sign;
END;
PostNormalize[@x];
END
ELSE
BEGIN
cy: CARDINAL;
[cy, x.frac.lowbits] ← ADC2[x.frac.lowbits, y.frac.lowbits];
[cy, x.frac.highbits] ← ADC3[x.frac.highbits, y.frac.highbits, cy];
IF cy#0 THEN
BEGIN
-- x.frac ← RSHIFT1[x.frac];
x.frac.lowbits ← BITSHIFT[x.frac.lowbits, -1];
IF BITAND[x.frac.highbits, 1]#0 THEN x.frac.lowbits ← BITOR[x.frac.lowbits, HiBit];
x.frac.highbits ← BITOR[BITSHIFT[x.frac.highbits, -1], HiBit];
x.exp ← x.exp+1;
END;
END;
RETURN [Pack[@x]];
END;
FADD: PUBLIC PROCEDURE [a, b: REAL] RETURNS [REAL] =
BEGIN
x, y: Extended;
Unpack[a, @x];
IF x.frac.lc=0 THEN RETURN[b];
Unpack[b, @y];
IF y.frac.lc=0 THEN RETURN[a];
RETURN [AddCommon[x, y]];
END;
FSUB: PUBLIC PROCEDURE [a, b: REAL] RETURNS [REAL] =
BEGIN
-- Negate b
LOOPHOLE[b, LONG INTEGER] ← -LOOPHOLE[b, LONG INTEGER];
RETURN [FADD[a,b]];
END;
FMUL: PUBLIC PROCEDURE [a, b: REAL] RETURNS [REAL] =
BEGIN
x, y: Extended;
hi, lo, temp: LongNumber;
cy: CARDINAL;
Unpack[a, @x];
Unpack[b, @y];
x.sign ← x.sign#y.sign;
x.exp ← x.exp+y.exp;
-- x.frac.lc ← MedMultiply[x.frac, y.frac];
lo.lc ← LongMult[x.frac.lowbits, y.frac.lowbits];
hi.lc ← LongMult[x.frac.highbits, y.frac.highbits];
temp.lc ← LongMult[x.frac.highbits, y.frac.lowbits];
[cy, lo.highbits] ← ADC2[lo.highbits, temp.lowbits];
hi.lc ← hi.lc+temp.highbits+cy;
temp.lc ← LongMult[y.frac.highbits, x.frac.lowbits];
[cy, lo.highbits] ← ADC2[lo.highbits, temp.lowbits];
x.frac.lc ← hi.lc+temp.highbits+cy;
-- normalize
PostNormalize[@x];
RETURN [Pack[@x]];
END;
FDIV: PUBLIC PROCEDURE [a, b: REAL] RETURNS [c: REAL] =
BEGIN
x, y: Extended;
lctemp: LongNumber;
Unpack[a, @x];
Unpack[b, @y];
x.sign ← x.sign#y.sign;
IF y.frac.lc=0 THEN
BEGIN
SIGNAL FloatingPointError[DivideBy0];
RETURN [IF x.sign THEN MinusInfinity ELSE PlusInfinity];
END;
IF x.frac.lc=0 THEN RETURN[IF x.sign THEN MinusZero ELSE PlusZero];
x.exp ← x.exp-y.exp;
-- Divide overflow correction
IF x.frac.highbits>=y.frac.highbits THEN
BEGIN
x.frac ← RSHIFT1[x.frac];
x.exp ← x.exp+1;
END;
[quotient: x.frac.highbits, remainder: x.frac.lowbits] ← LongDivMod[num: x.frac.lc, den: y.frac.highbits];
[quotient: x.frac.lowbits] ← LDIVMOD[numlow: 0, numhigh: x.frac.lowbits, den: y.frac.highbits];
lctemp.lc ← LongMult[x.frac.highbits, y.frac.lowbits];
IF lctemp.highbits>=y.frac.highbits THEN
BEGIN
x.frac.highbits ← x.frac.highbits-1;
lctemp.highbits ← lctemp.highbits-y.frac.highbits;
END;
x.frac.lc ← x.frac.lc-LongDiv[num: lctemp.lc, den: y.frac.highbits];
PostNormalize[@x];
RETURN[Pack[@x]];
END;
FLOAT: PUBLIC PROCEDURE [a: LONG INTEGER] RETURNS [REAL] =
BEGIN
x: Extended;
x.sign ← a<0;
x.frac.li ← IF x.sign THEN -a ELSE a;
IF x.frac.highbits=0 THEN -- speed trick
BEGIN
x.frac.highbits ← x.frac.lowbits;
x.frac.lowbits ← 0;
x.exp ← 16;
END
ELSE x.exp ← 32;
PostNormalize[@x];
RETURN[Pack[@x]];
END;
Fix: PUBLIC PROCEDURE [a: REAL] RETURNS [LONG INTEGER] =
BEGIN
x: Extended;
Unpack[a, @x];
IF x.exp<1 THEN RETURN[0];
IF x.exp>31 THEN
BEGIN
SIGNAL FloatingPointError[FixRangeOverflow];
RETURN [IF x.sign THEN FIRST[LONG INTEGER] ELSE LAST[LONG INTEGER]];
END;
x.frac ← LongShift[x.frac, x.exp-32];
RETURN [IF x.sign THEN -x.frac.li ELSE x.frac.li];
END;
FixI: PUBLIC PROCEDURE [a: REAL] RETURNS [c: INTEGER] =
BEGIN
x: Extended;
Unpack[a, @x];
IF x.exp<1 THEN RETURN[0];
IF x.exp>15 THEN
BEGIN
SIGNAL FloatingPointError[FixRangeOverflow];
RETURN [IF x.sign THEN FIRST[INTEGER] ELSE LAST[INTEGER]];
END;
c ← BITSHIFT[x.frac.highbits, x.exp-16];
IF x.sign THEN RETURN[-c];
END;
FixC: PUBLIC PROCEDURE [a: REAL] RETURNS [CARDINAL] =
BEGIN
x: Extended;
Unpack[a, @x];
IF x.exp<1 THEN RETURN[0];
IF x.exp>16 THEN
BEGIN
SIGNAL FloatingPointError[FixRangeOverflow];
RETURN [LAST[CARDINAL]];
END;
IF x.sign THEN
BEGIN
SIGNAL FloatingPointError[FixRangeOverflow];
RETURN [FIRST[CARDINAL]];
END;
RETURN[BITSHIFT[x.frac.highbits, x.exp-16]];
END;
FCOMP: PROCEDURE [a,b: REAL] RETURNS [INTEGER] =
BEGIN
RETURN [zFComp[a,b]];
END;
zFComp: PROCEDURE [a,b: REAL] RETURNS [INTEGER] =
MACHINE CODE BEGIN Mopcodes.zDCOMP; END;
InitFloat: PUBLIC PROCEDURE =
BEGIN
SDDefs.SD[SDDefs.sFADD] ← FADD;
SDDefs.SD[SDDefs.sFSUB] ← FSUB;
SDDefs.SD[SDDefs.sFMUL] ← FMUL;
SDDefs.SD[SDDefs.sFDIV] ← FDIV;
SDDefs.SD[SDDefs.sFCOMP] ← FCOMP;
SDDefs.SD[SDDefs.sFLOAT] ← FLOAT;
SDDefs.SD[SDDefs.sFIX] ← Fix;
END;
-- Mainline Code
InitFloat[];
END.