DRealImpl.mesa
Copyright Ó 1991, 1992 by Xerox Corporation. All rights reserved.
Michael Plass, August 13, 1991 0:01 am PDT
~
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"
};