]>
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 | -- -- | |
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 | ||
32 | with Output; use Output; | |
33 | with Tree_IO; use Tree_IO; | |
34 | ||
fbf5a39b AC |
35 | with GNAT.HTable; use GNAT.HTable; |
36 | ||
415dddc8 RK |
37 | package 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 | ||
2760 | end Uintp; |