IeeeFloatB.mesa - Mesa implementation of floating point ops
Copyright © 1985 by Xerox Corporation. All rights reserved.
Rovner On May 4, 1983 9:55 am
Levin, August 8, 1983 4:32 pm
Russ Atkinson (RRA) June 5, 1985 7:33:41 pm PDT
DIRECTORY
Basics USING [BITAND, BITOR, DoubleShift, DoubleShiftRight, LongNumber],
Ieee USING [BitOn, CVExtended, DeNormalize, Ext, funny, HiBit, MagicLI, NormalType, NotHiBit, Pack, PostNormalize, Round, RShift, SetFixOverflow, SetInvalidOperation, SetOverflow, StepTwo, TNnn, TNnz, TNzn, TNzz, Unpack],
PrincOps USING [zDCOMP],
Real USING [RealError, TrappingNaN],
RealExceptions USING [ClearExceptions, RaiseException],
RealOps USING [DefMode, Mode, RoundingMode, SetMode];
IeeeFloatB:
PROGRAM
IMPORTS Basics, Ieee, Real, RealExceptions, RealOps
EXPORTS Ieee, RealOps =
BEGIN OPEN Ieee, Real, RealOps;
FComp:
PUBLIC
SAFE
PROC [a, b:
REAL, m: Mode]
RETURNS [sense:
INTEGER] =
TRUSTED {
inner:
PROC = {
x: Ext ← Ieee.Unpack[a];
y: Ext ← Ieee.Unpack[b];
{
SELECT
TRUE
FROM
Basics.
BITAND[funny, Basics.
BITOR[
LOOPHOLE[x.det],
LOOPHOLE[y.det]]] = 0 =>
Normal case: Neither operand is infinity or NaN
SELECT Ieee.NormalType[x.det, y.det]
FROM
TNnn => NULL;
TNnz => GOTO XSign;
TNzn => GOTO YSign;
TNzz => GOTO Equal;
ENDCASE => ERROR;
x.det.type = nan => GOTO InvX;
y.det.type = nan => GOTO InvY;
x.det.type = infinity
AND y.det.type = infinity =>
IF m.im = projective
OR x.det.sign = y.det.sign
THEN GOTO Equal
ELSE GOTO XSign;
m.im = projective => GOTO InvX;
x.det.type = infinity => GOTO XSign;
y.det.type = infinity => GOTO YSign;
ENDCASE => ERROR;
SELECT
TRUE
FROM
x.det.sign => {
IF y.det.sign
THEN {
Signs are equal and both negative, so sense of the comparison of the absolute values is reversed
sense ← zFComp[ABS[b], ABS[a]];
RETURN;
};
At this point, x is negative and y is positive
sense ← -1;
};
y.det.sign =>
x is positive and y is negative, the return is obvious
sense ← 1;
ENDCASE =>
Both are positive, so integer comparison is (surprisingly) valid
sense ← zFComp[a, b];
EXITS
XSign => sense ← IF x.det.sign THEN -1 ELSE 1;
YSign => sense ← IF y.det.sign THEN 1 ELSE -1;
Equal => sense ← 0;
InvX => InvalidAndDie[@x];
InvY => InvalidAndDie[@y];
};
};
DoWithMode[inner, m];
};
zFComp: PROC [a, b: REAL] RETURNS [INTEGER] = MACHINE CODE {PrincOps.zDCOMP; };
Float:
PUBLIC
SAFE
PROC [a:
INT, m: RealOps.Mode]
RETURNS [r:
REAL ← 0.0] =
TRUSTED {
inner:
PROC = {
x: Ieee.Ext;
IF a < 0 THEN {x.det.sign ← TRUE; x.frac.li ← -a} ELSE {x.det.sign ← FALSE; x.frac.li ← a};
x.det.sticky ← FALSE;
x.det.type ← normal;
x.exp ← 31;
Ieee.PostNormalize[@x];
Ieee.Round[@x];
r ← Ieee.Pack[@x];
};
IF a # 0 THEN DoWithMode[inner, m];
};
RoundLI:
PUBLIC
SAFE
PROC [a:
REAL, m: RealOps.Mode]
RETURNS [fli:
INT] =
TRUSTED {
inner:
PROC = {
x: Ieee.Ext ← Ieee.Unpack[a];
inv, ov: BOOL;
[v: fli, invalid: inv, overflow: ov] ← FixExtended[x, m.round];
IF inv THEN InvalidAndDie[@x];
IF ov
THEN {
Ieee.SetFixOverflow[];
IF m.traps[fixOverflow]
THEN {
clientFixup: BOOL;
fraction: Basics.LongNumber;
[clientFixup, fraction] ← RealExceptions.RaiseException[Ieee.CVExtended[x]];
IF clientFixup THEN fli ← fraction.li;
};
};
};
DoWithMode[inner, m];
};
FixExtended:
PUBLIC
SAFE
PROC [z: Ieee.Ext, rmode: RealOps.RoundingMode]
RETURNS [v:
INT, 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 ← Ieee.RShift[z.frac];
}
ELSE {
Ieee.DeNormalize[@z, z.exp - 29];
grs ← Basics.BITAND[z.frac.lowbits, 3B];
grs ← grs + grs;
z.frac ← Basics.DoubleShiftRight[z.frac, 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 ← Basics.DoubleShift[z.frac, z.exp - 30];
z.frac.highbits ← Basics.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] = {
Ieee.SetInvalidOperation[];
[] ← RealExceptions.RaiseException[Ieee.CVExtended[z^]];
ERROR Real.RealError;
};
RoundI:
PUBLIC
SAFE
PROC [a:
REAL, m: RealOps.Mode]
RETURNS [fi:
INTEGER] =
TRUSTED {
inner:
PROC = {
x: Ieee.Ext ← Ieee.Unpack[a];
fli: INT;
inv, ov: BOOL;
[v: fli, invalid: inv, overflow: ov] ← FixExtended[x, m.round];
IF inv THEN InvalidAndDie[@x];
IF ov
OR fli
NOT
IN [
FIRST[
INTEGER]..
LAST[
INTEGER]]
THEN {
Ieee.SetFixOverflow[];
IF m.traps[fixOverflow]
THEN {
clientFixup: BOOL;
fraction: Basics.LongNumber;
[clientFixup, fraction] ← RealExceptions.RaiseException[Ieee.CVExtended[x]];
IF clientFixup THEN {fli ← fraction.li; GO TO done};
};
};
fi ← LOOPHOLE[LOOPHOLE[fli, Basics.LongNumber].lowbits, INTEGER];
EXITS done => {};
};
DoWithMode[inner, m];
};
RoundC:
PUBLIC
SAFE
PROC [a:
REAL, m: RealOps.Mode]
RETURNS [fc:
CARDINAL] =
TRUSTED {
inner:
PROC = {
x: Ieee.Ext ← Ieee.Unpack[a];
fli: INT;
inv, ov: BOOL;
[v: fli, invalid: inv, overflow: ov] ← FixExtended[x, m.round];
IF inv THEN InvalidAndDie[@x];
IF ov
OR fli
NOT
IN [
FIRST[
CARDINAL]..
LAST[
CARDINAL]]
THEN {
Ieee.SetFixOverflow[];
IF m.traps[fixOverflow]
THEN {
clientFixup: BOOL;
fraction: Basics.LongNumber;
[clientFixup, fraction] ← RealExceptions.RaiseException[Ieee.CVExtended[x]];
IF clientFixup THEN {fc ← fraction.lowbits; GO TO done};
};
IF NOT ov AND x.det.sign THEN fli ← -fli;
};
fc ← LOOPHOLE[fli, Basics.LongNumber].lowbits;
EXITS done => {};
};
DoWithMode[inner, m];
};
FScale:
PUBLIC
SAFE
PROC [a:
REAL, scale:
INTEGER, m: Mode ← DefMode]
RETURNS [r:
REAL] =
TRUSTED {
inner:
PROC = {
x: Ieee.Ext ← Ieee.Unpack[a];
SELECT x.det.type
FROM
normal => {
IF scale > 400 THEN Ieee.SetOverflow[@x];
IF scale < -400 THEN Ieee.SetOverflow[@x];
x.exp ← x.exp + scale;
Ieee.StepTwo[@x];
};
nan => IF a # Real.TrappingNaN THEN RETURN;
ENDCASE => RETURN;
r ← Ieee.Pack[@x];
};
r ← a;
DoWithMode[inner, m];
};
DoWithMode:
PROC [inner:
PROC, mode: Mode] = {
old: Mode ← RealOps.SetMode[mode];
RealExceptions.ClearExceptions[];
inner[ ! UNWIND => [] ← RealOps.SetMode[old]];
[] ← RealOps.SetMode[old];
};
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
January 14, 1984 4:51 pm, L. Stewart, change to Ieee