DIRECTORY
Basics USING [BITAND, BITOR, BITSHIFT, DoubleShift, DoubleShiftRight, LongMult, LongNumber],
Ieee USING [ADC3, BitOn, DenormalizedExponent, Details, ExponentBias, ExpSingleMax, ExpSingleMin, Ext, FractionShift, HiBit, HiddenBit, HiFractionMask, LargestSignificand, LeastSignificandBit, Microcode, MicroSticky, NaNExponent, SingleReal, StickyBits],
Real USING [Exception, ExceptionFlags, Extended, MinusInfinity, MinusZero, NoExceptions, PlusInfinity, PlusZero, RealException, TrapNonTrappingNaN, TrapTrappingNaN],
RealExceptions USING [GetExceptions, SetException, SetSticky, TestException],
RealOps USING [GetMode, Mode];

IeeeUtil: CEDAR PROGRAM
IMPORTS Basics, Ieee, Real, RealExceptions, RealOps
EXPORTS Ieee
= BEGIN OPEN Ieee, Real;

LongNumber: TYPE = Basics.LongNumber;


NormalizedCardinal: PROC [g: CARDINAL] RETURNS [BOOL] = TRUSTED INLINE {
RETURN [Basics.BITAND[g, Ieee.HiddenBit] # 0];
};

SetInexactResult: PUBLIC PROC = {
RealExceptions.SetException[inexactResult];
};

SetInvalidOperation: PUBLIC PROC = {
RealExceptions.SetException[invalidOperation];
};

SetDivisionByZero: PUBLIC PROC = {
RealExceptions.SetException[divisionByZero];
};

SetUnderflow: PUBLIC PROC [z: POINTER TO Ext] = {
RealExceptions.SetException[underflow];
};

SetOverflow: PUBLIC PROC [z: POINTER TO Ext] = {
RealExceptions.SetException[overflow];
};

SetFixOverflow: PUBLIC PROC = {
RealExceptions.SetException[fixOverflow];
RealExceptions.SetSticky[fixOverflow];
};


Unpack: PUBLIC PROC [r: REAL] RETURNS [z: Ext] = TRUSTED {
single: Ieee.SingleReal _ LOOPHOLE[r];
exp: INTEGER _ LOOPHOLE[single.exp, INTEGER] - ExponentBias;
z.exp _ exp;
z.det.sticky _ FALSE;
z.det.sign _ BitOn[LOOPHOLE[r, LongNumber].highbits, HiBit]; -- first r.j. the exponent
z.det.type _ normal;
z.frac.li _ LOOPHOLE[r, INT];
z.frac.highbits _ Basics.BITAND[HiFractionMask, z.frac.highbits];
SELECT exp FROM
= DenormalizedExponent => {
IF z.frac.li = 0
THEN z.det.type _ zero
ELSE {
z.exp _ ExpSingleMin;
z.frac _ Basics.DoubleShift[z.frac, FractionShift];
PostNormalize[@z];
};
};
= NaNExponent => {
IF z.frac.li = 0
THEN z.det.type _ infinity
ELSE {
z.det.type _ nan;
IF z.frac.lc = Real.TrapTrappingNaN THEN SetInvalidOperation[];
};
};
ENDCASE => {
z.frac _ Basics.DoubleShift[z.frac, FractionShift];
z.frac.highbits _ Basics.BITOR[HiddenBit, z.frac.highbits];
};
};


Pack: PUBLIC PROC [z: POINTER TO Ext] RETURNS [r: REAL] = TRUSTED {
trap: BOOL _ FALSE;
i: Exception;
exceptions: Real.ExceptionFlags _ RealExceptions.GetExceptions[];
IF exceptions # NoExceptions THEN {
mode: RealOps.Mode _ RealOps.GetMode[];
FOR i IN Exception DO
IF exceptions[i] THEN {
RealExceptions.SetSticky[i];
IF mode.traps[i] THEN trap _ TRUE;
IF i = invalidOperation THEN {
z.det.type _ nan;
IF z.frac.lc = 0 THEN z.frac.lc _ TrapNonTrappingNaN;
};
};
ENDLOOP;
IF trap
THEN {
p: REF Extended _ NEW[Extended _ CVExtended[z^]];
clientFix: BOOL _
SIGNAL Real.RealException[flags: RealExceptions.GetExceptions[], vp: p];
IF NOT clientFix THEN FixupProcedure[z] ELSE CFExtended[p, z];
}
ELSE FixupProcedure[z];
};
RETURN[UsualPack[z^]];
};

UsualPack: PUBLIC PROC [z: Ext] RETURNS [REAL] = TRUSTED {
single: Ieee.SingleReal;
exp: INTEGER _ z.exp;
SELECT z.det.type FROM
zero => RETURN [IF z.det.sign THEN Real.MinusZero ELSE Real.PlusZero];
infinity => RETURN [IF z.det.sign THEN Real.MinusInfinity ELSE Real.PlusInfinity];
nan => z.exp _ NaNExponent;
ENDCASE => z.frac _ Basics.DoubleShift[z.frac, -FractionShift];
SELECT exp FROM
< - ExponentBias =>
RETURN [IF z.det.sign THEN Real.MinusZero ELSE Real.PlusZero];
> ExponentBias+1 =>
RETURN [IF z.det.sign THEN Real.MinusInfinity ELSE Real.PlusInfinity];
ENDCASE;
single _ LOOPHOLE[z.frac.real];
single.exp _ exp+ExponentBias;
single.sign _ z.det.sign;
RETURN[LOOPHOLE[single]];
};

FixupProcedure: PUBLIC PROC [vp: POINTER TO Ext] = TRUSTED {
IF RealExceptions.TestException[underflow] THEN {
DeNormalize[vp, vp.exp - ExpSingleMin];
vp.exp _ DenormalizedExponent;
Round[vp];
IF vp.exp # DenormalizedExponent THEN {
vp.frac _ RShift[vp.frac];
vp.exp _ DenormalizedExponent;
};
};
IF RealExceptions.TestException[overflow] THEN {
RealExceptions.SetSticky[inexactResult];
SELECT RealOps.GetMode[].round FROM
rn, rz => GOTO SignTest;
rp => IF NOT vp.det.sign THEN GOTO SignTest;
rm => IF vp.det.sign THEN GOTO SignTest;
ENDCASE => ERROR;
IF NormalizedCardinal[vp.frac.highbits] THEN vp.frac.lc _ LargestSignificand;
vp.exp _ ExpSingleMax;
EXITS SignTest => vp.det.type _ infinity;
};
};

Round: PUBLIC PROC [z: POINTER TO Ext] = TRUSTED {
temp: LONG CARDINAL;
GRS: PROC [g: CARDINAL] RETURNS [CARDINAL] = TRUSTED {
s: BOOL _ BitOn[g, StickyBits] OR z.det.sticky;
g _ Basics.BITSHIFT[Basics.BITAND[g, 300B], -5];
IF s THEN g _ g + 1;
RETURN[g];
}; -- The fraction should be normalized here!
grs: CARDINAL _ GRS[z.frac.lowbits];
IF grs = 0 THEN RETURN;
SetInexactResult[];
{
SELECT RealOps.GetMode[].round FROM
rn =>
IF grs > 4 OR (grs = 4 AND BitOn[z.frac.lowbits, LeastSignificandBit]) 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 => {
temp _ z.frac.lc;
z.frac.lc _ z.frac.lc + LeastSignificandBit;
IF z.frac.lc <= temp THEN {
z.frac _ RShift1in1[z.frac];
z.exp _ z.exp + 1;
};
};
};
};

RShift1in1: PUBLIC PROC [z: LongNumber] RETURNS [LongNumber] = TRUSTED {
z _ Basics.DoubleShiftRight[z, 1];
z.highbits _ Basics.BITOR[HiddenBit, z.highbits];
RETURN[z];
};

NormalType: PUBLIC PROC [x, y: Details] RETURNS [INTEGER] = TRUSTED {
RETURN[(LOOPHOLE[x.type, CARDINAL]*2) + LOOPHOLE[y.type, CARDINAL]];
};

RShift: PUBLIC PROC [z: LongNumber] RETURNS [LongNumber] = TRUSTED {
RETURN [Basics.DoubleShiftRight[z, 1]];
};

LShift: PUBLIC PROC [z: LongNumber] RETURNS [LongNumber] = TRUSTED {
z.lc _ z.lc+z.lc;
RETURN[z];
};

StepTwo: PUBLIC PROC [z: POINTER TO Ext] = TRUSTED {
IF z.det.type # normal THEN RETURN;
IF z.exp <= ExpSingleMin THEN {
IF z.exp < ExpSingleMin OR (NOT NormalizedCardinal[z.frac.highbits]) THEN
SetUnderflow[z];
};
IF NOT RealExceptions.TestException[underflow] THEN Round[z];
IF (NOT NormalizedCardinal[z.frac.highbits]) AND z.exp # DenormalizedExponent AND
(NOT RealExceptions.TestException[underflow]) THEN SetInvalidOperation[]
ELSE IF z.exp > ExpSingleMax THEN SetOverflow[z];
};

Mul32: PUBLIC PROC [x, y: Basics.LongNumber] RETURNS [Basics.LongNumber, Basics.LongNumber] = TRUSTED {
hi, lo, t1, t2: Basics.LongNumber;
cy: CARDINAL;
lo.lc _ Basics.LongMult[x.lowbits, y.lowbits];
hi.lc _ Basics.LongMult[x.highbits, y.highbits];
t1.lc _ Basics.LongMult[x.highbits, y.lowbits];
t2.lc _ Basics.LongMult[x.lowbits, y.highbits];
[cy, lo.highbits] _ Ieee.ADC3[lo.highbits, t1.lowbits, t2.lowbits];
hi.lc _ hi.lc + t1.highbits + t2.highbits + cy;
RETURN[hi, lo];
};


PostNormalize: PUBLIC PROC [z: POINTER TO Ext] = TRUSTED {
IF z.frac.lc = 0 THEN ERROR;
WHILE Basics.BITAND[z.frac.highbits, Ieee.HiddenBit] = 0 DO
z.frac.lc _ z.frac.lc+z.frac.lc;
z.exp _ z.exp - 1;
ENDLOOP;
};


DeNormalize: PUBLIC PROC [z: POINTER TO Ext, count: INTEGER] = TRUSTED {
b: CARDINAL _ 0;
IF count > 0 THEN ERROR;
THROUGH (count..0] DO
b _ Basics.BITOR[b, Basics.BITAND[z.frac.lowbits, 1]];
z.frac _ Basics.DoubleShiftRight[z.frac, 1];
ENDLOOP;
IF b = 1 OR z.det.sticky THEN {
z.frac.lowbits _ Basics.BITOR[z.frac.lowbits, 1];
z.det.sticky _ FALSE;
};
};

CVExtended: PUBLIC PROC [z: Ieee.Ext] RETURNS [Real.Extended] = TRUSTED {
RETURN[[type: z.det.type, sign: z.det.sign, exp: z.exp, frac: z.frac.lc]];
};

CFExtended: PUBLIC PROC [zz: REF Real.Extended, z: POINTER TO Ieee.Ext] = TRUSTED {
z.frac.lc _ zz.frac;
z.exp _ zz.exp;
z.det.sign _ zz.sign;
z.det.type _ zz.type;
z.det.sticky _ TRUE;
};

InitIeee: PUBLIC PROC = TRUSTED {
IF Ieee.Microcode THEN [] _ Ieee.MicroSticky[0]; -- disable uCode IR trap
};

END.
L. Stewart July 5, 1980  3:29 PM Bug fix in rounding
L. Stewart July 6, 1980  12:30 PM Bug fix in Denormalize, added InitIeee
L. Stewart July 6, 1980  4:20 PM added microsticky
L. Stewart July 8, 1980  5:00 PM RealOps
August 25, 1980  10:25 AM, L. Stewart; fix to Denormalize, formatting
August 25, 1980  5:09 PM, L. Stewart; smaller and slower
4-Feb-81 18:51:47, L. Stewart, NonTrappingNaN -> TrapNonTrappingNaNL
June 3, 1982 11:39 am, L. Stewart, REF Extended
August 27, 1982 1:00 pm, L. Stewart, CEDAR & TRUSTED
January 14, 1984 4:56 pm, L. Stewart, change to Ieee
‚IeeeUtil.mesa - IEEE float utilities
Copyright c 1985 by Xerox Corporation.  All rights reserved.
Stewart, August 27, 1982 11:33 am
Rovner, May 4, 1983 9:57 am
Levin, August 8, 1983 4:35 pm
Russ Atkinson (RRA) May 28, 1985 9:49:43 pm PDT
Doug Wyatt, February 25, 1985 3:28:33 pm PST
obsolete global variables
fpmode: PUBLIC RealOps.Mode _ RealOps.DefMode;
thisTimeExceptions: PUBLIC Real.ExceptionFlags _ Real.NoExceptions;
stickyFlags: PUBLIC Real.ExceptionFlags _ Real.NoExceptions;
Separate the packed REAL into its component elements
denormalized or zero
RRA: this used to be the following code, but it caused several subtle errors.  When the whole Floating Point Issue is revisited, then this change should be reconsidered.
IF RealOps.GetMode[].nm = normalizing THEN PostNormalize[@z];
infinity or nan
Stuff the components back into the packed REAL.
Possible typo in standard here!!!
IF fpmode.round=rm OR fpmode.round=rp THEN {
IF NOT fpmode.traps[overflow] THEN thisTimeExceptions[overflow] _ FALSE;
IF NOT fpmode.traps[underflow] THEN thisTimeExceptions[underflow] _ FALSE;
};
RRA: this used to be ERROR, it is better to forgive, I think
RRA: this used to be ERROR, it is better to forgive, I think
mash stuff into the single precision format
just to set m1 & m2, leaves garbage in exp & sign
guaranteed to be in [0..ExponentBias*2) by above tests
simple boolean transfer of the sign
A 32 bit extended is considered to have its hidden bit as bit 0, significand as the next 29 bits, then G, then R, then S as a separate boolean.  GRS computs the 3 bit number formed by the concatenation of G, R, and IF S THEN 1 ELSE 0.
StickyBits are the set used for rounding to 24 bits
Should flush these constants
better overflow detect!
Post Normalize.  S does not participate
DeNormalize is much like LongShift, except that it maintains the sticky bits on the right. And it only shifts right.
This will get the globals.
ΚI˜
codeš
œ$™$Kšœ
Οm
œ1™<Kš
œ!™!Kš
œ™Kš
œ™J™/K™,—K˜š
Οk	˜	Kš	œžœžœžœžœ7˜\Kšœžœτ
˜ώ
Kšœžœ›
˜₯
Kšœžœ9˜MKšœžœ˜K˜—šœ
žœ
ž˜Kšžœ,˜3Kšžœ˜Kšœžœ
žœ˜K˜Kšœžœ˜%K˜š
œ™Kšœžœ ™.Kšœžœ)™CKšœ
žœ)™<—K˜šΟnœžœžœžœžœžœ
žœ˜HKšžœžœ˜.Kš
œ˜K˜—šŸœžœ
žœ˜!Kš
œ+˜+Kš
œ˜—K˜šŸœžœ
žœ˜$Kš
œ.˜.Kš
œ˜K˜—šŸœžœ
žœ˜"Kš
œ,˜,Kš
œ˜—K˜š
Ÿœžœ
žœžœ
žœ	˜1Kš
œ'˜'Kš
œ˜K˜—š
Ÿœžœ
žœžœ
žœ	˜0Kš
œ&˜&Kš
œ˜K˜—šŸœžœ
žœ˜Kš
œ)˜)Kš
œ&˜&Kš
œ˜K˜—Kš
œ4™4K˜šŸœžœ
žœžœžœžœ˜:Kšœžœ˜&Kšœžœžœ
žœ˜<Kš
œ˜Kšœžœ
˜Kšœžœ"Οc˜WK˜Kšœžœžœ˜Kšœžœ"˜Ašžœž˜˜Kš
œ™šžœ˜Kšžœ˜šžœ˜K˜K˜3š
œ˜Kšžœ¦
™©
Kšžœ$žœ™=—K˜——K˜—˜Kš
œ™šžœ˜Kšžœ˜šžœ˜K˜Kšžœ"žœ˜?K˜——K˜—šžœ˜K˜3Kšœžœ˜;K˜——K˜K˜—Kš
œ/™/K˜šŸœžœ
žœžœ
žœžœžœžœ˜CKšœžœžœ
˜K˜
Kš
œA˜Ašžœžœ˜#š
œ!™!šžœžœžœ™,Kšžœ
žœžœ žœ
™HKšžœ
žœžœ!žœ
™JK™——Kš
œ'˜'šžœžœž˜šžœžœ˜Kš
œ˜Kšžœžœžœ
˜"šžœžœ˜Kš
œ˜Kšžœžœ ˜5K˜—K˜—Kšžœ
˜—šžœ˜šžœ˜Kšœžœžœ˜1KšœžœžœB˜ZKšžœ
žœžœžœ˜>K˜
—Kšžœ˜—K˜—Kšžœ˜K˜K˜—šŸ	œžœ
žœ
žœžœžœ˜:Kš
œ˜Kšœžœ	˜šžœž˜Kš	œžœžœžœžœ˜FKš	œžœžœžœžœ˜RK˜Kšžœ8˜?—šžœž˜š
œ˜Kšžœžœžœžœ˜>Kš
œ<™<—š
œ˜Kšžœžœžœžœ˜FKš
œ<™<—Kšžœ
˜—K™+šœ	žœ˜Kš
œ1™1—š
œ˜Kš
œ6™6—š
œ˜Kš
œ#™#—Kšžœ
žœ
˜K˜K˜—šŸœžœ
žœžœ
žœžœ˜<šžœ)žœ˜1K˜'K˜K˜
šžœžœ˜'K˜K˜K˜—K˜—šžœ(žœ˜0Kš
œ(˜(šžœž˜#Kšœ
žœ
˜Kš	œžœ
žœ
žœ
žœ
˜,Kšœžœ
žœ
žœ
˜(Kšžœžœ
˜—Kšžœ&žœ!˜MK˜Kšžœ$˜)K˜—K˜K˜—šŸœžœ
žœžœ
žœžœ˜2Kšœžœ
žœ
˜Kš
œκ
™κ
šžœžœžœžœžœžœ˜6Kš
œ3™3Kšœžœžœ˜/Kš
œ™Kšœžœžœ˜0Kšžœžœ˜Kšžœ˜
Kšœ *˜-—Kšœžœžœ˜$Kšžœ	žœ
žœ
˜K˜˜
šžœž˜#˜šžœ	žœ
žœ-ž˜KKšžœ˜——Kšœžœ
˜Kšœžœžœ
žœ˜$Kš	œžœ
žœžœ
žœ˜(Kšžœžœ
˜—š
ž˜˜
K˜K˜,šžœžœ˜Kš
œ™K˜K˜K˜—K˜——K˜—K˜K˜—š
Ÿ
œžœ
žœžœžœ˜HKš
œ"˜"Kšœžœ˜1Kšžœ˜
K˜K˜—šŸ
œžœ
žœžœžœžœ˜EKš
žœžœ	žœžœ	žœ˜DKš
œ˜K˜—š
Ÿœžœ
žœžœžœ˜DKšžœ!˜'Kš
œ˜K˜—š
Ÿœžœ
žœžœžœ˜DKš
œ˜Kšžœ˜
Kš
œ˜K˜—šŸœžœ
žœžœ
žœžœ˜4Kšžœžœ
žœ
˜#šžœžœ˜šžœžœžœ&ž˜IK˜—K˜—Kšžœ
žœ)žœ
˜=šžœžœ&žœž˜QKšœ
žœ*žœ˜H—Kšžœ
žœžœ˜1K˜K˜—š
Ÿœžœ
žœžœ*žœ˜gK˜"Kšœžœ
˜
K˜.K˜0K˜/K˜/Kš
œC˜CK˜/Kšžœ	˜K˜K˜—Kš
œ'™'K˜šŸ
œžœ
žœžœ
žœžœ˜:Kšžœžœ
žœ
˜šžœžœ&ž˜;Kš
œ ˜ Kš
œ˜Kšžœ
˜—K˜K˜—Kš
œt™tK˜šŸœžœ
žœžœ
žœ
žœžœ˜HKšœžœ˜Kšžœžœ
žœ
˜šžœž˜Kšœžœžœ˜6Kš
œ,˜,Kšžœ
˜—šžœžœžœ˜Kšœžœ˜1Kšœžœ
˜Kš
œ˜—K˜K˜—š
Ÿ
œžœ
žœžœžœ˜IKšžœD˜JK˜K˜—šŸ
œžœ
žœžœžœ
žœžœ˜SK˜K˜K˜K˜Kšœžœ
˜K˜K˜—šŸœžœ
žœžœ˜!Kš
œ™Kšžœžœ ˜IK˜K˜—Kšžœ
˜—Kšž
œžœ˜4Kšž
œžœ'˜HKšž
œžœ˜2Kšž
œžœ˜(Kšœžœž
œ)˜EKšœžœž
œ˜8Kšœž
œ0˜DKšœž
œžœ	˜/Kšœž
œžœž˜4Kšœž
œ˜4—…— Β4