summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2009-04-17 09:38:12 +0000
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2009-04-17 09:38:12 +0000
commit37f5ff39a98ae165f9b7f47c351ba172e04957d5 (patch)
tree69f024da5f301a5d19395994058f7c9fff2082b9
parentcf4214f5516da07ac74b53c00efe703c2fffacf0 (diff)
downloadgcc-37f5ff39a98ae165f9b7f47c351ba172e04957d5.tar.gz
2009-04-17 Ed Schonberg <schonberg@adacore.com>
* atree.ads, atree.adb: Move New_Copy_Tree.to sem_util. * nlists.ads, nlists.adb: Move New_Copy_List to sem_util. * lib-load.adb: Use Copy_Separate_Tree rather than New_Copy_Tree * sem_util.ads, sem_util.adb: New_Copy_Tree and New_Copy_List belong in semantic units, because the handling of itypes in the copied tree requires semantic information that does not belong in atree. 2009-04-17 Robert Dewar <dewar@adacore.com> * par-ch6.adb: Minor reformatting * prj.adb: Minor reformatting git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@146230 138bc75d-0d04-0410-961f-82ee72b054a4
-rw-r--r--gcc/ada/ChangeLog32
-rw-r--r--gcc/ada/atree.adb102
-rw-r--r--gcc/ada/atree.ads91
-rw-r--r--gcc/ada/lib-load.adb4
-rw-r--r--gcc/ada/nlists.adb25
-rw-r--r--gcc/ada/nlists.ads7
-rw-r--r--gcc/ada/par-ch6.adb7
-rw-r--r--gcc/ada/prj.adb6
-rw-r--r--gcc/ada/sem_util.adb978
-rw-r--r--gcc/ada/sem_util.ads51
10 files changed, 1168 insertions, 135 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index eaa602b0ec1..15330166f64 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,35 @@
+2009-04-17 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch3.adb (Access_Subprogram_Definition): Additional checks on
+ illegal uses of incomplete types in formal parts and return types.
+
+ * sem_ch6.adb (Process_Formals): Taft-amendment types are legal in
+ access to subprograms.
+
+ * sem_ch7.adb (Uninstall_Declarations): diagnose attempts to use
+ Taft-amendment types as the return type of an access_to_function type.
+
+ * freeze.adb (Freeze_Entity): Remove tests on formals of an incomplete
+ type for access_to_subprograms. The check is performed on package exit.
+
+2009-04-17 Ed Schonberg <schonberg@adacore.com>
+
+ * atree.ads, atree.adb: Move New_Copy_Tree.to sem_util.
+
+ * nlists.ads, nlists.adb: Move New_Copy_List to sem_util.
+
+ * lib-load.adb: Use Copy_Separate_Tree rather than New_Copy_Tree
+
+ * sem_util.ads, sem_util.adb: New_Copy_Tree and New_Copy_List belong in
+ semantic units, because the handling of itypes in the copied tree
+ requires semantic information that does not belong in atree.
+
+2009-04-17 Robert Dewar <dewar@adacore.com>
+
+ * par-ch6.adb: Minor reformatting
+
+ * prj.adb: Minor reformatting
+
2009-04-17 Gary Dismukes <dismukes@adacore.com>
* par-ch6.adb (P_Subprogram): Overriding indicators should be allowed
diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb
index 027df3cdb18..3745b384938 100644
--- a/gcc/ada/atree.adb
+++ b/gcc/ada/atree.adb
@@ -105,8 +105,6 @@ package body Atree is
use Atree_Private_Part;
-- We are also allowed to see our private data structures!
- function E_To_N is new Unchecked_Conversion (Entity_Kind, Node_Kind);
- function N_To_E is new Unchecked_Conversion (Node_Kind, Entity_Kind);
-- Functions used to store Entity_Kind value in Nkind field
-- The following declarations are used to store flags 65-72 in the
@@ -395,91 +393,6 @@ package body Atree is
function To_Flag_Word5_Ptr is new
Unchecked_Conversion (Union_Id_Ptr, Flag_Word5_Ptr);
- -- Default value used to initialize default nodes. Note that some of the
- -- fields get overwritten, and in particular, Nkind always gets reset.
-
- Default_Node : Node_Record := (
- Is_Extension => False,
- Pflag1 => False,
- Pflag2 => False,
- In_List => False,
- Unused_1 => False,
- Rewrite_Ins => False,
- Analyzed => False,
- Comes_From_Source => False, -- modified by Set_Comes_From_Source_Default
- Error_Posted => False,
- Flag4 => False,
-
- Flag5 => False,
- Flag6 => False,
- Flag7 => False,
- Flag8 => False,
- Flag9 => False,
- Flag10 => False,
- Flag11 => False,
- Flag12 => False,
-
- Flag13 => False,
- Flag14 => False,
- Flag15 => False,
- Flag16 => False,
- Flag17 => False,
- Flag18 => False,
-
- Nkind => N_Unused_At_Start,
-
- Sloc => No_Location,
- Link => Empty_List_Or_Node,
- Field1 => Empty_List_Or_Node,
- Field2 => Empty_List_Or_Node,
- Field3 => Empty_List_Or_Node,
- Field4 => Empty_List_Or_Node,
- Field5 => Empty_List_Or_Node);
-
- -- Default value used to initialize node extensions (i.e. the second
- -- and third and fourth components of an extended node). Note we are
- -- cheating a bit here when it comes to Node12, which really holds
- -- flags an (for the third component), the convention. But it works
- -- because Empty, False, Convention_Ada, all happen to be all zero bits.
-
- Default_Node_Extension : constant Node_Record := (
- Is_Extension => True,
- Pflag1 => False,
- Pflag2 => False,
- In_List => False,
- Unused_1 => False,
- Rewrite_Ins => False,
- Analyzed => False,
- Comes_From_Source => False,
- Error_Posted => False,
- Flag4 => False,
-
- Flag5 => False,
- Flag6 => False,
- Flag7 => False,
- Flag8 => False,
- Flag9 => False,
- Flag10 => False,
- Flag11 => False,
- Flag12 => False,
-
- Flag13 => False,
- Flag14 => False,
- Flag15 => False,
- Flag16 => False,
- Flag17 => False,
- Flag18 => False,
-
- Nkind => E_To_N (E_Void),
-
- Field6 => Empty_List_Or_Node,
- Field7 => Empty_List_Or_Node,
- Field8 => Empty_List_Or_Node,
- Field9 => Empty_List_Or_Node,
- Field10 => Empty_List_Or_Node,
- Field11 => Empty_List_Or_Node,
- Field12 => Empty_List_Or_Node);
-
--------------------------------------------------
-- Implementation of Tree Substitution Routines --
--------------------------------------------------
@@ -1218,7 +1131,7 @@ package body Atree is
-- Start of processing for New_Copy_Tree function
- function New_Copy_Tree
+ function New_Copy_Tree1
(Source : Node_Id;
Map : Elist_Id := No_Elist;
New_Sloc : Source_Ptr := No_Location;
@@ -1835,12 +1748,9 @@ package body Atree is
-- The new Itype has all the attributes of the old one, and
-- we just copy the contents of the entity. However, the back-end
-- needs different names for debugging purposes, so we create a
- -- new internal name by appending the letter 'c' (copy) to the
- -- name of the original.
+ -- new internal name for it in all cases.
- Get_Name_String (Chars (Old_Itype));
- Add_Char_To_Name_Buffer ('c');
- Set_Chars (New_Itype, Name_Enter);
+ -- Set_Chars (New_Itype, New_Internal_Name ('T'));
-- If our associated node is an entity that has already been copied,
-- then set the associated node of the copy to point to the right
@@ -1952,6 +1862,10 @@ package body Atree is
Old_Itype);
end if;
end if;
+ Get_Name_String (Chars (Old_Itype));
+ Add_Char_To_Name_Buffer ('c');
+ Add_Nat_To_Name_Buffer (Int (Associated_Node_For_Itype (New_Itype)));
+ Set_Chars (New_Itype, Name_Enter);
end Visit_Itype;
----------------
@@ -2085,7 +1999,7 @@ package body Atree is
-- Now we can copy the actual tree
return Copy_Node_With_Replacement (Source);
- end New_Copy_Tree;
+ end New_Copy_Tree1;
----------------
-- New_Entity --
diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads
index df25f6e7291..8807638f862 100644
--- a/gcc/ada/atree.ads
+++ b/gcc/ada/atree.ads
@@ -430,7 +430,7 @@ package Atree is
-- Source to be Empty, in which case Relocate_Node simply returns
-- Empty as the result.
- function New_Copy_Tree
+ function New_Copy_Tree1
(Source : Node_Id;
Map : Elist_Id := No_Elist;
New_Sloc : Source_Ptr := No_Location;
@@ -3114,6 +3114,95 @@ package Atree is
for Node_Record'Size use 8*32;
for Node_Record'Alignment use 4;
+ function E_To_N is new Unchecked_Conversion (Entity_Kind, Node_Kind);
+ function N_To_E is new Unchecked_Conversion (Node_Kind, Entity_Kind);
+
+ -- Default value used to initialize default nodes. Note that some of the
+ -- fields get overwritten, and in particular, Nkind always gets reset.
+
+ Default_Node : Node_Record := (
+ Is_Extension => False,
+ Pflag1 => False,
+ Pflag2 => False,
+ In_List => False,
+ Unused_1 => False,
+ Rewrite_Ins => False,
+ Analyzed => False,
+ Comes_From_Source => False,
+ -- modified by Set_Comes_From_Source_Default
+ Error_Posted => False,
+ Flag4 => False,
+
+ Flag5 => False,
+ Flag6 => False,
+ Flag7 => False,
+ Flag8 => False,
+ Flag9 => False,
+ Flag10 => False,
+ Flag11 => False,
+ Flag12 => False,
+
+ Flag13 => False,
+ Flag14 => False,
+ Flag15 => False,
+ Flag16 => False,
+ Flag17 => False,
+ Flag18 => False,
+
+ Nkind => N_Unused_At_Start,
+
+ Sloc => No_Location,
+ Link => Empty_List_Or_Node,
+ Field1 => Empty_List_Or_Node,
+ Field2 => Empty_List_Or_Node,
+ Field3 => Empty_List_Or_Node,
+ Field4 => Empty_List_Or_Node,
+ Field5 => Empty_List_Or_Node);
+
+ -- Default value used to initialize node extensions (i.e. the second
+ -- and third and fourth components of an extended node). Note we are
+ -- cheating a bit here when it comes to Node12, which really holds
+ -- flags an (for the third component), the convention. But it works
+ -- because Empty, False, Convention_Ada, all happen to be all zero bits.
+
+ Default_Node_Extension : constant Node_Record := (
+ Is_Extension => True,
+ Pflag1 => False,
+ Pflag2 => False,
+ In_List => False,
+ Unused_1 => False,
+ Rewrite_Ins => False,
+ Analyzed => False,
+ Comes_From_Source => False,
+ Error_Posted => False,
+ Flag4 => False,
+
+ Flag5 => False,
+ Flag6 => False,
+ Flag7 => False,
+ Flag8 => False,
+ Flag9 => False,
+ Flag10 => False,
+ Flag11 => False,
+ Flag12 => False,
+
+ Flag13 => False,
+ Flag14 => False,
+ Flag15 => False,
+ Flag16 => False,
+ Flag17 => False,
+ Flag18 => False,
+
+ Nkind => E_To_N (E_Void),
+
+ Field6 => Empty_List_Or_Node,
+ Field7 => Empty_List_Or_Node,
+ Field8 => Empty_List_Or_Node,
+ Field9 => Empty_List_Or_Node,
+ Field10 => Empty_List_Or_Node,
+ Field11 => Empty_List_Or_Node,
+ Field12 => Empty_List_Or_Node);
+
-- The following defines the extendable array used for the nodes table
-- Nodes with extensions use five consecutive entries in the array
diff --git a/gcc/ada/lib-load.adb b/gcc/ada/lib-load.adb
index 1ceb389d553..857b609b0bc 100644
--- a/gcc/ada/lib-load.adb
+++ b/gcc/ada/lib-load.adb
@@ -169,14 +169,14 @@ package body Lib.Load is
Chars => Chars (Selector_Name (Name (With_Node))));
Du_Name :=
Make_Defining_Program_Unit_Name (No_Location,
- Name => New_Copy_Tree (Prefix (Name (With_Node))),
+ Name => Copy_Separate_Tree (Prefix (Name (With_Node))),
Defining_Identifier => Cunit_Entity);
Set_Is_Child_Unit (Cunit_Entity);
End_Lab :=
Make_Designator (No_Location,
- Name => New_Copy_Tree (Prefix (Name (With_Node))),
+ Name => Copy_Separate_Tree (Prefix (Name (With_Node))),
Identifier => New_Occurrence_Of (Cunit_Entity, No_Location));
end if;
diff --git a/gcc/ada/nlists.adb b/gcc/ada/nlists.adb
index 7a2b4b4a103..09bd85a8439 100644
--- a/gcc/ada/nlists.adb
+++ b/gcc/ada/nlists.adb
@@ -745,31 +745,6 @@ package body Nlists is
end if;
end New_Copy_List_Original;
- ------------------------
- -- New_Copy_List_Tree --
- ------------------------
-
- function New_Copy_List_Tree (List : List_Id) return List_Id is
- NL : List_Id;
- E : Node_Id;
-
- begin
- if List = No_List then
- return No_List;
-
- else
- NL := New_List;
- E := First (List);
-
- while Present (E) loop
- Append (New_Copy_Tree (E), NL);
- E := Next (E);
- end loop;
-
- return NL;
- end if;
- end New_Copy_List_Tree;
-
--------------
-- New_List --
--------------
diff --git a/gcc/ada/nlists.ads b/gcc/ada/nlists.ads
index 5a6b94f9d06..3753936df10 100644
--- a/gcc/ada/nlists.ads
+++ b/gcc/ada/nlists.ads
@@ -108,13 +108,6 @@ package Nlists is
function New_Copy_List_Original (List : List_Id) return List_Id;
-- Same as New_Copy_List but copies only nodes coming from source
- function New_Copy_List_Tree (List : List_Id) return List_Id;
- -- Similar to New_Copy_List, except that the copies are done using the
- -- Atree.New_Copy_Tree function, which means that a full recursive copy
- -- of the subtrees in the list is performed, setting proper parents. As
- -- for New_Copy_Tree, it is illegal to attempt to copy extended nodes
- -- (entities) either directly or indirectly using this function.
-
function First (List : List_Id) return Node_Id;
pragma Inline (First);
-- Obtains the first element of the given node list or, if the node list
diff --git a/gcc/ada/par-ch6.adb b/gcc/ada/par-ch6.adb
index 263efe1e5a3..d91b2d9f15d 100644
--- a/gcc/ada/par-ch6.adb
+++ b/gcc/ada/par-ch6.adb
@@ -221,13 +221,12 @@ package body Ch6 is
-- and bodies can occur.
if Pf_Flags /= Pf_Decl_Gins_Pbod_Rnam_Stub
- and then Pf_Flags /= Pf_Decl_Pbod
+ and then
+ Pf_Flags /= Pf_Decl_Pbod
then
Error_Msg_SC ("overriding indicator not allowed here!");
- elsif Token /= Tok_Function
- and then Token /= Tok_Procedure
- then
+ elsif Token /= Tok_Function and then Token /= Tok_Procedure then
Error_Msg_SC ("FUNCTION or PROCEDURE expected!");
end if;
end if;
diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb
index 73e1f40109d..d8f368d3996 100644
--- a/gcc/ada/prj.adb
+++ b/gcc/ada/prj.adb
@@ -715,8 +715,8 @@ package body Prj is
is
begin
if Object_File_Suffix = No_Name then
- return Extend_Name (Source_File_Name, Object_Suffix);
-
+ return Extend_Name
+ (Source_File_Name, Object_Suffix);
else
return Extend_Name
(Source_File_Name, Get_Name_String (Object_File_Suffix));
@@ -880,6 +880,7 @@ package body Prj is
loop
Free (Tree.Projects.Table (P));
end loop;
+
Project_Table.Free (Tree.Projects);
-- Private part
@@ -929,6 +930,7 @@ package body Prj is
Free (Tree.Projects.Table (P));
end loop;
end if;
+
Project_Table.Init (Tree.Projects);
-- Private part table
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index d036c858e84..337d1ac0cf0 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -59,8 +59,38 @@ with Tbuild; use Tbuild;
with Ttypes; use Ttypes;
with Uname; use Uname;
+with GNAT.HTable; use GNAT.HTable;
package body Sem_Util is
+ ----------------------------------------
+ -- Global_Variables for New_Copy_Tree --
+ ----------------------------------------
+
+ -- These global variables are used by New_Copy_Tree. See description
+ -- of the body of this subprogram for details. Global variables can be
+ -- safely used by New_Copy_Tree, since there is no case of a recursive
+ -- call from the processing inside New_Copy_Tree.
+
+ NCT_Hash_Threshhold : constant := 20;
+ -- If there are more than this number of pairs of entries in the
+ -- map, then Hash_Tables_Used will be set, and the hash tables will
+ -- be initialized and used for the searches.
+
+ NCT_Hash_Tables_Used : Boolean := False;
+ -- Set to True if hash tables are in use
+
+ NCT_Table_Entries : Nat;
+ -- Count entries in table to see if threshhold is reached
+
+ NCT_Hash_Table_Setup : Boolean := False;
+ -- Set to True if hash table contains data. We set this True if we
+ -- setup the hash table with data, and leave it set permanently
+ -- from then on, this is a signal that second and subsequent users
+ -- of the hash table must clear the old entries before reuse.
+
+ subtype NCT_Header_Num is Int range 0 .. 511;
+ -- Defines range of headers in hash tables (512 headers)
+
-----------------------
-- Local Subprograms --
-----------------------
@@ -7431,6 +7461,954 @@ package body Sem_Util is
end if;
end Needs_One_Actual;
+ ------------------------
+ -- New_Copy_List_Tree --
+ ------------------------
+
+ function New_Copy_List_Tree (List : List_Id) return List_Id is
+ NL : List_Id;
+ E : Node_Id;
+
+ begin
+ if List = No_List then
+ return No_List;
+
+ else
+ NL := New_List;
+ E := First (List);
+
+ while Present (E) loop
+ Append (New_Copy_Tree (E), NL);
+ E := Next (E);
+ end loop;
+
+ return NL;
+ end if;
+ end New_Copy_List_Tree;
+
+ -------------------
+ -- New_Copy_Tree --
+ -------------------
+
+ use Atree.Unchecked_Access;
+ use Atree_Private_Part;
+
+ -- Our approach here requires a two pass traversal of the tree. The
+ -- first pass visits all nodes that eventually will be copied looking
+ -- for defining Itypes. If any defining Itypes are found, then they are
+ -- copied, and an entry is added to the replacement map. In the second
+ -- phase, the tree is copied, using the replacement map to replace any
+ -- Itype references within the copied tree.
+
+ -- The following hash tables are used if the Map supplied has more
+ -- than hash threshhold entries to speed up access to the map. If
+ -- there are fewer entries, then the map is searched sequentially
+ -- (because setting up a hash table for only a few entries takes
+ -- more time than it saves.
+
+ function New_Copy_Hash (E : Entity_Id) return NCT_Header_Num;
+ -- Hash function used for hash operations
+
+ -------------------
+ -- New_Copy_Hash --
+ -------------------
+
+ function New_Copy_Hash (E : Entity_Id) return NCT_Header_Num is
+ begin
+ return Nat (E) mod (NCT_Header_Num'Last + 1);
+ end New_Copy_Hash;
+
+ ---------------
+ -- NCT_Assoc --
+ ---------------
+
+ -- The hash table NCT_Assoc associates old entities in the table
+ -- with their corresponding new entities (i.e. the pairs of entries
+ -- presented in the original Map argument are Key-Element pairs).
+
+ package NCT_Assoc is new Simple_HTable (
+ Header_Num => NCT_Header_Num,
+ Element => Entity_Id,
+ No_Element => Empty,
+ Key => Entity_Id,
+ Hash => New_Copy_Hash,
+ Equal => Types."=");
+
+ ---------------------
+ -- NCT_Itype_Assoc --
+ ---------------------
+
+ -- The hash table NCT_Itype_Assoc contains entries only for those
+ -- old nodes which have a non-empty Associated_Node_For_Itype set.
+ -- The key is the associated node, and the element is the new node
+ -- itself (NOT the associated node for the new node).
+
+ package NCT_Itype_Assoc is new Simple_HTable (
+ Header_Num => NCT_Header_Num,
+ Element => Entity_Id,
+ No_Element => Empty,
+ Key => Entity_Id,
+ Hash => New_Copy_Hash,
+ Equal => Types."=");
+
+ -- Start of processing for New_Copy_Tree function
+
+ function New_Copy_Tree
+ (Source : Node_Id;
+ Map : Elist_Id := No_Elist;
+ New_Sloc : Source_Ptr := No_Location;
+ New_Scope : Entity_Id := Empty) return Node_Id
+ is
+ Actual_Map : Elist_Id := Map;
+ -- This is the actual map for the copy. It is initialized with the
+ -- given elements, and then enlarged as required for Itypes that are
+ -- copied during the first phase of the copy operation. The visit
+ -- procedures add elements to this map as Itypes are encountered.
+ -- The reason we cannot use Map directly, is that it may well be
+ -- (and normally is) initialized to No_Elist, and if we have mapped
+ -- entities, we have to reset it to point to a real Elist.
+
+ function Assoc (N : Node_Or_Entity_Id) return Node_Id;
+ -- Called during second phase to map entities into their corresponding
+ -- copies using Actual_Map. If the argument is not an entity, or is not
+ -- in Actual_Map, then it is returned unchanged.
+
+ procedure Build_NCT_Hash_Tables;
+ -- Builds hash tables (number of elements >= threshold value)
+
+ function Copy_Elist_With_Replacement
+ (Old_Elist : Elist_Id) return Elist_Id;
+ -- Called during second phase to copy element list doing replacements
+
+ procedure Copy_Itype_With_Replacement (New_Itype : Entity_Id);
+ -- Called during the second phase to process a copied Itype. The actual
+ -- copy happened during the first phase (so that we could make the entry
+ -- in the mapping), but we still have to deal with the descendents of
+ -- the copied Itype and copy them where necessary.
+
+ function Copy_List_With_Replacement (Old_List : List_Id) return List_Id;
+ -- Called during second phase to copy list doing replacements
+
+ function Copy_Node_With_Replacement (Old_Node : Node_Id) return Node_Id;
+ -- Called during second phase to copy node doing replacements
+
+ procedure Visit_Elist (E : Elist_Id);
+ -- Called during first phase to visit all elements of an Elist
+
+ procedure Visit_Field (F : Union_Id; N : Node_Id);
+ -- Visit a single field, recursing to call Visit_Node or Visit_List
+ -- if the field is a syntactic descendent of the current node (i.e.
+ -- its parent is Node N).
+
+ procedure Visit_Itype (Old_Itype : Entity_Id);
+ -- Called during first phase to visit subsidiary fields of a defining
+ -- Itype, and also create a copy and make an entry in the replacement
+ -- map for the new copy.
+
+ procedure Visit_List (L : List_Id);
+ -- Called during first phase to visit all elements of a List
+
+ procedure Visit_Node (N : Node_Or_Entity_Id);
+ -- Called during first phase to visit a node and all its subtrees
+
+ -----------
+ -- Assoc --
+ -----------
+
+ function Assoc (N : Node_Or_Entity_Id) return Node_Id is
+ E : Elmt_Id;
+ Ent : Entity_Id;
+
+ begin
+ if not Has_Extension (N) or else No (Actual_Map) then
+ return N;
+
+ elsif NCT_Hash_Tables_Used then
+ Ent := NCT_Assoc.Get (Entity_Id (N));
+
+ if Present (Ent) then
+ return Ent;
+ else
+ return N;
+ end if;
+
+ -- No hash table used, do serial search
+
+ else
+ E := First_Elmt (Actual_Map);
+ while Present (E) loop
+ if Node (E) = N then
+ return Node (Next_Elmt (E));
+ else
+ E := Next_Elmt (Next_Elmt (E));
+ end if;
+ end loop;
+ end if;
+
+ return N;
+ end Assoc;
+
+ ---------------------------
+ -- Build_NCT_Hash_Tables --
+ ---------------------------
+
+ procedure Build_NCT_Hash_Tables is
+ Elmt : Elmt_Id;
+ Ent : Entity_Id;
+ begin
+ if NCT_Hash_Table_Setup then
+ NCT_Assoc.Reset;
+ NCT_Itype_Assoc.Reset;
+ end if;
+
+ Elmt := First_Elmt (Actual_Map);
+ while Present (Elmt) loop
+ Ent := Node (Elmt);
+
+ -- Get new entity, and associate old and new
+
+ Next_Elmt (Elmt);
+ NCT_Assoc.Set (Ent, Node (Elmt));
+
+ if Is_Type (Ent) then
+ declare
+ Anode : constant Entity_Id :=
+ Associated_Node_For_Itype (Ent);
+
+ begin
+ if Present (Anode) then
+
+ -- Enter a link between the associated node of the
+ -- old Itype and the new Itype, for updating later
+ -- when node is copied.
+
+ NCT_Itype_Assoc.Set (Anode, Node (Elmt));
+ end if;
+ end;
+ end if;
+
+ Next_Elmt (Elmt);
+ end loop;
+
+ NCT_Hash_Tables_Used := True;
+ NCT_Hash_Table_Setup := True;
+ end Build_NCT_Hash_Tables;
+
+ ---------------------------------
+ -- Copy_Elist_With_Replacement --
+ ---------------------------------
+
+ function Copy_Elist_With_Replacement
+ (Old_Elist : Elist_Id) return Elist_Id
+ is
+ M : Elmt_Id;
+ New_Elist : Elist_Id;
+
+ begin
+ if No (Old_Elist) then
+ return No_Elist;
+
+ else
+ New_Elist := New_Elmt_List;
+
+ M := First_Elmt (Old_Elist);
+ while Present (M) loop
+ Append_Elmt (Copy_Node_With_Replacement (Node (M)), New_Elist);
+ Next_Elmt (M);
+ end loop;
+ end if;
+
+ return New_Elist;
+ end Copy_Elist_With_Replacement;
+
+ ---------------------------------
+ -- Copy_Itype_With_Replacement --
+ ---------------------------------
+
+ -- This routine exactly parallels its phase one analog Visit_Itype,
+
+ procedure Copy_Itype_With_Replacement (New_Itype : Entity_Id) is
+ begin
+ -- Translate Next_Entity, Scope and Etype fields, in case they
+ -- reference entities that have been mapped into copies.
+
+ Set_Next_Entity (New_Itype, Assoc (Next_Entity (New_Itype)));
+ Set_Etype (New_Itype, Assoc (Etype (New_Itype)));
+
+ if Present (New_Scope) then
+ Set_Scope (New_Itype, New_Scope);
+ else
+ Set_Scope (New_Itype, Assoc (Scope (New_Itype)));
+ end if;
+
+ -- Copy referenced fields
+
+ if Is_Discrete_Type (New_Itype) then
+ Set_Scalar_Range (New_Itype,
+ Copy_Node_With_Replacement (Scalar_Range (New_Itype)));
+
+ elsif Has_Discriminants (Base_Type (New_Itype)) then
+ Set_Discriminant_Constraint (New_Itype,
+ Copy_Elist_With_Replacement
+ (Discriminant_Constraint (New_Itype)));
+
+ elsif Is_Array_Type (New_Itype) then
+ if Present (First_Index (New_Itype)) then
+ Set_First_Index (New_Itype,
+ First (Copy_List_With_Replacement
+ (List_Containing (First_Index (New_Itype)))));
+ end if;
+
+ if Is_Packed (New_Itype) then
+ Set_Packed_Array_Type (New_Itype,
+ Copy_Node_With_Replacement
+ (Packed_Array_Type (New_Itype)));
+ end if;
+ end if;
+ end Copy_Itype_With_Replacement;
+
+ --------------------------------
+ -- Copy_List_With_Replacement --
+ --------------------------------
+
+ function Copy_List_With_Replacement
+ (Old_List : List_Id) return List_Id
+ is
+ New_List : List_Id;
+ E : Node_Id;
+
+ begin
+ if Old_List = No_List then
+ return No_List;
+
+ else
+ New_List := Empty_List;
+
+ E := First (Old_List);
+ while Present (E) loop
+ Append (Copy_Node_With_Replacement (E), New_List);
+ Next (E);
+ end loop;
+
+ return New_List;
+ end if;
+ end Copy_List_With_Replacement;
+
+ --------------------------------
+ -- Copy_Node_With_Replacement --
+ --------------------------------
+
+ function Copy_Node_With_Replacement
+ (Old_Node : Node_Id) return Node_Id
+ is
+ New_Node : Node_Id;
+
+ procedure Adjust_Named_Associations
+ (Old_Node : Node_Id;
+ New_Node : Node_Id);
+ -- If a call node has named associations, these are chained through
+ -- the First_Named_Actual, Next_Named_Actual links. These must be
+ -- propagated separately to the new parameter list, because these
+ -- are not syntactic fields.
+
+ function Copy_Field_With_Replacement
+ (Field : Union_Id) return Union_Id;
+ -- Given Field, which is a field of Old_Node, return a copy of it
+ -- if it is a syntactic field (i.e. its parent is Node), setting
+ -- the parent of the copy to poit to New_Node. Otherwise returns
+ -- the field (possibly mapped if it is an entity).
+
+ -------------------------------
+ -- Adjust_Named_Associations --
+ -------------------------------
+
+ procedure Adjust_Named_Associations
+ (Old_Node : Node_Id;
+ New_Node : Node_Id)
+ is
+ Old_E : Node_Id;
+ New_E : Node_Id;
+
+ Old_Next : Node_Id;
+ New_Next : Node_Id;
+
+ begin
+ Old_E := First (Parameter_Associations (Old_Node));
+ New_E := First (Parameter_Associations (New_Node));
+ while Present (Old_E) loop
+ if Nkind (Old_E) = N_Parameter_Association
+ and then Present (Next_Named_Actual (Old_E))
+ then
+ if First_Named_Actual (Old_Node)
+ = Explicit_Actual_Parameter (Old_E)
+ then
+ Set_First_Named_Actual
+ (New_Node, Explicit_Actual_Parameter (New_E));
+ end if;
+
+ -- Now scan parameter list from the beginning,to locate
+ -- next named actual, which can be out of order.
+
+ Old_Next := First (Parameter_Associations (Old_Node));
+ New_Next := First (Parameter_Associations (New_Node));
+
+ while Nkind (Old_Next) /= N_Parameter_Association
+ or else Explicit_Actual_Parameter (Old_Next)
+ /= Next_Named_Actual (Old_E)
+ loop
+ Next (Old_Next);
+ Next (New_Next);
+ end loop;
+
+ Set_Next_Named_Actual
+ (New_E, Explicit_Actual_Parameter (New_Next));
+ end if;
+
+ Next (Old_E);
+ Next (New_E);
+ end loop;
+ end Adjust_Named_Associations;
+
+ ---------------------------------
+ -- Copy_Field_With_Replacement --
+ ---------------------------------
+
+ function Copy_Field_With_Replacement
+ (Field : Union_Id) return Union_Id
+ is
+ begin
+ if Field = Union_Id (Empty) then
+ return Field;
+
+ elsif Field in Node_Range then
+ declare
+ Old_N : constant Node_Id := Node_Id (Field);
+ New_N : Node_Id;
+
+ begin
+ -- If syntactic field, as indicated by the parent pointer
+ -- being set, then copy the referenced node recursively.
+
+ if Parent (Old_N) = Old_Node then
+ New_N := Copy_Node_With_Replacement (Old_N);
+
+ if New_N /= Old_N then
+ Set_Parent (New_N, New_Node);
+ end if;
+
+ -- For semantic fields, update possible entity reference
+ -- from the replacement map.
+
+ else
+ New_N := Assoc (Old_N);
+ end if;
+
+ return Union_Id (New_N);
+ end;
+
+ elsif Field in List_Range then
+ declare
+ Old_L : constant List_Id := List_Id (Field);
+ New_L : List_Id;
+
+ begin
+ -- If syntactic field, as indicated by the parent pointer,
+ -- then recursively copy the entire referenced list.
+
+ if Parent (Old_L) = Old_Node then
+ New_L := Copy_List_With_Replacement (Old_L);
+ Set_Parent (New_L, New_Node);
+
+ -- For semantic list, just returned unchanged
+
+ else
+ New_L := Old_L;
+ end if;
+
+ return Union_Id (New_L);
+ end;
+
+ -- Anything other than a list or a node is returned unchanged
+
+ else
+ return Field;
+ end if;
+ end Copy_Field_With_Replacement;
+
+ -- Start of processing for Copy_Node_With_Replacement
+
+ begin
+ if Old_Node <= Empty_Or_Error then
+ return Old_Node;
+
+ elsif Has_Extension (Old_Node) then
+ return Assoc (Old_Node);
+
+ else
+ New_Node := New_Copy (Old_Node);
+
+ -- If the node we are copying is the associated node of a
+ -- previously copied Itype, then adjust the associated node
+ -- of the copy of that Itype accordingly.
+
+ if Present (Actual_Map) then
+ declare
+ E : Elmt_Id;
+ Ent : Entity_Id;
+
+ begin
+ -- Case of hash table used
+
+ if NCT_Hash_Tables_Used then
+ Ent := NCT_Itype_Assoc.Get (Old_Node);
+
+ if Present (Ent) then
+ Set_Associated_Node_For_Itype (Ent, New_Node);
+ end if;
+
+ -- Case of no hash table used
+
+ else
+ E := First_Elmt (Actual_Map);
+ while Present (E) loop
+ if Is_Itype (Node (E))
+ and then
+ Old_Node = Associated_Node_For_Itype (Node (E))
+ then
+ Set_Associated_Node_For_Itype
+ (Node (Next_Elmt (E)), New_Node);
+ end if;
+
+ E := Next_Elmt (Next_Elmt (E));
+ end loop;
+ end if;
+ end;
+ end if;
+
+ -- Recursively copy descendents
+
+ Set_Field1
+ (New_Node, Copy_Field_With_Replacement (Field1 (New_Node)));
+ Set_Field2
+ (New_Node, Copy_Field_With_Replacement (Field2 (New_Node)));
+ Set_Field3
+ (New_Node, Copy_Field_With_Replacement (Field3 (New_Node)));
+ Set_Field4
+ (New_Node, Copy_Field_With_Replacement (Field4 (New_Node)));
+ Set_Field5
+ (New_Node, Copy_Field_With_Replacement (Field5 (New_Node)));
+
+ -- Adjust Sloc of new node if necessary
+
+ if New_Sloc /= No_Location then
+ Set_Sloc (New_Node, New_Sloc);
+
+ -- If we adjust the Sloc, then we are essentially making
+ -- a completely new node, so the Comes_From_Source flag
+ -- should be reset to the proper default value.
+
+ Nodes.Table (New_Node).Comes_From_Source :=
+ Default_Node.Comes_From_Source;
+ end if;
+
+ -- If the node is call and has named associations,
+ -- set the corresponding links in the copy.
+
+ if (Nkind (Old_Node) = N_Function_Call
+ or else Nkind (Old_Node) = N_Entry_Call_Statement
+ or else
+ Nkind (Old_Node) = N_Procedure_Call_Statement)
+ and then Present (First_Named_Actual (Old_Node))
+ then
+ Adjust_Named_Associations (Old_Node, New_Node);
+ end if;
+
+ -- Reset First_Real_Statement for Handled_Sequence_Of_Statements.
+ -- The replacement mechanism applies to entities, and is not used
+ -- here. Eventually we may need a more general graph-copying
+ -- routine. For now, do a sequential search to find desired node.
+
+ if Nkind (Old_Node) = N_Handled_Sequence_Of_Statements
+ and then Present (First_Real_Statement (Old_Node))
+ then
+ declare
+ Old_F : constant Node_Id := First_Real_Statement (Old_Node);
+ N1, N2 : Node_Id;
+
+ begin
+ N1 := First (Statements (Old_Node));
+ N2 := First (Statements (New_Node));
+
+ while N1 /= Old_F loop
+ Next (N1);
+ Next (N2);
+ end loop;
+
+ Set_First_Real_Statement (New_Node, N2);
+ end;
+ end if;
+ end if;
+
+ -- All done, return copied node
+
+ return New_Node;
+ end Copy_Node_With_Replacement;
+
+ -----------------
+ -- Visit_Elist --
+ -----------------
+
+ procedure Visit_Elist (E : Elist_Id) is
+ Elmt : Elmt_Id;
+ begin
+ if Present (E) then
+ Elmt := First_Elmt (E);
+
+ while Elmt /= No_Elmt loop
+ Visit_Node (Node (Elmt));
+ Next_Elmt (Elmt);
+ end loop;
+ end if;
+ end Visit_Elist;
+
+ -----------------
+ -- Visit_Field --
+ -----------------
+
+ procedure Visit_Field (F : Union_Id; N : Node_Id) is
+ begin
+ if F = Union_Id (Empty) then
+ return;
+
+ elsif F in Node_Range then
+
+ -- Copy node if it is syntactic, i.e. its parent pointer is
+ -- set to point to the field that referenced it (certain
+ -- Itypes will also meet this criterion, which is fine, since
+ -- these are clearly Itypes that do need to be copied, since
+ -- we are copying their parent.)
+
+ if Parent (Node_Id (F)) = N then
+ Visit_Node (Node_Id (F));
+ return;
+
+ -- Another case, if we are pointing to an Itype, then we want
+ -- to copy it if its associated node is somewhere in the tree
+ -- being copied.
+
+ -- Note: the exclusion of self-referential copies is just an
+ -- optimization, since the search of the already copied list
+ -- would catch it, but it is a common case (Etype pointing
+ -- to itself for an Itype that is a base type).
+
+ elsif Has_Extension (Node_Id (F))
+ and then Is_Itype (Entity_Id (F))
+ and then Node_Id (F) /= N
+ then
+ declare
+ P : Node_Id;
+
+ begin
+ P := Associated_Node_For_Itype (Node_Id (F));
+ while Present (P) loop
+ if P = Source then
+ Visit_Node (Node_Id (F));
+ return;
+ else
+ P := Parent (P);
+ end if;
+ end loop;
+
+ -- An Itype whose parent is not being copied definitely
+ -- should NOT be copied, since it does not belong in any
+ -- sense to the copied subtree.
+
+ return;
+ end;
+ end if;
+
+ elsif F in List_Range
+ and then Parent (List_Id (F)) = N
+ then
+ Visit_List (List_Id (F));
+ return;
+ end if;
+ end Visit_Field;
+
+ -----------------
+ -- Visit_Itype --
+ -----------------
+
+ procedure Visit_Itype (Old_Itype : Entity_Id) is
+ New_Itype : Entity_Id;
+ E : Elmt_Id;
+ Ent : Entity_Id;
+
+ begin
+ -- Itypes that describe the designated type of access to subprograms
+ -- have the structure of subprogram declarations, with signatures,
+ -- etc. Either we duplicate the signatures completely, or choose to
+ -- share such itypes, which is fine because their elaboration will
+ -- have no side effects.
+
+ if Ekind (Old_Itype) = E_Subprogram_Type then
+ return;
+ end if;
+
+ New_Itype := New_Copy (Old_Itype);
+
+ -- The new Itype has all the attributes of the old one, and
+ -- we just copy the contents of the entity. However, the back-end
+ -- needs different names for debugging purposes, so we create a
+ -- new internal name for it in all cases.
+
+ Set_Chars (New_Itype, New_Internal_Name ('T'));
+
+ -- If our associated node is an entity that has already been copied,
+ -- then set the associated node of the copy to point to the right
+ -- copy. If we have copied an Itype that is itself the associated
+ -- node of some previously copied Itype, then we set the right
+ -- pointer in the other direction.
+
+ if Present (Actual_Map) then
+
+ -- Case of hash tables used
+
+ if NCT_Hash_Tables_Used then
+
+ Ent := NCT_Assoc.Get (Associated_Node_For_Itype (Old_Itype));
+
+ if Present (Ent) then
+ Set_Associated_Node_For_Itype (New_Itype, Ent);
+ end if;
+
+ Ent := NCT_Itype_Assoc.Get (Old_Itype);
+ if Present (Ent) then
+ Set_Associated_Node_For_Itype (Ent, New_Itype);
+
+ -- If the hash table has no association for this Itype and
+ -- its associated node, enter one now.
+
+ else
+ NCT_Itype_Assoc.Set
+ (Associated_Node_For_Itype (Old_Itype), New_Itype);
+ end if;
+
+ -- Case of hash tables not used
+
+ else
+ E := First_Elmt (Actual_Map);
+ while Present (E) loop
+ if Associated_Node_For_Itype (Old_Itype) = Node (E) then
+ Set_Associated_Node_For_Itype
+ (New_Itype, Node (Next_Elmt (E)));
+ end if;
+
+ if Is_Type (Node (E))
+ and then
+ Old_Itype = Associated_Node_For_Itype (Node (E))
+ then
+ Set_Associated_Node_For_Itype
+ (Node (Next_Elmt (E)), New_Itype);
+ end if;
+
+ E := Next_Elmt (Next_Elmt (E));
+ end loop;
+ end if;
+ end if;
+
+ if Present (Freeze_Node (New_Itype)) then
+ Set_Is_Frozen (New_Itype, False);
+ Set_Freeze_Node (New_Itype, Empty);
+ end if;
+
+ -- Add new association to map
+
+ if No (Actual_Map) then
+ Actual_Map := New_Elmt_List;
+ end if;
+
+ Append_Elmt (Old_Itype, Actual_Map);
+ Append_Elmt (New_Itype, Actual_Map);
+
+ if NCT_Hash_Tables_Used then
+ NCT_Assoc.Set (Old_Itype, New_Itype);
+
+ else
+ NCT_Table_Entries := NCT_Table_Entries + 1;
+
+ if NCT_Table_Entries > NCT_Hash_Threshhold then
+ Build_NCT_Hash_Tables;
+ end if;
+ end if;
+
+ -- If a record subtype is simply copied, the entity list will be
+ -- shared. Thus cloned_Subtype must be set to indicate the sharing.
+
+ if Ekind (Old_Itype) = E_Record_Subtype
+ or else Ekind (Old_Itype) = E_Class_Wide_Subtype
+ then
+ Set_Cloned_Subtype (New_Itype, Old_Itype);
+ end if;
+
+ -- Visit descendents that eventually get copied
+
+ Visit_Field (Union_Id (Etype (Old_Itype)), Old_Itype);
+
+ if Is_Discrete_Type (Old_Itype) then
+ Visit_Field (Union_Id (Scalar_Range (Old_Itype)), Old_Itype);
+
+ elsif Has_Discriminants (Base_Type (Old_Itype)) then
+ -- ??? This should involve call to Visit_Field
+ Visit_Elist (Discriminant_Constraint (Old_Itype));
+
+ elsif Is_Array_Type (Old_Itype) then
+ if Present (First_Index (Old_Itype)) then
+ Visit_Field (Union_Id (List_Containing
+ (First_Index (Old_Itype))),
+ Old_Itype);
+ end if;
+
+ if Is_Packed (Old_Itype) then
+ Visit_Field (Union_Id (Packed_Array_Type (Old_Itype)),
+ Old_Itype);
+ end if;
+ end if;
+ end Visit_Itype;
+
+ ----------------
+ -- Visit_List --
+ ----------------
+
+ procedure Visit_List (L : List_Id) is
+ N : Node_Id;
+ begin
+ if L /= No_List then
+ N := First (L);
+
+ while Present (N) loop
+ Visit_Node (N);
+ Next (N);
+ end loop;
+ end if;
+ end Visit_List;
+
+ ----------------
+ -- Visit_Node --
+ ----------------
+
+ procedure Visit_Node (N : Node_Or_Entity_Id) is
+
+ -- Start of processing for Visit_Node
+
+ begin
+ -- Handle case of an Itype, which must be copied
+
+ if Has_Extension (N)
+ and then Is_Itype (N)
+ then
+ -- Nothing to do if already in the list. This can happen with an
+ -- Itype entity that appears more than once in the tree.
+ -- Note that we do not want to visit descendents in this case.
+
+ -- Test for already in list when hash table is used
+
+ if NCT_Hash_Tables_Used then
+ if Present (NCT_Assoc.Get (Entity_Id (N))) then
+ return;
+ end if;
+
+ -- Test for already in list when hash table not used
+
+ else
+ declare
+ E : Elmt_Id;
+ begin
+ if Present (Actual_Map) then
+ E := First_Elmt (Actual_Map);
+ while Present (E) loop
+ if Node (E) = N then
+ return;
+ else
+ E := Next_Elmt (Next_Elmt (E));
+ end if;
+ end loop;
+ end if;
+ end;
+ end if;
+
+ Visit_Itype (N);
+ end if;
+
+ -- Visit descendents
+
+ Visit_Field (Field1 (N), N);
+ Visit_Field (Field2 (N), N);
+ Visit_Field (Field3 (N), N);
+ Visit_Field (Field4 (N), N);
+ Visit_Field (Field5 (N), N);
+ end Visit_Node;
+
+ -- Start of processing for New_Copy_Tree
+
+ begin
+ Actual_Map := Map;
+
+ -- See if we should use hash table
+
+ if No (Actual_Map) then
+ NCT_Hash_Tables_Used := False;
+
+ else
+ declare
+ Elmt : Elmt_Id;
+
+ begin
+ NCT_Table_Entries := 0;
+
+ Elmt := First_Elmt (Actual_Map);
+ while Present (Elmt) loop
+ NCT_Table_Entries := NCT_Table_Entries + 1;
+ Next_Elmt (Elmt);
+ Next_Elmt (Elmt);
+ end loop;
+
+ if NCT_Table_Entries > NCT_Hash_Threshhold then
+ Build_NCT_Hash_Tables;
+ else
+ NCT_Hash_Tables_Used := False;
+ end if;
+ end;
+ end if;
+
+ -- Hash table set up if required, now start phase one by visiting
+ -- top node (we will recursively visit the descendents).
+
+ Visit_Node (Source);
+
+ -- Now the second phase of the copy can start. First we process
+ -- all the mapped entities, copying their descendents.
+
+ if Present (Actual_Map) then
+ declare
+ Elmt : Elmt_Id;
+ New_Itype : Entity_Id;
+ begin
+ Elmt := First_Elmt (Actual_Map);
+ while Present (Elmt) loop
+ Next_Elmt (Elmt);
+ New_Itype := Node (Elmt);
+ Copy_Itype_With_Replacement (New_Itype);
+ Next_Elmt (Elmt);
+ end loop;
+ end;
+ end if;
+
+ -- Now we can copy the actual tree
+
+ return Copy_Node_With_Replacement (Source);
+ end New_Copy_Tree;
+
-------------------------
-- New_External_Entity --
-------------------------
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index ce6d4bd99d2..4046b785892 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -876,6 +876,57 @@ package Sem_Util is
-- formal. Used in Ada 2005 mode to solve the syntactic ambiguity that
-- results from an indexing of a function call written in prefix form.
+ function New_Copy_List_Tree (List : List_Id) return List_Id;
+ -- Copy recursively an analyzed list of nodes. Uses New_Copy_Tree defined
+ -- below. As for New_Copy_Tree, it is illegal to attempt to copy extended
+ -- nodes (entities) either directly or indirectly using this function.
+
+ function New_Copy_Tree
+ (Source : Node_Id;
+ Map : Elist_Id := No_Elist;
+ New_Sloc : Source_Ptr := No_Location;
+ New_Scope : Entity_Id := Empty) return Node_Id;
+ -- Given a node that is the root of a subtree, Copy_Tree copies the entire
+ -- syntactic subtree, including recursively any descendents whose parent
+ -- field references a copied node (descendents not linked to a copied node
+ -- by the parent field are not copied, instead the copied tree references
+ -- the same descendent as the original in this case, which is appropriate
+ -- for non-syntactic fields such as Etype). The parent pointers in the
+ -- copy are properly set. Copy_Tree (Empty/Error) returns Empty/Error.
+ -- The one exception to the rule of not copying semantic fields is that
+ -- any implicit types attached to the subtree are duplicated, so that
+ -- the copy contains a distinct set of implicit type entities. Thus this
+ -- function is used when it is necessary to duplicate an analyzed tree,
+ -- declared in the same or some other compilation unit. This function is
+ -- declared here rather than in atree because it uses semantic information
+ -- in particular concerning the structure of itypes and the generation of
+ -- public symbols.
+
+ -- The Map argument, if set to a non-empty Elist, specifies a set of
+ -- mappings to be applied to entities in the tree. The map has the form:
+ --
+ -- old entity 1
+ -- new entity to replace references to entity 1
+ -- old entity 2
+ -- new entity to replace references to entity 2
+ -- ...
+ --
+ -- The call destroys the contents of Map in this case
+ --
+ -- The parameter New_Sloc, if set to a value other than No_Location, is
+ -- used as the Sloc value for all nodes in the new copy. If New_Sloc is
+ -- set to its default value No_Location, then the Sloc values of the
+ -- nodes in the copy are simply copied from the corresponding original.
+ --
+ -- The Comes_From_Source indication is unchanged if New_Sloc is set to
+ -- the default No_Location value, but is reset if New_Sloc is given, since
+ -- in this case the result clearly is neither a source node or an exact
+ -- copy of a source node.
+ --
+ -- The parameter New_Scope, if set to a value other than Empty, is the
+ -- value to use as the Scope for any Itypes that are copied. The most
+ -- typical value for this parameter, if given, is Current_Scope.
+
function New_External_Entity
(Kind : Entity_Kind;
Scope_Id : Entity_Id;