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

12 files changed, 215 insertions, 93 deletions

diff --git a/gcc/ada/g-dyntab.adb b/gcc/ada/g-dyntab.adb
index f90cc7b..a6a61a4 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;
 
    --------------
diff --git a/gcc/ada/g-table.adb b/gcc/ada/g-table.adb
index f16b6fd..2fd5d32 100644
--- a/gcc/ada/g-table.adb
+++ b/gcc/ada/g-table.adb
@@ -93,8 +93,7 @@ package body GNAT.Table is
 
    procedure Append (New_Val : Table_Component_Type) is
    begin
-      Increment_Last;
-      Table (Table_Index_Type (Last_Val)) := New_Val;
+      Set_Item (Table_Index_Type (Last_Val + 1), New_Val);
    end Append;
 
    --------------------
@@ -227,15 +226,67 @@ package body GNAT.Table is
    --------------
 
    procedure Set_Item
-     (Index : Table_Index_Type;
-      Item  : Table_Component_Type)
+      (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 (Table'First .. Table_Index_Type (Max + 1));
+      --  A constrained table subtype one element larger than the currently
+      --  allocated table.
+
+      Allocated_Table_Address : constant System.Address :=
+                                  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 of computing the address just past the end of the
+      --  current allocation).
+
+      Need_Realloc : constant Boolean := Integer (Index) > Max;
+      --  True if this operation requires storage reallocation (which may
+      --  involve moving table contents around).
+
    begin
-      if Integer (Index) > Last_Val then
-         Set_Last (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 (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 (Index);
+            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.
 
-      Table (Index) := Item;
+         if Integer (Index) > Last_Val then
+            Set_Last (Index);
+         end if;
+
+         Table (Index) := Item;
+      end if;
    end Set_Item;
 
    --------------
diff --git a/gcc/ada/repinfo.adb b/gcc/ada/repinfo.adb
index 93d5fd4..a36fb59 100644
--- a/gcc/ada/repinfo.adb
+++ b/gcc/ada/repinfo.adb
@@ -212,16 +212,10 @@ package body Repinfo is
    ------------------------
 
    function Create_Discrim_Ref (Discr : Entity_Id) return Node_Ref is
-      N : constant Uint := Discriminant_Number (Discr);
-      T : Nat;
    begin
-      Rep_Table.Increment_Last;
-      T := Rep_Table.Last;
-      Rep_Table.Table (T).Expr := Discrim_Val;
-      Rep_Table.Table (T).Op1  := N;
-      Rep_Table.Table (T).Op2  := No_Uint;
-      Rep_Table.Table (T).Op3  := No_Uint;
-      return UI_From_Int (-T);
+      return Create_Node
+        (Expr => Discrim_Val,
+         Op1  => Discriminant_Number (Discr));
    end Create_Discrim_Ref;
 
    ---------------------------
@@ -229,12 +223,9 @@ package body Repinfo is
    ---------------------------
 
    function Create_Dynamic_SO_Ref (E : Entity_Id) return Dynamic_SO_Ref is
-      T : Nat;
    begin
-      Dynamic_SO_Entity_Table.Increment_Last;
-      T := Dynamic_SO_Entity_Table.Last;
-      Dynamic_SO_Entity_Table.Table (T) := E;
-      return UI_From_Int (-T);
+      Dynamic_SO_Entity_Table.Append (E);
+      return UI_From_Int (-Dynamic_SO_Entity_Table.Last);
    end Create_Dynamic_SO_Ref;
 
    -----------------
@@ -247,15 +238,13 @@ package body Repinfo is
       Op2  : Node_Ref_Or_Val := No_Uint;
       Op3  : Node_Ref_Or_Val := No_Uint) return Node_Ref
    is
-      T : Nat;
    begin
-      Rep_Table.Increment_Last;
-      T := Rep_Table.Last;
-      Rep_Table.Table (T).Expr := Expr;
-      Rep_Table.Table (T).Op1  := Op1;
-      Rep_Table.Table (T).Op2  := Op2;
-      Rep_Table.Table (T).Op3  := Op3;
-      return UI_From_Int (-T);
+      Rep_Table.Append (
+        (Expr => Expr,
+         Op1  => Op1,
+         Op2  => Op2,
+         Op3  => Op3));
+      return UI_From_Int (-Rep_Table.Last);
    end Create_Node;
 
    ---------------------------
diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb
index bae6a9f..137ac4e 100644
--- a/gcc/ada/sem_elab.adb
+++ b/gcc/ada/sem_elab.adb
@@ -1906,14 +1906,13 @@ package body Sem_Elab is
       --  Delay this call if we are still delaying calls
 
       if Delaying_Elab_Checks then
-         Delay_Check.Increment_Last;
-         Delay_Check.Table (Delay_Check.Last) :=
+         Delay_Check.Append (
            (N              => N,
             E              => E,
             Orig_Ent       => Orig_Ent,
             Curscop        => Current_Scope,
             Outer_Scope    => Outer_Scope,
-            From_Elab_Code => From_Elab_Code);
+            From_Elab_Code => From_Elab_Code));
          return;
 
       --  Otherwise, call phase 2 continuation right now
@@ -2031,8 +2030,7 @@ package body Sem_Elab is
          Outer_Level_Sloc := Loc;
       end if;
 
-      Elab_Visited.Increment_Last;
-      Elab_Visited.Table (Elab_Visited.Last) := E;
+      Elab_Visited.Append (E);
 
       --  If the call is to a function that renames a literal, no check
       --  is needed.
@@ -2076,9 +2074,7 @@ package body Sem_Elab is
       else
          pragma Assert (Nkind (Sbody) = N_Subprogram_Body);
 
-         Elab_Call.Increment_Last;
-         Elab_Call.Table (Elab_Call.Last).Cloc := Loc;
-         Elab_Call.Table (Elab_Call.Last).Ent  := E;
+         Elab_Call.Append ((Cloc => Loc, Ent => E));
 
          if Debug_Flag_LL then
             Write_Str ("Elab_Call.Last = ");
diff --git a/gcc/ada/sinput-d.adb b/gcc/ada/sinput-d.adb
index d9e290a..9b13e55 100644
--- a/gcc/ada/sinput-d.adb
+++ b/gcc/ada/sinput-d.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2002-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 2002-2007, Free Software Foundation, Inc.         --
 --                                                                          --
 -- 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- --
@@ -62,14 +62,13 @@ package body Sinput.D is
    is
    begin
       Loc := Source_File.Table (Source_File.Last).Source_Last + 1;
-      Source_File.Increment_Last;
+      Source_File.Append (Source_File.Table (Source));
       Dfile := Source_File.Last;
 
       declare
          S : Source_File_Record renames Source_File.Table (Dfile);
 
       begin
-         S := Source_File.Table (Source);
          S.Full_Debug_Name   := Create_Debug_File (S.File_Name);
          S.Debug_Source_Name := Strip_Directory (S.Full_Debug_Name);
          S.Source_First      := Loc;
diff --git a/gcc/ada/sinput-l.adb b/gcc/ada/sinput-l.adb
index 03706f1..385bd8d 100644
--- a/gcc/ada/sinput-l.adb
+++ b/gcc/ada/sinput-l.adb
@@ -132,10 +132,9 @@ package body Sinput.L is
       A.Lo := Source_File.Table (Xold).Source_First;
       A.Hi := Source_File.Table (Xold).Source_Last;
 
-      Source_File.Increment_Last;
+      Source_File.Append (Source_File.Table (Xold));
       Xnew := Source_File.Last;
 
-      Source_File.Table (Xnew)               := Source_File.Table (Xold);
       Source_File.Table (Xnew).Inlined_Body  := Inlined_Body;
       Source_File.Table (Xnew).Instantiation := Sloc (Inst_Node);
       Source_File.Table (Xnew).Template      := Xold;
@@ -148,6 +147,7 @@ package body Sinput.L is
         Source_File.Table (Xnew - 1).Source_Last + 1;
       A.Adjust := Source_File.Table (Xnew).Source_First - A.Lo;
       Source_File.Table (Xnew).Source_Last := A.Hi + A.Adjust;
+
       Set_Source_File_Index_Table (Xnew);
 
       Source_File.Table (Xnew).Sloc_Adjust :=
diff --git a/gcc/ada/stringt.adb b/gcc/ada/stringt.adb
index 1c03a88..e272009 100644
--- a/gcc/ada/stringt.adb
+++ b/gcc/ada/stringt.adb
@@ -139,9 +139,7 @@ package body Stringt is
 
    procedure Start_String is
    begin
-      Strings.Increment_Last;
-      Strings.Table (Strings.Last).String_Index := String_Chars.Last + 1;
-      Strings.Table (Strings.Last).Length := 0;
+      Strings.Append ((String_Index => String_Chars.Last + 1, Length => 0));
    end Start_String;
 
    --  Version to start from initially stored string
@@ -166,9 +164,8 @@ package body Stringt is
            String_Chars.Last + 1;
 
          for J in 1 .. Strings.Table (S).Length loop
-            String_Chars.Increment_Last;
-            String_Chars.Table (String_Chars.Last) :=
-              String_Chars.Table (Strings.Table (S).String_Index + (J - 1));
+            String_Chars.Append
+              (String_Chars.Table (Strings.Table (S).String_Index + (J - 1)));
          end loop;
       end if;
 
@@ -183,8 +180,7 @@ package body Stringt is
 
    procedure Store_String_Char (C : Char_Code) is
    begin
-      String_Chars.Increment_Last;
-      String_Chars.Table (String_Chars.Last) := C;
+      String_Chars.Append (C);
       Strings.Table (Strings.Last).Length :=
         Strings.Table (Strings.Last).Length + 1;
    end Store_String_Char;
diff --git a/gcc/ada/switch-m.adb b/gcc/ada/switch-m.adb
index 7c7259d..ded1a94 100644
--- a/gcc/ada/switch-m.adb
+++ b/gcc/ada/switch-m.adb
@@ -119,9 +119,7 @@ package body Switch.M is
          --  Add a new component in the table.
 
          Switches (Last) := new String'(S);
-         Normalized_Switches.Increment_Last;
-         Normalized_Switches.Table (Normalized_Switches.Last) :=
-           Switches (Last);
+         Normalized_Switches.Append (Switches (Last));
       end Add_Switch_Component;
 
    --  Start of processing for Normalize_Compiler_Switches
diff --git a/gcc/ada/symbols-processing-vms-alpha.adb b/gcc/ada/symbols-processing-vms-alpha.adb
index da1bf5d..cb88fe9 100644
--- a/gcc/ada/symbols-processing-vms-alpha.adb
+++ b/gcc/ada/symbols-processing-vms-alpha.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2003-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 2003-2007, Free Software Foundation, Inc.         --
 --                                                                          --
 -- 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- --
@@ -212,9 +212,7 @@ package body Processing is
 
                         --  Put the new symbol in the table
 
-                        Symbol_Table.Increment_Last (Complete_Symbols);
-                        Complete_Symbols.Table
-                          (Symbol_Table.Last (Complete_Symbols)) := S_Data;
+                        Symbol_Table.Append (Complete_Symbols, S_Data);
                      end;
                   end if;
 
diff --git a/gcc/ada/symbols-processing-vms-ia64.adb b/gcc/ada/symbols-processing-vms-ia64.adb
index 5d62c3c..80b0762 100644
--- a/gcc/ada/symbols-processing-vms-ia64.adb
+++ b/gcc/ada/symbols-processing-vms-ia64.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2007, Free Software Foundation, Inc.         --
 --                                                                          --
 -- 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- --
@@ -362,9 +362,7 @@ package body Processing is
 
                   --  Put the new symbol in the table
 
-                  Symbol_Table.Increment_Last (Complete_Symbols);
-                  Complete_Symbols.Table
-                    (Symbol_Table.Last (Complete_Symbols)) := S_Data;
+                  Symbol_Table.Append (Complete_Symbols, S_Data);
                end;
             end if;
          end if;
diff --git a/gcc/ada/symbols-vms.adb b/gcc/ada/symbols-vms.adb
index 7f4e6e6..2b955ca 100644
--- a/gcc/ada/symbols-vms.adb
+++ b/gcc/ada/symbols-vms.adb
@@ -246,14 +246,12 @@ package body Symbols is
                if Last > Symbol_Vector'Length + Equal_Data'Length and then
                  Line (Last - Equal_Data'Length + 1 .. Last) = Equal_Data
                then
-                  Symbol_Table.Increment_Last (Original_Symbols);
-                  Original_Symbols.Table
-                    (Symbol_Table.Last (Original_Symbols)) :=
-                      (Name =>
-                         new String'(Line (Symbol_Vector'Length + 1 ..
-                                           Last - Equal_Data'Length)),
-                       Kind => Data,
-                       Present => True);
+                  Symbol_Table.Append (Original_Symbols,
+                    (Name =>
+                       new String'(Line (Symbol_Vector'Length + 1 ..
+                                         Last - Equal_Data'Length)),
+                     Kind => Data,
+                     Present => True));
 
                --  SYMBOL_VECTOR=(<symbol>=PROCEDURE)
 
@@ -262,14 +260,12 @@ package body Symbols is
                   Line (Last - Equal_Procedure'Length + 1 .. Last) =
                                                               Equal_Procedure
                then
-                  Symbol_Table.Increment_Last (Original_Symbols);
-                  Original_Symbols.Table
-                    (Symbol_Table.Last (Original_Symbols)) :=
+                  Symbol_Table.Append (Original_Symbols,
                     (Name =>
                        new String'(Line (Symbol_Vector'Length + 1 ..
                                          Last - Equal_Procedure'Length)),
                      Kind => Proc,
-                     Present => True);
+                     Present => True));
 
                --  Anything else is incorrectly formatted
 
@@ -536,9 +532,7 @@ package body Symbols is
                      Soft_Minor_ID := False;
                   end if;
 
-                  Symbol_Table.Increment_Last (Original_Symbols);
-                  Original_Symbols.Table
-                    (Symbol_Table.Last (Original_Symbols)) := S_Data;
+                  Symbol_Table.Append (Original_Symbols, S_Data);
                   Complete_Symbols.Table (Index).Present := False;
                end if;
             end loop;
diff --git a/gcc/ada/table.adb b/gcc/ada/table.adb
index 7897378..273be81 100644
--- a/gcc/ada/table.adb
+++ b/gcc/ada/table.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
 --                                                                          --
 -- 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- --
@@ -82,8 +82,7 @@ package body Table is
 
       procedure Append (New_Val : Table_Component_Type) is
       begin
-         Increment_Last;
-         Table (Table_Index_Type (Last_Val)) := New_Val;
+         Set_Item (Table_Index_Type (Last_Val + 1), New_Val);
       end Append;
 
       --------------------
@@ -268,12 +267,65 @@ package body Table is
          (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 (Table'First .. Table_Index_Type (Max + 1));
+         --  A constrained table subtype one element larger than the currently
+         --  allocated table.
+
+         Allocated_Table_Address : constant System.Address :=
+                                     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 of computing the address just past the end of the current
+         --  allocation).
+
+         Need_Realloc : constant Boolean := Int (Index) > Max;
+         --  True if this operation requires storage reallocation (which may
+         --  involve moving table contents around).
+
       begin
-         if Int (Index) > Max then
-            Set_Last (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 (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 (Index);
+               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.
 
-         Table (Index) := Item;
+            if Int (Index) > Last_Val then
+               Set_Last (Index);
+            end if;
+
+            Table (Index) := Item;
+         end if;
       end Set_Item;
 
       --------------
@@ -284,6 +336,7 @@ package body Table is
       begin
          if Int (New_Val) < Last_Val then
             Last_Val := Int (New_Val);
+
          else
             Last_Val := Int (New_Val);