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. ธ 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 zero, nan, overflow or denormalized case; do it the hard way This generates more roundoff than it should - mfp This generates more roundoff than it should - mfp Exported to Ieee ส4–(cedarcode) style•NewlineDelimiter ™codešœ ™ Kšœ ฯeœ=™HK™+K™*K™1K™Kšฯb ™ —˜šฯk œ˜!K˜——šะlnœŸ ˜KšŸœ ˜KšŸœ ˜KšœŸ˜—˜K™K˜šฯn œŸœŸœ"ŸœŸœŸœŸœ˜tK˜—šก œŸœŸœŸœ˜K˜—šกœŸœŸœŸœ ŸœŸœŸœ˜@KšœŸœ˜!KšœŸœ˜šŸœŸœ ŸœŸœ ˜*KšŸœŸœŸœ˜*šŸœ˜K™KšŸœ ŸœŸœ˜9KšŸœ˜ Kšœ˜——Kšœ˜K˜—š ก œŸœŸœŸœŸœ˜-Kšœ/˜/KšœŸœŸœฯc.˜KKšœŸœ˜KšŸœŸœ&Ÿœข œ˜DKšŸœ˜ Kšœ˜K˜—š กœŸœŸœŸœŸœŸœ˜,KšŸœŸœŸœ˜5KšŸœ˜Kšœ˜K˜—š กœŸœŸœŸœŸœŸœ˜.KšŸœŸœŸœ˜5KšŸœ˜Kšœ˜K˜—š กœŸœŸœŸœŸœŸœ˜0KšŸœŸœŸœ˜5KšŸœ˜ Kšœ˜K˜—š กœŸœŸœŸœŸœŸœ˜.KšŸœŸœŸœ˜5KšŸœ˜Kšœ˜K˜—šก œŸœŸœŸœ ŸœŸœŸœ˜DK™1KšœŸœ˜ KšœŸœ ˜KšœŸœŸœ˜#šŸ˜šŸœŸ˜ Kšœ,Ÿœ˜2Kšœ-Ÿœ˜3Kšœ˜Kšœ˜KšŸœ˜—KšŸœ˜ KšŸœ˜—Kšœ˜K˜—šœ Ÿœ˜,Kš œŸœŸœŸœŸœ˜7KšœŸœ ˜#—šก œŸœŸœŸœ˜1KšœŸœŸœ‡˜กKšŸœ˜ K˜K˜—šก œŸœŸœŸœ Ÿœ ŸœŸœ Ÿœ˜ŒK™1KšœŸœ˜#KšŸœ ŸœŸœ Ÿœ˜PšŸœŸœŸ˜šœ˜KšœŸœ˜KšŸœ ŸœŸœ˜6Kšœ ˜ Kšœ˜KšŸœŸœŸœ˜EKšŸœŸœŸœ˜FKšœ ŸœŸœŸœ˜$Kšœ˜—šœŸœ˜$Kš ŸœŸœŸœ ŸœŸœ˜;—šœŸœ˜%Kš ŸœŸœŸœ ŸœŸœ˜<—šŸœ˜ KšŸœ"˜(——Kšœ˜K˜—K™K™šก œŸœŸœŸœ˜AKšŸœข˜K˜K˜—šกœŸœŸœŸœŸœ ŸœŸœ˜@KšŸœข˜K˜K˜—š ก œŸœŸœŸœŸœ˜7KšŸœข˜K˜K˜—š กœŸœŸœŸœŸœ˜7KšŸœข˜K˜K˜——KšŸœ˜—…— ยฎ