Skip to content

R
riscv-gcc-1
Commit 1d6f10a1 by Thomas Quinot Committed by Arnaud Charlet
Options

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
parent f97ccb3a
Showing with 215 additions and 93 deletions
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;
--------------
......
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;
--------------
......
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;
---------------------------
......
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 = ");
......
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;
......
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 :=
......
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;
......
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
......
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;
......
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;
......
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;
......
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);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment