Copyright (C) 1994, Digital Equipment Corp.
UNSAFE MODULEInternal computations of Dragon require the use of bignums. Also, the fraction of a floating-point number can occupy more bits than there are in a Word.T. We use an ad-hoc implementation of bignums, because only few of the arithmetic operations are needed, and only positive numbers are needed.; IMPORT Word; DragonInt
A DragonInt.T, b, represent the value:
sigma (0, b.s - 1, b.w[i] * 2 ^ Used * i)
that is, b.w[0] contains the Used least significant bits, b.w[1] the next Used significant bits and so on.
The most significant word of a DragonInt.T must be non-null.
The value Used is chosen to facilitate the implementation of the arithmetic operations needed by the Dragon.F routine: intermediate computations on individual Word.T of a DragonInt.T won't overflow.
-------------------------------------------------------------- sessions ---
REVEAL Session = BRANDED "DragonInt.Session" REF RECORD next : INTEGER; w : REF ARRAY OF Word.T; END; PROCEDURE---------------------------------------------------------------- values ---NewSession (): Session = VAR s := NEW (Session); BEGIN s.w := NEW (REF ARRAY OF Word.T, 1000); s.w[0] := 0; (* Zero *) s.w[1] := 1; (* One *) s.next := 2; RETURN s; END NewSession; PROCEDUREEndSession (<*UNUSED*> s: Session) = BEGIN (*** maxHighWater := MAX (maxHighWater, s.next); INC (highWater [MIN (s.next DIV 10, LAST (highWater))]); INC (nSessions); ***) END EndSession;
CONST Used = 28; Reserved = Word.Size - Used; SigBits = Word.RightShift (Word.Not (0), Reserved); TopBit = 16_08000000; CONST (* masks to assemble 28-bit units from 32-bit words *) Mask1 = 16_0fffffff; (* bottom 28 *) Mask2B = 16_f0000000; (* top 4 of bottom 32 *) Mask2A = 16_00ffffff; (* bottom 24 of top 32 *) Mask3 = 16_ff000000; (* top 8 of top 32 *) TYPE Ptr = UNTRACED REF Word.T; PROCEDURE---------------------------------------------------- internal utilities ---New (s: Session; a, b: INTEGER): T = VAR res: T; x0, x1, x2: INTEGER; p: UNTRACED REF ARRAY [0..2] OF Word.T; BEGIN IF (a # 0) THEN x0 := Word.And (b, Mask1); x1 := Word.Or (Word.RightShift (Word.And (b, Mask2B), 28), Word.LeftShift (Word.And (a, Mask2A), 4)); x2 := Word.RightShift (Word.And (a, Mask3), 24); IF (x2 # 0) THEN p := InitValue (s, 3, res); p[0] := x0; p[1] := x1; p[2] := x2; ELSE p := InitValue (s, 2, res); p[0] := x0; p[1] := x1; END; ELSE (* a = 0 *) x0 := Word.And (b, Mask1); x1 := Word.RightShift (Word.And (b, Mask2B), 28); IF (x1 # 0) THEN p := InitValue (s, 2, res); p[0] := x0; p[1] := x1; ELSE p := InitValue (s, 1, res); p[0] := x0; END; END; RETURN res; END New; PROCEDUREcopy (s: Session; READONLY a: T): T = VAR res: T; BEGIN EVAL InitValue (s, a.s, res); SUBARRAY (s.w^, res.w, a.s) := SUBARRAY (s.w^, a.w, a.s); RETURN res; END copy; PROCEDUREadd (s: Session; READONLY a,b: T): T = VAR res: T; carry := 0; x: Word.T; ap, bp, cp: Ptr; a_w, b_w, a_s, b_s: INTEGER; BEGIN IF a.s < b.s THEN (* swap a & b *) a_w := b.w; a_s := b.s; b_w := a.w; b_s := a.s; ELSE a_w := a.w; a_s := a.s; b_w := b.w; b_s := b.s; END; (* INV: a.s >= b.s *) cp := InitValue (s, a_s + 1, res); VAR s_base := ADR (s.w[0]); BEGIN ap := s_base + a_w * ADRSIZE (Word.T); (* = ADR (s.w[a.w]) *) bp := s_base + b_w * ADRSIZE (Word.T); (* = ADR (s.w[b.w]) *) END; FOR i := 0 TO b_s - 1 DO x := Word.Plus (Word.Plus (ap^, bp^), carry); cp^ := Word.And (x, SigBits); carry := Word.RightShift (x, Used); INC (ap, ADRSIZE (ap^)); INC (bp, ADRSIZE (bp^)); INC (cp, ADRSIZE (cp^)); END; FOR i := b_s TO a_s - 1 DO x := Word.Plus (ap^, carry); cp^ := Word.And (x, SigBits); carry := Word.RightShift (x, Used); INC (ap, ADRSIZE (ap^)); INC (cp, ADRSIZE (cp^)); END; cp^ := carry; FixSize (s, res); RETURN res; END add; PROCEDUREdiff (s: Session; READONLY a,b: T): T = VAR res: T; borrow := 0; a_s := a.s; b_s := b.s; ap, bp, cp: Ptr; x: Word.T; BEGIN <* ASSERT a_s >= b_s *> cp := InitValue (s, a_s, res); VAR s_base := ADR (s.w[0]); BEGIN ap := s_base + a.w * ADRSIZE (Word.T); (* = ADR (s.w[a.w]) *) bp := s_base + b.w * ADRSIZE (Word.T); (* = ADR (s.w[b.w]) *) END; FOR i := 0 TO b_s - 1 DO x := Word.Minus (Word.Minus (ap^, bp^), borrow); cp^ := Word.And (x, SigBits); borrow := Word.And (Word.RightShift (x, Used), 1); INC (ap, ADRSIZE (ap^)); INC (bp, ADRSIZE (bp^)); INC (cp, ADRSIZE(cp^)); END; FOR i := b_s TO a_s - 1 DO x := Word.Minus (ap^, borrow); cp^ := Word.And (x, SigBits); borrow := Word.And (Word.RightShift (x, Used), 1); INC (ap, ADRSIZE (ap^)); INC (cp, ADRSIZE(cp^)); END; <*ASSERT borrow = 0*> FixSize (s, res); RETURN res; END diff; PROCEDUREcompare (s: Session; READONLY a, b: T): [-1..1] = VAR ap, bp : Ptr; a_s := a.s; b_s := b.s; BEGIN IF a_s < b_s THEN RETURN -1; ELSIF a_s > b_s THEN RETURN +1; END; VAR s_base := ADR (s.w[0]) + (a_s - 1) * ADRSIZE (Word.T); BEGIN ap := s_base + a.w * ADRSIZE (Word.T); (* = ADR (s.w[a.w + a.s - 1]) *) bp := s_base + b.w * ADRSIZE (Word.T); (* = ADR (s.w[b.w + a.s - 1]) *) END; FOR i := a_s - 1 TO 0 BY -1 DO IF Word.LT (ap^, bp^) THEN RETURN -1; ELSIF Word.GT (ap^, bp^) THEN RETURN +1; END; DEC (ap, ADRSIZE (ap^)); DEC (bp, ADRSIZE (bp^)); END; RETURN 0; END compare; PROCEDUREmax (s: Session; READONLY a, b: T): T = BEGIN IF compare (s, a, b) < 0 THEN RETURN copy (s, b); ELSE RETURN copy (s, a); END; END max; PROCEDUREshift (s: Session; READONLY a: T; n: INTEGER): T = (* to the left for positive n, to the right for negative n ==> a*2^n *) VAR res: T; k: INTEGER; carry := 0; ap, cp: Ptr; BEGIN IF n = 0 OR a.s = 0 THEN RETURN copy (s, a); END; IF n > 0 THEN (* shift left *) k := n DIV (Used); n := n MOD (Used); cp := InitValue (s, a.s + k + 1, res); ap := ADR (s.w[a.w]); FOR i := 0 TO k - 1 DO cp^ := 0; INC (cp, ADRSIZE (cp^)); END; FOR i := 0 TO a.s - 1 DO cp^ := Word.Or (Word.And (Word.LeftShift (ap^, n), SigBits), carry); carry := Word.RightShift (ap^, Used - n); INC (ap, ADRSIZE (ap^)); INC (cp, ADRSIZE (cp^)); END; cp^ := carry; ELSE (* n < 0 *) (* shift right *) k := (-n) DIV Word.Size; n := (-n) MOD Word.Size; EVAL InitValue (s, a.s - k, res); WITH w = s.w^ DO ap := ADR (w[a.w + a.s - 1]); cp := ADR (w[res.w + res.s - 1]); END; FOR i := a.s - k - 1 TO 0 BY -1 DO cp^ := Word.Or (carry, Word.RightShift (ap^, n)); carry := Word.And (Word.LeftShift (ap^, Used - n), SigBits); DEC (ap, ADRSIZE (ap^)); DEC (cp, ADRSIZE (cp^)); END; END; FixSize (s, res); RETURN res; END shift; PROCEDUREtimes2 (s: Session; READONLY a: T): T = (* ==> shift left 1 bit *) VAR res: T; new_sz: INTEGER; carry := 0; ap, cp: Ptr; a_s := a.s; a_w := a.w; BEGIN IF a_s = 0 THEN RETURN copy (s, a); END; new_sz := a_s; IF Word.And (s.w[a_w + a_s - 1], TopBit) # 0 THEN INC (new_sz); END; cp := InitValue (s, new_sz, res); ap := ADR (s.w[a_w]); FOR i := 0 TO a_s - 1 DO cp^ := Word.Or (Word.And (Word.LeftShift (ap^, 1), SigBits), carry); carry := Word.RightShift (ap^, Used - 1); INC (ap, ADRSIZE (ap^)); INC (cp, ADRSIZE (cp^)); END; IF (carry # 0) THEN cp^ := carry; END; RETURN res; END times2; PROCEDUREtimesTenInPlace (s: Session; VAR a: T): T = VAR res: T; carry := 0; x: Word.T; VAR ap: Ptr := ADR (s.w[a.w]); BEGIN FOR i := 0 TO a.s - 1 DO x := Word.Plus (Word.Times (ap^, 10), carry); ap^ := Word.And (x, SigBits); carry := Word.RightShift (x, Used); INC (ap, ADRSIZE (ap^)); END; IF carry = 0 THEN RETURN a; END; EVAL InitValue (s, a.s+1, res); SUBARRAY (s.w^, res.w, a.s) := SUBARRAY (s.w^, a.w, a.s); s.w[res.w+a.s] := carry; a := res; RETURN a; END timesTenInPlace; PROCEDUREdivideTen (s: Session; READONLY a: T): T = (* upper *) VAR res: T; carry := 0; x: INTEGER; ap, cp: Ptr; BEGIN EVAL InitValue (s, a.s, res); WITH w = s.w^, dw = a.s - 1 DO ap := ADR (w[a.w + dw]); cp := ADR (w[res.w + dw]); END; FOR i := a.s - 1 TO 0 BY -1 DO x := Word.Or (Word.LeftShift (carry, Used), ap^); cp^ := Word.Divide (x, 10); carry := Word.Mod (x, 10); DEC (ap, ADRSIZE (ap^)); DEC (cp, ADRSIZE (cp^)); END; FixSize (s, res); IF carry # 0 THEN res := add (s, res, One); END; RETURN res; END divideTen; PROCEDUREdivmod (s: Session; READONLY a, b : T; VAR(*OUT*) d: INTEGER): T = (* The div is known to be a base B digit *) VAR n := 1; nb := b; n1b := Zero; BEGIN WHILE compare (s, a, nb) >= 0 DO n1b := nb; INC (n); nb := add (s, nb, b); END; d := n - 1; RETURN diff (s, a, n1b); END divmod;
PROCEDUREInitValue (s: Session; n_words: INTEGER; VAR(*OUT*) t: T): ADDRESS= (* allocates space in s.w, initializes t, and returns the address of the first word of t *) BEGIN (*** INC (allocates [MIN (n_words, LAST (allocates))]); INC (nAllocates); ***) t.s := n_words; t.w := s.next; INC (s.next, n_words); IF (s.next > NUMBER (s.w^)) THEN Expand (s); END; RETURN ADR (s.w[t.w]); END InitValue; PROCEDUREExpand (s: Session) = VAR n := NUMBER (s.w^); new := NEW (REF ARRAY OF Word.T, n + n); BEGIN SUBARRAY (new^, 0, n) := s.w^; s.w := new; END Expand; PROCEDUREFixSize (s: Session; VAR a: T) = (* computes a.s from a.w, by discarding the null most significant words *) VAR ap: Ptr := ADR (s.w[a.w + a.s - 1]); BEGIN WHILE a.s > 0 AND ap^ = 0 DO DEC (a.s); DEC (ap, ADRSIZE (ap^)); END; END FixSize; BEGIN END DragonInt.