<> <> <> <> <> <> DIRECTORY Basics USING [LongNumber], Ieee USING [BitOn, Ext, HalfLC, HiBit, Mul32, Pack, PostNormalize, RShift1in1, SingleReal, StepTwo], PrincOpsUtils USING [BITOR], Real USING [MaxSinglePrecision, NumberType, RoundLI], RealExceptions USING [ClearExceptions], RealOps USING [DefMode, Mode, SetMode]; IeeeIOA: CEDAR PROGRAM IMPORTS Ieee, PrincOpsUtils, Real, RealExceptions, RealOps EXPORTS Real = BEGIN PowTen: TYPE = RECORD [f: LONG CARDINAL, e: INTEGER]; TenTable: TYPE = RECORD [tens: ARRAY [0..13] OF PowTen, t26, t39: PowTen]; posTable: TenTable =[tens: [ [20000000000B, 0], [24000000000B, 3], [31000000000B, 6], [37200000000B, 9], [23420000000B, 13], [30324000000B, 16], [36411000000B, 19], [23045500000B, 23], [27657020000B, 26], [35632624000B, 29], [22500574400B, 33], [27220733500B, 36], [35065122420B, 39], [22141163452B, 43]], t26: [24533722672B, 86], t39: [27405037645B, 129]]; negTable: TenTable = [tens: [ [20000000000B, 0], [31463146315B, -4], [24365605075B, -7], [20304467230B, -10], [32155613531B, -14], [24761326107B, -17], [20615736406B, -20], [32657712326B, -24], [25363073422B, -27], [21134057501B, -30], [33371577317B, -34], [25772777414B, -37], [21457146011B, -40], [34113411502B, -44]], t26: [30604403045B, -87], t39: [25616276613B, -130]]; MulExtended: PROC [x, y: Ieee.Ext] RETURNS [z: Ieee.Ext] = TRUSTED { hi, lo: Basics.LongNumber; z.exp _ x.exp + y.exp + 1; z.det.sign _ x.det.sign # y.det.sign; z.det.type _ normal; z.det.sticky _ x.det.sticky OR y.det.sticky; [hi, lo] _ Ieee.Mul32[x.frac, y.frac]; -- normalize 64 WHILE NOT Ieee.BitOn[hi.highbits, Ieee.HiBit] DO hi.lc _ hi.lc + hi.lc; IF Ieee.BitOn[lo.highbits, Ieee.HiBit] THEN hi.lowbits _ PrincOpsUtils.BITOR[hi.lowbits, 1]; lo.lc _ lo.lc + lo.lc; z.exp _ z.exp - 1; ENDLOOP; z.frac _ hi; -- Round to 32 bits. IF lo.lc > Ieee.HalfLC OR (lo.lc = Ieee.HalfLC AND Ieee.BitOn[z.frac.lowbits, 1]) THEN { <> z.frac.lc _ z.frac.lc + 1; IF z.frac.lc < hi.lc THEN { z.frac _ Ieee.RShift1in1[z.frac]; z.exp _ z.exp + 1; }; }; IF lo.lc # 0 THEN z.det.sticky _ TRUE; }; myRealToPairTable: REF RealTable _ NewRealTable[]; RealTableIndex: TYPE = [-38..38]; RealTable: TYPE = ARRAY RealTableIndex OF REAL; myTensTable: TensTableRef _ NEW[TensTableArray _ [ 1, 10, 100, 1000, 10000, 100000, 1000000, 10000000, 100000000, 1000000000]]; TensTableRef: TYPE = REF TensTableArray; TensTableArray: TYPE = ARRAY [0..Real.MaxSinglePrecision] OF INT; NewRealTable: PROC RETURNS [ref: REF RealTable] = { ref _ NEW[RealTable]; FOR i: RealTableIndex IN RealTableIndex DO ref[i] _ PairToReal[1, i]; ENDLOOP; }; RealToPair: PUBLIC PROC [r: REAL, precision: NAT] RETURNS [type: Real.NumberType, fr: INT, exp10: INTEGER] = { lo: RealTableIndex _ -38; hi: RealTableIndex _ LAST[RealTableIndex]; abs: REAL _ ABS[r]; single: Ieee.SingleReal _ LOOPHOLE[abs, Ieee.SingleReal]; adjust: INTEGER _ 0; sexp: [0..377B] _ single.exp; exp2: INTEGER _ sexp-200B; type _ normal; SELECT sexp FROM < 40B => { SELECT TRUE FROM r = 0.0 => <<0.0 is a special case.>> RETURN [zero, 0, 0]; ENDCASE => { <> floor: REAL _ myRealToPairTable[precision-38]; WHILE abs < floor DO abs _ abs * 1e10; adjust _ adjust - 10; ENDLOOP; hi _ -18; }; }; >= 340B => { IF sexp # 377B THEN <> lo _ exp2*3/10 ELSE { <> IF r < 0 THEN fr _ FIRST[INT] ELSE fr _ LAST[INT]; exp10 _ 99; IF single.m1 = 0 AND single.m2 = 0 THEN type _ infinity ELSE type _ nan; RETURN; }; }; ENDCASE => { <> lo _ exp2*3/10-2; hi _ lo + 4; }; <> SELECT precision FROM 0 => precision _ 1; > Real.MaxSinglePrecision => precision _ Real.MaxSinglePrecision; ENDCASE; <> DO mid: RealTableIndex _ (lo+hi)/2; guess: REAL _ myRealToPairTable[mid]; IF mid = lo OR mid = hi THEN { <> IF mid = hi THEN mid _ lo; IF mid < hi THEN { <> next: REAL _ myRealToPairTable[mid+1]; IF next < abs THEN mid _ mid + 1; }; mid _ mid-precision+1; <> exp10 _ mid+adjust; abs _ abs / myRealToPairTable[mid]; EXIT; }; IF guess <= abs THEN {lo _ mid; LOOP}; hi _ mid; ENDLOOP; fr _ Real.RoundLI[abs]; IF fr = myTensTable[precision] THEN { <> fr _ myTensTable[precision-1]; exp10 _ exp10 + 1; }; IF r < 0.0 THEN fr _ - fr; }; Scale: PROC [x: Ieee.Ext, exp10: INTEGER] RETURNS [y: Ieee.Ext] = TRUSTED { table: TenTable; mul: PowTen; big: BOOL; IF exp10 = 0 THEN RETURN[x]; big _ exp10 < 0; table _ IF big THEN negTable ELSE posTable; exp10 _ ABS[exp10]; SELECT exp10 FROM IN [1..13] => mul _ table.tens[exp10]; IN (13..26) => { x _ MulExtended[x, CVExt[table.tens[13]]]; mul _ table.tens[exp10 - 13]; }; = 26 => mul _ table.t26; IN (26..39] => { x _ MulExtended[x, CVExt[table.t26]]; mul _ table.tens[exp10 - 26]; }; = 39 => mul _ table.t39; IN (39..52] => { x _ MulExtended[x, CVExt[table.t39]]; mul _ table.tens[exp10 - 39]; }; ENDCASE => { WHILE exp10 > 52 DO x _ MulExtended[x, CVExt[table.t39]]; exp10 _ exp10 - 39; ENDLOOP; RETURN[Scale[x, IF big THEN -exp10 ELSE exp10]]; }; y _ CVExt[mul]; y _ MulExtended[x, y]; }; CVExt: PROC [t: PowTen] RETURNS [y: Ieee.Ext] = { y.det.sticky _ y.det.sign _ FALSE; y.det.type _ normal; y.frac.lc _ t.f; y.exp _ t.e; }; PairToReal: PUBLIC PROC [fr: INT, exp10: INTEGER] RETURNS [r: REAL] = TRUSTED { RealExceptions.ClearExceptions[]; IF fr = 0 THEN r _ 0.0 ELSE { y: Ieee.Ext; old: RealOps.Mode _ RealOps.SetMode[RealOps.DefMode]; { ENABLE UNWIND => [] _ RealOps.SetMode[old]; y.exp _ 31; y.det.sign _ fr < 0; y.det.sticky _ FALSE; y.det.type _ normal; y.frac.li _ IF y.det.sign THEN -fr ELSE fr; Ieee.PostNormalize[@y]; y _ Scale[y, exp10]; Ieee.StepTwo[@y]; r _ Ieee.Pack[@y]; }; [] _ RealOps.SetMode[old]; }; }; END. <> <> <> <> <> <<>>