Index: exp_aggr.adb
===================================================================
--- exp_aggr.adb	(revision 251892)
+++ exp_aggr.adb	(working copy)
@@ -6275,7 +6275,7 @@
               New_List (
                 Make_Assignment_Statement (Loc,
                   Name       => Target,
-                  Expression => New_Copy (N)));
+                  Expression => New_Copy_Tree (N)));
 
          else
             Aggr_Code :=
Index: exp_ch4.adb
===================================================================
--- exp_ch4.adb	(revision 251892)
+++ exp_ch4.adb	(working copy)
@@ -3194,7 +3194,7 @@
                 Object_Definition   => New_Occurrence_Of (Artyp, Loc),
                 Expression          =>
                   Make_Op_Add (Loc,
-                    Left_Opnd  => New_Copy (Aggr_Length (NN - 1)),
+                    Left_Opnd  => New_Copy_Tree (Aggr_Length (NN - 1)),
                     Right_Opnd => Clen)));
 
             Aggr_Length (NN) := Make_Identifier (Loc, Chars => Chars (Ent));
@@ -3275,7 +3275,7 @@
             function Get_Known_Bound (J : Nat) return Node_Id is
             begin
                if Is_Fixed_Length (J) or else J = NN then
-                  return New_Copy (Opnd_Low_Bound (J));
+                  return New_Copy_Tree (Opnd_Low_Bound (J));
 
                else
                   return
@@ -3288,7 +3288,7 @@
                           Right_Opnd =>
                             Make_Integer_Literal (Loc, 0)),
 
-                        New_Copy (Opnd_Low_Bound (J)),
+                        New_Copy_Tree (Opnd_Low_Bound (J)),
                         Get_Known_Bound (J + 1)));
                end if;
             end Get_Known_Bound;
@@ -3313,10 +3313,10 @@
       High_Bound :=
         To_Ityp
           (Make_Op_Add (Loc,
-             Left_Opnd  => To_Artyp (New_Copy (Low_Bound)),
+             Left_Opnd  => To_Artyp (New_Copy_Tree (Low_Bound)),
              Right_Opnd =>
                Make_Op_Subtract (Loc,
-                 Left_Opnd  => New_Copy (Aggr_Length (NN)),
+                 Left_Opnd  => New_Copy_Tree (Aggr_Length (NN)),
                  Right_Opnd => Make_Artyp_Literal (1))));
 
       --  Note that calculation of the high bound may cause overflow in some
@@ -3341,7 +3341,7 @@
            Make_If_Expression (Loc,
              Expressions => New_List (
                Make_Op_Eq (Loc,
-                 Left_Opnd  => New_Copy (Aggr_Length (NN)),
+                 Left_Opnd  => New_Copy_Tree (Aggr_Length (NN)),
                  Right_Opnd => Make_Artyp_Literal (0)),
                Last_Opnd_Low_Bound,
                Low_Bound));
@@ -3350,7 +3350,7 @@
            Make_If_Expression (Loc,
              Expressions => New_List (
                Make_Op_Eq (Loc,
-                 Left_Opnd  => New_Copy (Aggr_Length (NN)),
+                 Left_Opnd  => New_Copy_Tree (Aggr_Length (NN)),
                  Right_Opnd => Make_Artyp_Literal (0)),
                Last_Opnd_High_Bound,
                High_Bound));
@@ -3488,12 +3488,12 @@
          declare
             Lo : constant Node_Id :=
                    Make_Op_Add (Loc,
-                     Left_Opnd  => To_Artyp (New_Copy (Low_Bound)),
+                     Left_Opnd  => To_Artyp (New_Copy_Tree (Low_Bound)),
                      Right_Opnd => Aggr_Length (J - 1));
 
             Hi : constant Node_Id :=
                    Make_Op_Add (Loc,
-                     Left_Opnd  => To_Artyp (New_Copy (Low_Bound)),
+                     Left_Opnd  => To_Artyp (New_Copy_Tree (Low_Bound)),
                      Right_Opnd =>
                        Make_Op_Subtract (Loc,
                          Left_Opnd  => Aggr_Length (J),
@@ -7015,7 +7015,7 @@
 
          if Debug_Flag_Dot_H then
             declare
-               Cnod : constant Node_Id   := Relocate_Node (Cnode);
+               Cnod : constant Node_Id   := New_Copy_Tree (Cnode);
                Typ  : constant Entity_Id := Base_Type (Etype (Cnode));
 
             begin
@@ -11232,9 +11232,9 @@
          --  Apply an accessibility check when the conversion operand is an
          --  access parameter (or a renaming thereof), unless conversion was
          --  expanded from an Unchecked_ or Unrestricted_Access attribute,
-         --  or for the actual of a class-wide interface parameter.
-         --  Note that other checks may still need to be applied below (such
-         --  as tagged type checks).
+         --  or for the actual of a class-wide interface parameter. Note that
+         --  other checks may still need to be applied below (such as tagged
+         --  type checks).
 
          elsif Is_Entity_Name (Operand)
            and then Has_Extra_Accessibility (Entity (Operand))
@@ -11243,9 +11243,8 @@
                       or else Attribute_Name (Original_Node (N)) = Name_Access)
          then
             if not Comes_From_Source (N)
-              and then Nkind_In (Parent (N),
-                N_Function_Call,
-                N_Procedure_Call_Statement)
+              and then Nkind_In (Parent (N), N_Function_Call,
+                                             N_Procedure_Call_Statement)
               and then Is_Interface (Designated_Type (Target_Type))
               and then Is_Class_Wide_Type (Designated_Type (Target_Type))
             then
Index: sem_util.adb
===================================================================
--- sem_util.adb	(revision 251892)
+++ sem_util.adb	(working copy)
@@ -11715,6 +11715,26 @@
       end loop;
    end In_Subprogram_Or_Concurrent_Unit;
 
+   ----------------
+   -- In_Subtree --
+   ----------------
+
+   function In_Subtree (Root : Node_Id; N : Node_Id) return Boolean is
+      Curr : Node_Id;
+
+   begin
+      Curr := N;
+      while Present (Curr) loop
+         if Curr = Root then
+            return True;
+         end if;
+
+         Curr := Parent (Curr);
+      end loop;
+
+      return False;
+   end In_Subtree;
+
    ---------------------
    -- In_Visible_Part --
    ---------------------
@@ -17278,73 +17298,71 @@
       end if;
    end New_Copy_List_Tree;
 
-   --------------------------------------------------
-   -- New_Copy_Tree Auxiliary Data and Subprograms --
-   --------------------------------------------------
+   -------------------
+   -- New_Copy_Tree --
+   -------------------
 
-   use Atree.Unchecked_Access;
-   use Atree_Private_Part;
+   --  The following tables play a key role in replicating entities and Itypes.
+   --  They are intentionally declared at the library level rather than within
+   --  New_Copy_Tree to avoid elaborating them on each call. This performance
+   --  optimization saves up to 2% of the entire compilation time spent in the
+   --  front end. Care should be taken to reset the tables on each new call to
+   --  New_Copy_Tree.
 
-   --  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.
+   NCT_Table_Max : constant := 511;
 
-   --  The following hash tables are used to speed up access to the map. They
-   --  are declared at library level to avoid elaborating them for every call
-   --  to New_Copy_Tree. This can save up to 2% of the entire compilation time
-   --  spent in the front end.
+   subtype NCT_Table_Index is Nat range 0 .. NCT_Table_Max - 1;
 
-   subtype NCT_Header_Num is Int range 0 .. 511;
-   --  Defines range of headers in hash tables (512 headers)
+   function NCT_Table_Hash (Key : Node_Or_Entity_Id) return NCT_Table_Index;
+   --  Obtain the hash value of node or entity Key
 
-   function New_Copy_Hash (E : Entity_Id) return NCT_Header_Num;
-   --  Hash function used for hash operations
+   --------------------
+   -- NCT_Table_Hash --
+   --------------------
 
-   -------------------
-   -- New_Copy_Hash --
-   -------------------
-
-   function New_Copy_Hash (E : Entity_Id) return NCT_Header_Num is
+   function NCT_Table_Hash (Key : Node_Or_Entity_Id) return NCT_Table_Index is
    begin
-      return Nat (E) mod (NCT_Header_Num'Last + 1);
-   end New_Copy_Hash;
+      return NCT_Table_Index (Key mod NCT_Table_Max);
+   end NCT_Table_Hash;
 
-   ---------------
-   -- NCT_Assoc --
-   ---------------
+   ----------------------
+   -- NCT_New_Entities --
+   ----------------------
 
-   --  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).
+   --  The following table maps old entities and Itypes to their corresponding
+   --  new entities and Itypes.
 
-   package NCT_Assoc is new Simple_HTable (
-     Header_Num => NCT_Header_Num,
+   --    Aaa -> Xxx
+
+   package NCT_New_Entities is new Simple_HTable (
+     Header_Num => NCT_Table_Index,
      Element    => Entity_Id,
      No_Element => Empty,
      Key        => Entity_Id,
-     Hash       => New_Copy_Hash,
-     Equal      => Types."=");
+     Hash       => NCT_Table_Hash,
+     Equal      => "=");
 
-   ---------------------
-   -- NCT_Itype_Assoc --
-   ---------------------
+   ------------------------
+   -- NCT_Pending_Itypes --
+   ------------------------
 
-   --  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).
+   --  The following table maps old Associated_Node_For_Itype nodes to a set of
+   --  new itypes. Given a set of old Itypes Aaa, Bbb, and Ccc, where all three
+   --  have the same Associated_Node_For_Itype Ppp, and their corresponding new
+   --  Itypes Xxx, Yyy, Zzz, the table contains the following mapping:
 
-   package NCT_Itype_Assoc is new Simple_HTable (
-     Header_Num => NCT_Header_Num,
-     Element    => Node_Or_Entity_Id,
-     No_Element => Empty,
-     Key        => Entity_Id,
-     Hash       => New_Copy_Hash,
-     Equal      => Types."=");
+   --    Ppp -> (Xxx, Yyy, Zzz)
 
+   --  The set is expressed as an Elist
+
+   package NCT_Pending_Itypes is new Simple_HTable (
+     Header_Num => NCT_Table_Index,
+     Element    => Elist_Id,
+     No_Element => No_Elist,
+     Key        => Node_Id,
+     Hash       => NCT_Table_Hash,
+     Equal      => "=");
+
    -------------------
    -- New_Copy_Tree --
    -------------------
@@ -17355,527 +17373,910 @@
       New_Sloc  : Source_Ptr := No_Location;
       New_Scope : Entity_Id  := Empty) return Node_Id
    is
+      --  This routine performs low-level tree manipulations and needs access
+      --  to the internals of the tree.
+
+      use Atree.Unchecked_Access;
+      use Atree_Private_Part;
+
       EWA_Level : Nat := 0;
-      --  By default, copying of defining identifiers is prohibited because
-      --  this would introduce an entirely new entity into the tree. The
-      --  exception to this general rule is declaration of constants and
-      --  variables located in Expression_With_Action nodes.
+      --  This counter keeps track of how many N_Expression_With_Actions nodes
+      --  are encountered during a depth-first traversal of the subtree. These
+      --  nodes may define new entities in their Actions lists and thus require
+      --  special processing.
 
       EWA_Inner_Scope_Level : Nat := 0;
-      --  Level of internal scope of defined in EWAs. Used to avoid creating
-      --  variables for declarations located in blocks or subprograms defined
-      --  in Expression_With_Action nodes.
+      --  This counter keeps track of how many scoping constructs appear within
+      --  an N_Expression_With_Actions node.
 
-      NCT_Hash_Tables_Used : Boolean := False;
-      --  Set to True if hash tables are in use. It is intended to speed up the
-      --  common case, which is no hash tables in use. This can save up to 8%
-      --  of the entire compilation time spent in the front end.
+      NCT_Tables_In_Use : Boolean := False;
+      --  This flag keeps track of whether the two tables NCT_New_Entities and
+      --  NCT_Pending_Itypes are in use. The flag is part of an optimization
+      --  where certain operations are not performed if the tables are not in
+      --  use. This saves up to 8% of the entire compilation time spent in the
+      --  front end.
 
-      function Assoc (N : Node_Or_Entity_Id) return Node_Id;
-      --  Called during second phase to map entities into their corresponding
-      --  copies using the hash table. If the argument is not an entity, or is
-      --  not in the hash table, then it is returned unchanged.
+      procedure Add_New_Entity (Old_Id : Entity_Id; New_Id : Entity_Id);
+      pragma Inline (Add_New_Entity);
+      --  Add an entry in the NCT_New_Entities table which maps key Old_Id to
+      --  value New_Id. Old_Id is an entity which appears within the Actions
+      --  list of an N_Expression_With_Actions node, or within an entity map.
+      --  New_Id is the corresponding new entity generated during Phase 1.
 
-      procedure Build_NCT_Hash_Tables;
-      --  Builds hash tables
+      procedure Add_Pending_Itype (Assoc_Nod : Node_Id; Itype : Entity_Id);
+      pragma Inline (Add_New_Entity);
+      --  Add an entry in the NCT_Pending_Itypes which maps key Assoc_Nod to
+      --  value Itype. Assoc_Nod is the associated node of an itype. Itype is
+      --  an itype.
 
-      function Copy_Elist_With_Replacement
-        (Old_Elist : Elist_Id) return Elist_Id;
-      --  Called during second phase to copy element list doing replacements
+      procedure Build_NCT_Tables (Entity_Map : Elist_Id);
+      pragma Inline (Build_NCT_Tables);
+      --  Populate tables NCT_New_Entities and NCT_Pending_Itypes with the
+      --  information supplied in entity map Entity_Map. The format of the
+      --  entity map must be as follows:
+      --
+      --    Old_Id1, New_Id1, Old_Id2, New_Id2, .., Old_IdN, New_IdN
 
-      procedure Copy_Entity_With_Replacement (New_Entity : Entity_Id);
-      --  Called during the second phase to process a copied Entity. 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 descendants of
-      --  the copied Entity and copy them where necessary.
+      function Copy_Any_Node_With_Replacement
+        (N : Node_Or_Entity_Id) return Node_Or_Entity_Id;
+      pragma Inline (Copy_Any_Node_With_Replacement);
+      --  Replicate entity or node N by invoking one of the following routines:
+      --
+      --    Copy_Node_With_Replacement
+      --    Corresponding_Entity
 
-      function Copy_List_With_Replacement (Old_List : List_Id) return List_Id;
-      --  Called during second phase to copy list doing replacements
+      function Copy_Elist_With_Replacement (List : Elist_Id) return Elist_Id;
+      --  Replicate the elements of entity list List
 
-      function Copy_Node_With_Replacement (Old_Node : Node_Id) return Node_Id;
-      --  Called during second phase to copy node doing replacements
+      function Copy_Field_With_Replacement
+        (Field    : Union_Id;
+         Old_Par  : Node_Id := Empty;
+         New_Par  : Node_Id := Empty;
+         Semantic : Boolean := False) return Union_Id;
+      --  Replicate field Field by invoking one of the following routines:
+      --
+      --    Copy_Elist_With_Replacement
+      --    Copy_List_With_Replacement
+      --    Copy_Node_With_Replacement
+      --    Corresponding_Entity
+      --
+      --  If the field is not an entity list, entity, itype, syntactic list,
+      --  or node, then the field is returned unchanged. The routine always
+      --  replicates entities, itypes, and valid syntactic fields. Old_Par is
+      --  the expected parent of a syntactic field. New_Par is the new parent
+      --  associated with a replicated syntactic field. Flag Semantic should
+      --  be set when the input is a semantic field.
 
-      function In_Map (E : Entity_Id) return Boolean;
-      --  Return True if E is one of the old entities specified in the set of
-      --  mappings to be applied to entities in the tree (i.e. Map).
+      function Copy_List_With_Replacement (List : List_Id) return List_Id;
+      --  Replicate the elements of syntactic list List
 
-      procedure Visit_Elist (E : Elist_Id);
-      --  Called during first phase to visit all elements of an Elist
+      function Copy_Node_With_Replacement (N : Node_Id) return Node_Id;
+      --  Replicate node N
 
-      procedure Visit_Entity (Old_Entity : Entity_Id);
-      --  Called during first phase to visit subsidiary fields of a defining
-      --  entity which is not an itype, and also create a copy and make an
-      --  entry in the replacement map for the new copy.
+      function Corresponding_Entity (Id : Entity_Id) return Entity_Id;
+      pragma Inline (Corresponding_Entity);
+      --  Return the corresponding new entity of Id generated during Phase 1.
+      --  If there is no such entity, return Id.
 
-      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 descendant of the current node (i.e. its
-      --  parent is Node N).
+      function In_Entity_Map
+        (Id         : Entity_Id;
+         Entity_Map : Elist_Id) return Boolean;
+      pragma Inline (In_Entity_Map);
+      --  Determine whether entity Id is one of the old ids specified in entity
+      --  map Entity_Map. The format of the entity map must be as follows:
+      --
+      --    Old_Id1, New_Id1, Old_Id2, New_Id2, .., Old_IdN, New_IdN
 
-      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 Update_CFS_Sloc (N : Node_Or_Entity_Id);
+      pragma Inline (Update_CFS_Sloc);
+      --  Update the Comes_From_Source and Sloc attributes of node or entity N
 
-      procedure Visit_List (L : List_Id);
-      --  Called during first phase to visit all elements of a List
+      procedure Update_First_Real_Statement
+        (Old_HSS : Node_Id;
+         New_HSS : Node_Id);
+      pragma Inline (Update_First_Real_Statement);
+      --  Update semantic attribute First_Real_Statement of handled sequence of
+      --  statements New_HSS based on handled sequence of statements Old_HSS.
 
-      procedure Visit_Node (N : Node_Or_Entity_Id);
-      --  Called during first phase to visit a node and all its subtrees
+      procedure Update_Named_Associations
+        (Old_Call : Node_Id;
+         New_Call : Node_Id);
+      pragma Inline (Update_Named_Associations);
+      --  Update semantic chain First/Next_Named_Association of call New_call
+      --  based on call Old_Call.
 
-      -----------
-      -- Assoc --
-      -----------
+      procedure Update_New_Entities (Entity_Map : Elist_Id);
+      pragma Inline (Update_New_Entities);
+      --  Update the semantic attributes of all new entities generated during
+      --  Phase 1 that do not appear in entity map Entity_Map. The format of
+      --  the entity map must be as follows:
+      --
+      --    Old_Id1, New_Id1, Old_Id2, New_Id2, .., Old_IdN, New_IdN
 
-      function Assoc (N : Node_Or_Entity_Id) return Node_Id is
-         Ent : Entity_Id;
+      procedure Update_Pending_Itypes
+        (Old_Assoc : Node_Id;
+         New_Assoc : Node_Id);
+      pragma Inline (Update_Pending_Itypes);
+      --  Update semantic attribute Associated_Node_For_Itype to refer to node
+      --  New_Assoc for all itypes whose associated node is Old_Assoc.
 
+      procedure Update_Semantic_Fields (Id : Entity_Id);
+      pragma Inline (Update_Semantic_Fields);
+      --  Subsidiary to Update_New_Entities. Update semantic fields of entity
+      --  or itype Id.
+
+      procedure Visit_Any_Node (N : Node_Or_Entity_Id);
+      pragma Inline (Visit_Any_Node);
+      --  Visit entity of node N by invoking one of the following routines:
+      --
+      --    Visit_Entity
+      --    Visit_Itype
+      --    Visit_Node
+
+      procedure Visit_Elist (List : Elist_Id);
+      --  Visit the elements of entity list List
+
+      procedure Visit_Entity (Id : Entity_Id);
+      --  Visit entity Id. This action may create a new entity of Id and save
+      --  it in table NCT_New_Entities.
+
+      procedure Visit_Field
+        (Field    : Union_Id;
+         Par_Nod  : Node_Id := Empty;
+         Semantic : Boolean := False);
+      --  Visit field Field by invoking one of the following routines:
+      --
+      --    Visit_Elist
+      --    Visit_Entity
+      --    Visit_Itype
+      --    Visit_List
+      --    Visit_Node
+      --
+      --  If the field is not an entity list, entity, itype, syntactic list,
+      --  or node, then the field is not visited. The routine always visits
+      --  valid syntactic fields. Par_Nod is the expected parent of the
+      --  syntactic field. Flag Semantic should be set when the input is a
+      --  semantic field.
+
+      procedure Visit_Itype (Itype : Entity_Id);
+      --  Visit itype Itype. This action may create a new entity for Itype and
+      --  save it in table NCT_New_Entities. In addition, the routine may map
+      --  the associated node of Itype to the new itype in NCT_Pending_Itypes.
+
+      procedure Visit_List (List : List_Id);
+      --  Visit the elements of syntactic list List
+
+      procedure Visit_Node (N : Node_Id);
+      --  Visit node N
+
+      procedure Visit_Semantic_Fields (Id : Entity_Id);
+      pragma Inline (Visit_Semantic_Fields);
+      --  Subsidiary to Visit_Entity and Visit_Itype. Visit common semantic
+      --  fields of entity or itype Id.
+
+      --------------------
+      -- Add_New_Entity --
+      --------------------
+
+      procedure Add_New_Entity (Old_Id : Entity_Id; New_Id : Entity_Id) is
       begin
-         if Nkind (N) not in N_Entity or else not NCT_Hash_Tables_Used then
-            return N;
+         pragma Assert (Present (Old_Id));
+         pragma Assert (Present (New_Id));
+         pragma Assert (Nkind (Old_Id) in N_Entity);
+         pragma Assert (Nkind (New_Id) in N_Entity);
 
-         else
-            Ent := NCT_Assoc.Get (Entity_Id (N));
+         NCT_Tables_In_Use := True;
 
-            if Present (Ent) then
-               return Ent;
-            end if;
+         --  Sanity check the NCT_New_Entities table. No previous mapping with
+         --  key Old_Id should exist.
+
+         pragma Assert (No (NCT_New_Entities.Get (Old_Id)));
+
+         --  Establish the mapping
+
+         --    Old_Id -> New_Id
+
+         NCT_New_Entities.Set (Old_Id, New_Id);
+      end Add_New_Entity;
+
+      -----------------------
+      -- Add_Pending_Itype --
+      -----------------------
+
+      procedure Add_Pending_Itype (Assoc_Nod : Node_Id; Itype : Entity_Id) is
+         Itypes : Elist_Id;
+
+      begin
+         pragma Assert (Present (Assoc_Nod));
+         pragma Assert (Present (Itype));
+         pragma Assert (Nkind (Itype) in N_Entity);
+         pragma Assert (Is_Itype (Itype));
+
+         NCT_Tables_In_Use := True;
+
+         --  It is not possible to sanity check the NCT_Pendint_Itypes table
+         --  directly because a single node may act as the associated node for
+         --  multiple itypes.
+
+         Itypes := NCT_Pending_Itypes.Get (Assoc_Nod);
+
+         if No (Itypes) then
+            Itypes := New_Elmt_List;
+            NCT_Pending_Itypes.Set (Assoc_Nod, Itypes);
          end if;
 
-         return N;
-      end Assoc;
+         --  Establish the mapping
 
-      ---------------------------
-      -- Build_NCT_Hash_Tables --
-      ---------------------------
+         --    Assoc_Nod -> (Itype, ...)
 
-      procedure Build_NCT_Hash_Tables is
-         Assoc : Entity_Id;
-         Elmt  : Elmt_Id;
-         Key   : Entity_Id;
-         Value : Entity_Id;
+         --  Avoid inserting the same itype multiple times. This involves a
+         --  linear search, however the set of itypes with the same associated
+         --  node is very small.
 
+         Append_Unique_Elmt (Itype, Itypes);
+      end Add_Pending_Itype;
+
+      ----------------------
+      -- Build_NCT_Tables --
+      ----------------------
+
+      procedure Build_NCT_Tables (Entity_Map : Elist_Id) is
+         Elmt   : Elmt_Id;
+         Old_Id : Entity_Id;
+         New_Id : Entity_Id;
+
       begin
-         if No (Map) then
+         --  Nothing to do when there is no entity map
+
+         if No (Entity_Map) then
             return;
          end if;
 
-         --  Clear both hash tables associated with entry replication since
-         --  multiple calls to New_Copy_Tree could cause multiple collisions
-         --  and produce long linked lists in individual buckets.
-
-         NCT_Assoc.Reset;
-         NCT_Itype_Assoc.Reset;
-
-         Elmt := First_Elmt (Map);
+         Elmt := First_Elmt (Entity_Map);
          while Present (Elmt) loop
 
-            --  Extract a (key, value) pair from the map
+            --  Extract the (Old_Id, New_Id) pair from the entity map
 
-            Key := Node (Elmt);
+            Old_Id := Node (Elmt);
             Next_Elmt (Elmt);
-            Value := Node (Elmt);
 
-            --  Add the pair in the association hash table
+            New_Id := Node (Elmt);
+            Next_Elmt (Elmt);
 
-            NCT_Assoc.Set (Key, Value);
+            --  Establish the following mapping within table NCT_New_Entities
 
-            --  Add a link between the associated node of the old Itype and the
-            --  new Itype, for updating later when node is copied.
+            --    Old_Id -> New_Id
 
-            if Is_Type (Key) then
-               Assoc := Associated_Node_For_Itype (Key);
+            Add_New_Entity (Old_Id, New_Id);
 
-               if Present (Assoc) then
-                  NCT_Itype_Assoc.Set (Assoc, Value);
-               end if;
+            --  Establish the following mapping within table NCT_Pending_Itypes
+            --  when the new entity is an itype.
+
+            --    Assoc_Nod -> (New_Id, ...)
+
+            --  IMPORTANT: the associated node is that of the old itype because
+            --  the node will be replicated in Phase 2.
+
+            if Is_Itype (Old_Id) then
+               Add_Pending_Itype
+                 (Assoc_Nod => Associated_Node_For_Itype (Old_Id),
+                  Itype     => New_Id);
             end if;
-
-            Next_Elmt (Elmt);
          end loop;
+      end Build_NCT_Tables;
 
-         NCT_Hash_Tables_Used := True;
-      end Build_NCT_Hash_Tables;
+      ------------------------------------
+      -- Copy_Any_Node_With_Replacement --
+      ------------------------------------
 
+      function Copy_Any_Node_With_Replacement
+        (N : Node_Or_Entity_Id) return Node_Or_Entity_Id
+      is
+      begin
+         if Nkind (N) in N_Entity then
+            return Corresponding_Entity (N);
+         else
+            return Copy_Node_With_Replacement (N);
+         end if;
+      end Copy_Any_Node_With_Replacement;
+
       ---------------------------------
       -- Copy_Elist_With_Replacement --
       ---------------------------------
 
-      function Copy_Elist_With_Replacement
-        (Old_Elist : Elist_Id) return Elist_Id
-      is
-         M         : Elmt_Id;
-         New_Elist : Elist_Id;
+      function Copy_Elist_With_Replacement (List : Elist_Id) return Elist_Id is
+         Elmt   : Elmt_Id;
+         Result : Elist_Id;
 
       begin
-         if No (Old_Elist) then
-            return No_Elist;
+         --  Copy the contents of the old list. Note that the list itself may
+         --  be empty, in which case the routine returns a new empty list. This
+         --  avoids sharing lists between subtrees. The element of an entity
+         --  list could be an entity or a node, hence the invocation of routine
+         --  Copy_Any_Node_With_Replacement.
 
-         else
-            New_Elist := New_Elmt_List;
+         if Present (List) then
+            Result := 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);
+            Elmt := First_Elmt (List);
+            while Present (Elmt) loop
+               Append_Elmt
+                 (Copy_Any_Node_With_Replacement (Node (Elmt)), Result);
+
+               Next_Elmt (Elmt);
             end loop;
+
+         --  Otherwise the list does not exist
+
+         else
+            Result := No_Elist;
          end if;
 
-         return New_Elist;
+         return Result;
       end Copy_Elist_With_Replacement;
 
-      ----------------------------------
-      -- Copy_Entity_With_Replacement --
-      ----------------------------------
+      ---------------------------------
+      -- Copy_Field_With_Replacement --
+      ---------------------------------
 
-      --  This routine exactly parallels its phase one analog Visit_Itype
-
-      procedure Copy_Entity_With_Replacement (New_Entity : Entity_Id) is
+      function Copy_Field_With_Replacement
+        (Field    : Union_Id;
+         Old_Par  : Node_Id := Empty;
+         New_Par  : Node_Id := Empty;
+         Semantic : Boolean := False) return Union_Id
+      is
       begin
-         --  Translate Next_Entity, Scope, and Etype fields, in case they
-         --  reference entities that have been mapped into copies.
+         --  The field is empty
 
-         Set_Next_Entity (New_Entity, Assoc (Next_Entity (New_Entity)));
-         Set_Etype       (New_Entity, Assoc (Etype       (New_Entity)));
+         if Field = Union_Id (Empty) then
+            return Field;
 
-         if Present (New_Scope) then
-            Set_Scope    (New_Entity, New_Scope);
-         else
-            Set_Scope    (New_Entity, Assoc (Scope       (New_Entity)));
-         end if;
+         --  The field is an entity/itype/node
 
-         --  Copy referenced fields
+         elsif Field in Node_Range then
+            declare
+               Old_N     : constant Node_Id := Node_Id (Field);
+               Syntactic : constant Boolean := Parent (Old_N) = Old_Par;
 
-         if Is_Discrete_Type (New_Entity) then
-            Set_Scalar_Range (New_Entity,
-              Copy_Node_With_Replacement (Scalar_Range (New_Entity)));
+               New_N : Node_Id;
 
-         elsif Has_Discriminants (Base_Type (New_Entity)) then
-            Set_Discriminant_Constraint (New_Entity,
-              Copy_Elist_With_Replacement
-                (Discriminant_Constraint (New_Entity)));
+            begin
+               --  The field is an entity/itype
 
-         elsif Is_Array_Type (New_Entity) then
-            if Present (First_Index (New_Entity)) then
-               Set_First_Index (New_Entity,
-                 First (Copy_List_With_Replacement
-                         (List_Containing (First_Index (New_Entity)))));
-            end if;
+               if Nkind (Old_N) in N_Entity then
 
-            if Is_Packed (New_Entity) then
-               Set_Packed_Array_Impl_Type (New_Entity,
-                 Copy_Node_With_Replacement
-                   (Packed_Array_Impl_Type (New_Entity)));
-            end if;
+                  --  An entity/itype is always replicated
+
+                  New_N := Corresponding_Entity (Old_N);
+
+                  --  Update the parent pointer when the entity is a syntactic
+                  --  field. Note that itypes do not have parent pointers.
+
+                  if Syntactic and then New_N /= Old_N then
+                     Set_Parent (New_N, New_Par);
+                  end if;
+
+               --  The field is a node
+
+               else
+                  --  A node is replicated when it is either a syntactic field
+                  --  or when the caller treats it as a semantic attribute.
+
+                  if Syntactic or else Semantic then
+                     New_N := Copy_Node_With_Replacement (Old_N);
+
+                     --  Update the parent pointer when the node is a syntactic
+                     --  field.
+
+                     if Syntactic and then New_N /= Old_N then
+                        Set_Parent (New_N, New_Par);
+                     end if;
+
+                  --  Otherwise the node is returned unchanged
+
+                  else
+                     New_N := Old_N;
+                  end if;
+               end if;
+
+               return Union_Id (New_N);
+            end;
+
+         --  The field is an entity list
+
+         elsif Field in Elist_Range then
+            return Union_Id (Copy_Elist_With_Replacement (Elist_Id (Field)));
+
+         --  The field is a syntactic list
+
+         elsif Field in List_Range then
+            declare
+               Old_List  : constant List_Id := List_Id (Field);
+               Syntactic : constant Boolean := Parent (Old_List) = Old_Par;
+
+               New_List : List_Id;
+
+            begin
+               --  A list is replicated when it is either a syntactic field or
+               --  when the caller treats it as a semantic attribute.
+
+               if Syntactic or else Semantic then
+                  New_List := Copy_List_With_Replacement (Old_List);
+
+                  --  Update the parent pointer when the list is a syntactic
+                  --  field.
+
+                  if Syntactic and then New_List /= Old_List then
+                     Set_Parent (New_List, New_Par);
+                  end if;
+
+               --  Otherwise the list is returned unchanged
+
+               else
+                  New_List := Old_List;
+               end if;
+
+               return Union_Id (New_List);
+            end;
+
+         --  Otherwise the field denotes an attribute that does not need to be
+         --  replicated (Chars, literals, etc).
+
+         else
+            return Field;
          end if;
-      end Copy_Entity_With_Replacement;
+      end Copy_Field_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;
+      function Copy_List_With_Replacement (List : List_Id) return List_Id is
+         Elmt   : Node_Id;
+         Result : List_Id;
 
       begin
-         if Old_List = No_List then
-            return No_List;
+         --  Copy the contents of the old list. Note that the list itself may
+         --  be empty, in which case the routine returns a new empty list. This
+         --  avoids sharing lists between subtrees. The element of a syntactic
+         --  list is always a node, never an entity or itype, hence the call to
+         --  routine Copy_Node_With_Replacement.
 
-         else
-            New_List := Empty_List;
+         if Present (List) then
+            Result := New_List;
 
-            E := First (Old_List);
-            while Present (E) loop
-               Append (Copy_Node_With_Replacement (E), New_List);
-               Next (E);
+            Elmt := First (List);
+            while Present (Elmt) loop
+               Append (Copy_Node_With_Replacement (Elmt), Result);
+
+               Next (Elmt);
             end loop;
 
-            return New_List;
+         --  Otherwise the list does not exist
+
+         else
+            Result := No_List;
          end if;
+
+         return Result;
       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;
+      function Copy_Node_With_Replacement (N : Node_Id) return Node_Id is
+         Result : 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.
+      begin
+         --  Assume that the node must be returned unchanged
 
-         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).
+         Result := N;
 
-         -------------------------------
-         -- Adjust_Named_Associations --
-         -------------------------------
+         if N > Empty_Or_Error then
+            pragma Assert (Nkind (N) not in N_Entity);
 
-         procedure Adjust_Named_Associations
-           (Old_Node : Node_Id;
-            New_Node : Node_Id)
-         is
-            Old_E : Node_Id;
-            New_E : Node_Id;
+            Result := New_Copy (N);
 
-            Old_Next : Node_Id;
-            New_Next : Node_Id;
+            Set_Field1 (Result,
+              Copy_Field_With_Replacement
+                (Field   => Field1 (Result),
+                 Old_Par => N,
+                 New_Par => Result));
 
-         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;
+            Set_Field2 (Result,
+              Copy_Field_With_Replacement
+                (Field   => Field2 (Result),
+                 Old_Par => N,
+                 New_Par => Result));
 
-                  --  Now scan parameter list from the beginning, to locate
-                  --  next named actual, which can be out of order.
+            Set_Field3 (Result,
+              Copy_Field_With_Replacement
+                (Field   => Field3 (Result),
+                 Old_Par => N,
+                 New_Par => Result));
 
-                  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_Field4 (Result,
+              Copy_Field_With_Replacement
+                (Field   => Field4 (Result),
+                 Old_Par => N,
+                 New_Par => Result));
 
-                  Set_Next_Named_Actual
-                    (New_E, Explicit_Actual_Parameter (New_Next));
-               end if;
+            Set_Field5 (Result,
+              Copy_Field_With_Replacement
+                (Field   => Field5 (Result),
+                 Old_Par => N,
+                 New_Par => Result));
 
-               Next (Old_E);
-               Next (New_E);
-            end loop;
-         end Adjust_Named_Associations;
+            --  Update the Comes_From_Source and Sloc attributes of the node
+            --  in case the caller has supplied new values.
 
-         ---------------------------------
-         -- Copy_Field_With_Replacement --
-         ---------------------------------
+            Update_CFS_Sloc (Result);
 
-         function Copy_Field_With_Replacement
-           (Field : Union_Id) return Union_Id
-         is
-         begin
-            if Field = Union_Id (Empty) then
-               return Field;
+            --  Update the Associated_Node_For_Itype attribute of all itypes
+            --  created during Phase 1 whose associated node is N. As a result
+            --  the Associated_Node_For_Itype refers to the replicated node.
+            --  No action needs to be taken when the Associated_Node_For_Itype
+            --  refers to an entity because this was already handled during
+            --  Phase 1, in Visit_Itype.
 
-            elsif Field in Node_Range then
-               declare
-                  Old_N : constant Node_Id := Node_Id (Field);
-                  New_N : Node_Id;
+            Update_Pending_Itypes
+              (Old_Assoc => N,
+               New_Assoc => Result);
 
-               begin
-                  --  If syntactic field, as indicated by the parent pointer
-                  --  being set, then copy the referenced node recursively.
+            --  Update the First/Next_Named_Association chain for a replicated
+            --  call.
 
-                  if Parent (Old_N) = Old_Node then
-                     New_N := Copy_Node_With_Replacement (Old_N);
+            if Nkind_In (N, N_Entry_Call_Statement,
+                            N_Function_Call,
+                            N_Procedure_Call_Statement)
+            then
+               Update_Named_Associations
+                 (Old_Call => N,
+                  New_Call => Result);
 
-                     if New_N /= Old_N then
-                        Set_Parent (New_N, New_Node);
-                     end if;
+            --  Update the Renamed_Object attribute of a replicated object
+            --  declaration.
 
-                  --  For semantic fields, update possible entity reference
-                  --  from the replacement map.
+            elsif Nkind (N) = N_Object_Renaming_Declaration then
+               Set_Renamed_Object (Defining_Entity (Result), Name (Result));
 
-                  else
-                     New_N := Assoc (Old_N);
-                  end if;
+            --  Update the First_Real_Statement attribute of a replicated
+            --  handled sequence of statements.
 
-                  return Union_Id (New_N);
-               end;
+            elsif Nkind (N) = N_Handled_Sequence_Of_Statements then
+               Update_First_Real_Statement
+                 (Old_HSS => N,
+                  New_HSS => Result);
+            end if;
+         end if;
 
-            elsif Field in List_Range then
-               declare
-                  Old_L : constant List_Id := List_Id (Field);
-                  New_L : List_Id;
+         return Result;
+      end Copy_Node_With_Replacement;
 
-               begin
-                  --  If syntactic field, as indicated by the parent pointer,
-                  --  then recursively copy the entire referenced list.
+      --------------------------
+      -- Corresponding_Entity --
+      --------------------------
 
-                  if Parent (Old_L) = Old_Node then
-                     New_L := Copy_List_With_Replacement (Old_L);
-                     Set_Parent (New_L, New_Node);
+      function Corresponding_Entity (Id : Entity_Id) return Entity_Id is
+         New_Id : Entity_Id;
+         Result : Entity_Id;
 
-                  --  For semantic list, just returned unchanged
+      begin
+         --  Assume that the entity must be returned unchanged
 
-                  else
-                     New_L := Old_L;
-                  end if;
+         Result := Id;
 
-                  return Union_Id (New_L);
-               end;
+         if Id > Empty_Or_Error then
+            pragma Assert (Nkind (Id) in N_Entity);
 
-            --  Anything other than a list or a node is returned unchanged
+            --  Determine whether the entity has a corresponding new entity
+            --  generated during Phase 1 and if it does, use it.
 
-            else
-               return Field;
+            if NCT_Tables_In_Use then
+               New_Id := NCT_New_Entities.Get (Id);
+
+               if Present (New_Id) then
+                  Result := New_Id;
+               end if;
             end if;
-         end Copy_Field_With_Replacement;
+         end if;
 
-      --  Start of processing for Copy_Node_With_Replacement
+         return Result;
+      end Corresponding_Entity;
 
+      -------------------
+      -- In_Entity_Map --
+      -------------------
+
+      function In_Entity_Map
+        (Id         : Entity_Id;
+         Entity_Map : Elist_Id) return Boolean
+      is
+         Elmt   : Elmt_Id;
+         Old_Id : Entity_Id;
+
       begin
-         if Old_Node <= Empty_Or_Error then
-            return Old_Node;
+         --  The entity map contains pairs (Old_Id, New_Id). The advancement
+         --  step always skips the New_Id portion of the pair.
 
-         elsif Nkind (Old_Node) in N_Entity then
-            return Assoc (Old_Node);
+         if Present (Entity_Map) then
+            Elmt := First_Elmt (Entity_Map);
+            while Present (Elmt) loop
+               Old_Id := Node (Elmt);
 
-         else
-            New_Node := New_Copy (Old_Node);
+               if Old_Id = Id then
+                  return True;
+               end if;
 
-            --  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.
+               Next_Elmt (Elmt);
+               Next_Elmt (Elmt);
+            end loop;
+         end if;
 
-            declare
-               Ent : constant Entity_Id := NCT_Itype_Assoc.Get (Old_Node);
+         return False;
+      end In_Entity_Map;
 
-            begin
-               if Present (Ent) then
-                  Set_Associated_Node_For_Itype (Ent, New_Node);
-               end if;
-            end;
+      ---------------------
+      -- Update_CFS_Sloc --
+      ---------------------
 
-            --  Recursively copy descendants
+      procedure Update_CFS_Sloc (N : Node_Or_Entity_Id) is
+      begin
+         --  A new source location defaults the Comes_From_Source attribute
 
-            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)));
+         if New_Sloc /= No_Location then
+            Set_Comes_From_Source (N, Default_Node.Comes_From_Source);
+            Set_Sloc              (N, New_Sloc);
+         end if;
+      end Update_CFS_Sloc;
 
-            --  Adjust Sloc of new node if necessary
+      ---------------------------------
+      -- Update_First_Real_Statement --
+      ---------------------------------
 
-            if New_Sloc /= No_Location then
-               Set_Sloc (New_Node, New_Sloc);
+      procedure Update_First_Real_Statement
+        (Old_HSS : Node_Id;
+         New_HSS : Node_Id)
+      is
+         Old_First_Stmt : constant Node_Id := First_Real_Statement (Old_HSS);
 
-               --  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.
+         New_Stmt : Node_Id;
+         Old_Stmt : Node_Id;
 
-               Set_Comes_From_Source
-                 (New_Node, Default_Node.Comes_From_Source);
-            end if;
+      begin
+         --  Recreate the First_Real_Statement attribute of a handled sequence
+         --  of statements by traversing the statement lists of both sequences
+         --  in parallel.
 
-            --  Update the named association links for calls to mention the
-            --  copied actual parameters.
+         if Present (Old_First_Stmt) then
+            New_Stmt := First (Statements (New_HSS));
+            Old_Stmt := First (Statements (Old_HSS));
+            while Present (Old_Stmt) and then Old_Stmt /= Old_First_Stmt loop
+               Next (New_Stmt);
+               Next (Old_Stmt);
+            end loop;
 
-            if Nkind_In (Old_Node, N_Entry_Call_Statement,
-                                   N_Function_Call,
-                                   N_Procedure_Call_Statement)
-              and then Present (First_Named_Actual (Old_Node))
-            then
-               Adjust_Named_Associations (Old_Node, New_Node);
+            pragma Assert (Present (New_Stmt));
+            pragma Assert (Present (Old_Stmt));
 
-            --  Update the Renamed_Object attribute of an object renaming
-            --  declaration to mention the replicated name.
+            Set_First_Real_Statement (New_HSS, New_Stmt);
+         end if;
+      end Update_First_Real_Statement;
 
-            elsif Nkind (Old_Node) = N_Object_Renaming_Declaration then
-               Set_Renamed_Object
-                 (Defining_Entity (New_Node), Name (New_Node));
-            end if;
+      -------------------------------
+      -- Update_Named_Associations --
+      -------------------------------
 
-            --  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.
+      procedure Update_Named_Associations
+        (Old_Call : Node_Id;
+         New_Call : Node_Id)
+      is
+         New_Act  : Node_Id;
+         New_Next : Node_Id;
+         Old_Act  : Node_Id;
+         Old_Next : Node_Id;
 
-            if Nkind (Old_Node) = N_Handled_Sequence_Of_Statements
-              and then Present (First_Real_Statement (Old_Node))
+      begin
+         --  Recreate the First/Next_Named_Actual chain of a call by traversing
+         --  the chains of both the old and new calls in parallel.
+
+         New_Act := First (Parameter_Associations (New_Call));
+         Old_Act := First (Parameter_Associations (Old_Call));
+         while Present (Old_Act) loop
+            if Nkind (Old_Act) = N_Parameter_Association
+              and then Present (Next_Named_Actual (Old_Act))
             then
-               declare
-                  Old_F : constant Node_Id := First_Real_Statement (Old_Node);
-                  N1    : Node_Id;
-                  N2    : Node_Id;
+               if First_Named_Actual (Old_Call) =
+                    Explicit_Actual_Parameter (Old_Act)
+               then
+                  Set_First_Named_Actual (New_Call,
+                    Explicit_Actual_Parameter (New_Act));
+               end if;
 
-               begin
-                  N1 := First (Statements (Old_Node));
-                  N2 := First (Statements (New_Node));
+               --  Scan the actual parameter list to find the next suitable
+               --  named actual. Note that the list may be out of order.
 
-                  while N1 /= Old_F loop
-                     Next (N1);
-                     Next (N2);
-                  end loop;
+               New_Next := First (Parameter_Associations (New_Call));
+               Old_Next := First (Parameter_Associations (Old_Call));
+               while Nkind (Old_Next) /= N_Parameter_Association
+                 or else Explicit_Actual_Parameter (Old_Next) /=
+                           Next_Named_Actual (Old_Act)
+               loop
+                  Next (New_Next);
+                  Next (Old_Next);
+               end loop;
 
-                  Set_First_Real_Statement (New_Node, N2);
-               end;
+               Set_Next_Named_Actual (New_Act,
+                 Explicit_Actual_Parameter (New_Next));
             end if;
-         end if;
 
-         --  All done, return copied node
+            Next (New_Act);
+            Next (Old_Act);
+         end loop;
+      end Update_Named_Associations;
 
-         return New_Node;
-      end Copy_Node_With_Replacement;
+      -------------------------
+      -- Update_New_Entities --
+      -------------------------
 
-      ------------
-      -- In_Map --
-      ------------
+      procedure Update_New_Entities (Entity_Map : Elist_Id) is
+         New_Id : Entity_Id := Empty;
+         Old_Id : Entity_Id := Empty;
 
-      function In_Map (E : Entity_Id) return Boolean is
-         Elmt : Elmt_Id;
-         Ent  : Entity_Id;
-
       begin
-         if Present (Map) then
-            Elmt := First_Elmt (Map);
-            while Present (Elmt) loop
-               Ent := Node (Elmt);
+         if NCT_Tables_In_Use then
+            NCT_New_Entities.Get_First (Old_Id, New_Id);
 
-               if Ent = E then
-                  return True;
+            --  Update the semantic fields of all new entities created during
+            --  Phase 1 which were not supplied via an entity map.
+            --  ??? Is there a better way of distinguishing those?
+
+            while Present (Old_Id) and then Present (New_Id) loop
+               if not (Present (Entity_Map)
+                        and then In_Entity_Map (Old_Id, Entity_Map))
+               then
+                  Update_Semantic_Fields (New_Id);
                end if;
 
-               Next_Elmt (Elmt);
-               Next_Elmt (Elmt);
+               NCT_New_Entities.Get_Next (Old_Id, New_Id);
             end loop;
          end if;
+      end Update_New_Entities;
 
-         return False;
-      end In_Map;
+      ---------------------------
+      -- Update_Pending_Itypes --
+      ---------------------------
 
+      procedure Update_Pending_Itypes
+        (Old_Assoc : Node_Id;
+         New_Assoc : Node_Id)
+      is
+         Item   : Elmt_Id;
+         Itypes : Elist_Id;
+
+      begin
+         if NCT_Tables_In_Use then
+            Itypes := NCT_Pending_Itypes.Get (Old_Assoc);
+
+            --  Update the Associated_Node_For_Itype attribute for all itypes
+            --  which originally refer to Old_Assoc to designate New_Assoc.
+
+            if Present (Itypes) then
+               Item := First_Elmt (Itypes);
+               while Present (Item) loop
+                  Set_Associated_Node_For_Itype (Node (Item), New_Assoc);
+
+                  Next_Elmt (Item);
+               end loop;
+            end if;
+         end if;
+      end Update_Pending_Itypes;
+
+      ----------------------------
+      -- Update_Semantic_Fields --
+      ----------------------------
+
+      procedure Update_Semantic_Fields (Id : Entity_Id) is
+      begin
+         --  Discriminant_Constraint
+
+         if Has_Discriminants (Base_Type (Id)) then
+            Set_Discriminant_Constraint (Id, Elist_Id (
+              Copy_Field_With_Replacement
+                (Field    => Union_Id (Discriminant_Constraint (Id)),
+                 Semantic => True)));
+         end if;
+
+         --  Etype
+
+         Set_Etype (Id, Node_Id (
+           Copy_Field_With_Replacement
+             (Field    => Union_Id (Etype (Id)),
+              Semantic => True)));
+
+         --  First_Index
+         --  Packed_Array_Impl_Type
+
+         if Is_Array_Type (Id) then
+            if Present (First_Index (Id)) then
+               Set_First_Index (Id, First (List_Id (
+                 Copy_Field_With_Replacement
+                   (Field    => Union_Id (List_Containing (First_Index (Id))),
+                    Semantic => True))));
+            end if;
+
+            if Is_Packed (Id) then
+               Set_Packed_Array_Impl_Type (Id, Node_Id (
+                 Copy_Field_With_Replacement
+                   (Field    => Union_Id (Packed_Array_Impl_Type (Id)),
+                    Semantic => True)));
+            end if;
+         end if;
+
+         --  Next_Entity
+
+         Set_Next_Entity (Id, Node_Id (
+           Copy_Field_With_Replacement
+             (Field    => Union_Id (Next_Entity (Id)),
+              Semantic => True)));
+
+         --  Scalar_Range
+
+         if Is_Discrete_Type (Id) then
+            Set_Scalar_Range (Id, Node_Id (
+              Copy_Field_With_Replacement
+                (Field    => Union_Id (Scalar_Range (Id)),
+                 Semantic => True)));
+         end if;
+
+         --  Scope
+
+         --  Update the scope when the caller specified an explicit one
+
+         if Present (New_Scope) then
+            Set_Scope (Id, New_Scope);
+         else
+            Set_Scope (Id, Node_Id (
+              Copy_Field_With_Replacement
+                (Field    => Union_Id (Scope (Id)),
+                 Semantic => True)));
+         end if;
+      end Update_Semantic_Fields;
+
+      --------------------
+      -- Visit_Any_Node --
+      --------------------
+
+      procedure Visit_Any_Node (N : Node_Or_Entity_Id) is
+      begin
+         if Nkind (N) in N_Entity then
+            if Is_Itype (N) then
+               Visit_Itype (N);
+            else
+               Visit_Entity (N);
+            end if;
+         else
+            Visit_Node (N);
+         end if;
+      end Visit_Any_Node;
+
       -----------------
       -- Visit_Elist --
       -----------------
 
-      procedure Visit_Elist (E : Elist_Id) is
+      procedure Visit_Elist (List : Elist_Id) is
          Elmt : Elmt_Id;
+
       begin
-         if Present (E) then
-            Elmt := First_Elmt (E);
+         --  The element of an entity list could be an entity, itype, or a
+         --  node, hence the call to Visit_Any_Node.
 
-            while Elmt /= No_Elmt loop
-               Visit_Node (Node (Elmt));
+         if Present (List) then
+            Elmt := First_Elmt (List);
+            while Present (Elmt) loop
+               Visit_Any_Node (Node (Elmt));
+
                Next_Elmt (Elmt);
             end loop;
          end if;
@@ -17885,108 +18286,153 @@
       -- Visit_Entity --
       ------------------
 
-      procedure Visit_Entity (Old_Entity : Entity_Id) is
-         New_E : Entity_Id;
+      procedure Visit_Entity (Id : Entity_Id) is
+         New_Id : Entity_Id;
 
       begin
-         pragma Assert (not Is_Itype (Old_Entity));
-         pragma Assert (Nkind (Old_Entity) in N_Entity);
+         pragma Assert (Nkind (Id) in N_Entity);
+         pragma Assert (not Is_Itype (Id));
 
-         --  Do not duplicate an entity when it is declared within an inner
-         --  scope enclosed by an expression with actions.
+         --  Nothing to do if the entity is not defined in the Actions list of
+         --  an N_Expression_With_Actions node.
 
-         if EWA_Inner_Scope_Level > 0 then
+         if EWA_Level = 0 then
             return;
 
-         --  Entity duplication is currently performed only for objects and
-         --  types. Relaxing this restriction leads to a performance penalty.
+         --  Nothing to do if the entity is defined within a scoping construct
+         --  of an N_Expression_With_Actions node.
 
-         elsif Ekind_In (Old_Entity, E_Constant, E_Variable) then
-            null;
+         elsif EWA_Inner_Scope_Level > 0 then
+            return;
 
-         elsif Is_Type (Old_Entity) then
-            null;
+         --  Nothing to do if the entity is not an object or a type. Relaxing
+         --  this restriction leads to a performance penalty.
 
-         else
+         elsif not Ekind_In (Id, E_Constant, E_Variable)
+           and then not Is_Type (Id)
+         then
             return;
+
+         --  Nothing to do if the entity was already visited
+
+         elsif NCT_Tables_In_Use
+           and then Present (NCT_New_Entities.Get (Id))
+         then
+            return;
+
+         --  Nothing to do if the declaration node of the entity is not within
+         --  the subtree being replicated.
+
+         elsif not In_Subtree
+                     (Root => Source,
+                      N    => Declaration_Node (Id))
+         then
+            return;
          end if;
 
-         New_E := New_Copy (Old_Entity);
+         --  Create a new entity by directly copying the old entity. This
+         --  action causes all attributes of the old entity to be inherited.
 
-         --  The new entity has all the attributes of the old one, however it
-         --  requires a new name for debugging purposes.
+         New_Id := New_Copy (Id);
 
-         Set_Chars (New_E, New_Internal_Name ('T'));
+         --  Create a new name for the new entity because the back end needs
+         --  distinct names for debugging purposes.
 
-         --  Add new association to map
+         Set_Chars (New_Id, New_Internal_Name ('T'));
 
-         NCT_Assoc.Set (Old_Entity, New_E);
-         NCT_Hash_Tables_Used := True;
+         --  Update the Comes_From_Source and Sloc attributes of the entity in
+         --  case the caller has supplied new values.
 
-         --  Visit descendants that eventually get copied
+         Update_CFS_Sloc (New_Id);
 
-         Visit_Field (Union_Id (Etype (Old_Entity)), Old_Entity);
+         --  Establish the following mapping within table NCT_New_Entities:
+
+         --    Id -> New_Id
+
+         Add_New_Entity (Id, New_Id);
+
+         --  Deal with the semantic fields of entities. The fields are visited
+         --  because they may mention entities which reside within the subtree
+         --  being copied.
+
+         Visit_Semantic_Fields (Id);
       end Visit_Entity;
 
       -----------------
       -- Visit_Field --
       -----------------
 
-      procedure Visit_Field (F : Union_Id; N : Node_Id) is
+      procedure Visit_Field
+        (Field    : Union_Id;
+         Par_Nod  : Node_Id := Empty;
+         Semantic : Boolean := False)
+      is
       begin
-         if F = Union_Id (Empty) then
+         --  The field is empty
+
+         if Field = Union_Id (Empty) then
             return;
 
-         elsif F in Node_Range then
+         --  The field is an entity/itype/node
 
-            --  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.)
+         elsif Field in Node_Range then
+            declare
+               N : constant Node_Id := Node_Id (Field);
 
-            if Parent (Node_Id (F)) = N then
-               Visit_Node (Node_Id (F));
-               return;
+            begin
+               --  The field is an entity/itype
 
-            --  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.
+               if Nkind (N) in N_Entity then
 
-            --  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).
+                  --  Itypes are always visited
 
-            elsif Nkind (Node_Id (F)) in N_Entity
-              and then Is_Itype (Entity_Id (F))
-              and then Node_Id (F) /= N
-            then
-               declare
-                  P : Node_Id;
+                  if Is_Itype (N) then
+                     Visit_Itype (N);
 
-               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 entity is visited when it is either a syntactic field
+                  --  or when the caller treats it as a semantic attribute.
 
-                  --  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.
+                  elsif Parent (N) = Par_Nod or else Semantic then
+                     Visit_Entity (N);
+                  end if;
 
-                  return;
-               end;
-            end if;
+               --  The field is a node
 
-         elsif F in List_Range and then Parent (List_Id (F)) = N then
-            Visit_List (List_Id (F));
-            return;
+               else
+                  --  A node is visited when it is either a syntactic field or
+                  --  when the caller treats it as a semantic attribute.
+
+                  if Parent (N) = Par_Nod or else Semantic then
+                     Visit_Node (N);
+                  end if;
+               end if;
+            end;
+
+         --  The field is an entity list
+
+         elsif Field in Elist_Range then
+            Visit_Elist (Elist_Id (Field));
+
+         --  The field is a syntax list
+
+         elsif Field in List_Range then
+            declare
+               List : constant List_Id := List_Id (Field);
+
+            begin
+               --  A syntax list is visited when it is either a syntactic field
+               --  or when the caller treats it as a semantic attribute.
+
+               if Parent (List) = Par_Nod or else Semantic then
+                  Visit_List (List);
+               end if;
+            end;
+
+         --  Otherwise the field denotes information which does not need to be
+         --  visited (chars, literals, etc.).
+
+         else
+            null;
          end if;
       end Visit_Field;
 
@@ -17994,110 +18440,139 @@
       -- Visit_Itype --
       -----------------
 
-      procedure Visit_Itype (Old_Itype : Entity_Id) is
+      procedure Visit_Itype (Itype : Entity_Id) is
+         New_Assoc : Node_Id;
          New_Itype : Entity_Id;
-         Ent       : Entity_Id;
+         Old_Assoc : Node_Id;
 
       begin
+         pragma Assert (Nkind (Itype) in N_Entity);
+         pragma Assert (Is_Itype (Itype));
+
          --  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
+         if Ekind (Itype) = E_Subprogram_Type then
             return;
+
+         --  Nothing to do if the itype was already visited
+
+         elsif NCT_Tables_In_Use
+           and then Present (NCT_New_Entities.Get (Itype))
+         then
+            return;
+
+         --  Nothing to do if the associated node of the itype is not within
+         --  the subtree being replicated.
+
+         elsif not In_Subtree
+                     (Root => Source,
+                      N    => Associated_Node_For_Itype (Itype))
+         then
+            return;
          end if;
 
-         New_Itype := New_Copy (Old_Itype);
+         --  Create a new itype by directly copying the old itype. This action
+         --  causes all attributes of the old itype to be inherited.
 
-         --  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.
+         New_Itype := New_Copy (Itype);
 
+         --  Create a new name for the new itype because the back end requires
+         --  distinct names for debugging purposes.
+
          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.
+         --  Update the Comes_From_Source and Sloc attributes of the itype in
+         --  case the caller has supplied new values.
 
-         Ent := NCT_Assoc.Get (Associated_Node_For_Itype (Old_Itype));
+         Update_CFS_Sloc (New_Itype);
 
-         if Present (Ent) then
-            Set_Associated_Node_For_Itype (New_Itype, Ent);
-         end if;
+         --  Establish the following mapping within table NCT_New_Entities:
 
-         Ent := NCT_Itype_Assoc.Get (Old_Itype);
+         --    Itype -> New_Itype
 
-         if Present (Ent) then
-            Set_Associated_Node_For_Itype (Ent, New_Itype);
+         Add_New_Entity (Itype, New_Itype);
 
-         --  If the hash table has no association for this Itype and its
-         --  associated node, enter one now.
+         --  The new itype must be unfrozen because the resulting subtree may
+         --  be inserted anywhere and cause an earlier or later freezing.
 
-         else
-            NCT_Itype_Assoc.Set
-              (Associated_Node_For_Itype (Old_Itype), New_Itype);
-         end if;
-
          if Present (Freeze_Node (New_Itype)) then
-            Set_Is_Frozen (New_Itype, False);
             Set_Freeze_Node (New_Itype, Empty);
+            Set_Is_Frozen   (New_Itype, False);
          end if;
 
-         --  Add new association to map
-
-         NCT_Assoc.Set (Old_Itype, New_Itype);
-         NCT_Hash_Tables_Used := True;
-
          --  If a record subtype is simply copied, the entity list will be
          --  shared. Thus cloned_Subtype must be set to indicate the sharing.
+         --  ??? What does this do?
 
-         if Ekind_In (Old_Itype, E_Class_Wide_Subtype, E_Record_Subtype) then
-            Set_Cloned_Subtype (New_Itype, Old_Itype);
+         if Ekind_In (Itype, E_Class_Wide_Subtype, E_Record_Subtype) then
+            Set_Cloned_Subtype (New_Itype, Itype);
          end if;
 
-         --  Visit descendants that eventually get copied
+         --  The associated node may denote an entity, in which case it may
+         --  already have a new corresponding entity created during a prior
+         --  call to Visit_Entity or Visit_Itype for the same subtree.
 
-         Visit_Field (Union_Id (Etype (Old_Itype)), Old_Itype);
+         --    Given
+         --       Old_Assoc ---------> New_Assoc
 
-         if Is_Discrete_Type (Old_Itype) then
-            Visit_Field (Union_Id (Scalar_Range (Old_Itype)), Old_Itype);
+         --    Created by Visit_Itype
+         --       Itype -------------> New_Itype
+         --       ANFI = Old_Assoc     ANFI = Old_Assoc  <  must be updated
 
-         elsif Has_Discriminants (Base_Type (Old_Itype)) then
-            --  ??? This should involve call to Visit_Field
-            Visit_Elist (Discriminant_Constraint (Old_Itype));
+         --  In the example above, Old_Assoc is an arbitrary entity that was
+         --  already visited for the same subtree and has a corresponding new
+         --  entity New_Assoc. Old_Assoc was inherited by New_Itype by virtue
+         --  of copying entities, however it must be updated to New_Assoc.
 
-         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);
+         Old_Assoc := Associated_Node_For_Itype (Itype);
+
+         if Nkind (Old_Assoc) in N_Entity then
+            if NCT_Tables_In_Use then
+               New_Assoc := NCT_New_Entities.Get (Old_Assoc);
+
+               if Present (New_Assoc) then
+                  Set_Associated_Node_For_Itype (New_Itype, New_Assoc);
+               end if;
             end if;
 
-            if Is_Packed (Old_Itype) then
-               Visit_Field
-                 (Union_Id (Packed_Array_Impl_Type (Old_Itype)), Old_Itype);
-            end if;
+         --  Otherwise the associated node denotes a node. Postpone the update
+         --  until Phase 2 when the node is replicated. Establish the following
+         --  mapping within table NCT_Pending_Itypes:
+
+         --    Old_Assoc -> (New_Type, ...)
+
+         else
+            Add_Pending_Itype (Old_Assoc, New_Itype);
          end if;
+
+         --  Deal with the semantic fields of itypes. The fields are visited
+         --  because they may mention entities that reside within the subtree
+         --  being copied.
+
+         Visit_Semantic_Fields (Itype);
       end Visit_Itype;
 
       ----------------
       -- Visit_List --
       ----------------
 
-      procedure Visit_List (L : List_Id) is
-         N : Node_Id;
+      procedure Visit_List (List : List_Id) is
+         Elmt : Node_Id;
+
       begin
-         if L /= No_List then
-            N := First (L);
+         --  Note that the element of a syntactic list is always a node, never
+         --  an entity or itype, hence the call to Visit_Node.
 
-            while Present (N) loop
-               Visit_Node (N);
-               Next (N);
+         if Present (List) then
+            Elmt := First (List);
+            while Present (Elmt) loop
+               Visit_Node (Elmt);
+
+               Next (Elmt);
             end loop;
          end if;
       end Visit_List;
@@ -18108,6 +18583,8 @@
 
       procedure Visit_Node (N : Node_Or_Entity_Id) is
       begin
+         pragma Assert (Nkind (N) not in N_Entity);
+
          if Nkind (N) = N_Expression_With_Actions then
             EWA_Level := EWA_Level + 1;
 
@@ -18117,42 +18594,28 @@
                                  N_Subprogram_Declaration)
          then
             EWA_Inner_Scope_Level := EWA_Inner_Scope_Level + 1;
+         end if;
 
-         --  Handle case of an Itype, which must be copied
+         Visit_Field
+          (Field   => Field1 (N),
+           Par_Nod => N);
 
-         elsif Nkind (N) in N_Entity and then Is_Itype (N) then
+         Visit_Field
+          (Field   => Field2 (N),
+           Par_Nod => N);
 
-            --  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 descendants in this case.
+         Visit_Field
+          (Field   => Field3 (N),
+           Par_Nod => N);
 
-            if Present (NCT_Assoc.Get (Entity_Id (N))) then
-               return;
-            end if;
+         Visit_Field
+          (Field   => Field4 (N),
+           Par_Nod => N);
 
-            Visit_Itype (N);
+         Visit_Field
+          (Field   => Field5 (N),
+           Par_Nod => N);
 
-         --  Handle defining entities in Expression_With_Action nodes
-
-         elsif Nkind (N) in N_Entity and then EWA_Level > 0 then
-
-            --  Nothing to do if already in the hash table
-
-            if Present (NCT_Assoc.Get (Entity_Id (N))) then
-               return;
-            end if;
-
-            Visit_Entity (N);
-         end if;
-
-         --  Visit descendants
-
-         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);
-
          if EWA_Level > 0
            and then Nkind_In (N, N_Block_Statement,
                                  N_Subprogram_Body,
@@ -18165,57 +18628,171 @@
          end if;
       end Visit_Node;
 
+      ---------------------------
+      -- Visit_Semantic_Fields --
+      ---------------------------
+
+      procedure Visit_Semantic_Fields (Id : Entity_Id) is
+      begin
+         pragma Assert (Nkind (Id) in N_Entity);
+
+         --  Discriminant_Constraint
+
+         if Has_Discriminants (Base_Type (Id)) then
+            Visit_Field
+              (Field    => Union_Id (Discriminant_Constraint (Id)),
+               Semantic => True);
+         end if;
+
+         --  Etype
+
+         Visit_Field
+           (Field    => Union_Id (Etype (Id)),
+            Semantic => True);
+
+         --  First_Index
+         --  Packed_Array_Impl_Type
+
+         if Is_Array_Type (Id) then
+            if Present (First_Index (Id)) then
+               Visit_Field
+                 (Field    => Union_Id (List_Containing (First_Index (Id))),
+                  Semantic => True);
+            end if;
+
+            if Is_Packed (Id) then
+               Visit_Field
+                 (Field    => Union_Id (Packed_Array_Impl_Type (Id)),
+                  Semantic => True);
+            end if;
+         end if;
+
+         --  Scalar_Range
+
+         if Is_Discrete_Type (Id) then
+            Visit_Field
+              (Field    => Union_Id (Scalar_Range (Id)),
+               Semantic => True);
+         end if;
+      end Visit_Semantic_Fields;
+
    --  Start of processing for New_Copy_Tree
 
    begin
-      Build_NCT_Hash_Tables;
+      --  Routine New_Copy_Tree performs a deep copy of a subtree by creating
+      --  shallow copies for each node within, and then updating the child and
+      --  parent pointers accordingly. This process is straightforward, however
+      --  the routine must deal with the following complications:
 
-      --  Hash table set up if required, now start phase one by visiting top
-      --  node (we will recursively visit the descendants).
+      --    * Entities defined within N_Expression_With_Actions nodes must be
+      --      replicated rather than shared to avoid introducing two identical
+      --      symbols within the same scope. Note that no other expression can
+      --      currently define entities.
 
-      Visit_Node (Source);
+      --        do
+      --           Source_Low  : ...;
+      --           Source_High : ...;
 
-      --  Now the second phase of the copy can start. First we process all the
-      --  mapped entities, copying their descendants.
+      --           <reference to Source_Low>
+      --           <reference to Source_High>
+      --        in ... end;
 
-      if NCT_Hash_Tables_Used then
-         declare
-            Old_E : Entity_Id := Empty;
-            New_E : Entity_Id;
+      --      New_Copy_Tree handles this case by first creating new entities
+      --      and then updating all existing references to point to these new
+      --      entities.
 
-         begin
-            NCT_Assoc.Get_First (Old_E, New_E);
-            while Present (New_E) loop
+      --        do
+      --           New_Low  : ...;
+      --           New_High : ...;
 
-               --  Skip entities that were not created in the first phase
-               --  (that is, old entities specified by the caller in the set of
-               --  mappings to be applied to the tree).
+      --           <reference to New_Low>
+      --           <reference to New_High>
+      --        in ... end;
 
-               if Is_Itype (New_E)
-                 or else No (Map)
-                 or else not In_Map (Old_E)
-               then
-                  Copy_Entity_With_Replacement (New_E);
-               end if;
+      --    * Itypes defined within the subtree must be replicated to avoid any
+      --      dependencies on invalid or inaccessible data.
 
-               NCT_Assoc.Get_Next (Old_E, New_E);
-            end loop;
-         end;
-      end if;
+      --        subtype Source_Itype is ... range Source_Low .. Source_High;
 
-      --  Now we can copy the actual tree
+      --      New_Copy_Tree handles this case by first creating a new itype in
+      --      the same fashion as entities, and then updating various relevant
+      --      constraints.
 
-      declare
-         Result : constant Node_Id := Copy_Node_With_Replacement (Source);
+      --        subtype New_Itype is ... range New_Low .. New_High;
 
-      begin
-         if NCT_Hash_Tables_Used then
-            NCT_Assoc.Reset;
-            NCT_Itype_Assoc.Reset;
-         end if;
+      --    * The Associated_Node_For_Itype field of itypes must be updated to
+      --      reference the proper replicated entity or node.
 
-         return Result;
-      end;
+      --    * Semantic fields of entities such as Etype and Scope must be
+      --      updated to reference the proper replicated entities.
+
+      --    * Semantic fields of nodes such as First_Real_Statement must be
+      --      updated to reference the proper replicated nodes.
+
+      --  To meet all these demands, routine New_Copy_Tree is split into two
+      --  phases.
+
+      --  Phase 1 traverses the tree in order to locate entities and itypes
+      --  defined within the subtree. New entities are generated and saved in
+      --  table NCT_New_Entities. The semantic fields of all new entities and
+      --  itypes are then updated accordingly.
+
+      --  Phase 2 traverses the tree in order to replicate each node. Various
+      --  semantic fields of nodes and entities are updated accordingly.
+
+      --  Preparatory phase. Clear the contents of tables NCT_New_Entities and
+      --  NCT_Pending_Itypes in case a previous call to New_Copy_Tree left some
+      --  data inside.
+
+      NCT_New_Entities.Reset;
+      NCT_Pending_Itypes.Reset;
+
+      --  Populate tables NCT_New_Entities and NCT_Pending_Itypes with data
+      --  supplied by a linear entity map. The tables offer faster access to
+      --  the same data.
+
+      Build_NCT_Tables (Map);
+
+      --  Execute Phase 1. Traverse the subtree and generate new entities for
+      --  the following cases:
+
+      --    * An entity defined within an N_Expression_With_Actions node
+
+      --    * An itype referenced within the subtree where the associated node
+      --      is also in the subtree.
+
+      --  All new entities are accessible via table NCT_New_Entities, which
+      --  contains mappings of the form:
+
+      --    Old_Entity -> New_Entity
+      --    Old_Itype  -> New_Itype
+
+      --  In addition, the associated nodes of all new itypes are mapped in
+      --  table NCT_Pending_Itypes:
+
+      --    Assoc_Nod -> (New_Itype1, New_Itype2, .., New_ItypeN)
+
+      Visit_Any_Node (Source);
+
+      --  Update the semantic attributes of all new entities generated during
+      --  Phase 1 before starting Phase 2. The updates could be performed in
+      --  routine Corresponding_Entity, however this may cause the same entity
+      --  to be updated multiple times, effectively generating useless nodes.
+      --  Keeping the updates separates from Phase 2 ensures that only one set
+      --  of attributes is generated for an entity at any one time.
+
+      Update_New_Entities (Map);
+
+      --  Execute Phase 2. Replicate the source subtree one node at a time.
+      --  The following transformations take place:
+
+      --    * References to entities and itypes are updated to refer to the
+      --      new entities and itypes generated during Phase 1.
+
+      --    * All Associated_Node_For_Itype attributes of itypes are updated
+      --      to refer to the new replicated Associated_Node_For_Itype.
+
+      return Copy_Node_With_Replacement (Source);
    end New_Copy_Tree;
 
    -------------------------
Index: sem_util.ads
===================================================================
--- sem_util.ads	(revision 251892)
+++ sem_util.ads	(working copy)
@@ -1371,6 +1371,9 @@
    --  appearing anywhere within such a construct (that is it does not need
    --  to be directly within).
 
+   function In_Subtree (Root : Node_Id; N : Node_Id) return Boolean;
+   --  Determine whether node N is within the subtree rooted at Root
+
    function In_Visible_Part (Scope_Id : Entity_Id) return Boolean;
    --  Determine whether a declaration occurs within the visible part of a
    --  package specification. The package must be on the scope stack, and the
@@ -2057,46 +2060,75 @@
       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, New_Copy_Tree copies the
-   --  entire syntactic subtree, including recursively any descendants whose
-   --  parent field references a copied node (descendants not linked to a
-   --  copied node by the parent field are not copied, instead the copied tree
-   --  references the same descendant 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. New_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:
+   --  Perform a deep copy of the subtree rooted at Source. Entities, itypes,
+   --  and nodes are handled separately as follows:
    --
-   --     old entity 1
-   --     new entity to replace references to entity 1
-   --     old entity 2
-   --     new entity to replace references to entity 2
-   --     ...
+   --    * A node is replicated by first creating a shallow copy, then copying
+   --      its syntactic fields, where all Parent pointers of the fields are
+   --      updated to refer to the copy. In addition, the following semantic
+   --      fields are recreated after the replication takes place.
    --
-   --  The call destroys the contents of Map in this case
+   --        First_Named_Actual
+   --        First_Real_Statement
+   --        Next_Named_Actual
    --
-   --  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.
+   --      If applicable, the Etype field (if any) is updated to refer to a
+   --      local itype or type (see below).
    --
-   --  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.
+   --    * An entity defined within an N_Expression_With_Actions node in the
+   --      subtree is given a new entity, and all references to the original
+   --      entity are updated to refer to the new entity. In addition, the
+   --      following semantic fields are replicated and/or updated to refer
+   --      to a local entity or itype.
    --
-   --  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.
+   --        Discriminant_Constraint
+   --        Etype
+   --        First_Index
+   --        Next_Entity
+   --        Packed_Array_Impl_Type
+   --        Scalar_Range
+   --        Scope
+   --
+   --      Note that currently no other expression can define entities.
+   --
+   --    * An itype whose Associated_Node_For_Itype node is in the subtree
+   --      is given a new entity, and all references to the original itype
+   --      are updated to refer to the new itype. In addition, the following
+   --      semantic fields are replicated and/or updated to refer to a local
+   --      entity or itype.
+   --
+   --        Discriminant_Constraint
+   --        Etype
+   --        First_Index
+   --        Next_Entity
+   --        Packed_Array_Impl_Type
+   --        Scalar_Range
+   --        Scope
+   --
+   --      The Associated_Node_For_Itype is updated to refer to a replicated
+   --      node.
+   --
+   --  The routine can replicate both analyzed and unanalyzed trees. Copying an
+   --  Empty or Error node yields the same node.
+   --
+   --  Parameter Map may be used to specify a set of mappings between entities.
+   --  These mappings are then taken into account when replicating entities.
+   --  The format of Map must be as follows:
+   --
+   --    old entity 1
+   --    new entity to replace references to entity 1
+   --    old entity 2
+   --    new entity to replace references to entity 2
+   --    ...
+   --
+   --  Map and its contents are left unchanged.
+   --
+   --  Parameter New_Sloc may be used to specify a new source location for all
+   --  replicated entities, itypes, and nodes. The Comes_From_Source indicator
+   --  is defaulted if a new source location is provided.
+   --
+   --  Parameter New_Scope may be used to specify a new scope for all copied
+   --  entities and itypes.
 
    function New_External_Entity
      (Kind         : Entity_Kind;
@@ -2177,7 +2209,7 @@
    --  allowed as actuals for this function.
 
    function Original_Aspect_Pragma_Name (N : Node_Id) return Name_Id;
-   --  Retrieve the name of aspect or pragma N taking into account a possible
+   --  Retrieve the name of aspect or pragma N, taking into account a possible
    --  rewrite and whether the pragma is generated from an aspect as the names
    --  may be different. The routine also deals with 'Class in which case it
    --  returns the following values:
