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