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 => 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. ˜IeeeIOA.mesa - Utilities for IO Copyright c 1985 by Xerox Corporation. All rights reserved. Rovner On May 4, 1983 9:59 am Stewart, January 14, 1984 4:18 pm Levin, August 8, 1983 4:38 pm Russ Atkinson (RRA) May 23, 1985 0:56:38 am PDT Overflow 0.0 is a special case. Denormalized or VERY small numbers Normal (but but quite large) numbers. We need to watch out for edge effects in estimating lo and hi bounds for the search. Infinity or Not a Number Normal numbers, easy to estimate the lo and hi bounds. Take precision into the range [1..Real.MaxSinglePrecision]. We always give back at least one digit of precision. Perform a binary search for the best power of ten. The binary chop has converged. The correct value of mid is either lo or hi. So, a simple test should suffice. Well, we might be too low by one index. We believe that mid IN RealTableIndex at this point, because of the check for adjusting denormalized numbers up within the floor. If this is not correct, we deserve to get a bounds fault. Rats! The Real.RoundLI operation rounded up to bump the # of precision, so we have to adjust the # of precision down, and adjust the exponent as well. August25, 1980 4:28 PM, LStewart; formatting and qualification August 27, 1982 1:04 pm, L. Stewart, CEDAR January 14, 1984 4:53 pm, L. Stewart, changeTo Ieee Russ Atkinson (RRA) February 19, 1985 5:05:51 pm PST fixed RealToPair to be more accurate and faster Ê˜codešœ™Kšœ Ïmœ1™K˜>K˜>K˜*˜5K˜——šÏnœžœžœžœ˜DK˜K˜K˜%K˜Kšœžœ˜,Kšœ'Ïc˜6šžœžœ%ž˜0K˜šžœ%ž˜+Kšœžœ˜0—K˜K˜Kšžœ˜—Kšœ ˜!šžœž˜Kšœžœ žœ˜>Kšœ™K˜šžœžœ˜Kšœ!˜!Kšœ˜—K˜—Kšžœžœžœ˜&K˜K˜—šœžœ˜2K˜Kšœžœ ˜!Kš œžœžœžœžœ˜/K˜—šœžœ˜2˜LK˜—Kšœžœžœ˜(Kš œžœžœžœžœ˜AK˜—šŸœžœžœžœ˜3Kšœžœ˜šžœžœž˜*Kšœ˜Kšžœ˜—K˜K˜—šŸ œžœžœžœ žœžœžœ žœ˜nKšœ˜Kšœžœ˜*Kšœžœžœ˜Kšœžœ˜9Kšœžœ˜Kšœ˜Kšœžœ ˜Kšœ˜šžœž˜˜ šžœžœž˜šœ ˜ K™Kšžœ˜—šžœ˜Kšœ"™"Kšœžœ#˜.šžœ ž˜K˜Kšœ˜Kšžœ˜—K˜ K˜——K˜—šœ˜šžœ˜šž˜K™{Kšœ˜—šžœ˜Kšœ™Kšžœžœžœžœžœžœžœ˜2K˜šžœžœ˜"Kšžœ˜Kšžœ˜—Kšžœ˜Kšœ˜——K˜—šžœ˜K™6Kšœ˜K˜K˜——K˜Kšœq™qšžœž˜Kšœ˜KšœA˜AKšžœ˜—Kšœ2™2šž˜Kšœ ˜ Kšœžœ˜%šžœ žœ žœ˜Kšœo™oKšžœ žœ ˜šžœ žœ˜Kšœ'™'Kšœžœ˜&Kšžœžœ˜!K˜—šœ˜Kšœ¼™¼—Kšœ˜Kšœ#˜#Kšžœ˜Kšœ˜—Kšžœžœžœ˜&K˜ Kšžœ˜—Kšœ˜šžœžœ˜%Kšœ—™—Kšœ˜K˜K˜—Kšžœ žœ˜K˜K˜—š Ÿœžœžœžœžœ˜KK˜K˜Kšœžœ˜ Kšžœžœžœ˜K˜Kšœžœžœ žœ ˜+Kšœžœ˜šžœž˜Kšžœ$˜&šžœ˜K˜*K˜K˜—K˜šžœ˜K˜F—K˜šžœ˜K˜F—šžœ˜šžœž˜Kšœ:žœ˜B—Kšžœ žœžœžœ ˜0K˜——K˜K˜K˜K˜—šŸœžœ žœ˜1Kšœžœ˜"K˜K˜K˜K˜K˜—šŸ œžœžœžœ žœžœžœžœ˜OKšœ!˜!šžœ˜ Kšžœ˜šžœ˜Kšœ˜Kšœ5˜5˜Kšžœžœ˜+K˜K˜Kšœžœ˜K˜Kšœžœžœžœ˜+Kšœ˜K˜Kšœ˜Kšœ˜K˜—Kšœ˜Kšœ˜——K˜K˜—šžœ˜K˜—Kšœžœ(™?Kšœžœž™*Kšœžœ™3™4K™/—K™—…—n"“