From 078b1a5f6db354c2f8cf73c535542e2d32224e3a Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 26 Oct 2015 11:54:01 +0100 Subject: [PATCH] [multiple changes] 2015-10-26 Gary Dismukes * sem_ch13.adb: Minor reformatting. 2015-10-26 Steve Baird * exp_disp.adb: Omit most dispatch table initialization code if Generate_SCIL is true. 2015-10-26 Arnaud Charlet * sinfo.ads, exp_ch3.adb: Revert previous change. (Build_Record_Init_Proc): Do not build an aggregate if Modify_Tree_For_C. From-SVN: r229327 --- gcc/ada/ChangeLog | 15 +++++++++++++++ gcc/ada/exp_ch3.adb | 15 +++++++++------ gcc/ada/exp_disp.adb | 28 ++++++++++++++++++++++++++++ gcc/ada/sem_ch13.adb | 8 ++++---- gcc/ada/sinfo.ads | 3 --- 5 files changed, 56 insertions(+), 13 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 442dafe0853..1e7dfdbeff7 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,18 @@ +2015-10-26 Gary Dismukes + + * sem_ch13.adb: Minor reformatting. + +2015-10-26 Steve Baird + + * exp_disp.adb: Omit most dispatch table initialization code + if Generate_SCIL is true. + +2015-10-26 Arnaud Charlet + + * sinfo.ads, exp_ch3.adb: Revert previous change. + (Build_Record_Init_Proc): Do not build an aggregate if + Modify_Tree_For_C. + 2015-10-26 Ed Schonberg * sem_ch6.adb (Find_Corresponding_Spec): Reject a subprogram diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 04d1fc821f9..6fb3a598351 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -760,10 +760,8 @@ package body Exp_Ch3 is -- want to inline, because nested stuff may cause difficulties in -- inter-unit inlining, and furthermore there is in any case no -- point in inlining such complex init procs. - -- Also do not inline in case of Modify_Tree_For_C where front-end - -- inlining is used and may not always play well with init procs. - if not Has_Task (Proc_Id) and then not Modify_Tree_For_C then + if not Has_Task (Proc_Id) then Set_Is_Inlined (Proc_Id); end if; @@ -3600,12 +3598,9 @@ package body Exp_Ch3 is -- In addition, when compiled for another unit for inlining purposes, -- it may make reference to entities that have not been elaborated -- yet. Similar considerations apply to task types. - -- Also do not inline in case of Modify_Tree_For_C where front-end - -- inlining is used and may not always play well with init procs. if not Is_Concurrent_Type (Rec_Type) and then not Has_Task (Rec_Type) - and then not Modify_Tree_For_C then Set_Is_Inlined (Proc_Id); end if; @@ -3617,6 +3612,14 @@ package body Exp_Ch3 is Set_Debug_Info_Off (Proc_Id); end if; + -- Do not build an aggregate if Modify_Tree_For_C, this isn't + -- needed and may generate early references to non frozen types + -- since we expand aggregate much more systematically. + + if Modify_Tree_For_C then + return; + end if; + declare Agg : constant Node_Id := Build_Equivalent_Record_Aggregate (Rec_Type); diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index d8ad4f8fd8c..7abc0b543a5 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -3903,6 +3903,10 @@ package body Exp_Disp is end loop; end if; + if Generate_SCIL then + Nb_Predef_Prims := 0; + end if; + -- Stage 2: Create the thunks associated with the predefined -- primitives and save their entity to fill the aggregate. @@ -3924,6 +3928,7 @@ package body Exp_Disp is if Is_Predefined_Dispatching_Operation (Prim) and then not Is_Abstract_Subprogram (Prim) and then not Is_Eliminated (Prim) + and then not Generate_SCIL and then not Present (Prim_Table (UI_To_Int (DT_Position (Prim)))) then @@ -4620,6 +4625,10 @@ package body Exp_Disp is DT_Ptr := Node (First_Elmt (Access_Disp_Table (Typ))); Nb_Prim := UI_To_Int (DT_Entry_Count (First_Tag_Component (Typ))); + if Generate_SCIL then + Nb_Prim := 0; + end if; + Set_Is_Statically_Allocated (DT, Is_Library_Level_Tagged_Type (Typ)); Set_Is_Statically_Allocated (SSD, Is_Library_Level_Tagged_Type (Typ)); Set_Is_Statically_Allocated (TSD, Is_Library_Level_Tagged_Type (Typ)); @@ -4685,6 +4694,14 @@ package body Exp_Disp is Make_SCIL_Dispatch_Table_Tag_Init (Sloc (Last (Result))); Set_SCIL_Entity (New_Node, Typ); Set_SCIL_Node (Last (Result), New_Node); + + goto Early_Exit_For_SCIL; + + -- Gnat2scil has its own implementation of dispatch tables, + -- different than what is being implemented here. Generating + -- further dispatch table initialization code would just + -- cause gnat2scil to generate useless Scil which CodePeer + -- would waste time and space analyzing, so we skip it. end if; -- Generate: @@ -4754,6 +4771,14 @@ package body Exp_Disp is Make_SCIL_Dispatch_Table_Tag_Init (Sloc (Last (Result))); Set_SCIL_Entity (New_Node, Typ); Set_SCIL_Node (Last (Result), New_Node); + + goto Early_Exit_For_SCIL; + + -- Gnat2scil has its own implementation of dispatch tables, + -- different than what is being implemented here. Generating + -- further dispatch table initialization code would just + -- cause gnat2scil to generate useless Scil which CodePeer + -- would waste time and space analyzing, so we skip it. end if; Append_To (Result, @@ -6213,6 +6238,8 @@ package body Exp_Disp is end; end if; + <> + -- Register the tagged type in the call graph nodes table Register_CG_Node (Typ); @@ -7087,6 +7114,7 @@ package body Exp_Disp is if not RTE_Available (RE_Tag) or else Is_Eliminated (Ultimate_Alias (Prim)) + or else Generate_SCIL then return L; end if; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 9ef6263846f..93da0497f37 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -4003,14 +4003,14 @@ package body Sem_Ch13 is if Debug_Flag_Dot_XX then null; - -- OK if current attribute_definition_clause is expansion - -- of inherited aspect. + -- OK if current attribute_definition_clause is expansion of + -- inherited aspect. elsif Aspect_Rep_Item (Inherited) = N then null; - -- Indicate the operation that must be overridden, rather - -- than redefining the indexing aspect + -- Indicate the operation that must be overridden, rather than + -- redefining the indexing aspect. else Illegal_Indexing diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 3528f9fbd12..5f2f0920eaf 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -735,9 +735,6 @@ package Sinfo is -- they are systematically expanded into loops (for arrays) and -- individual assignments (for records). - -- Initialization procedures (init procs) for records and arrays are - -- not inlined. - ------------------------------------ -- Description of Semantic Fields -- ------------------------------------ -- 2.30.2