[multiple changes]

2017-09-06  Yannick Moy  <moy@adacore.com>

	* treepr.adb (Print_Entity_Info): Do not print empty Elist.

2017-09-06  Yannick Moy  <moy@adacore.com>

	* inline.adb (Can_Be_Inlined_In_GNATprove_Mode): Do not consider calls
	to subprograms in other units as possibly inlined.

2017-09-06  Ed Schonberg  <schonberg@adacore.com>

	* freeze.adb (Freeze_Entity): For a derived type that has no
	explicit delayed aspects but may inherit delayed aspects from its
	parent type, analyze aspect at freeze point for proper capture
	of an inherited aspect.

2017-09-06  Arnaud Charlet  <charlet@adacore.com>

	* lib-xref.adb (Get_Through_Renamings): Get through subprogram
	renamings; also, avoid repeated calls to Renamed_Object when getting
	through object renamings.

2017-09-06  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Array_Type_Declaration): Handle properly an
	array type declaration in a private part, when an index is a
	subtype indication of a discrete type with a private partial view.

2017-09-06  Javier Miranda  <miranda@adacore.com>

	* exp_ch4.adb (Expand_Modular_Op): Force generating
	temporary to improve the generated code.

2017-09-06  Tristan Gingold  <gingold@adacore.com>

	* s-fatgen.adb: Minor typo fix in comment.

2017-09-06  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch5.adb (Make_Field_Assign): If the type
	of the right-hand side has stored constraint, use its values
	(except for those that are renamings of parent discriminants)
	to produce additional assignments for the discriminants of the
	left-hand side, which are invisible in the righ-hand side and
	not retrievable as selected components.

2017-09-06  Ed Schonberg  <schonberg@adacore.com>

	* sem_util.adb (Needs_One_Formal): The first formal of such a
	function must be a controlling formal, so that Obj.F (X, Y)
	can have the interpretation F(Obj)(X, Y).
	* sem_util.ads: Clarify documentation.

2017-09-06  Eric Botcazou  <ebotcazou@adacore.com>

	* table.ads, table.adb: Restore original implementation.
	* namet.h (Names_Ptr): Adjust back.
	(Name_Chars_Ptr): Likewise.
	* uintp.h (Uints_Ptr): Likewise.
	(Udigits_Ptr): Likewise.
	* g-table.ads: Remove pragma Compiler_Unit_Warning.
	* par_sco.adb: Do not with GNAT.Table and use Table consistently.
	* scos.ads: Replace GNAT.Table with Table and adjust instantiations.
	* spark_xrefs.ads: Likewise.
	* scos.h: Undo latest changes.

2017-09-06  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch12.adb (Analyze_Subprogram_Instantiation): Propagate
	No_Return flag to instance if pragma applies to generic unit. This
	must be done explicitly because the pragma does not appear
	directly in the generic declaration (unlike the corresponding
	aspect specification).

From-SVN: r251765

1 files changed, 190 insertions, 58 deletions

diff --git a/gcc/ada/table.ads b/gcc/ada/table.ads
index 8782f11..dcfc6fb 100644
--- a/gcc/ada/table.ads
+++ b/gcc/ada/table.ads
@@ -29,20 +29,19 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  This package is a wrapper for GNAT.Table, for use in the compiler front
---  end. It adds the Tree_Write/Tree_Read functionality; everything else is
---  just a renaming of GNAT.Table. See GNAT.Table (g-table.ads) and
---  GNAT.Dynamic_Tables (g-dyntab.ads) for documentation.
-
---  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)
+--  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 uses a very efficient memory management scheme and any
+--  change must be carefully evaluated on compilation of real software.
+
+--  Note that this interface should remain synchronized with those in
+--  GNAT.Table and GNAT.Dynamic_Tables to keep coherency between these
+--  three related units.
 
 with Types; use Types;
-with GNAT.Table;
 
 package Table is
    pragma Elaborate_Body;
@@ -51,66 +50,199 @@ package Table is
       type Table_Component_Type is private;
       type Table_Index_Type     is range <>;
 
-      Table_Low_Bound   : Table_Index_Type := Table_Index_Type'First;
-      Table_Initial     : Pos := 8;
-      Table_Increment   : Nat := 100;
-      Table_Name        : String; -- for debugging printouts
+      Table_Low_Bound   : Table_Index_Type;
+      Table_Initial     : Pos;
+      Table_Increment   : Nat;
+      Table_Name        : String;
       Release_Threshold : Nat := 0;
 
    package Table is
 
-      package Tab is new GNAT.Table
-        (Table_Component_Type,
-         Table_Index_Type,
-         Table_Low_Bound,
-         Positive (Table_Initial),
-         Natural (Table_Increment),
-         Table_Name,
-         Natural (Release_Threshold));
-
-      subtype Valid_Table_Index_Type is Tab.Valid_Table_Index_Type;
-      subtype Table_Last_Type is Tab.Table_Last_Type;
-      subtype Table_Type is Tab.Table_Type;
-
-      subtype Table_Ptr is Tab.Table_Ptr;
-
-      Table : Table_Ptr renames Tab.Table;
-
-      Locked : Boolean renames Tab.Locked;
-
-      function Is_Empty return Boolean renames Tab.Is_Empty;
-
-      procedure Init renames Tab.Init;
-
-      function First return Table_Index_Type renames Tab.First;
-      function Last return Table_Last_Type renames Tab.Last;
+      --  Table_Component_Type and Table_Index_Type specify the type of the
+      --  array, Table_Low_Bound is the lower bound. Table_Index_Type must be
+      --  an integer type. The effect is roughly to declare:
+
+      --    Table : array (Table_Index_Type range Table_Low_Bound .. <>)
+      --                       of Table_Component_Type;
+
+      --    Note: since the upper bound can be one less than the lower
+      --    bound for an empty array, the table index type must be able
+      --    to cover this range, e.g. if the lower bound is 1, then the
+      --    Table_Index_Type should be Natural rather than Positive.
+
+      --  Table_Component_Type may be any Ada type, except that controlled
+      --  types are not supported. Note however that default initialization
+      --  will NOT occur for array components.
+
+      --  The Table_Initial values controls the allocation of the table when
+      --  it is first allocated, either by default, or by an explicit Init
+      --  call. The value used is Opt.Table_Factor * Table_Initial.
+
+      --  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 Table_Name parameter is simply use in debug output messages it
+      --  has no other usage, and is not referenced in non-debugging mode.
+
+      --  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.
+
+      type Table_Type is
+        array (Table_Index_Type range <>) of Table_Component_Type;
+
+      subtype Big_Table_Type is
+        Table_Type (Table_Low_Bound .. 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.
+
+      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
+
+      Table : aliased Table_Ptr := null;
+      --  The table itself. The lower bound is the value of Low_Bound.
+      --  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.
+
+      Locked : Boolean := False;
+      --  Table expansion is permitted only if this switch is set to False. A
+      --  client may set Locked to True, in which case any attempt to expand
+      --  the table will cause an assertion failure. Note that while a table
+      --  is locked, its address in memory remains fixed and unchanging. This
+      --  feature is used to control table expansion during Gigi processing.
+      --  Gigi assumes that tables other than the Uint and Ureal tables do
+      --  not move during processing, which means that they cannot be expanded.
+      --  The Locked flag is used to enforce this restriction.
+
+      procedure Init;
+      --  This procedure allocates a new table of size Initial (freeing any
+      --  previously allocated larger table). It is not necessary to call
+      --  Init when a table is first instantiated (since the instantiation does
+      --  the same initialization steps). However, it is harmless to do so, and
+      --  Init is convenient in reestablishing a table for new use.
+
+      function Last return Table_Index_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. Note that the only way to
+      --  modify Last is to call the Set_Last procedure. Last must always be
+      --  used to determine the logically last entry.
+
+      procedure Release;
+      --  Storage is allocated in chunks according to the values given in the
+      --  Initial and 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 Free;
+      --  Free all allocated memory for the table. A call to init is required
+      --  before any use of this table after calling Free.
+
+      First : constant Table_Index_Type := Table_Low_Bound;
+      --  Export First as synonym for Low_Bound (parallel with use of Last)
+
+      procedure Set_Last (New_Val : Table_Index_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;
+      pragma Inline (Increment_Last);
+      --  Adds 1 to Last (same as Set_Last (Last + 1)
+
+      procedure Decrement_Last;
+      pragma Inline (Decrement_Last);
+      --  Subtracts 1 from Last (same as Set_Last (Last - 1)
+
+      procedure Append (New_Val : Table_Component_Type);
+      pragma Inline (Append);
+      --  Equivalent to:
+      --    x.Increment_Last;
+      --    x.Table (x.Last) := New_Val;
+      --  i.e. the table size is increased by one, and the given new item
+      --  stored in the newly created table element.
+
+      procedure Append_All (New_Vals : Table_Type);
+      --  Appends all components of New_Vals
 
-      procedure Release renames Tab.Release;
-
-      procedure Free renames Tab.Free;
-
-      procedure Set_Last (New_Val : Table_Last_Type) renames Tab.Set_Last;
-
-      procedure Increment_Last renames Tab.Increment_Last;
-      procedure Decrement_Last renames Tab.Decrement_Last;
+      procedure Set_Item
+        (Index : Table_Index_Type;
+         Item  : Table_Component_Type);
+      pragma Inline (Set_Item);
+      --  Put Item in the table at position Index. The table is expanded if
+      --  current table length is less than Index and in that case Last is set
+      --  to Index. Item will replace any value already present in the table
+      --  at this position.
 
-      procedure Append (New_Val : Table_Component_Type) renames Tab.Append;
-      procedure Append_All (New_Vals : Table_Type) renames Tab.Append_All;
+      type Saved_Table is private;
+      --  Type used for Save/Restore subprograms
 
-      procedure Set_Item
-        (Index : Valid_Table_Index_Type;
-         Item  : Table_Component_Type) renames Tab.Set_Item;
+      function Save return Saved_Table;
+      --  Resets table to empty, but saves old contents of table in returned
+      --  value, for possible later restoration by a call to Restore.
 
-      subtype Saved_Table is Tab.Saved_Table;
-      function Save return Saved_Table renames Tab.Save;
-      procedure Restore (T : in out Saved_Table) renames Tab.Restore;
+      procedure Restore (T : Saved_Table);
+      --  Given a Saved_Table value returned by a prior call to Save, restores
+      --  the table to the state it was in at the time of the Save call.
 
       procedure Tree_Write;
       --  Writes out contents of table using Tree_IO
 
       procedure Tree_Read;
       --  Initializes table by reading contents previously written with the
-      --  Tree_Write call, also using Tree_IO.
+      --  Tree_Write call (also using Tree_IO).
+
+   private
+
+      Last_Val : Int;
+      --  Current value of Last. Note that we declare this in the private part
+      --  because we don't want the client to modify Last except through one of
+      --  the official interfaces (since a modification to Last may require a
+      --  reallocation of the table).
+
+      Max : Int;
+      --  Subscript of the maximum entry in the currently allocated table
+
+      type Saved_Table is record
+         Last_Val : Int;
+         Max      : Int;
+         Table    : Table_Ptr;
+      end record;
 
    end Table;
 end Table;