]> git.ipfire.org Git - thirdparty/gcc.git/blame - gcc/ada/uintp.adb
Licensing changes to GPLv3 resp. GPLv3 with GCC Runtime Exception.
[thirdparty/gcc.git] / gcc / ada / uintp.adb
CommitLineData
415dddc8
RK
1------------------------------------------------------------------------------
2-- --
3-- GNAT COMPILER COMPONENTS --
4-- --
5-- U I N T P --
6-- --
7-- B o d y --
8-- --
748086b7 9-- Copyright (C) 1992-2009 Free Software Foundation, Inc. --
415dddc8
RK
10-- --
11-- GNAT is free software; you can redistribute it and/or modify it under --
12-- terms of the GNU General Public License as published by the Free Soft- --
748086b7 13-- ware Foundation; either version 3, or (at your option) any later ver- --
415dddc8
RK
14-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
748086b7
JJ
16-- or FITNESS FOR A PARTICULAR PURPOSE. --
17-- --
18-- As a special exception under Section 7 of GPL version 3, you are granted --
19-- additional permissions described in the GCC Runtime Library Exception, --
20-- version 3.1, as published by the Free Software Foundation. --
21-- --
22-- You should have received a copy of the GNU General Public License and --
23-- a copy of the GCC Runtime Library Exception along with this program; --
24-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
25-- <http://www.gnu.org/licenses/>. --
415dddc8
RK
26-- --
27-- GNAT was originally developed by the GNAT team at New York University. --
71ff80dc 28-- Extensive contributions were provided by Ada Core Technologies Inc. --
415dddc8
RK
29-- --
30------------------------------------------------------------------------------
31
32with Output; use Output;
33with Tree_IO; use Tree_IO;
34
fbf5a39b
AC
35with GNAT.HTable; use GNAT.HTable;
36
415dddc8
RK
37package body Uintp is
38
39 ------------------------
40 -- Local Declarations --
41 ------------------------
42
43 Uint_Int_First : Uint := Uint_0;
44 -- Uint value containing Int'First value, set by Initialize. The initial
45 -- value of Uint_0 is used for an assertion check that ensures that this
46 -- value is not used before it is initialized. This value is used in the
835d23b2
RD
47 -- UI_Is_In_Int_Range predicate, and it is right that this is a host value,
48 -- since the issue is host representation of integer values.
415dddc8
RK
49
50 Uint_Int_Last : Uint;
9de61fcb 51 -- Uint value containing Int'Last value set by Initialize
415dddc8
RK
52
53 UI_Power_2 : array (Int range 0 .. 64) of Uint;
54 -- This table is used to memoize exponentiations by powers of 2. The Nth
55 -- entry, if set, contains the Uint value 2 ** N. Initially UI_Power_2_Set
56 -- is zero and only the 0'th entry is set, the invariant being that all
57 -- entries in the range 0 .. UI_Power_2_Set are initialized.
58
59 UI_Power_2_Set : Nat;
60 -- Number of entries set in UI_Power_2;
61
62 UI_Power_10 : array (Int range 0 .. 64) of Uint;
63 -- This table is used to memoize exponentiations by powers of 10 in the
64 -- same manner as described above for UI_Power_2.
65
66 UI_Power_10_Set : Nat;
67 -- Number of entries set in UI_Power_10;
68
69 Uints_Min : Uint;
70 Udigits_Min : Int;
835d23b2
RD
71 -- These values are used to make sure that the mark/release mechanism does
72 -- not destroy values saved in the U_Power tables or in the hash table used
3354f96d 73 -- by UI_From_Int. Whenever an entry is made in either of these tables,
835d23b2
RD
74 -- Uints_Min and Udigits_Min are updated to protect the entry, and Release
75 -- never cuts back beyond these minimum values.
415dddc8
RK
76
77 Int_0 : constant Int := 0;
78 Int_1 : constant Int := 1;
79 Int_2 : constant Int := 2;
80 -- These values are used in some cases where the use of numeric literals
81 -- would cause ambiguities (integer vs Uint).
82
fbf5a39b
AC
83 ----------------------------
84 -- UI_From_Int Hash Table --
85 ----------------------------
86
835d23b2
RD
87 -- UI_From_Int uses a hash table to avoid duplicating entries and wasting
88 -- storage. This is particularly important for complex cases of back
89 -- annotation.
fbf5a39b
AC
90
91 subtype Hnum is Nat range 0 .. 1022;
92
93 function Hash_Num (F : Int) return Hnum;
94 -- Hashing function
95
96 package UI_Ints is new Simple_HTable (
97 Header_Num => Hnum,
98 Element => Uint,
99 No_Element => No_Uint,
100 Key => Int,
101 Hash => Hash_Num,
102 Equal => "=");
103
415dddc8
RK
104 -----------------------
105 -- Local Subprograms --
106 -----------------------
107
108 function Direct (U : Uint) return Boolean;
109 pragma Inline (Direct);
110 -- Returns True if U is represented directly
111
112 function Direct_Val (U : Uint) return Int;
835d23b2
RD
113 -- U is a Uint for is represented directly. The returned result is the
114 -- value represented.
415dddc8
RK
115
116 function GCD (Jin, Kin : Int) return Int;
117 -- Compute GCD of two integers. Assumes that Jin >= Kin >= 0
118
119 procedure Image_Out
120 (Input : Uint;
121 To_Buffer : Boolean;
122 Format : UI_Format);
835d23b2
RD
123 -- Common processing for UI_Image and UI_Write, To_Buffer is set True for
124 -- UI_Image, and false for UI_Write, and Format is copied from the Format
125 -- parameter to UI_Image or UI_Write.
415dddc8
RK
126
127 procedure Init_Operand (UI : Uint; Vec : out UI_Vector);
128 pragma Inline (Init_Operand);
129 -- This procedure puts the value of UI into the vector in canonical
835d23b2
RD
130 -- multiple precision format. The parameter should be of the correct size
131 -- as determined by a previous call to N_Digits (UI). The first digit of
a2dc5812 132 -- Vec contains the sign, all other digits are always non-negative. Note
835d23b2
RD
133 -- that the input may be directly represented, and in this case Vec will
134 -- contain the corresponding one or two digit value. The low bound of Vec
135 -- is always 1.
415dddc8
RK
136
137 function Least_Sig_Digit (Arg : Uint) return Int;
138 pragma Inline (Least_Sig_Digit);
835d23b2
RD
139 -- Returns the Least Significant Digit of Arg quickly. When the given Uint
140 -- is less than 2**15, the value returned is the input value, in this case
141 -- the result may be negative. It is expected that any use will mask off
142 -- unnecessary bits. This is used for finding Arg mod B where B is a power
3354f96d 143 -- of two. Hence the actual base is irrelevant as long as it is a power of
835d23b2 144 -- two.
415dddc8
RK
145
146 procedure Most_Sig_2_Digits
147 (Left : Uint;
148 Right : Uint;
149 Left_Hat : out Int;
150 Right_Hat : out Int);
151 -- Returns leading two significant digits from the given pair of Uint's.
835d23b2
RD
152 -- Mathematically: returns Left / (Base ** K) and Right / (Base ** K) where
153 -- K is as small as possible S.T. Right_Hat < Base * Base. It is required
154 -- that Left > Right for the algorithm to work.
415dddc8
RK
155
156 function N_Digits (Input : Uint) return Int;
157 pragma Inline (N_Digits);
158 -- Returns number of "digits" in a Uint
159
160 function Sum_Digits (Left : Uint; Sign : Int) return Int;
835d23b2
RD
161 -- If Sign = 1 return the sum of the "digits" of Abs (Left). If the total
162 -- has more then one digit then return Sum_Digits of total.
415dddc8
RK
163
164 function Sum_Double_Digits (Left : Uint; Sign : Int) return Int;
165 -- Same as above but work in New_Base = Base * Base
166
2e45500e
TQ
167 procedure UI_Div_Rem
168 (Left, Right : Uint;
169 Quotient : out Uint;
170 Remainder : out Uint;
171 Discard_Quotient : Boolean;
172 Discard_Remainder : Boolean);
3354f96d 173 -- Compute Euclidean division of Left by Right, and return Quotient and
2e45500e 174 -- signed Remainder (Left rem Right).
835d23b2
RD
175 --
176 -- If Discard_Quotient is True, Quotient is left unchanged.
177 -- If Discard_Remainder is True, Remainder is left unchanged.
2e45500e 178
415dddc8
RK
179 function Vector_To_Uint
180 (In_Vec : UI_Vector;
2e45500e 181 Negative : Boolean) return Uint;
835d23b2
RD
182 -- Functions that calculate values in UI_Vectors, call this function to
183 -- create and return the Uint value. In_Vec contains the multiple precision
184 -- (Base) representation of a non-negative value. Leading zeroes are
185 -- permitted. Negative is set if the desired result is the negative of the
186 -- given value. The result will be either the appropriate directly
187 -- represented value, or a table entry in the proper canonical format is
188 -- created and returned.
415dddc8 189 --
835d23b2
RD
190 -- Note that Init_Operand puts a signed value in the result vector, but
191 -- Vector_To_Uint is always presented with a non-negative value. The
192 -- processing of signs is something that is done by the caller before
193 -- calling Vector_To_Uint.
415dddc8
RK
194
195 ------------
196 -- Direct --
197 ------------
198
199 function Direct (U : Uint) return Boolean is
200 begin
201 return Int (U) <= Int (Uint_Direct_Last);
202 end Direct;
203
204 ----------------
205 -- Direct_Val --
206 ----------------
207
208 function Direct_Val (U : Uint) return Int is
209 begin
210 pragma Assert (Direct (U));
211 return Int (U) - Int (Uint_Direct_Bias);
212 end Direct_Val;
213
214 ---------
215 -- GCD --
216 ---------
217
218 function GCD (Jin, Kin : Int) return Int is
219 J, K, Tmp : Int;
220
221 begin
222 pragma Assert (Jin >= Kin);
223 pragma Assert (Kin >= Int_0);
224
225 J := Jin;
226 K := Kin;
415dddc8
RK
227 while K /= Uint_0 loop
228 Tmp := J mod K;
229 J := K;
230 K := Tmp;
231 end loop;
232
233 return J;
234 end GCD;
235
fbf5a39b
AC
236 --------------
237 -- Hash_Num --
238 --------------
239
240 function Hash_Num (F : Int) return Hnum is
241 begin
242 return Standard."mod" (F, Hnum'Range_Length);
243 end Hash_Num;
244
415dddc8
RK
245 ---------------
246 -- Image_Out --
247 ---------------
248
249 procedure Image_Out
250 (Input : Uint;
251 To_Buffer : Boolean;
252 Format : UI_Format)
253 is
254 Marks : constant Uintp.Save_Mark := Uintp.Mark;
255 Base : Uint;
256 Ainput : Uint;
257
258 Digs_Output : Natural := 0;
259 -- Counts digits output. In hex mode, but not in decimal mode, we
260 -- put an underline after every four hex digits that are output.
261
262 Exponent : Natural := 0;
263 -- If the number is too long to fit in the buffer, we switch to an
264 -- approximate output format with an exponent. This variable records
265 -- the exponent value.
266
267 function Better_In_Hex return Boolean;
268 -- Determines if it is better to generate digits in base 16 (result
269 -- is true) or base 10 (result is false). The choice is purely a
270 -- matter of convenience and aesthetics, so it does not matter which
271 -- value is returned from a correctness point of view.
272
273 procedure Image_Char (C : Character);
274 -- Internal procedure to output one character
275
276 procedure Image_Exponent (N : Natural);
835d23b2
RD
277 -- Output non-zero exponent. Note that we only use the exponent form in
278 -- the buffer case, so we know that To_Buffer is true.
415dddc8
RK
279
280 procedure Image_Uint (U : Uint);
281 -- Internal procedure to output characters of non-negative Uint
282
283 -------------------
284 -- Better_In_Hex --
285 -------------------
286
287 function Better_In_Hex return Boolean is
288 T16 : constant Uint := Uint_2 ** Int'(16);
289 A : Uint;
290
291 begin
292 A := UI_Abs (Input);
293
294 -- Small values up to 2**16 can always be in decimal
295
296 if A < T16 then
297 return False;
298 end if;
299
300 -- Otherwise, see if we are a power of 2 or one less than a power
301 -- of 2. For the moment these are the only cases printed in hex.
302
303 if A mod Uint_2 = Uint_1 then
304 A := A + Uint_1;
305 end if;
306
307 loop
308 if A mod T16 /= Uint_0 then
309 return False;
310
311 else
312 A := A / T16;
313 end if;
314
315 exit when A < T16;
316 end loop;
317
318 while A > Uint_2 loop
319 if A mod Uint_2 /= Uint_0 then
320 return False;
321
322 else
323 A := A / Uint_2;
324 end if;
325 end loop;
326
327 return True;
328 end Better_In_Hex;
329
330 ----------------
331 -- Image_Char --
332 ----------------
333
334 procedure Image_Char (C : Character) is
335 begin
336 if To_Buffer then
337 if UI_Image_Length + 6 > UI_Image_Max then
338 Exponent := Exponent + 1;
339 else
340 UI_Image_Length := UI_Image_Length + 1;
341 UI_Image_Buffer (UI_Image_Length) := C;
342 end if;
343 else
344 Write_Char (C);
345 end if;
346 end Image_Char;
347
348 --------------------
349 -- Image_Exponent --
350 --------------------
351
352 procedure Image_Exponent (N : Natural) is
353 begin
354 if N >= 10 then
355 Image_Exponent (N / 10);
356 end if;
357
358 UI_Image_Length := UI_Image_Length + 1;
359 UI_Image_Buffer (UI_Image_Length) :=
360 Character'Val (Character'Pos ('0') + N mod 10);
361 end Image_Exponent;
362
363 ----------------
364 -- Image_Uint --
365 ----------------
366
367 procedure Image_Uint (U : Uint) is
fbf5a39b
AC
368 H : constant array (Int range 0 .. 15) of Character :=
369 "0123456789ABCDEF";
415dddc8
RK
370
371 begin
372 if U >= Base then
373 Image_Uint (U / Base);
374 end if;
375
376 if Digs_Output = 4 and then Base = Uint_16 then
377 Image_Char ('_');
378 Digs_Output := 0;
379 end if;
380
381 Image_Char (H (UI_To_Int (U rem Base)));
382
383 Digs_Output := Digs_Output + 1;
384 end Image_Uint;
385
386 -- Start of processing for Image_Out
387
388 begin
389 if Input = No_Uint then
390 Image_Char ('?');
391 return;
392 end if;
393
394 UI_Image_Length := 0;
395
396 if Input < Uint_0 then
397 Image_Char ('-');
398 Ainput := -Input;
399 else
400 Ainput := Input;
401 end if;
402
403 if Format = Hex
404 or else (Format = Auto and then Better_In_Hex)
405 then
406 Base := Uint_16;
407 Image_Char ('1');
408 Image_Char ('6');
409 Image_Char ('#');
410 Image_Uint (Ainput);
411 Image_Char ('#');
412
413 else
414 Base := Uint_10;
415 Image_Uint (Ainput);
416 end if;
417
418 if Exponent /= 0 then
419 UI_Image_Length := UI_Image_Length + 1;
420 UI_Image_Buffer (UI_Image_Length) := 'E';
421 Image_Exponent (Exponent);
422 end if;
423
424 Uintp.Release (Marks);
425 end Image_Out;
426
427 -------------------
428 -- Init_Operand --
429 -------------------
430
431 procedure Init_Operand (UI : Uint; Vec : out UI_Vector) is
432 Loc : Int;
433
bfc8aa81
RD
434 pragma Assert (Vec'First = Int'(1));
435
415dddc8
RK
436 begin
437 if Direct (UI) then
438 Vec (1) := Direct_Val (UI);
439
440 if Vec (1) >= Base then
441 Vec (2) := Vec (1) rem Base;
442 Vec (1) := Vec (1) / Base;
443 end if;
444
445 else
446 Loc := Uints.Table (UI).Loc;
447
448 for J in 1 .. Uints.Table (UI).Length loop
449 Vec (J) := Udigits.Table (Loc + J - 1);
450 end loop;
451 end if;
452 end Init_Operand;
453
454 ----------------
455 -- Initialize --
456 ----------------
457
458 procedure Initialize is
459 begin
460 Uints.Init;
461 Udigits.Init;
462
463 Uint_Int_First := UI_From_Int (Int'First);
464 Uint_Int_Last := UI_From_Int (Int'Last);
465
466 UI_Power_2 (0) := Uint_1;
467 UI_Power_2_Set := 0;
468
469 UI_Power_10 (0) := Uint_1;
470 UI_Power_10_Set := 0;
471
472 Uints_Min := Uints.Last;
473 Udigits_Min := Udigits.Last;
474
fbf5a39b 475 UI_Ints.Reset;
415dddc8
RK
476 end Initialize;
477
478 ---------------------
479 -- Least_Sig_Digit --
480 ---------------------
481
482 function Least_Sig_Digit (Arg : Uint) return Int is
483 V : Int;
484
485 begin
486 if Direct (Arg) then
487 V := Direct_Val (Arg);
488
489 if V >= Base then
490 V := V mod Base;
491 end if;
492
493 -- Note that this result may be negative
494
495 return V;
496
497 else
498 return
499 Udigits.Table
500 (Uints.Table (Arg).Loc + Uints.Table (Arg).Length - 1);
501 end if;
502 end Least_Sig_Digit;
503
504 ----------
505 -- Mark --
506 ----------
507
508 function Mark return Save_Mark is
509 begin
510 return (Save_Uint => Uints.Last, Save_Udigit => Udigits.Last);
511 end Mark;
512
513 -----------------------
514 -- Most_Sig_2_Digits --
515 -----------------------
516
517 procedure Most_Sig_2_Digits
518 (Left : Uint;
519 Right : Uint;
520 Left_Hat : out Int;
521 Right_Hat : out Int)
522 is
523 begin
524 pragma Assert (Left >= Right);
525
526 if Direct (Left) then
527 Left_Hat := Direct_Val (Left);
528 Right_Hat := Direct_Val (Right);
529 return;
530
531 else
532 declare
533 L1 : constant Int :=
534 Udigits.Table (Uints.Table (Left).Loc);
535 L2 : constant Int :=
536 Udigits.Table (Uints.Table (Left).Loc + 1);
537
538 begin
539 -- It is not so clear what to return when Arg is negative???
540
541 Left_Hat := abs (L1) * Base + L2;
542 end;
543 end if;
544
545 declare
546 Length_L : constant Int := Uints.Table (Left).Length;
547 Length_R : Int;
548 R1 : Int;
549 R2 : Int;
550 T : Int;
551
552 begin
553 if Direct (Right) then
554 T := Direct_Val (Left);
555 R1 := abs (T / Base);
556 R2 := T rem Base;
557 Length_R := 2;
558
559 else
560 R1 := abs (Udigits.Table (Uints.Table (Right).Loc));
561 R2 := Udigits.Table (Uints.Table (Right).Loc + 1);
562 Length_R := Uints.Table (Right).Length;
563 end if;
564
565 if Length_L = Length_R then
566 Right_Hat := R1 * Base + R2;
567 elsif Length_L = Length_R + Int_1 then
568 Right_Hat := R1;
569 else
570 Right_Hat := 0;
571 end if;
572 end;
573 end Most_Sig_2_Digits;
574
575 ---------------
576 -- N_Digits --
577 ---------------
578
579 -- Note: N_Digits returns 1 for No_Uint
580
581 function N_Digits (Input : Uint) return Int is
582 begin
583 if Direct (Input) then
584 if Direct_Val (Input) >= Base then
585 return 2;
586 else
587 return 1;
588 end if;
589
590 else
591 return Uints.Table (Input).Length;
592 end if;
593 end N_Digits;
594
595 --------------
596 -- Num_Bits --
597 --------------
598
599 function Num_Bits (Input : Uint) return Nat is
600 Bits : Nat;
601 Num : Nat;
602
603 begin
bfc8aa81
RD
604 -- Largest negative number has to be handled specially, since it is in
605 -- Int_Range, but we cannot take the absolute value.
606
93f978b7
RK
607 if Input = Uint_Int_First then
608 return Int'Size;
609
bfc8aa81
RD
610 -- For any other number in Int_Range, get absolute value of number
611
93f978b7 612 elsif UI_Is_In_Int_Range (Input) then
fbf5a39b 613 Num := abs (UI_To_Int (Input));
415dddc8
RK
614 Bits := 0;
615
bfc8aa81
RD
616 -- If not in Int_Range then initialize bit count for all low order
617 -- words, and set number to high order digit.
618
415dddc8
RK
619 else
620 Bits := Base_Bits * (Uints.Table (Input).Length - 1);
621 Num := abs (Udigits.Table (Uints.Table (Input).Loc));
622 end if;
623
bfc8aa81
RD
624 -- Increase bit count for remaining value in Num
625
415dddc8
RK
626 while Types.">" (Num, 0) loop
627 Num := Num / 2;
628 Bits := Bits + 1;
629 end loop;
630
631 return Bits;
632 end Num_Bits;
633
634 ---------
635 -- pid --
636 ---------
637
638 procedure pid (Input : Uint) is
639 begin
640 UI_Write (Input, Decimal);
641 Write_Eol;
642 end pid;
643
644 ---------
645 -- pih --
646 ---------
647
648 procedure pih (Input : Uint) is
649 begin
650 UI_Write (Input, Hex);
651 Write_Eol;
652 end pih;
653
654 -------------
655 -- Release --
656 -------------
657
658 procedure Release (M : Save_Mark) is
659 begin
660 Uints.Set_Last (Uint'Max (M.Save_Uint, Uints_Min));
661 Udigits.Set_Last (Int'Max (M.Save_Udigit, Udigits_Min));
662 end Release;
663
664 ----------------------
665 -- Release_And_Save --
666 ----------------------
667
668 procedure Release_And_Save (M : Save_Mark; UI : in out Uint) is
669 begin
670 if Direct (UI) then
671 Release (M);
672
673 else
674 declare
fbf5a39b
AC
675 UE_Len : constant Pos := Uints.Table (UI).Length;
676 UE_Loc : constant Int := Uints.Table (UI).Loc;
415dddc8 677
fbf5a39b 678 UD : constant Udigits.Table_Type (1 .. UE_Len) :=
415dddc8
RK
679 Udigits.Table (UE_Loc .. UE_Loc + UE_Len - 1);
680
681 begin
682 Release (M);
683
5eace9bc 684 Uints.Append ((Length => UE_Len, Loc => Udigits.Last + 1));
415dddc8
RK
685 UI := Uints.Last;
686
415dddc8 687 for J in 1 .. UE_Len loop
5eace9bc 688 Udigits.Append (UD (J));
415dddc8
RK
689 end loop;
690 end;
691 end if;
692 end Release_And_Save;
693
694 procedure Release_And_Save (M : Save_Mark; UI1, UI2 : in out Uint) is
695 begin
696 if Direct (UI1) then
697 Release_And_Save (M, UI2);
698
699 elsif Direct (UI2) then
700 Release_And_Save (M, UI1);
701
702 else
703 declare
fbf5a39b
AC
704 UE1_Len : constant Pos := Uints.Table (UI1).Length;
705 UE1_Loc : constant Int := Uints.Table (UI1).Loc;
415dddc8 706
fbf5a39b 707 UD1 : constant Udigits.Table_Type (1 .. UE1_Len) :=
415dddc8
RK
708 Udigits.Table (UE1_Loc .. UE1_Loc + UE1_Len - 1);
709
fbf5a39b
AC
710 UE2_Len : constant Pos := Uints.Table (UI2).Length;
711 UE2_Loc : constant Int := Uints.Table (UI2).Loc;
415dddc8 712
fbf5a39b 713 UD2 : constant Udigits.Table_Type (1 .. UE2_Len) :=
415dddc8
RK
714 Udigits.Table (UE2_Loc .. UE2_Loc + UE2_Len - 1);
715
716 begin
717 Release (M);
718
5eace9bc 719 Uints.Append ((Length => UE1_Len, Loc => Udigits.Last + 1));
415dddc8
RK
720 UI1 := Uints.Last;
721
415dddc8 722 for J in 1 .. UE1_Len loop
5eace9bc 723 Udigits.Append (UD1 (J));
415dddc8
RK
724 end loop;
725
5eace9bc 726 Uints.Append ((Length => UE2_Len, Loc => Udigits.Last + 1));
415dddc8
RK
727 UI2 := Uints.Last;
728
415dddc8 729 for J in 1 .. UE2_Len loop
5eace9bc 730 Udigits.Append (UD2 (J));
415dddc8
RK
731 end loop;
732 end;
733 end if;
734 end Release_And_Save;
735
736 ----------------
737 -- Sum_Digits --
738 ----------------
739
740 -- This is done in one pass
741
3354f96d 742 -- Mathematically: assume base congruent to 1 and compute an equivalent
415dddc8
RK
743 -- integer to Left.
744
9de61fcb 745 -- If Sign = -1 return the alternating sum of the "digits"
415dddc8 746
9de61fcb 747 -- D1 - D2 + D3 - D4 + D5 ...
415dddc8
RK
748
749 -- (where D1 is Least Significant Digit)
750
3354f96d 751 -- Mathematically: assume base congruent to -1 and compute an equivalent
415dddc8
RK
752 -- integer to Left.
753
754 -- This is used in Rem and Base is assumed to be 2 ** 15
755
756 -- Note: The next two functions are very similar, any style changes made
757 -- to one should be reflected in both. These would be simpler if we
758 -- worked base 2 ** 32.
759
760 function Sum_Digits (Left : Uint; Sign : Int) return Int is
761 begin
762 pragma Assert (Sign = Int_1 or Sign = Int (-1));
763
764 -- First try simple case;
765
766 if Direct (Left) then
767 declare
768 Tmp_Int : Int := Direct_Val (Left);
769
770 begin
771 if Tmp_Int >= Base then
772 Tmp_Int := (Tmp_Int / Base) +
773 Sign * (Tmp_Int rem Base);
774
775 -- Now Tmp_Int is in [-(Base - 1) .. 2 * (Base - 1)]
776
777 if Tmp_Int >= Base then
778
9de61fcb 779 -- Sign must be 1
415dddc8
RK
780
781 Tmp_Int := (Tmp_Int / Base) + 1;
782
783 end if;
784
785 -- Now Tmp_Int is in [-(Base - 1) .. (Base - 1)]
786
787 end if;
788
789 return Tmp_Int;
790 end;
791
792 -- Otherwise full circuit is needed
793
794 else
795 declare
fbf5a39b 796 L_Length : constant Int := N_Digits (Left);
415dddc8
RK
797 L_Vec : UI_Vector (1 .. L_Length);
798 Tmp_Int : Int;
799 Carry : Int;
800 Alt : Int;
801
802 begin
803 Init_Operand (Left, L_Vec);
804 L_Vec (1) := abs L_Vec (1);
805 Tmp_Int := 0;
806 Carry := 0;
807 Alt := 1;
808
809 for J in reverse 1 .. L_Length loop
810 Tmp_Int := Tmp_Int + Alt * (L_Vec (J) + Carry);
811
812 -- Tmp_Int is now between [-2 * Base + 1 .. 2 * Base - 1],
813 -- since old Tmp_Int is between [-(Base - 1) .. Base - 1]
814 -- and L_Vec is in [0 .. Base - 1] and Carry in [-1 .. 1]
815
816 if Tmp_Int >= Base then
817 Tmp_Int := Tmp_Int - Base;
818 Carry := 1;
819
820 elsif Tmp_Int <= -Base then
821 Tmp_Int := Tmp_Int + Base;
822 Carry := -1;
823
824 else
825 Carry := 0;
826 end if;
827
828 -- Tmp_Int is now between [-Base + 1 .. Base - 1]
829
830 Alt := Alt * Sign;
831 end loop;
832
833 Tmp_Int := Tmp_Int + Alt * Carry;
834
835 -- Tmp_Int is now between [-Base .. Base]
836
837 if Tmp_Int >= Base then
838 Tmp_Int := Tmp_Int - Base + Alt * Sign * 1;
839
840 elsif Tmp_Int <= -Base then
841 Tmp_Int := Tmp_Int + Base + Alt * Sign * (-1);
842 end if;
843
844 -- Now Tmp_Int is in [-(Base - 1) .. (Base - 1)]
845
846 return Tmp_Int;
847 end;
848 end if;
849 end Sum_Digits;
850
851 -----------------------
852 -- Sum_Double_Digits --
853 -----------------------
854
855 -- Note: This is used in Rem, Base is assumed to be 2 ** 15
856
857 function Sum_Double_Digits (Left : Uint; Sign : Int) return Int is
858 begin
859 -- First try simple case;
860
861 pragma Assert (Sign = Int_1 or Sign = Int (-1));
862
863 if Direct (Left) then
864 return Direct_Val (Left);
865
866 -- Otherwise full circuit is needed
867
868 else
869 declare
fbf5a39b 870 L_Length : constant Int := N_Digits (Left);
415dddc8
RK
871 L_Vec : UI_Vector (1 .. L_Length);
872 Most_Sig_Int : Int;
873 Least_Sig_Int : Int;
874 Carry : Int;
875 J : Int;
876 Alt : Int;
877
878 begin
879 Init_Operand (Left, L_Vec);
880 L_Vec (1) := abs L_Vec (1);
881 Most_Sig_Int := 0;
882 Least_Sig_Int := 0;
883 Carry := 0;
884 Alt := 1;
885 J := L_Length;
886
887 while J > Int_1 loop
415dddc8
RK
888 Least_Sig_Int := Least_Sig_Int + Alt * (L_Vec (J) + Carry);
889
890 -- Least is in [-2 Base + 1 .. 2 * Base - 1]
891 -- Since L_Vec in [0 .. Base - 1] and Carry in [-1 .. 1]
892 -- and old Least in [-Base + 1 .. Base - 1]
893
894 if Least_Sig_Int >= Base then
895 Least_Sig_Int := Least_Sig_Int - Base;
896 Carry := 1;
897
898 elsif Least_Sig_Int <= -Base then
899 Least_Sig_Int := Least_Sig_Int + Base;
900 Carry := -1;
901
902 else
903 Carry := 0;
904 end if;
905
906 -- Least is now in [-Base + 1 .. Base - 1]
907
908 Most_Sig_Int := Most_Sig_Int + Alt * (L_Vec (J - 1) + Carry);
909
910 -- Most is in [-2 Base + 1 .. 2 * Base - 1]
911 -- Since L_Vec in [0 .. Base - 1] and Carry in [-1 .. 1]
912 -- and old Most in [-Base + 1 .. Base - 1]
913
914 if Most_Sig_Int >= Base then
915 Most_Sig_Int := Most_Sig_Int - Base;
916 Carry := 1;
917
918 elsif Most_Sig_Int <= -Base then
919 Most_Sig_Int := Most_Sig_Int + Base;
920 Carry := -1;
921 else
922 Carry := 0;
923 end if;
924
925 -- Most is now in [-Base + 1 .. Base - 1]
926
927 J := J - 2;
928 Alt := Alt * Sign;
929 end loop;
930
931 if J = Int_1 then
932 Least_Sig_Int := Least_Sig_Int + Alt * (L_Vec (J) + Carry);
933 else
934 Least_Sig_Int := Least_Sig_Int + Alt * Carry;
935 end if;
936
937 if Least_Sig_Int >= Base then
938 Least_Sig_Int := Least_Sig_Int - Base;
939 Most_Sig_Int := Most_Sig_Int + Alt * 1;
940
941 elsif Least_Sig_Int <= -Base then
942 Least_Sig_Int := Least_Sig_Int + Base;
943 Most_Sig_Int := Most_Sig_Int + Alt * (-1);
944 end if;
945
946 if Most_Sig_Int >= Base then
947 Most_Sig_Int := Most_Sig_Int - Base;
948 Alt := Alt * Sign;
949 Least_Sig_Int :=
950 Least_Sig_Int + Alt * 1; -- cannot overflow again
951
952 elsif Most_Sig_Int <= -Base then
953 Most_Sig_Int := Most_Sig_Int + Base;
954 Alt := Alt * Sign;
955 Least_Sig_Int :=
956 Least_Sig_Int + Alt * (-1); -- cannot overflow again.
957 end if;
958
959 return Most_Sig_Int * Base + Least_Sig_Int;
960 end;
961 end if;
962 end Sum_Double_Digits;
963
964 ---------------
965 -- Tree_Read --
966 ---------------
967
968 procedure Tree_Read is
969 begin
970 Uints.Tree_Read;
971 Udigits.Tree_Read;
972
973 Tree_Read_Int (Int (Uint_Int_First));
974 Tree_Read_Int (Int (Uint_Int_Last));
975 Tree_Read_Int (UI_Power_2_Set);
976 Tree_Read_Int (UI_Power_10_Set);
977 Tree_Read_Int (Int (Uints_Min));
978 Tree_Read_Int (Udigits_Min);
979
980 for J in 0 .. UI_Power_2_Set loop
981 Tree_Read_Int (Int (UI_Power_2 (J)));
982 end loop;
983
984 for J in 0 .. UI_Power_10_Set loop
985 Tree_Read_Int (Int (UI_Power_10 (J)));
986 end loop;
987
988 end Tree_Read;
989
990 ----------------
991 -- Tree_Write --
992 ----------------
993
994 procedure Tree_Write is
995 begin
996 Uints.Tree_Write;
997 Udigits.Tree_Write;
998
999 Tree_Write_Int (Int (Uint_Int_First));
1000 Tree_Write_Int (Int (Uint_Int_Last));
1001 Tree_Write_Int (UI_Power_2_Set);
1002 Tree_Write_Int (UI_Power_10_Set);
1003 Tree_Write_Int (Int (Uints_Min));
1004 Tree_Write_Int (Udigits_Min);
1005
1006 for J in 0 .. UI_Power_2_Set loop
1007 Tree_Write_Int (Int (UI_Power_2 (J)));
1008 end loop;
1009
1010 for J in 0 .. UI_Power_10_Set loop
1011 Tree_Write_Int (Int (UI_Power_10 (J)));
1012 end loop;
1013
1014 end Tree_Write;
1015
1016 -------------
1017 -- UI_Abs --
1018 -------------
1019
1020 function UI_Abs (Right : Uint) return Uint is
1021 begin
1022 if Right < Uint_0 then
1023 return -Right;
1024 else
1025 return Right;
1026 end if;
1027 end UI_Abs;
1028
1029 -------------
1030 -- UI_Add --
1031 -------------
1032
1033 function UI_Add (Left : Int; Right : Uint) return Uint is
1034 begin
1035 return UI_Add (UI_From_Int (Left), Right);
1036 end UI_Add;
1037
1038 function UI_Add (Left : Uint; Right : Int) return Uint is
1039 begin
1040 return UI_Add (Left, UI_From_Int (Right));
1041 end UI_Add;
1042
1043 function UI_Add (Left : Uint; Right : Uint) return Uint is
1044 begin
1045 -- Simple cases of direct operands and addition of zero
1046
1047 if Direct (Left) then
1048 if Direct (Right) then
1049 return UI_From_Int (Direct_Val (Left) + Direct_Val (Right));
1050
1051 elsif Int (Left) = Int (Uint_0) then
1052 return Right;
1053 end if;
1054
1055 elsif Direct (Right) and then Int (Right) = Int (Uint_0) then
1056 return Left;
1057 end if;
1058
1059 -- Otherwise full circuit is needed
1060
1061 declare
fbf5a39b
AC
1062 L_Length : constant Int := N_Digits (Left);
1063 R_Length : constant Int := N_Digits (Right);
415dddc8
RK
1064 L_Vec : UI_Vector (1 .. L_Length);
1065 R_Vec : UI_Vector (1 .. R_Length);
1066 Sum_Length : Int;
1067 Tmp_Int : Int;
1068 Carry : Int;
1069 Borrow : Int;
1070 X_Bigger : Boolean := False;
1071 Y_Bigger : Boolean := False;
1072 Result_Neg : Boolean := False;
1073
1074 begin
1075 Init_Operand (Left, L_Vec);
1076 Init_Operand (Right, R_Vec);
1077
1078 -- At least one of the two operands is in multi-digit form.
1079 -- Calculate the number of digits sufficient to hold result.
1080
1081 if L_Length > R_Length then
1082 Sum_Length := L_Length + 1;
1083 X_Bigger := True;
1084 else
1085 Sum_Length := R_Length + 1;
835d23b2
RD
1086
1087 if R_Length > L_Length then
1088 Y_Bigger := True;
1089 end if;
415dddc8
RK
1090 end if;
1091
835d23b2
RD
1092 -- Make copies of the absolute values of L_Vec and R_Vec into X and Y
1093 -- both with lengths equal to the maximum possibly needed. This makes
1094 -- looping over the digits much simpler.
415dddc8
RK
1095
1096 declare
1097 X : UI_Vector (1 .. Sum_Length);
1098 Y : UI_Vector (1 .. Sum_Length);
1099 Tmp_UI : UI_Vector (1 .. Sum_Length);
1100
1101 begin
1102 for J in 1 .. Sum_Length - L_Length loop
1103 X (J) := 0;
1104 end loop;
1105
1106 X (Sum_Length - L_Length + 1) := abs L_Vec (1);
1107
1108 for J in 2 .. L_Length loop
1109 X (J + (Sum_Length - L_Length)) := L_Vec (J);
1110 end loop;
1111
1112 for J in 1 .. Sum_Length - R_Length loop
1113 Y (J) := 0;
1114 end loop;
1115
1116 Y (Sum_Length - R_Length + 1) := abs R_Vec (1);
1117
1118 for J in 2 .. R_Length loop
1119 Y (J + (Sum_Length - R_Length)) := R_Vec (J);
1120 end loop;
1121
1122 if (L_Vec (1) < Int_0) = (R_Vec (1) < Int_0) then
1123
1124 -- Same sign so just add
1125
1126 Carry := 0;
1127 for J in reverse 1 .. Sum_Length loop
1128 Tmp_Int := X (J) + Y (J) + Carry;
1129
1130 if Tmp_Int >= Base then
1131 Tmp_Int := Tmp_Int - Base;
1132 Carry := 1;
1133 else
1134 Carry := 0;
1135 end if;
1136
1137 X (J) := Tmp_Int;
1138 end loop;
1139
1140 return Vector_To_Uint (X, L_Vec (1) < Int_0);
1141
1142 else
1143 -- Find which one has bigger magnitude
1144
1145 if not (X_Bigger or Y_Bigger) then
1146 for J in L_Vec'Range loop
1147 if abs L_Vec (J) > abs R_Vec (J) then
1148 X_Bigger := True;
1149 exit;
1150 elsif abs R_Vec (J) > abs L_Vec (J) then
1151 Y_Bigger := True;
1152 exit;
1153 end if;
1154 end loop;
1155 end if;
1156
835d23b2
RD
1157 -- If they have identical magnitude, just return 0, else swap
1158 -- if necessary so that X had the bigger magnitude. Determine
1159 -- if result is negative at this time.
415dddc8
RK
1160
1161 Result_Neg := False;
1162
1163 if not (X_Bigger or Y_Bigger) then
1164 return Uint_0;
1165
1166 elsif Y_Bigger then
1167 if R_Vec (1) < Int_0 then
1168 Result_Neg := True;
1169 end if;
1170
1171 Tmp_UI := X;
1172 X := Y;
1173 Y := Tmp_UI;
1174
1175 else
1176 if L_Vec (1) < Int_0 then
1177 Result_Neg := True;
1178 end if;
1179 end if;
1180
1181 -- Subtract Y from the bigger X
1182
1183 Borrow := 0;
1184
1185 for J in reverse 1 .. Sum_Length loop
1186 Tmp_Int := X (J) - Y (J) + Borrow;
1187
1188 if Tmp_Int < Int_0 then
1189 Tmp_Int := Tmp_Int + Base;
1190 Borrow := -1;
1191 else
1192 Borrow := 0;
1193 end if;
1194
1195 X (J) := Tmp_Int;
1196 end loop;
1197
1198 return Vector_To_Uint (X, Result_Neg);
1199
1200 end if;
1201 end;
1202 end;
1203 end UI_Add;
1204
1205 --------------------------
1206 -- UI_Decimal_Digits_Hi --
1207 --------------------------
1208
1209 function UI_Decimal_Digits_Hi (U : Uint) return Nat is
1210 begin
835d23b2
RD
1211 -- The maximum value of a "digit" is 32767, which is 5 decimal digits,
1212 -- so an N_Digit number could take up to 5 times this number of digits.
1213 -- This is certainly too high for large numbers but it is not worth
1214 -- worrying about.
415dddc8
RK
1215
1216 return 5 * N_Digits (U);
1217 end UI_Decimal_Digits_Hi;
1218
1219 --------------------------
1220 -- UI_Decimal_Digits_Lo --
1221 --------------------------
1222
1223 function UI_Decimal_Digits_Lo (U : Uint) return Nat is
1224 begin
1225 -- The maximum value of a "digit" is 32767, which is more than four
1226 -- decimal digits, but not a full five digits. The easily computed
1227 -- minimum number of decimal digits is thus 1 + 4 * the number of
835d23b2
RD
1228 -- digits. This is certainly too low for large numbers but it is not
1229 -- worth worrying about.
415dddc8
RK
1230
1231 return 1 + 4 * (N_Digits (U) - 1);
1232 end UI_Decimal_Digits_Lo;
1233
1234 ------------
1235 -- UI_Div --
1236 ------------
1237
1238 function UI_Div (Left : Int; Right : Uint) return Uint is
1239 begin
1240 return UI_Div (UI_From_Int (Left), Right);
1241 end UI_Div;
1242
1243 function UI_Div (Left : Uint; Right : Int) return Uint is
1244 begin
1245 return UI_Div (Left, UI_From_Int (Right));
1246 end UI_Div;
1247
1248 function UI_Div (Left, Right : Uint) return Uint is
2e45500e
TQ
1249 Quotient : Uint;
1250 Remainder : Uint;
67ce0d7e 1251 pragma Warnings (Off, Remainder);
2e45500e
TQ
1252 begin
1253 UI_Div_Rem
1254 (Left, Right,
1255 Quotient, Remainder,
1256 Discard_Quotient => False,
1257 Discard_Remainder => True);
1258 return Quotient;
1259 end UI_Div;
1260
1261 ----------------
1262 -- UI_Div_Rem --
1263 ----------------
1264
1265 procedure UI_Div_Rem
1266 (Left, Right : Uint;
1267 Quotient : out Uint;
1268 Remainder : out Uint;
1269 Discard_Quotient : Boolean;
1270 Discard_Remainder : Boolean)
1271 is
c5d31169
AC
1272 pragma Warnings (Off, Quotient);
1273 pragma Warnings (Off, Remainder);
415dddc8
RK
1274 begin
1275 pragma Assert (Right /= Uint_0);
1276
1277 -- Cases where both operands are represented directly
1278
1279 if Direct (Left) and then Direct (Right) then
2e45500e
TQ
1280 declare
1281 DV_Left : constant Int := Direct_Val (Left);
1282 DV_Right : constant Int := Direct_Val (Right);
1283
1284 begin
1285 if not Discard_Quotient then
1286 Quotient := UI_From_Int (DV_Left / DV_Right);
1287 end if;
1288
1289 if not Discard_Remainder then
1290 Remainder := UI_From_Int (DV_Left rem DV_Right);
1291 end if;
1292
1293 return;
1294 end;
415dddc8
RK
1295 end if;
1296
1297 declare
1298 L_Length : constant Int := N_Digits (Left);
1299 R_Length : constant Int := N_Digits (Right);
1300 Q_Length : constant Int := L_Length - R_Length + 1;
1301 L_Vec : UI_Vector (1 .. L_Length);
1302 R_Vec : UI_Vector (1 .. R_Length);
1303 D : Int;
2e45500e 1304 Remainder_I : Int;
415dddc8
RK
1305 Tmp_Divisor : Int;
1306 Carry : Int;
1307 Tmp_Int : Int;
1308 Tmp_Dig : Int;
1309
2e45500e
TQ
1310 procedure UI_Div_Vector
1311 (L_Vec : UI_Vector;
1312 R_Int : Int;
1313 Quotient : out UI_Vector;
1314 Remainder : out Int);
1315 pragma Inline (UI_Div_Vector);
1316 -- Specialised variant for case where the divisor is a single digit
1317
1318 procedure UI_Div_Vector
1319 (L_Vec : UI_Vector;
1320 R_Int : Int;
1321 Quotient : out UI_Vector;
1322 Remainder : out Int)
1323 is
1324 Tmp_Int : Int;
1325
1326 begin
1327 Remainder := 0;
1328 for J in L_Vec'Range loop
1329 Tmp_Int := Remainder * Base + abs L_Vec (J);
1330 Quotient (Quotient'First + J - L_Vec'First) := Tmp_Int / R_Int;
1331 Remainder := Tmp_Int rem R_Int;
1332 end loop;
1333
1334 if L_Vec (L_Vec'First) < Int_0 then
1335 Remainder := -Remainder;
1336 end if;
1337 end UI_Div_Vector;
1338
1339 -- Start of processing for UI_Div_Rem
1340
415dddc8
RK
1341 begin
1342 -- Result is zero if left operand is shorter than right
1343
1344 if L_Length < R_Length then
2e45500e
TQ
1345 if not Discard_Quotient then
1346 Quotient := Uint_0;
1347 end if;
1348 if not Discard_Remainder then
1349 Remainder := Left;
1350 end if;
1351 return;
415dddc8
RK
1352 end if;
1353
1354 Init_Operand (Left, L_Vec);
1355 Init_Operand (Right, R_Vec);
1356
1357 -- Case of right operand is single digit. Here we can simply divide
1358 -- each digit of the left operand by the divisor, from most to least
1359 -- significant, carrying the remainder to the next digit (just like
1360 -- ordinary long division by hand).
1361
1362 if R_Length = Int_1 then
415dddc8
RK
1363 Tmp_Divisor := abs R_Vec (1);
1364
1365 declare
2e45500e 1366 Quotient_V : UI_Vector (1 .. L_Length);
415dddc8
RK
1367
1368 begin
2e45500e 1369 UI_Div_Vector (L_Vec, Tmp_Divisor, Quotient_V, Remainder_I);
415dddc8 1370
2e45500e
TQ
1371 if not Discard_Quotient then
1372 Quotient :=
1373 Vector_To_Uint
1374 (Quotient_V, (L_Vec (1) < Int_0 xor R_Vec (1) < Int_0));
1375 end if;
1376
1377 if not Discard_Remainder then
1378 Remainder := UI_From_Int (Remainder_I);
1379 end if;
1380 return;
415dddc8
RK
1381 end;
1382 end if;
1383
1384 -- The possible simple cases have been exhausted. Now turn to the
1385 -- algorithm D from the section of Knuth mentioned at the top of
1386 -- this package.
1387
1388 Algorithm_D : declare
1389 Dividend : UI_Vector (1 .. L_Length + 1);
1390 Divisor : UI_Vector (1 .. R_Length);
2e45500e 1391 Quotient_V : UI_Vector (1 .. Q_Length);
415dddc8
RK
1392 Divisor_Dig1 : Int;
1393 Divisor_Dig2 : Int;
1394 Q_Guess : Int;
1395
1396 begin
1397 -- [ NORMALIZE ] (step D1 in the algorithm). First calculate the
1398 -- scale d, and then multiply Left and Right (u and v in the book)
1399 -- by d to get the dividend and divisor to work with.
1400
1401 D := Base / (abs R_Vec (1) + 1);
1402
1403 Dividend (1) := 0;
1404 Dividend (2) := abs L_Vec (1);
1405
1406 for J in 3 .. L_Length + Int_1 loop
1407 Dividend (J) := L_Vec (J - 1);
1408 end loop;
1409
1410 Divisor (1) := abs R_Vec (1);
1411
1412 for J in Int_2 .. R_Length loop
1413 Divisor (J) := R_Vec (J);
1414 end loop;
1415
1416 if D > Int_1 then
1417
1418 -- Multiply Dividend by D
1419
1420 Carry := 0;
1421 for J in reverse Dividend'Range loop
1422 Tmp_Int := Dividend (J) * D + Carry;
1423 Dividend (J) := Tmp_Int rem Base;
1424 Carry := Tmp_Int / Base;
1425 end loop;
1426
9de61fcb 1427 -- Multiply Divisor by d
415dddc8
RK
1428
1429 Carry := 0;
1430 for J in reverse Divisor'Range loop
1431 Tmp_Int := Divisor (J) * D + Carry;
1432 Divisor (J) := Tmp_Int rem Base;
1433 Carry := Tmp_Int / Base;
1434 end loop;
1435 end if;
1436
9de61fcb 1437 -- Main loop of long division algorithm
415dddc8
RK
1438
1439 Divisor_Dig1 := Divisor (1);
1440 Divisor_Dig2 := Divisor (2);
1441
2e45500e 1442 for J in Quotient_V'Range loop
415dddc8 1443
9de61fcb 1444 -- [ CALCULATE Q (hat) ] (step D3 in the algorithm)
415dddc8
RK
1445
1446 Tmp_Int := Dividend (J) * Base + Dividend (J + 1);
1447
1448 -- Initial guess
1449
1450 if Dividend (J) = Divisor_Dig1 then
1451 Q_Guess := Base - 1;
1452 else
1453 Q_Guess := Tmp_Int / Divisor_Dig1;
1454 end if;
1455
1456 -- Refine the guess
1457
1458 while Divisor_Dig2 * Q_Guess >
1459 (Tmp_Int - Q_Guess * Divisor_Dig1) * Base +
1460 Dividend (J + 2)
1461 loop
1462 Q_Guess := Q_Guess - 1;
1463 end loop;
1464
2e45500e 1465 -- [ MULTIPLY & SUBTRACT ] (step D4). Q_Guess * Divisor is
415dddc8
RK
1466 -- subtracted from the remaining dividend.
1467
1468 Carry := 0;
1469 for K in reverse Divisor'Range loop
1470 Tmp_Int := Dividend (J + K) - Q_Guess * Divisor (K) + Carry;
1471 Tmp_Dig := Tmp_Int rem Base;
1472 Carry := Tmp_Int / Base;
1473
1474 if Tmp_Dig < Int_0 then
1475 Tmp_Dig := Tmp_Dig + Base;
1476 Carry := Carry - 1;
1477 end if;
1478
1479 Dividend (J + K) := Tmp_Dig;
1480 end loop;
1481
1482 Dividend (J) := Dividend (J) + Carry;
1483
1484 -- [ TEST REMAINDER ] & [ ADD BACK ] (steps D5 and D6)
835d23b2 1485
415dddc8
RK
1486 -- Here there is a slight difference from the book: the last
1487 -- carry is always added in above and below (cancelling each
1488 -- other). In fact the dividend going negative is used as
1489 -- the test.
1490
1491 -- If the Dividend went negative, then Q_Guess was off by
1492 -- one, so it is decremented, and the divisor is added back
1493 -- into the relevant portion of the dividend.
1494
1495 if Dividend (J) < Int_0 then
1496 Q_Guess := Q_Guess - 1;
1497
1498 Carry := 0;
1499 for K in reverse Divisor'Range loop
1500 Tmp_Int := Dividend (J + K) + Divisor (K) + Carry;
1501
1502 if Tmp_Int >= Base then
1503 Tmp_Int := Tmp_Int - Base;
1504 Carry := 1;
1505 else
1506 Carry := 0;
1507 end if;
1508
1509 Dividend (J + K) := Tmp_Int;
1510 end loop;
1511
1512 Dividend (J) := Dividend (J) + Carry;
1513 end if;
1514
1515 -- Finally we can get the next quotient digit
1516
2e45500e 1517 Quotient_V (J) := Q_Guess;
415dddc8
RK
1518 end loop;
1519
2e45500e
TQ
1520 -- [ UNNORMALIZE ] (step D8)
1521
1522 if not Discard_Quotient then
1523 Quotient := Vector_To_Uint
1524 (Quotient_V, (L_Vec (1) < Int_0 xor R_Vec (1) < Int_0));
1525 end if;
415dddc8 1526
2e45500e
TQ
1527 if not Discard_Remainder then
1528 declare
1529 Remainder_V : UI_Vector (1 .. R_Length);
1530 Discard_Int : Int;
67ce0d7e 1531 pragma Warnings (Off, Discard_Int);
2e45500e
TQ
1532 begin
1533 UI_Div_Vector
1534 (Dividend (Dividend'Last - R_Length + 1 .. Dividend'Last),
1535 D,
1536 Remainder_V, Discard_Int);
1537 Remainder := Vector_To_Uint (Remainder_V, L_Vec (1) < Int_0);
1538 end;
1539 end if;
415dddc8
RK
1540 end Algorithm_D;
1541 end;
2e45500e 1542 end UI_Div_Rem;
415dddc8
RK
1543
1544 ------------
1545 -- UI_Eq --
1546 ------------
1547
1548 function UI_Eq (Left : Int; Right : Uint) return Boolean is
1549 begin
1550 return not UI_Ne (UI_From_Int (Left), Right);
1551 end UI_Eq;
1552
1553 function UI_Eq (Left : Uint; Right : Int) return Boolean is
1554 begin
1555 return not UI_Ne (Left, UI_From_Int (Right));
1556 end UI_Eq;
1557
1558 function UI_Eq (Left : Uint; Right : Uint) return Boolean is
1559 begin
1560 return not UI_Ne (Left, Right);
1561 end UI_Eq;
1562
1563 --------------
1564 -- UI_Expon --
1565 --------------
1566
1567 function UI_Expon (Left : Int; Right : Uint) return Uint is
1568 begin
1569 return UI_Expon (UI_From_Int (Left), Right);
1570 end UI_Expon;
1571
1572 function UI_Expon (Left : Uint; Right : Int) return Uint is
1573 begin
1574 return UI_Expon (Left, UI_From_Int (Right));
1575 end UI_Expon;
1576
1577 function UI_Expon (Left : Int; Right : Int) return Uint is
1578 begin
1579 return UI_Expon (UI_From_Int (Left), UI_From_Int (Right));
1580 end UI_Expon;
1581
1582 function UI_Expon (Left : Uint; Right : Uint) return Uint is
1583 begin
1584 pragma Assert (Right >= Uint_0);
1585
1586 -- Any value raised to power of 0 is 1
1587
1588 if Right = Uint_0 then
1589 return Uint_1;
1590
9de61fcb 1591 -- 0 to any positive power is 0
415dddc8
RK
1592
1593 elsif Left = Uint_0 then
1594 return Uint_0;
1595
1596 -- 1 to any power is 1
1597
1598 elsif Left = Uint_1 then
1599 return Uint_1;
1600
1601 -- Any value raised to power of 1 is that value
1602
1603 elsif Right = Uint_1 then
1604 return Left;
1605
1606 -- Cases which can be done by table lookup
1607
1608 elsif Right <= Uint_64 then
1609
1610 -- 2 ** N for N in 2 .. 64
1611
1612 if Left = Uint_2 then
1613 declare
1614 Right_Int : constant Int := Direct_Val (Right);
1615
1616 begin
1617 if Right_Int > UI_Power_2_Set then
1618 for J in UI_Power_2_Set + Int_1 .. Right_Int loop
1619 UI_Power_2 (J) := UI_Power_2 (J - Int_1) * Int_2;
1620 Uints_Min := Uints.Last;
1621 Udigits_Min := Udigits.Last;
1622 end loop;
1623
1624 UI_Power_2_Set := Right_Int;
1625 end if;
1626
1627 return UI_Power_2 (Right_Int);
1628 end;
1629
1630 -- 10 ** N for N in 2 .. 64
1631
1632 elsif Left = Uint_10 then
1633 declare
1634 Right_Int : constant Int := Direct_Val (Right);
1635
1636 begin
1637 if Right_Int > UI_Power_10_Set then
1638 for J in UI_Power_10_Set + Int_1 .. Right_Int loop
1639 UI_Power_10 (J) := UI_Power_10 (J - Int_1) * Int (10);
1640 Uints_Min := Uints.Last;
1641 Udigits_Min := Udigits.Last;
1642 end loop;
1643
1644 UI_Power_10_Set := Right_Int;
1645 end if;
1646
1647 return UI_Power_10 (Right_Int);
1648 end;
1649 end if;
1650 end if;
1651
1652 -- If we fall through, then we have the general case (see Knuth 4.6.3)
1653
1654 declare
1655 N : Uint := Right;
1656 Squares : Uint := Left;
1657 Result : Uint := Uint_1;
1658 M : constant Uintp.Save_Mark := Uintp.Mark;
1659
1660 begin
1661 loop
1662 if (Least_Sig_Digit (N) mod Int_2) = Int_1 then
1663 Result := Result * Squares;
1664 end if;
1665
1666 N := N / Uint_2;
1667 exit when N = Uint_0;
1668 Squares := Squares * Squares;
1669 end loop;
1670
1671 Uintp.Release_And_Save (M, Result);
1672 return Result;
1673 end;
1674 end UI_Expon;
1675
82c80734
RD
1676 ----------------
1677 -- UI_From_CC --
1678 ----------------
1679
1680 function UI_From_CC (Input : Char_Code) return Uint is
1681 begin
1682 return UI_From_Dint (Dint (Input));
1683 end UI_From_CC;
1684
415dddc8
RK
1685 ------------------
1686 -- UI_From_Dint --
1687 ------------------
1688
1689 function UI_From_Dint (Input : Dint) return Uint is
1690 begin
1691
1692 if Dint (Min_Direct) <= Input and then Input <= Dint (Max_Direct) then
1693 return Uint (Dint (Uint_Direct_Bias) + Input);
1694
835d23b2
RD
1695 -- For values of larger magnitude, compute digits into a vector and call
1696 -- Vector_To_Uint.
415dddc8
RK
1697
1698 else
1699 declare
1700 Max_For_Dint : constant := 5;
835d23b2
RD
1701 -- Base is defined so that 5 Uint digits is sufficient to hold the
1702 -- largest possible Dint value.
415dddc8
RK
1703
1704 V : UI_Vector (1 .. Max_For_Dint);
1705
1706 Temp_Integer : Dint;
1707
1708 begin
1709 for J in V'Range loop
1710 V (J) := 0;
1711 end loop;
1712
1713 Temp_Integer := Input;
1714
1715 for J in reverse V'Range loop
1716 V (J) := Int (abs (Temp_Integer rem Dint (Base)));
1717 Temp_Integer := Temp_Integer / Dint (Base);
1718 end loop;
1719
1720 return Vector_To_Uint (V, Input < Dint'(0));
1721 end;
1722 end if;
1723 end UI_From_Dint;
1724
1725 -----------------
1726 -- UI_From_Int --
1727 -----------------
1728
1729 function UI_From_Int (Input : Int) return Uint is
fbf5a39b 1730 U : Uint;
415dddc8 1731
fbf5a39b 1732 begin
415dddc8
RK
1733 if Min_Direct <= Input and then Input <= Max_Direct then
1734 return Uint (Int (Uint_Direct_Bias) + Input);
fbf5a39b
AC
1735 end if;
1736
1737 -- If already in the hash table, return entry
1738
1739 U := UI_Ints.Get (Input);
1740
1741 if U /= No_Uint then
1742 return U;
1743 end if;
415dddc8 1744
835d23b2
RD
1745 -- For values of larger magnitude, compute digits into a vector and call
1746 -- Vector_To_Uint.
415dddc8 1747
fbf5a39b
AC
1748 declare
1749 Max_For_Int : constant := 3;
835d23b2
RD
1750 -- Base is defined so that 3 Uint digits is sufficient to hold the
1751 -- largest possible Int value.
415dddc8 1752
fbf5a39b 1753 V : UI_Vector (1 .. Max_For_Int);
415dddc8 1754
fbf5a39b 1755 Temp_Integer : Int;
415dddc8 1756
fbf5a39b
AC
1757 begin
1758 for J in V'Range loop
1759 V (J) := 0;
1760 end loop;
415dddc8 1761
fbf5a39b 1762 Temp_Integer := Input;
415dddc8 1763
fbf5a39b
AC
1764 for J in reverse V'Range loop
1765 V (J) := abs (Temp_Integer rem Base);
1766 Temp_Integer := Temp_Integer / Base;
1767 end loop;
415dddc8 1768
fbf5a39b
AC
1769 U := Vector_To_Uint (V, Input < Int_0);
1770 UI_Ints.Set (Input, U);
1771 Uints_Min := Uints.Last;
1772 Udigits_Min := Udigits.Last;
1773 return U;
1774 end;
415dddc8
RK
1775 end UI_From_Int;
1776
1777 ------------
1778 -- UI_GCD --
1779 ------------
1780
9de61fcb 1781 -- Lehmer's algorithm for GCD
415dddc8
RK
1782
1783 -- The idea is to avoid using multiple precision arithmetic wherever
1784 -- possible, substituting Int arithmetic instead. See Knuth volume II,
1785 -- Algorithm L (page 329).
1786
1787 -- We use the same notation as Knuth (U_Hat standing for the obvious!)
1788
1789 function UI_GCD (Uin, Vin : Uint) return Uint is
1790 U, V : Uint;
1791 -- Copies of Uin and Vin
1792
1793 U_Hat, V_Hat : Int;
1794 -- The most Significant digits of U,V
1795
1796 A, B, C, D, T, Q, Den1, Den2 : Int;
1797
1798 Tmp_UI : Uint;
1799 Marks : constant Uintp.Save_Mark := Uintp.Mark;
1800 Iterations : Integer := 0;
1801
1802 begin
1803 pragma Assert (Uin >= Vin);
1804 pragma Assert (Vin >= Uint_0);
1805
1806 U := Uin;
1807 V := Vin;
1808
1809 loop
1810 Iterations := Iterations + 1;
1811
1812 if Direct (V) then
1813 if V = Uint_0 then
1814 return U;
1815 else
1816 return
1817 UI_From_Int (GCD (Direct_Val (V), UI_To_Int (U rem V)));
1818 end if;
1819 end if;
1820
1821 Most_Sig_2_Digits (U, V, U_Hat, V_Hat);
1822 A := 1;
1823 B := 0;
1824 C := 0;
1825 D := 1;
1826
1827 loop
1828 -- We might overflow and get division by zero here. This just
9de61fcb 1829 -- means we cannot take the single precision step
415dddc8
RK
1830
1831 Den1 := V_Hat + C;
1832 Den2 := V_Hat + D;
dc829590 1833 exit when Den1 = Int_0 or else Den2 = Int_0;
415dddc8
RK
1834
1835 -- Compute Q, the trial quotient
1836
1837 Q := (U_Hat + A) / Den1;
1838
1839 exit when Q /= ((U_Hat + B) / Den2);
1840
835d23b2
RD
1841 -- A single precision step Euclid step will give same answer as a
1842 -- multiprecision one.
415dddc8
RK
1843
1844 T := A - (Q * C);
1845 A := C;
1846 C := T;
1847
1848 T := B - (Q * D);
1849 B := D;
1850 D := T;
1851
1852 T := U_Hat - (Q * V_Hat);
1853 U_Hat := V_Hat;
1854 V_Hat := T;
1855
1856 end loop;
1857
1858 -- Take a multiprecision Euclid step
1859
1860 if B = Int_0 then
1861
9de61fcb 1862 -- No single precision steps take a regular Euclid step
415dddc8
RK
1863
1864 Tmp_UI := U rem V;
1865 U := V;
1866 V := Tmp_UI;
1867
1868 else
9de61fcb 1869 -- Use prior single precision steps to compute this Euclid step
415dddc8 1870
835d23b2
RD
1871 -- For constructs such as:
1872 -- sqrt_2: constant := 1.41421_35623_73095_04880_16887_24209_698;
1873 -- sqrt_eps: constant long_float := long_float( 1.0 / sqrt_2)
1874 -- ** long_float'machine_mantissa;
1875 --
1876 -- we spend 80% of our time working on this step. Perhaps we need
1877 -- a special case Int / Uint dot product to speed things up. ???
415dddc8 1878
835d23b2
RD
1879 -- Alternatively we could increase the single precision iterations
1880 -- to handle Uint's of some small size ( <5 digits?). Then we
1881 -- would have more iterations on small Uint. On the code above, we
1882 -- only get 5 (on average) single precision iterations per large
1883 -- iteration. ???
415dddc8
RK
1884
1885 Tmp_UI := (UI_From_Int (A) * U) + (UI_From_Int (B) * V);
1886 V := (UI_From_Int (C) * U) + (UI_From_Int (D) * V);
1887 U := Tmp_UI;
1888 end if;
1889
835d23b2
RD
1890 -- If the operands are very different in magnitude, the loop will
1891 -- generate large amounts of short-lived data, which it is worth
1892 -- removing periodically.
415dddc8
RK
1893
1894 if Iterations > 100 then
1895 Release_And_Save (Marks, U, V);
1896 Iterations := 0;
1897 end if;
1898 end loop;
1899 end UI_GCD;
1900
1901 ------------
1902 -- UI_Ge --
1903 ------------
1904
1905 function UI_Ge (Left : Int; Right : Uint) return Boolean is
1906 begin
1907 return not UI_Lt (UI_From_Int (Left), Right);
1908 end UI_Ge;
1909
1910 function UI_Ge (Left : Uint; Right : Int) return Boolean is
1911 begin
1912 return not UI_Lt (Left, UI_From_Int (Right));
1913 end UI_Ge;
1914
1915 function UI_Ge (Left : Uint; Right : Uint) return Boolean is
1916 begin
1917 return not UI_Lt (Left, Right);
1918 end UI_Ge;
1919
1920 ------------
1921 -- UI_Gt --
1922 ------------
1923
1924 function UI_Gt (Left : Int; Right : Uint) return Boolean is
1925 begin
1926 return UI_Lt (Right, UI_From_Int (Left));
1927 end UI_Gt;
1928
1929 function UI_Gt (Left : Uint; Right : Int) return Boolean is
1930 begin
1931 return UI_Lt (UI_From_Int (Right), Left);
1932 end UI_Gt;
1933
1934 function UI_Gt (Left : Uint; Right : Uint) return Boolean is
1935 begin
efde9617 1936 return UI_Lt (Left => Right, Right => Left);
415dddc8
RK
1937 end UI_Gt;
1938
1939 ---------------
1940 -- UI_Image --
1941 ---------------
1942
1943 procedure UI_Image (Input : Uint; Format : UI_Format := Auto) is
1944 begin
1945 Image_Out (Input, True, Format);
1946 end UI_Image;
1947
1948 -------------------------
1949 -- UI_Is_In_Int_Range --
1950 -------------------------
1951
1952 function UI_Is_In_Int_Range (Input : Uint) return Boolean is
1953 begin
1954 -- Make sure we don't get called before Initialize
1955
1956 pragma Assert (Uint_Int_First /= Uint_0);
1957
1958 if Direct (Input) then
1959 return True;
1960 else
1961 return Input >= Uint_Int_First
1962 and then Input <= Uint_Int_Last;
1963 end if;
1964 end UI_Is_In_Int_Range;
1965
1966 ------------
1967 -- UI_Le --
1968 ------------
1969
1970 function UI_Le (Left : Int; Right : Uint) return Boolean is
1971 begin
1972 return not UI_Lt (Right, UI_From_Int (Left));
1973 end UI_Le;
1974
1975 function UI_Le (Left : Uint; Right : Int) return Boolean is
1976 begin
1977 return not UI_Lt (UI_From_Int (Right), Left);
1978 end UI_Le;
1979
1980 function UI_Le (Left : Uint; Right : Uint) return Boolean is
1981 begin
efde9617 1982 return not UI_Lt (Left => Right, Right => Left);
415dddc8
RK
1983 end UI_Le;
1984
1985 ------------
1986 -- UI_Lt --
1987 ------------
1988
1989 function UI_Lt (Left : Int; Right : Uint) return Boolean is
1990 begin
1991 return UI_Lt (UI_From_Int (Left), Right);
1992 end UI_Lt;
1993
1994 function UI_Lt (Left : Uint; Right : Int) return Boolean is
1995 begin
1996 return UI_Lt (Left, UI_From_Int (Right));
1997 end UI_Lt;
1998
1999 function UI_Lt (Left : Uint; Right : Uint) return Boolean is
2000 begin
2001 -- Quick processing for identical arguments
2002
2003 if Int (Left) = Int (Right) then
2004 return False;
2005
2006 -- Quick processing for both arguments directly represented
2007
2008 elsif Direct (Left) and then Direct (Right) then
2009 return Int (Left) < Int (Right);
2010
2011 -- At least one argument is more than one digit long
2012
2013 else
2014 declare
2015 L_Length : constant Int := N_Digits (Left);
2016 R_Length : constant Int := N_Digits (Right);
2017
2018 L_Vec : UI_Vector (1 .. L_Length);
2019 R_Vec : UI_Vector (1 .. R_Length);
2020
2021 begin
2022 Init_Operand (Left, L_Vec);
2023 Init_Operand (Right, R_Vec);
2024
2025 if L_Vec (1) < Int_0 then
2026
2027 -- First argument negative, second argument non-negative
2028
2029 if R_Vec (1) >= Int_0 then
2030 return True;
2031
2032 -- Both arguments negative
2033
2034 else
2035 if L_Length /= R_Length then
2036 return L_Length > R_Length;
2037
2038 elsif L_Vec (1) /= R_Vec (1) then
2039 return L_Vec (1) < R_Vec (1);
2040
2041 else
2042 for J in 2 .. L_Vec'Last loop
2043 if L_Vec (J) /= R_Vec (J) then
2044 return L_Vec (J) > R_Vec (J);
2045 end if;
2046 end loop;
2047
2048 return False;
2049 end if;
2050 end if;
2051
2052 else
2053 -- First argument non-negative, second argument negative
2054
2055 if R_Vec (1) < Int_0 then
2056 return False;
2057
2058 -- Both arguments non-negative
2059
2060 else
2061 if L_Length /= R_Length then
2062 return L_Length < R_Length;
2063 else
2064 for J in L_Vec'Range loop
2065 if L_Vec (J) /= R_Vec (J) then
2066 return L_Vec (J) < R_Vec (J);
2067 end if;
2068 end loop;
2069
2070 return False;
2071 end if;
2072 end if;
2073 end if;
2074 end;
2075 end if;
2076 end UI_Lt;
2077
2078 ------------
2079 -- UI_Max --
2080 ------------
2081
2082 function UI_Max (Left : Int; Right : Uint) return Uint is
2083 begin
2084 return UI_Max (UI_From_Int (Left), Right);
2085 end UI_Max;
2086
2087 function UI_Max (Left : Uint; Right : Int) return Uint is
2088 begin
2089 return UI_Max (Left, UI_From_Int (Right));
2090 end UI_Max;
2091
2092 function UI_Max (Left : Uint; Right : Uint) return Uint is
2093 begin
2094 if Left >= Right then
2095 return Left;
2096 else
2097 return Right;
2098 end if;
2099 end UI_Max;
2100
2101 ------------
2102 -- UI_Min --
2103 ------------
2104
2105 function UI_Min (Left : Int; Right : Uint) return Uint is
2106 begin
2107 return UI_Min (UI_From_Int (Left), Right);
2108 end UI_Min;
2109
2110 function UI_Min (Left : Uint; Right : Int) return Uint is
2111 begin
2112 return UI_Min (Left, UI_From_Int (Right));
2113 end UI_Min;
2114
2115 function UI_Min (Left : Uint; Right : Uint) return Uint is
2116 begin
2117 if Left <= Right then
2118 return Left;
2119 else
2120 return Right;
2121 end if;
2122 end UI_Min;
2123
2124 -------------
2125 -- UI_Mod --
2126 -------------
2127
2128 function UI_Mod (Left : Int; Right : Uint) return Uint is
2129 begin
2130 return UI_Mod (UI_From_Int (Left), Right);
2131 end UI_Mod;
2132
2133 function UI_Mod (Left : Uint; Right : Int) return Uint is
2134 begin
2135 return UI_Mod (Left, UI_From_Int (Right));
2136 end UI_Mod;
2137
2138 function UI_Mod (Left : Uint; Right : Uint) return Uint is
2139 Urem : constant Uint := Left rem Right;
2140
2141 begin
2142 if (Left < Uint_0) = (Right < Uint_0)
2143 or else Urem = Uint_0
2144 then
2145 return Urem;
2146 else
2147 return Right + Urem;
2148 end if;
2149 end UI_Mod;
2150
2e45500e
TQ
2151 -------------------------------
2152 -- UI_Modular_Exponentiation --
2153 -------------------------------
2154
2155 function UI_Modular_Exponentiation
2156 (B : Uint;
2157 E : Uint;
2158 Modulo : Uint) return Uint
2159 is
2160 M : constant Save_Mark := Mark;
2161
2162 Result : Uint := Uint_1;
2163 Base : Uint := B;
2164 Exponent : Uint := E;
2165
2166 begin
2167 while Exponent /= Uint_0 loop
2168 if Least_Sig_Digit (Exponent) rem Int'(2) = Int'(1) then
2169 Result := (Result * Base) rem Modulo;
2170 end if;
2171
2172 Exponent := Exponent / Uint_2;
2173 Base := (Base * Base) rem Modulo;
2174 end loop;
2175
2176 Release_And_Save (M, Result);
2177 return Result;
2178 end UI_Modular_Exponentiation;
2179
2180 ------------------------
2181 -- UI_Modular_Inverse --
2182 ------------------------
2183
2184 function UI_Modular_Inverse (N : Uint; Modulo : Uint) return Uint is
2185 M : constant Save_Mark := Mark;
2186 U : Uint;
2187 V : Uint;
2188 Q : Uint;
2189 R : Uint;
2190 X : Uint;
2191 Y : Uint;
2192 T : Uint;
2193 S : Int := 1;
2194
2195 begin
2196 U := Modulo;
2197 V := N;
2198
2199 X := Uint_1;
2200 Y := Uint_0;
2201
2202 loop
2203 UI_Div_Rem
2204 (U, V,
2205 Quotient => Q, Remainder => R,
2206 Discard_Quotient => False,
2207 Discard_Remainder => False);
2208
2209 U := V;
2210 V := R;
2211
2212 T := X;
2213 X := Y + Q * X;
2214 Y := T;
2215 S := -S;
2216
2217 exit when R = Uint_1;
2218 end loop;
2219
2220 if S = Int'(-1) then
2221 X := Modulo - X;
2222 end if;
2223
2224 Release_And_Save (M, X);
2225 return X;
2226 end UI_Modular_Inverse;
2227
415dddc8
RK
2228 ------------
2229 -- UI_Mul --
2230 ------------
2231
2232 function UI_Mul (Left : Int; Right : Uint) return Uint is
2233 begin
2234 return UI_Mul (UI_From_Int (Left), Right);
2235 end UI_Mul;
2236
2237 function UI_Mul (Left : Uint; Right : Int) return Uint is
2238 begin
2239 return UI_Mul (Left, UI_From_Int (Right));
2240 end UI_Mul;
2241
2242 function UI_Mul (Left : Uint; Right : Uint) return Uint is
2243 begin
2244 -- Simple case of single length operands
2245
2246 if Direct (Left) and then Direct (Right) then
2247 return
2248 UI_From_Dint
2249 (Dint (Direct_Val (Left)) * Dint (Direct_Val (Right)));
2250 end if;
2251
2252 -- Otherwise we have the general case (Algorithm M in Knuth)
2253
2254 declare
2255 L_Length : constant Int := N_Digits (Left);
2256 R_Length : constant Int := N_Digits (Right);
2257 L_Vec : UI_Vector (1 .. L_Length);
2258 R_Vec : UI_Vector (1 .. R_Length);
2259 Neg : Boolean;
2260
2261 begin
2262 Init_Operand (Left, L_Vec);
2263 Init_Operand (Right, R_Vec);
2264 Neg := (L_Vec (1) < Int_0) xor (R_Vec (1) < Int_0);
2265 L_Vec (1) := abs (L_Vec (1));
2266 R_Vec (1) := abs (R_Vec (1));
2267
2268 Algorithm_M : declare
2269 Product : UI_Vector (1 .. L_Length + R_Length);
2270 Tmp_Sum : Int;
2271 Carry : Int;
2272
2273 begin
2274 for J in Product'Range loop
2275 Product (J) := 0;
2276 end loop;
2277
2278 for J in reverse R_Vec'Range loop
2279 Carry := 0;
2280 for K in reverse L_Vec'Range loop
2281 Tmp_Sum :=
2282 L_Vec (K) * R_Vec (J) + Product (J + K) + Carry;
2283 Product (J + K) := Tmp_Sum rem Base;
2284 Carry := Tmp_Sum / Base;
2285 end loop;
2286
2287 Product (J) := Carry;
2288 end loop;
2289
2290 return Vector_To_Uint (Product, Neg);
2291 end Algorithm_M;
2292 end;
2293 end UI_Mul;
2294
2295 ------------
2296 -- UI_Ne --
2297 ------------
2298
2299 function UI_Ne (Left : Int; Right : Uint) return Boolean is
2300 begin
2301 return UI_Ne (UI_From_Int (Left), Right);
2302 end UI_Ne;
2303
2304 function UI_Ne (Left : Uint; Right : Int) return Boolean is
2305 begin
2306 return UI_Ne (Left, UI_From_Int (Right));
2307 end UI_Ne;
2308
2309 function UI_Ne (Left : Uint; Right : Uint) return Boolean is
2310 begin
2311 -- Quick processing for identical arguments. Note that this takes
2312 -- care of the case of two No_Uint arguments.
2313
2314 if Int (Left) = Int (Right) then
2315 return False;
2316 end if;
2317
2318 -- See if left operand directly represented
2319
2320 if Direct (Left) then
2321
2322 -- If right operand directly represented then compare
2323
2324 if Direct (Right) then
2325 return Int (Left) /= Int (Right);
2326
2327 -- Left operand directly represented, right not, must be unequal
2328
2329 else
2330 return True;
2331 end if;
2332
2333 -- Right operand directly represented, left not, must be unequal
2334
2335 elsif Direct (Right) then
2336 return True;
2337 end if;
2338
2339 -- Otherwise both multi-word, do comparison
2340
2341 declare
2342 Size : constant Int := N_Digits (Left);
2343 Left_Loc : Int;
2344 Right_Loc : Int;
2345
2346 begin
2347 if Size /= N_Digits (Right) then
2348 return True;
2349 end if;
2350
2351 Left_Loc := Uints.Table (Left).Loc;
2352 Right_Loc := Uints.Table (Right).Loc;
2353
2354 for J in Int_0 .. Size - Int_1 loop
2355 if Udigits.Table (Left_Loc + J) /=
2356 Udigits.Table (Right_Loc + J)
2357 then
2358 return True;
2359 end if;
2360 end loop;
2361
2362 return False;
2363 end;
2364 end UI_Ne;
2365
2366 ----------------
2367 -- UI_Negate --
2368 ----------------
2369
2370 function UI_Negate (Right : Uint) return Uint is
2371 begin
835d23b2
RD
2372 -- Case where input is directly represented. Note that since the range
2373 -- of Direct values is non-symmetrical, the result may not be directly
2374 -- represented, this is taken care of in UI_From_Int.
415dddc8
RK
2375
2376 if Direct (Right) then
2377 return UI_From_Int (-Direct_Val (Right));
2378
835d23b2
RD
2379 -- Full processing for multi-digit case. Note that we cannot just copy
2380 -- the value to the end of the table negating the first digit, since the
2381 -- range of Direct values is non-symmetrical, so we can have a negative
2382 -- value that is not Direct whose negation can be represented directly.
415dddc8
RK
2383
2384 else
2385 declare
2386 R_Length : constant Int := N_Digits (Right);
2387 R_Vec : UI_Vector (1 .. R_Length);
2388 Neg : Boolean;
2389
2390 begin
2391 Init_Operand (Right, R_Vec);
2392 Neg := R_Vec (1) > Int_0;
2393 R_Vec (1) := abs R_Vec (1);
2394 return Vector_To_Uint (R_Vec, Neg);
2395 end;
2396 end if;
2397 end UI_Negate;
2398
2399 -------------
2400 -- UI_Rem --
2401 -------------
2402
2403 function UI_Rem (Left : Int; Right : Uint) return Uint is
2404 begin
2405 return UI_Rem (UI_From_Int (Left), Right);
2406 end UI_Rem;
2407
2408 function UI_Rem (Left : Uint; Right : Int) return Uint is
2409 begin
2410 return UI_Rem (Left, UI_From_Int (Right));
2411 end UI_Rem;
2412
2413 function UI_Rem (Left, Right : Uint) return Uint is
2414 Sign : Int;
2415 Tmp : Int;
2416
2417 subtype Int1_12 is Integer range 1 .. 12;
2418
2419 begin
2420 pragma Assert (Right /= Uint_0);
2421
2422 if Direct (Right) then
2423 if Direct (Left) then
2424 return UI_From_Int (Direct_Val (Left) rem Direct_Val (Right));
2425
2426 else
2e45500e 2427
415dddc8
RK
2428 -- Special cases when Right is less than 13 and Left is larger
2429 -- larger than one digit. All of these algorithms depend on the
2430 -- base being 2 ** 15 We work with Abs (Left) and Abs(Right)
2431 -- then multiply result by Sign (Left)
2432
2433 if (Right <= Uint_12) and then (Right >= Uint_Minus_12) then
2434
fbf5a39b 2435 if Left < Uint_0 then
415dddc8
RK
2436 Sign := -1;
2437 else
2438 Sign := 1;
2439 end if;
2440
835d23b2
RD
2441 -- All cases are listed, grouped by mathematical method It is
2442 -- not inefficient to do have this case list out of order since
2443 -- GCC sorts the cases we list.
415dddc8
RK
2444
2445 case Int1_12 (abs (Direct_Val (Right))) is
2446
2447 when 1 =>
2448 return Uint_0;
2449
835d23b2
RD
2450 -- Powers of two are simple AND's with LS Left Digit GCC
2451 -- will recognise these constants as powers of 2 and replace
2452 -- the rem with simpler operations where possible.
415dddc8 2453
9de61fcb 2454 -- Least_Sig_Digit might return Negative numbers
415dddc8
RK
2455
2456 when 2 =>
2457 return UI_From_Int (
2458 Sign * (Least_Sig_Digit (Left) mod 2));
2459
2460 when 4 =>
2461 return UI_From_Int (
2462 Sign * (Least_Sig_Digit (Left) mod 4));
2463
2464 when 8 =>
2465 return UI_From_Int (
2466 Sign * (Least_Sig_Digit (Left) mod 8));
2467
2468 -- Some number theoretical tricks:
2469
2470 -- If B Rem Right = 1 then
2471 -- Left Rem Right = Sum_Of_Digits_Base_B (Left) Rem Right
2472
2473 -- Note: 2^32 mod 3 = 1
2474
2475 when 3 =>
2476 return UI_From_Int (
2477 Sign * (Sum_Double_Digits (Left, 1) rem Int (3)));
2478
2479 -- Note: 2^15 mod 7 = 1
2480
2481 when 7 =>
2482 return UI_From_Int (
2483 Sign * (Sum_Digits (Left, 1) rem Int (7)));
2484
2485 -- Note: 2^32 mod 5 = -1
835d23b2 2486
415dddc8
RK
2487 -- Alternating sums might be negative, but rem is always
2488 -- positive hence we must use mod here.
2489
2490 when 5 =>
2491 Tmp := Sum_Double_Digits (Left, -1) mod Int (5);
2492 return UI_From_Int (Sign * Tmp);
2493
2494 -- Note: 2^15 mod 9 = -1
835d23b2 2495
415dddc8
RK
2496 -- Alternating sums might be negative, but rem is always
2497 -- positive hence we must use mod here.
2498
2499 when 9 =>
2500 Tmp := Sum_Digits (Left, -1) mod Int (9);
2501 return UI_From_Int (Sign * Tmp);
2502
2503 -- Note: 2^15 mod 11 = -1
835d23b2 2504
415dddc8
RK
2505 -- Alternating sums might be negative, but rem is always
2506 -- positive hence we must use mod here.
2507
2508 when 11 =>
2509 Tmp := Sum_Digits (Left, -1) mod Int (11);
2510 return UI_From_Int (Sign * Tmp);
2511
835d23b2
RD
2512 -- Now resort to Chinese Remainder theorem to reduce 6, 10,
2513 -- 12 to previous special cases
415dddc8 2514
835d23b2
RD
2515 -- There is no reason we could not add more cases like these
2516 -- if it proves useful.
415dddc8 2517
835d23b2
RD
2518 -- Perhaps we should go up to 16, however we have no "trick"
2519 -- for 13.
415dddc8
RK
2520
2521 -- To find u mod m we:
835d23b2 2522
415dddc8
RK
2523 -- Pick m1, m2 S.T.
2524 -- GCD(m1, m2) = 1 AND m = (m1 * m2).
835d23b2 2525
415dddc8
RK
2526 -- Next we pick (Basis) M1, M2 small S.T.
2527 -- (M1 mod m1) = (M2 mod m2) = 1 AND
2528 -- (M1 mod m2) = (M2 mod m1) = 0
2529
835d23b2
RD
2530 -- So u mod m = (u1 * M1 + u2 * M2) mod m Where u1 = (u mod
2531 -- m1) AND u2 = (u mod m2); Under typical circumstances the
2532 -- last mod m can be done with a (possible) single
2533 -- subtraction.
415dddc8
RK
2534
2535 -- m1 = 2; m2 = 3; M1 = 3; M2 = 4;
2536
2537 when 6 =>
2538 Tmp := 3 * (Least_Sig_Digit (Left) rem 2) +
2539 4 * (Sum_Double_Digits (Left, 1) rem 3);
2540 return UI_From_Int (Sign * (Tmp rem 6));
2541
2542 -- m1 = 2; m2 = 5; M1 = 5; M2 = 6;
2543
2544 when 10 =>
2545 Tmp := 5 * (Least_Sig_Digit (Left) rem 2) +
2546 6 * (Sum_Double_Digits (Left, -1) mod 5);
2547 return UI_From_Int (Sign * (Tmp rem 10));
2548
2549 -- m1 = 3; m2 = 4; M1 = 4; M2 = 9;
2550
2551 when 12 =>
2552 Tmp := 4 * (Sum_Double_Digits (Left, 1) rem 3) +
2553 9 * (Least_Sig_Digit (Left) rem 4);
2554 return UI_From_Int (Sign * (Tmp rem 12));
2555 end case;
2556
2557 end if;
2558
9de61fcb 2559 -- Else fall through to general case
415dddc8 2560
2e45500e 2561 -- The special case Length (Left) = Length (Right) = 1 in Div
415dddc8
RK
2562 -- looks slow. It uses UI_To_Int when Int should suffice. ???
2563 end if;
2564 end if;
2565
2e45500e 2566 declare
67ce0d7e
RD
2567 Remainder : Uint;
2568 Quotient : Uint;
2569 pragma Warnings (Off, Quotient);
2e45500e
TQ
2570 begin
2571 UI_Div_Rem
2572 (Left, Right, Quotient, Remainder,
2573 Discard_Quotient => True,
2574 Discard_Remainder => False);
2575 return Remainder;
2576 end;
415dddc8
RK
2577 end UI_Rem;
2578
2579 ------------
2580 -- UI_Sub --
2581 ------------
2582
2583 function UI_Sub (Left : Int; Right : Uint) return Uint is
2584 begin
2585 return UI_Add (Left, -Right);
2586 end UI_Sub;
2587
2588 function UI_Sub (Left : Uint; Right : Int) return Uint is
2589 begin
2590 return UI_Add (Left, -Right);
2591 end UI_Sub;
2592
2593 function UI_Sub (Left : Uint; Right : Uint) return Uint is
2594 begin
2595 if Direct (Left) and then Direct (Right) then
2596 return UI_From_Int (Direct_Val (Left) - Direct_Val (Right));
2597 else
2598 return UI_Add (Left, -Right);
2599 end if;
2600 end UI_Sub;
2601
82c80734
RD
2602 --------------
2603 -- UI_To_CC --
2604 --------------
2605
2606 function UI_To_CC (Input : Uint) return Char_Code is
2607 begin
2608 if Direct (Input) then
2609 return Char_Code (Direct_Val (Input));
2610
2611 -- Case of input is more than one digit
2612
2613 else
2614 declare
2615 In_Length : constant Int := N_Digits (Input);
2616 In_Vec : UI_Vector (1 .. In_Length);
2617 Ret_CC : Char_Code;
2618
2619 begin
2620 Init_Operand (Input, In_Vec);
2621
2622 -- We assume value is positive
2623
2624 Ret_CC := 0;
2625 for Idx in In_Vec'Range loop
2626 Ret_CC := Ret_CC * Char_Code (Base) +
2627 Char_Code (abs In_Vec (Idx));
2628 end loop;
2629
2630 return Ret_CC;
2631 end;
2632 end if;
2633 end UI_To_CC;
2634
415dddc8
RK
2635 ----------------
2636 -- UI_To_Int --
2637 ----------------
2638
2639 function UI_To_Int (Input : Uint) return Int is
2640 begin
2641 if Direct (Input) then
2642 return Direct_Val (Input);
2643
2644 -- Case of input is more than one digit
2645
2646 else
2647 declare
2648 In_Length : constant Int := N_Digits (Input);
2649 In_Vec : UI_Vector (1 .. In_Length);
2650 Ret_Int : Int;
2651
2652 begin
2653 -- Uints of more than one digit could be outside the range for
2654 -- Ints. Caller should have checked for this if not certain.
2655 -- Fatal error to attempt to convert from value outside Int'Range.
2656
2657 pragma Assert (UI_Is_In_Int_Range (Input));
2658
2659 -- Otherwise, proceed ahead, we are OK
2660
2661 Init_Operand (Input, In_Vec);
2662 Ret_Int := 0;
2663
835d23b2
RD
2664 -- Calculate -|Input| and then negates if value is positive. This
2665 -- handles our current definition of Int (based on 2s complement).
2666 -- Is it secure enough???
415dddc8
RK
2667
2668 for Idx in In_Vec'Range loop
2669 Ret_Int := Ret_Int * Base - abs In_Vec (Idx);
2670 end loop;
2671
2672 if In_Vec (1) < Int_0 then
2673 return Ret_Int;
2674 else
2675 return -Ret_Int;
2676 end if;
2677 end;
2678 end if;
2679 end UI_To_Int;
2680
2681 --------------
2682 -- UI_Write --
2683 --------------
2684
2685 procedure UI_Write (Input : Uint; Format : UI_Format := Auto) is
2686 begin
2687 Image_Out (Input, False, Format);
2688 end UI_Write;
2689
2690 ---------------------
2691 -- Vector_To_Uint --
2692 ---------------------
2693
2694 function Vector_To_Uint
2695 (In_Vec : UI_Vector;
2696 Negative : Boolean)
2697 return Uint
2698 is
2699 Size : Int;
2700 Val : Int;
2701
2702 begin
2703 -- The vector can contain leading zeros. These are not stored in the
2704 -- table, so loop through the vector looking for first non-zero digit
2705
2706 for J in In_Vec'Range loop
2707 if In_Vec (J) /= Int_0 then
2708
2709 -- The length of the value is the length of the rest of the vector
2710
2711 Size := In_Vec'Last - J + 1;
2712
2713 -- One digit value can always be represented directly
2714
2715 if Size = Int_1 then
2716 if Negative then
2717 return Uint (Int (Uint_Direct_Bias) - In_Vec (J));
2718 else
2719 return Uint (Int (Uint_Direct_Bias) + In_Vec (J));
2720 end if;
2721
2722 -- Positive two digit values may be in direct representation range
2723
2724 elsif Size = Int_2 and then not Negative then
2725 Val := In_Vec (J) * Base + In_Vec (J + 1);
2726
2727 if Val <= Max_Direct then
2728 return Uint (Int (Uint_Direct_Bias) + Val);
2729 end if;
2730 end if;
2731
835d23b2
RD
2732 -- The value is outside the direct representation range and must
2733 -- therefore be stored in the table. Expand the table to contain
3354f96d 2734 -- the count and digits. The index of the new table entry will be
835d23b2 2735 -- returned as the result.
415dddc8 2736
5eace9bc 2737 Uints.Append ((Length => Size, Loc => Udigits.Last + 1));
415dddc8
RK
2738
2739 if Negative then
5eace9bc 2740 Val := -In_Vec (J);
415dddc8 2741 else
5eace9bc 2742 Val := +In_Vec (J);
415dddc8
RK
2743 end if;
2744
5eace9bc
TQ
2745 Udigits.Append (Val);
2746
415dddc8 2747 for K in 2 .. Size loop
5eace9bc 2748 Udigits.Append (In_Vec (J + K - 1));
415dddc8
RK
2749 end loop;
2750
2751 return Uints.Last;
2752 end if;
2753 end loop;
2754
2755 -- Dropped through loop only if vector contained all zeros
2756
2757 return Uint_0;
2758 end Vector_To_Uint;
2759
2760end Uintp;