DragonRealIO:
CEDAR
PROGRAM
IMPORTS DragonReal
EXPORTS DragonReal =
BEGIN OPEN DragonReal;
ExtTenPowersLow: ARRAY [-31..31] OF ExtRec; -- indexed by powerOf10
ExtTenPowersHigh: ARRAY [-11..11] OF ExtRec; -- indexed by powerOf10/32
QCTenPowers:
ARRAY [ 0..19]
OF
QCARD;
InitTenPowers
Tables:
PROC = {
ext: Ext[exp: 0, qc[100000B, 0, 0, 0]];0
FOR ii:
INTEGER
IN [0..32]
ExtTenPowersLow[ii] ← ext^;
[cy, ext.qc] ← QCMul[ext.qc, 10];
WHILE cy#0 DO [exp.qc, ] ← QCSftRt[ext.qc, cy, 1]; cy𡤌y/2; exp𡤎xp+1 ENDLOOP
ENDLOOP;
FOR ii:
INTEGER
IN [1..12]
ExtTenPowersHigh[ii] ← ext^;
[ext.qc, low] ← QCMulDbl[ext.qc,ExtTenPowersHigh[1].qc]
ext.exp ← ext.exp+1+ExtTenPowersHigh[1].exp;
IF ext.qc[0]<100000B THEN {ext.qc ← QCSftLt[ext.qc, low[0]]; ext.exp ← ext.exp-1};
ENDLOOP;
ext^ ← ExtTenPowersLow[0];
FOR ii:
INTEGER
DECREASING IN [-32..0]
ExtTenPowersLow[ii] ← ext^;
IF ~(QCComp[ext.qc, ExtTenPowersLow[1].qc] = lessthan)
THEN ext.qc ← QCSftRt[ext.qc, 0, 1].z;
ELSE ext.exp ← ext.exp-1;
ext.exp ← ext.exp-ExtTenPowersLow[1].exp;
ext.qc ← QCDivDbl[ext.qc, ALL[0], ExtTenPowersLow[1].qc].qRes;
ENDLOOP;
FOR ii:
INTEGER
DECREASING IN [-12..-1]
ExtTenPowersHigh[ii] ← ext^;
IF ~(QCComp[ext.qc, ExtTenPowersHigh[1].qc] = lessthan)
THEN ext.qc ← QCSftRt[ext.qc, 0, 1].z;
ELSE ext.exp ← ext.exp-1;
ext.exp ← ext.exp-ExtTenPowersHigh[1].exp;
ext.qc ← QCDivDbl[ext.qc, ALL[0], ExtTenPowersLow[1].qc].qRes;
ENDLOOP;
QCTenPowers[0] ← [0,0,0,1];
FOR ii:
INTEGER
IN [1..19]
QCTenPowers[ii] ← QCMul[QCTenPowers[ii-1], 10].prod ENDLOOP};
RealToDec:
PROC [r: Real, precision:
NAT ← DefaultSinglePrecision]
RETURNS [type: NumberType, int: INT, exp10: INT];
ext: Ext;
DragonIeeeInternal.thisTimeExceptions ← Real.NoExceptions;
ext ← Unpack[r];
SELECT ext.type
FROM
zero => RETURN[zero, 0, 0];
nan => RETURN[nan, 0, 0];
infinity => RETURN[infinity, (IF ext.qcn THEN LAST[INT] ELSE FIRST[INT]), 99];
ENDCASE => NULL;
ExtToDec[ext, MAX[1, MIN[precision, MaxSinglePrecision]]];
int ← LOOPHOLE[QCardToCard[exp.qc], INT];
RETURN[normal, (IF ext.qcn THEN -int ELSE int), ext.exp];
RealDblToDec:
PROC [r: RealDbl, precision:
NAT ← DefaultDoublePrecision]
RETURNS [type: NumberType, int: QINT, exp10: INT];
ext: Ext;
DragonIeeeInternal.thisTimeExceptions ← Real.NoExceptions;
ext ← UnpackDbl[r];
SELECT ext.type
FROM
zero => RETURN[zero, [FALSE, ALL[000000B]], 000];
nan => RETURN[nan, [FALSE, ALL[000000B]], 000];
infinity => RETURN[infinity, [ext.qcn, ALL[177777B]], 999];
ENDCASE => NULL;
ExtToDec[ext, MAX[1, MIN[precision, MaxDoublePrecision]]];
RETURN[normal, [ext.qcn, ext.qc], ext.exp];
ExtToDec:
PROC [ext: Ext, precision:
NAT]
RETURNS [exp10:
INT];
normalized: BOOL ← Normalized[ext.qc[0]];
qcn: BOOL ← ext.qcn;
temp: Ext ← NEW[ExtRec ← []];
ext.qcn ← FALSE;
exp10 ← IF normalized THEN (ext.exp*3)/10 ELSE (IF ext.double THEN -308 ELSE -38);
exp10 ← exp10 + 1 - precision;
DO
t1, t2: BOOLEAN;
temp^ ← exp^; ScaleBy10[temp, -exp10];
[invalid: t1, overflow: t2] ← FixExtended[temp, rn]; IF t1 OR t2 THEN ERROR;
SELECT QCCompare[temp.qc, QCTenPowers[precision]]
FROM
greater => {exp10 ← exp10 + 1; LOOP};
equal => {exp10 ← exp10 + 1; temp.qc ← QCDiv[temp.qc, 10].qRes; EXIT};
ENDCASE;
IF QCCompare[temp.qc, QCTenPowers[precision-1]] = lessthan
AND normalized
THEN {exp10 ← exp10 - 1; LOOP}
ELSE EXIT;
ENDLOOP;
ext^ ← [type: decimal, qcn: qcn, exp: exp10, qc ← temp.qc, double: ext.double]};
RealFromDec:
PROC [int:
INT, exp10:
INTEGER]
RETURNS [real: Real] = {
savedRndMode: RoundingMode ← fpmode.round;
ext: Ext;
IF int = 0 THEN RETURN[DragonReal.PlusZero];
ext ← NEW[ExtRec ← [sticky: FALSE, type: normal, double: FALSE, qcn: (int<0), exp: 31]];
ext.qc ← QCFromCard[LOOPHOLE[(IF int<0 THEN -int ELSE int)]];
ext.qc[0] ← ext.qc[2]; ext.qc[1] ← ext.qc[3]; ext.exp ← 31;
WHILE ext.qc[0]<100000B DO ext.qc ← QCSftLt[ext.qc]; ext.exp ← ext.exp-1 ENDLOOP;
ext ← ScaleBy10[ext, exp10];
or: RoundingMode ← fpmode.round;
IeeeInternal.fpmode.round ← rn;
IeeeInternal.thisTimeExceptions ← Real.NoExceptions;
StepTwo[ext];
IeeeInternal.fpmode.round ← or;
real ← ExtToReal[exp] };
RealDblFromDec:
PROC [int:
INT, exp10:
INTEGER]
RETURNS [real: RealDbl] = {
ext: Ext;
IF int = 0 THEN RETURN[DragonReal.PlusZero];
ext ← NEW[ExtRec ← [sticky: FALSE, type: normal, double: FALSE, qcn: (int<0), exp: 31]];
ext.qc ← QCFromCard[LOOPHOLE[(IF int<0 THEN -int ELSE int)]];
ext.qc[0] ← ext.qc[2]; ext.qc[1] ← ext.qc[3]; ext.exp ← 31;
WHILE ext.qc[0]<100000B DO ext.qc ← QCSftLt[ext.qc]; ext.exp ← ext.exp-1 ENDLOOP;
ext ← ScaleBy10[ext, exp10];
or: RoundingMode ← fpmode.round;
IeeeInternal.fpmode.round ← rn;
IeeeInternal.thisTimeExceptions ← Real.NoExceptions;
StepTwo[ext];
IeeeInternal.fpmode.round ← or;
real ← ExtToRealDbl[exp] };
ScaleBy10:
PROC [ext: Ext, exp10:
INTEGER] = {
Scale:
PROC[range: {high, low}, index:
INTEGER] = {
ext.exp ← ext.exp +(
IF range=high
THEN ExtTenPowersHi[index].exp
ELSE ExtTenPowersLo[index].exp);
[ext.qc, low] ← QCMulDbl[ext.qc, (
IF range=high
THEN ExtTenPowersHi[index].qc
ELSE ExtTenPowersLo[index].qc)];
Normalize double QCARDS
ext.exp ← ext.exp+1;
IF ext.qc[0]<100000B
THEN {
ext.qc ← QCSftLt[ext.qc, low[0]];
low ← QCSftLt[low];
ext.exp ← ext.exp-1};
IF low # ALL[0] THEN exp10.sticky ← TRUE;
Round to nearest
SELECT QCComp[low, [100000B, 0, 0, 0]]
FROM
ls => RETURN;
eq => IF NOT BitOn[ext.qc[3],1] THEN RETURN;
ENDCASE => NULL;
[cy, ext.qc] ← QCAdd[ext.qc, [0,0,0,1]];
IF cy#0 THEN {ext.qc[0] ← 100000B; ext.exp𡤎xt.exp+1};
RETURN};
low: QCard;
cy: CARDINAL;
SELECT exp10
FROM
0 => RETURN;
< -352 => ERROR; -- Underflow;
> 352 => ERROR; -- Overflow
ENDCASE => NULL;
IF (exp10 / 32) # 0 THEN Scale[high, (exp10 / 32)];
IF (exp10 MOD 32) # 0 THEN Scale[low, (exp10 MOD 32)]};
Normalized: PROC [g: UNSPECIFIED] RETURNS [BOOLEAN] = INLINE {RETURN[g<0]};
InitTenPowersTables[];
END.