<> <> DIRECTORY DragonReal, PrincOpsUtils; 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; InitTenPowersTables: 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_cy/2; exp_exp+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]; <> <> <> StepTwo[ext]; <> 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)]; <> 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; <> 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_ext.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.