DragonRealIeeeD:
CEDAR
PROGRAM
IMPORTS Basics, IeeeInternal, PrincOpsUtils, Real
EXPORTS IeeeInternal =
BEGIN OPEN IeeeInternal, Real;
global variables
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; };
Separate the packed REAL into its component elements
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 => {
denormalized or zero
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 => {
infinity or nan
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];
};
};
Stuff the components back into the packed REAL.
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 {
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;
};
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];
clear hidden bit
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;
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.
GRS:
PUBLIC
PROC [g:
CARDINAL]
RETURNS [
INTEGER] =
TRUSTED {
StickyBits are the set used for rounding to 24 bits
s: BOOLEAN ← BitOn[g, StickyBits] OR z.det.sticky;
Should flush these constants
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 {
better overflow detect!
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];
};
Post Normalize. S does not participate
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;
};
positive count is left shift, negative is right shift
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 is much like LongShift, except that it maintains the sticky bits on the right. And it only shifts right.
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 {
This will get the globals.
IF Real.Microcode THEN [] ← IeeeInternal.MicroSticky[0]; -- disable uCode IR trap
};
END.