1aexcept.adb, [...]: Merge header, formatting and other trivial changes from ACT.
[platform/upstream/gcc.git] / gcc / ada / uintp.ads
1 ------------------------------------------------------------------------------
2 --                                                                          --
3 --                         GNAT COMPILER COMPONENTS                         --
4 --                                                                          --
5 --                                U I N T P                                 --
6 --                                                                          --
7 --                                 S p e c                                  --
8 --                                                                          --
9 --          Copyright (C) 1992-2002, Free Software Foundation, Inc.         --
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 2,  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.  See the GNU General Public License --
17 -- for  more details.  You should have  received  a copy of the GNU General --
18 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
19 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
20 -- MA 02111-1307, USA.                                                      --
21 --                                                                          --
22 -- As a special exception,  if other files  instantiate  generics from this --
23 -- unit, or you link  this unit with other files  to produce an executable, --
24 -- this  unit  does not  by itself cause  the resulting  executable  to  be --
25 -- covered  by the  GNU  General  Public  License.  This exception does not --
26 -- however invalidate  any other reasons why  the executable file  might be --
27 -- covered by the  GNU Public License.                                      --
28 --                                                                          --
29 -- GNAT was originally developed  by the GNAT team at  New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
31 --                                                                          --
32 ------------------------------------------------------------------------------
33
34 --  Support for universal integer arithmetic
35
36 --  WARNING: There is a C version of this package. Any changes to this
37 --  source file must be properly reflected in the C header file sinfo.h
38
39 with Alloc;
40 with Table;
41 pragma Elaborate_All (Table);
42 with Types; use Types;
43
44 package Uintp is
45
46    -------------------------------------------------
47    -- Basic Types and Constants for Uintp Package --
48    -------------------------------------------------
49
50    type Uint is private;
51    --  The basic universal integer type
52
53    No_Uint : constant Uint;
54    --  A constant value indicating a missing or unset Uint value
55
56    Uint_0   : constant Uint;
57    Uint_1   : constant Uint;
58    Uint_2   : constant Uint;
59    Uint_3   : constant Uint;
60    Uint_4   : constant Uint;
61    Uint_5   : constant Uint;
62    Uint_6   : constant Uint;
63    Uint_7   : constant Uint;
64    Uint_8   : constant Uint;
65    Uint_9   : constant Uint;
66    Uint_10  : constant Uint;
67    Uint_12  : constant Uint;
68    Uint_15  : constant Uint;
69    Uint_16  : constant Uint;
70    Uint_24  : constant Uint;
71    Uint_32  : constant Uint;
72    Uint_63  : constant Uint;
73    Uint_64  : constant Uint;
74    Uint_128 : constant Uint;
75
76    Uint_Minus_1   : constant Uint;
77    Uint_Minus_2   : constant Uint;
78    Uint_Minus_3   : constant Uint;
79    Uint_Minus_4   : constant Uint;
80    Uint_Minus_5   : constant Uint;
81    Uint_Minus_6   : constant Uint;
82    Uint_Minus_7   : constant Uint;
83    Uint_Minus_8   : constant Uint;
84    Uint_Minus_9   : constant Uint;
85    Uint_Minus_12  : constant Uint;
86    Uint_Minus_128 : constant Uint;
87
88    -----------------
89    -- Subprograms --
90    -----------------
91
92    procedure Initialize;
93    --  Initialize Uint tables. Note that Initialize must not be called if
94    --  Tree_Read is used. Note also that there is no lock routine in this
95    --  unit, these are among the few tables that can be expanded during
96    --  gigi processing.
97
98    procedure Tree_Read;
99    --  Initializes internal tables from current tree file using Tree_Read.
100    --  Note that Initialize should not be called if Tree_Read is used.
101    --  Tree_Read includes all necessary initialization.
102
103    procedure Tree_Write;
104    --  Writes out internal tables to current tree file using Tree_Write.
105
106    function UI_Abs (Right : Uint) return Uint;
107    pragma Inline (UI_Abs);
108    --  Returns abs function of universal integer.
109
110    function UI_Add (Left : Uint; Right : Uint) return Uint;
111    function UI_Add (Left : Int;  Right : Uint) return Uint;
112    function UI_Add (Left : Uint; Right : Int)  return Uint;
113    --  Returns sum of two integer values.
114
115    function UI_Decimal_Digits_Hi (U : Uint) return Nat;
116    --  Returns an estimate of the number of decimal digits required to
117    --  represent the absolute value of U. This estimate is correct or high,
118    --  i.e. it never returns a value that is too low. The accuracy of the
119    --  estimate affects only the effectiveness of comparison optimizations
120    --  in Urealp.
121
122    function UI_Decimal_Digits_Lo (U : Uint) return Nat;
123    --  Returns an estimate of the number of decimal digits required to
124    --  represent the absolute value of U. This estimate is correct or low,
125    --  i.e. it never returns a value that is too high. The accuracy of the
126    --  estimate affects only the effectiveness of comparison optimizations
127    --  in Urealp.
128
129    function UI_Div (Left : Uint; Right : Uint) return Uint;
130    function UI_Div (Left : Int;  Right : Uint) return Uint;
131    function UI_Div (Left : Uint; Right : Int)  return Uint;
132    --  Returns quotient of two integer values. Fatal error if Right = 0
133
134    function UI_Eq (Left : Uint; Right : Uint) return Boolean;
135    function UI_Eq (Left : Int;  Right : Uint) return Boolean;
136    function UI_Eq (Left : Uint; Right : Int)  return Boolean;
137    pragma Inline (UI_Eq);
138    --  Compares integer values for equality.
139
140    function UI_Expon (Left : Uint; Right : Uint) return Uint;
141    function UI_Expon (Left : Int;  Right : Uint) return Uint;
142    function UI_Expon (Left : Uint; Right : Int)  return Uint;
143    function UI_Expon (Left : Int;  Right : Int)  return Uint;
144    --  Returns result of exponentiating two integer values
145    --  Fatal error if Right is negative.
146
147    function UI_GCD (Uin, Vin : Uint) return Uint;
148    --  Computes GCD of input values. Assumes Uin >= Vin >= 0.
149
150    function UI_Ge (Left : Uint; Right : Uint) return Boolean;
151    function UI_Ge (Left : Int;  Right : Uint) return Boolean;
152    function UI_Ge (Left : Uint; Right : Int)  return Boolean;
153    pragma Inline (UI_Ge);
154    --  Compares integer values for greater than or equal.
155
156    function UI_Gt (Left : Uint; Right : Uint) return Boolean;
157    function UI_Gt (Left : Int;  Right : Uint) return Boolean;
158    function UI_Gt (Left : Uint; Right : Int)  return Boolean;
159    pragma Inline (UI_Gt);
160    --  Compares integer values for greater than.
161
162    function UI_Is_In_Int_Range (Input : Uint) return Boolean;
163    pragma Inline (UI_Is_In_Int_Range);
164    --  Determines if universal integer is in Int range.
165
166    function UI_Le (Left : Uint; Right : Uint) return Boolean;
167    function UI_Le (Left : Int;  Right : Uint) return Boolean;
168    function UI_Le (Left : Uint; Right : Int)  return Boolean;
169    pragma Inline (UI_Le);
170    --  Compares integer values for less than or equal.
171
172    function UI_Lt (Left : Uint; Right : Uint) return Boolean;
173    function UI_Lt (Left : Int;  Right : Uint) return Boolean;
174    function UI_Lt (Left : Uint; Right : Int)  return Boolean;
175    --  Compares integer values for less than.
176
177    function UI_Max (Left : Uint; Right : Uint) return Uint;
178    function UI_Max (Left : Int;  Right : Uint) return Uint;
179    function UI_Max (Left : Uint; Right : Int)  return Uint;
180    --  Returns maximum of two integer values
181
182    function UI_Min (Left : Uint; Right : Uint) return Uint;
183    function UI_Min (Left : Int;  Right : Uint) return Uint;
184    function UI_Min (Left : Uint; Right : Int)  return Uint;
185    --  Returns minimum of two integer values.
186
187    function UI_Mod (Left : Uint; Right : Uint) return Uint;
188    function UI_Mod (Left : Int;  Right : Uint) return Uint;
189    function UI_Mod (Left : Uint; Right : Int)  return Uint;
190    pragma Inline (UI_Mod);
191    --  Returns mod function of two integer values.
192
193    function UI_Mul (Left : Uint; Right : Uint) return Uint;
194    function UI_Mul (Left : Int;  Right : Uint) return Uint;
195    function UI_Mul (Left : Uint; Right : Int)  return Uint;
196    --  Returns product of two integer values
197
198    function UI_Ne (Left : Uint; Right : Uint) return Boolean;
199    function UI_Ne (Left : Int;  Right : Uint) return Boolean;
200    function UI_Ne (Left : Uint; Right : Int)  return Boolean;
201    pragma Inline (UI_Ne);
202    --  Compares integer values for inequality.
203
204    function UI_Negate (Right : Uint) return Uint;
205    pragma Inline (UI_Negate);
206    --  Returns negative of universal integer.
207
208    function UI_Rem (Left : Uint; Right : Uint) return Uint;
209    function UI_Rem (Left : Int;  Right : Uint) return Uint;
210    function UI_Rem (Left : Uint; Right : Int)  return Uint;
211    --  Returns rem of two integer values.
212
213    function UI_Sub (Left : Uint; Right : Uint) return Uint;
214    function UI_Sub (Left : Int;  Right : Uint) return Uint;
215    function UI_Sub (Left : Uint; Right : Int)  return Uint;
216    pragma Inline (UI_Sub);
217    --  Returns difference of two integer values
218
219    function UI_From_Dint (Input : Dint) return Uint;
220    --  Converts Dint value to universal integer form.
221
222    function UI_From_Int (Input : Int) return Uint;
223    --  Converts Int value to universal integer form.
224
225    function UI_To_Int (Input : Uint) return Int;
226    --  Converts universal integer value to Int. Fatal error
227    --  if value is not in appropriate range.
228
229    function Num_Bits (Input : Uint) return Nat;
230    --  Approximate number of binary bits in given universal integer.
231    --  This function is used for capacity checks, and it can be one
232    --  bit off without affecting its usage.
233
234    ---------------------
235    -- Output Routines --
236    ---------------------
237
238    type UI_Format is (Hex, Decimal, Auto);
239    --  Used to determine whether UI_Image/UI_Write output is in hexadecimal
240    --  or decimal format. Auto, the default setting, lets the routine make
241    --  a decision based on the value.
242
243    UI_Image_Max    : constant := 32;
244    UI_Image_Buffer : String (1 .. UI_Image_Max);
245    UI_Image_Length : Natural;
246    --  Buffer used for UI_Image as described below
247
248    procedure UI_Image (Input : Uint; Format : UI_Format := Auto);
249    --  Places a representation of Uint, consisting of a possible minus sign,
250    --  followed by the value in UI_Image_Buffer. The form of the value is an
251    --  integer literal in either decimal (no base) or hexadecimal (base 16)
252    --  format. If Hex is True on entry, then hex mode is forced, otherwise
253    --  UI_Image makes a guess at which output format is more convenient. The
254    --  value must fit in UI_Image_Buffer. If necessary, the result is an
255    --  approximation of the proper value, using an exponential format. The
256    --  image of No_Uint is output as a single question mark.
257
258    procedure UI_Write (Input : Uint; Format : UI_Format := Auto);
259    --  Writes a representation of Uint, consisting of a possible minus sign,
260    --  followed by the value to the output file. The form of the value is an
261    --  integer literal in either decimal (no base) or hexadecimal (base 16)
262    --  format as appropriate. UI_Format shows which format to use. Auto,
263    --  the default, asks UI_Write to make a guess at which output format
264    --  will be more convenient to read.
265
266    procedure pid (Input : Uint);
267    pragma Export (Ada, pid);
268    --  Writes representation of Uint in decimal with a terminating line
269    --  return. This is intended for use from the debugger.
270
271    procedure pih (Input : Uint);
272    pragma Export (Ada, pih);
273    --  Writes representation of Uint in hex with a terminating line return.
274    --  This is intended for use from the debugger.
275
276    ------------------------
277    -- Operator Renamings --
278    ------------------------
279
280    function "+" (Left : Uint; Right : Uint) return Uint renames UI_Add;
281    function "+" (Left : Int;  Right : Uint) return Uint renames UI_Add;
282    function "+" (Left : Uint; Right : Int)  return Uint renames UI_Add;
283
284    function "/" (Left : Uint; Right : Uint) return Uint renames UI_Div;
285    function "/" (Left : Int;  Right : Uint) return Uint renames UI_Div;
286    function "/" (Left : Uint; Right : Int)  return Uint renames UI_Div;
287
288    function "*" (Left : Uint; Right : Uint) return Uint renames UI_Mul;
289    function "*" (Left : Int;  Right : Uint) return Uint renames UI_Mul;
290    function "*" (Left : Uint; Right : Int)  return Uint renames UI_Mul;
291
292    function "-" (Left : Uint; Right : Uint) return Uint renames UI_Sub;
293    function "-" (Left : Int;  Right : Uint) return Uint renames UI_Sub;
294    function "-" (Left : Uint; Right : Int)  return Uint renames UI_Sub;
295
296    function "**"  (Left : Uint; Right : Uint) return Uint renames UI_Expon;
297    function "**"  (Left : Uint; Right : Int)  return Uint renames UI_Expon;
298    function "**"  (Left : Int;  Right : Uint) return Uint renames UI_Expon;
299    function "**"  (Left : Int;  Right : Int)  return Uint renames UI_Expon;
300
301    function "abs" (Real : Uint) return Uint renames UI_Abs;
302
303    function "mod" (Left : Uint; Right : Uint) return Uint renames UI_Mod;
304    function "mod" (Left : Int;  Right : Uint) return Uint renames UI_Mod;
305    function "mod" (Left : Uint; Right : Int)  return Uint renames UI_Mod;
306
307    function "rem" (Left : Uint; Right : Uint) return Uint renames UI_Rem;
308    function "rem" (Left : Int;  Right : Uint) return Uint renames UI_Rem;
309    function "rem" (Left : Uint; Right : Int)  return Uint renames UI_Rem;
310
311    function "-"   (Real : Uint) return Uint renames UI_Negate;
312
313    function "="   (Left : Uint; Right : Uint) return Boolean renames UI_Eq;
314    function "="   (Left : Int;  Right : Uint) return Boolean renames UI_Eq;
315    function "="   (Left : Uint; Right : Int)  return Boolean renames UI_Eq;
316
317    function ">="  (Left : Uint; Right : Uint) return Boolean renames UI_Ge;
318    function ">="  (Left : Int;  Right : Uint) return Boolean renames UI_Ge;
319    function ">="  (Left : Uint; Right : Int)  return Boolean renames UI_Ge;
320
321    function ">"   (Left : Uint; Right : Uint) return Boolean renames UI_Gt;
322    function ">"   (Left : Int;  Right : Uint) return Boolean renames UI_Gt;
323    function ">"   (Left : Uint; Right : Int)  return Boolean renames UI_Gt;
324
325    function "<="  (Left : Uint; Right : Uint) return Boolean renames UI_Le;
326    function "<="  (Left : Int;  Right : Uint) return Boolean renames UI_Le;
327    function "<="  (Left : Uint; Right : Int)  return Boolean renames UI_Le;
328
329    function "<"   (Left : Uint; Right : Uint) return Boolean renames UI_Lt;
330    function "<"   (Left : Int;  Right : Uint) return Boolean renames UI_Lt;
331    function "<"   (Left : Uint; Right : Int)  return Boolean renames UI_Lt;
332
333    -----------------------------
334    -- Mark/Release Processing --
335    -----------------------------
336
337    --  The space used by Uint data is not automatically reclaimed. However,
338    --  a mark-release regime is implemented which allows storage to be
339    --  released back to a previously noted mark. This is used for example
340    --  when doing comparisons, where only intermediate results get stored
341    --  that do not need to be saved for future use.
342
343    type Save_Mark is private;
344
345    function Mark return Save_Mark;
346    --  Note mark point for future release
347
348    procedure Release (M : Save_Mark);
349    --  Release storage allocated since mark was noted
350
351    procedure Release_And_Save (M : Save_Mark; UI : in out Uint);
352    --  Like Release, except that the given Uint value (which is typically
353    --  among the data being released) is recopied after the release, so
354    --  that it is the most recent item, and UI is updated to point to
355    --  its copied location.
356
357    procedure Release_And_Save (M : Save_Mark; UI1, UI2 : in out Uint);
358    --  Like Release, except that the given Uint values (which are typically
359    --  among the data being released) are recopied after the release, so
360    --  that they are the most recent items, and UI1 and UI2 are updated if
361    --  necessary to point to the copied locations. This routine is careful
362    --  to do things in the right order, so that the values do not clobber
363    --  one another.
364
365    -----------------------------------
366    -- Representation of Uint Values --
367    -----------------------------------
368
369 private
370
371    type Uint is new Int range Uint_Low_Bound .. Uint_High_Bound;
372    for Uint'Size use 32;
373
374    No_Uint : constant Uint := Uint (Uint_Low_Bound);
375
376    --  Uint values are represented as multiple precision integers stored in
377    --  a multi-digit format using Base as the base. This value is chosen so
378    --  that the product Base*Base is within the range of allowed Int values.
379
380    --  Base is defined to allow efficient execution of the primitive
381    --  operations (a0, b0, c0) defined in the section "The Classical
382    --  Algorithms" (sec. 4.3.1) of Donald Knuth's "The Art of Computer
383    --  Programming", Vol. 2. These algorithms are used in this package.
384
385    Base_Bits : constant := 15;
386    --  Number of bits in base value
387
388    Base : constant Int := 2 ** Base_Bits;
389
390    --  Values in the range -(Base+1) .. maxdirect are encoded directly as
391    --  Uint values by adding a bias value. The value of maxdirect is chosen
392    --  so that a directly represented number always fits in two digits when
393    --  represented in base format.
394
395    Min_Direct : constant Int := -(Base - 1);
396    Max_Direct : constant Int := (Base - 1) * (Base - 1);
397
398    --  The following values define the bias used to store Uint values which
399    --  are in this range, as well as the biased values for the first and
400    --  last values in this range. We use a new derived type for these
401    --  constants to avoid accidental use of Uint arithmetic on these
402    --  values, which is never correct.
403
404    type Ctrl is range Int'First .. Int'Last;
405
406    Uint_Direct_Bias  : constant Ctrl := Ctrl (Uint_Low_Bound) + Ctrl (Base);
407    Uint_Direct_First : constant Ctrl := Uint_Direct_Bias + Ctrl (Min_Direct);
408    Uint_Direct_Last  : constant Ctrl := Uint_Direct_Bias + Ctrl (Max_Direct);
409
410    Uint_0   : constant Uint := Uint (Uint_Direct_Bias);
411    Uint_1   : constant Uint := Uint (Uint_Direct_Bias + 1);
412    Uint_2   : constant Uint := Uint (Uint_Direct_Bias + 2);
413    Uint_3   : constant Uint := Uint (Uint_Direct_Bias + 3);
414    Uint_4   : constant Uint := Uint (Uint_Direct_Bias + 4);
415    Uint_5   : constant Uint := Uint (Uint_Direct_Bias + 5);
416    Uint_6   : constant Uint := Uint (Uint_Direct_Bias + 6);
417    Uint_7   : constant Uint := Uint (Uint_Direct_Bias + 7);
418    Uint_8   : constant Uint := Uint (Uint_Direct_Bias + 8);
419    Uint_9   : constant Uint := Uint (Uint_Direct_Bias + 9);
420    Uint_10  : constant Uint := Uint (Uint_Direct_Bias + 10);
421    Uint_12  : constant Uint := Uint (Uint_Direct_Bias + 12);
422    Uint_15  : constant Uint := Uint (Uint_Direct_Bias + 15);
423    Uint_16  : constant Uint := Uint (Uint_Direct_Bias + 16);
424    Uint_24  : constant Uint := Uint (Uint_Direct_Bias + 24);
425    Uint_32  : constant Uint := Uint (Uint_Direct_Bias + 32);
426    Uint_63  : constant Uint := Uint (Uint_Direct_Bias + 63);
427    Uint_64  : constant Uint := Uint (Uint_Direct_Bias + 64);
428    Uint_128 : constant Uint := Uint (Uint_Direct_Bias + 128);
429
430    Uint_Minus_1   : constant Uint := Uint (Uint_Direct_Bias - 1);
431    Uint_Minus_2   : constant Uint := Uint (Uint_Direct_Bias - 2);
432    Uint_Minus_3   : constant Uint := Uint (Uint_Direct_Bias - 3);
433    Uint_Minus_4   : constant Uint := Uint (Uint_Direct_Bias - 4);
434    Uint_Minus_5   : constant Uint := Uint (Uint_Direct_Bias - 5);
435    Uint_Minus_6   : constant Uint := Uint (Uint_Direct_Bias - 6);
436    Uint_Minus_7   : constant Uint := Uint (Uint_Direct_Bias - 7);
437    Uint_Minus_8   : constant Uint := Uint (Uint_Direct_Bias - 8);
438    Uint_Minus_9   : constant Uint := Uint (Uint_Direct_Bias - 9);
439    Uint_Minus_12  : constant Uint := Uint (Uint_Direct_Bias - 12);
440    Uint_Minus_128 : constant Uint := Uint (Uint_Direct_Bias - 128);
441
442    type Save_Mark is record
443       Save_Uint   : Uint;
444       Save_Udigit : Int;
445    end record;
446
447    --  Values outside the range that is represented directly are stored
448    --  using two tables. The secondary table Udigits contains sequences of
449    --  Int values consisting of the digits of the number in a radix Base
450    --  system. The digits are stored from most significant to least
451    --  significant with the first digit only carrying the sign.
452
453    --  There is one entry in the primary Uints table for each distinct Uint
454    --  value. This table entry contains the length (number of digits) and
455    --  a starting offset of the value in the Udigits table.
456
457    Uint_First_Entry : constant Uint := Uint (Uint_Table_Start);
458
459    --  Some subprograms defined in this package manipulate the Udigits
460    --  table directly, while for others it is more convenient to work with
461    --  locally defined arrays of the digits of the Universal Integers.
462    --  The type UI_Vector is defined for this purpose and some internal
463    --  subprograms used for converting from one to the other are defined.
464
465    type UI_Vector is array (Pos range <>) of Int;
466    --  Vector containing the integer values of a Uint value
467
468    --  Note: An earlier version of this package used pointers of arrays
469    --  of Ints (dynamically allocated) for the Uint type. The change
470    --  leads to a few less natural idioms used throughout this code, but
471    --  eliminates all uses of the heap except for the table package itself.
472    --  For example, Uint parameters are often converted to UI_Vectors for
473    --  internal manipulation. This is done by creating the local UI_Vector
474    --  using the function N_Digits on the Uint to find the size needed for
475    --  the vector, and then calling Init_Operand to copy the values out
476    --  of the table into the vector.
477
478    type Uint_Entry is record
479       Length : Pos;
480       --  Length of entry in Udigits table in digits (i.e. in words)
481
482       Loc : Int;
483       --  Starting location in Udigits table of this Uint value
484    end record;
485
486    package Uints is new Table.Table (
487      Table_Component_Type => Uint_Entry,
488      Table_Index_Type     => Uint,
489      Table_Low_Bound      => Uint_First_Entry,
490      Table_Initial        => Alloc.Uints_Initial,
491      Table_Increment      => Alloc.Uints_Increment,
492      Table_Name           => "Uints");
493
494    package Udigits is new Table.Table (
495      Table_Component_Type => Int,
496      Table_Index_Type     => Int,
497      Table_Low_Bound      => 0,
498      Table_Initial        => Alloc.Udigits_Initial,
499      Table_Increment      => Alloc.Udigits_Increment,
500      Table_Name           => "Udigits");
501
502    --  Note: the reason these tables are defined here in the private part of
503    --  the spec, rather than in the body, is that they are refrerenced
504    --  directly by gigi.
505
506 end Uintp;