DIRECTORY
Basics USING [LongMult, LongNumber],
IeeeInternal,
PrincOps,
PrincOpsUtils,
Real,
RealOps USING [DefMode, Mode];

DragonRealIeeeD: CEDAR PROGRAM IMPORTS Basics, IeeeInternal, PrincOpsUtils, Real EXPORTS IeeeInternal =
BEGIN OPEN IeeeInternal, Real;

fpmode: PUBLIC RealOps.Mode _ RealOps.DefMode;
thisTimeExceptions: PUBLIC Real.ExceptionFlags _ Real.NoExceptions;
stickyFlags: PUBLIC Real.ExceptionFlags _ Real.NoExceptions;

SetInexactResult: PUBLIC PROC = {thisTimeExceptions[inexactResult] _ TRUE; };

SetInvalidOperation: PUBLIC PROC = {
thisTimeExceptions[invalidOperation] _ TRUE; };

SetDivisionByZero: PUBLIC PROC = {thisTimeExceptions[divisionByZero] _ TRUE; };

SetUnderflow: PUBLIC PROC [z: POINTER TO Ext] = {
thisTimeExceptions[underflow] _ TRUE; };

SetOverflow: PUBLIC PROC [z: POINTER TO Ext] = {
thisTimeExceptions[overflow] _ TRUE; };

SetFixOverflow: PUBLIC PROC = {
thisTimeExceptions[fixOverflow] _ TRUE; stickyFlags[fixOverflow] _ TRUE; };


Unpack: PUBLIC PROC [r: REAL] RETURNS [z: Ext] = TRUSTED {
z.det.sticky _ FALSE;
z.det.sign _ BitOn[LN[r].highbits, HiBit]; -- first r.j. the exponent
z.exp _ PrincOpsUtils.BITSHIFT[
PrincOpsUtils.BITAND[LN[r].highbits, ExponentMask], -ExponentShift];
z.exp _ z.exp - ExponentBias;
z.det.type _ normal;
z.frac.li _ LN[r].li;
z.frac.highbits _ PrincOpsUtils.BITAND[HiFractionMask, z.frac.highbits];
SELECT z.exp FROM
= DenormalizedExponent => {
IF z.frac.li = 0 THEN z.det.type _ zero
ELSE {
z.exp _ ExpSingleMin;
z.frac.li _ LongShift[z.frac.li, FractionShift];
IF fpmode.nm = normalizing THEN 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.li _ LongShift[z.frac.li, FractionShift];
z.frac.highbits _ PrincOpsUtils.BITOR[HiddenBit, z.frac.highbits];
};
};


Pack: PUBLIC PROC [z: POINTER TO Ext] RETURNS [r: REAL] = TRUSTED {
trap: BOOLEAN _ FALSE;
p: REF Extended _ NIL;
clientFix: BOOL;
i: Exception;
IF thisTimeExceptions # NoExceptions THEN {
IF thisTimeExceptions[invalidOperation] THEN {
z.det.type _ nan; IF z.frac.lc = 0 THEN z.frac.lc _ TrapNonTrappingNaN; };
FOR i IN Exception DO
stickyFlags[i] _ stickyFlags[i] OR thisTimeExceptions[i];
trap _ trap OR (fpmode.traps[i] AND thisTimeExceptions[i]);
ENDLOOP;
IF trap THEN {
p _ NEW[Extended _ CVExtended[z^]];
clientFix _ SIGNAL Real.RealException[flags: thisTimeExceptions, 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 {
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.li _ LongShift[z.frac.li, -FractionShift];
z.frac.highbits _ PrincOpsUtils.BITAND[z.frac.highbits, HiFractionMask];
IF z.exp NOT IN [-127..128] THEN ERROR;
z.exp _ PrincOpsUtils.BITSHIFT[z.exp + ExponentBias, ExponentShift];
z.frac.highbits _ PrincOpsUtils.BITOR[z.frac.highbits, z.exp];
IF z.det.sign THEN z.frac.highbits _ PrincOpsUtils.BITOR[z.frac.highbits, SignBit];
RETURN[LOOPHOLE[z.frac.li, REAL]];
};

FixupProcedure: PUBLIC PROC [vp: POINTER TO Ext] = TRUSTED {
IF thisTimeExceptions[underflow] THEN {
DeNormalize[vp, vp.exp - ExpSingleMin];
vp.exp _ DenormalizedExponent;
Round[vp];
IF vp.exp # DenormalizedExponent THEN {
vp.frac.lc _ RShift[vp.frac.lc]; vp.exp _ DenormalizedExponent; };
};
IF thisTimeExceptions[overflow] THEN {
stickyFlags[inexactResult] _ TRUE;
SELECT fpmode.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 IeeeInternal.Normalized[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: PUBLIC PROC [g: CARDINAL] RETURNS [INTEGER] = TRUSTED {
s: BOOLEAN _ BitOn[g, StickyBits] OR z.det.sticky;
g _ PrincOpsUtils.BITSHIFT[PrincOpsUtils.BITAND[g, 300B], -5];
IF s THEN g _ g + 1;
RETURN[g];
}; -- The fraction should be normalized here!
grs: INTEGER _ GRS[z.frac.lowbits];
IF grs = 0 THEN RETURN;
SetInexactResult[];
{
SELECT fpmode.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.li _ RShift1in1[z.frac.li];
z.exp _ z.exp + 1;
};
};
};
};

RShift1in1: PUBLIC PROC [z: LONG UNSPECIFIED] RETURNS [LONG UNSPECIFIED] = TRUSTED {
vl: Basics.LongNumber;
vl.lc _ z;
vl.lc _ vl.lc/2;
vl.highbits _ PrincOpsUtils.BITOR[HiddenBit, vl.highbits];
RETURN[vl.lc];
};

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

RShift: PUBLIC PROC [z: LONG UNSPECIFIED] RETURNS [LONG UNSPECIFIED] = TRUSTED {
z _ LOOPHOLE[z, LONG CARDINAL]/2; RETURN[z]; };

LShift: PUBLIC PROC [z: LONG UNSPECIFIED] RETURNS [LONG UNSPECIFIED] = TRUSTED {
z _ LOOPHOLE[z, LONG CARDINAL]*2; RETURN[z]; };

StepTwo: PUBLIC PROC [ext: Ext] = {
IF ext.type # normal THEN RETURN;
IF ~Normalized[ext.sig[0]]	THEN					SetUnderflow[ext]
ELSE	IF ext.double
THEN	IF ext.exp < ExpDoubleMin	THEN	SetUnderflow[ext]
ELSE	IF ext.exp < ExpSingleMin	THEN	SetUnderflow[ext];
IF NOT thisTimeExceptions[underflow] THEN Round[ext];
IF ~Normalized[ext.sig[0]]	AND
  ext.exp # ExpSingleDnorm AND
~thisTimeExceptions[underflow]
THEN											SetInvalidOperation[]
ELSE IF ext.double
THEN	IF ext.exp < ExpDoubleMax	THEN	SetOverflow[ext]
ELSE	IF ext.exp > ExpSingleMax THEN	SetOverflow[ext]};

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] _ IeeeInternal.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 NOT IeeeInternal.BitOn[z.frac.highbits, HiddenBit] DO
z.frac.lc _ LShift[z.frac.lc]; z.exp _ z.exp - 1; ENDLOOP;
};


LongShift: PUBLIC PROC [z: LONG UNSPECIFIED, count: INTEGER]
RETURNS [LONG UNSPECIFIED] = TRUSTED {
vl: Basics.LongNumber;
vl.lc _ z;
IF count >= 0 THEN THROUGH [0..count) DO vl.lc _ vl.lc*2; ENDLOOP
ELSE THROUGH (count..0] DO vl.lc _ vl.lc/2; ENDLOOP;
RETURN[vl.lc];
};


DeNormalize: PUBLIC PROC [z: POINTER TO Ext, count: INTEGER] = TRUSTED {
b: BOOLEAN _ FALSE;
IF count > 0 THEN ERROR;
THROUGH (count..0] DO
b _ b OR BitOn[z.frac.lowbits, 1]; z.frac.lc _ z.frac.lc/2; ENDLOOP;
IF b OR z.det.sticky THEN {
z.frac.lowbits _ PrincOpsUtils.BITOR[z.frac.lowbits, 1]; z.det.sticky _ FALSE; };
};

CVExtended: PUBLIC PROC [z: IeeeInternal.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 IeeeInternal.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 Real.Microcode THEN [] _ IeeeInternal.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 IeeeInternal
”DragonRealIeeeD.mesa
Last Modified: Stewart, August 27, 1982 11:33 am
Last Modified: Paul Rovner, May 4, 1983 9:57 am
IEEE float utilities
Last Edited by: Levin, August 8, 1983 4:35 pm
global variables
Separate the packed REAL into its component elements
denormalized or zero
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;
};
clear hidden bit
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
positive count is left shift, negative is right shift
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.
�ÊÁ˜Jš
Ïb™Jš
œ0™0Jš
œ/™/Jš
œ™Jš
œ-™-J˜š
Ïk	˜	Jšœžœ˜$J˜
J˜	J˜J˜Jšœžœ˜J˜—š
�œžœ
žœ
žœ+žœ˜gJšžœ
žœ˜J˜Jš
œ™Jšœžœ ˜.Jšœžœ)˜CJšœ
žœ)˜<J˜JšÏnœžœ
žœ(žœ˜MJ˜šŸœžœ
žœ˜$Jšœ'žœ˜/J˜—JšŸœžœ
žœ)žœ˜OJ˜š
Ÿœžœ
žœžœ
žœ	˜1Jšœ žœ˜(J˜—š
Ÿœžœ
žœžœ
žœ	˜0Jšœžœ˜'J˜—šŸœžœ
žœ˜Jšœ"žœžœ˜KJ˜—Jš
œ4™4J˜šŸœžœ
žœžœžœžœ˜:Jšœžœ
˜JšœžœÏc˜Ešœžœ
˜Jšœžœ
žœ-˜D—J˜J˜Jšœžœ˜Jšœ žœ"˜Hšžœž˜˜Jš
œ™Jšžœžœ˜'šžœ˜J˜J˜0Jšžœžœ˜2J˜—J˜—˜Jš
œ™Jšžœžœ˜+šžœ˜J˜Jšžœ"žœ˜?J˜—J˜—šžœ˜J˜0Jšœ žœ˜BJ˜——J˜J˜—Jš
œ/™/J˜šŸœžœ
žœžœ
žœžœžœžœ˜CJšœžœžœ
˜Jšœžœžœ
˜Jšœžœ
˜J˜
šžœ#žœ˜+Jš
œ!™!Jš
œ,™,Jš
œH™HJš
œJ™JJš
œ™šžœ&žœ˜.Jšœžœžœ#˜J—šžœžœž˜Jšœ žœ˜9Jšœžœžœ˜;Jšžœ
˜—šžœžœ˜Jšœžœ˜#Jšœžœ6˜HJšžœ
žœžœžœ˜>J˜
—Jšžœ˜J˜—Jšžœ˜J˜J˜—šŸ	œžœ
žœ
žœžœžœ˜:šžœž˜Jš	œžœ
žœžœžœ˜E˜Jšžœ
žœžœžœ˜E—J˜Jšžœ5˜<—Jš
œ™Jšœ žœ"˜HJš
žœžœ
žœ
žœ
žœ
˜'Jšœžœ&˜DJšœ žœ˜>Jšžœžœ!žœ˜SJšžœ
žœžœ˜"J˜J˜—šŸœžœ
žœžœ
žœžœ˜<šžœžœ˜'J˜'J˜J˜
šžœžœ˜'J˜B—J˜—šžœžœ˜&Jšœžœ
˜"šžœž˜Jšœ
žœ
˜Jš	œžœ
žœ
žœ
žœ
˜,Jšœžœ
žœ
žœ
˜(Jšžœžœ
˜—Jšžœ+žœ!˜RJ˜Jšžœ$˜)J˜—J˜J˜—šŸœžœ
žœžœ
žœžœ˜2Jšœžœ
žœ
˜Jš
ϐ
™ê
šžœžœ
žœžœžœžœžœ˜<Jš
œ3™3Jšœžœžœ˜2Jš
œ™Jšœžœžœ˜>Jšžœžœ˜Jšžœ˜
Jšœ *˜-—Jšœžœžœ˜#Jšžœ	žœ
žœ
˜J˜J˜
šžœž˜˜šžœ	žœ
žœ,˜FJšžœ
žœ˜——Jšœžœ
˜Jšœžœžœ
žœ˜$Jš	œžœ
žœžœ
žœ˜(Jšžœžœ
˜—š
ž˜˜
J˜J˜,šžœžœ˜Jš
œ™J˜"J˜J˜—J˜——J˜J˜J˜—šŸ
œžœ
žœžœ
žœžœžœ
žœžœ˜TJ˜J˜
J˜Jšœžœ˜:Jšžœ˜J˜J˜—šŸ
œžœ
žœžœžœžœ˜EJš
žœžœ	žœžœ	žœ˜EJ˜—šŸœžœ
žœžœ
žœžœžœ
žœžœ˜PJš	œžœžœ
žœžœ˜/J˜—šŸœžœ
žœžœ
žœžœžœ
žœžœ˜PJš	œžœžœ
žœžœ˜/J˜—šŸœžœ
žœ˜#Jšžœžœ
žœ
˜!šžœžœ�œ˜5šžœ
žœ˜Jšžœ
žœžœ
�œ˜5Jšžœ
žœžœ
�œ˜6——Jšžœ
žœžœ˜5šžœž˜Jšœž˜š
œ˜Jšžœ�œ˜$šžœ
žœ˜Jšžœ
žœžœ
�œ˜4Jšžœ
žœžœ
�œ˜6————J˜šŸœžœ
žœ˜,Jšžœ*žœ˜:J˜"Jšœžœ
˜
J˜.J˜0J˜/J˜/J˜KJ˜/Jšžœ	˜J˜J˜—Jš
œ'™'J˜šŸ
œžœ
žœžœ
žœžœ˜:Jšžœžœ
žœ
˜šžœ
žœ0ž˜;Jšœ2žœ
˜:—J˜J˜—Jš
œ5™5J˜šŸ	œžœ
žœžœ
žœ	žœ
˜<Jšžœžœ
žœžœ˜&J˜J˜
Jš	žœžœ
žœžœž˜AJšžœ
žœžœžœ
˜4Jšžœ˜J˜J˜—Jš
œt™tJ˜šŸœžœ
žœžœ
žœ
žœžœ˜HJšœžœžœ
˜Jšžœžœ
žœ
˜šžœž˜Jšœžœ4žœ
˜D—šžœžœžœ˜Jšœžœ$žœ˜Q—J˜J˜—š
Ÿ
œžœ
žœžœžœ˜QJšžœD˜JJ˜J˜—šŸ
œžœ
žœžœžœ
žœ˜QJšžœ˜	J˜J˜J˜J˜Jšœžœ
˜J˜J˜—šŸœžœ
žœžœ˜!Jš
œ™Jšžœžœ# ˜QJ˜J˜—Jšžœ
˜—Jšž
œžœ˜4Jšž
œžœ'˜HJšž
œžœ˜2Jšž
œžœ˜(Jšœžœž
œ)˜EJšœžœž
œ˜8Jšœž
œ0˜DJšœž
œžœ	˜/Jšœž
œžœž˜4Jšœž
œ!˜<—…— t0É