diff mbox series

[Ada] Build static dispatch tables always at the end of declarative part

Message ID 20220602090858.GA1010710@adacore.com
State New
Headers show
Series [Ada] Build static dispatch tables always at the end of declarative part | expand

Commit Message

Pierre-Marie de Rodat June 2, 2022, 9:08 a.m. UTC 
The static dispatch tables of library-level tagged types are either built
on the first object declaration or at the end of the declarative part of
the package spec or body. There is no real need for the former case, and
the tables are not built for other constructs that freeze (tagged) types.

Therefore this change removes the former case, thus causing the tables to
be always built at the end of the declarative part; that's orthogonal to
freezing and the tagged types are still frozen at the appropriate place.

Moreover, it wraps the code in the Actions list of a freeze node (like
for the nonstatic case) so that it is considered elaboration code by the
processing done in Sem_Elab and does not disturb it.

No functional changes.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

	* exp_ch3.adb (Expand_Freeze_Record_Type): Adjust comment.
	(Expand_N_Object_Declaration): Do not build static dispatch tables.
	* exp_disp.adb (Make_And_Insert_Dispatch_Table): New procedure.
	(Build_Static_Dispatch_Tables): Call it to build the dispatch tables
	and wrap them in the Actions list of a freeze node.
diff mbox series

Patch

diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -5763,7 +5763,7 @@  package body Exp_Ch3 is
 
                --  Generate dispatch table of locally defined tagged type.
                --  Dispatch tables of library level tagged types are built
-               --  later (see Analyze_Declarations).
+               --  later (see Build_Static_Dispatch_Tables).
 
                if not Building_Static_DT (Typ) then
                   Append_Freeze_Actions (Typ, Make_DT (Typ));
@@ -6907,37 +6907,6 @@  package body Exp_Ch3 is
          return;
       end if;
 
-      --  First we do special processing for objects of a tagged type where
-      --  this is the point at which the type is frozen. The creation of the
-      --  dispatch table and the initialization procedure have to be deferred
-      --  to this point, since we reference previously declared primitive
-      --  subprograms.
-
-      --  Force construction of dispatch tables of library level tagged types
-
-      if Tagged_Type_Expansion
-        and then Building_Static_Dispatch_Tables
-        and then Is_Library_Level_Entity (Def_Id)
-        and then Is_Library_Level_Tagged_Type (Base_Typ)
-        and then Ekind (Base_Typ) in E_Record_Type
-                                   | E_Protected_Type
-                                   | E_Task_Type
-        and then not Has_Dispatch_Table (Base_Typ)
-      then
-         declare
-            New_Nodes : List_Id := No_List;
-
-         begin
-            if Is_Concurrent_Type (Base_Typ) then
-               New_Nodes := Make_DT (Corresponding_Record_Type (Base_Typ));
-            else
-               New_Nodes := Make_DT (Base_Typ);
-            end if;
-
-            Insert_List_Before (N, New_Nodes);
-         end;
-      end if;
-
       --  Make shared memory routines for shared passive variable
 
       if Is_Shared_Passive (Def_Id) then


diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -358,6 +358,12 @@  package body Exp_Disp is
       procedure Build_Package_Dispatch_Tables (N : Node_Id);
       --  Build static dispatch tables associated with package declaration N
 
+      procedure Make_And_Insert_Dispatch_Table (Typ : Entity_Id);
+      --  Build the dispatch table of the tagged type Typ and insert it at the
+      --  end of Target_List after wrapping it in the Actions list of a freeze
+      --  node, so that it is skipped by Sem_Elab (Expand_Freeze_Record_Type
+      --  does the same for nonstatic dispatch tables).
+
       ---------------------------
       -- Build_Dispatch_Tables --
       ---------------------------
@@ -410,8 +416,7 @@  package body Exp_Disp is
                then
                   null;
                else
-                  Insert_List_After_And_Analyze (Last (Target_List),
-                    Make_DT (Defining_Entity (D)));
+                  Make_And_Insert_Dispatch_Table (Defining_Entity (D));
                end if;
 
             --  Handle private types of library level tagged types. We must
@@ -434,8 +439,7 @@  package body Exp_Disp is
                     and then not Is_Concurrent_Type (E2)
                   then
                      Exchange_Declarations (E1);
-                     Insert_List_After_And_Analyze (Last (Target_List),
-                       Make_DT (E1));
+                     Make_And_Insert_Dispatch_Table (E1);
                      Exchange_Declarations (E2);
                   end if;
                end;
@@ -469,6 +473,25 @@  package body Exp_Disp is
          Pop_Scope;
       end Build_Package_Dispatch_Tables;
 
+      ------------------------------------
+      -- Make_And_Insert_Dispatch_Table --
+      ------------------------------------
+
+      procedure Make_And_Insert_Dispatch_Table (Typ : Entity_Id) is
+         F_Typ : constant Entity_Id := Create_Itype (E_Class_Wide_Type, Typ);
+         --  The code generator discards freeze nodes of CW types after
+         --  evaluating their side effects, so create an artificial one.
+
+         F_Nod : constant Node_Id := Make_Freeze_Entity (Sloc (Typ));
+
+      begin
+         Set_Is_Frozen (F_Typ);
+         Set_Entity    (F_Nod, F_Typ);
+         Set_Actions   (F_Nod, Make_DT (Typ));
+
+         Insert_After_And_Analyze (Last (Target_List), F_Nod);
+      end Make_And_Insert_Dispatch_Table;
+
    --  Start of processing for Build_Static_Dispatch_Tables
 
    begin