diff gcc/ada/libgnat/g-dyntab.ads @ 111:04ced10e8804

gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children 84e7813d76e9
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gcc/ada/libgnat/g-dyntab.ads	Fri Oct 27 22:46:09 2017 +0900
@@ -0,0 +1,293 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                   G N A T . D Y N A M I C _ T A B L E S                  --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                     Copyright (C) 2000-2017, AdaCore                     --
+--                                                                          --
+-- GNAT is free software;  you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  Resizable one dimensional array support
+
+--  This package provides an implementation of dynamically resizable one
+--  dimensional arrays. The idea is to mimic the normal Ada semantics for
+--  arrays as closely as possible with the one additional capability of
+--  dynamically modifying the value of the Last attribute.
+
+--  This package provides a facility similar to that of Ada.Containers.Vectors.
+
+--  Note that these three interfaces should remain synchronized to keep as much
+--  coherency as possible among these related units:
+--
+--     GNAT.Dynamic_Tables
+--     GNAT.Table
+--     Table (the compiler unit)
+
+pragma Compiler_Unit_Warning;
+
+with Ada.Unchecked_Conversion;
+
+generic
+   type Table_Component_Type is private;
+   type Table_Index_Type     is range <>;
+
+   Table_Low_Bound   : Table_Index_Type := Table_Index_Type'First;
+   Table_Initial     : Positive := 8;
+   Table_Increment   : Natural := 100;
+   Release_Threshold : Natural := 0; -- size in bytes
+
+package GNAT.Dynamic_Tables is
+
+   --  Table_Component_Type and Table_Index_Type specify the type of the array,
+   --  Table_Low_Bound is the lower bound. The effect is roughly to declare:
+
+   --    Table : array (Table_Low_Bound .. <>) of Table_Component_Type;
+
+   --  The lower bound of Table_Index_Type is ignored.
+
+   --  Table_Component_Type must not be a type with controlled parts.
+
+   --  The Table_Initial value controls the allocation of the table when it is
+   --  first allocated.
+
+   --  The Table_Increment value controls the amount of increase, if the table
+   --  has to be increased in size. The value given is a percentage value (e.g.
+   --  100 = increase table size by 100%, i.e. double it).
+
+   --  The Last and Set_Last subprograms provide control over the current
+   --  logical allocation. They are quite efficient, so they can be used
+   --  freely (expensive reallocation occurs only at major granularity
+   --  chunks controlled by the allocation parameters).
+
+   --  Note: we do not make the table components aliased, since this would
+   --  restrict the use of table for discriminated types. If it is necessary
+   --  to take the access of a table element, use Unrestricted_Access.
+
+   --  WARNING: On HPPA, the virtual addressing approach used in this unit is
+   --  incompatible with the indexing instructions on the HPPA. So when using
+   --  this unit, compile your application with -mdisable-indexing.
+
+   --  WARNING: If the table is reallocated, then the address of all its
+   --  components will change. So do not capture the address of an element
+   --  and then use the address later after the table may be reallocated. One
+   --  tricky case of this is passing an element of the table to a subprogram
+   --  by reference where the table gets reallocated during the execution of
+   --  the subprogram. The best rule to follow is never to pass a table element
+   --  as a parameter except for the case of IN mode parameters with scalar
+   --  values.
+
+   pragma Assert (Table_Low_Bound /= Table_Index_Type'Base'First);
+
+   subtype Valid_Table_Index_Type is Table_Index_Type'Base
+     range Table_Low_Bound .. Table_Index_Type'Base'Last;
+   subtype Table_Last_Type is Table_Index_Type'Base
+     range Table_Low_Bound - 1 .. Table_Index_Type'Base'Last;
+
+   --  Table_Component_Type must not be a type with controlled parts.
+
+   --  The Table_Initial value controls the allocation of the table when it is
+   --  first allocated.
+
+   --  The Table_Increment value controls the amount of increase, if the table
+   --  has to be increased in size. The value given is a percentage value (e.g.
+   --  100 = increase table size by 100%, i.e. double it).
+
+   --  The Last and Set_Last subprograms provide control over the current
+   --  logical allocation. They are quite efficient, so they can be used
+   --  freely (expensive reallocation occurs only at major granularity
+   --  chunks controlled by the allocation parameters).
+
+   --  Note: we do not make the table components aliased, since this would
+   --  restrict the use of table for discriminated types. If it is necessary
+   --  to take the access of a table element, use Unrestricted_Access.
+
+   type Table_Type is
+     array (Valid_Table_Index_Type range <>) of Table_Component_Type;
+   subtype Big_Table_Type is
+     Table_Type (Table_Low_Bound .. Valid_Table_Index_Type'Last);
+   --  We work with pointers to a bogus array type that is constrained with
+   --  the maximum possible range bound. This means that the pointer is a thin
+   --  pointer, which is more efficient. Since subscript checks in any case
+   --  must be on the logical, rather than physical bounds, safety is not
+   --  compromised by this approach.
+
+   --  To get subscript checking, rename a slice of the Table, like this:
+
+   --     Table : Table_Type renames T.Table (First .. Last (T));
+
+   --  and then refer to components of Table.
+
+   type Table_Ptr is access all Big_Table_Type;
+   for Table_Ptr'Storage_Size use 0;
+   --  The table is actually represented as a pointer to allow reallocation
+
+   type Table_Private is private;
+   --  Table private data that is not exported in Instance
+
+   --  Private use only:
+   subtype Empty_Table_Array_Type is
+     Table_Type (Table_Low_Bound .. Table_Low_Bound - 1);
+   type Empty_Table_Array_Ptr is access all Empty_Table_Array_Type;
+   Empty_Table_Array : aliased Empty_Table_Array_Type;
+   function Empty_Table_Array_Ptr_To_Table_Ptr is
+     new Ada.Unchecked_Conversion (Empty_Table_Array_Ptr, Table_Ptr);
+   Empty_Table_Ptr : constant Table_Ptr :=
+             Empty_Table_Array_Ptr_To_Table_Ptr (Empty_Table_Array'Access);
+   --  End private use only. The above are used to initialize Table to point to
+   --  an empty array.
+
+   type Instance is record
+      Table : Table_Ptr := Empty_Table_Ptr;
+      --  The table itself. The lower bound is the value of First. Logically
+      --  the upper bound is the current value of Last (although the actual
+      --  size of the allocated table may be larger than this). The program may
+      --  only access and modify Table entries in the range First .. Last.
+      --
+      --  It's a good idea to access this via a renaming of a slice, in order
+      --  to ensure bounds checking, as in:
+      --
+      --     Tab : Table_Type renames X.Table (First .. X.Last);
+      --
+      --  Note: The Table component must come first. See declarations of
+      --  SCO_Unit_Table and SCO_Table in scos.h.
+
+      Locked : Boolean := False;
+      --  Table reallocation is permitted only if this is False. A client may
+      --  set Locked to True, in which case any operation that might expand or
+      --  shrink the table will cause an assertion failure. While a table is
+      --  locked, its address in memory remains fixed and unchanging.
+
+      P : Table_Private;
+   end record;
+
+   function Is_Empty (T : Instance) return Boolean;
+   pragma Inline (Is_Empty);
+
+   procedure Init (T : in out Instance);
+   --  Reinitializes the table to empty. There is no need to call this before
+   --  using a table; tables default to empty.
+
+   procedure Free (T : in out Instance) renames Init;
+
+   function First return Table_Index_Type;
+   pragma Inline (First);
+   --  Export First as synonym for Table_Low_Bound (parallel with use of Last)
+
+   function Last (T : Instance) return Table_Last_Type;
+   pragma Inline (Last);
+   --  Returns the current value of the last used entry in the table, which can
+   --  then be used as a subscript for Table.
+
+   procedure Release (T : in out Instance);
+   --  Storage is allocated in chunks according to the values given in the
+   --  Table_Initial and Table_Increment parameters. If Release_Threshold is
+   --  0 or the length of the table does not exceed this threshold then a call
+   --  to Release releases all storage that is allocated, but is not logically
+   --  part of the current array value; otherwise the call to Release leaves
+   --  the current array value plus 0.1% of the current table length free
+   --  elements located at the end of the table. This parameter facilitates
+   --  reopening large tables and adding a few elements without allocating a
+   --  chunk of memory. In both cases current array values are not affected by
+   --  this call.
+
+   procedure Set_Last (T : in out Instance; New_Val : Table_Last_Type);
+   pragma Inline (Set_Last);
+   --  This procedure sets Last to the indicated value. If necessary the table
+   --  is reallocated to accommodate the new value (i.e. on return the
+   --  allocated table has an upper bound of at least Last). If Set_Last
+   --  reduces the size of the table, then logically entries are removed from
+   --  the table. If Set_Last increases the size of the table, then new entries
+   --  are logically added to the table.
+
+   procedure Increment_Last (T : in out Instance);
+   pragma Inline (Increment_Last);
+   --  Adds 1 to Last (same as Set_Last (Last + 1))
+
+   procedure Decrement_Last (T : in out Instance);
+   pragma Inline (Decrement_Last);
+   --  Subtracts 1 from Last (same as Set_Last (Last - 1))
+
+   procedure Append (T : in out Instance; New_Val : Table_Component_Type);
+   pragma Inline (Append);
+   --  Appends New_Val onto the end of the table
+   --  Equivalent to:
+   --    Increment_Last (T);
+   --    T.Table (T.Last) := New_Val;
+
+   procedure Append_All (T : in out Instance; New_Vals : Table_Type);
+   --  Appends all components of New_Vals
+
+   procedure Set_Item
+     (T     : in out Instance;
+      Index : Valid_Table_Index_Type;
+      Item  : Table_Component_Type);
+   pragma Inline (Set_Item);
+   --  Put Item in the table at position Index. If Index points to an existing
+   --  item (i.e. it is in the range First .. Last (T)), the item is replaced.
+   --  Otherwise (i.e. Index > Last (T)), the table is expanded, and Last is
+   --  set to Index.
+
+   procedure Move (From, To : in out Instance);
+   --  Moves from From to To, and sets From to empty
+
+   procedure Allocate (T : in out Instance; Num : Integer := 1);
+   pragma Inline (Allocate);
+   --  Adds Num to Last
+
+   generic
+     with procedure Action
+       (Index : Valid_Table_Index_Type;
+        Item  : Table_Component_Type;
+        Quit  : in out Boolean) is <>;
+   procedure For_Each (Table : Instance);
+   --  Calls procedure Action for each component of the table, or until one of
+   --  these calls set Quit to True.
+
+   generic
+     with function Lt (Comp1, Comp2 : Table_Component_Type) return Boolean;
+   procedure Sort_Table (Table : in out Instance);
+   --  This procedure sorts the components of the table into ascending order
+   --  making calls to Lt to do required comparisons, and using assignments
+   --  to move components around. The Lt function returns True if Comp1 is
+   --  less than Comp2 (in the sense of the desired sort), and False if Comp1
+   --  is greater than Comp2. For equal objects it does not matter if True or
+   --  False is returned (it is slightly more efficient to return False). The
+   --  sort is not stable (the order of equal items in the table is not
+   --  preserved).
+
+private
+
+   type Table_Private is record
+      Last_Allocated : Table_Last_Type := Table_Low_Bound - 1;
+      --  Subscript of the maximum entry in the currently allocated table.
+      --  Initial value ensures that we initially allocate the table.
+
+      Last : Table_Last_Type := Table_Low_Bound - 1;
+      --  Current value of Last function
+
+      --  Invariant: Last <= Last_Allocated
+   end record;
+
+end GNAT.Dynamic_Tables;