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;
--------------------
--------------
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;
--------------
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;
--------------------
--------------
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;
--------------
------------------------
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;
---------------------------
---------------------------
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;
-----------------
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;
---------------------------
-- 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
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.
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 = ");
-- --
-- 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- --
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;
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;
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 :=
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
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;
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;
-- 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
-- --
-- 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- --
-- 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;
-- --
-- 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- --
-- 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;
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)
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
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;
-- --
-- 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- --
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;
--------------------
(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;
--------------
begin
if Int (New_Val) < Last_Val then
Last_Val := Int (New_Val);
+
else
Last_Val := Int (New_Val);
OSDN Git Service
