<<>> <> <> <> <> <> <<>> <> DIRECTORY Ieee, Real, RealInline; RealImpl: CEDAR PROGRAM IMPORTS RealInline EXPORTS Real, Ieee ~ BEGIN <> 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 { <> 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] ~ { <> 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] ~ { <> 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]; }; <> <<>> 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 }; END.