<<>> <> <> <> <<>> 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] = { <<... 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 { <> 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.