RealImpl.mesa
Copyright Ó 1988, 1990, 1991 by Xerox Corporation. All rights reserved.
Michael Plass, March 3, 1988 1:56:02 pm PST
Carl Hauser, March 21, 1988 4:27:13 pm PST
Russ Atkinson (RRA) December 28, 1990 3:50 pm PST
Sun version
Exported to Real
RealException:
PUBLIC
SIGNAL [flags: Real.ExceptionFlags, vp:
REF Real.Extended]
RETURNS [clientFixup:
BOOL] ~
CODE;
RealError:
PUBLIC
ERROR ~
CODE;
FScale:
PUBLIC
PROC [a:
REAL, scale:
INTEGER]
RETURNS [
REAL] ~ {
r: Ieee.SingleReal ¬ LOOPHOLE[a];
exp: INTEGER ¬ r.exp + scale;
IF exp
IN (0..377B)
AND r.exp
IN (0..377B)
THEN { r.exp ¬ exp; RETURN [LOOPHOLE[r]] }
ELSE {
zero, nan, overflow or denormalized case; do it the hard way
IF a = 0.0 THEN RETURN [a];
WHILE scale >= 8 DO scale ¬ scale - 8; a ¬ a * 256.0 ENDLOOP;
WHILE scale > 0 DO scale ¬ scale - 1; a ¬ a+a ENDLOOP;
WHILE -scale >= 8 DO scale ¬ scale + 8; a ¬ a / 256.0 ENDLOOP;
WHILE -scale > 0 DO scale ¬ scale + 1; a ¬ a/2.0 ENDLOOP;
RETURN [a]
};
};
RangeError:
PROC [a:
REAL]
RETURNS [
REAL] ~ {
flags: Real.ExceptionFlags ¬ Real.NoExceptions;
vp: REF Real.Extended ¬ NIL; -- fix this someday to allow fixups by clients
flags[fixOverflow] ¬ TRUE;
IF (SIGNAL RealException[flags: flags, vp: vp]) THEN {--fix this--};
RETURN [a]
};
Fix:
PUBLIC
PROC [a:
REAL]
RETURNS [
INT] ~ {
IF NOT RealInline.IsValid[a] THEN a ¬ RangeError[a];
RETURN [RealInline.MCFix[a]]
};
Round:
PUBLIC
PROC [a:
REAL]
RETURNS [
INT] ~ {
IF NOT RealInline.IsValid[a] THEN a ¬ RangeError[a];
RETURN [RealInline.MCRound[a]]
};
Ceiling:
PUBLIC
PROC [a:
REAL]
RETURNS [
INT] ~ {
IF NOT RealInline.IsValid[a] THEN a ¬ RangeError[a];
RETURN [RealInline.MCCeiling[a]]
};
Floor:
PUBLIC
PROC [a:
REAL]
RETURNS [
INT] ~ {
IF NOT RealInline.IsValid[a] THEN a ¬ RangeError[a];
RETURN [RealInline.MCFloor[a]]
};
PairToReal:
PUBLIC
PROC [fr:
INT, exp10:
INTEGER]
RETURNS [
REAL] ~ {
This generates more roundoff than it should - mfp
a: REAL ¬ fr;
i: INTEGER ¬ exp10;
lim: NAT = PowerTenArrayIndex.LAST;
DO
SELECT i
FROM
> lim => {a ¬ a*tenToThe[lim]; i ¬ i - lim; LOOP};
< -lim => {a ¬ a/tenToThe[lim]; i ¬ i + lim; LOOP};
> 0 => a ¬ a*tenToThe[i];
< 0 => a ¬ a/tenToThe[-i];
ENDCASE;
RETURN [a];
ENDLOOP;
};
tenToThe:
REF PowerTenArray ¬ PowersOfTen[];
PowerTenArray: TYPE = ARRAY PowerTenArrayIndex OF REAL;
PowerTenArrayIndex: TYPE = [0..20];
PowersOfTen:
PROC
RETURNS [
REF PowerTenArray] ~ {
t: REF PowerTenArray ¬ NEW[PowerTenArray ¬ [0.0, 1e1, 1e2, 1e3, 1e4, 1e5, 1e6, 1e7, 1e8, 1e9, 1e10, 1e11, 1e12, 1e13, 1e14, 1e15, 1e16, 1e17, 1e18, 1e19, 1e20]];
RETURN [t]
};
RealToPair:
PUBLIC
PROC [r:
REAL, precision:
NAT ¬ Real.DefaultSinglePrecision]
RETURNS [type: Real.NumberType, fr:
INT, exp10:
INTEGER] ~ {
This generates more roundoff than it should - mfp
rep: Ieee.SingleReal ¬ LOOPHOLE[r];
IF precision > PowerTenArrayIndex.LAST THEN precision ¬ PowerTenArrayIndex.LAST;
SELECT
TRUE
FROM
rep.exp < 255 => {
a: REAL ¬ RealInline.Abs[r];
IF a <= 0.0 THEN RETURN [type: zero, fr: 0, exp10: 0];
exp10 ¬ 0;
type ¬ normal;
WHILE a < tenToThe[precision] DO a ¬ a*10.0; exp10 ¬ exp10-1 ENDLOOP;
WHILE a >= tenToThe[precision] DO a ¬ a/10.0; exp10 ¬ exp10+1 ENDLOOP;
fr ¬ Round[IF r < 0 THEN -a ELSE a];
};
rep =
LOOPHOLE[Real.PlusInfinity] =>
RETURN [type: infinity, fr: INT.LAST, exp10: INTEGER.LAST];
rep =
LOOPHOLE[Real.MinusInfinity] =>
RETURN [type: infinity, fr: INT.FIRST, exp10: INTEGER.LAST];
ENDCASE =>
RETURN [type: nan, fr: rep.m, exp10: 0];
};
Exported to Ieee
CVExtended:
PUBLIC
PROC [z: Ieee.Ext]
RETURNS [Real.Extended] = {
ERROR; -- Not Yet Implemented
};
Pack:
PUBLIC
PROC [z:
POINTER
TO Ieee.Ext]
RETURNS [r:
REAL] = {
ERROR; -- Not Yet Implemented
};
UsualPack:
PUBLIC
PROC [z: Ieee.Ext]
RETURNS [
REAL] = {
ERROR; -- Not Yet Implemented
};
Unpack:
PUBLIC
PROC [r:
REAL]
RETURNS [z: Ieee.Ext] = {
ERROR; -- Not Yet Implemented
};