DIRECTORY
Basics USING [LongNumber],
IeeeInternal,
PrincOps USING [zDCOMP],
PrincOpsUtils USING [BITAND, BITOR],
Real,
RealOps;

DragonRealIeeeB: PROGRAM IMPORTS IeeeInternal, PrincOpsUtils, Real EXPORTS IeeeInternal, RealOps =
BEGIN OPEN IeeeInternal, 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: IeeeInternal.Ext;
{
fpmode _ m;
thisTimeExceptions _ Real.NoExceptions;
x _ IeeeInternal.Unpack[a];
y _ IeeeInternal.Unpack[b];
IF IeeeInternal.BitOn[funny, PrincOpsUtils.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 IeeeInternal.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 {PrincOps.zDCOMP; };

Float: PUBLIC SAFE PROC [a: LONG INTEGER, m: RealOps.Mode] RETURNS [REAL] = TRUSTED {
x: IeeeInternal.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;
IeeeInternal.PostNormalize[@x];
IeeeInternal.Round[@x];
RETURN[IeeeInternal.Pack[@x]];
};

RoundLI: PUBLIC SAFE PROC [a: REAL, m: RealOps.Mode] RETURNS [LONG INTEGER] = TRUSTED {
x: IeeeInternal.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 {
IeeeInternal.SetFixOverflow[];
IF fpmode.traps[fixOverflow] THEN {
p: REF Real.Extended _ NEW[Real.Extended _ IeeeInternal.CVExtended[x]];
IF SIGNAL Real.RealException[thisTimeExceptions, p] THEN RETURN[LOOPHOLE[p^.frac, LONG INTEGER]];
};
};
RETURN[fli];
};

FixExtended: PUBLIC SAFE PROC [z: IeeeInternal.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 IeeeInternal.BitOn[z.frac.lowbits, 1] THEN 4 ELSE 0;
z.frac.lc _ IeeeInternal.RShift[z.frac.lc];
}
ELSE {
IeeeInternal.DeNormalize[@z, z.exp - 29];
grs _ PrincOpsUtils.BITAND[z.frac.lowbits, 3B];
grs _ grs + grs;
z.frac.lc _ IeeeInternal.LongShift[z.frac.lc, -2];
};
IF z.det.sticky THEN grs _ grs + 1;
SELECT rmode FROM
rn => {
IF grs > 4 OR (grs = 4 AND IeeeInternal.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 IeeeInternal.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];
z.frac.li _ IeeeInternal.LongShift[z.frac.li, z.exp - 30];
z.frac.highbits _ PrincOpsUtils.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 IeeeInternal.Ext] = {
p: REF Real.Extended _ NEW[Real.Extended _ IeeeInternal.CVExtended[z^]];
IeeeInternal.SetInvalidOperation[];
[] _ SIGNAL Real.RealException[thisTimeExceptions, p];
ERROR Real.RealError;
};

RoundI: PUBLIC SAFE PROC [a: REAL, m: RealOps.Mode] RETURNS [INTEGER] = TRUSTED {
x: IeeeInternal.Ext;
fli: LONG INTEGER;
fi: INTEGER;
inv, ov: BOOLEAN;
fpmode _ m;
thisTimeExceptions _ NoExceptions;
x _ IeeeInternal.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 {
IeeeInternal.SetFixOverflow[];
IF fpmode.traps[fixOverflow] THEN {
p: REF Real.Extended _ NEW[Real.Extended _ IeeeInternal.CVExtended[x]];
IF SIGNAL Real.RealException[thisTimeExceptions, p] THEN RETURN[LOOPHOLE[p^.frac, Basics.LongNumber].lowbits];
}; -- FixExtended returns low 31 bits of integer part of fraction
IF NOT ov AND x.det.sign THEN fli _ -fli;
fi _ PrincOpsUtils.BITAND[NotHiBit, LOOPHOLE[fli, Basics.LongNumber].lowbits];
}
ELSE fi _ LOOPHOLE[fli, Basics.LongNumber].lowbits;
RETURN[fi];
};

RoundC: PUBLIC SAFE PROC [a: REAL, m: RealOps.Mode] RETURNS [CARDINAL] = TRUSTED {
x: IeeeInternal.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 {
IeeeInternal.SetFixOverflow[];
IF fpmode.traps[fixOverflow] THEN {
p: REF Real.Extended _ NEW[Real.Extended _ IeeeInternal.CVExtended[x]];
IF SIGNAL Real.RealException[thisTimeExceptions, p] THEN RETURN[LOOPHOLE[p^.frac, Basics.LongNumber].lowbits];
};
IF NOT ov AND x.det.sign THEN fli _ -fli;
};
fc _ LOOPHOLE[fli, Basics.LongNumber].lowbits;
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: IeeeInternal.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;
IeeeInternal.SetInvalidOperation[]; -- Signal invalid operation
RETURN[IeeeInternal.Pack[@x]];
};
};
};

FScale: PUBLIC SAFE PROC [a: REAL, scale: INTEGER, m: Mode _ DefMode] RETURNS [REAL] = TRUSTED {
x: IeeeInternal.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 IeeeInternal.SetOverflow[@x];
IF scale < -400 THEN IeeeInternal.SetOverflow[@x];
x.exp _ x.exp + scale;
IeeeInternal.StepTwo[@x];
RETURN[IeeeInternal.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
January 14, 1984 4:51 pm, L. Stewart, change to IeeeInternal

øDragonRealIeeeB.mesa
Last Modified: August 27, 1982 11:27 am
Last Modified By Paul Rovner On May 4, 1983 9:55 am
Mesa implementation of floating point ops
Last Edited by: Levin, August 8, 1983 4:32 pm
returns positive without looking at sign
�Êˆ˜Jš
Ïb™Jš
œ'™'Jš
œ3™3Jš
œ)™)Jš
œ-™-J˜š
Ïk	˜	Jšœžœ˜J˜
Jšœ	žœ
˜Jšœžœžœžœ˜$J˜J˜J˜—š�œžœ
žœ#žœ˜bJšžœ
žœ˜'J˜šœžœžœ
žœ˜#Jšžœžœ˜Jšžœžœ˜Jšžœžœ˜Jšžœžœ˜Jšžœžœ˜Jšžœžœ˜Jšžœžœ˜Jšžœžœ˜J˜Jšžœžœ˜Jšžœžœ˜Jšžœžœ˜Jšžœžœ˜Jšžœžœ˜Jšžœžœ˜Jšžœžœ˜Jšžœžœ˜J˜Jšžœžœ˜Jšžœžœ˜Jšžœžœ˜Jšžœžœ˜Jšžœžœ˜Jšžœžœ˜Jšžœžœ˜Jšžœžœ˜J˜Jšžœžœ˜Jšžœžœ˜Jšžœžœ˜Jšžœžœ˜Jšžœžœ˜Jšžœžœ˜Jšžœžœ˜Jšžœžœ˜J˜J˜J˜—šÏnœžœ
žœ
žœžœžœžœžœ˜KJ˜J˜
J˜J˜'J˜J˜šžœ)žœž˜Dšžœ
žœ
ž˜Jšœžœ˜Jšœžœ˜Jšœžœžœ
˜8šœžœ˜2Jšžœžœžœ
žœ˜DJšžœ
žœ˜—Jšœžœ˜$Jšœžœ˜$Jšœžœ˜$Jšžœž˜——š
ž˜šžœ'ž˜1Jšœžœ
˜
Jšœžœ˜Jšœžœ˜Jšœžœ˜Jšžœžœ
˜——Jšžœžœ
žœ˜+šžœž˜Jš
ž˜Jšžœžœ
žœžœ˜/Jšžœžœ
žœžœ˜/Jšžœ
˜—š
ž˜Jš	œ	žœ
žœžœžœ˜.Jš	œ	žœ
žœžœžœ˜.Jšœ	žœ˜J˜J˜—J˜Jšžœ˜J˜J˜—Jš
œžœžœžœžœžœ
žœ˜O˜šŸœžœ
žœ
žœžœ
žœžœžœžœ˜UJ˜J˜J˜'Jšžœžœ
žœ˜J˜Jšœžœžœžœ˜)Jšœžœ
˜J˜J˜J˜J˜Jšžœ˜J˜J˜—šŸœžœ
žœ
žœžœžœžœ
žœžœ˜WJ˜Jšœžœ
žœ
˜Jšœ	žœ
˜J˜J˜'J˜J˜DJšžœžœ˜šžœžœ˜J˜šžœžœ˜#Jšœžœžœ-˜GJšžœ
žœ+žœ
žœ
žœ
žœ
žœ˜aJ˜—J˜—Jšžœ˜J˜J˜—šŸœžœ
žœ
žœ3˜PJš
žœžœ
žœžœžœ˜AJšœžœ
˜
J˜
šžœž˜Jšœžœ	˜Jšœžœ	˜Jšœžœ˜Jšœ
žœ
˜Jšžœžœ
˜—Jšžœžœ
žœ
˜!J˜
šžœžœ˜Jšœžœ'žœžœ˜=J˜+J˜
—šžœ˜J˜)Jšœžœ˜/J˜J˜2J˜—Jšžœžœ˜#šžœž˜˜šžœ	žœ
žœ(ž˜FJšžœ˜—J˜—Jšœžœ
˜Jšœžœžœ
žœ˜$Jš	œžœ
žœžœ
žœ˜(Jšžœžœ
˜—š
ž˜˜
J˜Jšžœ,žœ
žœ
˜AJ˜——J˜š
ž˜˜
šžœžœž˜*Jšžœžœžœ˜4—Jš
œ(™(J˜:Jšœ žœ˜BJšžœžœžœ˜5J˜—Jšœžœžœžœ˜@Jšœžœžœžœ˜6—J˜Jšžœžœ˜*Jšžœžœžœ˜6J˜J˜—šŸ
œžœžœ
žœ˜8Jšœžœžœ.˜HJ˜#Jšœžœ+˜6Jšžœ˜J˜J˜—šŸœžœ
žœ
žœžœžœžœžœ˜QJ˜Jšœžœ
žœ
˜Jšœžœ
˜Jšœ	žœ
˜J˜J˜"J˜J˜DJšžœžœ˜šžœžœžœ
žœžœ
žœžœ
žœžœ˜:J˜šžœžœ˜#Jšœžœžœ-˜GJš
žœ
žœ+žœ
žœ
žœ&˜nJšœÏc>˜A—Jšžœ
žœžœžœ˜)Jšœžœžœ"˜NJ˜
—Jšžœžœ!˜3Jšžœ˜J˜J˜—šŸœžœ
žœ
žœžœžœžœžœ˜RJ˜Jšœžœ
žœ
˜Jšœžœ
˜
Jšœ	žœ
˜J˜J˜'J˜J˜DJšžœžœ˜šžœžœžœ
žœžœ
žœžœ
žœžœ˜<J˜šžœžœ˜#Jšœžœžœ-˜GJš
žœ
žœ+žœ
žœ
žœ&˜nJ˜—Jšžœ
žœžœžœ˜)J˜—Jšœžœ!˜.Jšžœ˜J˜J˜——šœ
žœžœžœ
˜)Jšœžœ/˜<J˜šŸœžœ
žœ
žœžœžœžœžœ˜[J˜J˜J˜J˜
J˜J˜'J˜šžœž˜Jšœžœžœ
žœ	žœ
žœ˜@Jš
œžœžœžœ
žœ	žœ
žœ˜`Jšœžœ˜Jšœ
žœ
˜Jšžœžœ
˜—Jš
žœžœ
žœžœ
žœ	˜CJšœžœ˜Jšœžœ$˜3J˜&Jšœžœžœ˜—šœžœ
žœ
žœ
žœžœ˜AJšœžœ
žœ
žœ
žœžœ˜AJš
ž˜˜J˜Jšœ$ ˜?Jšžœ˜J˜—J˜J˜J˜—šŸœžœ
žœ
žœžœ	žœžœžœžœ˜`J˜ šžœž˜Jšœžœžœ
žœ˜.Jšœžœ˜Jšœ
žœ
˜Jšžœžœ
˜—Jšžœ
žœ˜1Jšžœžœ˜2J˜J˜Jšžœ˜J˜J˜—Jšžœ
˜——Jšž
œ žœ-žœ
˜WJšž
œ"žœ.˜SJšœžœ%˜=Jšœž
œžœ+˜QJšœž
œž˜3Jšœž
œ!˜<J˜—…—"’0