MODULE Integers; (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 System/Mod/Integers.odc *) (* DO NOT EDIT *) IMPORT Files, Math; CONST B = 10000; DecPerDig = 4; BinBase = 16 * 1024; KaratsubaBreak = 41; TYPE Index = INTEGER; Digit = SHORTINT; DoubleDigit = INTEGER; IntegerDesc = ARRAY OF Digit; (* to hide internal structure from interface *) Integer* = POINTER TO IntegerDesc; Buffer = RECORD digit: Integer; beg, len: Index END; VAR zero, one, two, buf6: Integer; PROCEDURE CopyOf (x: Integer; len: Index): Integer; VAR buf: Integer; BEGIN ASSERT(len > 0, 20); NEW(buf, len); REPEAT DEC(len); buf[len] := x[len] UNTIL len = 0; RETURN buf END CopyOf; (* Operations on Digits *) PROCEDURE Add (x, y, sum: Integer; xL, yL: Index; OUT sumL: Index); VAR i, l: Index; c: Digit; BEGIN l := MIN(xL, yL); i := 0; c := 0; WHILE i < l DO c := SHORT(c DIV B + x[i] + y[i]); sum[i] := SHORT(c MOD B); INC(i) END; WHILE i < xL DO c := SHORT(c DIV B + x[i]); sum[i] := SHORT(c MOD B); INC(i) END; WHILE i < yL DO c := SHORT(c DIV B + y[i]); sum[i] := SHORT(c MOD B); INC(i) END; IF c >= B THEN sum[i] := SHORT(c DIV B); INC(i) END; sumL := i END Add; PROCEDURE Subtract (x, y, dif: Integer; xL, yL: Index; OUT difL: Index); VAR i: Index; c, d: Digit; BEGIN ASSERT(xL >= yL, 20); i := 0; difL := 0; c := 0; WHILE i < yL DO c := SHORT(c DIV B + x[i] - y[i]); d := SHORT(c MOD B); IF d # 0 THEN WHILE difL # i DO dif[difL] := 0; INC(difL) END; dif[i] := d; INC(difL) END; INC(i) END; WHILE i < xL DO c := SHORT(c DIV B + x[i]); d := SHORT(c MOD B); IF d # 0 THEN WHILE difL # i DO dif[difL] := 0; INC(difL) END; dif[i] := d; INC(difL) END; INC(i) END; ASSERT(c DIV B = 0, 100) END Subtract; PROCEDURE OneDigitMult (a, b: Buffer; VAR c: Buffer); VAR i: Index; carry, factor: DoubleDigit; BEGIN ASSERT(a.len = 1, 20); factor := a.digit[a.beg]; i := 0; carry := 0; WHILE i # b.len DO carry := carry DIV B + factor * b.digit[b.beg + i]; c.digit[c.beg + i] := SHORT(carry MOD B); INC(i) END; IF carry >= B THEN c.digit[c.beg + i] := SHORT(carry DIV B); INC(i) END; c.len := i END OneDigitMult; PROCEDURE SimpleMult (a, b: Buffer; VAR c: Buffer); VAR i, j, k: Index; c0, c1: DoubleDigit; BEGIN ASSERT(a.len <= b.len, 20); c.len := a.len + b.len - 1; i := 0; c0 := 0; c1 := 0; REPEAT IF i < b.len THEN IF i < a.len THEN j := i; k := 0 ELSE j := a.len - 1; k := i - a.len + 1 END; REPEAT c0 := c0 + a.digit[a.beg + j] * b.digit[b.beg + k]; IF c0 > MAX(DoubleDigit) - BinBase * (B - 1) THEN c1 := c1 + c0 DIV BinBase; c0 := c0 MOD BinBase END; DEC(j); INC(k) UNTIL j < 0 ELSE j := a.len - 1; k := i - a.len + 1; REPEAT c0 := c0 + a.digit[a.beg + j] * b.digit[b.beg + k]; IF c0 > MAX(DoubleDigit) - BinBase * (B - 1) THEN c1 := c1 + c0 DIV BinBase; c0 := c0 MOD BinBase END; DEC(j); INC(k) UNTIL k = b.len END; IF c1 = 0 THEN c.digit[c.beg + i] := SHORT(c0 MOD B); c0 := c0 DIV B ELSE c0 := c0 + BinBase * (c1 MOD B); c.digit[c.beg + i] := SHORT(c0 MOD B); c0 := c0 DIV B; c1 := c1 DIV B END; INC(i) UNTIL i = c.len; IF c0 # 0 THEN c.digit[c.beg + c.len] := SHORT(c0); INC(c.len) END END SimpleMult; PROCEDURE AddBuf (a, b: Buffer; VAR c: Buffer); (* c := a + b *) VAR i: Index; carry: Digit; BEGIN ASSERT(a.len <= b.len, 20); i := 0; carry := 0; WHILE i # a.len DO carry := SHORT(carry DIV B + a.digit[a.beg + i] + b.digit[b.beg + i]); c.digit[c.beg + i] := SHORT(carry MOD B); INC(i) END; WHILE (i # b.len) & (carry >= B) DO carry := SHORT(carry DIV B + b.digit[b.beg + i]); c.digit[c.beg + i] := SHORT(carry MOD B); INC(i) END; IF carry >= B THEN c.digit[c.beg + i] := SHORT(carry DIV B); INC(i) ELSE WHILE i # b.len DO c.digit[c.beg + i] := b.digit[b.beg + i]; INC(i) END END; c.len := i END AddBuf; PROCEDURE AddToBuf (VAR a: Buffer; b: Buffer; shift: Index); (* a := a + b * B^shift *) VAR i, n: Index; carry: Digit; BEGIN b.beg := b.beg - shift; b.len := b.len + shift; i := shift; n := MIN(a.len, b.len); carry := 0; WHILE i # n DO carry := SHORT(carry DIV B + a.digit[a.beg + i] + b.digit[b.beg + i]); a.digit[a.beg + i] := SHORT(carry MOD B); INC(i) END; IF i # a.len THEN WHILE (i # a.len) & (carry >= B) DO carry := SHORT(carry DIV B + a.digit[a.beg + i]); a.digit[a.beg + i] := SHORT(carry MOD B); INC(i) END; IF carry >= B THEN a.digit[a.beg + i] := SHORT(carry DIV B); INC(i) END ELSE WHILE (i # b.len) & (carry >= B) DO carry := SHORT(carry DIV B + b.digit[b.beg + i]); a.digit[a.beg + i] := SHORT(carry MOD B); INC(i) END; IF carry >= B THEN a.digit[a.beg + i] := SHORT(carry DIV B); INC(i) ELSE WHILE i # b.len DO a.digit[a.beg + i] := b.digit[b.beg + i]; INC(i) END END END; a.len := MAX(i, a.len) END AddToBuf; PROCEDURE SubtractFromBuf (VAR a: Buffer; b, c: Buffer); (* a := a - b - c *) VAR i: Index; carry: Digit; BEGIN ASSERT(b.len <= c.len, 20); i := 0; carry := 0; WHILE i # b.len DO carry := SHORT(carry DIV B + a.digit[a.beg + i] - b.digit[b.beg + i] - c.digit[c.beg + i]); a.digit[a.beg + i] := SHORT(carry MOD B); INC(i) END; WHILE i # c.len DO carry := SHORT(carry DIV B + a.digit[a.beg + i] - c.digit[c.beg + i]); a.digit[a.beg + i] := SHORT(carry MOD B); INC(i) END; WHILE carry < 0 DO carry := SHORT(carry DIV B + a.digit[a.beg + i]); a.digit[a.beg + i] := SHORT(carry MOD B); INC(i) END; ASSERT(i <= a.len, 100); WHILE (a.len # 0) & (a.digit[a.beg + a.len - 1] = 0) DO DEC(a.len) END END SubtractFromBuf; PROCEDURE KStep (a, b: Buffer; VAR c: Buffer; stack: Buffer); VAR n2, i: Index; a0, a1, b0, b1, c0, c1, h: Buffer; BEGIN ASSERT(a.len <= b.len, 20); IF a.len = 0 THEN c.len := 0 ELSIF a.len = 1 THEN OneDigitMult(a, b, c) ELSIF a.len <= KaratsubaBreak THEN SimpleMult(a, b, c) ELSE n2 := b.len DIV 2; c0.digit := c.digit; c0.beg := c.beg; c1.digit := c.digit; c1.beg := c.beg + 2 * n2; a0.digit := a.digit; a0.beg := a.beg; a0.len := MIN(a.len, n2); a1.digit := a.digit; a1.beg := a.beg + n2; a1.len := MAX(0, a.len - n2); WHILE (a0.len # 0) & (a0.digit[a0.beg + a0.len - 1] = 0) DO DEC(a0.len) END; b0.digit := b.digit; b0.beg := b.beg; b0.len := MIN(b.len, n2); b1.digit := b.digit; b1.beg := b.beg + n2; b1.len := MAX(0, b.len - n2); WHILE (b0.len # 0) & (b0.digit[b0.beg + b0.len - 1] = 0) DO DEC(b0.len) END; IF (a0.len # 0) OR (b0.len # 0) THEN IF a0.len <= a1.len THEN AddBuf(a0, a1, c1) ELSE AddBuf(a1, a0, c1) END; IF b0.len <= b1.len THEN AddBuf(b0, b1, c0) ELSE AddBuf(b1, b0, c0) END; h.digit := stack.digit; h.beg := stack.beg; stack.beg := stack.beg + c0.len + c1.len; IF c0.len <= c1.len THEN KStep(c0, c1, h, stack) ELSE KStep(c1, c0, h, stack) END; IF a0.len <= b0.len THEN KStep(a0, b0, c0, stack) ELSE KStep(b0, a0, c0, stack) END; KStep(a1, b1, c1, stack); IF c0.len <= c1.len THEN SubtractFromBuf(h, c0, c1) ELSE SubtractFromBuf(h, c1, c0) END; IF c1.len # 0 THEN i := c0.beg + c0.len; WHILE i < c1.beg DO c.digit[i] := 0; INC(i) END; c.len := c1.beg + c1.len - c.beg ELSE WHILE c0.len < n2 DO c0.digit[c0.beg + c0.len] := 0; INC(c0.len) END; c.len := c0.len END; ASSERT(h.len # 0, 100); AddToBuf(c, h, n2) ELSE KStep(a1, b1, c1, stack); c.len := c1.beg + c1.len - c.beg; i := c.beg; WHILE i # c1.beg DO c.digit[i] := 0; INC(i) END END END END KStep; PROCEDURE Karatsuba (x, y, pro:Integer; xL, yL: Index; OUT proL: Index); VAR a, b, c, stack: Buffer; BEGIN ASSERT(xL <= yL, 20); a.digit := x; a.beg := 0; a.len := xL; b.digit := y; b.beg := 0; b.len := yL; c.digit := pro; c.beg := 0; NEW(stack.digit, 2 * b.len); stack.beg := 0; KStep(a, b, c, stack); proL := c.len END Karatsuba; PROCEDURE Multiply (x, y, pro: Integer; xL, yL: Index; OUT proL: Index); VAR i, j, k: Index; c0, c1: DoubleDigit; BEGIN ASSERT(xL <= yL, 20); IF xL > KaratsubaBreak THEN Karatsuba(x, y, pro, xL, yL, proL) ELSIF xL = 1 THEN proL := 0; c1 := x[0]; c0 := 0; WHILE proL < yL DO c0 := c1 * y[proL] + c0; pro[proL] := SHORT(c0 MOD B); c0 := c0 DIV B ; INC(proL) END; IF c0 # 0 THEN pro[proL] := SHORT(c0); INC(proL) END ELSE proL := xL + yL - 1; i := 0; c0 := 0; c1 := 0; REPEAT IF i < yL THEN IF i < xL THEN j := i; k := 0 ELSE j := xL - 1; k := i - xL + 1 END; REPEAT c0 := c0 + x[j] * y[k]; IF c0 > MAX(DoubleDigit) - BinBase * (B - 1) THEN c1 := c1 + c0 DIV BinBase; c0 := c0 MOD BinBase END; DEC(j); INC(k) UNTIL j < 0 ELSE j := xL - 1; k := i - xL + 1; REPEAT c0 := c0 + x[j] * y[k]; IF c0 > MAX(DoubleDigit) - BinBase * (B - 1) THEN c1 := c1 + c0 DIV BinBase; c0 := c0 MOD BinBase END; DEC(j); INC(k) UNTIL k = yL END; IF c1 = 0 THEN pro[i] := SHORT(c0 MOD B); c0 := c0 DIV B ELSE c0 := c0 + BinBase * (c1 MOD B); pro[i] := SHORT(c0 MOD B); c0 := c0 DIV B; c1 := c1 DIV B END; INC(i) UNTIL i = proL; IF c0 # 0 THEN pro[proL] := SHORT(c0); INC(proL) END END END Multiply; PROCEDURE DecomposeQuoRem (x, y: Integer; xL, yL: Index); VAR ix, iy, j: Index; d, q, h, yLead, ySecond: DoubleDigit; yBuf: Integer; BEGIN ASSERT((yL # 0) & (y[yL - 1] # 0), 20); IF yL = 1 THEN j := xL - 1; h := 0; d := y[0]; WHILE j >= 0 DO h := x[j] + h * B; x[j + 1] := SHORT(h DIV d); h := h MOD d; DEC(j) END; x[0] := SHORT(h) ELSIF xL >= yL THEN x[xL] := 0; d := (B DIV 2 - 1) DIV y[yL - 1] + 1; yBuf := CopyOf(y, yL); IF d # 1 THEN j := 0; h := 0; WHILE j < xL DO h := d * x[j] + h DIV B; x[j] := SHORT(h MOD B); INC(j) END; x[xL] := SHORT(h DIV B); j := 0; h := 0; WHILE j < yL DO h := d * yBuf[j] + h DIV B; yBuf[j] := SHORT(h MOD B); INC(j) END; ASSERT(h DIV B = 0, 100) END; yLead := yBuf[yL - 1]; ySecond := yBuf[yL - 2]; j := xL; WHILE j >= yL DO IF x[j] # yLead THEN q := (x[j] * B + x[j - 1]) DIV yLead ELSE q := B - 1 END; WHILE ySecond * q > (x[j] * B + x[j - 1] - yLead * q) * B + x[j - 2] DO DEC(q) END; ix := j - yL; iy := 0; h := 0; WHILE iy < yL DO h := x[ix] - q * yBuf[iy] + h DIV B; x[ix] := SHORT(h MOD B); INC(ix); INC(iy) END; IF (-x[j]) # (h DIV B) THEN ix := j - yL; iy := 0; h := 0; WHILE iy < yL DO h := h DIV B + x[ix] + yBuf[iy]; x[ix] := SHORT(h MOD B); INC(ix); INC(iy) END; x[j] := SHORT(q - 1) ELSE x[j] := SHORT(q) END; DEC(j) END; IF d # 1 THEN j := yL; h := 0; WHILE j # 0 DO DEC(j); h := h + x[j]; x[j] := SHORT(h DIV d); h := (h MOD d) * B END END END END DecomposeQuoRem; PROCEDURE GetQuoRem (x, y: Integer; xL, yL: Index; xNeg, yNeg: BOOLEAN; quo, rem: Integer; OUT quoL, remL: Index; OUT quoNeg, remNeg: BOOLEAN; doQuo, doRem: BOOLEAN); VAR i: Index; c: Digit; xBuf: Integer; BEGIN ASSERT(xL >= yL, 20); xBuf := CopyOf(x, xL + 1); DecomposeQuoRem(xBuf, y, xL, yL); i := xL; WHILE (i >= yL) & (xBuf[i] = 0) DO DEC(i) END; quoL := i - yL + 1; i := yL - 1; WHILE (i >= 0) & (xBuf[i] = 0) DO DEC(i) END; remL := i + 1; IF doQuo THEN quoNeg := xNeg # yNeg; IF quoNeg & (remL # 0) THEN i := 0; c := 1; WHILE (i # quoL) & (c # 0) DO c := SHORT(c + xBuf[i + yL]); quo[i] := SHORT(c MOD B); c := SHORT(c DIV B); INC(i) END; IF c = 0 THEN WHILE i # quoL DO quo[i] := xBuf[i + yL]; INC(i) END ELSE quo[i] := c; INC(quoL) END ELSE i := 0; WHILE i # quoL DO quo[i] := xBuf[i + yL]; INC(i) END END END; IF doRem THEN remNeg := yNeg & (remL # 0); IF (xNeg # yNeg) & (remL # 0) THEN Subtract(y, xBuf, rem, yL, remL, remL) ELSE i := 0; WHILE i # remL DO rem[i] := xBuf[i]; INC(i) END END END END GetQuoRem; PROCEDURE BinPower (x: Integer; exp: INTEGER; y: Integer; xL: Index; OUT yL: Index); VAR zL: Index; b: INTEGER; z: Integer; BEGIN ASSERT(exp > 0, 20); ASSERT(xL # 0, 21); b := 1; WHILE 2 * b <= exp DO b := 2 * b END; y[0] := 1; yL := 1; NEW(z, LEN(y^)); (* y^b * x^exp = const.) & (2 * b > exp) *) WHILE (exp # 0) OR (b # 1) DO IF exp >= b THEN exp := exp - b; IF xL <= yL THEN Multiply(x, y, z, xL, yL, zL) ELSE Multiply(y, x, z, yL, xL, zL) END ELSE b := b DIV 2; Multiply(y, y, z, yL, yL, zL) END; yL := zL; REPEAT DEC(zL); y[zL] := z[zL] UNTIL zL = 0 END END BinPower; (* Data Format Support *) PROCEDURE New (nofDigits: Index): Integer; VAR x: Integer; BEGIN NEW(x, nofDigits + 2); RETURN x END New; PROCEDURE SetLength (x: Integer; len: Index; negative: BOOLEAN); VAR low, high: Digit; BEGIN ASSERT(len >= 0, 20); ASSERT(~negative OR (len # 0), 21); IF negative THEN len := -len END; low := SHORT(len MOD 10000H - 8000H); high := SHORT(len DIV 10000H); x[LEN(x^) - 1] := low; x[LEN(x^) - 2] := high END SetLength; PROCEDURE GetLength (x: Integer; OUT len: Index; OUT negative: BOOLEAN); VAR low, high: Digit; BEGIN low := x[LEN(x^) - 1]; high := x[LEN(x^) - 2]; len := low + 8000H + high * 10000H; negative := len < 0; len := ABS(len) END GetLength; (* Exported Services *) PROCEDURE Long* (x: LONGINT): Integer; VAR i: Index; negative: BOOLEAN; int: Integer; BEGIN IF x # 0 THEN negative := x < 0; x := ABS(x); int := New(5); i := 0; REPEAT int[i] := SHORT(SHORT(x MOD B)); x := x DIV B; INC(i) UNTIL x = 0; SetLength(int, i, negative) ELSE int := zero END; RETURN int END Long; PROCEDURE Short* (x: Integer): LONGINT; VAR i: Index; res: LONGINT; negative: BOOLEAN; BEGIN res := 0; GetLength(x, i, negative); WHILE i # 0 DO DEC(i); res := res * B + x[i] END; IF negative THEN res := -res END; RETURN res END Short; PROCEDURE Entier* (x: REAL): Integer; VAR mL, yL, i: Index; mx: REAL; ex: INTEGER; neg: BOOLEAN; y, z: Integer; PROCEDURE Inc(m: Integer; VAR mL: Index); VAR i: Index; BEGIN i := 0; WHILE m[i] = B - 1 DO m[i] := 0; INC(i) END; INC(m[i]); IF i = mL THEN INC(mL); m[mL] := 0 END END Inc; PROCEDURE Double (m: Integer; VAR mL: Index); VAR i: Index; c: Digit; BEGIN i := 0; c := 0; WHILE i < mL DO c := SHORT(c + m[i] * 2); m[i] := SHORT(c MOD B); c := SHORT(c DIV B); INC(i) END; IF c # 0 THEN INC(mL); m[mL] := 0; m[i] := c END END Double; BEGIN IF (x >= 1) OR (x < 0) THEN neg := x < 0; x := ABS(x); mL := 0; buf6[0] := 0; mx := Math.Mantissa(x); ex := Math.Exponent(x); WHILE (mx # 0) & (ex > 0) DO (* mx * 2^ex + m * 2^ex = const. *) IF ENTIER(mx) = 1 THEN Inc(buf6, mL); mx := mx - 1 ELSE ASSERT(ENTIER(mx) = 0, 100) END; Double(buf6, mL); mx := 2 * mx; DEC(ex) END; IF (ENTIER(mx) = 1) & (ex = 0) THEN Inc(buf6, mL); mx := mx - 1 END; IF ex > 0 THEN y := New(mL + SHORT(ENTIER(Math.Ln(2) * ex / Math.Ln(B)) + 1)); z := New(SHORT(ENTIER(Math.Ln(2) * ex / Math.Ln(B)) + 1)); BinPower(two, ex, z, 1, yL); IF mL <= yL THEN Multiply(buf6, z, y, mL, yL, yL) ELSE Multiply(z, buf6, y, yL, mL, yL) END ELSE y := New(mL + 1); yL := mL; i := 0; WHILE i # mL DO y[i] := buf6[i]; INC(i) END END; IF neg & (mx # 0) THEN Inc(y, yL) END; SetLength(y, yL, neg) ELSE y := zero END; RETURN y END Entier; PROCEDURE Float* (x: Integer): REAL; VAR i: Index; y: REAL; negative: BOOLEAN; BEGIN y := 0; GetLength(x, i, negative); WHILE i # 0 DO DEC(i); y := y * B + x[i] END; IF negative THEN y := -y END; RETURN y END Float; PROCEDURE Sign* (x: Integer): INTEGER; VAR len: Index; negative: BOOLEAN; BEGIN GetLength(x, len, negative); IF len = 0 THEN RETURN 0 ELSIF negative THEN RETURN -1 ELSE RETURN 1 END END Sign; PROCEDURE Abs* (x: Integer): Integer; VAR len: Index; negative: BOOLEAN; y: Integer; BEGIN GetLength(x, len, negative); IF negative THEN y := New(len); SetLength(y, len, FALSE); REPEAT DEC(len); y[len] := x[len] UNTIL len = 0 ELSE y := x END; RETURN y END Abs; PROCEDURE Digits10Of* (x: Integer): INTEGER; VAR i, n: Index; d: Digit; negative: BOOLEAN; BEGIN GetLength(x, n, negative); IF n # 0 THEN d := x[n - 1]; i := 0; REPEAT INC(i); d := SHORT(d DIV 10) UNTIL d = 0; n := DecPerDig * (n - 1) + i END; RETURN n END Digits10Of; PROCEDURE ThisDigit10* (x: Integer; exp10: INTEGER): CHAR; VAR i, n: Index; d: Digit; negative: BOOLEAN; BEGIN ASSERT(exp10 >= 0, 20); GetLength(x, n, negative); i := exp10 DIV DecPerDig; IF n > i THEN d := x[i]; i := exp10 MOD DecPerDig; WHILE i # 0 DO d := SHORT(d DIV 10); DEC(i) END; d := SHORT(d MOD 10) ELSE d := 0 END; RETURN CHR(ORD("0") + d) END ThisDigit10; PROCEDURE Compare* (x, y: Integer): INTEGER; VAR xL, yL: Index; res: INTEGER; xNeg, yNeg: BOOLEAN; BEGIN GetLength(x, xL, xNeg); GetLength(y, yL, yNeg); IF xNeg = yNeg THEN IF (xL = yL) & (xL # 0) THEN DEC(xL); WHILE (xL # 0) & (x[xL] = y[xL]) DO DEC(xL) END; IF x[xL] = y[xL] THEN res := 0 ELSIF (x[xL] < y[xL]) = xNeg THEN res := 1 ELSE res := -1 END ELSE IF xL = yL THEN res := 0 ELSIF (xL < yL) = xNeg THEN res := 1 ELSE res := -1 END END ELSIF xNeg THEN res := -1 ELSE res := 1 END; RETURN res END Compare; PROCEDURE AddOp (x, y: Integer; subtract: BOOLEAN): Integer; VAR i, d, xL, yL, intL: Index; xNeg, yNeg: BOOLEAN; int: Integer; BEGIN GetLength(x, xL, xNeg); GetLength(y, yL, yNeg); IF yL = 0 THEN int := x ELSIF xL = 0 THEN IF subtract THEN int := New(yL); SetLength(int, yL, ~yNeg); REPEAT DEC(yL); int[yL] := y[yL] UNTIL yL = 0 ELSE int := y END ELSIF (xNeg = yNeg) # subtract THEN int := New(MAX(xL, yL) + 1); Add(x, y, int, xL, yL, intL); SetLength(int, intL, xNeg) ELSE d := xL - yL; IF d # 0 THEN i := MAX(xL, yL) - 1 ELSE i := xL; REPEAT DEC(i); d := x[i] - y[i] UNTIL (i = 0) OR (d # 0) END; IF d > 0 THEN int := New(i + 1); Subtract(x, y, int, xL, yL, intL); SetLength(int, intL, xNeg) ELSIF d < 0 THEN int := New(i + 1); Subtract(y, x, int, yL, xL, intL); SetLength(int, intL, yNeg # subtract) ELSE int := zero END END; RETURN int END AddOp; PROCEDURE Sum* (x, y: Integer): Integer; BEGIN RETURN AddOp(x, y, FALSE) END Sum; PROCEDURE Difference*(x, y: Integer): Integer; BEGIN RETURN AddOp(x, y, TRUE) END Difference; PROCEDURE Product* (x, y: Integer): Integer; VAR xL, yL, intL: Index; neg, xNeg, yNeg: BOOLEAN; int: Integer; BEGIN GetLength(x, xL, xNeg); GetLength(y, yL, yNeg); neg := xNeg # yNeg; IF xL > yL THEN int := x; x := y; y := int; intL := xL; xL := yL; yL := intL; xNeg := yNeg END; (* x.nofDigits <= y.nofDigits - yNeg no more valid! *) IF xL = 0 THEN int := zero ELSIF (xL = 1) & (x[0] = 1) THEN IF xNeg THEN int := New(yL); SetLength(int, yL, neg); REPEAT DEC(yL); int[yL] := y[yL] UNTIL yL = 0 ELSE int := y END ELSE int := New(xL + yL); Multiply(x, y, int, xL, yL, intL); SetLength(int, intL, neg) END; RETURN int END Product; PROCEDURE Quotient* (x, y: Integer): Integer; VAR xL, yL, intL, remL: Index; xNeg, yNeg, qNeg, rNeg: BOOLEAN; int: Integer; BEGIN GetLength(x, xL, xNeg); GetLength(y, yL, yNeg); ASSERT(yL # 0, 20); IF xL < yL THEN int := zero ELSIF (yL = 1) & (y[0] = 1) THEN IF yNeg THEN int := New(xL); SetLength(int, xL, ~xNeg); REPEAT DEC(xL); int[xL] := x[xL] UNTIL xL = 0 ELSE int := x END ELSE int := New(xL - yL + 2); GetQuoRem(x, y, xL, yL, xNeg, yNeg, int, NIL, intL, remL, qNeg, rNeg, TRUE, FALSE); SetLength(int, intL, qNeg) END; RETURN int END Quotient; PROCEDURE Remainder* (x, y: Integer): Integer; VAR xL, yL, intL, quoL: Index; xNeg, yNeg, qNeg, rNeg: BOOLEAN; int: Integer; BEGIN GetLength(x, xL, xNeg); GetLength(y, yL, yNeg); ASSERT(yL # 0, 20); IF xL < yL THEN int := x ELSIF (yL = 1) & (y[0] = 1) THEN int := zero ELSE int := New(yL); GetQuoRem(x, y, xL, yL, xNeg, yNeg, NIL, int, quoL, intL, qNeg, rNeg, FALSE, TRUE); SetLength(int, intL, rNeg) END; RETURN int END Remainder; PROCEDURE QuoRem* (x, y: Integer; OUT quo, rem: Integer); VAR xL, yL, quoL, remL: Index; xNeg, yNeg, qNeg, rNeg: BOOLEAN; BEGIN GetLength(x, xL, xNeg); GetLength(y, yL, yNeg); ASSERT(yL # 0, 20); IF xL < yL THEN quo := zero; rem := x ELSIF (yL = 1) & (y[0] = 1) THEN rem := zero; IF yNeg THEN quo := New(xL); SetLength(quo, xL, ~xNeg); REPEAT DEC(xL); quo[xL] := x[xL] UNTIL xL = 0 ELSE quo := x END ELSE quo := New(xL - yL + 2); rem := New(yL); GetQuoRem(x, y, xL, yL, xNeg, yNeg, quo, rem, quoL, remL, qNeg, rNeg, TRUE, TRUE); SetLength(quo, quoL, qNeg); SetLength(rem, remL, rNeg) END END QuoRem; PROCEDURE GCD* (x, y: Integer): Integer; VAR xL, yL, i: Index; h: Digit; negative: BOOLEAN; xBuf, yBuf, int: Integer; BEGIN GetLength(x, xL, negative); GetLength(y, yL, negative); IF xL = 0 THEN int := y ELSIF yL = 0 THEN int := x ELSE IF xL >= yL THEN xBuf := CopyOf(x, xL + 1); yBuf := CopyOf(y, yL + 1) ELSE xBuf := CopyOf(y, yL + 1); yBuf := CopyOf(x, xL + 1); i := xL; xL := yL; yL := i END; WHILE yL # 0 DO DecomposeQuoRem(xBuf, yBuf, xL, yL); xL := yL; WHILE (xL # 0) & (xBuf[xL - 1] = 0) DO DEC(xL) END; i := yL; WHILE i # 0 DO DEC(i); h := xBuf[i]; xBuf[i] := yBuf[i]; yBuf[i] := h END; i := xL; xL := yL; yL := i END; int := New(xL); SetLength(int, xL, FALSE); WHILE xL # 0 DO DEC(xL); int[xL] := xBuf[xL] END END; RETURN int END GCD; PROCEDURE Power* (x: Integer; exp: INTEGER): Integer; VAR xL, intL: Index; negative: BOOLEAN; int: Integer; BEGIN ASSERT(exp >= 0, 20); GetLength(x, xL, negative); IF xL = 0 THEN int := zero ELSIF (xL = 1) & (x[0] = 1) THEN IF negative & ~ODD(exp) THEN int := New(xL); SetLength(int, xL, FALSE); REPEAT DEC(xL); int[xL] := x[xL] UNTIL xL = 0 ELSE int := x END ELSIF exp = 0 THEN int := one ELSIF exp = 1 THEN int := x ELSE int := New(SHORT((xL - 1) * exp + ENTIER(Math.Ln(x[xL - 1] + 1) * exp / Math.Ln(B)) + 1)); BinPower(x, exp, int, xL, intL); SetLength(int, intL, negative & ODD(exp)) END; RETURN int END Power; (* Read from and Write to String and File *) PROCEDURE ConvertFromString* (IN s: ARRAY OF CHAR; OUT x: Integer); VAR i, j, k: INTEGER; dig, b: Digit; ch: CHAR; negative: BOOLEAN; new: Integer; BEGIN i := 0; ch := s[0]; WHILE (ch # 0X) & (ch <= " ") DO INC(i); ch := s[i] END; negative := ch = "-"; IF negative THEN INC(i); ch := s[i] END; IF ch = "+" THEN INC(i); ch := s[i] END; WHILE (ch # 0X) & (ch <= " ") DO INC(i); ch := s[i] END; ASSERT((ch >= "0") & (ch <= "9"), 20); WHILE ch = "0" DO INC(i); ch := s[i] END; IF (ch > "0") & (ch <= "9") THEN j := i; REPEAT INC(j); ch := s[j] UNTIL (ch < "0") OR (ch > "9"); k := (j - i - 1) DIV DecPerDig + 2; new := New(k); SetLength(new, k - 1, negative); k := (j - i) MOD DecPerDig; IF k # 0 THEN b := 1; DEC(k); WHILE k # 0 DO DEC(k); b := SHORT(b * 10) END ELSE b := B DIV 10 END; REPEAT dig := 0; WHILE b # 0 DO dig := SHORT(dig + b * (ORD(s[i]) - ORD("0"))); b := SHORT(b DIV 10); INC(i) END; new[(j - i) DIV DecPerDig] := dig; b := B DIV 10 UNTIL i = j; x := new ELSE x := zero END END ConvertFromString; PROCEDURE ConvertToString* (x: Integer; OUT s: ARRAY OF CHAR); VAR j: Index; i: INTEGER; d, b: Digit; negative: BOOLEAN; BEGIN GetLength(x, j, negative); IF negative THEN s[0] := "-"; i := 1 ELSE i := 0 END; IF j # 0 THEN DEC(j); d := x[j]; b := B DIV 10; WHILE d DIV b = 0 DO b := SHORT(b DIV 10) END; REPEAT s[i] := CHR(d DIV b + ORD("0")); INC(i); d := SHORT(d MOD b); b := SHORT(b DIV 10) UNTIL b = 0; WHILE j # 0 DO DEC(j); d := x[j]; b := B DIV 10; REPEAT s[i] := CHR(d DIV b + ORD("0")); INC(i); d := SHORT(d MOD b); b := SHORT(b DIV 10) UNTIL b = 0 END ELSE s[i] := "0"; INC(i) END; s[i] := 0X END ConvertToString; PROCEDURE Internalize* (r: Files.Reader; OUT x: Integer); VAR len: Index; n, version: INTEGER; negative: BOOLEAN; new: Integer; buf: ARRAY 4 OF BYTE; BEGIN r.ReadByte(buf[0]); version := buf[0]; ASSERT((version = 0) OR (version >= 128), 20); IF version = 0 THEN r.ReadBytes(buf, 0, 4); len := (((buf[0] MOD 128) * 256 + buf[1] MOD 256) * 256 + buf[2] MOD 256) * 256 + buf[3] MOD 256; new := New(len); SetLength(new, len, buf[0] < 0); WHILE len # 0 DO DEC(len); r.ReadBytes(buf, 0, 2); new[len] := SHORT((buf[0] MOD 256) * 256 + buf[1] MOD 256) END; x := new ELSE (* version >= 128 *) r.ReadByte(buf[1]); n := (buf[0] MOD 256) * 256 + buf[1] MOD 256 - 32768; r.ReadBytes(buf, 0, 2); DEC(n); len := (buf[0] MOD 256) * 256 + buf[1] MOD 256; negative := len < 0; len := ABS(len); new := New(len); SetLength(new, len, negative); WHILE n # len DO DEC(n); r.ReadBytes(buf, 0, 2) END; WHILE len # 0 DO DEC(len); r.ReadBytes(buf, 0, 2); new[len] := SHORT((buf[0] MOD 256) * 256 + buf[1] MOD 256) END; x := new END END Internalize; PROCEDURE Externalize* (w: Files.Writer; x: Integer); VAR len, l: Index; d: Digit; i: INTEGER; negative: BOOLEAN; buf: ARRAY 4 OF BYTE; PROCEDURE Byte(x: INTEGER): BYTE; BEGIN ASSERT((x >= MIN(BYTE)) & (x <= MAX(BYTE) - MIN(BYTE)), 20); IF x > MAX(BYTE) THEN RETURN SHORT(SHORT(x - 256)) ELSE RETURN SHORT(SHORT(x)) END END Byte; BEGIN GetLength(x, len, negative); l := len; i := 4; REPEAT DEC(i); buf[i] := Byte(l MOD 256); l := l DIV 256 UNTIL i = 0; IF negative THEN buf[0] := Byte(128 + buf[0] MOD 256) END; w.WriteByte(0); w.WriteBytes(buf, 0, 4); WHILE len # 0 DO DEC(len); d := x[len]; buf[0] := Byte(d DIV 256); buf[1] := Byte(d MOD 256); w.WriteBytes(buf, 0, 2) END END Externalize; BEGIN ASSERT(B <= BinBase, 20); zero := New(0); SetLength(zero, 0, FALSE); one := New(1); one[0] := 1; SetLength(one, 1, FALSE); two := New(1); two[0] := 2; SetLength(two, 1, FALSE); NEW(buf6, 6) END Integers.