-- IeeeFloatB.mesa
-- Last Modified: August 27, 1982 11:27 am
-- Mesa implementation of floating point ops
DIRECTORY
Ieee,
Inline USING [BITAND, BITOR, LowHalf],
Mopcodes USING [zDCOMP],
Real,
RealOps;
IeeeFloatB: PROGRAM IMPORTS Ieee, Inline, Real EXPORTS Ieee, RealOps =
BEGIN OPEN Ieee, Real, RealOps;
sqGuesses: ARRAY[0..32) OF REAL ← [
LOOPHOLE[7715741440B, REAL],
LOOPHOLE[7717240700B, REAL],
LOOPHOLE[7720514140B, REAL],
LOOPHOLE[7721745140B, REAL],
LOOPHOLE[7723155200B, REAL],
LOOPHOLE[7724346000B, REAL],
LOOPHOLE[7725517500B, REAL],
LOOPHOLE[7726654000B, REAL],
LOOPHOLE[7727773400B, REAL],
LOOPHOLE[7731077100B, REAL],
LOOPHOLE[7732167300B, REAL],
LOOPHOLE[7733245000B, REAL],
LOOPHOLE[7734310400B, REAL],
LOOPHOLE[7735342500B, REAL],
LOOPHOLE[7736363400B, REAL],
LOOPHOLE[7737373700B, REAL],
LOOPHOLE[7740370240B, REAL],
LOOPHOLE[7741351440B, REAL],
LOOPHOLE[7742314540B, REAL],
LOOPHOLE[7743243000B, REAL],
LOOPHOLE[7744155200B, REAL],
LOOPHOLE[7745054400B, REAL],
LOOPHOLE[7745741300B, REAL],
LOOPHOLE[7746614600B, REAL],
LOOPHOLE[7747457040B, REAL],
LOOPHOLE[7750310640B, REAL],
LOOPHOLE[7751132500B, REAL],
LOOPHOLE[7751745000B, REAL],
LOOPHOLE[7752550100B, REAL],
LOOPHOLE[7753344400B, REAL],
LOOPHOLE[7754132600B, REAL],
LOOPHOLE[7754712500B, REAL]];
FComp: PUBLIC SAFE PROC [a, b: REAL, m: Mode] RETURNS [INTEGER] = TRUSTED {
x, y: Ieee.Ext;
{
fpmode ← m;
thisTimeExceptions ← Real.NoExceptions;
x ← Ieee.Unpack[a];
y ← Ieee.Unpack[b];
IF Ieee.BitOn[funny, Inline.BITOR[x.det, y.det]] THEN
SELECT TRUE FROM
x.det.type = nan => GOTO InvX;
y.det.type = nan => GOTO InvY;
x.det.type # infinity AND y.det.type # infinity => NULL;
x.det.type = infinity AND y.det.type = infinity =>
IF fpmode.im = projective OR x.det.sign = y.det.sign THEN GOTO Equal
ELSE GOTO XSign;
fpmode.im = projective => GOTO InvX;
x.det.type = infinity => GOTO XSign;
y.det.type = infinity => GOTO YSign;
ENDCASE => ERROR
ELSE
SELECT Ieee.NormalType[x.det, y.det] FROM
TNnn => NULL;
TNnz => GOTO XSign;
TNzn => GOTO YSign;
TNzz => GOTO Equal;
ENDCASE => ERROR;
IF x.det.sign # y.det.sign THEN GOTO XSign;
IF x.det.sign THEN
BEGIN
LOOPHOLE[a, LONG INTEGER] ← MagicLI - LN[a].li;
LOOPHOLE[b, LONG INTEGER] ← MagicLI - LN[b].li;
END;
EXITS
XSign => RETURN[IF x.det.sign THEN -1 ELSE 1];
YSign => RETURN[IF y.det.sign THEN 1 ELSE -1];
Equal => RETURN[0];
InvX => InvalidAndDie[@x];
InvY => InvalidAndDie[@y];
};
RETURN[zFComp[a, b]];
};
zFComp: PROC [a, b: REAL] RETURNS [INTEGER] = MACHINE CODE {Mopcodes.zDCOMP; };
Float: PUBLIC SAFE PROC [a: LONG INTEGER, m: RealOps.Mode] RETURNS [REAL] = TRUSTED {
x: Ieee.Ext;
fpmode ← m;
thisTimeExceptions ← Real.NoExceptions;
IF a = 0 THEN RETURN[PlusZero];
x.det.sign ← a < 0;
x.frac.li ← IF x.det.sign THEN -a ELSE a;
x.det.sticky ← FALSE;
x.det.type ← normal;
x.exp ← 31;
Ieee.PostNormalize[@x];
Ieee.Round[@x];
RETURN[Ieee.Pack[@x]];
};
RoundLI: PUBLIC SAFE PROC [a: REAL, m: RealOps.Mode] RETURNS [LONG INTEGER] = TRUSTED {
x: Ieee.Ext;
fli: LONG INTEGER;
inv, ov: BOOLEAN;
fpmode ← m;
thisTimeExceptions ← Real.NoExceptions;
x ← Unpack[a];
[v: fli, invalid: inv, overflow: ov] ← FixExtended[x, fpmode.round];
IF inv THEN InvalidAndDie[@x];
IF ov THEN {
Ieee.SetFixOverflow[];
IF fpmode.traps[fixOverflow] THEN {
p: REF Real.Extended ← NEW[Real.Extended ← Ieee.CVExtended[x]];
IF SIGNAL Real.RealException[thisTimeExceptions, p] THEN RETURN[LOOPHOLE[p↑.frac, LONG INTEGER]];
};
};
RETURN[fli];
};
FixExtended: PUBLIC SAFE PROC [z: Ieee.Ext, rmode: RealOps.RoundingMode]
RETURNS [v: LONG INTEGER, invalid, overflow: BOOLEAN] = TRUSTED {
grs: INTEGER;
{
SELECT z.det.type FROM
nan => GOTO Invalid;
infinity => GOTO Invalid;
zero => GOTO Zero;
normal => NULL;
ENDCASE => ERROR;
IF z.exp > 30 THEN GOTO Overflow;
{
IF z.exp = 30 THEN {
grs ← IF Ieee.BitOn[z.frac.lowbits, 1] THEN 4 ELSE 0;
z.frac.lc ← Ieee.RShift[z.frac.lc];
}
ELSE {
Ieee.DeNormalize[@z, z.exp - 29];
grs ← Inline.BITAND[z.frac.lowbits, 3B];
grs ← grs + grs;
z.frac.lc ← Ieee.LongShift[z.frac.lc, -2];
};
IF z.det.sticky THEN grs ← grs + 1;
SELECT rmode FROM
rn => {
IF grs > 4 OR (grs = 4 AND Ieee.BitOn[z.frac.lowbits, 1]) THEN
GOTO Plus1;
};
rz => NULL;
rm => IF z.det.sign THEN GOTO Plus1;
rp => IF NOT z.det.sign THEN GOTO Plus1;
ENDCASE => ERROR;
EXITS
Plus1 => {
z.frac.lc ← z.frac.lc + 1;
IF Ieee.BitOn[z.frac.highbits, HiBit] THEN GOTO Overflow;
};
};
EXITS
Overflow => {
IF z.det.sign AND z.frac.li = MagicLI THEN
RETURN[v: MagicLI, invalid: FALSE, overflow: FALSE];
-- returns positive without looking at sign
z.frac.li ← Ieee.LongShift[z.frac.li, z.exp - 30];
z.frac.highbits ← Inline.BITAND[NotHiBit, z.frac.highbits];
RETURN[v: z.frac.li, invalid: FALSE, overflow: TRUE];
};
Invalid => RETURN[v: z.frac.li, invalid: TRUE, overflow: FALSE];
Zero => RETURN[v: 0, invalid: FALSE, overflow: FALSE];
};
IF z.det.sign THEN z.frac.li ← -z.frac.li;
RETURN[v: z.frac.li, invalid: FALSE, overflow: FALSE];
};
InvalidAndDie: PROC [z: POINTER TO Ieee.Ext] = {
p: REF Real.Extended ← NEW[Real.Extended ← Ieee.CVExtended[z↑]];
Ieee.SetInvalidOperation[];
[] ← SIGNAL Real.RealException[thisTimeExceptions, p];
ERROR Real.RealError;
};
RoundI: PUBLIC SAFE PROC [a: REAL, m: RealOps.Mode] RETURNS [INTEGER] = TRUSTED {
x: Ieee.Ext;
fli: LONG INTEGER;
fi: INTEGER;
inv, ov: BOOLEAN;
fpmode ← m;
thisTimeExceptions ← NoExceptions;
x ← Ieee.Unpack[a];
[v: fli, invalid: inv, overflow: ov] ← FixExtended[x, fpmode.round];
IF inv THEN InvalidAndDie[@x];
IF ov OR fli NOT IN [FIRST[INTEGER]..LAST[INTEGER]] THEN {
Ieee.SetFixOverflow[];
IF fpmode.traps[fixOverflow] THEN {
p: REF Real.Extended ← NEW[Real.Extended ← Ieee.CVExtended[x]];
IF SIGNAL Real.RealException[thisTimeExceptions, p] THEN RETURN[Inline.LowHalf[p↑.frac]];
}; -- FixExtended returns low 31 bits of integer part of fraction
IF NOT ov AND x.det.sign THEN fli ← -fli;
fi ← Inline.BITAND[NotHiBit, Inline.LowHalf[fli]];
}
ELSE fi ← Inline.LowHalf[fli];
RETURN[fi];
};
RoundC: PUBLIC SAFE PROC [a: REAL, m: RealOps.Mode] RETURNS [CARDINAL] = TRUSTED {
x: Ieee.Ext;
fli: LONG INTEGER;
fc: CARDINAL;
inv, ov: BOOLEAN;
fpmode ← m;
thisTimeExceptions ← Real.NoExceptions;
x ← Unpack[a];
[v: fli, invalid: inv, overflow: ov] ← FixExtended[x, fpmode.round];
IF inv THEN InvalidAndDie[@x];
IF ov OR fli NOT IN [FIRST[CARDINAL]..LAST[CARDINAL]] THEN {
Ieee.SetFixOverflow[];
IF fpmode.traps[fixOverflow] THEN {
p: REF Real.Extended ← NEW[Real.Extended ← Ieee.CVExtended[x]];
IF SIGNAL Real.RealException[thisTimeExceptions, p] THEN RETURN[Inline.LowHalf[p↑.frac]];
};
IF NOT ov AND x.det.sign THEN fli ← -fli;
};
fc ← Inline.LowHalf[fli];
RETURN[fc];
};
SquareReal: TYPE = RECORD [m2: CARDINAL,
sign: BOOLEAN, expD2: [0..128), index: [0..32), m1: [0..8)];
SqRt: PUBLIC SAFE PROC [a: REAL, m: Mode ← RealOps.DefMode] RETURNS [b: REAL] = TRUSTED {
aFmt: SquareReal;
bFmt: SingleReal;
x: Ieee.Ext;
{
fpmode ← m;
thisTimeExceptions ← Real.NoExceptions;
x ← Unpack[a];
SELECT x.det.type FROM
nan => IF a = Real.TrappingNaN THEN GOTO Invalid ELSE RETURN[a];
infinity => IF m.im = projective OR x.det.sign THEN GOTO Invalid ELSE RETURN[Real.PlusInfinity];
zero => RETURN[a];
normal => NULL;
ENDCASE => ERROR;
IF x.det.sign OR NOT Normalized[x.frac.highbits] THEN GOTO Invalid;
aFmt ← LOOPHOLE[a, SquareReal];
bFmt ← LOOPHOLE[sqGuesses[aFmt.index], SingleReal];
bFmt.exp ← bFmt.exp + aFmt.expD2 - 63;
b ← LOOPHOLE[bFmt, REAL];
b ← LOOPHOLE[LOOPHOLE[b + a/b, LONG CARDINAL] - 40000000B, REAL];
b ← LOOPHOLE[LOOPHOLE[b + a/b, LONG CARDINAL] - 40000000B, REAL];
EXITS
Invalid => {
x.frac.lc ← Real.SqRtNaN;
Ieee.SetInvalidOperation[]; -- Signal invalid operation
RETURN[Ieee.Pack[@x]];
};
};
};
FScale: PUBLIC SAFE PROC [a: REAL, scale: INTEGER, m: Mode ← DefMode] RETURNS [REAL] = TRUSTED {
x: Ieee.Ext ← Unpack[a];
SELECT x.det.type FROM
nan => IF a # Real.TrappingNaN THEN RETURN[a];
infinity, zero => RETURN[a];
normal => NULL;
ENDCASE => ERROR;
IF scale > 400 THEN Ieee.SetOverflow[@x];
IF scale < -400 THEN Ieee.SetOverflow[@x];
x.exp ← x.exp + scale;
Ieee.StepTwo[@x];
RETURN[Ieee.Pack[@x]];
};
END.
L. Stewart, July 12, 1980 11:13 PM, Rounds changed to return low order bits on RESUME.
L. Stewart, August 12, 1980 12:05 PM, RoundI, RoundC fixed for negative arguments.
August 25, 1980 4:05 PM, LStewart; formatting, shorten Float
June 3, 1982 12:02 pm, L. Stewart, REF Extended in RealException, SqRt and FScale
August 27, 1982 11:30 am, L. Stewart, added TRUSTED