table.adb, [...] (Append): Reimplement in terms of Set_Item.

2007-08-14  Thomas Quinot  <quinot@adacore.com>

	* table.adb, g-table.adb, g-dyntab.adb (Append): Reimplement in terms
	of Set_Item.
	(Set_Item): When the new item is an element of the currently allocated
	table passed by reference, save a copy on the stack if we're going
	to reallocate. Also, in Table.Set_Item, make sure we test the proper
	variable to determine whether to call Set_Last.

	* sinput-d.adb, sinput-l.adb, stringt.adb, switch-m.adb,
	symbols-vms.adb, symbols-processing-vms-alpha.adb,
	symbols-processing-vms-ia64.adb, sem_elab.adb, repinfo.adb: Replace
	some occurrences of the pattern
	   T.Increment_Last;
	   T.Table (T.Last) := Value;
	with a cleaner call to
	   T.Append (Value);

From-SVN: r127442

1 files changed, 59 insertions, 9 deletions

diff --git a/gcc/ada/g-dyntab.adb b/gcc/ada/g-dyntab.adb
index f90cc7b09be..a6a61a432ea 100644
--- a/gcc/ada/g-dyntab.adb
+++ b/gcc/ada/g-dyntab.adb
@@ -82,8 +82,7 @@ package body GNAT.Dynamic_Tables is
 
    procedure Append (T : in out Instance; New_Val : Table_Component_Type) is
    begin
-      Increment_Last (T);
-      T.Table (Table_Index_Type (T.P.Last_Val)) := New_Val;
+      Set_Item (T, Table_Index_Type (T.P.Last_Val + 1), New_Val);
    end Append;
 
    --------------------
@@ -227,16 +226,67 @@ package body GNAT.Dynamic_Tables is
    --------------
 
    procedure Set_Item
-     (T     : in out Instance;
-      Index : Table_Index_Type;
-      Item  : Table_Component_Type)
+      (T     : in out Instance;
+       Index : Table_Index_Type;
+       Item  : Table_Component_Type)
    is
+      --  If Item is a value within the current allocation, and we are going to
+      --  reallocate, then we must preserve an intermediate copy here before
+      --  calling Increment_Last. Otherwise, if Table_Component_Type is passed
+      --  by reference, we are going to end up copying from storage that might
+      --  have been deallocated from Increment_Last calling Reallocate.
+
+      subtype Allocated_Table_T is
+        Table_Type (T.Table'First .. Table_Index_Type (T.P.Max + 1));
+      --  A constrained table subtype one element larger than the currently
+      --  allocated table.
+
+      Allocated_Table_Address : constant System.Address :=
+                                  T.Table.all'Address;
+      --  Used for address clause below (we can't use non-static expression
+      --  Table.all'Address directly in the clause because some older versions
+      --  of the compiler do not allow it).
+
+      Allocated_Table : Allocated_Table_T;
+      pragma Import (Ada, Allocated_Table);
+      for Allocated_Table'Address use Allocated_Table_Address;
+      --  Allocated_Table represents the currently allocated array, plus one
+      --  element (the supplementary element is used to have a convenient way
+      --  to the address just past the end of the current allocation).
+
+      Need_Realloc : constant Boolean := Integer (Index) > T.P.Max;
+      --  True if this operation requires storage reallocation (which may
+      --  involve moving table contents around).
+
    begin
-      if Integer (Index) > T.P.Last_Val then
-         Set_Last (T, Index);
-      end if;
+      --  If we're going to reallocate, check wheter Item references an
+      --  element of the currently allocated table.
+
+      if Need_Realloc
+        and then Allocated_Table'Address <= Item'Address
+        and then Item'Address <
+                   Allocated_Table (Table_Index_Type (T.P.Max + 1))'Address
+      then
+         --  If so, save a copy on the stack because Increment_Last will
+         --  reallocate storage and might deallocate the current table.
+
+         declare
+            Item_Copy : constant Table_Component_Type := Item;
+         begin
+            Set_Last (T, Index);
+            T.Table (Index) := Item_Copy;
+         end;
+
+      else
+         --  Here we know that either we won't reallocate (case of Index < Max)
+         --  or that Item is not in the currently allocated table.
 
-      T.Table (Index) := Item;
+         if Integer (Index) > T.P.Last_Val then
+            Set_Last (T, Index);
+         end if;
+
+         T.Table (Index) := Item;
+      end if;
    end Set_Item;
 
    --------------