From: Eric Botcazou Date: Mon, 16 May 2022 14:14:46 +0000 (+0200) Subject: [Ada] Build static dispatch tables always at the end of declarative part X-Git-Tag: basepoints/gcc-14~6265 X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=5a06e886ac86fd14e02eca0cf70360f1c2d9374f;p=thirdparty%2Fgcc.git [Ada] Build static dispatch tables always at the end of declarative part 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. 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 --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 5403f3b4f64..2f74208c401 100644 --- 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 index 8666902be8d..f16cfdca948 100644 --- 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