-- IeeeUtil.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
DIRECTORY
Basics USING [LongMult, LongNumber],
Ieee,
PrincOps,
PrincOpsUtils,
Real,
RealOps USING [DefMode, Mode];
IeeeUtil: CEDAR PROGRAM IMPORTS Ieee, PrincOpsUtils, Real EXPORTS Ieee =
BEGIN OPEN Ieee, 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 Ieee.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 [z: POINTER TO Ext] = TRUSTED {
IF z.det.type # normal THEN RETURN;
IF z.exp <= ExpSingleMin THEN {
IF z.exp < ExpSingleMin OR (NOT Normalized[z.frac.highbits]) THEN
SetUnderflow[z];
};
IF NOT thisTimeExceptions[underflow] THEN Round[z];
IF (NOT Normalized[z.frac.highbits]) AND z.exp # DenormalizedExponent AND
(NOT thisTimeExceptions[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];
};
-- Post Normalize. S does not participate
PostNormalize: PUBLIC PROC [z: POINTER TO Ext] = TRUSTED {
IF z.frac.lc = 0 THEN ERROR;
WHILE NOT Ieee.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: 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 {
-- This will get the globals.
IF Real.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