source: BigInt/UInt128.pas

Last change on this file was 514, checked in by chronos, 6 years ago
  • Modified: Updated BigInt classes for Int128 a UInt128.
File size: 30.4 KB
Line 
1unit UInt128;
2
3{$mode delphi}{$H+}
4
5interface
6
7uses
8 Classes, SysUtils;
9
10type
11
12 { UInt128 }
13
14 UInt128 = packed record
15 procedure SetZero;
16 procedure SetOne;
17 procedure SetMinimum;
18 procedure SetMaximum;
19 function IsZero: Boolean;
20 function IsOne: Boolean;
21 function IsMinimum: Boolean;
22 function IsMaximum: Boolean;
23 class function Min(A, B: UInt128): UInt128; static;
24 class function Max(A, B: UInt128): UInt128; static;
25 class function Zero: UInt128; static;
26 class function One: UInt128; static;
27 class function Minimum: UInt128; static;
28 class function Maximum: UInt128; static;
29 class function Compare(A, B: UInt128): Int8; static;
30 class procedure IntDivMod(A, B: UInt128; var Q, R: UInt128); static;
31 class operator Inc(A: UInt128): UInt128;
32 class operator Dec(A: UInt128): UInt128;
33 class operator Implicit(A: ShortInt): UInt128;
34 class operator Implicit(A: Byte): UInt128;
35 class operator Implicit(A: UInt128): Byte;
36 class operator Implicit(A: UInt128): LongWord;
37 class operator Implicit(A: UInt128): ShortInt;
38 class operator BitwiseXor(A, B: UInt128): UInt128;
39 class operator BitwiseAnd(A, B: UInt128): UInt128;
40 class operator BitwiseOr(A, B: UInt128): UInt128;
41 class operator Add(A, B: UInt128): UInt128;
42 class operator Subtract(A, B: UInt128): UInt128;
43 class operator Equal(A, B: UInt128): Boolean;
44 class operator LessThan(A, B: UInt128): Boolean;
45 class operator LessThanOrEqual(A, B: UInt128): Boolean;
46 class operator GreaterThan(A, B: UInt128): Boolean;
47 class operator GreaterThanOrEqual(A, B: UInt128): Boolean;
48 class operator Multiply(A, B: UInt128): UInt128;
49 class operator IntDivide(A, B: UInt128): UInt128;
50 class operator Modulus(A, B: UInt128): UInt128;
51 class operator LeftShift(A, B: UInt128): UInt128;
52 class operator RightShift(A, B: UInt128): UInt128;
53 case Integer of
54 0: (Bytes: array[0..15] of Byte);
55 1: (Words: array[0..7] of Word);
56 2: (LongWords: array[0..3] of LongWord);
57 3: (QWords: array[0..1] of QWord);
58 end;
59 PUInt128 = ^UInt128;
60
61 { Int128 }
62
63 Int128 = packed record
64 procedure SetZero;
65 procedure SetOne;
66 procedure SetMinusOne;
67 procedure SetMinimum;
68 procedure SetMaximum;
69 function IsZero: Boolean;
70 function IsOne: Boolean;
71 function IsMinusOne: Boolean;
72 function IsMinimum: Boolean;
73 function IsMaximum: Boolean;
74 function IsNegative: Boolean;
75 function IsPositive: Boolean;
76 function Abs: Int128;
77 function Sign: Int8;
78 class function Min(A, B: Int128): Int128; static;
79 class function Max(A, B: Int128): Int128; static;
80 class function Zero: Int128; static;
81 class function One: Int128; static;
82 class function MinusOne: Int128; static;
83 class function Minimum: Int128; static;
84 class function Maximum: Int128; static;
85 class function Compare(A, B: Int128): Int8; static;
86 class procedure IntDivMod(A, B: Int128; var Q, R: Int128); static;
87 class operator Inc(A: Int128): Int128;
88 class operator Dec(A: Int128): Int128;
89 class operator Implicit(A: ShortInt): Int128;
90 class operator Implicit(A: Byte): Int128;
91 class operator Implicit(A: Int64): Int128;
92 class operator Implicit(A: UInt128): Int128;
93 class operator Implicit(A: Int128): ShortInt;
94 class operator Implicit(A: Int128): Byte;
95 class operator Implicit(A: Int128): LongWord;
96 class operator Implicit(A: Int128): UInt128;
97 class operator BitwiseXor(A, B: Int128): Int128;
98 class operator BitwiseAnd(A, B: Int128): Int128;
99 class operator BitwiseOr(A, B: Int128): Int128;
100 class operator Add(A, B: Int128): Int128;
101 class operator Subtract(A, B: Int128): Int128;
102 class operator Equal(A, B: Int128): Boolean;
103 class operator LessThan(A, B: Int128): Boolean;
104 class operator LessThanOrEqual(A, B: Int128): Boolean;
105 class operator GreaterThan(A, B: Int128): Boolean;
106 class operator GreaterThanOrEqual(A, B: Int128): Boolean;
107 class operator Negative(A: Int128): Int128;
108 class operator Multiply(A, B: Int128): Int128;
109 class operator IntDivide(A, B: Int128): Int128;
110 class operator Modulus(A, B: Int128): Int128;
111 class operator LeftShift(A, B: Int128): Int128;
112 class operator RightShift(A, B: Int128): Int128;
113 case Integer of
114 0: (Bytes: array[0..15] of Byte);
115 1: (ShortInts: array[0..15] of ShortInt);
116 2: (Words: array[0..7] of Word);
117 3: (SmallInts: array[0..7] of SmallInt);
118 4: (LongWords: array[0..3] of LongWord);
119 5: (LongInts: array[0..3] of LongInt);
120 6: (QWords: array[0..1] of QWord);
121 7: (Int64s: array[0..1] of Int64);
122 end;
123 PInt128 = ^Int128;
124
125function IntToStr(Value: Int128): string; overload;
126function IntToStr(Value: UInt128): string; overload;
127function IntToHex(Value: Int128; Digits: integer): string; overload;
128function IntToHex(Value: UInt128; Digits: integer): string; overload;
129
130
131implementation
132
133
134const
135 HexDigits: array[0..15] of Char = '0123456789ABCDEF';
136
137// Raise errors using Error function in System.pas
138{$IFOPT Q+}
139procedure RaiseOverflowError;
140begin
141 Error(reIntOverflow);
142end;
143{$ENDIF}
144
145{$IFOPT R+}
146procedure RaiseRangeError;
147begin
148 Error(reRangeError);
149end;
150{$ENDIF}
151procedure RaiseDivByZeroError;
152begin
153 Error(reDivByZero);
154end;
155
156function IntToHex(Value: Int128; Digits: integer): string;
157var
158 I: Integer;
159begin
160 if Digits = 0 then
161 Digits := 1;
162 SetLength(Result, Digits);
163 for I := 0 to Digits - 1 do
164 begin
165 Result[Digits - I] := HexDigits[Value and 15];
166 Value := Value shr 4;
167 end ;
168 while Value <> 0 do begin
169 Result := HexDigits[Value and 15] + Result;
170 Value := Value shr 4;
171 end;
172end;
173
174function IntToHex(Value: UInt128; Digits: integer): string;
175var
176 I: Integer;
177begin
178 if Digits = 0 then
179 Digits := 1;
180 SetLength(Result, Digits);
181 for I := 0 to Digits - 1 do
182 begin
183 Result[Digits - I] := HexDigits[Value and 15];
184 Value := Value shr 4;
185 end ;
186 while Value <> 0 do begin
187 Result := HexDigits[Value and 15] + Result;
188 Value := Value shr 4;
189 end;
190end;
191
192function IntToStr(Value: Int128): string;
193begin
194 Result := '';
195 if Value < 0 then begin
196 Value := -Value;
197 while Value > 9 do begin
198 Result := Chr(Ord('0') + (Value mod 10)) + Result;
199 Value := Value div 10;
200 end;
201 Result := '-' + Chr(Ord('0') + (Value mod 10)) + Result;
202 end else begin
203 while Value > 9 do begin
204 Result := Chr(Ord('0') + (Value mod 10)) + Result;
205 Value := Value div 10;
206 end;
207 Result := Chr(Ord('0') + Value) + Result;
208 end;
209end;
210
211function IntToStr(Value: UInt128): string;
212begin
213 Result := '';
214 while Value < 9 do begin
215 Result := Chr(Ord('0') + (Value mod 10)) + Result;
216 Value := Value div 10;
217 end;
218 Result := Chr(Ord('0') + (Value mod 10)) + Result;
219end;
220
221{ UInt128 }
222
223procedure UInt128.SetZero;
224begin
225 QWords[0] := 0;
226 QWords[1] := 0;
227end;
228
229procedure UInt128.SetOne;
230begin
231 QWords[0] := 1;
232 QWords[1] := 0;
233end;
234
235procedure UInt128.SetMinimum;
236begin
237 SetZero;
238end;
239
240procedure UInt128.SetMaximum;
241begin
242 LongWords[0] := $ffffffff;
243 LongWords[1] := $ffffffff;
244 LongWords[2] := $ffffffff;
245 LongWords[3] := $ffffffff;
246end;
247
248function UInt128.IsZero: Boolean;
249begin
250 Result := Self = UInt128.Zero;
251end;
252
253function UInt128.IsOne: Boolean;
254begin
255 Result := Self = UInt128.One;
256end;
257
258function UInt128.IsMinimum: Boolean;
259begin
260 Result := Self = UInt128.Minimum;
261end;
262
263function UInt128.IsMaximum: Boolean;
264begin
265 Result := Self = UInt128.Maximum;
266end;
267
268class function UInt128.Min(A, B: UInt128): UInt128;
269begin
270 if A < B then Result := A else Result := B;
271end;
272
273class function UInt128.Max(A, B: UInt128): UInt128;
274begin
275 if A > B then Result := A else Result := B;
276end;
277
278class function UInt128.Zero: UInt128;
279begin
280 Result.SetZero;
281end;
282
283class function UInt128.One: UInt128;
284begin
285 Result.SetOne;
286end;
287
288class function UInt128.Minimum: UInt128;
289begin
290 Result.SetMinimum;
291end;
292
293class function UInt128.Maximum: UInt128;
294begin
295 Result.SetMaximum;
296end;
297
298class function UInt128.Compare(A, B: UInt128): Int8;
299var
300 C, D: LongWord;
301begin
302 C := A.LongWords[3];
303 D := B.LongWords[3];
304 if C = D then
305 begin
306 C := A.LongWords[2];
307 D := B.LongWords[2];
308 if C = D then
309 begin
310 C := A.LongWords[1];
311 D := B.LongWords[1];
312 if C = D then
313 begin
314 C := A.LongWords[0];
315 D := B.LongWords[0];
316 end;
317 end;
318 end;
319 if C > D then
320 Result := 1 else
321 if C < D then
322 Result := -1
323 else
324 Result := 0;
325end;
326
327class operator UInt128.Implicit(A: ShortInt): UInt128;
328begin
329 {$IFOPT R+}
330 if A < 0 then
331 RaiseRangeError;
332 {$ENDIF}
333 Result.SetZero;
334 Result.Bytes[0] := A;
335end;
336
337class operator UInt128.Implicit(A: Byte): UInt128;
338begin
339 Result.SetZero;
340 Result.Bytes[0] := A;
341end;
342
343class operator UInt128.Implicit(A: UInt128): Byte;
344begin
345 Result := A.Bytes[0];
346end;
347
348class operator UInt128.Implicit(A: UInt128): LongWord;
349begin
350 Result := A.LongWords[0];
351end;
352
353class operator UInt128.Implicit(A: UInt128): ShortInt;
354begin
355 {$IFOPT R+}
356 if not (A <= High(ShortInt)) then
357 RaiseRangeError;
358 {$ENDIF}
359 Result := A.Bytes[0];
360end;
361
362class operator UInt128.BitwiseXor(A, B: UInt128): UInt128;
363begin
364 Result.LongWords[0] := A.LongWords[0] xor B.LongWords[0];
365 Result.LongWords[1] := A.LongWords[1] xor B.LongWords[1];
366end;
367
368class operator UInt128.BitwiseAnd(A, B: UInt128): UInt128;
369begin
370 Result.LongWords[0] := A.LongWords[0] and B.LongWords[0];
371 Result.LongWords[1] := A.LongWords[1] and B.LongWords[1];
372end;
373
374class operator UInt128.BitwiseOr(A, B: UInt128): UInt128;
375begin
376 Result.LongWords[0] := A.LongWords[0] or B.LongWords[0];
377 Result.LongWords[1] := A.LongWords[1] or B.LongWords[1];
378end;
379
380class operator UInt128.Add(A, B: UInt128): UInt128;
381var
382 C: LongWord;
383 D: Integer;
384begin
385 C := LongWord(A.Words[0]) + B.Words[0];
386 Result.Words[0] := Word(C and $FFFF);
387
388 for D := 1 to 7 do begin
389 C := C shr 16;
390 Inc(C, A.Words[D]);
391 Inc(C, B.Words[D]);
392 Result.Words[D] := Word(C and $FFFF);
393 end;
394
395 {$IFOPT Q+}
396 C := C shr 16;
397 if C > 0 then RaiseOverflowError;
398 {$ENDIF}
399end;
400
401class operator UInt128.Subtract(A, B: UInt128): UInt128;
402var
403 C, D: Integer;
404begin
405 C := A.Words[0];
406 Dec(C, B.Words[0]);
407 Result.Words[0] := Word(C);
408
409 for D := 1 to 7 do
410 begin
411 if C < 0 then C := -1 else C := 0;
412 Inc(C, A.Words[D]);
413 Dec(C, B.Words[D]);
414 Result.Words[D] := Word(C);
415 end;
416
417 {$IFOPT Q+}
418 if C < 0 then RaiseOverflowError;
419 {$ENDIF}
420end;
421
422class operator UInt128.Equal(A, B: UInt128): Boolean;
423begin
424 Result := (A.LongWords[0] = B.LongWords[0]) and
425 (A.LongWords[1] = B.LongWords[1]);
426end;
427
428class operator UInt128.LessThan(A, B: UInt128): Boolean;
429var
430 G: Int8;
431begin
432 G := Compare(A, B);
433 Result := G = -1;
434end;
435
436class operator UInt128.LessThanOrEqual(A, B: UInt128): Boolean;
437begin
438 Result := not (A > B);
439end;
440
441class operator UInt128.GreaterThan(A, B: UInt128): Boolean;
442begin
443 Result := Compare(A, B) = 1;
444end;
445
446class operator UInt128.GreaterThanOrEqual(A, B: UInt128): Boolean;
447begin
448 Result := not (A < B);
449end;
450
451class operator UInt128.Multiply(A, B: UInt128): UInt128;
452var
453 C : Int64;
454begin
455 C := LongWord(A.Words[0]) * B.Words[0];
456 Result.Words[0] := Word(C);
457
458 C := C shr 16;
459 Inc(C, LongWord(A.Words[0]) * B.Words[1]);
460 Inc(C, LongWord(A.Words[1]) * B.Words[0]);
461 Result.Words[1] := Word(C);
462
463 C := C shr 16;
464 Inc(C, LongWord(A.Words[0]) * B.Words[2]);
465 Inc(C, LongWord(A.Words[1]) * B.Words[1]);
466 Inc(C, LongWord(A.Words[2]) * B.Words[0]);
467 Result.Words[2] := Word(C);
468
469 C := C shr 16;
470 Inc(C, LongWord(A.Words[0]) * B.Words[3]);
471 Inc(C, LongWord(A.Words[1]) * B.Words[2]);
472 Inc(C, LongWord(A.Words[2]) * B.Words[1]);
473 Inc(C, LongWord(A.Words[3]) * B.Words[0]);
474 Result.Words[3] := Word(C);
475
476 C := C shr 16;
477 Inc(C, LongWord(A.Words[0]) * B.Words[4]);
478 Inc(C, LongWord(A.Words[1]) * B.Words[3]);
479 Inc(C, LongWord(A.Words[2]) * B.Words[2]);
480 Inc(C, LongWord(A.Words[3]) * B.Words[1]);
481 Inc(C, LongWord(A.Words[4]) * B.Words[0]);
482 Result.Words[4] := Word(C);
483
484 C := C shr 16;
485 Inc(C, LongWord(A.Words[0]) * B.Words[5]);
486 Inc(C, LongWord(A.Words[1]) * B.Words[4]);
487 Inc(C, LongWord(A.Words[2]) * B.Words[3]);
488 Inc(C, LongWord(A.Words[3]) * B.Words[2]);
489 Inc(C, LongWord(A.Words[4]) * B.Words[1]);
490 Inc(C, LongWord(A.Words[5]) * B.Words[0]);
491 Result.Words[5] := Word(C);
492
493 C := C shr 16;
494 Inc(C, LongWord(A.Words[0]) * B.Words[6]);
495 Inc(C, LongWord(A.Words[1]) * B.Words[5]);
496 Inc(C, LongWord(A.Words[2]) * B.Words[4]);
497 Inc(C, LongWord(A.Words[3]) * B.Words[3]);
498 Inc(C, LongWord(A.Words[4]) * B.Words[2]);
499 Inc(C, LongWord(A.Words[5]) * B.Words[1]);
500 Inc(C, LongWord(A.Words[6]) * B.Words[0]);
501 Result.Words[6] := Word(C);
502
503 C := C shr 16;
504 Inc(C, LongWord(A.Words[0]) * B.Words[7]);
505 Inc(C, LongWord(A.Words[1]) * B.Words[6]);
506 Inc(C, LongWord(A.Words[2]) * B.Words[5]);
507 Inc(C, LongWord(A.Words[3]) * B.Words[4]);
508 Inc(C, LongWord(A.Words[4]) * B.Words[3]);
509 Inc(C, LongWord(A.Words[5]) * B.Words[2]);
510 Inc(C, LongWord(A.Words[6]) * B.Words[1]);
511 Inc(C, LongWord(A.Words[7]) * B.Words[0]);
512 Result.Words[7] := Word(C);
513
514 {$IFOPT Q+}
515 C := C shr 16;
516 Inc(C, LongWord(A.Words[1]) * B.Words[7]);
517 Inc(C, LongWord(A.Words[2]) * B.Words[6]);
518 Inc(C, LongWord(A.Words[3]) * B.Words[5]);
519 Inc(C, LongWord(A.Words[4]) * B.Words[4]);
520 Inc(C, LongWord(A.Words[5]) * B.Words[3]);
521 Inc(C, LongWord(A.Words[6]) * B.Words[2]);
522 Inc(C, LongWord(A.Words[7]) * B.Words[1]);
523 if C > 0 then
524 RaiseOverflowError;
525
526 C := C shr 16;
527 Inc(C, LongWord(A.Words[2]) * B.Words[7]);
528 Inc(C, LongWord(A.Words[3]) * B.Words[6]);
529 Inc(C, LongWord(A.Words[4]) * B.Words[5]);
530 Inc(C, LongWord(A.Words[5]) * B.Words[4]);
531 Inc(C, LongWord(A.Words[6]) * B.Words[3]);
532 Inc(C, LongWord(A.Words[7]) * B.Words[2]);
533 if C > 0 then
534 RaiseOverflowError;
535
536 C := C shr 16;
537 Inc(C, LongWord(A.Words[3]) * B.Words[7]);
538 Inc(C, LongWord(A.Words[4]) * B.Words[6]);
539 Inc(C, LongWord(A.Words[5]) * B.Words[5]);
540 Inc(C, LongWord(A.Words[6]) * B.Words[4]);
541 Inc(C, LongWord(A.Words[7]) * B.Words[3]);
542 if C > 0 then
543 RaiseOverflowError;
544
545 C := C shr 16;
546 Inc(C, LongWord(A.Words[4]) * B.Words[7]);
547 Inc(C, LongWord(A.Words[5]) * B.Words[6]);
548 Inc(C, LongWord(A.Words[6]) * B.Words[5]);
549 Inc(C, LongWord(A.Words[7]) * B.Words[4]);
550 if C > 0 then
551 RaiseOverflowError;
552
553 C := C shr 16;
554 Inc(C, LongWord(A.Words[5]) * B.Words[7]);
555 Inc(C, LongWord(A.Words[6]) * B.Words[6]);
556 Inc(C, LongWord(A.Words[7]) * B.Words[5]);
557 if C > 0 then
558 RaiseOverflowError;
559
560 C := C shr 16;
561 Inc(C, LongWord(A.Words[6]) * B.Words[7]);
562 Inc(C, LongWord(A.Words[7]) * B.Words[6]);
563 if C > 0 then
564 RaiseOverflowError;
565
566 C := C shr 16;
567 Inc(C, LongWord(A.Words[7]) * B.Words[7]);
568 if C > 0 then
569 RaiseOverflowError;
570 {$ENDIF}
571end;
572
573class operator UInt128.IntDivide(A, B: UInt128): UInt128;
574var
575 M: UInt128;
576begin
577 IntDivMod(A, B, Result, M);
578end;
579
580class procedure UInt128.IntDivMod(A, B: UInt128; var Q, R: UInt128);
581var
582 C: Integer;
583 D: UInt128;
584begin
585 // Handle special cases
586 if B.IsZero then begin // B = 0
587 RaiseDivByZeroError;
588 end else
589 if B.IsOne then begin// B = 1
590 Q := A;
591 R.SetZero;
592 Exit;
593 end else
594 if A.IsZero then begin // A = 0
595 Q.SetZero;
596 R.SetZero;
597 Exit;
598 end;
599 C := UInt128.Compare(A, B);
600 if C < 0 then begin // A < B
601 R := A;
602 Q.SetZero;
603 Exit;
604 end else
605 if C = 0 then begin // A = B
606 Q.SetOne;
607 R.SetZero;
608 Exit;
609 end;
610 // Divide using "restoring radix two" division
611 D := A;
612 R.SetZero; // remainder (128 bits)
613 Q.SetZero; // quotient (128 bits)
614 for C := 0 to 127 do begin
615 // Shift high bit of dividend D into low bit of remainder R
616 R := R shl 1;
617 if D.LongWords[3] and $80000000 <> 0 then
618 R.LongWords[0] := R.LongWords[0] or 1;
619 D := D shl 1;
620 // Shift quotient
621 Q := Q shl 1;
622 // Subtract divisor from remainder if large enough
623 if UInt128.Compare(R, B) >= 0 then begin
624 R := R - B;
625 // Set result bit in quotient
626 Q.LongWords[0] := Q.LongWords[0] or 1;
627 end;
628 end;
629end;
630
631class operator UInt128.Inc(A: UInt128): UInt128;
632var
633 C: LongWord;
634 D: Integer;
635begin
636 C := A.Words[0];
637 Inc(C);
638 Result.Words[0] := Word(C and $FFFF);
639
640 C := C shr 16;
641 if C = 0 then Exit;
642 Inc(C, A.Words[1]);
643 Result.Words[1] := Word(C and $FFFF);
644
645 for D := 2 to 7 do begin
646 C := C shr 16;
647 if C = 0 then Exit;
648 Inc(C, A.Words[D]);
649 Result.Words[D] := Word(C and $FFFF);
650 end;
651
652 {$IFOPT Q+}
653 C := C shr 16;
654 if C > 0 then RaiseOverflowError;
655 {$ENDIF}
656end;
657
658class operator UInt128.Dec(A: UInt128): UInt128;
659begin
660 Result := A - 1;
661end;
662
663class operator UInt128.Modulus(A, B: UInt128): UInt128;
664var
665 D: UInt128;
666begin
667 IntDivMod(A, B, D, Result);
668end;
669
670class operator UInt128.LeftShift(A, B: UInt128): UInt128;
671var
672 C, D : Byte;
673begin
674 if B = 0 then begin
675 Exit;
676 end else
677 if B = 1 then begin
678 Result.LongWords[3] := (A.LongWords[3] shl 1) or (A.LongWords[2] shr 31);
679 Result.LongWords[2] := (A.LongWords[2] shl 1) or (A.LongWords[1] shr 31);
680 Result.LongWords[1] := (A.LongWords[1] shl 1) or (A.LongWords[0] shr 31);
681 Result.LongWords[0] := (A.LongWords[0] shl 1);
682 end else
683 if B >= 128 then begin
684 A.SetZero;
685 end else
686 if B < 32 then begin // 1 <= B <= 31
687 C := 32 - B;
688 Result.LongWords[3] := (A.LongWords[3] shl B) or (A.LongWords[2] shr C);
689 Result.LongWords[2] := (A.LongWords[2] shl B) or (A.LongWords[1] shr C);
690 Result.LongWords[1] := (A.LongWords[1] shl B) or (A.LongWords[0] shr C);
691 Result.LongWords[0] := (A.LongWords[0] shl B);
692 end else
693 if B < 64 then begin // 32 <= B <= 63
694 D := B - 32;
695 C := 32 - D;
696 Result.LongWords[3] := (A.LongWords[2] shl D) or (A.LongWords[1] shr C);
697 Result.LongWords[2] := (A.LongWords[1] shl D) or (A.LongWords[0] shr C);
698 Result.LongWords[1] := (A.LongWords[0] shl D);
699 Result.LongWords[0] := 0;
700 end else
701 if B < 96 then begin // 64 <= B <= 95
702 D := B - 64;
703 C := 32 - D;
704 Result.LongWords[3] := (A.LongWords[1] shl D) or (A.LongWords[0] shr C);
705 Result.LongWords[2] := (A.LongWords[0] shl D);
706 Result.LongWords[1] := 0;
707 Result.LongWords[0] := 0;
708 end else begin // 96 <= B <= 127
709 D := B - 96;
710 Result.LongWords[3] := (A.LongWords[0] shl D);
711 Result.LongWords[2] := 0;
712 Result.LongWords[1] := 0;
713 Result.LongWords[0] := 0;
714 end;
715end;
716
717class operator UInt128.RightShift(A, B: UInt128): UInt128;
718var
719 C, D : Byte;
720begin
721 if B = 0 then begin
722 Exit;
723 end else
724 if B = 1 then begin
725 Result.LongWords[0] := (A.LongWords[0] shr 1) or (A.LongWords[1] shl 31);
726 Result.LongWords[1] := (A.LongWords[1] shr 1) or (A.LongWords[2] shl 31);
727 Result.LongWords[2] := (A.LongWords[2] shr 1) or (A.LongWords[3] shl 31);
728 Result.LongWords[3] := (A.LongWords[3] shr 1);
729 end else
730 if B >= 128 then begin
731 A.SetZero;
732 end else
733 if B < 32 then begin // 1 <= B <= 31
734 C := 32 - B;
735 Result.LongWords[0] := (A.LongWords[0] shr B) or (A.LongWords[1] shl C);
736 Result.LongWords[1] := (A.LongWords[1] shr B) or (A.LongWords[2] shl C);
737 Result.LongWords[2] := (A.LongWords[2] shr B) or (A.LongWords[3] shl C);
738 Result.LongWords[3] := (A.LongWords[3] shr B);
739 end else
740 if B < 64 then begin // 32 <= B <= 63
741 D := B - 32;
742 C := 32 - D;
743 Result.LongWords[0] := (A.LongWords[1] shr D) or (A.LongWords[2] shl C);
744 Result.LongWords[1] := (A.LongWords[2] shr D) or (A.LongWords[3] shl C);
745 Result.LongWords[2] := (A.LongWords[3] shr D);
746 Result.LongWords[3] := 0;
747 end else
748 if B < 96 then begin // 64 <= B <= 95
749 D := B - 64;
750 C := 32 - D;
751 Result.LongWords[0] := (A.LongWords[2] shr D) or (A.LongWords[3] shl C);
752 Result.LongWords[1] := (A.LongWords[3] shr D);
753 Result.LongWords[2] := 0;
754 Result.LongWords[3] := 0;
755 end else begin // 96 <= B <= 127
756 D := B - 96;
757 Result.LongWords[0] := (A.LongWords[3] shr D);
758 Result.LongWords[1] := 0;
759 Result.LongWords[2] := 0;
760 Result.LongWords[3] := 0;
761 end;
762end;
763
764{ Int128 }
765
766procedure Int128.SetZero;
767begin
768 QWords[0] := 0;
769 QWords[1] := 0;
770end;
771
772procedure Int128.SetOne;
773begin
774 QWords[0] := 1;
775 QWords[1] := 0;
776end;
777
778procedure Int128.SetMinusOne;
779begin
780 LongWords[0] := $ffffffff;
781 LongWords[1] := $ffffffff;
782 LongWords[2] := $ffffffff;
783 LongWords[3] := $ffffffff;
784end;
785
786procedure Int128.SetMinimum;
787begin
788 LongWords[0] := 0;
789 LongWords[1] := 0;
790 LongWords[2] := 0;
791 LongWords[3] := $80000000;
792end;
793
794procedure Int128.SetMaximum;
795begin
796 QWords[0] := 0;
797 QWords[1] := $7fffffffffffffff;
798end;
799
800function Int128.IsNegative: Boolean;
801begin
802 Result := (LongWords[3] and $80000000) <> 0;
803end;
804
805function Int128.IsPositive: Boolean;
806begin
807 Result := (LongWords[3] and $80000000) = 0;
808end;
809
810function Int128.IsZero: Boolean;
811begin
812 Result := Self = Int128.Zero;
813end;
814
815function Int128.IsOne: Boolean;
816begin
817 Result := Self = Int128.One;
818end;
819
820function Int128.IsMinusOne: Boolean;
821begin
822 Result := Self = Int128.MinusOne;
823end;
824
825function Int128.IsMinimum: Boolean;
826begin
827 Result := Self = Minimum;
828end;
829
830function Int128.IsMaximum: Boolean;
831begin
832 Result := Self = Maximum;
833end;
834
835class function Int128.Zero: Int128;
836begin
837 Result.SetZero;
838end;
839
840class function Int128.One: Int128;
841begin
842 Result.SetOne;
843end;
844
845class function Int128.MinusOne: Int128;
846begin
847 Result.SetMinusOne;
848end;
849
850class function Int128.Minimum: Int128;
851begin
852 Result.SetMinimum;
853end;
854
855class function Int128.Maximum: Int128;
856begin
857 Result.SetMaximum;
858end;
859
860function Int128.Abs: Int128;
861begin
862 if Self < 0 then Result := -Self
863 else Result := Self;
864end;
865
866function Int128.Sign: Int8;
867begin
868 if IsZero then Result := 0
869 else if (LongWords[3] and $80000000) = 1 then Result := 1
870 else Result := 1;
871end;
872
873class function Int128.Min(A, B: Int128): Int128;
874begin
875 if A < B then Result := A else Result := B;
876end;
877
878class function Int128.Max(A, B: Int128): Int128;
879begin
880 if A > B then Result := A else Result := B;
881end;
882
883class operator Int128.Implicit(A: ShortInt): Int128;
884begin
885 if A < 0 then begin
886 Result.SetMinusOne;
887 Result.ShortInts[0] := A;
888 end else begin
889 Result.SetZero;
890 Result.ShortInts[0] := A;
891 end;
892end;
893
894class operator Int128.Implicit(A: Byte): Int128;
895begin
896 Result.SetZero;
897 Result.Bytes[0] := A;
898end;
899
900class operator Int128.Implicit(A: Int64): Int128;
901begin
902 Result.Int64s[0] := A;
903 if A < 0 then Result.Int64s[1] := -1
904 else Result.Int64s[1] := 0;
905end;
906
907class operator Int128.Implicit(A: Int128): Byte;
908begin
909 {$IFOPT R+}
910 if not ((A <= High(Byte)) and (A >= Low(Byte))) then
911 RaiseRangeError;
912 {$ENDIF}
913 Result := A.Bytes[0];
914end;
915
916class operator Int128.Implicit(A: Int128): LongWord;
917begin
918 Result := A.LongWords[0];
919end;
920
921class operator Int128.Implicit(A: Int128): UInt128;
922begin
923 {$IFOPT R+}
924 if A.IsNegative then
925 RaiseRangeError;
926 {$ENDIF}
927 Result.QWords[0] := A.QWords[0];
928 Result.QWords[1] := A.QWords[1];
929end;
930
931class operator Int128.Implicit(A: UInt128): Int128;
932begin
933 {$IFOPT R+}
934 if A.LongWords[3] and $80000000 <> 0 then
935 RaiseRangeError;
936 {$ENDIF}
937 Result.LongWords[0] := A.LongWords[0];
938 Result.LongWords[1] := A.LongWords[1];
939 Result.LongWords[2] := A.LongWords[2];
940 Result.LongWords[3] := A.LongWords[3];
941end;
942
943class operator Int128.Implicit(A: Int128): ShortInt;
944begin
945 {$IFOPT R+}
946 if not ((A <= High(ShortInt)) and (A >= Low(ShortInt))) then
947 RaiseRangeError;
948 {$ENDIF}
949 Result := A.ShortInts[0];
950end;
951
952class operator Int128.BitwiseXor(A, B: Int128): Int128;
953begin
954 Result.QWords[0] := A.QWords[0] xor B.QWords[0];
955 Result.QWords[1] := A.QWords[1] xor B.QWords[1];
956end;
957
958class operator Int128.BitwiseAnd(A, B: Int128): Int128;
959begin
960 Result.QWords[0] := A.QWords[0] and B.QWords[0];
961 Result.QWords[1] := A.QWords[1] and B.QWords[1];
962end;
963
964class operator Int128.BitwiseOr(A, B: Int128): Int128;
965begin
966 Result.QWords[0] := A.QWords[0] or B.QWords[0];
967 Result.QWords[1] := A.QWords[1] or B.QWords[1];
968end;
969
970class function Int128.Compare(A, B: Int128): Int8;
971var
972 P, Q : Boolean;
973begin
974 P := A.LongWords[3] and $80000000 <> 0;
975 Q := B.LongWords[3] and $80000000 <> 0;
976 if P <> Q then
977 if P then
978 Result := -1
979 else
980 Result := 1
981 else
982 if A.LongWords[3] < B.LongWords[3] then
983 Result := -1 else
984 if A.LongWords[3] > B.LongWords[3] then
985 Result := 1 else
986 if A.LongWords[2] < B.LongWords[2] then
987 Result := -1 else
988 if A.LongWords[2] > B.LongWords[2] then
989 Result := 1 else
990 if A.LongWords[1] < B.LongWords[1] then
991 Result := -1 else
992 if A.LongWords[1] > B.LongWords[1] then
993 Result := 1 else
994 if A.LongWords[0] < B.LongWords[0] then
995 Result := -1 else
996 if A.LongWords[0] > B.LongWords[0] then
997 Result := 1
998 else
999 Result := 0;
1000end;
1001
1002class procedure Int128.IntDivMod(A, B: Int128; var Q, R: Int128);
1003var
1004 C, T: UInt128;
1005 D, E: UInt128;
1006begin
1007 C := A.Abs;
1008 D := B.Abs;
1009 UInt128.IntDivMod(C, D, T, E);
1010 if not (A.IsNegative xor B.IsNegative) then Q := T
1011 else Q := -Int128(T);
1012 R := E;
1013end;
1014
1015class operator Int128.Inc(A: Int128): Int128;
1016begin
1017 Result := A + 1;
1018end;
1019
1020class operator Int128.Dec(A: Int128): Int128;
1021begin
1022 Result := A - 1;
1023end;
1024
1025class operator Int128.Add(A, B: Int128): Int128;
1026var
1027 {$IFOPT Q+}
1028 D, E : Boolean;
1029 {$ENDIF}
1030begin
1031 {$IFOPT Q+}
1032 D := A.LongWords[3] and $80000000 = 0;
1033 E := B.LongWords[3] and $80000000 = 0;
1034 {$ENDIF}
1035
1036 Result.QWords[0] := A.QWords[0] + B.QWords[0];
1037 Result.QWords[1] := A.QWords[1] + B.QWords[1];
1038 if ((A.QWords[0] shr 63) = 1) and ((B.QWords[0] shr 63) = 1) then
1039 Result.QWords[1] := Result.QWords[1] + 1;
1040
1041 {$IFOPT Q+}
1042 // Check overflow
1043 if A.LongWords[3] and $80000000 <> 0 then
1044 begin
1045 if D and not E then
1046 RaiseOverflowError;
1047 end
1048 else
1049 if not D and E then
1050 RaiseOverflowError;
1051 {$ENDIF}
1052end;
1053
1054class operator Int128.Subtract(A, B: Int128): Int128;
1055var
1056 {$IFOPT Q+}
1057 D, E : Boolean;
1058 {$ENDIF}
1059begin
1060 {$IFOPT Q+}
1061 D := A.LongWords[3] and $80000000 = 0;
1062 E := B.LongWords[3] and $80000000 = 0;
1063 {$ENDIF}
1064
1065 Result.QWords[0] := A.QWords[0] - B.QWords[0];
1066 Result.QWords[1] := A.QWords[1] - B.QWords[1];
1067 if ((A.QWords[0] shr 63) = 1) and ((B.QWords[0] shr 63) = 1) then
1068 Result.QWords[1] := Result.QWords[1] - 1;
1069
1070 {$IFOPT Q+}
1071 // Check overflow
1072 if A.LongWords[3] and $80000000 <> 0 then
1073 begin
1074 if D and not E then
1075 RaiseOverflowError;
1076 end
1077 else
1078 if not D and E then
1079 RaiseOverflowError;
1080 {$ENDIF}
1081end;
1082
1083class operator Int128.Equal(A, B: Int128): Boolean;
1084begin
1085 Result := (A.QWords[0] = B.QWords[0]) and (A.QWords[1] = B.QWords[1]);
1086end;
1087
1088class operator Int128.LessThan(A, B: Int128): Boolean;
1089var
1090 G: Int8;
1091begin
1092 G := Compare(A, B);
1093 Result := G = -1;
1094end;
1095
1096class operator Int128.LessThanOrEqual(A, B: Int128): Boolean;
1097begin
1098 Result := not (A > B);
1099end;
1100
1101class operator Int128.GreaterThan(A, B: Int128): Boolean;
1102begin
1103 Result := Compare(A, B) = 1;
1104end;
1105
1106class operator Int128.GreaterThanOrEqual(A, B: Int128): Boolean;
1107begin
1108 Result := not (A < B);
1109end;
1110
1111class operator Int128.Negative(A: Int128): Int128;
1112begin
1113 Result := (A xor Int128.MinusOne) + 1;
1114end;
1115
1116class operator Int128.Multiply(A, B: Int128): Int128;
1117begin
1118 Result := 0;
1119 while B.Abs > 0 do begin
1120 Result := Result + A;
1121 B := B - 1;
1122 end;
1123 if B.Sign = -1 then Result := -Result;
1124end;
1125
1126class operator Int128.IntDivide(A, B: Int128): Int128;
1127var
1128 M: Int128;
1129begin
1130 IntDivMod(A, B, Result, M);
1131end;
1132
1133class operator Int128.Modulus(A, B: Int128): Int128;
1134var
1135 D: Int128;
1136begin
1137 IntDivMod(A, B, D, Result);
1138end;
1139
1140class operator Int128.LeftShift(A, B: Int128): Int128;
1141var
1142 C, D: Byte;
1143begin
1144 if B = 0 then begin
1145 Result := A;
1146 end else
1147 if B = 1 then begin
1148 Result.LongWords[3] := (A.LongWords[3] shl 1) or (A.LongWords[2] shr 31);
1149 Result.LongWords[2] := (A.LongWords[2] shl 1) or (A.LongWords[1] shr 31);
1150 Result.LongWords[1] := (A.LongWords[1] shl 1) or (A.LongWords[0] shr 31);
1151 Result.LongWords[0] := (A.LongWords[0] shl 1);
1152 end else
1153 if B >= 128 then begin
1154 Result.SetZero;
1155 end else
1156 if B < 32 then begin // 1 <= B <= 31
1157 C := 32 - B;
1158 Result.LongWords[3] := (A.LongWords[3] shl B) or (A.LongWords[2] shr C);
1159 Result.LongWords[2] := (A.LongWords[2] shl B) or (A.LongWords[1] shr C);
1160 Result.LongWords[1] := (A.LongWords[1] shl B) or (A.LongWords[0] shr C);
1161 Result.LongWords[0] := (A.LongWords[0] shl B);
1162 end else
1163 if B < 64 then begin // 32 <= B <= 63
1164 D := B - 32;
1165 C := 32 - D;
1166 Result.LongWords[3] := (A.LongWords[2] shl D) or (A.LongWords[1] shr C);
1167 Result.LongWords[2] := (A.LongWords[1] shl D) or (A.LongWords[0] shr C);
1168 Result.LongWords[1] := (A.LongWords[0] shl D);
1169 Result.LongWords[0] := 0;
1170 end else
1171 if B < 96 then begin // 64 <= B <= 95
1172 D := B - 64;
1173 C := 32 - D;
1174 Result.LongWords[3] := (A.LongWords[1] shl D) or (A.LongWords[0] shr C);
1175 Result.LongWords[2] := (A.LongWords[0] shl D);
1176 Result.LongWords[1] := 0;
1177 Result.LongWords[0] := 0;
1178 end else begin // 96 <= B <= 127
1179 D := B - 96;
1180 Result.LongWords[3] := (A.LongWords[0] shl D);
1181 Result.LongWords[2] := 0;
1182 Result.LongWords[1] := 0;
1183 Result.LongWords[0] := 0;
1184 end;
1185end;
1186
1187class operator Int128.RightShift(A, B: Int128): Int128;
1188var
1189 C, D: Byte;
1190begin
1191 if B = 0 then begin
1192 Result := A;
1193 end else
1194 if B = 1 then begin
1195 Result.LongWords[0] := (A.LongWords[0] shr 1) or (A.LongWords[1] shl 31);
1196 Result.LongWords[1] := (A.LongWords[1] shr 1) or (A.LongWords[2] shl 31);
1197 Result.LongWords[2] := (A.LongWords[2] shr 1) or (A.LongWords[3] shl 31);
1198 Result.LongWords[3] := (A.LongWords[3] shr 1);
1199 end else
1200 if B >= 128 then begin
1201 Result.SetZero;
1202 end else
1203 if B < 32 then begin // 1 <= B <= 31
1204 C := 32 - B;
1205 Result.LongWords[0] := (A.LongWords[0] shr Byte(B)) or (A.LongWords[1] shl C);
1206 Result.LongWords[1] := (A.LongWords[1] shr Byte(B)) or (A.LongWords[2] shl C);
1207 Result.LongWords[2] := (A.LongWords[2] shr Byte(B)) or (A.LongWords[3] shl C);
1208 Result.LongWords[3] := (A.LongWords[3] shr Byte(B));
1209 end else
1210 if B < 64 then begin // 32 <= B <= 63
1211 D := B - 32;
1212 C := 32 - D;
1213 Result.LongWords[0] := (A.LongWords[1] shr Byte(D)) or (A.LongWords[2] shl C);
1214 Result.LongWords[1] := (A.LongWords[2] shr Byte(D)) or (A.LongWords[3] shl C);
1215 Result.LongWords[2] := (A.LongWords[3] shr Byte(D));
1216 Result.LongWords[3] := 0;
1217 end else
1218 if B < 96 then begin // 64 <= B <= 95
1219 D := B - 64;
1220 C := 32 - D;
1221 Result.LongWords[0] := (A.LongWords[2] shr Byte(D)) or (A.LongWords[3] shl C);
1222 Result.LongWords[1] := (A.LongWords[3] shr Byte(D));
1223 Result.LongWords[2] := 0;
1224 Result.LongWords[3] := 0;
1225 end else begin // 96 <= B <= 127
1226 D := B - 96;
1227 Result.LongWords[0] := (A.LongWords[3] shr Byte(D));
1228 Result.LongWords[1] := 0;
1229 Result.LongWords[2] := 0;
1230 Result.LongWords[3] := 0;
1231 end;
1232end;
1233
1234end.
1235
Note: See TracBrowser for help on using the repository browser.