IeeePack.mesa - Ieee Floating Point Package for compiler (Ieee + IeeeIOA + IeeeUtil)
Copyright © 1985 by Xerox Corporation. All rights reserved.
Satterthwaite, April 16, 1986 3:10:48 pm PST
Maxwell, August 11, 1983 8:36 am
Russ Atkinson (RRA) March 6, 1985 10:29:58 pm PST
DIRECTORY
Basics: TYPE USING [BITAND, BITOR, BITSHIFT, BITXOR, LongMult, LongNumber],
Real:
TYPE
USING [Exception, ExceptionFlags, Extended, MinusInfinity, MinusZero, Mode, NoExceptions, NumberType, PlusInfinity, PlusZero, TrapNonTrappingNaN, TrapTrappingNaN];
IeeePack:
PROGRAM
IMPORTS Basics
EXPORTS Real = {
OPEN Basics, Real;
RealException: PUBLIC SIGNAL[flags: ExceptionFlags] = CODE;
from Ieee.Mesa
Details:
TYPE =
MACHINE
DEPENDENT
RECORD[
sign: BOOL,
sticky: BOOL,
blank: [0..7777b],
type: Real.NumberType];
Ext:
TYPE =
RECORD[
det: Details,
exp: INTEGER,
frac: LongNumber];
constants
HiBit: CARDINAL = 100000b;
ExponentBias: INTEGER = 127;
ExponentMask: INTEGER = 077600b;
ExponentShift: INTEGER = 7;
HiFractionMask: INTEGER = 177b;
FractionShift: INTEGER = 8;
LeastSignificandBit: INTEGER = 0400b;
HiddenBit: CARDINAL = 100000b;
StickyBits: CARDINAL = 77b;
HalfLC: LONG CARDINAL = 20000000000b;
SignBit: CARDINAL = 100000b;
ExpSingleMax: INTEGER = 127;
ExpSingleMin: INTEGER = -126;
DenormalizedExponent: INTEGER = -127;
NaNExponent: INTEGER = 128;
BiasAdjust: INTEGER = 192;
global variables
fpmode: Mode = [nm: warning, round: rn];
enableFlags: ExceptionFlags = [invalidOperation: TRUE, divisionByZero: TRUE, overflow: TRUE];
thisTimeExceptions: ExceptionFlags;
LN:
PROC[r:
LONG
UNSPECIFIED]
RETURNS[LongNumber] =
INLINE {
RETURN[LOOPHOLE[r, LongNumber]]};
BitOn:
PROC[a, b:
UNSPECIFIED]
RETURNS[
BOOL] =
INLINE {
RETURN[BITAND[a, b]#0]};
Normalized:
PROC[g:
INTEGER]
RETURNS[
BOOL] =
INLINE {
RETURN[BITAND[g, HiddenBit]#0]};
Add with Carry
ADC3:
PROC[a, b, c:
CARDINAL]
RETURNS [
CARDINAL,
CARDINAL] =
INLINE {
s: LongNumber;
s.lc ← a.LONG+b.LONG+c.LONG;
RETURN[s.highbits, s.lowbits]};
from IeeeIOA
PowTen:
TYPE =
RECORD[
f: LONG CARDINAL,
e: INTEGER];
TenTable:
TYPE =
RECORD[
tens: ARRAY [0..13] OF PowTen,
t26, t39: PowTen];
posTable: TenTable = [
tens: [
[ 20000000000b, 0], [ 24000000000b, 3],
[ 31000000000b, 6], [ 37200000000b, 9],
[ 23420000000b, 13], [ 30324000000b, 16],
[ 36411000000b, 19], [ 23045500000b, 23],
[ 27657020000b, 26], [ 35632624000b, 29],
[ 22500574400b, 33], [ 27220733500b, 36],
[ 35065122420b, 39], [ 22141163452b, 43]],
t26: [24533722672b, 86],
t39: [27405037645b, 129]];
negTable: TenTable = [
tens: [
[ 20000000000b, 0], [ 31463146315b, -4],
[ 24365605075b, -7], [ 20304467230b, -10],
[ 32155613531b, -14], [ 24761326107b, -17],
[ 20615736406b, -20], [ 32657712326b, -24],
[ 25363073422b, -27], [ 21134057501b, -30],
[ 33371577317b, -34], [ 25772777414b, -37],
[ 21457146011b, -40], [ 34113411502b, -44]],
t26: [30604403045b, -87],
t39: [25616276613b, -130]];
MulExtended:
PROC[x, y: Ext]
RETURNS[z: Ext] = {
hi, lo: LongNumber;
z.exp ← x.exp+y.exp+1;
z.det.sign ← x.det.sign#y.det.sign;
z.det.type ← normal;
z.det.sticky ← x.det.sticky OR y.det.sticky;
[hi, lo] ← Mul32[x.frac, y.frac];
normalize 64
WHILE
NOT BitOn[hi.highbits, HiBit]
DO
hi.lc ← hi.lc+hi.lc;
IF BitOn[lo.highbits, HiBit] THEN hi.lowbits ← BITOR[hi.lowbits, 1];
lo.lc ← lo.lc+lo.lc;
z.exp ← z.exp-1;
ENDLOOP;
z.frac ← hi;
Round to 32 bits.
IF lo.lc>HalfLC
OR (lo.lc=HalfLC
AND BitOn[z.frac.lowbits, 1])
THEN {
Overflow
z.frac.lc ← z.frac.lc+1;
IF z.frac.lc<hi.lc
THEN {
z.frac.lc ← RShift1in1[z.frac.lc];
z.exp ← z.exp+1};
};
IF lo.lc#0 THEN z.det.sticky ← TRUE};
Scale:
PROC[x: Ext, exp10:
INTEGER]
RETURNS[y: Ext] = {
table: TenTable;
mul: PowTen;
big: BOOL;
IF exp10=0 THEN RETURN [x];
big ← exp10<0;
table ← IF big THEN negTable ELSE posTable;
exp10 ← ABS[exp10];
SELECT exp10
FROM
IN [1..13] => mul ← table.tens[exp10];
IN (13..26) => {
x ← MulExtended[x, CVExt[table.tens[13]]];
mul ← table.tens[exp10-13]};
=26 => mul ← table.t26;
IN (26..39) => {
x ← MulExtended[x, CVExt[table.t26]];
mul ← table.tens[exp10-26]};
=39 => mul ← table.t39;
IN (39..52] => {
x ← MulExtended[x, CVExt[table.t39]];
mul ← table.tens[exp10-39]};
ENDCASE => {
WHILE exp10>52
DO
x ← MulExtended[x, CVExt[table.t39]];
exp10 ← exp10-39;
ENDLOOP;
RETURN[Scale[x, IF big THEN -exp10 ELSE exp10]]};
y ← CVExt[mul];
y ← MulExtended[x, y]};
CVExt:
PROC[t: PowTen]
RETURNS[y: Ext] = {
y.det.sticky ← y.det.sign ← FALSE;
y.det.type ← normal;
y.frac.lc ← t.f;
y.exp ← t.e};
PairToReal:
PUBLIC
PROC[fr:
LONG
INTEGER, exp10:
INTEGER]
RETURNS[
REAL] = {
y: Ext;
or: RoundingMode ← fpmode.round;
fpmode.round ← rn;
thisTimeExceptions ← NoExceptions;
IF fr=0 THEN RETURN[PlusZero];
y.exp ← 31;
y.det.sign ← fr<0;
y.det.sticky ← FALSE;
y.det.type ← normal;
y.frac.li ← IF y.det.sign THEN -fr ELSE fr;
PostNormalize[@y];
y ← Scale[y, exp10];
StepTwo[@y];
fpmode.round ← or;
RETURN[Pack[@y]]};
from IeeeFloatA (adapted)
RealToExtended:
PUBLIC
PROC[a:
REAL]
RETURNS[Real.Extended] = {
ext: Ext = Unpack[a];
RETURN[[type: ext.det.type, sign: ext.det.sign, exp: ext.exp, frac: ext.frac.lc]]};
ExtendedToReal:
PUBLIC
PROC[e: Real.Extended]
RETURNS[
REAL] = {
ext: Ext ← [
det: [sign: e.sign, sticky: FALSE, blank: 0, type: e.type],
exp: e.exp, frac: [lc[e.frac]]];
RETURN[Pack[@ext]]};
Negate:
PUBLIC
PROC[a:
REAL]
RETURNS[
REAL] = {
IF LN[a] = LN[PlusZero] THEN RETURN[PlusZero];
Negate a
LOOPHOLE[a, LongNumber].highbits ← BITXOR[LN[a].highbits, SignBit];
RETURN[a]};
Abs:
PUBLIC
PROC[a:
REAL]
RETURNS[
REAL] = {
RETURN[IF BitOn[LN[a].highbits, SignBit] THEN Negate[a] ELSE a]};
from IEEEUtil
SetInexactResult:
PROC = {
thisTimeExceptions[inexactResult] ← TRUE};
SetInvalidOperation:
PROC = {
thisTimeExceptions[invalidOperation] ← TRUE};
SetUnderflow:
PROC[z:
POINTER
TO Ext] = {
thisTimeExceptions[underflow] ← TRUE};
SetOverflow:
PROC[z:
POINTER
TO Ext] = {
thisTimeExceptions[overflow] ← TRUE};
Separate the packed REAL into its component elements
Unpack:
PUBLIC
PROC[r:
REAL]
RETURNS[z: Ext] = {
z.det.sticky ← FALSE;
z.det.sign ← BitOn[LN[r].highbits, HiBit]; -- first r.j. the exponent
z.exp ← Basics.
BITSHIFT[
Basics.BITAND[LN[r].highbits, ExponentMask], -ExponentShift];
z.exp ← z.exp - ExponentBias;
z.det.type ← normal;
z.frac.li ← LN[r].li;
z.frac.highbits ← Basics.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 ← Basics.BITOR[HiddenBit, z.frac.highbits]};
};
Stuff the components back into the packed REAL.
Pack:
PROC[z:
POINTER
TO Ext]
RETURNS[r:
REAL] = {
trap: BOOL ← FALSE;
i: Exception;
IF thisTimeExceptions#NoExceptions
THEN {
Possible typo in standard here!!!
IF thisTimeExceptions[invalidOperation]
THEN {
z.det.type ← nan;
IF z.frac.lc=0 THEN z.frac.lc ← TrapNonTrappingNaN};
FOR i
IN Exception
DO
trap ← trap OR (enableFlags[i] AND thisTimeExceptions[i]);
ENDLOOP ;
IF trap
THEN
SIGNAL RealException[flags: thisTimeExceptions];
FixupProcedure[z]};
RETURN[UsualPack[z^]]};
UsualPack:
PROC[z: Ext]
RETURNS[
REAL] = {
SELECT z.det.type
FROM
zero => RETURN [IF z.det.sign THEN MinusZero ELSE PlusZero];
infinity => RETURN [IF z.det.sign THEN MinusInfinity ELSE PlusInfinity];
nan => z.exp ← NaNExponent;
ENDCASE => z.frac.li ← LongShift[z.frac.li, -FractionShift];
clear hidden bit
z.frac.highbits ← BITAND[z.frac.highbits, HiFractionMask];
IF z.exp NOT IN [-127..128] THEN ERROR;
z.exp ← BITSHIFT[z.exp+ExponentBias, ExponentShift];
z.frac.highbits ← BITOR[z.frac.highbits, z.exp];
IF z.det.sign THEN z.frac.highbits ← BITOR[z.frac.highbits, SignBit];
RETURN [LOOPHOLE[z.frac.li, REAL]]};
FixupProcedure:
PROC[vp:
POINTER
TO Ext] = {
IF thisTimeExceptions[underflow]
THEN {
DeNormalize[vp, vp.exp-ExpSingleMin];
vp.exp ← DenormalizedExponent};
IF thisTimeExceptions[overflow]
THEN
vp.det.type ← infinity;
};
Round:
PROC[z:
POINTER
TO Ext] = {
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:
INTEGER]
RETURNS [
INTEGER] = {
StickyBits are the set used for rounding to 24 bits
s: BOOL ← BitOn[g, StickyBits] OR z.det.sticky;
Should flush these constants
g ← BITSHIFT[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[];
BEGIN
SELECT fpmode.round
FROM
rn => {
IF z.det.sign THEN grs ← 8-grs;
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};
};
END};
RShift1in1:
PROC[z:
LONG
UNSPECIFIED]
RETURNS[
LONG
UNSPECIFIED] = {
vl: LongNumber;
vl.lc ← z;
vl.lowbits ← BITSHIFT[vl.lowbits, -1];
IF BitOn[vl.highbits, 1] THEN vl.lowbits ← BITOR[vl.lowbits, HiBit];
vl.highbits ← BITOR[HiddenBit, BITSHIFT[vl.highbits, -1]];
RETURN [vl.lc]};
LShift:
PROC[z:
LONG
UNSPECIFIED]
RETURNS[
LONG
UNSPECIFIED] = {
vl: LongNumber;
vl.lc ← z;
vl.highbits ← BITSHIFT[vl.highbits, 1];
IF BitOn[vl.lowbits, HiBit] THEN vl.highbits ← BITOR[vl.highbits, 1];
vl.lowbits ← BITSHIFT[vl.lowbits, 1];
RETURN [vl.lc]};
StepTwo:
PROC[z:
POINTER
TO Ext] = {
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]};
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:
PROC[x, y: LongNumber]
RETURNS[LongNumber, LongNumber] = {
hi, lo, t1, t2: LongNumber;
cy: CARDINAL;
lo.lc ← LongMult[x.lowbits, y.lowbits];
hi.lc ← LongMult[x.highbits, y.highbits];
t1.lc ← LongMult[x.highbits, y.lowbits];
t2.lc ← LongMult[x.lowbits, y.highbits];
[cy, lo.highbits] ← 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:
PROC[z:
POINTER
TO Ext] = {
IF z.frac.lc=0 THEN ERROR;
WHILE
BITAND[z.frac.highbits, HiddenBit]=0
DO
z.frac.lc ← LShift[z.frac.lc];
z.exp ← z.exp-1;
ENDLOOP;
};
positive count is left shift, negative is right shift
LongShift:
PROC[z:
LONG
UNSPECIFIED, count:
INTEGER]
RETURNS[
LONG
UNSPECIFIED] = {
xl, vl: LongNumber;
vl.lc ← z;
SELECT count
FROM
NOT IN (-32..32) => RETURN [0];
0 => RETURN [vl.lc];
IN [16..32) => {
xl.highbits ← BITSHIFT[vl.lowbits,count-16];
xl.lowbits ← 0};
IN (0..16) => {
xl.highbits ← BITSHIFT[vl.highbits, count] + BITSHIFT[vl.lowbits,count-16];
xl.lowbits ← BITSHIFT[vl.lowbits, count]};
IN (-16..0) => {
xl.highbits ← BITSHIFT[vl.highbits, count];
xl.lowbits ← BITSHIFT[vl.lowbits, count] + BITSHIFT[vl.highbits,count+16]};
IN (-32..-16] => {
xl.highbits ← 0;
xl.lowbits ← BITSHIFT[vl.highbits,count+16]};
ENDCASE => ERROR;
RETURN[xl.lc]};
DeNormalize is much like LongShift, except that it maintains the sticky bits on the right. And it only shifts right.
DeNormalize:
PROC[z:
POINTER
TO Ext, count:
INTEGER] = {
sMask:
ARRAY [1..16)
OF
CARDINAL = [
1b, 3b, 7b, 17b, 37b, 77b, 177b, 377b, 777b, 1777b, 3777b, 7777b, 17777b, 37777b, 77777b];
Mask off everything but the bits contributing to S, then set or clear S in the result.
IF count>0 THEN ERROR;
IF count=0 THEN RETURN;
count ← -count;
z.det.sticky ←
SELECT count
FROM
=16 => z.frac.lowbits#0,
IN [1..16) => BitOn[z.frac.lowbits, sMask[count]],
IN (16..32) => z.frac.lowbits#0 OR BitOn[z.frac.highbits, sMask[count-16]],
ENDCASE => z.frac.lc#0;
z.frac.lc ← LongShift[z.frac.lc, -count]};
}.