IeeeUtil.mesa - IEEE float utilities
Copyright © 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
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;
obsolete global variables
fpmode: PUBLIC RealOps.Mode ← RealOps.DefMode;
thisTimeExceptions: PUBLIC Real.ExceptionFlags ← Real.NoExceptions;
stickyFlags: PUBLIC Real.ExceptionFlags ← Real.NoExceptions;
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];
};
Separate the packed REAL into its component elements
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 => {
denormalized or zero
IF z.frac.li = 0
THEN z.det.type ← zero
ELSE {
z.exp ← ExpSingleMin;
z.frac ← Basics.DoubleShift[z.frac, FractionShift];
PostNormalize[@z];
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];
};
};
= 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 ← Basics.DoubleShift[z.frac, FractionShift];
z.frac.highbits ← Basics.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: BOOL ← FALSE;
i: Exception;
exceptions: Real.ExceptionFlags ← RealExceptions.GetExceptions[];
IF exceptions # 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;
};
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];
RRA: this used to be ERROR, it is better to forgive, I think
> ExponentBias+1 =>
RETURN [IF z.det.sign THEN Real.MinusInfinity ELSE Real.PlusInfinity];
RRA: this used to be ERROR, it is better to forgive, I think
ENDCASE;
mash stuff into the single precision format
single ←
LOOPHOLE[z.frac.real];
just to set m1 & m2, leaves garbage in exp & sign
single.exp ← exp+ExponentBias;
guaranteed to be in [0..ExponentBias*2) by above tests
single.sign ← z.det.sign;
simple boolean transfer of the 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;
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:
PROC [g:
CARDINAL]
RETURNS [
CARDINAL] =
TRUSTED {
StickyBits are the set used for rounding to 24 bits
s: BOOL ← BitOn[g, StickyBits] OR z.det.sticky;
Should flush these constants
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 {
better overflow detect!
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];
};
Post Normalize. S does not participate
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 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: 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 {
This will get the globals.
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