DRealImpl.mesa
Copyright Ó 1991, 1992 by Xerox Corporation. All rights reserved.
Michael Plass, August 13, 1991 0:01 am PDT
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] ~ {
Assumes xreal IN [0..DINT.LAST];
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] ~ {};
DebugPrint: PROC [x: Extended] ~ TRUSTED MACHINE CODE {
"DebugHexPrint16Bytes"
};
END.