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