[Ada] Quadratic compile time with tagged types

This patch is an incremental commit which focuses on the optimization of entity
chain navigation by adding an additional field (Prev_Entity) to all nodes in
order to greaty speed up compilation of sources making heavy use of tagged
derivations by effectly making the entity chain from a singly-linked list into
a doubly-linked one.

This is only a performance improvement: no compilation result change
expected.

2018-05-24  Justin Squirek  <squirek@adacore.com>

gcc/ada/

	* einfo.ads, einfo.adb (Append_Entity): Modified to use Link_Entities
	and manage doubly-linked entity chain.
	(Nested_Scenarios): Removed entity field used for optimization during
	 elaboration to make room for the new field Prev_Entity.
	(Link_Entities): Added to replace redundant calls to Set_Next_Entity
	and Set_Prev_Entity as well as centralize changes to the entity chain.
	(Predicated_Parent): Modified to use Node38.
	(Prev_Entity): Added to fetch new node field Prev_Entity in all entity
	types.
	(Remove_Entity): Moved from sem_util.
	(Set_Nested_Scenarios): Deleted.
	(Set_Predicated_Parent): Modified to use Node38.
	(Set_Prev_Entity): Added to set Prev_Entity field.
	(Set_Validated_Object): Modified to use Node38.
	(Unlink_Next_Entity): Added to process Prev_Entity when an unlinking
	action is required.
	(Validated_Object): Modified to use Node38.
	(Write_Field36_Name): Remove Nested_Scenarios, Validated_Object, and
	predicated parent cases.
	(Write_Field38_Name): Add predicated parent and Validated_Object cases.
	* sem_ch3.adb (Process_Subtype): Add guard to protect against
	inappropriate marking of Predicated_Parent to non-itype subtypes.
	(Make_Class_Wide_Type): Preserve Prev_Entity field and set in new type.
	(Copy_And_Swap): Add setting of Prev_Entity.
	(Build_derived_Record_Type): Replace Set_Next_Entity w/ Link_Entities.
	* sem_ch6.adb (Analyze_Subprogram_Body_Helper): Replace Set_Next_Entity
	w/ Link_Entities.
	(New_Overloaded_Entity): Remove block created to search for previous
	entities in the entity chain with relevant calls to Prev_Entity as well
	as replace duplicated code from Remove_Entity_And_Homonym with a call
	to that subprogram.
	* sem_ch7.adb (Exchange_Declarations): Replace Set_Next_Entity w/
	Link_Entities.
	* sem_elab.adb (Find_And_Process_Nested_Scenarios): Remove global and
	initial subprogram declarations related to Nested_Scenarios.
	(Process_Nested_Scenarios): Deleted.
	(Save_Scenario): Deleted.
	(Traverse_Body): Remove optimization for Nested_Scenarios so as to free
	node space in the entity tree.
	* sem_util.adb, sem_util.ads (Remove_Entity): Moved to einfo.
	(Remove_Entity_And_Homonym): Added to separate functionality of
	Remove_Entity from the homonym chain directly.
	* exp_attr.adb (Expand_N_Attribute_Reference): Replace Set_Next_Entity
	w/ Link_Entities and Unlink_Next_Entity.
	* exp_ch3.adb (Expand_N_Object_Declaration): Replace Set_Next_Entity w/
	Link_Entities.
	* exp_ch6.adb (Replace_Renaming_Declaration_Id): Replace
	Set_Next_Entity w/ Link_Entities.
	* exp_disp.adb (Expand_Dispatching_Call): Replace Set_Next_Entity w/
	Link_Entities and Unlink_Next_Entity.
	* exp_spark.adb (Expand_SPARK_N_Object_Renaming_Declaration): Replace
	call to Remove_Entity with its new incarnation.
	* exp_util.adb (New_Class_Wide_Subtype): Add setting of Prev_Entity.
	* freeze.adb (Freeze_Record_Type): Replace Set_Next_Entity w/
	Link_Entities.

From-SVN: r260661

16 files changed, 428 insertions, 425 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 30f5cd6..b0ce1be 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,61 @@
+2018-05-24  Justin Squirek  <squirek@adacore.com>
+
+	* einfo.ads, einfo.adb (Append_Entity): Modified to use Link_Entities
+	and manage doubly-linked entity chain.
+	(Nested_Scenarios): Removed entity field used for optimization during
+	 elaboration to make room for the new field Prev_Entity.
+	(Link_Entities): Added to replace redundant calls to Set_Next_Entity
+	and Set_Prev_Entity as well as centralize changes to the entity chain.
+	(Predicated_Parent): Modified to use Node38.
+	(Prev_Entity): Added to fetch new node field Prev_Entity in all entity
+	types.
+	(Remove_Entity): Moved from sem_util.
+	(Set_Nested_Scenarios): Deleted.
+	(Set_Predicated_Parent): Modified to use Node38.
+	(Set_Prev_Entity): Added to set Prev_Entity field.
+	(Set_Validated_Object): Modified to use Node38.
+	(Unlink_Next_Entity): Added to process Prev_Entity when an unlinking
+	action is required.
+	(Validated_Object): Modified to use Node38.
+	(Write_Field36_Name): Remove Nested_Scenarios, Validated_Object, and
+	predicated parent cases.
+	(Write_Field38_Name): Add predicated parent and Validated_Object cases.
+	* sem_ch3.adb (Process_Subtype): Add guard to protect against
+	inappropriate marking of Predicated_Parent to non-itype subtypes.
+	(Make_Class_Wide_Type): Preserve Prev_Entity field and set in new type.
+	(Copy_And_Swap): Add setting of Prev_Entity.
+	(Build_derived_Record_Type): Replace Set_Next_Entity w/ Link_Entities.
+	* sem_ch6.adb (Analyze_Subprogram_Body_Helper): Replace Set_Next_Entity
+	w/ Link_Entities.
+	(New_Overloaded_Entity): Remove block created to search for previous
+	entities in the entity chain with relevant calls to Prev_Entity as well
+	as replace duplicated code from Remove_Entity_And_Homonym with a call
+	to that subprogram.
+	* sem_ch7.adb (Exchange_Declarations): Replace Set_Next_Entity w/
+	Link_Entities.
+	* sem_elab.adb (Find_And_Process_Nested_Scenarios): Remove global and
+	initial subprogram declarations related to Nested_Scenarios.
+	(Process_Nested_Scenarios): Deleted.
+	(Save_Scenario): Deleted.
+	(Traverse_Body): Remove optimization for Nested_Scenarios so as to free
+	node space in the entity tree.
+	* sem_util.adb, sem_util.ads (Remove_Entity): Moved to einfo.
+	(Remove_Entity_And_Homonym): Added to separate functionality of
+	Remove_Entity from the homonym chain directly.
+	* exp_attr.adb (Expand_N_Attribute_Reference): Replace Set_Next_Entity
+	w/ Link_Entities and Unlink_Next_Entity.
+	* exp_ch3.adb (Expand_N_Object_Declaration): Replace Set_Next_Entity w/
+	Link_Entities.
+	* exp_ch6.adb (Replace_Renaming_Declaration_Id): Replace
+	Set_Next_Entity w/ Link_Entities.
+	* exp_disp.adb (Expand_Dispatching_Call): Replace Set_Next_Entity w/
+	Link_Entities and Unlink_Next_Entity.
+	* exp_spark.adb (Expand_SPARK_N_Object_Renaming_Declaration): Replace
+	call to Remove_Entity with its new incarnation.
+	* exp_util.adb (New_Class_Wide_Subtype): Add setting of Prev_Entity.
+	* freeze.adb (Freeze_Record_Type): Replace Set_Next_Entity w/
+	Link_Entities.
+
 2018-05-24  Hristian Kirtchev  <kirtchev@adacore.com>
 
 	* sem_ch10.adb (Expand_Limited_With_Clause): Update the call to
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index 7ba4327..c0cb261 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -70,6 +70,7 @@ package body Einfo is
    --    Homonym                         Node4
    --    First_Rep_Item                  Node6
    --    Freeze_Node                     Node7
+   --    Prev_Entity                     Node36
    --    Associated_Entity               Node37
 
    --  The usage of other fields (and the entity kinds to which it applies)
@@ -274,10 +275,10 @@ package body Einfo is
    --    Entry_Max_Queue_Lengths_Array   Node35
    --    Import_Pragma                   Node35
 
-   --    Nested_Scenarios                Elist36
-   --    Validated_Object                Node36
-   --    Predicated_Parent               Node36
+   --    Prev_Entity                     Node36
 
+   --    Validated_Object                Node38
+   --    Predicated_Parent               Node38
    --    Class_Wide_Clone                Node38
 
    --    Protected_Subprogram            Node39
@@ -2878,14 +2879,6 @@ package body Einfo is
       return Flag22 (Id);
    end Needs_No_Actuals;
 
-   function Nested_Scenarios (Id : E) return L is
-   begin
-      pragma Assert (Ekind_In (Id, E_Function,
-                                   E_Procedure,
-                                   E_Subprogram_Body));
-      return Elist36 (Id);
-   end Nested_Scenarios;
-
    function Never_Set_In_Source (Id : E) return B is
    begin
       return Flag115 (Id);
@@ -3085,8 +3078,10 @@ package body Einfo is
 
    function Predicated_Parent (Id : E) return E is
    begin
-      pragma Assert (Is_Type (Id));
-      return Node36 (Id);
+      pragma Assert (Ekind_In (Id, E_Array_Subtype,
+                                   E_Record_Subtype,
+                                   E_Record_Subtype_With_Private));
+      return Node38 (Id);
    end Predicated_Parent;
 
    function Predicates_Ignored (Id : E) return B is
@@ -3095,6 +3090,11 @@ package body Einfo is
       return Flag288 (Id);
    end Predicates_Ignored;
 
+   function Prev_Entity (Id : E) return E is
+   begin
+      return Node36 (Id);
+   end Prev_Entity;
+
    function Prival (Id : E) return E is
    begin
       pragma Assert (Is_Protected_Component (Id));
@@ -3593,7 +3593,7 @@ package body Einfo is
    function Validated_Object (Id : E) return N is
    begin
       pragma Assert (Ekind (Id) = E_Variable);
-      return Node36 (Id);
+      return Node38 (Id);
    end Validated_Object;
 
    function Warnings_Off (Id : E) return B is
@@ -6111,14 +6111,6 @@ package body Einfo is
       Set_Flag22 (Id, V);
    end Set_Needs_No_Actuals;
 
-   procedure Set_Nested_Scenarios (Id : E; V : L) is
-   begin
-      pragma Assert (Ekind_In (Id, E_Function,
-                                   E_Procedure,
-                                   E_Subprogram_Body));
-      Set_Elist36 (Id, V);
-   end Set_Nested_Scenarios;
-
    procedure Set_Never_Set_In_Source (Id : E; V : B := True) is
    begin
       Set_Flag115 (Id, V);
@@ -6320,8 +6312,10 @@ package body Einfo is
 
    procedure Set_Predicated_Parent (Id : E; V : E) is
    begin
-      pragma Assert (Is_Type (Id));
-      Set_Node36 (Id, V);
+      pragma Assert (Ekind_In (Id, E_Array_Subtype,
+                                   E_Record_Subtype,
+                                   E_Record_Subtype_With_Private));
+      Set_Node38 (Id, V);
    end Set_Predicated_Parent;
 
    procedure Set_Predicates_Ignored (Id : E; V : B) is
@@ -6360,6 +6354,11 @@ package body Einfo is
       Set_Node22 (Id, V);
    end Set_Private_View;
 
+   procedure Set_Prev_Entity (Id : E; V : E) is
+   begin
+      Set_Node36 (Id, V);
+   end Set_Prev_Entity;
+
    procedure Set_Protected_Body_Subprogram (Id : E; V : E) is
    begin
       pragma Assert (Is_Subprogram (Id) or else Is_Entry (Id));
@@ -6848,7 +6847,7 @@ package body Einfo is
    procedure Set_Validated_Object (Id : E; V : N) is
    begin
       pragma Assert (Ekind (Id) = E_Variable);
-      Set_Node36 (Id, V);
+      Set_Node38 (Id, V);
    end Set_Validated_Object;
 
    procedure Set_Warnings_Off (Id : E; V : B := True) is
@@ -7202,17 +7201,31 @@ package body Einfo is
    -- Append_Entity --
    -------------------
 
-   procedure Append_Entity (Id : Entity_Id; V : Entity_Id) is
+   procedure Append_Entity (Id : Entity_Id; Scop : Entity_Id) is
+      Last : constant Entity_Id := Last_Entity (Scop);
+
    begin
-      if Last_Entity (V) = Empty then
-         Set_First_Entity (Id => V, V => Id);
+      Set_Scope (Id, Scop);
+      Set_Prev_Entity (Id, Empty);  --  Empty <-- Id
+
+      --  The entity chain is empty
+
+      if No (Last) then
+         Set_First_Entity (Scop, Id);
+
+      --  Otherwise the entity chain has at least one element
+
       else
-         Set_Next_Entity (Last_Entity (V), Id);
+         Link_Entities (Last, Id);  --  Last <-- Id, Last --> Id
       end if;
 
-      Set_Next_Entity (Id, Empty);
-      Set_Scope (Id, V);
-      Set_Last_Entity (Id => V, V => Id);
+      --  NOTE: The setting of the Next_Entity attribute of Id must happen
+      --  here as opposed to at the beginning of the routine because doing
+      --  so causes the binder to hang. It is not clear why ???
+
+      Set_Next_Entity (Id, Empty);  --  Id --> Empty
+
+      Set_Last_Entity (Scop, Id);
    end Append_Entity;
 
    ---------------
@@ -8377,6 +8390,23 @@ package body Einfo is
       end if;
    end Last_Formal;
 
+   -------------------
+   -- Link_Entities --
+   -------------------
+
+   procedure Link_Entities (First : Entity_Id; Second : Node_Id) is
+   begin
+      if Present (Second) then
+         Set_Prev_Entity (Second, First);  --  First <-- Second
+      end if;
+
+      Set_Next_Entity (First, Second);     --  First --> Second
+   end Link_Entities;
+
+   ----------------------
+   -- Model_Emin_Value --
+   ----------------------
+
    function Model_Emin_Value (Id : E) return Uint is
    begin
       return Machine_Emin_Value (Id);
@@ -8842,7 +8872,11 @@ package body Einfo is
       then
          Typ := Full_View (Id);
 
-      elsif Is_Itype (Id) and then Present (Predicated_Parent (Id)) then
+      elsif Ekind_In (Id, E_Array_Subtype,
+                          E_Record_Subtype,
+                          E_Record_Subtype_With_Private)
+        and then Present (Predicated_Parent (Id))
+      then
          Typ := Predicated_Parent (Id);
 
       else
@@ -8972,6 +9006,47 @@ package body Einfo is
       Set_First_Rep_Item (E, N);
    end Record_Rep_Item;
 
+   -------------------
+   -- Remove_Entity --
+   -------------------
+
+   procedure Remove_Entity (Id : Entity_Id) is
+      Next  : constant Entity_Id := Next_Entity (Id);
+      Prev  : constant Entity_Id := Prev_Entity (Id);
+      Scop  : constant Entity_Id := Scope (Id);
+      First : constant Entity_Id := First_Entity (Scop);
+      Last  : constant Entity_Id := Last_Entity  (Scop);
+
+   begin
+      --  Eliminate any existing linkages from the entity
+
+      Set_Prev_Entity (Id, Empty);  --  Empty <-- Id
+      Set_Next_Entity (Id, Empty);  --  Id --> Empty
+
+      --  The eliminated entity was the only element in the entity chain
+
+      if Id = First and then Id = Last then
+         Set_First_Entity (Scop, Empty);
+         Set_Last_Entity  (Scop, Empty);
+
+      --  The eliminated entity was the head of the entity chain
+
+      elsif Id = First then
+         Set_First_Entity (Scop, Next);
+
+      --  The eliminated entity was the tail of the entity chain
+
+      elsif Id = Last then
+         Set_Last_Entity (Scop, Prev);
+
+      --  Otherwise the eliminated entity comes from the middle of the entity
+      --  chain.
+
+      else
+         Link_Entities (Prev, Next);  --  Prev <-- Next, Prev --> Next
+      end if;
+   end Remove_Entity;
+
    ---------------
    -- Root_Type --
    ---------------
@@ -9523,6 +9598,21 @@ package body Einfo is
    end Underlying_Type;
 
    ------------------------
+   -- Unlink_Next_Entity --
+   ------------------------
+
+   procedure Unlink_Next_Entity (Id : Entity_Id) is
+      Next : constant Entity_Id := Next_Entity (Id);
+
+   begin
+      if Present (Next) then
+         Set_Prev_Entity (Next, Empty);  --  Empty <-- Next
+      end if;
+
+      Set_Next_Entity (Id, Empty);       --  Id --> Empty
+   end Unlink_Next_Entity;
+
+   ------------------------
    -- Write_Entity_Flags --
    ------------------------
 
@@ -10825,6 +10915,9 @@ package body Einfo is
    procedure Write_Field24_Name (Id : Entity_Id) is
    begin
       case Ekind (Id) is
+         when E_Package =>
+            Write_Str ("Incomplete_Actuals");
+
          when Type_Kind
             | E_Constant
             | E_Variable
@@ -10837,9 +10930,6 @@ package body Einfo is
          =>
             Write_Str ("Subps_Index");
 
-         when E_Package =>
-            Write_Str ("Incomplete_Actuals");
-
          when others =>
             Write_Str ("Field24???");
       end case;
@@ -11205,25 +11295,9 @@ package body Einfo is
    ------------------------
 
    procedure Write_Field36_Name (Id : Entity_Id) is
+      pragma Unreferenced (Id);
    begin
-      case Ekind (Id) is
-         when E_Function
-            | E_Procedure
-            | E_Subprogram_Body
-         =>
-            Write_Str ("Nested_Scenarios");
-
-         when E_Variable =>
-            Write_Str ("Validated_Object");
-
-         when E_Array_Subtype
-            | E_Record_Subtype
-         =>
-            Write_Str ("predicated parent");
-
-         when others =>
-            Write_Str ("Field36??");
-      end case;
+      Write_Str ("Prev_Entity");
    end Write_Field36_Name;
 
    ------------------------
@@ -11246,7 +11320,16 @@ package body Einfo is
          when E_Function
             | E_Procedure
          =>
-            Write_Str ("class-wide clone");
+            Write_Str ("Class_Wide_Clone");
+
+         when E_Array_Subtype
+            | E_Record_Subtype
+            | E_Record_Subtype_With_Private
+         =>
+            Write_Str ("Predicated_Parent");
+
+         when E_Variable =>
+            Write_Str ("Validated_Object");
 
          when others =>
             Write_Str ("Field38??");
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 1baac05..e6dea67 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -3549,14 +3549,6 @@ package Einfo is
 --       interpreted as an indexing of the result of the call. It is also
 --       used to resolve various cases of entry calls.
 
---    Nested_Scenarios (Elist36)
---       Present in [stand alone] subprogram bodies. The list contains all
---       nested scenarios (see the terminology in Sem_Elab) which appear within
---       the declarations, statements, and exception handlers of the subprogram
---       body. The list improves the performance of the ABE Processing phase by
---       avoiding a full tree traversal when the same subprogram body is part
---       of several distinct paths in the elaboration graph.
-
 --    Never_Set_In_Source (Flag115)
 --       Defined in all entities, but can be set only for variables and
 --       parameters. This flag is set if the object is never assigned a value
@@ -3932,7 +3924,7 @@ package Einfo is
 --       is the special version created for membership tests, where if one of
 --       these raise expressions is executed, the result is to return False.
 
---    Predicated_Parent (Node36)
+--    Predicated_Parent (Node38)
 --       Defined on itypes created by subtype indications, when the parent
 --       subtype has predicates. The itype shares the Predicate_Function
 --       of the predicated parent, but this function may not have been built
@@ -3945,6 +3937,11 @@ package Einfo is
 --       a context where Assertion_Policy is Ignore, in which case no checks
 --       (static or dynamic) must be generated for objects of the type.
 
+--    Prev_Entity (Node36)
+--       Defined in all entities. The entities of a scope are chained, and this
+--       field is used as a backward pointer for this entity list - effectivly
+--       making the entity chain doubly-linked.
+
 --    Primitive_Operations (synthesized)
 --       Defined in concurrent types, tagged record types and subtypes, tagged
 --       private types and tagged incomplete types. For concurrent types whose
@@ -4625,7 +4622,7 @@ package Einfo is
 --       in this scope and must be released on exit unless flag
 --       Sec_Stack_Needed_For_Return is set.
 
---    Validated_Object (Node36)
+--    Validated_Object (Node38)
 --       Defined in variables. Contains the object whose value is captured by
 --       the variable for validity check purposes.
 
@@ -5554,6 +5551,7 @@ package Einfo is
    --    Etype                               (Node5)
    --    First_Rep_Item                      (Node6)
    --    Freeze_Node                         (Node7)
+   --    Prev_Entity                         (Node36)
    --    Associated_Entity                   (Node37)
 
    --    Address_Taken                       (Flag104)
@@ -5860,6 +5858,7 @@ package Einfo is
    --    Component_Size                      (Uint22)   (base type only)
    --    Packed_Array_Impl_Type              (Node23)
    --    Related_Array_Object                (Node25)
+   --    Predicated_Parent                   (Node38)   (subtype only)
    --    Component_Alignment                 (special)  (base type only)
    --    Has_Component_Size_Clause           (Flag68)   (base type only)
    --    Has_Pragma_Pack                     (Flag121)  (impl base type only)
@@ -6157,7 +6156,6 @@ package Einfo is
    --    Linker_Section_Pragma               (Node33)
    --    Contract                            (Node34)
    --    Import_Pragma                       (Node35)   (non-generic case only)
-   --    Nested_Scenarios                    (Elist36)
    --    Class_Wide_Clone                    (Node38)
    --    Protected_Subprogram                (Node39)   (non-generic case only)
    --    SPARK_Pragma                        (Node40)
@@ -6486,7 +6484,6 @@ package Einfo is
    --    Linker_Section_Pragma               (Node33)
    --    Contract                            (Node34)
    --    Import_Pragma                       (Node35)   (non-generic case only)
-   --    Nested_Scenarios                    (Elist36)
    --    Class_Wide_Clone                    (Node38)
    --    Protected_Subprogram                (Node39)   (non-generic case only)
    --    SPARK_Pragma                        (Node40)
@@ -6597,6 +6594,7 @@ package Einfo is
    --    Dispatch_Table_Wrappers             (Elist26)  (base type only)
    --    Underlying_Record_View              (Node28)   (base type only)
    --    Access_Disp_Table_Elab_Flag         (Node30)   (base type only)
+   --    Predicated_Parent                   (Node38)   (subtype only)
    --    Component_Alignment                 (special)  (base type only)
    --    C_Pass_By_Copy                      (Flag125)  (base type only)
    --    Has_Dispatch_Table                  (Flag220)  (base tagged type only)
@@ -6631,6 +6629,7 @@ package Einfo is
    --    Private_View                        (Node22)
    --    Stored_Constraint                   (Elist23)
    --    Interfaces                          (Elist25)
+   --    Predicated_Parent                   (Node38)   (subtype only)
    --    Has_Completion                      (Flag26)
    --    Has_Private_Ancestor                (Flag151)
    --    Has_Private_Extension               (Flag300)
@@ -6681,7 +6680,6 @@ package Einfo is
    --    Extra_Formals                       (Node28)
    --    Anonymous_Masters                   (Elist29)
    --    Contract                            (Node34)
-   --    Nested_Scenarios                    (Elist36)
    --    SPARK_Pragma                        (Node40)
    --    Contains_Ignored_Ghost_Code         (Flag279)
    --    SPARK_Pragma_Inherited              (Flag265)
@@ -6764,7 +6762,7 @@ package Einfo is
    --    Linker_Section_Pragma               (Node33)
    --    Contract                            (Node34)
    --    Anonymous_Designated_Type           (Node35)
-   --    Validated_Object                    (Node36)
+   --    Validated_Object                    (Node38)
    --    SPARK_Pragma                        (Node40)
    --    Has_Alignment_Clause                (Flag46)
    --    Has_Atomic_Components               (Flag86)
@@ -7402,7 +7400,6 @@ package Einfo is
    function Must_Have_Preelab_Init              (Id : E) return B;
    function Needs_Debug_Info                    (Id : E) return B;
    function Needs_No_Actuals                    (Id : E) return B;
-   function Nested_Scenarios                    (Id : E) return L;
    function Never_Set_In_Source                 (Id : E) return B;
    function Next_Inlined_Subprogram             (Id : E) return E;
    function No_Dynamic_Predicate_On_Actual      (Id : E) return B;
@@ -7437,6 +7434,7 @@ package Einfo is
    function Postconditions_Proc                 (Id : E) return E;
    function Predicated_Parent                   (Id : E) return E;
    function Predicates_Ignored                  (Id : E) return B;
+   function Prev_Entity                         (Id : E) return E;
    function Prival                              (Id : E) return E;
    function Prival_Link                         (Id : E) return E;
    function Private_Dependents                  (Id : E) return L;
@@ -8106,7 +8104,6 @@ package Einfo is
    procedure Set_Must_Have_Preelab_Init          (Id : E; V : B := True);
    procedure Set_Needs_Debug_Info                (Id : E; V : B := True);
    procedure Set_Needs_No_Actuals                (Id : E; V : B := True);
-   procedure Set_Nested_Scenarios                (Id : E; V : L);
    procedure Set_Never_Set_In_Source             (Id : E; V : B := True);
    procedure Set_Next_Inlined_Subprogram         (Id : E; V : E);
    procedure Set_No_Dynamic_Predicate_On_Actual  (Id : E; V : B := True);
@@ -8139,6 +8136,7 @@ package Einfo is
    procedure Set_Partial_View_Has_Unknown_Discr  (Id : E; V : B := True);
    procedure Set_Pending_Access_Types            (Id : E; V : L);
    procedure Set_Postconditions_Proc             (Id : E; V : E);
+   procedure Set_Prev_Entity                     (Id : E; V : E);
    procedure Set_Prival                          (Id : E; V : E);
    procedure Set_Prival_Link                     (Id : E; V : E);
    procedure Set_Private_Dependents              (Id : E; V : L);
@@ -8468,8 +8466,8 @@ package Einfo is
    -- Miscellaneous Subprograms --
    -------------------------------
 
-   procedure Append_Entity (Id : Entity_Id; V : Entity_Id);
-   --  Add an entity to the list of entities declared in the scope V
+   procedure Append_Entity (Id : Entity_Id; Scop : Entity_Id);
+   --  Add an entity to the list of entities declared in the scope Scop
 
    function Get_Full_View (T : Entity_Id) return Entity_Id;
    --  If T is an incomplete type and the full declaration has been seen, or
@@ -8480,11 +8478,20 @@ package Einfo is
    --  Test if the node N is the name of an entity (i.e. is an identifier,
    --  expanded name, or an attribute reference that returns an entity).
 
+   procedure Link_Entities (First : Entity_Id; Second : Entity_Id);
+   --  Link entities First and Second in one entity chain.
+   --
+   --  NOTE: No updates are done to the First_Entity and Last_Entity fields
+   --  of the scope.
+
    function Next_Index (Id : Node_Id) return Node_Id;
    --  Given an index from a previous call to First_Index or Next_Index,
    --  returns a node representing the occurrence of the next index subtype,
    --  or Empty if there are no more index subtypes.
 
+   procedure Remove_Entity (Id : Entity_Id);
+   --  Remove entity Id from the entity chain of its scope
+
    function Scope_Depth (Id : Entity_Id) return Uint;
    --  Returns the scope depth value of the Id, unless the Id is a record
    --  type, in which case it returns the scope depth of the record scope.
@@ -8496,6 +8503,9 @@ package Einfo is
    --  is returned. If K is already a subtype kind it itself is returned. An
    --  internal error is generated if no such correspondence exists for K.
 
+   procedure Unlink_Next_Entity (Id : Entity_Id);
+   --  Unchain entity Id's forward link within the entity chain of its scope
+
    ----------------------------------
    -- Debugging Output Subprograms --
    ----------------------------------
@@ -8948,6 +8958,7 @@ package Einfo is
    pragma Inline (Last_Assignment);
    pragma Inline (Last_Entity);
    pragma Inline (Limited_View);
+   pragma Inline (Link_Entities);
    pragma Inline (Linker_Section_Pragma);
    pragma Inline (Lit_Indexes);
    pragma Inline (Lit_Strings);
@@ -8962,7 +8973,6 @@ package Einfo is
    pragma Inline (Must_Have_Preelab_Init);
    pragma Inline (Needs_Debug_Info);
    pragma Inline (Needs_No_Actuals);
-   pragma Inline (Nested_Scenarios);
    pragma Inline (Never_Set_In_Source);
    pragma Inline (Next_Index);
    pragma Inline (Next_Inlined_Subprogram);
@@ -9000,6 +9010,7 @@ package Einfo is
    pragma Inline (Postconditions_Proc);
    pragma Inline (Predicated_Parent);
    pragma Inline (Predicates_Ignored);
+   pragma Inline (Prev_Entity);
    pragma Inline (Prival);
    pragma Inline (Prival_Link);
    pragma Inline (Private_Dependents);
@@ -9020,6 +9031,7 @@ package Einfo is
    pragma Inline (Related_Instance);
    pragma Inline (Related_Type);
    pragma Inline (Relative_Deadline_Variable);
+   pragma Inline (Remove_Entity);
    pragma Inline (Renamed_Entity);
    pragma Inline (Renamed_In_Spec);
    pragma Inline (Renamed_Object);
@@ -9072,6 +9084,7 @@ package Einfo is
    pragma Inline (Underlying_Full_View);
    pragma Inline (Underlying_Record_View);
    pragma Inline (Universal_Aliasing);
+   pragma Inline (Unlink_Next_Entity);
    pragma Inline (Unset_Reference);
    pragma Inline (Used_As_Generic_Actual);
    pragma Inline (Uses_Lock_Free);
@@ -9453,7 +9466,6 @@ package Einfo is
    pragma Inline (Set_Must_Have_Preelab_Init);
    pragma Inline (Set_Needs_Debug_Info);
    pragma Inline (Set_Needs_No_Actuals);
-   pragma Inline (Set_Nested_Scenarios);
    pragma Inline (Set_Never_Set_In_Source);
    pragma Inline (Set_Next_Inlined_Subprogram);
    pragma Inline (Set_No_Dynamic_Predicate_On_Actual);
@@ -9488,6 +9500,7 @@ package Einfo is
    pragma Inline (Set_Postconditions_Proc);
    pragma Inline (Set_Predicated_Parent);
    pragma Inline (Set_Predicates_Ignored);
+   pragma Inline (Set_Prev_Entity);
    pragma Inline (Set_Prival);
    pragma Inline (Set_Prival_Link);
    pragma Inline (Set_Private_Dependents);
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index c29aa80..30d6605 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -2110,12 +2110,11 @@ package body Exp_Attr is
                            Next_Formal (Old_Formal);
                            exit when No (Old_Formal);
 
-                           Set_Next_Entity (New_Formal,
-                             New_Copy (Old_Formal));
-                           Next_Entity (New_Formal);
+                           Link_Entities (New_Formal, New_Copy (Old_Formal));
+                           Next_Entity   (New_Formal);
                         end loop;
 
-                        Set_Next_Entity (New_Formal, Empty);
+                        Unlink_Next_Entity (New_Formal);
                         Set_Last_Entity (Subp_Typ, Extra);
                      end if;
 
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 4c3a7b7..a8e2499 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -6785,8 +6785,8 @@ package body Exp_Ch3 is
                                    SPARK_Pragma_Inherited (Def_Id);
 
                   begin
-                     Set_Next_Entity (New_Id, Next_Entity (Def_Id));
-                     Set_Next_Entity (Def_Id, Next_Temp);
+                     Link_Entities (New_Id, Next_Entity (Def_Id));
+                     Link_Entities (Def_Id, Next_Temp);
 
                      Set_Chars   (Defining_Identifier (N), Chars   (Def_Id));
                      Set_Homonym (Defining_Identifier (N), Homonym (Def_Id));
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 21d87ef..3395c21 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -9201,8 +9201,8 @@ package body Exp_Ch6 is
       declare
          Next_Id : constant Entity_Id := Next_Entity (New_Id);
       begin
-         Set_Next_Entity (New_Id, Next_Entity (Orig_Id));
-         Set_Next_Entity (Orig_Id, Next_Id);
+         Link_Entities (New_Id, Next_Entity (Orig_Id));
+         Link_Entities (Orig_Id, Next_Id);
       end;
 
       Set_Homonym (New_Id, Homonym (Orig_Id));
diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index 0a63645..dbccfed 100644
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -1030,12 +1030,12 @@ package body Exp_Disp is
                Next_Formal (Old_Formal);
                exit when No (Old_Formal);
 
-               Set_Next_Entity (New_Formal, New_Copy (Old_Formal));
-               Next_Entity (New_Formal);
-               Next_Actual (Param);
+               Link_Entities (New_Formal, New_Copy (Old_Formal));
+               Next_Entity   (New_Formal);
+               Next_Actual   (Param);
             end loop;
 
-            Set_Next_Entity (New_Formal, Empty);
+            Unlink_Next_Entity (New_Formal);
             Set_Last_Entity (Subp_Typ, Extra);
          end if;
 
diff --git a/gcc/ada/exp_spark.adb b/gcc/ada/exp_spark.adb
index a8c8e3b..f59e5f3 100644
--- a/gcc/ada/exp_spark.adb
+++ b/gcc/ada/exp_spark.adb
@@ -386,7 +386,7 @@ package body Exp_SPARK is
          --  Remove the entity of the renaming declaration from visibility as
          --  the analysis of the object declaration will reintroduce it again.
 
-         Remove_Entity (Obj_Id);
+         Remove_Entity_And_Homonym (Obj_Id);
          Analyze (N);
 
       --  Otherwise unconditionally remove all side effects from the name
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 8ae2d2b..256f6bb 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -10613,6 +10613,7 @@ package body Exp_Util is
       Set_Is_Itype                  (Res);
       Set_Is_Public                 (Res, False);
       Set_Next_Entity               (Res, Empty);
+      Set_Prev_Entity               (Res, Empty);
       Set_Sloc                      (Res, Sloc (N));
 
       Set_Public_Status (Res);
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 50485f1..a275619 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -4321,7 +4321,7 @@ package body Freeze is
 
                   else
                      if Present (Prev) then
-                        Set_Next_Entity (Prev, Next_Entity (Comp));
+                        Link_Entities (Prev, Next_Entity (Comp));
                      else
                         Set_First_Entity (Rec, Next_Entity (Comp));
                      end if;
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 1a3e4d4..f3ba069 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -6609,6 +6609,7 @@ package body Sem_Ch3 is
                            Create_Itype (Ekind (Pbase), N, Derived_Type, 'B');
             Svg_Chars  : constant Name_Id   := Chars (Ibase);
             Svg_Next_E : constant Entity_Id := Next_Entity (Ibase);
+            Svg_Prev_E : constant Entity_Id := Prev_Entity (Ibase);
 
          begin
             Copy_Node (Pbase, Ibase);
@@ -6619,6 +6620,7 @@ package body Sem_Ch3 is
             Set_Associated_Node_For_Itype (Ibase, N);
 
             Set_Chars             (Ibase, Svg_Chars);
+            Set_Prev_Entity       (Ibase, Svg_Prev_E);
             Set_Next_Entity       (Ibase, Svg_Next_E);
             Set_Sloc              (Ibase, Sloc (Derived_Type));
             Set_Scope             (Ibase, Scope (Derived_Type));
@@ -7042,7 +7044,7 @@ package body Sem_Ch3 is
             if No (Next_Entity (Old_Disc))
               or else Ekind (Next_Entity (Old_Disc)) /= E_Discriminant
             then
-               Set_Next_Entity
+               Link_Entities
                  (Last_Entity (Derived_Type), Next_Entity (Old_Disc));
                exit;
             end if;
@@ -9431,8 +9433,8 @@ package body Sem_Ch3 is
          --  Restore the fields saved prior to the New_Copy_Tree call
          --  and compute the stored constraint.
 
-         Set_Etype       (Derived_Type, Save_Etype);
-         Set_Next_Entity (Derived_Type, Save_Next_Entity);
+         Set_Etype     (Derived_Type, Save_Etype);
+         Link_Entities (Derived_Type, Save_Next_Entity);
 
          if Has_Discriminants (Derived_Type) then
             Set_Discriminant_Constraint
@@ -12324,7 +12326,7 @@ package body Sem_Ch3 is
             Set_Sloc          (Full, Sloc (Priv));
       end case;
 
-      Set_Next_Entity               (Full, Save_Next_Entity);
+      Link_Entities                 (Full, Save_Next_Entity);
       Set_Homonym                   (Full, Save_Homonym);
       Set_Associated_Node_For_Itype (Full, Related_Nod);
 
@@ -14424,6 +14426,7 @@ package body Sem_Ch3 is
       Set_Is_Volatile                (Full, Is_Volatile             (Priv));
       Set_Treat_As_Volatile          (Full, Treat_As_Volatile       (Priv));
       Set_Scope                      (Full, Scope                   (Priv));
+      Set_Prev_Entity                (Full, Prev_Entity             (Priv));
       Set_Next_Entity                (Full, Next_Entity             (Priv));
       Set_First_Entity               (Full, First_Entity            (Priv));
       Set_Last_Entity                (Full, Last_Entity             (Priv));
@@ -18942,6 +18945,7 @@ package body Sem_Ch3 is
       CW_Type : Entity_Id;
       CW_Name : Name_Id;
       Next_E  : Entity_Id;
+      Prev_E  : Entity_Id;
 
    begin
       if Present (Class_Wide_Type (T)) then
@@ -18974,10 +18978,12 @@ package body Sem_Ch3 is
 
       CW_Name := Chars (CW_Type);
       Next_E  := Next_Entity (CW_Type);
+      Prev_E  := Prev_Entity (CW_Type);
       Copy_Node (T, CW_Type);
       Set_Comes_From_Source (CW_Type, False);
       Set_Chars (CW_Type, CW_Name);
       Set_Parent (CW_Type, Parent (T));
+      Set_Prev_Entity (CW_Type, Prev_E);
       Set_Next_Entity (CW_Type, Next_E);
 
       --  Ensure we have a new freeze node for the class-wide type. The partial
@@ -21761,7 +21767,7 @@ package body Sem_Ch3 is
 
             --  Indicate where the predicate function may be found
 
-            if No (Predicate_Function (Def_Id)) then
+            if No (Predicate_Function (Def_Id)) and then Is_Itype (Def_Id) then
                Set_Predicated_Parent (Def_Id, Subtype_Mark_Id);
             end if;
          end if;
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index e838e6a..5eab1e0 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -4516,7 +4516,7 @@ package body Sem_Ch6 is
             --  Body entities present (formals), so chain stuff past them
 
             else
-               Set_Next_Entity
+               Link_Entities
                  (Last_Entity (Body_Id), Next_Entity (Last_Real_Spec_Entity));
             end if;
 
@@ -10059,9 +10059,6 @@ package body Sem_Ch6 is
       E : Entity_Id;
       --  Entity that S overrides
 
-      Prev_Vis : Entity_Id := Empty;
-      --  Predecessor of E in Homonym chain
-
       procedure Check_For_Primitive_Subprogram
         (Is_Primitive  : out Boolean;
          Is_Overriding : Boolean := False);
@@ -11022,198 +11019,161 @@ package body Sem_Ch6 is
 
                   Overridden_Subp := E;
 
-                  declare
-                     Prev : Entity_Id;
-
-                  begin
-                     Prev := First_Entity (Current_Scope);
-                     while Present (Prev) and then Next_Entity (Prev) /= E loop
-                        Next_Entity (Prev);
-                     end loop;
-
-                     --  It is possible for E to be in the current scope and
-                     --  yet not in the entity chain. This can only occur in a
-                     --  generic context where E is an implicit concatenation
-                     --  in the formal part, because in a generic body the
-                     --  entity chain starts with the formals.
+                  --  It is possible for E to be in the current scope and
+                  --  yet not in the entity chain. This can only occur in a
+                  --  generic context where E is an implicit concatenation
+                  --  in the formal part, because in a generic body the
+                  --  entity chain starts with the formals.
 
-                     --  In GNATprove mode, a wrapper for an operation with
-                     --  axiomatization may be a homonym of another declaration
-                     --  for an actual subprogram (needs refinement ???).
+                  --  In GNATprove mode, a wrapper for an operation with
+                  --  axiomatization may be a homonym of another declaration
+                  --  for an actual subprogram (needs refinement ???).
 
-                     if No (Prev) then
-                        if In_Instance
-                          and then GNATprove_Mode
-                          and then
-                            Nkind (Original_Node (Unit_Declaration_Node (S))) =
-                                             N_Subprogram_Renaming_Declaration
-                        then
-                           return;
-                        else
-                           pragma Assert (Chars (E) = Name_Op_Concat);
-                           null;
-                        end if;
+                  if No (Prev_Entity (E)) then
+                     if In_Instance
+                       and then GNATprove_Mode
+                       and then
+                         Nkind (Original_Node (Unit_Declaration_Node (S))) =
+                                          N_Subprogram_Renaming_Declaration
+                     then
+                        return;
+                     else
+                        pragma Assert (Chars (E) = Name_Op_Concat);
+                        null;
                      end if;
+                  end if;
 
-                     --  E must be removed both from the entity_list of the
-                     --  current scope, and from the visibility chain.
-
-                     if Debug_Flag_E then
-                        Write_Str ("Override implicit operation ");
-                        Write_Int (Int (E));
-                        Write_Eol;
-                     end if;
+                  --  E must be removed both from the entity_list of the
+                  --  current scope, and from the visibility chain.
 
-                     --  If E is a predefined concatenation, it stands for four
-                     --  different operations. As a result, a single explicit
-                     --  declaration does not hide it. In a possible ambiguous
-                     --  situation, Disambiguate chooses the user-defined op,
-                     --  so it is correct to retain the previous internal one.
+                  if Debug_Flag_E then
+                     Write_Str ("Override implicit operation ");
+                     Write_Int (Int (E));
+                     Write_Eol;
+                  end if;
 
-                     if Chars (E) /= Name_Op_Concat
-                       or else Ekind (E) /= E_Operator
-                     then
-                        --  For nondispatching derived operations that are
-                        --  overridden by a subprogram declared in the private
-                        --  part of a package, we retain the derived subprogram
-                        --  but mark it as not immediately visible. If the
-                        --  derived operation was declared in the visible part
-                        --  then this ensures that it will still be visible
-                        --  outside the package with the proper signature
-                        --  (calls from outside must also be directed to this
-                        --  version rather than the overriding one, unlike the
-                        --  dispatching case). Calls from inside the package
-                        --  will still resolve to the overriding subprogram
-                        --  since the derived one is marked as not visible
-                        --  within the package.
-
-                        --  If the private operation is dispatching, we achieve
-                        --  the overriding by keeping the implicit operation
-                        --  but setting its alias to be the overriding one. In
-                        --  this fashion the proper body is executed in all
-                        --  cases, but the original signature is used outside
-                        --  of the package.
-
-                        --  If the overriding is not in the private part, we
-                        --  remove the implicit operation altogether.
-
-                        if Is_Private_Declaration (S) then
-                           if not Is_Dispatching_Operation (E) then
-                              Set_Is_Immediately_Visible (E, False);
-                           else
-                              --  Work done in Override_Dispatching_Operation,
-                              --  so nothing else needs to be done here.
-
-                              null;
-                           end if;
+                  --  If E is a predefined concatenation, it stands for four
+                  --  different operations. As a result, a single explicit
+                  --  declaration does not hide it. In a possible ambiguous
+                  --  situation, Disambiguate chooses the user-defined op,
+                  --  so it is correct to retain the previous internal one.
 
+                  if Chars (E) /= Name_Op_Concat
+                    or else Ekind (E) /= E_Operator
+                  then
+                     --  For nondispatching derived operations that are
+                     --  overridden by a subprogram declared in the private
+                     --  part of a package, we retain the derived subprogram
+                     --  but mark it as not immediately visible. If the
+                     --  derived operation was declared in the visible part
+                     --  then this ensures that it will still be visible
+                     --  outside the package with the proper signature
+                     --  (calls from outside must also be directed to this
+                     --  version rather than the overriding one, unlike the
+                     --  dispatching case). Calls from inside the package
+                     --  will still resolve to the overriding subprogram
+                     --  since the derived one is marked as not visible
+                     --  within the package.
+
+                     --  If the private operation is dispatching, we achieve
+                     --  the overriding by keeping the implicit operation
+                     --  but setting its alias to be the overriding one. In
+                     --  this fashion the proper body is executed in all
+                     --  cases, but the original signature is used outside
+                     --  of the package.
+
+                     --  If the overriding is not in the private part, we
+                     --  remove the implicit operation altogether.
+
+                     if Is_Private_Declaration (S) then
+                        if not Is_Dispatching_Operation (E) then
+                           Set_Is_Immediately_Visible (E, False);
                         else
-                           --  Find predecessor of E in Homonym chain
-
-                           if E = Current_Entity (E) then
-                              Prev_Vis := Empty;
-                           else
-                              Prev_Vis := Current_Entity (E);
-                              while Homonym (Prev_Vis) /= E loop
-                                 Prev_Vis := Homonym (Prev_Vis);
-                              end loop;
-                           end if;
-
-                           if Prev_Vis /= Empty then
-
-                              --  Skip E in the visibility chain
-
-                              Set_Homonym (Prev_Vis, Homonym (E));
+                           --  Work done in Override_Dispatching_Operation, so
+                           --  nothing else needs to be done here.
 
-                           else
-                              Set_Name_Entity_Id (Chars (E), Homonym (E));
-                           end if;
-
-                           Set_Next_Entity (Prev, Next_Entity (E));
-
-                           if No (Next_Entity (Prev)) then
-                              Set_Last_Entity (Current_Scope, Prev);
-                           end if;
+                           null;
                         end if;
+
+                     else
+                        Remove_Entity_And_Homonym (E);
                      end if;
+                  end if;
 
-                     Enter_Overloaded_Entity (S);
+                  Enter_Overloaded_Entity (S);
 
-                     --  For entities generated by Derive_Subprograms the
-                     --  overridden operation is the inherited primitive
-                     --  (which is available through the attribute alias).
+                  --  For entities generated by Derive_Subprograms the
+                  --  overridden operation is the inherited primitive
+                  --  (which is available through the attribute alias).
 
-                     if not (Comes_From_Source (E))
-                       and then Is_Dispatching_Operation (E)
-                       and then Find_Dispatching_Type (E) =
-                                Find_Dispatching_Type (S)
-                       and then Present (Alias (E))
-                       and then Comes_From_Source (Alias (E))
-                     then
-                        Set_Overridden_Operation    (S, Alias (E));
-                        Inherit_Subprogram_Contract (S, Alias (E));
+                  if not (Comes_From_Source (E))
+                    and then Is_Dispatching_Operation (E)
+                    and then Find_Dispatching_Type (E) =
+                             Find_Dispatching_Type (S)
+                    and then Present (Alias (E))
+                    and then Comes_From_Source (Alias (E))
+                  then
+                     Set_Overridden_Operation    (S, Alias (E));
+                     Inherit_Subprogram_Contract (S, Alias (E));
 
-                     --  Normal case of setting entity as overridden
+                  --  Normal case of setting entity as overridden
 
-                     --  Note: Static_Initialization and Overridden_Operation
-                     --  attributes use the same field in subprogram entities.
-                     --  Static_Initialization is only defined for internal
-                     --  initialization procedures, where Overridden_Operation
-                     --  is irrelevant. Therefore the setting of this attribute
-                     --  must check whether the target is an init_proc.
+                  --  Note: Static_Initialization and Overridden_Operation
+                  --  attributes use the same field in subprogram entities.
+                  --  Static_Initialization is only defined for internal
+                  --  initialization procedures, where Overridden_Operation
+                  --  is irrelevant. Therefore the setting of this attribute
+                  --  must check whether the target is an init_proc.
 
-                     elsif not Is_Init_Proc (S) then
-                        Set_Overridden_Operation    (S, E);
-                        Inherit_Subprogram_Contract (S, E);
-                     end if;
+                  elsif not Is_Init_Proc (S) then
+                     Set_Overridden_Operation    (S, E);
+                     Inherit_Subprogram_Contract (S, E);
+                  end if;
 
-                     Check_Overriding_Indicator (S, E, Is_Primitive => True);
+                  Check_Overriding_Indicator (S, E, Is_Primitive => True);
 
-                     --  The Ghost policy in effect at the point of declaration
-                     --  of a parent subprogram and an overriding subprogram
-                     --  must match (SPARK RM 6.9(17)).
+                  --  The Ghost policy in effect at the point of declaration
+                  --  of a parent subprogram and an overriding subprogram
+                  --  must match (SPARK RM 6.9(17)).
 
-                     Check_Ghost_Overriding (S, E);
+                  Check_Ghost_Overriding (S, E);
 
-                     --  If S is a user-defined subprogram or a null procedure
-                     --  expanded to override an inherited null procedure, or a
-                     --  predefined dispatching primitive then indicate that E
-                     --  overrides the operation from which S is inherited.
+                  --  If S is a user-defined subprogram or a null procedure
+                  --  expanded to override an inherited null procedure, or a
+                  --  predefined dispatching primitive then indicate that E
+                  --  overrides the operation from which S is inherited.
 
-                     if Comes_From_Source (S)
-                       or else
-                         (Present (Parent (S))
-                           and then
-                             Nkind (Parent (S)) = N_Procedure_Specification
-                           and then
-                             Null_Present (Parent (S)))
-                       or else
-                         (Present (Alias (E))
-                           and then
-                             Is_Predefined_Dispatching_Operation (Alias (E)))
-                     then
-                        if Present (Alias (E)) then
-                           Set_Overridden_Operation    (S, Alias (E));
-                           Inherit_Subprogram_Contract (S, Alias (E));
-                        end if;
+                  if Comes_From_Source (S)
+                    or else
+                      (Present (Parent (S))
+                        and then Nkind (Parent (S)) = N_Procedure_Specification
+                        and then Null_Present (Parent (S)))
+                    or else
+                      (Present (Alias (E))
+                        and then
+                          Is_Predefined_Dispatching_Operation (Alias (E)))
+                  then
+                     if Present (Alias (E)) then
+                        Set_Overridden_Operation    (S, Alias (E));
+                        Inherit_Subprogram_Contract (S, Alias (E));
                      end if;
+                  end if;
 
-                     if Is_Dispatching_Operation (E) then
+                  if Is_Dispatching_Operation (E) then
 
-                        --  An overriding dispatching subprogram inherits the
-                        --  convention of the overridden subprogram (AI-117).
+                     --  An overriding dispatching subprogram inherits the
+                     --  convention of the overridden subprogram (AI-117).
 
-                        Set_Convention (S, Convention (E));
-                        Check_Dispatching_Operation (S, E);
+                     Set_Convention (S, Convention (E));
+                     Check_Dispatching_Operation (S, E);
 
-                     else
-                        Check_Dispatching_Operation (S, Empty);
-                     end if;
+                  else
+                     Check_Dispatching_Operation (S, Empty);
+                  end if;
 
-                     Check_For_Primitive_Subprogram
-                       (Is_Primitive_Subp, Is_Overriding => True);
-                     goto Check_Inequality;
-                  end;
+                  Check_For_Primitive_Subprogram
+                    (Is_Primitive_Subp, Is_Overriding => True);
+                  goto Check_Inequality;
 
                --  Apparent redeclarations in instances can occur when two
                --  formal types get the same actual type. The subprograms in
diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb
index 866c6f9..cb4b853 100644
--- a/gcc/ada/sem_ch7.adb
+++ b/gcc/ada/sem_ch7.adb
@@ -2159,12 +2159,12 @@ package body Sem_Ch7 is
 
       Exchange_Entities (Id, Full_Id);
 
-      Set_Next_Entity (Id, Next1);
-      Set_Homonym     (Id, H1);
+      Link_Entities (Id, Next1);
+      Set_Homonym   (Id, H1);
 
-      Set_Full_View   (Full_Id, Id);
-      Set_Next_Entity (Full_Id, Next2);
-      Set_Homonym     (Full_Id, H2);
+      Set_Full_View (Full_Id, Id);
+      Link_Entities (Full_Id, Next2);
+      Set_Homonym   (Full_Id, H2);
    end Exchange_Declarations;
 
    ----------------------------
diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb
index 0b7fcb4..9525f7f 100644
--- a/gcc/ada/sem_elab.adb
+++ b/gcc/ada/sem_elab.adb
@@ -11185,32 +11185,19 @@ package body Sem_Elab is
       procedure Find_And_Process_Nested_Scenarios;
       pragma Inline (Find_And_Process_Nested_Scenarios);
       --  Examine the declarations and statements of subprogram body N for
-      --  suitable scenarios. Save each discovered scenario and process it
-      --  accordingly.
-
-      procedure Process_Nested_Scenarios (Nested : Elist_Id);
-      pragma Inline (Process_Nested_Scenarios);
-      --  Invoke Process_Conditional_ABE on each individual scenario found in
-      --  list Nested.
+      --  suitable scenarios.
 
       ---------------------------------------
       -- Find_And_Process_Nested_Scenarios --
       ---------------------------------------
 
       procedure Find_And_Process_Nested_Scenarios is
-         Body_Id : constant Entity_Id := Defining_Entity (N);
-
          function Is_Potential_Scenario
            (Nod : Node_Id) return Traverse_Result;
          --  Determine whether arbitrary node Nod denotes a suitable scenario.
          --  If it does, save it in the Nested_Scenarios list of the subprogram
          --  body, and process it.
 
-         procedure Save_Scenario (Nod : Node_Id);
-         pragma Inline (Save_Scenario);
-         --  Save scenario Nod in the Nested_Scenarios list of the subprogram
-         --  body.
-
          procedure Traverse_List (List : List_Id);
          pragma Inline (Traverse_List);
          --  Invoke Traverse_Potential_Scenarios on each node in list List
@@ -11303,14 +11290,7 @@ package body Sem_Elab is
 
             --  General case
 
-            --  Save a suitable scenario in the Nested_Scenarios list of the
-            --  subprogram body. As a result any subsequent traversals of the
-            --  subprogram body started from a different top-level scenario no
-            --  longer need to reexamine the tree.
-
             elsif Is_Suitable_Scenario (Nod) then
-               Save_Scenario (Nod);
-
                Process_Conditional_ABE
                  (N     => Nod,
                   State => State);
@@ -11320,24 +11300,6 @@ package body Sem_Elab is
          end Is_Potential_Scenario;
 
          -------------------
-         -- Save_Scenario --
-         -------------------
-
-         procedure Save_Scenario (Nod : Node_Id) is
-            Nested : Elist_Id;
-
-         begin
-            Nested := Nested_Scenarios (Body_Id);
-
-            if No (Nested) then
-               Nested := New_Elmt_List;
-               Set_Nested_Scenarios (Body_Id, Nested);
-            end if;
-
-            Append_Elmt (Nod, Nested);
-         end Save_Scenario;
-
-         -------------------
          -- Traverse_List --
          -------------------
 
@@ -11365,28 +11327,6 @@ package body Sem_Elab is
          Traverse_Potential_Scenarios (Handled_Statement_Sequence (N));
       end Find_And_Process_Nested_Scenarios;
 
-      ------------------------------
-      -- Process_Nested_Scenarios --
-      ------------------------------
-
-      procedure Process_Nested_Scenarios (Nested : Elist_Id) is
-         Nested_Elmt : Elmt_Id;
-
-      begin
-         Nested_Elmt := First_Elmt (Nested);
-         while Present (Nested_Elmt) loop
-            Process_Conditional_ABE
-              (N     => Node (Nested_Elmt),
-               State => State);
-
-            Next_Elmt (Nested_Elmt);
-         end loop;
-      end Process_Nested_Scenarios;
-
-      --  Local variables
-
-      Nested : Elist_Id;
-
    --  Start of processing for Traverse_Body
 
    begin
@@ -11411,23 +11351,10 @@ package body Sem_Elab is
          Set_Is_Visited_Body (N);
       end if;
 
-      Nested := Nested_Scenarios (Defining_Entity (N));
-
-      --  The subprogram body was already examined as part of the elaboration
-      --  graph starting from a different top-level scenario. There is no need
-      --  to traverse the declarations and statements again because this will
-      --  yield the exact same scenarios. Use the nested scenarios collected
-      --  during the first inspection of the body.
-
-      if Present (Nested) then
-         Process_Nested_Scenarios (Nested);
+      --  Examine the declarations and statements of the subprogram body for
+      --  suitable scenarios, save and process them accordingly.
 
-      --  Otherwise examine the declarations and statements of the subprogram
-      --  body for suitable scenarios, save and process them accordingly.
-
-      else
-         Find_And_Process_Nested_Scenarios;
-      end if;
+      Find_And_Process_Nested_Scenarios;
    end Traverse_Body;
 
    -----------------
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 4e12f93..d205e58 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -727,7 +727,7 @@ package body Sem_Util is
         and then Scop = Current_Scope
       then
          --  The inherited operation is available at the earliest place after
-         --  the derived type declaration ( RM 7.3.1 (6/1)). This is only
+         --  the derived type declaration (RM 7.3.1 (6/1)). This is only
          --  relevant for type extensions. If the parent operation appears
          --  after the type extension, the operation is not visible.
 
@@ -740,8 +740,8 @@ package body Sem_Util is
             then
                if Sloc (Decl) > Sloc (Par) then
                   Next_E := Next_Entity (Par);
-                  Set_Next_Entity (Par, S);
-                  Set_Next_Entity (S, Next_E);
+                  Link_Entities (Par, S);
+                  Link_Entities (S, Next_E);
                   return;
 
                else
@@ -7043,7 +7043,7 @@ package body Sem_Util is
                   null;
 
                else
-                  Set_Next_Entity (Prev, Next_Entity (E));
+                  Link_Entities (Prev, Next_Entity (E));
 
                   if No (Next_Entity (Prev)) then
                      Set_Last_Entity (Current_Scope, Prev);
@@ -19996,6 +19996,13 @@ package body Sem_Util is
             end if;
          end if;
 
+         --  Prev_Entity
+
+         Set_Prev_Entity (Id, Node_Id (
+           Copy_Field_With_Replacement
+             (Field    => Union_Id (Prev_Entity (Id)),
+              Semantic => True)));
+
          --  Next_Entity
 
          Set_Next_Entity (Id, Node_Id (
@@ -22980,92 +22987,43 @@ package body Sem_Util is
       end if;
    end References_Generic_Formal_Type;
 
-   -------------------
-   -- Remove_Entity --
-   -------------------
-
-   procedure Remove_Entity (Id : Entity_Id) is
-      Scop    : constant Entity_Id := Scope (Id);
-      Prev_Id : Entity_Id;
+   -------------------------------
+   -- Remove_Entity_And_Homonym --
+   -------------------------------
 
+   procedure Remove_Entity_And_Homonym (Id : Entity_Id) is
    begin
-      --  Remove the entity from the homonym chain. When the entity is the
-      --  head of the chain, associate the entry in the name table with its
-      --  homonym effectively making it the new head of the chain.
-
-      if Current_Entity (Id) = Id then
-         Set_Name_Entity_Id (Chars (Id), Homonym (Id));
-
-      --  Otherwise link the previous and next homonyms
-
-      else
-         Prev_Id := Current_Entity (Id);
-         if Present (Prev_Id) then
-            while Present (Prev_Id) and then Homonym (Prev_Id) /= Id loop
-               Prev_Id := Homonym (Prev_Id);
-            end loop;
-
-            Set_Homonym (Prev_Id, Homonym (Id));
-         end if;
-      end if;
-
-      --  Remove the entity from the scope entity chain. When the entity is
-      --  the head of the chain, set the next entity as the new head of the
-      --  chain.
-
-      if First_Entity (Scop) = Id then
-         Prev_Id := Empty;
-         Set_First_Entity (Scop, Next_Entity (Id));
-
-      --  Otherwise the entity is either in the middle of the chain or it acts
-      --  as its tail. Traverse and link the previous and next entities.
-
-      else
-         Prev_Id := First_Entity (Scop);
-         while Present (Prev_Id) and then Next_Entity (Prev_Id) /= Id loop
-            Next_Entity (Prev_Id);
-         end loop;
-
-         if Present (Prev_Id) then
-            Set_Next_Entity (Prev_Id, Next_Entity (Id));
-         end if;
-      end if;
-
-      --  Handle the case where the entity acts as the tail of the scope entity
-      --  chain.
-
-      if Last_Entity (Scop) = Id then
-         Set_Last_Entity (Scop, Prev_Id);
-      end if;
-   end Remove_Entity;
+      Remove_Entity (Id);
+      Remove_Homonym (Id);
+   end Remove_Entity_And_Homonym;
 
    --------------------
    -- Remove_Homonym --
    --------------------
 
-   procedure Remove_Homonym (E : Entity_Id) is
-      Prev  : Entity_Id := Empty;
-      H     : Entity_Id;
+   procedure Remove_Homonym (Id : Entity_Id) is
+      Hom  : Entity_Id;
+      Prev : Entity_Id := Empty;
 
    begin
-      if E = Current_Entity (E) then
-         if Present (Homonym (E)) then
-            Set_Current_Entity (Homonym (E));
+      if Id = Current_Entity (Id) then
+         if Present (Homonym (Id)) then
+            Set_Current_Entity (Homonym (Id));
          else
-            Set_Name_Entity_Id (Chars (E), Empty);
+            Set_Name_Entity_Id (Chars (Id), Empty);
          end if;
 
       else
-         H := Current_Entity (E);
-         while Present (H) and then H /= E loop
-            Prev := H;
-            H    := Homonym (H);
+         Hom := Current_Entity (Id);
+         while Present (Hom) and then Hom /= Id loop
+            Prev := Hom;
+            Hom  := Homonym (Hom);
          end loop;
 
-         --  If E is not on the homonym chain, nothing to do
+         --  If Id is not on the homonym chain, nothing to do
 
-         if Present (H) then
-            Set_Homonym (Prev, Homonym (E));
+         if Present (Hom) then
+            Set_Homonym (Prev, Homonym (Id));
          end if;
       end if;
    end Remove_Homonym;
@@ -23103,9 +23061,7 @@ package body Sem_Util is
    --  Start of processing for Remove_Overloaded_Entity
 
    begin
-      --  Remove the entity from both the homonym and scope chains
-
-      Remove_Entity (Id);
+      Remove_Entity_And_Homonym (Id);
 
       --  The entity denotes a primitive subprogram. Remove it from the list of
       --  primitives of the associated controlling type.
@@ -24656,7 +24612,7 @@ package body Sem_Util is
          --  destination scope.
 
          if Present (Last_Entity (To)) then
-            Set_Next_Entity (Last_Entity (To), Id);
+            Link_Entities (Last_Entity (To), Id);
          else
             Set_First_Entity (To, Id);
          end if;
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 66280f9..2aa7432 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -2489,14 +2489,14 @@ package Sem_Util is
    --  Returns True if the expression Expr contains any references to a generic
    --  type. This can only happen within a generic template.
 
-   procedure Remove_Entity (Id : Entity_Id);
+   procedure Remove_Entity_And_Homonym (Id : Entity_Id);
    --  Remove arbitrary entity Id from both the homonym and scope chains. Use
    --  Remove_Overloaded_Entity for overloadable entities. Note: the removal
    --  performed by this routine does not affect the visibility of existing
    --  homonyms.
 
-   procedure Remove_Homonym (E : Entity_Id);
-   --  Removes E from the homonym chain
+   procedure Remove_Homonym (Id : Entity_Id);
+   --  Removes entity Id from the homonym chain
 
    procedure Remove_Overloaded_Entity (Id : Entity_Id);
    --  Remove arbitrary entity Id from the homonym chain, the scope chain and