-- DumpReals.mesa

-- Utilities for Real Output in Mesa 6 debugger

-- Last Modified: L. Stewart June 26, 1980 4:29 PM

-- Last Modified: Bruce July 7, 1980 5:52 PM

DIRECTORY

DebugFormat USING [Foo],

DI USING [GetValue],

DOutput USING [Char, Decimal, Text],

Dump USING [],

Inline USING [BITAND, BITOR, BITSHIFT, HighHalf, LowHalf, LongMult, LongNumber],

Real: FROM "IeeeFloat" USING [ADC3, BitOn, DenormalizedExponent, Details, ExponentBias, ExponentMask, ExponentShift, ExpSingleMin, Ext, HiBit, HiddenBit, HiFractionMask, HalfLC, LN, NaNExponent, Normalized, NumberType],

String USING [AppendString];

DumpReals: PROGRAM

IMPORTS DI, DOutput, Real, Inline, String

EXPORTS Dump =

BEGIN OPEN Real, Inline;

precision: CARDINAL = 7;

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]

];

-- Only works for positive times positive

MulExtended: PROCEDURE [x: Ext, y: PowTen] RETURNS [Ext] =

BEGIN

hi, lo: Inline.LongNumber;

x.exp ← x.exp+y.e+1;

[hi, lo] ← Mul32[x.frac, LN[y.f]];

-- normalize 64

WHILE NOT BitOn[hi.highbits, HiBit] DO

hi.lc ← hi.lc*2;

IF BitOn[lo.highbits, HiBit] THEN hi.lowbits ← hi.lowbits+1;

lo.lc ← lo.lc*2;

x.exp ← x.exp-1;

ENDLOOP;

x.frac ← hi;

-- Round to 32 bits.

IF lo.lc>HalfLC OR (lo.lc=HalfLC AND BitOn[x.frac.lowbits, 1]) THEN

BEGIN -- Overflow

x.frac.lc ← x.frac.lc+1;

IF x.frac.lc<hi.lc THEN

BEGIN

x.frac.lc ← x.frac.lc/2;

x.frac.highbits ← BITOR[HiddenBit, x.frac.highbits];

x.exp ← x.exp+1;

END;

END;

IF lo.lc#0 THEN x.det.sticky ← TRUE;

RETURN [x];

END;

Mul32: PROCEDURE [x, y: LongNumber] RETURNS [LongNumber, LongNumber] = INLINE

BEGIN

hi, lo, t1, t2: LongNumber;

cy: CARDINAL;

lo.lc ← LongMult[x.lowbits, y.lowbits];

hi.lc ← LongMult[x.highbits, y.highbits];

t1.lc ← LongMult[x.highbits, y.lowbits];

t2.lc ← LongMult[x.lowbits, y.highbits];

[cy, lo.highbits] ← ADC3[lo.highbits, t1.lowbits, t2.lowbits];

hi.lc ← hi.lc+t1.highbits+t2.highbits+cy;

RETURN [hi, lo];

END;

-- Only works for positive r

RealToPair: PUBLIC PROCEDURE [r: REAL] RETURNS [type: NumberType, fr: LONG INTEGER, exp10: INTEGER] = INLINE

BEGIN

x, zz: Ext;

normalized: BOOLEAN;

x ← Unpack[r];

type ← x.det.type;

IF type#normal THEN RETURN;

normalized ← Normalized[x.frac.highbits];

exp10 ← IF normalized THEN (x.exp*3)/10

ELSE -38;

exp10 ← exp10+1-precision;

DO

zz ← Scale[x, -exp10];

fr ← FixExtended[zz];

SELECT TRUE FROM

fr>10000000 => exp10 ← exp10+1;

fr=10000000 =>

BEGIN

exp10 ← exp10+1;

fr ← fr/10;

EXIT;

END;

fr<1000000 => IF normalized THEN exp10 ← exp10-1

ELSE EXIT;

ENDCASE => EXIT;

ENDLOOP;

END;

Scale: PROCEDURE [x: Ext, exp10: INTEGER] RETURNS [y: Ext] =

BEGIN

big: BOOLEAN ← exp10<0;

table: TenTable ← IF big THEN negTable ELSE posTable;

exp10 ← ABS[exp10];

SELECT exp10 FROM

IN [0..13] => NULL;

IN (13..26) =>

BEGIN

x ← MulExtended[x, table.tens[13]];

exp10 ← exp10-13;

END;

IN [26..39) =>

BEGIN

x ← MulExtended[x, table.t26];

exp10 ← exp10-26;

END;

IN [39..52] =>

BEGIN

x ← MulExtended[x, table.t39];

exp10 ← exp10-39;

END;

ENDCASE => ERROR;

y ← MulExtended[x, table.tens[exp10]];

END;

-- Separate the packed REAL into its component elements, only works for positive (actually, ignores sign)

Unpack: PROCEDURE [r: REAL] RETURNS [z: Ext] = INLINE

BEGIN

z.det ← Details[sign: FALSE, sticky: FALSE, blank: 0, type: normal];

z.exp ← BITSHIFT[BITAND[LN[r].highbits, ExponentMask], -ExponentShift]-ExponentBias;

z.frac.li ← LN[r].li;

z.frac.highbits ← BITAND[HiFractionMask, z.frac.highbits];

SELECT z.exp FROM

=DenormalizedExponent => -- denormalized or zero

BEGIN

IF z.frac.li=0 THEN z.det.type ← zero

ELSE

BEGIN

z.exp ← ExpSingleMin;

z.frac.lc ← z.frac.lc*256;

END;

END;

=NaNExponent => -- infinity or nan

BEGIN

z.det.type ← IF z.frac.li=0 THEN infinity

ELSE nan;

END;

ENDCASE =>

BEGIN

z.frac.lc ← z.frac.lc*256;

z.frac.highbits ← BITOR[HiddenBit, z.frac.highbits];

END;

END;

-- Fix Extended, only works for positive z

FixExtended: PUBLIC PROCEDURE [z: Ext] RETURNS [v: LONG INTEGER] = INLINE

BEGIN

grs: INTEGER;

IF z.exp>29 THEN ERROR;

DeNormalize[@z, z.exp-29];

grs ← BITAND[z.frac.lowbits, 3B]*2;

z.frac.lc ← z.frac.lc/4;

IF z.det.sticky THEN grs ← grs+1;

IF grs>4 OR (grs=4 AND BitOn[z.frac.lowbits, 1]) THEN z.frac.lc ← z.frac.lc+1;

RETURN [v: z.frac.li];

END;

-- DeNormalize is much like LongShift, except that it maintains the sticky bits on the right. And it only shifts right.

DeNormalize: PROCEDURE [z: POINTER TO Ext, count: INTEGER] = INLINE

BEGIN

sMask: ARRAY [0..16) OF CARDINAL = [0B, 1B, 3B, 7B, 17B, 37B, 77B, 177B, 377B, 777B, 1777B, 3777B, 7777B, 17777B, 37777B, 77777B];

-- Mask off everything but the bits contributing to S, then possibly set S in the result.

count ← -count;

z.det.sticky ← z.det.sticky OR (SELECT count FROM

IN [0..16) => BitOn[z.frac.lowbits, sMask[count]],

IN [16..32) => z.frac.lowbits#0 OR BitOn[z.frac.highbits, sMask[count-16]],

ENDCASE => z.frac.lc#0);

THROUGH [1..count] DO z.frac.lc ← z.frac.lc/2; ENDLOOP;

END;

PrintReal: PROCEDURE [r: REAL] =

BEGIN OPEN DOutput;

exp: INTEGER;

z: LONG INTEGER;

ty: NumberType;

sign: BOOLEAN;

lds: STRING ← [8];

rds: STRING ← [8];

i, digit, digits, rd, ld: CARDINAL;

Zeros: PROCEDURE [n: CARDINAL] =

BEGIN

THROUGH [1..n] DO

Char[’0];

ENDLOOP;

END;

AddChars: PROCEDURE [sss: STRING] =

BEGIN

i: CARDINAL;

FOR i DECREASING IN [0..sss.length) DO

digit ← Inline.LowHalf[z MOD 10];

z ← z/10;

sss[i] ← digit+’0;

ENDLOOP;

END;

BEGIN

sign ← BitOn[Inline.HighHalf[r], HiBit];

-- LN[r].highbits ← BITAND[LN[r].highbits, NotHiBit];

-- sign will be ignored by Unpack, when called by RealToPair

[type: ty, fr: z, exp10: exp] ← RealToPair[r];

SELECT ty FROM

nan => Text[s: ".."L];

infinity => Text[s: IF sign THEN "--"L ELSE "++"L];

zero => Text[s: IF sign THEN "-0"L ELSE "0"L];

ENDCASE => GOTO Ok;

EXITS

Ok =>

BEGIN

IF sign THEN Char[’-];

IF z=0 THEN ERROR;

digits ← precision;

WHILE (z MOD 10)=0 DO -- strip trailing zeros

z ← z/10;

exp ← exp+1;

digits ← digits-1;

IF digits=0 THEN ERROR;

ENDLOOP;

rd ← MAX[0, -exp];

rds.length ← MIN[digits, rd]; -- right digit string

AddChars[rds];

ld ← MAX[0, LOOPHOLE[digits,INTEGER]+exp];

lds.length ← MIN[digits,ld]; -- left digit string

AddChars[lds];

IF ld+rd<7 THEN

BEGIN

Text[s: lds];

SELECT TRUE FROM

ld=0 => -- number entirely to right of decimal point

BEGIN

Text[s: "0."L];

Zeros[rd-rds.length];

END;

rd=0 => Zeros[ld-lds.length]; -- number entirely to left of decimal point

ENDCASE => Char[’.]; -- some of each

Text[s: rds];

END

ELSE -- e format

BEGIN

String.AppendString[to: lds, from: rds];

Char[lds[0]];

exp ← exp+lds.length-1;

Char[’.];

IF lds.length=1 THEN Char[’0]

ELSE

FOR i IN [1..lds.length) DO

Char[lds[i]];

ENDLOOP;

-- print exponent

IF exp=0 THEN RETURN;

Char[’e];

IF exp>0 THEN Char[’+];

Decimal[exp];

END;

END;

END;

END;

Real: PUBLIC PROCEDURE [f: DebugFormat.Foo] =

BEGIN

rp: LONG POINTER TO REAL;

DI.GetValue[f: f];

rp ← LOOPHOLE[f.addr.base];

PrintReal[rp↑];

END;

END.