From e4fed0767a1e3115257b38204231d02217d1408d Mon Sep 17 00:00:00 2001 From: charlet Date: Tue, 14 Aug 2007 08:46:03 +0000 Subject: [PATCH] 2007-08-14 Thomas Quinot * 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); git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@127442 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/g-dyntab.adb | 68 +++++++++++++++++++++++++++----- gcc/ada/g-table.adb | 67 +++++++++++++++++++++++++++---- gcc/ada/repinfo.adb | 33 ++++++---------- gcc/ada/sem_elab.adb | 12 ++---- gcc/ada/sinput-d.adb | 5 +-- gcc/ada/sinput-l.adb | 4 +- gcc/ada/stringt.adb | 12 ++---- gcc/ada/switch-m.adb | 4 +- gcc/ada/symbols-processing-vms-alpha.adb | 6 +-- gcc/ada/symbols-processing-vms-ia64.adb | 6 +-- gcc/ada/symbols-vms.adb | 24 +++++------ gcc/ada/table.adb | 67 +++++++++++++++++++++++++++---- 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=(=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); -- 2.7.4