gcc/ada/libgnat/g-dyntab.ads

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                   G N A T . D Y N A M I C _ T A B L E S                  --
   6 --                                                                          --
   7 --                                 S p e c                                  --
   8 --                                                                          --
   9 --                     Copyright (C) 2000-2023, AdaCore                     --
  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 --  Resizable one dimensional array support
  33
  34 --  This package provides an implementation of dynamically resizable one
  35 --  dimensional arrays. The idea is to mimic the normal Ada semantics for
  36 --  arrays as closely as possible with the one additional capability of
  37 --  dynamically modifying the value of the Last attribute.
  38
  39 --  This package provides a facility similar to that of Ada.Containers.Vectors.
  40
  41 --  Note that these three interfaces should remain synchronized to keep as much
  42 --  coherency as possible among these related units:
  43 --
  44 --     GNAT.Dynamic_Tables
  45 --     GNAT.Table
  46 --     Table (the compiler unit)
  47
  48 --  Note: this unit is used during bootstrap, see ADA_GENERATED_FILES in
  49 --  gcc-interface/Make-lang.in for details on the constraints.
  50
  51 with Ada.Unchecked_Conversion;
  52
  53 generic
  54    type Table_Component_Type is private;
  55    type Table_Index_Type     is range <>;
  56
  57    Table_Low_Bound   : Table_Index_Type := Table_Index_Type'First;
  58    Table_Initial     : Positive := 8;
  59    Table_Increment   : Natural := 100;
  60    Release_Threshold : Natural := 0; -- size in bytes
  61
  62 package GNAT.Dynamic_Tables is
  63
  64    --  Table_Component_Type and Table_Index_Type specify the type of the array,
  65    --  Table_Low_Bound is the lower bound. The effect is roughly to declare:
  66
  67    --    Table : array (Table_Low_Bound .. <>) of Table_Component_Type;
  68
  69    --  The lower bound of Table_Index_Type is ignored.
  70
  71    --  Table_Component_Type must not be a type with controlled parts.
  72
  73    --  The Table_Initial value controls the allocation of the table when it is
  74    --  first allocated.
  75
  76    --  The Table_Increment value controls the amount of increase, if the table
  77    --  has to be increased in size. The value given is a percentage value (e.g.
  78    --  100 = increase table size by 100%, i.e. double it).
  79
  80    --  The Last and Set_Last subprograms provide control over the current
  81    --  logical allocation. They are quite efficient, so they can be used
  82    --  freely (expensive reallocation occurs only at major granularity
  83    --  chunks controlled by the allocation parameters).
  84
  85    --  WARNING: On HPPA, the virtual addressing approach used in this unit is
  86    --  incompatible with the indexing instructions on the HPPA. So when using
  87    --  this unit, compile your application with -mdisable-indexing.
  88
  89    --  WARNING: If the table is reallocated, then the address of all its
  90    --  components will change. So do not capture the address of an element
  91    --  and then use the address later after the table may be reallocated. One
  92    --  tricky case of this is passing an element of the table to a subprogram
  93    --  by reference where the table gets reallocated during the execution of
  94    --  the subprogram. The best rule to follow is never to pass a table element
  95    --  as a parameter except for the case of IN mode parameters with scalar
  96    --  values.
  97
  98    pragma Assert (Table_Low_Bound /= Table_Index_Type'Base'First);
  99
 100    subtype Valid_Table_Index_Type is Table_Index_Type'Base
 101      range Table_Low_Bound .. Table_Index_Type'Base'Last;
 102    subtype Table_Last_Type is Table_Index_Type'Base
 103      range Table_Low_Bound - 1 .. Table_Index_Type'Base'Last;
 104
 105    --  Table_Component_Type must not be a type with controlled parts.
 106
 107    --  The Table_Initial value controls the allocation of the table when it is
 108    --  first allocated.
 109
 110    --  The Table_Increment value controls the amount of increase, if the table
 111    --  has to be increased in size. The value given is a percentage value (e.g.
 112    --  100 = increase table size by 100%, i.e. double it).
 113
 114    --  The Last and Set_Last subprograms provide control over the current
 115    --  logical allocation. They are quite efficient, so they can be used
 116    --  freely (expensive reallocation occurs only at major granularity
 117    --  chunks controlled by the allocation parameters).
 118
 119    --  Note: For backward compatibility we do not make the table components
 120    --  aliased, since for Ada 95 this would have restricted the use of tables
 121    --  for discriminated types. If it is necessary to take the access of a
 122    --  table element, use Unrestricted_Access.
 123
 124    type Table_Type is
 125      array (Valid_Table_Index_Type range <>) of Table_Component_Type;
 126    subtype Big_Table_Type is
 127      Table_Type (Table_Low_Bound .. Valid_Table_Index_Type'Last);
 128    --  We work with pointers to a bogus array type that is constrained with
 129    --  the maximum possible range bound. This means that the pointer is a thin
 130    --  pointer, which is more efficient. Since subscript checks in any case
 131    --  must be on the logical, rather than physical bounds, safety is not
 132    --  compromised by this approach.
 133
 134    --  To get subscript checking, rename a slice of the Table, like this:
 135
 136    --     Table : Table_Type renames T.Table (First .. Last (T));
 137
 138    --  and then refer to components of Table.
 139
 140    type Table_Ptr is access all Big_Table_Type;
 141    for Table_Ptr'Storage_Size use 0;
 142    --  The table is actually represented as a pointer to allow reallocation
 143
 144    type Table_Private is private;
 145    --  Table private data that is not exported in Instance
 146
 147    --  Private use only:
 148    subtype Empty_Table_Array_Type is
 149      Table_Type (Table_Low_Bound .. Table_Low_Bound - 1);
 150    type Empty_Table_Array_Ptr is access all Empty_Table_Array_Type;
 151    Empty_Table_Array : aliased Empty_Table_Array_Type;
 152    function Empty_Table_Array_Ptr_To_Table_Ptr is
 153      new Ada.Unchecked_Conversion (Empty_Table_Array_Ptr, Table_Ptr);
 154    Empty_Table_Ptr : constant Table_Ptr :=
 155              Empty_Table_Array_Ptr_To_Table_Ptr (Empty_Table_Array'Access);
 156    --  End private use only. The above are used to initialize Table to point to
 157    --  an empty array.
 158
 159    type Instance is record
 160       Table : Table_Ptr := Empty_Table_Ptr;
 161       --  The table itself. The lower bound is the value of First. Logically
 162       --  the upper bound is the current value of Last (although the actual
 163       --  size of the allocated table may be larger than this). The program may
 164       --  only access and modify Table entries in the range First .. Last.
 165       --
 166       --  It's a good idea to access this via a renaming of a slice, in order
 167       --  to ensure bounds checking, as in:
 168       --
 169       --     Tab : Table_Type renames X.Table (First .. X.Last);
 170       --
 171       --  Note: The Table component must come first. See declarations of
 172       --  SCO_Unit_Table and SCO_Table in scos.h.
 173
 174       Locked : Boolean := False;
 175       --  Table reallocation is permitted only if this is False. A client may
 176       --  set Locked to True, in which case any operation that might expand or
 177       --  shrink the table will cause an assertion failure. While a table is
 178       --  locked, its address in memory remains fixed and unchanging.
 179
 180       P : Table_Private;
 181    end record;
 182
 183    function Is_Empty (T : Instance) return Boolean;
 184    pragma Inline (Is_Empty);
 185
 186    procedure Init (T : in out Instance);
 187    --  Reinitializes the table to empty. There is no need to call this before
 188    --  using a table; tables default to empty.
 189
 190    procedure Free (T : in out Instance) renames Init;
 191
 192    function First return Table_Index_Type;
 193    pragma Inline (First);
 194    --  Export First as synonym for Table_Low_Bound (parallel with use of Last)
 195
 196    function Last (T : Instance) return Table_Last_Type;
 197    pragma Inline (Last);
 198    --  Returns the current value of the last used entry in the table, which can
 199    --  then be used as a subscript for Table.
 200
 201    procedure Release (T : in out Instance);
 202    --  Storage is allocated in chunks according to the values given in the
 203    --  Table_Initial and Table_Increment parameters. If Release_Threshold is
 204    --  0 or the length of the table does not exceed this threshold then a call
 205    --  to Release releases all storage that is allocated, but is not logically
 206    --  part of the current array value; otherwise the call to Release leaves
 207    --  the current array value plus 0.1% of the current table length free
 208    --  elements located at the end of the table. This parameter facilitates
 209    --  reopening large tables and adding a few elements without allocating a
 210    --  chunk of memory. In both cases current array values are not affected by
 211    --  this call.
 212
 213    procedure Set_Last (T : in out Instance; New_Val : Table_Last_Type);
 214    pragma Inline (Set_Last);
 215    --  This procedure sets Last to the indicated value. If necessary the table
 216    --  is reallocated to accommodate the new value (i.e. on return the
 217    --  allocated table has an upper bound of at least Last). If Set_Last
 218    --  reduces the size of the table, then logically entries are removed from
 219    --  the table. If Set_Last increases the size of the table, then new entries
 220    --  are logically added to the table.
 221
 222    procedure Increment_Last (T : in out Instance);
 223    pragma Inline (Increment_Last);
 224    --  Adds 1 to Last (same as Set_Last (Last + 1))
 225
 226    procedure Decrement_Last (T : in out Instance);
 227    pragma Inline (Decrement_Last);
 228    --  Subtracts 1 from Last (same as Set_Last (Last - 1))
 229
 230    procedure Append (T : in out Instance; New_Val : Table_Component_Type);
 231    pragma Inline (Append);
 232    --  Appends New_Val onto the end of the table
 233    --  Equivalent to:
 234    --    Increment_Last (T);
 235    --    T.Table (T.Last) := New_Val;
 236
 237    procedure Append_All (T : in out Instance; New_Vals : Table_Type);
 238    --  Appends all components of New_Vals
 239
 240    procedure Set_Item
 241      (T     : in out Instance;
 242       Index : Valid_Table_Index_Type;
 243       Item  : Table_Component_Type);
 244    pragma Inline (Set_Item);
 245    --  Put Item in the table at position Index. If Index points to an existing
 246    --  item (i.e. it is in the range First .. Last (T)), the item is replaced.
 247    --  Otherwise (i.e. Index > Last (T)), the table is expanded, and Last is
 248    --  set to Index.
 249
 250    procedure Move (From, To : in out Instance);
 251    --  Moves from From to To, and sets From to empty
 252
 253    procedure Allocate (T : in out Instance; Num : Integer := 1);
 254    pragma Inline (Allocate);
 255    --  Adds Num to Last
 256
 257    generic
 258      with procedure Action
 259        (Index : Valid_Table_Index_Type;
 260         Item  : Table_Component_Type;
 261         Quit  : in out Boolean) is <>;
 262    procedure For_Each (Table : Instance);
 263    --  Calls procedure Action for each component of the table, or until one of
 264    --  these calls set Quit to True.
 265
 266    generic
 267      with function Lt (Comp1, Comp2 : Table_Component_Type) return Boolean;
 268    procedure Sort_Table (Table : in out Instance);
 269    --  This procedure sorts the components of the table into ascending order
 270    --  making calls to Lt to do required comparisons, and using assignments
 271    --  to move components around. The Lt function returns True if Comp1 is
 272    --  less than Comp2 (in the sense of the desired sort), and False if Comp1
 273    --  is greater than Comp2. For equal objects it does not matter if True or
 274    --  False is returned (it is slightly more efficient to return False). The
 275    --  sort is not stable (the order of equal items in the table is not
 276    --  preserved).
 277
 278 private
 279
 280    type Table_Private is record
 281       Last_Allocated : Table_Last_Type := Table_Low_Bound - 1;
 282       --  Subscript of the maximum entry in the currently allocated table.
 283       --  Initial value ensures that we initially allocate the table.
 284
 285       Last : Table_Last_Type := Table_Low_Bound - 1;
 286       --  Current value of Last function
 287
 288       --  Invariant: Last <= Last_Allocated
 289    end record;
 290
 291 end GNAT.Dynamic_Tables;