RealSupportImpl.mesa
Copyright Ó 1989, 1990, 1991 by Xerox Corporation. All rights reserved.
Russ Atkinson (RRA) December 27, 1990 11:04 pm PST
DIRECTORY
FloatingPointCommon USING [Error, NumberType],
RealSupport;
RealSupportImpl: CEDAR PROGRAM
IMPORTS FloatingPointCommon
EXPORTS RealSupport
= BEGIN OPEN RealSupport;
NumberType: TYPE = FloatingPointCommon.NumberType;
PREAL: TYPE = POINTER TO REAL;
Types & constants
SingleReal: TYPE = MACHINE DEPENDENT RECORD [sign: BOOL, exp: Exponent, m: Mantissa];
According to the IEEE standard for 32-bit floating-point
Exponent: TYPE = CARDINAL [0..377B];
maxNormalExp: NAT = Exponent.LAST-1;
nanExp: NAT = Exponent.LAST;
Mantissa: TYPE = CARDINAL [0..37777777B];
maxMantissa: Mantissa = Mantissa.LAST;
Public procedures written in Mesa
Classify: PUBLIC PROC [d: REAL] RETURNS [NumberType] = TRUSTED {
f: SingleReal ¬ LOOPHOLE[d];
SELECT f.exp FROM
0 => IF f.m = 0 THEN RETURN [zero] ELSE RETURN [subnormal];
nanExp =>
SELECT f.m FROM
0 => RETURN [infinity];
1 => RETURN [quiet];
ENDCASE => RETURN [signaling];
ENDCASE => RETURN [normal];
};
Example: PUBLIC PROC [c: NumberType, min: BOOL ¬ FALSE] RETURNS [REAL] = TRUSTED {
f: SingleReal ¬ [FALSE, 0, 0];
SELECT c FROM
zero => {};
subnormal => IF min THEN f.m ¬ 1 ELSE f.m ¬ maxMantissa;
normal => IF min THEN f.exp ¬ 1 ELSE {f.exp ¬ maxNormalExp; f.m ¬ maxMantissa};
infinity => f.exp ¬ nanExp;
quiet => {f.exp ¬ nanExp; f.m ¬ 1};
signaling => {f.exp ¬ nanExp; f.m ¬ 2};
ENDCASE;
RETURN [LOOPHOLE[f]];
};
IntToReal: PUBLIC PROC [i: INT] RETURNS [ret: REAL] = TRUSTED {
ret ¬ i;
};
CardToReal: PUBLIC PROC [c: CARD] RETURNS [ret: REAL] = TRUSTED {
ret ¬ c;
};
Fix: PUBLIC PROC [x: REAL] RETURNS [INT] = {
... rounds toward zero (error if outside the INT range)
IF NOT InRange[x] THEN OtherError[];
RETURN [MCFix[x]]
};
Round: PUBLIC PROC [x: REAL] RETURNS [INT] = {
... rounds toward nearest (error if outside the INT range)
IF NOT InRange[x] THEN OtherError[];
RETURN [MCRound[x]]
};
FScale: PUBLIC PROC [a: REAL, scale: INTEGER] RETURNS [REAL] = {
r: 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]
};
};
Neg: PUBLIC PROC [d: REAL] RETURNS [ret: REAL] = TRUSTED {
f: SingleReal ¬ LOOPHOLE[d];
f.sign ¬ NOT f.sign;
ret ¬ LOOPHOLE[f];
};
InlineAbs: PROC [r: REAL] RETURNS [REAL] = INLINE {
This is VERY IEEE dependent
RETURN [LOOPHOLE[(LOOPHOLE[r, CARD]*2)/2, REAL]]
};
Abs: PUBLIC PROC [d: REAL] RETURNS [ret: REAL] = TRUSTED {
ret ¬ InlineAbs[d];
};
Add: PUBLIC PROC [x, y: REAL] RETURNS [ret: REAL] = TRUSTED {
ret ¬ x + y;
};
Sub: PUBLIC PROC [x, y: REAL] RETURNS [ret: REAL] = TRUSTED {
ret ¬ x - y;
};
Mul: PUBLIC PROC [x, y: REAL] RETURNS [ret: REAL] = TRUSTED {
ret ¬ x * y;
};
Div: PUBLIC PROC [x, y: REAL] RETURNS [ret: REAL] = TRUSTED {
ret ¬ x / y;
};
Gt: PUBLIC PROC [x, y: REAL] RETURNS [BOOL] = TRUSTED {
RETURN [x > y];
};
Ge: PUBLIC PROC [x, y: REAL] RETURNS [BOOL] = TRUSTED {
RETURN [x >= y];
};
Lt: PUBLIC PROC [x, y: REAL] RETURNS [BOOL] = TRUSTED {
RETURN [x < y];
};
Le: PUBLIC PROC [x, y: REAL] RETURNS [BOOL] = TRUSTED {
RETURN [x <= y];
};
Eq: PUBLIC PROC [x, y: REAL] RETURNS [BOOL] = TRUSTED {
RETURN [x = y];
};
Ne: PUBLIC PROC [x, y: REAL] RETURNS [BOOL] = TRUSTED {
RETURN [x # y];
};
Min: PUBLIC PROC [x, y: REAL] RETURNS [ret: REAL] = TRUSTED {
ret ¬ MIN[x, y];
};
Max: PUBLIC PROC [x, y: REAL] RETURNS [ret: REAL] = TRUSTED {
ret ¬ MAX[x, y];
};
Pwr: PUBLIC PROC [x, y: REAL] RETURNS [ret: REAL] = TRUSTED {
ret ¬ x ** y;
};
Floor: PUBLIC PROC [x: REAL] RETURNS [ret: REAL] = TRUSTED {
IF NOT InRange[x] THEN OtherError[];
RETURN [MCFloor[x]]
};
Ceiling: PUBLIC PROC [x: REAL] RETURNS [ret: REAL] = TRUSTED {
IF NOT InRange[x] THEN OtherError[];
RETURN [MCCeiling[x]]
};
Support procedures
MCFix: PROC [REAL] RETURNS [INT] ~ TRUSTED MACHINE CODE {
"XR←REAL32𡤏ix"
};
MCRound: PROC [REAL] RETURNS [INT] ~ TRUSTED MACHINE CODE {
"XR←REAL32←Round"
};
MCCeiling: PROC [REAL] RETURNS [INT] ~ TRUSTED MACHINE CODE {
"XR←REAL32�iling"
};
MCFloor: PROC [REAL] RETURNS [INT] ~ TRUSTED MACHINE CODE {
"XR←REAL32𡤏loor"
};
floatLastInt: REAL ¬ INT.LAST;
QuickEq: PROC [x, y: REAL] RETURNS [BOOL] = INLINE {
RETURN [LOOPHOLE[x, CARD] = LOOPHOLE[y, CARD]];
};
QuickLt: PROC [x, y: REAL] RETURNS [BOOL] = INLINE {
RETURN [LOOPHOLE[x, INT] < LOOPHOLE[y, INT]];
};
InRange: PROC [a: REAL] RETURNS [BOOL] ~ INLINE {
RETURN [LOOPHOLE[InlineAbs[a], CARD] <= LOOPHOLE[floatLastInt, CARD]];
};
OtherError: PROC = {
ERROR FloatingPointCommon.Error[other];
};
END.