1 MODULE Integers;
3 (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 System/Mod/Integers.odc *)
4 (* DO NOT EDIT *)
6 IMPORT Files, Math;
8 CONST
9 B = 10000; DecPerDig = 4; BinBase = 16 * 1024;
10 KaratsubaBreak = 41;
12 TYPE
13 Index = INTEGER;
14 Digit = SHORTINT;
15 DoubleDigit = INTEGER;
17 IntegerDesc = ARRAY OF Digit; (* to hide internal structure from interface *)
18 Integer* = POINTER TO IntegerDesc;
19 Buffer = RECORD
20 digit: Integer;
21 beg, len: Index
22 END;
24 VAR zero, one, two, buf6: Integer;
26 PROCEDURE CopyOf (x: Integer; len: Index): Integer;
27 VAR buf: Integer;
28 BEGIN
29 ASSERT(len > 0, 20);
30 NEW(buf, len);
31 REPEAT DEC(len); buf[len] := x[len] UNTIL len = 0;
32 RETURN buf
33 END CopyOf;
35 (* Operations on Digits *)
37 PROCEDURE Add (x, y, sum: Integer; xL, yL: Index; OUT sumL: Index);
38 VAR i, l: Index; c: Digit;
39 BEGIN
40 l := MIN(xL, yL);
41 i := 0; c := 0;
42 WHILE i < l DO c := SHORT(c DIV B + x[i] + y[i]); sum[i] := SHORT(c MOD B); INC(i) END;
43 WHILE i < xL DO c := SHORT(c DIV B + x[i]); sum[i] := SHORT(c MOD B); INC(i) END;
44 WHILE i < yL DO c := SHORT(c DIV B + y[i]); sum[i] := SHORT(c MOD B); INC(i) END;
45 IF c >= B THEN sum[i] := SHORT(c DIV B); INC(i) END;
46 sumL := i
47 END Add;
49 PROCEDURE Subtract (x, y, dif: Integer; xL, yL: Index; OUT difL: Index);
50 VAR i: Index; c, d: Digit;
51 BEGIN
52 ASSERT(xL >= yL, 20);
53 i := 0; difL := 0; c := 0;
54 WHILE i < yL DO
55 c := SHORT(c DIV B + x[i] - y[i]); d := SHORT(c MOD B);
56 IF d # 0 THEN
57 WHILE difL # i DO dif[difL] := 0; INC(difL) END;
58 dif[i] := d; INC(difL)
59 END;
60 INC(i)
61 END;
62 WHILE i < xL DO
63 c := SHORT(c DIV B + x[i]); d := SHORT(c MOD B);
64 IF d # 0 THEN
65 WHILE difL # i DO dif[difL] := 0; INC(difL) END;
66 dif[i] := d; INC(difL)
67 END;
68 INC(i)
69 END;
70 ASSERT(c DIV B = 0, 100)
71 END Subtract;
73 PROCEDURE OneDigitMult (a, b: Buffer; VAR c: Buffer);
74 VAR i: Index; carry, factor: DoubleDigit;
75 BEGIN
76 ASSERT(a.len = 1, 20);
77 factor := a.digit[a.beg]; i := 0; carry := 0;
78 WHILE i # b.len DO
79 carry := carry DIV B + factor * b.digit[b.beg + i]; c.digit[c.beg + i] := SHORT(carry MOD B);
80 INC(i)
81 END;
82 IF carry >= B THEN c.digit[c.beg + i] := SHORT(carry DIV B); INC(i) END;
83 c.len := i
84 END OneDigitMult;
86 PROCEDURE SimpleMult (a, b: Buffer; VAR c: Buffer);
87 VAR i, j, k: Index; c0, c1: DoubleDigit;
88 BEGIN
89 ASSERT(a.len <= b.len, 20);
90 c.len := a.len + b.len - 1;
91 i := 0; c0 := 0; c1 := 0;
92 REPEAT
93 IF i < b.len THEN
94 IF i < a.len THEN j := i; k := 0 ELSE j := a.len - 1; k := i - a.len + 1 END;
95 REPEAT
96 c0 := c0 + a.digit[a.beg + j] * b.digit[b.beg + k];
97 IF c0 > MAX(DoubleDigit) - BinBase * (B - 1) THEN
98 c1 := c1 + c0 DIV BinBase; c0 := c0 MOD BinBase
99 END;
100 DEC(j); INC(k)
101 UNTIL j < 0
102 ELSE
103 j := a.len - 1; k := i - a.len + 1;
104 REPEAT
105 c0 := c0 + a.digit[a.beg + j] * b.digit[b.beg + k];
106 IF c0 > MAX(DoubleDigit) - BinBase * (B - 1) THEN
107 c1 := c1 + c0 DIV BinBase; c0 := c0 MOD BinBase
108 END;
109 DEC(j); INC(k)
110 UNTIL k = b.len
111 END;
112 IF c1 = 0 THEN c.digit[c.beg + i] := SHORT(c0 MOD B); c0 := c0 DIV B
113 ELSE
114 c0 := c0 + BinBase * (c1 MOD B);
115 c.digit[c.beg + i] := SHORT(c0 MOD B); c0 := c0 DIV B; c1 := c1 DIV B
116 END;
117 INC(i)
118 UNTIL i = c.len;
119 IF c0 # 0 THEN c.digit[c.beg + c.len] := SHORT(c0); INC(c.len) END
120 END SimpleMult;
122 PROCEDURE AddBuf (a, b: Buffer; VAR c: Buffer); (* c := a + b *)
123 VAR i: Index; carry: Digit;
124 BEGIN
125 ASSERT(a.len <= b.len, 20);
126 i := 0; carry := 0;
127 WHILE i # a.len DO
128 carry := SHORT(carry DIV B + a.digit[a.beg + i] + b.digit[b.beg + i]);
129 c.digit[c.beg + i] := SHORT(carry MOD B);
130 INC(i)
131 END;
132 WHILE (i # b.len) & (carry >= B) DO
133 carry := SHORT(carry DIV B + b.digit[b.beg + i]); c.digit[c.beg + i] := SHORT(carry MOD B);
134 INC(i)
135 END;
136 IF carry >= B THEN c.digit[c.beg + i] := SHORT(carry DIV B); INC(i)
137 ELSE
138 WHILE i # b.len DO c.digit[c.beg + i] := b.digit[b.beg + i]; INC(i) END
139 END;
140 c.len := i
141 END AddBuf;
143 PROCEDURE AddToBuf (VAR a: Buffer; b: Buffer; shift: Index); (* a := a + b * B^shift *)
144 VAR i, n: Index; carry: Digit;
145 BEGIN
146 b.beg := b.beg - shift; b.len := b.len + shift; i := shift; n := MIN(a.len, b.len); carry := 0;
147 WHILE i # n DO
148 carry := SHORT(carry DIV B + a.digit[a.beg + i] + b.digit[b.beg + i]);
149 a.digit[a.beg + i] := SHORT(carry MOD B);
150 INC(i)
151 END;
152 IF i # a.len THEN
153 WHILE (i # a.len) & (carry >= B) DO
154 carry := SHORT(carry DIV B + a.digit[a.beg + i]); a.digit[a.beg + i] := SHORT(carry MOD B);
155 INC(i)
156 END;
157 IF carry >= B THEN a.digit[a.beg + i] := SHORT(carry DIV B); INC(i) END
158 ELSE
159 WHILE (i # b.len) & (carry >= B) DO
160 carry := SHORT(carry DIV B + b.digit[b.beg + i]); a.digit[a.beg + i] := SHORT(carry MOD B);
161 INC(i)
162 END;
163 IF carry >= B THEN a.digit[a.beg + i] := SHORT(carry DIV B); INC(i)
164 ELSE
165 WHILE i # b.len DO a.digit[a.beg + i] := b.digit[b.beg + i]; INC(i) END
166 END
167 END;
168 a.len := MAX(i, a.len)
169 END AddToBuf;
171 PROCEDURE SubtractFromBuf (VAR a: Buffer; b, c: Buffer); (* a := a - b - c *)
172 VAR i: Index; carry: Digit;
173 BEGIN
174 ASSERT(b.len <= c.len, 20);
175 i := 0; carry := 0;
176 WHILE i # b.len DO
177 carry := SHORT(carry DIV B + a.digit[a.beg + i] - b.digit[b.beg + i] - c.digit[c.beg + i]);
178 a.digit[a.beg + i] := SHORT(carry MOD B);
179 INC(i)
180 END;
181 WHILE i # c.len DO
182 carry := SHORT(carry DIV B + a.digit[a.beg + i] - c.digit[c.beg + i]);
183 a.digit[a.beg + i] := SHORT(carry MOD B);
184 INC(i)
185 END;
186 WHILE carry < 0 DO
187 carry := SHORT(carry DIV B + a.digit[a.beg + i]); a.digit[a.beg + i] := SHORT(carry MOD B);
188 INC(i)
189 END;
190 ASSERT(i <= a.len, 100);
191 WHILE (a.len # 0) & (a.digit[a.beg + a.len - 1] = 0) DO DEC(a.len) END
192 END SubtractFromBuf;
194 PROCEDURE KStep (a, b: Buffer; VAR c: Buffer; stack: Buffer);
195 VAR n2, i: Index; a0, a1, b0, b1, c0, c1, h: Buffer;
196 BEGIN
197 ASSERT(a.len <= b.len, 20);
198 IF a.len = 0 THEN c.len := 0
199 ELSIF a.len = 1 THEN OneDigitMult(a, b, c)
200 ELSIF a.len <= KaratsubaBreak THEN SimpleMult(a, b, c)
201 ELSE
202 n2 := b.len DIV 2;
203 c0.digit := c.digit; c0.beg := c.beg; c1.digit := c.digit; c1.beg := c.beg + 2 * n2;
204 a0.digit := a.digit; a0.beg := a.beg; a0.len := MIN(a.len, n2);
205 a1.digit := a.digit; a1.beg := a.beg + n2; a1.len := MAX(0, a.len - n2);
206 WHILE (a0.len # 0) & (a0.digit[a0.beg + a0.len - 1] = 0) DO DEC(a0.len) END;
207 b0.digit := b.digit; b0.beg := b.beg; b0.len := MIN(b.len, n2);
208 b1.digit := b.digit; b1.beg := b.beg + n2; b1.len := MAX(0, b.len - n2);
209 WHILE (b0.len # 0) & (b0.digit[b0.beg + b0.len - 1] = 0) DO DEC(b0.len) END;
210 IF (a0.len # 0) OR (b0.len # 0) THEN
211 IF a0.len <= a1.len THEN AddBuf(a0, a1, c1) ELSE AddBuf(a1, a0, c1) END;
212 IF b0.len <= b1.len THEN AddBuf(b0, b1, c0) ELSE AddBuf(b1, b0, c0) END;
213 h.digit := stack.digit; h.beg := stack.beg; stack.beg := stack.beg + c0.len + c1.len;
214 IF c0.len <= c1.len THEN KStep(c0, c1, h, stack) ELSE KStep(c1, c0, h, stack) END;
215 IF a0.len <= b0.len THEN KStep(a0, b0, c0, stack) ELSE KStep(b0, a0, c0, stack) END;
216 KStep(a1, b1, c1, stack);
217 IF c0.len <= c1.len THEN SubtractFromBuf(h, c0, c1) ELSE SubtractFromBuf(h, c1, c0) END;
218 IF c1.len # 0 THEN
219 i := c0.beg + c0.len;
220 WHILE i < c1.beg DO c.digit[i] := 0; INC(i) END;
221 c.len := c1.beg + c1.len - c.beg
222 ELSE
223 WHILE c0.len < n2 DO c0.digit[c0.beg + c0.len] := 0; INC(c0.len) END;
224 c.len := c0.len
225 END;
226 ASSERT(h.len # 0, 100);
227 AddToBuf(c, h, n2)
228 ELSE
229 KStep(a1, b1, c1, stack); c.len := c1.beg + c1.len - c.beg;
230 i := c.beg;
231 WHILE i # c1.beg DO c.digit[i] := 0; INC(i) END
232 END
233 END
234 END KStep;
236 PROCEDURE Karatsuba (x, y, pro:Integer; xL, yL: Index; OUT proL: Index);
237 VAR a, b, c, stack: Buffer;
238 BEGIN
239 ASSERT(xL <= yL, 20);
240 a.digit := x; a.beg := 0; a.len := xL; b.digit := y; b.beg := 0; b.len := yL;
241 c.digit := pro; c.beg := 0;
242 NEW(stack.digit, 2 * b.len); stack.beg := 0;
243 KStep(a, b, c, stack);
244 proL := c.len
245 END Karatsuba;
247 PROCEDURE Multiply (x, y, pro: Integer; xL, yL: Index; OUT proL: Index);
248 VAR i, j, k: Index; c0, c1: DoubleDigit;
249 BEGIN
250 ASSERT(xL <= yL, 20);
251 IF xL > KaratsubaBreak THEN Karatsuba(x, y, pro, xL, yL, proL)
252 ELSIF xL = 1 THEN
253 proL := 0; c1 := x[0]; c0 := 0;
254 WHILE proL < yL DO
255 c0 := c1 * y[proL] + c0; pro[proL] := SHORT(c0 MOD B);
256 c0 := c0 DIV B ; INC(proL)
257 END;
258 IF c0 # 0 THEN pro[proL] := SHORT(c0); INC(proL) END
259 ELSE
260 proL := xL + yL - 1;
261 i := 0; c0 := 0; c1 := 0;
262 REPEAT
263 IF i < yL THEN
264 IF i < xL THEN j := i; k := 0 ELSE j := xL - 1; k := i - xL + 1 END;
265 REPEAT
266 c0 := c0 + x[j] * y[k];
267 IF c0 > MAX(DoubleDigit) - BinBase * (B - 1) THEN
268 c1 := c1 + c0 DIV BinBase; c0 := c0 MOD BinBase
269 END;
270 DEC(j); INC(k)
271 UNTIL j < 0
272 ELSE
273 j := xL - 1; k := i - xL + 1;
274 REPEAT
275 c0 := c0 + x[j] * y[k];
276 IF c0 > MAX(DoubleDigit) - BinBase * (B - 1) THEN
277 c1 := c1 + c0 DIV BinBase; c0 := c0 MOD BinBase
278 END;
279 DEC(j); INC(k)
280 UNTIL k = yL
281 END;
282 IF c1 = 0 THEN pro[i] := SHORT(c0 MOD B); c0 := c0 DIV B
283 ELSE c0 := c0 + BinBase * (c1 MOD B); pro[i] := SHORT(c0 MOD B);
284 c0 := c0 DIV B; c1 := c1 DIV B
285 END;
286 INC(i)
287 UNTIL i = proL;
288 IF c0 # 0 THEN pro[proL] := SHORT(c0); INC(proL) END
289 END
290 END Multiply;
292 PROCEDURE DecomposeQuoRem (x, y: Integer; xL, yL: Index);
293 VAR ix, iy, j: Index; d, q, h, yLead, ySecond: DoubleDigit; yBuf: Integer;
294 BEGIN
295 ASSERT((yL # 0) & (y[yL - 1] # 0), 20);
296 IF yL = 1 THEN
297 j := xL - 1; h := 0; d := y[0];
298 WHILE j >= 0 DO h := x[j] + h * B; x[j + 1] := SHORT(h DIV d); h := h MOD d; DEC(j) END;
299 x[0] := SHORT(h)
300 ELSIF xL >= yL THEN
301 x[xL] := 0; d := (B DIV 2 - 1) DIV y[yL - 1] + 1; yBuf := CopyOf(y, yL);
302 IF d # 1 THEN
303 j := 0; h := 0;
304 WHILE j < xL DO h := d * x[j] + h DIV B; x[j] := SHORT(h MOD B); INC(j) END;
305 x[xL] := SHORT(h DIV B);
306 j := 0; h := 0;
307 WHILE j < yL DO h := d * yBuf[j] + h DIV B; yBuf[j] := SHORT(h MOD B); INC(j) END;
308 ASSERT(h DIV B = 0, 100)
309 END;
310 yLead := yBuf[yL - 1]; ySecond := yBuf[yL - 2]; j := xL;
311 WHILE j >= yL DO
312 IF x[j] # yLead THEN q := (x[j] * B + x[j - 1]) DIV yLead ELSE q := B - 1 END;
313 WHILE ySecond * q > (x[j] * B + x[j - 1] - yLead * q) * B + x[j - 2] DO
314 DEC(q)
315 END;
316 ix := j - yL; iy := 0; h := 0;
317 WHILE iy < yL DO
318 h := x[ix] - q * yBuf[iy] + h DIV B; x[ix] := SHORT(h MOD B); INC(ix); INC(iy)
319 END;
320 IF (-x[j]) # (h DIV B) THEN
321 ix := j - yL; iy := 0; h := 0;
322 WHILE iy < yL DO
323 h := h DIV B + x[ix] + yBuf[iy]; x[ix] := SHORT(h MOD B); INC(ix); INC(iy)
324 END;
325 x[j] := SHORT(q - 1)
326 ELSE x[j] := SHORT(q)
327 END;
328 DEC(j)
329 END;
330 IF d # 1 THEN
331 j := yL; h := 0;
332 WHILE j # 0 DO DEC(j); h := h + x[j]; x[j] := SHORT(h DIV d); h := (h MOD d) * B END
333 END
334 END
335 END DecomposeQuoRem;
337 PROCEDURE GetQuoRem (x, y: Integer; xL, yL: Index; xNeg, yNeg: BOOLEAN;
338 quo, rem: Integer; OUT quoL, remL: Index; OUT quoNeg, remNeg: BOOLEAN;
339 doQuo, doRem: BOOLEAN);
340 VAR i: Index; c: Digit; xBuf: Integer;
341 BEGIN
342 ASSERT(xL >= yL, 20);
343 xBuf := CopyOf(x, xL + 1);
344 DecomposeQuoRem(xBuf, y, xL, yL);
345 i := xL;
346 WHILE (i >= yL) & (xBuf[i] = 0) DO DEC(i) END;
347 quoL := i - yL + 1;
348 i := yL - 1;
349 WHILE (i >= 0) & (xBuf[i] = 0) DO DEC(i) END;
350 remL := i + 1;
351 IF doQuo THEN
352 quoNeg := xNeg # yNeg;
353 IF quoNeg & (remL # 0) THEN
354 i := 0; c := 1;
355 WHILE (i # quoL) & (c # 0) DO
356 c := SHORT(c + xBuf[i + yL]); quo[i] := SHORT(c MOD B); c := SHORT(c DIV B);
357 INC(i)
358 END;
359 IF c = 0 THEN
360 WHILE i # quoL DO quo[i] := xBuf[i + yL]; INC(i) END
361 ELSE quo[i] := c; INC(quoL)
362 END
363 ELSE
364 i := 0;
365 WHILE i # quoL DO quo[i] := xBuf[i + yL]; INC(i) END
366 END
367 END;
368 IF doRem THEN
369 remNeg := yNeg & (remL # 0);
370 IF (xNeg # yNeg) & (remL # 0) THEN Subtract(y, xBuf, rem, yL, remL, remL)
371 ELSE
372 i := 0;
373 WHILE i # remL DO rem[i] := xBuf[i]; INC(i) END
374 END
375 END
376 END GetQuoRem;
378 PROCEDURE BinPower (x: Integer; exp: INTEGER; y: Integer; xL: Index; OUT yL: Index);
379 VAR zL: Index; b: INTEGER; z: Integer;
380 BEGIN
381 ASSERT(exp > 0, 20); ASSERT(xL # 0, 21);
382 b := 1;
383 WHILE 2 * b <= exp DO b := 2 * b END;
384 y[0] := 1; yL := 1; NEW(z, LEN(y^));
385 (* y^b * x^exp = const.) & (2 * b > exp) *)
386 WHILE (exp # 0) OR (b # 1) DO
387 IF exp >= b THEN
388 exp := exp - b;
389 IF xL <= yL THEN Multiply(x, y, z, xL, yL, zL) ELSE Multiply(y, x, z, yL, xL, zL) END
390 ELSE b := b DIV 2; Multiply(y, y, z, yL, yL, zL)
391 END;
392 yL := zL;
393 REPEAT DEC(zL); y[zL] := z[zL] UNTIL zL = 0
394 END
395 END BinPower;
397 (* Data Format Support *)
399 PROCEDURE New (nofDigits: Index): Integer;
400 VAR x: Integer;
401 BEGIN
402 NEW(x, nofDigits + 2); RETURN x
403 END New;
405 PROCEDURE SetLength (x: Integer; len: Index; negative: BOOLEAN);
406 VAR low, high: Digit;
407 BEGIN
408 ASSERT(len >= 0, 20); ASSERT(~negative OR (len # 0), 21);
409 IF negative THEN len := -len END;
410 low := SHORT(len MOD 10000H - 8000H); high := SHORT(len DIV 10000H);
411 x[LEN(x^) - 1] := low; x[LEN(x^) - 2] := high
412 END SetLength;
414 PROCEDURE GetLength (x: Integer; OUT len: Index; OUT negative: BOOLEAN);
415 VAR low, high: Digit;
416 BEGIN
417 low := x[LEN(x^) - 1]; high := x[LEN(x^) - 2];
418 len := low + 8000H + high * 10000H;
419 negative := len < 0; len := ABS(len)
420 END GetLength;
422 (* Exported Services *)
424 PROCEDURE Long* (x: LONGINT): Integer;
425 VAR i: Index; negative: BOOLEAN; int: Integer;
426 BEGIN
427 IF x # 0 THEN
428 negative := x < 0; x := ABS(x);
429 int := New(5); i := 0;
430 REPEAT int[i] := SHORT(SHORT(x MOD B)); x := x DIV B; INC(i) UNTIL x = 0;
431 SetLength(int, i, negative)
432 ELSE int := zero
433 END;
434 RETURN int
435 END Long;
437 PROCEDURE Short* (x: Integer): LONGINT;
438 VAR i: Index; res: LONGINT; negative: BOOLEAN;
439 BEGIN
440 res := 0; GetLength(x, i, negative);
441 WHILE i # 0 DO DEC(i); res := res * B + x[i] END;
442 IF negative THEN res := -res END;
443 RETURN res
444 END Short;
446 PROCEDURE Entier* (x: REAL): Integer;
447 VAR mL, yL, i: Index; mx: REAL; ex: INTEGER; neg: BOOLEAN; y, z: Integer;
449 PROCEDURE Inc(m: Integer; VAR mL: Index);
450 VAR i: Index;
451 BEGIN
452 i := 0;
453 WHILE m[i] = B - 1 DO m[i] := 0; INC(i) END;
454 INC(m[i]);
455 IF i = mL THEN INC(mL); m[mL] := 0 END
456 END Inc;
458 PROCEDURE Double (m: Integer; VAR mL: Index);
459 VAR i: Index; c: Digit;
460 BEGIN
461 i := 0; c := 0;
462 WHILE i < mL DO
463 c := SHORT(c + m[i] * 2); m[i] := SHORT(c MOD B); c := SHORT(c DIV B);
464 INC(i)
465 END;
466 IF c # 0 THEN INC(mL); m[mL] := 0; m[i] := c END
467 END Double;
469 BEGIN
470 IF (x >= 1) OR (x < 0) THEN
471 neg := x < 0; x := ABS(x);
472 mL := 0; buf6[0] := 0; mx := Math.Mantissa(x); ex := Math.Exponent(x);
473 WHILE (mx # 0) & (ex > 0) DO (* mx * 2^ex + m * 2^ex = const. *)
474 IF ENTIER(mx) = 1 THEN Inc(buf6, mL); mx := mx - 1
475 ELSE ASSERT(ENTIER(mx) = 0, 100)
476 END;
477 Double(buf6, mL); mx := 2 * mx; DEC(ex)
478 END;
479 IF (ENTIER(mx) = 1) & (ex = 0) THEN Inc(buf6, mL); mx := mx - 1 END;
480 IF ex > 0 THEN
481 y := New(mL + SHORT(ENTIER(Math.Ln(2) * ex / Math.Ln(B)) + 1));
482 z := New(SHORT(ENTIER(Math.Ln(2) * ex / Math.Ln(B)) + 1));
483 BinPower(two, ex, z, 1, yL);
484 IF mL <= yL THEN Multiply(buf6, z, y, mL, yL, yL) ELSE Multiply(z, buf6, y, yL, mL, yL) END
485 ELSE
486 y := New(mL + 1); yL := mL;
487 i := 0;
488 WHILE i # mL DO y[i] := buf6[i]; INC(i) END
489 END;
490 IF neg & (mx # 0) THEN Inc(y, yL) END;
491 SetLength(y, yL, neg)
492 ELSE y := zero
493 END;
494 RETURN y
495 END Entier;
497 PROCEDURE Float* (x: Integer): REAL;
498 VAR i: Index; y: REAL; negative: BOOLEAN;
499 BEGIN
500 y := 0; GetLength(x, i, negative);
501 WHILE i # 0 DO DEC(i); y := y * B + x[i] END;
502 IF negative THEN y := -y END;
503 RETURN y
504 END Float;
506 PROCEDURE Sign* (x: Integer): INTEGER;
507 VAR len: Index; negative: BOOLEAN;
508 BEGIN
509 GetLength(x, len, negative);
510 IF len = 0 THEN RETURN 0
511 ELSIF negative THEN RETURN -1
512 ELSE RETURN 1
513 END
514 END Sign;
516 PROCEDURE Abs* (x: Integer): Integer;
517 VAR len: Index; negative: BOOLEAN; y: Integer;
518 BEGIN
519 GetLength(x, len, negative);
520 IF negative THEN
521 y := New(len); SetLength(y, len, FALSE);
522 REPEAT DEC(len); y[len] := x[len] UNTIL len = 0
523 ELSE y := x
524 END;
525 RETURN y
526 END Abs;
528 PROCEDURE Digits10Of* (x: Integer): INTEGER;
529 VAR i, n: Index; d: Digit; negative: BOOLEAN;
530 BEGIN
531 GetLength(x, n, negative);
532 IF n # 0 THEN
533 d := x[n - 1]; i := 0;
534 REPEAT INC(i); d := SHORT(d DIV 10) UNTIL d = 0;
535 n := DecPerDig * (n - 1) + i
536 END;
537 RETURN n
538 END Digits10Of;
540 PROCEDURE ThisDigit10* (x: Integer; exp10: INTEGER): CHAR;
541 VAR i, n: Index; d: Digit; negative: BOOLEAN;
542 BEGIN
543 ASSERT(exp10 >= 0, 20);
544 GetLength(x, n, negative); i := exp10 DIV DecPerDig;
545 IF n > i THEN
546 d := x[i]; i := exp10 MOD DecPerDig;
547 WHILE i # 0 DO d := SHORT(d DIV 10); DEC(i) END;
548 d := SHORT(d MOD 10)
549 ELSE d := 0
550 END;
551 RETURN CHR(ORD("0") + d)
552 END ThisDigit10;
554 PROCEDURE Compare* (x, y: Integer): INTEGER;
555 VAR xL, yL: Index; res: INTEGER; xNeg, yNeg: BOOLEAN;
556 BEGIN
557 GetLength(x, xL, xNeg); GetLength(y, yL, yNeg);
558 IF xNeg = yNeg THEN
559 IF (xL = yL) & (xL # 0) THEN
560 DEC(xL);
561 WHILE (xL # 0) & (x[xL] = y[xL]) DO DEC(xL) END;
562 IF x[xL] = y[xL] THEN res := 0 ELSIF (x[xL] < y[xL]) = xNeg THEN res := 1 ELSE res := -1 END
563 ELSE
564 IF xL = yL THEN res := 0 ELSIF (xL < yL) = xNeg THEN res := 1 ELSE res := -1 END
565 END
566 ELSIF xNeg THEN res := -1
567 ELSE res := 1
568 END;
569 RETURN res
570 END Compare;
572 PROCEDURE AddOp (x, y: Integer; subtract: BOOLEAN): Integer;
573 VAR i, d, xL, yL, intL: Index; xNeg, yNeg: BOOLEAN; int: Integer;
574 BEGIN
575 GetLength(x, xL, xNeg); GetLength(y, yL, yNeg);
576 IF yL = 0 THEN int := x
577 ELSIF xL = 0 THEN
578 IF subtract THEN
579 int := New(yL); SetLength(int, yL, ~yNeg);
580 REPEAT DEC(yL); int[yL] := y[yL] UNTIL yL = 0
581 ELSE int := y
582 END
583 ELSIF (xNeg = yNeg) # subtract THEN
584 int := New(MAX(xL, yL) + 1); Add(x, y, int, xL, yL, intL); SetLength(int, intL, xNeg)
585 ELSE
586 d := xL - yL;
587 IF d # 0 THEN i := MAX(xL, yL) - 1
588 ELSE
589 i := xL;
590 REPEAT DEC(i); d := x[i] - y[i] UNTIL (i = 0) OR (d # 0)
591 END;
592 IF d > 0 THEN
593 int := New(i + 1); Subtract(x, y, int, xL, yL, intL); SetLength(int, intL, xNeg)
594 ELSIF d < 0 THEN
595 int := New(i + 1); Subtract(y, x, int, yL, xL, intL); SetLength(int, intL, yNeg # subtract)
596 ELSE int := zero
597 END
598 END;
599 RETURN int
600 END AddOp;
602 PROCEDURE Sum* (x, y: Integer): Integer;
603 BEGIN
604 RETURN AddOp(x, y, FALSE)
605 END Sum;
607 PROCEDURE Difference*(x, y: Integer): Integer;
608 BEGIN
609 RETURN AddOp(x, y, TRUE)
610 END Difference;
612 PROCEDURE Product* (x, y: Integer): Integer;
613 VAR xL, yL, intL: Index; neg, xNeg, yNeg: BOOLEAN; int: Integer;
614 BEGIN
615 GetLength(x, xL, xNeg); GetLength(y, yL, yNeg); neg := xNeg # yNeg;
616 IF xL > yL THEN int := x; x := y; y := int; intL := xL; xL := yL; yL := intL; xNeg := yNeg END;
617 (* x.nofDigits <= y.nofDigits - yNeg no more valid! *)
618 IF xL = 0 THEN int := zero
619 ELSIF (xL = 1) & (x[0] = 1) THEN
620 IF xNeg THEN
621 int := New(yL); SetLength(int, yL, neg);
622 REPEAT DEC(yL); int[yL] := y[yL] UNTIL yL = 0
623 ELSE int := y
624 END
625 ELSE
626 int := New(xL + yL); Multiply(x, y, int, xL, yL, intL); SetLength(int, intL, neg)
627 END;
628 RETURN int
629 END Product;
631 PROCEDURE Quotient* (x, y: Integer): Integer;
632 VAR xL, yL, intL, remL: Index; xNeg, yNeg, qNeg, rNeg: BOOLEAN;
633 int: Integer;
634 BEGIN
635 GetLength(x, xL, xNeg); GetLength(y, yL, yNeg);
636 ASSERT(yL # 0, 20);
637 IF xL < yL THEN int := zero
638 ELSIF (yL = 1) & (y[0] = 1) THEN
639 IF yNeg THEN
640 int := New(xL); SetLength(int, xL, ~xNeg);
641 REPEAT DEC(xL); int[xL] := x[xL] UNTIL xL = 0
642 ELSE int := x
643 END
644 ELSE
645 int := New(xL - yL + 2);
646 GetQuoRem(x, y, xL, yL, xNeg, yNeg, int, NIL, intL, remL, qNeg, rNeg, TRUE, FALSE);
647 SetLength(int, intL, qNeg)
648 END;
649 RETURN int
650 END Quotient;
652 PROCEDURE Remainder* (x, y: Integer): Integer;
653 VAR xL, yL, intL, quoL: Index; xNeg, yNeg, qNeg, rNeg: BOOLEAN;
654 int: Integer;
655 BEGIN
656 GetLength(x, xL, xNeg); GetLength(y, yL, yNeg);
657 ASSERT(yL # 0, 20);
658 IF xL < yL THEN int := x
659 ELSIF (yL = 1) & (y[0] = 1) THEN int := zero
660 ELSE
661 int := New(yL);
662 GetQuoRem(x, y, xL, yL, xNeg, yNeg, NIL, int, quoL, intL, qNeg, rNeg, FALSE, TRUE);
663 SetLength(int, intL, rNeg)
664 END;
665 RETURN int
666 END Remainder;
668 PROCEDURE QuoRem* (x, y: Integer; OUT quo, rem: Integer);
669 VAR xL, yL, quoL, remL: Index; xNeg, yNeg, qNeg, rNeg: BOOLEAN;
670 BEGIN
671 GetLength(x, xL, xNeg); GetLength(y, yL, yNeg);
672 ASSERT(yL # 0, 20);
673 IF xL < yL THEN quo := zero; rem := x
674 ELSIF (yL = 1) & (y[0] = 1) THEN
675 rem := zero;
676 IF yNeg THEN
677 quo := New(xL); SetLength(quo, xL, ~xNeg);
678 REPEAT DEC(xL); quo[xL] := x[xL] UNTIL xL = 0
679 ELSE quo := x
680 END
681 ELSE
682 quo := New(xL - yL + 2); rem := New(yL);
683 GetQuoRem(x, y, xL, yL, xNeg, yNeg, quo, rem, quoL, remL, qNeg, rNeg, TRUE, TRUE);
684 SetLength(quo, quoL, qNeg); SetLength(rem, remL, rNeg)
685 END
686 END QuoRem;
688 PROCEDURE GCD* (x, y: Integer): Integer;
689 VAR xL, yL, i: Index; h: Digit; negative: BOOLEAN; xBuf, yBuf, int: Integer;
690 BEGIN
691 GetLength(x, xL, negative); GetLength(y, yL, negative);
692 IF xL = 0 THEN int := y
693 ELSIF yL = 0 THEN int := x
694 ELSE
695 IF xL >= yL THEN xBuf := CopyOf(x, xL + 1); yBuf := CopyOf(y, yL + 1)
696 ELSE xBuf := CopyOf(y, yL + 1); yBuf := CopyOf(x, xL + 1); i := xL; xL := yL; yL := i
697 END;
698 WHILE yL # 0 DO
699 DecomposeQuoRem(xBuf, yBuf, xL, yL);
700 xL := yL;
701 WHILE (xL # 0) & (xBuf[xL - 1] = 0) DO DEC(xL) END;
702 i := yL;
703 WHILE i # 0 DO DEC(i); h := xBuf[i]; xBuf[i] := yBuf[i]; yBuf[i] := h END;
704 i := xL; xL := yL; yL := i
705 END;
706 int := New(xL); SetLength(int, xL, FALSE);
707 WHILE xL # 0 DO DEC(xL); int[xL] := xBuf[xL] END
708 END;
709 RETURN int
710 END GCD;
712 PROCEDURE Power* (x: Integer; exp: INTEGER): Integer;
713 VAR xL, intL: Index; negative: BOOLEAN; int: Integer;
714 BEGIN
715 ASSERT(exp >= 0, 20);
716 GetLength(x, xL, negative);
717 IF xL = 0 THEN int := zero
718 ELSIF (xL = 1) & (x[0] = 1) THEN
719 IF negative & ~ODD(exp) THEN
720 int := New(xL); SetLength(int, xL, FALSE);
721 REPEAT DEC(xL); int[xL] := x[xL] UNTIL xL = 0
722 ELSE int := x
723 END
724 ELSIF exp = 0 THEN int := one
725 ELSIF exp = 1 THEN int := x
726 ELSE
727 int := New(SHORT((xL - 1) * exp + ENTIER(Math.Ln(x[xL - 1] + 1) * exp / Math.Ln(B)) + 1));
728 BinPower(x, exp, int, xL, intL); SetLength(int, intL, negative & ODD(exp))
729 END;
730 RETURN int
731 END Power;
733 (* Read from and Write to String and File *)
735 PROCEDURE ConvertFromString* (IN s: ARRAY OF CHAR; OUT x: Integer);
736 VAR i, j, k: INTEGER; dig, b: Digit; ch: CHAR; negative: BOOLEAN; new: Integer;
737 BEGIN
738 i := 0; ch := s[0];
739 WHILE (ch # 0X) & (ch <= " ") DO INC(i); ch := s[i] END;
740 negative := ch = "-";
741 IF negative THEN INC(i); ch := s[i] END;
742 IF ch = "+" THEN INC(i); ch := s[i] END;
743 WHILE (ch # 0X) & (ch <= " ") DO INC(i); ch := s[i] END;
744 ASSERT((ch >= "0") & (ch <= "9"), 20);
745 WHILE ch = "0" DO INC(i); ch := s[i] END;
746 IF (ch > "0") & (ch <= "9") THEN
747 j := i;
748 REPEAT INC(j); ch := s[j] UNTIL (ch < "0") OR (ch > "9");
749 k := (j - i - 1) DIV DecPerDig + 2;
750 new := New(k); SetLength(new, k - 1, negative);
751 k := (j - i) MOD DecPerDig;
752 IF k # 0 THEN
753 b := 1; DEC(k);
754 WHILE k # 0 DO DEC(k); b := SHORT(b * 10) END
755 ELSE b := B DIV 10
756 END;
757 REPEAT
758 dig := 0;
759 WHILE b # 0 DO
760 dig := SHORT(dig + b * (ORD(s[i]) - ORD("0"))); b := SHORT(b DIV 10);
761 INC(i)
762 END;
763 new[(j - i) DIV DecPerDig] := dig; b := B DIV 10
764 UNTIL i = j;
765 x := new
766 ELSE x := zero
767 END
768 END ConvertFromString;
770 PROCEDURE ConvertToString* (x: Integer; OUT s: ARRAY OF CHAR);
771 VAR j: Index; i: INTEGER; d, b: Digit; negative: BOOLEAN;
772 BEGIN
773 GetLength(x, j, negative);
774 IF negative THEN s[0] := "-"; i := 1 ELSE i := 0 END;
775 IF j # 0 THEN
776 DEC(j); d := x[j]; b := B DIV 10;
777 WHILE d DIV b = 0 DO b := SHORT(b DIV 10) END;
778 REPEAT
779 s[i] := CHR(d DIV b + ORD("0")); INC(i); d := SHORT(d MOD b); b := SHORT(b DIV 10)
780 UNTIL b = 0;
781 WHILE j # 0 DO
782 DEC(j); d := x[j]; b := B DIV 10;
783 REPEAT
784 s[i] := CHR(d DIV b + ORD("0")); INC(i); d := SHORT(d MOD b); b := SHORT(b DIV 10)
785 UNTIL b = 0
786 END
787 ELSE s[i] := "0"; INC(i)
788 END;
789 s[i] := 0X
790 END ConvertToString;
792 PROCEDURE Internalize* (r: Files.Reader; OUT x: Integer);
793 VAR len: Index; n, version: INTEGER; negative: BOOLEAN;
794 new: Integer; buf: ARRAY 4 OF BYTE;
795 BEGIN
796 r.ReadByte(buf[0]); version := buf[0];
797 ASSERT((version = 0) OR (version >= 128), 20);
798 IF version = 0 THEN
799 r.ReadBytes(buf, 0, 4);
800 len := (((buf[0] MOD 128) * 256 + buf[1] MOD 256) * 256
801 + buf[2] MOD 256) * 256 + buf[3] MOD 256;
802 new := New(len); SetLength(new, len, buf[0] < 0);
803 WHILE len # 0 DO
804 DEC(len);
805 r.ReadBytes(buf, 0, 2); new[len] := SHORT((buf[0] MOD 256) * 256 + buf[1] MOD 256)
806 END;
807 x := new
808 ELSE (* version >= 128 *)
809 r.ReadByte(buf[1]); n := (buf[0] MOD 256) * 256 + buf[1] MOD 256 - 32768;
810 r.ReadBytes(buf, 0, 2); DEC(n);
811 len := (buf[0] MOD 256) * 256 + buf[1] MOD 256; negative := len < 0; len := ABS(len);
812 new := New(len); SetLength(new, len, negative);
813 WHILE n # len DO DEC(n); r.ReadBytes(buf, 0, 2) END;
814 WHILE len # 0 DO
815 DEC(len);
816 r.ReadBytes(buf, 0, 2); new[len] := SHORT((buf[0] MOD 256) * 256 + buf[1] MOD 256)
817 END;
818 x := new
819 END
820 END Internalize;
822 PROCEDURE Externalize* (w: Files.Writer; x: Integer);
823 VAR len, l: Index; d: Digit; i: INTEGER; negative: BOOLEAN; buf: ARRAY 4 OF BYTE;
825 PROCEDURE Byte(x: INTEGER): BYTE;
826 BEGIN
827 ASSERT((x >= MIN(BYTE)) & (x <= MAX(BYTE) - MIN(BYTE)), 20);
828 IF x > MAX(BYTE) THEN RETURN SHORT(SHORT(x - 256)) ELSE RETURN SHORT(SHORT(x)) END
829 END Byte;
831 BEGIN
832 GetLength(x, len, negative); l := len; i := 4;
833 REPEAT DEC(i); buf[i] := Byte(l MOD 256); l := l DIV 256 UNTIL i = 0;
834 IF negative THEN buf[0] := Byte(128 + buf[0] MOD 256) END;
835 w.WriteByte(0); w.WriteBytes(buf, 0, 4);
836 WHILE len # 0 DO
837 DEC(len);
838 d := x[len]; buf[0] := Byte(d DIV 256); buf[1] := Byte(d MOD 256); w.WriteBytes(buf, 0, 2)
839 END
840 END Externalize;
842 BEGIN
843 ASSERT(B <= BinBase, 20);
844 zero := New(0); SetLength(zero, 0, FALSE);
845 one := New(1); one[0] := 1; SetLength(one, 1, FALSE);
846 two := New(1); two[0] := 2; SetLength(two, 1, FALSE);
847 NEW(buf6, 6)
848 END Integers.