blackbox-linux-console/BlackBox/System/Mod/Integers.txt

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.