Context Navigation

← Previous Revision
Next Revision →
Blame
Revision Log

UInt128.pas

Visit:

Last change on this file was 161, checked in by chronos, 7 years ago
Modified: Further Int128 unit implementation.
File size: 30.4 KB

Line
1	unit UInt128;
2
3	{$mode delphi}{$H+}
4
5	interface
6
7	uses
8	Classes, SysUtils;
9
10	type
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
125	function IntToStr(Value: Int128): string; overload;
126	function IntToStr(Value: UInt128): string; overload;
127	function IntToHex(Value: Int128; Digits: integer): string; overload;
128	function IntToHex(Value: UInt128; Digits: integer): string; overload;
129
130
131	implementation
132
133
134	const
135	HexDigits: array[0..15] of Char = '0123456789ABCDEF';
136
137	// Raise errors using Error function in System.pas
138	{$IFOPT Q+}
139	procedure RaiseOverflowError;
140	begin
141	Error(reIntOverflow);
142	end;
143	{$ENDIF}
144
145	{$IFOPT R+}
146	procedure RaiseRangeError;
147	begin
148	Error(reRangeError);
149	end;
150	{$ENDIF}
151	procedure RaiseDivByZeroError;
152	begin
153	Error(reDivByZero);
154	end;
155
156	function IntToHex(Value: Int128; Digits: integer): string;
157	var
158	I: Integer;
159	begin
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;
172	end;
173
174	function IntToHex(Value: UInt128; Digits: integer): string;
175	var
176	I: Integer;
177	begin
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;
190	end;
191
192	function IntToStr(Value: Int128): string;
193	begin
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;
209	end;
210
211	function IntToStr(Value: UInt128): string;
212	begin
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;
219	end;
220
221	{ UInt128 }
222
223	procedure UInt128.SetZero;
224	begin
225	QWords[0] := 0;
226	QWords[1] := 0;
227	end;
228
229	procedure UInt128.SetOne;
230	begin
231	QWords[0] := 1;
232	QWords[1] := 0;
233	end;
234
235	procedure UInt128.SetMinimum;
236	begin
237	SetZero;
238	end;
239
240	procedure UInt128.SetMaximum;
241	begin
242	LongWords[0] := $ffffffff;
243	LongWords[1] := $ffffffff;
244	LongWords[2] := $ffffffff;
245	LongWords[3] := $ffffffff;
246	end;
247
248	function UInt128.IsZero: Boolean;
249	begin
250	Result := Self = UInt128.Zero;
251	end;
252
253	function UInt128.IsOne: Boolean;
254	begin
255	Result := Self = UInt128.One;
256	end;
257
258	function UInt128.IsMinimum: Boolean;
259	begin
260	Result := Self = UInt128.Minimum;
261	end;
262
263	function UInt128.IsMaximum: Boolean;
264	begin
265	Result := Self = UInt128.Maximum;
266	end;
267
268	class function UInt128.Min(A, B: UInt128): UInt128;
269	begin
270	if A < B then Result := A else Result := B;
271	end;
272
273	class function UInt128.Max(A, B: UInt128): UInt128;
274	begin
275	if A > B then Result := A else Result := B;
276	end;
277
278	class function UInt128.Zero: UInt128;
279	begin
280	Result.SetZero;
281	end;
282
283	class function UInt128.One: UInt128;
284	begin
285	Result.SetOne;
286	end;
287
288	class function UInt128.Minimum: UInt128;
289	begin
290	Result.SetMinimum;
291	end;
292
293	class function UInt128.Maximum: UInt128;
294	begin
295	Result.SetMaximum;
296	end;
297
298	class function UInt128.Compare(A, B: UInt128): Int8;
299	var
300	C, D: LongWord;
301	begin
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;
325	end;
326
327	class operator UInt128.Implicit(A: ShortInt): UInt128;
328	begin
329	{$IFOPT R+}
330	if A < 0 then
331	RaiseRangeError;
332	{$ENDIF}
333	Result.SetZero;
334	Result.Bytes[0] := A;
335	end;
336
337	class operator UInt128.Implicit(A: Byte): UInt128;
338	begin
339	Result.SetZero;
340	Result.Bytes[0] := A;
341	end;
342
343	class operator UInt128.Implicit(A: UInt128): Byte;
344	begin
345	Result := A.Bytes[0];
346	end;
347
348	class operator UInt128.Implicit(A: UInt128): LongWord;
349	begin
350	Result := A.LongWords[0];
351	end;
352
353	class operator UInt128.Implicit(A: UInt128): ShortInt;
354	begin
355	{$IFOPT R+}
356	if not (A <= High(ShortInt)) then
357	RaiseRangeError;
358	{$ENDIF}
359	Result := A.Bytes[0];
360	end;
361
362	class operator UInt128.BitwiseXor(A, B: UInt128): UInt128;
363	begin
364	Result.LongWords[0] := A.LongWords[0] xor B.LongWords[0];
365	Result.LongWords[1] := A.LongWords[1] xor B.LongWords[1];
366	end;
367
368	class operator UInt128.BitwiseAnd(A, B: UInt128): UInt128;
369	begin
370	Result.LongWords[0] := A.LongWords[0] and B.LongWords[0];
371	Result.LongWords[1] := A.LongWords[1] and B.LongWords[1];
372	end;
373
374	class operator UInt128.BitwiseOr(A, B: UInt128): UInt128;
375	begin
376	Result.LongWords[0] := A.LongWords[0] or B.LongWords[0];
377	Result.LongWords[1] := A.LongWords[1] or B.LongWords[1];
378	end;
379
380	class operator UInt128.Add(A, B: UInt128): UInt128;
381	var
382	C: LongWord;
383	D: Integer;
384	begin
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}
399	end;
400
401	class operator UInt128.Subtract(A, B: UInt128): UInt128;
402	var
403	C, D: Integer;
404	begin
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}
420	end;
421
422	class operator UInt128.Equal(A, B: UInt128): Boolean;
423	begin
424	Result := (A.LongWords[0] = B.LongWords[0]) and
425	(A.LongWords[1] = B.LongWords[1]);
426	end;
427
428	class operator UInt128.LessThan(A, B: UInt128): Boolean;
429	var
430	G: Int8;
431	begin
432	G := Compare(A, B);
433	Result := G = -1;
434	end;
435
436	class operator UInt128.LessThanOrEqual(A, B: UInt128): Boolean;
437	begin
438	Result := not (A > B);
439	end;
440
441	class operator UInt128.GreaterThan(A, B: UInt128): Boolean;
442	begin
443	Result := Compare(A, B) = 1;
444	end;
445
446	class operator UInt128.GreaterThanOrEqual(A, B: UInt128): Boolean;
447	begin
448	Result := not (A < B);
449	end;
450
451	class operator UInt128.Multiply(A, B: UInt128): UInt128;
452	var
453	C : Int64;
454	begin
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}
571	end;
572
573	class operator UInt128.IntDivide(A, B: UInt128): UInt128;
574	var
575	M: UInt128;
576	begin
577	IntDivMod(A, B, Result, M);
578	end;
579
580	class procedure UInt128.IntDivMod(A, B: UInt128; var Q, R: UInt128);
581	var
582	C: Integer;
583	D: UInt128;
584	begin
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;
629	end;
630
631	class operator UInt128.Inc(A: UInt128): UInt128;
632	var
633	C: LongWord;
634	D: Integer;
635	begin
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}
656	end;
657
658	class operator UInt128.Dec(A: UInt128): UInt128;
659	begin
660	Result := A - 1;
661	end;
662
663	class operator UInt128.Modulus(A, B: UInt128): UInt128;
664	var
665	D: UInt128;
666	begin
667	IntDivMod(A, B, D, Result);
668	end;
669
670	class operator UInt128.LeftShift(A, B: UInt128): UInt128;
671	var
672	C, D : Byte;
673	begin
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;
715	end;
716
717	class operator UInt128.RightShift(A, B: UInt128): UInt128;
718	var
719	C, D : Byte;
720	begin
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;
762	end;
763
764	{ Int128 }
765
766	procedure Int128.SetZero;
767	begin
768	QWords[0] := 0;
769	QWords[1] := 0;
770	end;
771
772	procedure Int128.SetOne;
773	begin
774	QWords[0] := 1;
775	QWords[1] := 0;
776	end;
777
778	procedure Int128.SetMinusOne;
779	begin
780	LongWords[0] := $ffffffff;
781	LongWords[1] := $ffffffff;
782	LongWords[2] := $ffffffff;
783	LongWords[3] := $ffffffff;
784	end;
785
786	procedure Int128.SetMinimum;
787	begin
788	LongWords[0] := 0;
789	LongWords[1] := 0;
790	LongWords[2] := 0;
791	LongWords[3] := $80000000;
792	end;
793
794	procedure Int128.SetMaximum;
795	begin
796	QWords[0] := 0;
797	QWords[1] := $7fffffffffffffff;
798	end;
799
800	function Int128.IsNegative: Boolean;
801	begin
802	Result := (LongWords[3] and $80000000) <> 0;
803	end;
804
805	function Int128.IsPositive: Boolean;
806	begin
807	Result := (LongWords[3] and $80000000) = 0;
808	end;
809
810	function Int128.IsZero: Boolean;
811	begin
812	Result := Self = Int128.Zero;
813	end;
814
815	function Int128.IsOne: Boolean;
816	begin
817	Result := Self = Int128.One;
818	end;
819
820	function Int128.IsMinusOne: Boolean;
821	begin
822	Result := Self = Int128.MinusOne;
823	end;
824
825	function Int128.IsMinimum: Boolean;
826	begin
827	Result := Self = Minimum;
828	end;
829
830	function Int128.IsMaximum: Boolean;
831	begin
832	Result := Self = Maximum;
833	end;
834
835	class function Int128.Zero: Int128;
836	begin
837	Result.SetZero;
838	end;
839
840	class function Int128.One: Int128;
841	begin
842	Result.SetOne;
843	end;
844
845	class function Int128.MinusOne: Int128;
846	begin
847	Result.SetMinusOne;
848	end;
849
850	class function Int128.Minimum: Int128;
851	begin
852	Result.SetMinimum;
853	end;
854
855	class function Int128.Maximum: Int128;
856	begin
857	Result.SetMaximum;
858	end;
859
860	function Int128.Abs: Int128;
861	begin
862	if Self < 0 then Result := -Self
863	else Result := Self;
864	end;
865
866	function Int128.Sign: Int8;
867	begin
868	if IsZero then Result := 0
869	else if (LongWords[3] and $80000000) = 1 then Result := 1
870	else Result := 1;
871	end;
872
873	class function Int128.Min(A, B: Int128): Int128;
874	begin
875	if A < B then Result := A else Result := B;
876	end;
877
878	class function Int128.Max(A, B: Int128): Int128;
879	begin
880	if A > B then Result := A else Result := B;
881	end;
882
883	class operator Int128.Implicit(A: ShortInt): Int128;
884	begin
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;
892	end;
893
894	class operator Int128.Implicit(A: Byte): Int128;
895	begin
896	Result.SetZero;
897	Result.Bytes[0] := A;
898	end;
899
900	class operator Int128.Implicit(A: Int64): Int128;
901	begin
902	Result.Int64s[0] := A;
903	if A < 0 then Result.Int64s[1] := -1
904	else Result.Int64s[1] := 0;
905	end;
906
907	class operator Int128.Implicit(A: Int128): Byte;
908	begin
909	{$IFOPT R+}
910	if not ((A <= High(Byte)) and (A >= Low(Byte))) then
911	RaiseRangeError;
912	{$ENDIF}
913	Result := A.Bytes[0];
914	end;
915
916	class operator Int128.Implicit(A: Int128): LongWord;
917	begin
918	Result := A.LongWords[0];
919	end;
920
921	class operator Int128.Implicit(A: Int128): UInt128;
922	begin
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];
929	end;
930
931	class operator Int128.Implicit(A: UInt128): Int128;
932	begin
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];
941	end;
942
943	class operator Int128.Implicit(A: Int128): ShortInt;
944	begin
945	{$IFOPT R+}
946	if not ((A <= High(ShortInt)) and (A >= Low(ShortInt))) then
947	RaiseRangeError;
948	{$ENDIF}
949	Result := A.ShortInts[0];
950	end;
951
952	class operator Int128.BitwiseXor(A, B: Int128): Int128;
953	begin
954	Result.QWords[0] := A.QWords[0] xor B.QWords[0];
955	Result.QWords[1] := A.QWords[1] xor B.QWords[1];
956	end;
957
958	class operator Int128.BitwiseAnd(A, B: Int128): Int128;
959	begin
960	Result.QWords[0] := A.QWords[0] and B.QWords[0];
961	Result.QWords[1] := A.QWords[1] and B.QWords[1];
962	end;
963
964	class operator Int128.BitwiseOr(A, B: Int128): Int128;
965	begin
966	Result.QWords[0] := A.QWords[0] or B.QWords[0];
967	Result.QWords[1] := A.QWords[1] or B.QWords[1];
968	end;
969
970	class function Int128.Compare(A, B: Int128): Int8;
971	var
972	P, Q : Boolean;
973	begin
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;
1000	end;
1001
1002	class procedure Int128.IntDivMod(A, B: Int128; var Q, R: Int128);
1003	var
1004	C, T: UInt128;
1005	D, E: UInt128;
1006	begin
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;
1013	end;
1014
1015	class operator Int128.Inc(A: Int128): Int128;
1016	begin
1017	Result := A + 1;
1018	end;
1019
1020	class operator Int128.Dec(A: Int128): Int128;
1021	begin
1022	Result := A - 1;
1023	end;
1024
1025	class operator Int128.Add(A, B: Int128): Int128;
1026	var
1027	{$IFOPT Q+}
1028	D, E : Boolean;
1029	{$ENDIF}
1030	begin
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}
1052	end;
1053
1054	class operator Int128.Subtract(A, B: Int128): Int128;
1055	var
1056	{$IFOPT Q+}
1057	D, E : Boolean;
1058	{$ENDIF}
1059	begin
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}
1081	end;
1082
1083	class operator Int128.Equal(A, B: Int128): Boolean;
1084	begin
1085	Result := (A.QWords[0] = B.QWords[0]) and (A.QWords[1] = B.QWords[1]);
1086	end;
1087
1088	class operator Int128.LessThan(A, B: Int128): Boolean;
1089	var
1090	G: Int8;
1091	begin
1092	G := Compare(A, B);
1093	Result := G = -1;
1094	end;
1095
1096	class operator Int128.LessThanOrEqual(A, B: Int128): Boolean;
1097	begin
1098	Result := not (A > B);
1099	end;
1100
1101	class operator Int128.GreaterThan(A, B: Int128): Boolean;
1102	begin
1103	Result := Compare(A, B) = 1;
1104	end;
1105
1106	class operator Int128.GreaterThanOrEqual(A, B: Int128): Boolean;
1107	begin
1108	Result := not (A < B);
1109	end;
1110
1111	class operator Int128.Negative(A: Int128): Int128;
1112	begin
1113	Result := (A xor Int128.MinusOne) + 1;
1114	end;
1115
1116	class operator Int128.Multiply(A, B: Int128): Int128;
1117	begin
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;
1124	end;
1125
1126	class operator Int128.IntDivide(A, B: Int128): Int128;
1127	var
1128	M: Int128;
1129	begin
1130	IntDivMod(A, B, Result, M);
1131	end;
1132
1133	class operator Int128.Modulus(A, B: Int128): Int128;
1134	var
1135	D: Int128;
1136	begin
1137	IntDivMod(A, B, D, Result);
1138	end;
1139
1140	class operator Int128.LeftShift(A, B: Int128): Int128;
1141	var
1142	C, D: Byte;
1143	begin
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;
1185	end;
1186
1187	class operator Int128.RightShift(A, B: Int128): Int128;
1188	var
1189	C, D: Byte;
1190	begin
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;
1232	end;
1233
1234	end.
1235

Note: See TracBrowser for help on using the repository browser.

Context Navigation

source: branches/virtualcpu3/UInt128.pas

Download in other formats: