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; SingleReal: TYPE = MACHINE DEPENDENT RECORD [sign: BOOL, exp: Exponent, m: Mantissa]; Exponent: TYPE = CARDINAL [0..377B]; maxNormalExp: NAT = Exponent.LAST-1; nanExp: NAT = Exponent.LAST; Mantissa: TYPE = CARDINAL [0..37777777B]; maxMantissa: Mantissa = Mantissa.LAST; 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] = { IF NOT InRange[x] THEN OtherError[]; RETURN [MCFix[x]] }; Round: PUBLIC PROC [x: REAL] RETURNS [INT] = { 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 { 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 { 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]] }; MCFix: PROC [REAL] RETURNS [INT] ~ TRUSTED MACHINE CODE { "XR_REAL32_Fix" }; MCRound: PROC [REAL] RETURNS [INT] ~ TRUSTED MACHINE CODE { "XR_REAL32_Round" }; MCCeiling: PROC [REAL] RETURNS [INT] ~ TRUSTED MACHINE CODE { "XR_REAL32_Ceiling" }; MCFloor: PROC [REAL] RETURNS [INT] ~ TRUSTED MACHINE CODE { "XR_REAL32_Floor" }; 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. ϊ RealSupportImpl.mesa Copyright Σ 1989, 1990, 1991 by Xerox Corporation. All rights reserved. Russ Atkinson (RRA) December 27, 1990 11:04 pm PST Types & constants According to the IEEE standard for 32-bit floating-point Public procedures written in Mesa ... rounds toward zero (error if outside the INT range) ... rounds toward nearest (error if outside the INT range) zero, nan, overflow or denormalized case; do it the hard way This is VERY IEEE dependent Support procedures Κ Μ–(cedarcode) style•NewlineDelimiter ™headšœ™Icodešœ Οeœ=™HL™2L™šΟk ˜ Lšœžœ˜.Lšœ ˜ —L˜—šœž ˜Lšžœ˜Lšžœ ˜Lšœžœžœ ˜L˜Lšœ žœ"˜2L˜Lš žœžœžœžœžœ˜—™š œ žœžœž œžœžœ˜ULšœžœ#™8L˜—šœ žœžœ ˜$Lšœžœ žœ˜$Lšœžœ žœ˜—šœ žœžœ˜)Lšœ!žœ˜&——™!š Οnœžœžœžœžœžœ˜@Lšœžœ˜šžœž˜Lš œžœ žœžœžœžœ ˜;šœ ˜ šžœž˜Lšœžœ ˜Lšœžœ ˜Lšžœžœ ˜——Lšžœžœ ˜—L˜L˜—šŸœžœžœžœžœžœžœžœ˜RLšœžœ˜šžœž˜ Lšœ ˜ Lšœ žœžœ žœ˜8Lšœ žœžœ žœ+˜OLšœ˜Lšœ#˜#Lšœ'˜'Lšžœ˜—Lšžœžœ˜L˜L˜—šŸ œžœžœžœžœžœžœ˜?L˜L˜L™—šŸ œžœžœžœžœžœžœ˜AL˜L˜L™—š Ÿœžœžœžœžœžœ˜,Lšœ-žœ™7Lšžœžœ žœ˜$Lšžœ ˜L˜L™—š Ÿœžœžœžœžœžœ˜.Lšœ0žœ™:Lšžœžœ žœ˜$Lšžœ ˜L˜L˜—šŸœžœžœžœ žœžœžœ˜@Lšœžœ˜Lšœžœ˜šžœžœ žœžœ ˜*Lšžœžœžœ˜*šžœ˜L™Lšžœ žœžœ˜9Lšžœ˜ Lšœ˜——L˜L™—šŸœžœžœžœžœžœžœ˜:Lšœžœ˜Lšœ žœ˜Lšœžœ˜L˜L™—š Ÿ œžœžœžœžœžœ˜3LšœΟbœ™Lš žœžœžœžœžœ˜0L˜L˜—šŸœžœžœžœžœžœžœ˜:Lšœ˜L˜L™—šŸœžœžœžœžœžœžœ˜=L˜ L˜L™—šŸœžœžœžœžœžœžœ˜=L˜ L˜L™—šŸœžœžœžœžœžœžœ˜=L˜ L˜L™—šŸœžœžœžœžœžœžœ˜=L˜ L˜L™—šŸœžœžœžœžœžœžœ˜7Lšžœ ˜L˜L™—šŸœžœžœžœžœžœžœ˜7Lšžœ ˜L˜L™—šŸœžœžœžœžœžœžœ˜7Lšžœ ˜L˜L™—šŸœžœžœžœžœžœžœ˜7Lšžœ ˜L˜L™—šŸœžœžœžœžœžœžœ˜7Lšžœ ˜L˜L™—šŸœžœžœžœžœžœžœ˜7Lšžœ ˜L˜L™—šŸœžœžœžœžœžœžœ˜=Lšœžœ˜L˜L™—šŸœžœžœžœžœžœžœ˜=Lšœžœ˜L˜L™—šŸœžœžœžœžœžœžœ˜=Lšœ ˜ L˜L™—šŸœžœžœžœžœžœžœ˜Lšžœžœ žœ˜$Lšžœ˜L˜L˜——™šŸœžœžœžœžœžœžœžœ˜9Lšœ˜Lšœ˜L˜—šŸœžœžœžœžœžœžœžœ˜;Lšœ˜Lšœ˜L˜—šŸ œžœžœžœžœžœžœžœ˜=Lšœ˜Lšœ˜L˜—šŸœžœžœžœžœžœžœžœ˜;Lšœ˜Lšœ˜L˜—šœžœžœžœ˜L˜—š Ÿœžœžœžœžœžœ˜4Lš žœžœžœžœžœ˜/L˜L˜—š Ÿœžœžœžœžœžœ˜4Lš žœžœžœžœžœ˜-L˜L˜—š Ÿœžœžœžœžœžœ˜1Lš žœžœžœžœžœ˜FLšœ˜L˜—šŸ œžœ˜Lšžœ"˜'L˜——Kšžœ˜L˜—…—f,