DIRECTORY DReal, DRealSupport, ExtendedFloatSupport, Real; DRealImpl: CEDAR PROGRAM IMPORTS ExtendedFloatSupport, DRealSupport EXPORTS DReal ~ BEGIN OPEN ExtendedFloatSupport; ExtendedRep: TYPE ~ MACHINE DEPENDENT RECORD [ SELECT OVERLAID * FROM xreal => [xreal: Extended], pair => [hi, lo: DCARD], quad => [q0, q1, q2, q3: CARD32], ENDCASE ]; magic: ExtendedRep = ComputeMagic[]; ComputeMagic: PROC RETURNS [ExtendedRep] = { one: Extended = ExtendedFromDReal[1.0]; m: ExtendedRep ¬ [xreal[ExtendedFromDReal[9.0]]]; UNTIL m.q3 = 1 DO m.xreal ¬ Subtract[Add[m.xreal, m.xreal], one]; ENDLOOP; m.q3 ¬ 0; RETURN [m] }; FScale: PUBLIC PROC [a: DREAL, scale: INTEGER] RETURNS [DREAL] ~ { RETURN [DRealSupport.FScale[a, scale]] }; Round: PUBLIC PROC [dreal: DREAL] RETURNS [DINT] ~ { neg: BOOL ~ dreal < 0; m: ExtendedRep ~ [xreal[Add[ExtendedFromDReal[ABS[dreal]], magic.xreal]]]; chk: BOOL[FALSE..FALSE] ~ m.hi # magic.hi OR magic.lo > DCARD[2]**63- ORD[NOT neg]; RETURN [IF neg THEN -LOOPHOLE[m.lo, DINT] ELSE LOOPHOLE[m.lo, DINT]] }; Fix: PUBLIC PROC [dreal: DREAL] RETURNS [DINT] ~ { neg: BOOL ~ dreal < 0; m: ExtendedRep ¬ [xreal[Add[ExtendedFromDReal[ABS[dreal]], magic.xreal]]]; chk: BOOL[FALSE..FALSE] ~ m.hi # magic.hi OR magic.lo > DCARD[2]**63 - ORD[NOT neg]; IF m.lo > ABS[dreal] THEN m.lo ¬ m.lo - 1; RETURN [IF neg THEN -LOOPHOLE[m.lo, DINT] ELSE LOOPHOLE[m.lo, DINT]] }; Ceiling: PUBLIC PROC [dreal: DREAL] RETURNS [ans: DINT] ~ { ans ¬ Round[dreal]; IF ans < dreal THEN ans ¬ ans + 1; }; Floor: PUBLIC PROC [dreal: DREAL] RETURNS [ans: DINT] ~ { ans ¬ Round[dreal]; IF ans > dreal THEN ans ¬ ans - 1; }; XRound: PROC [xreal: Extended, neg: BOOL] RETURNS [DINT] ~ { m: ExtendedRep ~ [xreal[Add[xreal, magic.xreal]]]; RETURN [IF neg THEN -LOOPHOLE[m.lo, DINT] ELSE LOOPHOLE[m.lo, DINT]] }; one: Extended = ExtendedFromDReal[1.0]; ten: Extended = ExtendedFromDReal[10.0]; TenToThe: PROC [i: NAT] RETURNS [Extended] ~ { Sqr: PROC [d: Extended] RETURNS [Extended] ~ INLINE {RETURN [Multiply[d, d]]}; SELECT TRUE FROM i = 0 => RETURN [one]; i = 1 => RETURN [ten]; i MOD 2 = 0 => RETURN [Sqr[TenToThe[i/2]]]; ENDCASE => RETURN [Multiply[ten, Sqr[TenToThe[i/2]]]]; }; RealToPair: PUBLIC PROC [r: DREAL, precision: NAT] RETURNS [type: Real.NumberType, fr: DINT, exp10: INTEGER] ~ { SELECT DRealSupport.Classify[r] FROM zero => { RETURN [zero, 0, 0] }; infinity => { RETURN [infinity, IF r < 0 THEN DINT.FIRST ELSE DINT.LAST, INTEGER.LAST] }; quiet, signaling, other => { RETURN [nan, LOOPHOLE[r], 0] }; ENDCASE => { vMin: Extended = TenToThe[precision-1]; vMax: Extended = Multiply[vMin, ten]; negative: BOOL = r < 0; v: Extended ¬ ExtendedFromDReal[IF negative THEN -r ELSE r]; exponent: INT ¬ 0; DebugPrint[v]; UNTIL Less[v, vMax] DO v ¬ Divide[v, ten]; exponent ¬ exponent + 1; DebugPrint[v]; ENDLOOP; WHILE Less[v, vMin] DO v ¬ Multiply[v, ten]; exponent ¬ exponent - 1; DebugPrint[v]; ENDLOOP; RETURN [normal, XRound[v, negative], exponent]; }; }; DebugPrint: PROC [x: Extended] ~ {}; END. ψ DRealImpl.mesa Copyright Σ 1991, 1992 by Xerox Corporation. All rights reserved. Michael Plass, August 13, 1991 0:01 am PDT Assumes xreal IN [0..DINT.LAST]; DebugPrint: PROC [x: Extended] ~ TRUSTED MACHINE CODE { "DebugHexPrint16Bytes" }; ΚX–(cedarcode) style•NewlineDelimiter ™codešœ™Kšœ Οeœ7™BK™*—K˜KšΟk œ1˜:K˜KšΠblΠlnœž ˜Kšžœ#˜*Kšžœ˜ šœžœžœ˜"K˜š œ žœžœž œžœ˜.šžœžœž˜Kšœ˜Kšœžœ˜Kšœžœ˜!Kšž˜—Kšœ˜K˜—Kšœ$˜$šΟn œžœžœ˜,Kšœ'˜'K˜1šžœ ž˜K˜/Kšžœ˜—K˜ Kšžœ˜ Kšœ˜K˜—š‘œžœžœžœ žœžœžœ˜BKšžœ ˜&Kšœ˜K˜—š ‘œžœžœ žœžœžœ˜4Kšœžœ ˜Kšœ.žœ˜JKšœžœžœžœžœ žœ žœžœ˜SKšžœžœžœžœžœžœžœžœ˜DKšœ˜K˜—š ‘œžœžœ žœžœžœ˜2Kšœžœ ˜Kšœ.žœ˜JKšœžœžœžœžœ žœ žœžœ˜TKšžœžœžœ˜*Kšžœžœžœžœžœžœžœžœ˜DKšœ˜K˜—š ‘œžœžœ žœžœžœ˜;K˜Kšžœ žœ˜"Kšœ˜K˜—š ‘œžœžœ žœžœžœ˜9K˜Kšžœ žœ˜"Kšœ˜K˜—š ‘œžœžœžœžœ˜