Commit 078b1a5f by Arnaud Charlet

[multiple changes]

2015-10-26  Gary Dismukes  <dismukes@adacore.com>

	* sem_ch13.adb: Minor reformatting.

2015-10-26  Steve Baird  <baird@adacore.com>

	* exp_disp.adb: Omit most dispatch table initialization code
	if Generate_SCIL is true.

2015-10-26  Arnaud Charlet  <charlet@adacore.com>

	* 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
parent e4bda610
2015-10-26 Gary Dismukes <dismukes@adacore.com>
* sem_ch13.adb: Minor reformatting.
2015-10-26 Steve Baird <baird@adacore.com>
* exp_disp.adb: Omit most dispatch table initialization code
if Generate_SCIL is true.
2015-10-26 Arnaud Charlet <charlet@adacore.com>
* 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 <schonberg@adacore.com> 2015-10-26 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb (Find_Corresponding_Spec): Reject a subprogram * sem_ch6.adb (Find_Corresponding_Spec): Reject a subprogram
......
...@@ -760,10 +760,8 @@ package body Exp_Ch3 is ...@@ -760,10 +760,8 @@ package body Exp_Ch3 is
-- want to inline, because nested stuff may cause difficulties in -- want to inline, because nested stuff may cause difficulties in
-- inter-unit inlining, and furthermore there is in any case no -- inter-unit inlining, and furthermore there is in any case no
-- point in inlining such complex init procs. -- 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); Set_Is_Inlined (Proc_Id);
end if; end if;
...@@ -3600,12 +3598,9 @@ package body Exp_Ch3 is ...@@ -3600,12 +3598,9 @@ package body Exp_Ch3 is
-- In addition, when compiled for another unit for inlining purposes, -- In addition, when compiled for another unit for inlining purposes,
-- it may make reference to entities that have not been elaborated -- it may make reference to entities that have not been elaborated
-- yet. Similar considerations apply to task types. -- 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) if not Is_Concurrent_Type (Rec_Type)
and then not Has_Task (Rec_Type) and then not Has_Task (Rec_Type)
and then not Modify_Tree_For_C
then then
Set_Is_Inlined (Proc_Id); Set_Is_Inlined (Proc_Id);
end if; end if;
...@@ -3617,6 +3612,14 @@ package body Exp_Ch3 is ...@@ -3617,6 +3612,14 @@ package body Exp_Ch3 is
Set_Debug_Info_Off (Proc_Id); Set_Debug_Info_Off (Proc_Id);
end if; 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 declare
Agg : constant Node_Id := Agg : constant Node_Id :=
Build_Equivalent_Record_Aggregate (Rec_Type); Build_Equivalent_Record_Aggregate (Rec_Type);
......
...@@ -3903,6 +3903,10 @@ package body Exp_Disp is ...@@ -3903,6 +3903,10 @@ package body Exp_Disp is
end loop; end loop;
end if; end if;
if Generate_SCIL then
Nb_Predef_Prims := 0;
end if;
-- Stage 2: Create the thunks associated with the predefined -- Stage 2: Create the thunks associated with the predefined
-- primitives and save their entity to fill the aggregate. -- primitives and save their entity to fill the aggregate.
...@@ -3924,6 +3928,7 @@ package body Exp_Disp is ...@@ -3924,6 +3928,7 @@ package body Exp_Disp is
if Is_Predefined_Dispatching_Operation (Prim) if Is_Predefined_Dispatching_Operation (Prim)
and then not Is_Abstract_Subprogram (Prim) and then not Is_Abstract_Subprogram (Prim)
and then not Is_Eliminated (Prim) and then not Is_Eliminated (Prim)
and then not Generate_SCIL
and then not Present (Prim_Table and then not Present (Prim_Table
(UI_To_Int (DT_Position (Prim)))) (UI_To_Int (DT_Position (Prim))))
then then
...@@ -4620,6 +4625,10 @@ package body Exp_Disp is ...@@ -4620,6 +4625,10 @@ package body Exp_Disp is
DT_Ptr := Node (First_Elmt (Access_Disp_Table (Typ))); DT_Ptr := Node (First_Elmt (Access_Disp_Table (Typ)));
Nb_Prim := UI_To_Int (DT_Entry_Count (First_Tag_Component (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 (DT, Is_Library_Level_Tagged_Type (Typ));
Set_Is_Statically_Allocated (SSD, 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)); Set_Is_Statically_Allocated (TSD, Is_Library_Level_Tagged_Type (Typ));
...@@ -4685,6 +4694,14 @@ package body Exp_Disp is ...@@ -4685,6 +4694,14 @@ package body Exp_Disp is
Make_SCIL_Dispatch_Table_Tag_Init (Sloc (Last (Result))); Make_SCIL_Dispatch_Table_Tag_Init (Sloc (Last (Result)));
Set_SCIL_Entity (New_Node, Typ); Set_SCIL_Entity (New_Node, Typ);
Set_SCIL_Node (Last (Result), New_Node); 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; end if;
-- Generate: -- Generate:
...@@ -4754,6 +4771,14 @@ package body Exp_Disp is ...@@ -4754,6 +4771,14 @@ package body Exp_Disp is
Make_SCIL_Dispatch_Table_Tag_Init (Sloc (Last (Result))); Make_SCIL_Dispatch_Table_Tag_Init (Sloc (Last (Result)));
Set_SCIL_Entity (New_Node, Typ); Set_SCIL_Entity (New_Node, Typ);
Set_SCIL_Node (Last (Result), New_Node); 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; end if;
Append_To (Result, Append_To (Result,
...@@ -6213,6 +6238,8 @@ package body Exp_Disp is ...@@ -6213,6 +6238,8 @@ package body Exp_Disp is
end; end;
end if; end if;
<<Early_Exit_For_SCIL>>
-- Register the tagged type in the call graph nodes table -- Register the tagged type in the call graph nodes table
Register_CG_Node (Typ); Register_CG_Node (Typ);
...@@ -7087,6 +7114,7 @@ package body Exp_Disp is ...@@ -7087,6 +7114,7 @@ package body Exp_Disp is
if not RTE_Available (RE_Tag) if not RTE_Available (RE_Tag)
or else Is_Eliminated (Ultimate_Alias (Prim)) or else Is_Eliminated (Ultimate_Alias (Prim))
or else Generate_SCIL
then then
return L; return L;
end if; end if;
......
...@@ -4003,14 +4003,14 @@ package body Sem_Ch13 is ...@@ -4003,14 +4003,14 @@ package body Sem_Ch13 is
if Debug_Flag_Dot_XX then if Debug_Flag_Dot_XX then
null; null;
-- OK if current attribute_definition_clause is expansion -- OK if current attribute_definition_clause is expansion of
-- of inherited aspect. -- inherited aspect.
elsif Aspect_Rep_Item (Inherited) = N then elsif Aspect_Rep_Item (Inherited) = N then
null; null;
-- Indicate the operation that must be overridden, rather -- Indicate the operation that must be overridden, rather than
-- than redefining the indexing aspect -- redefining the indexing aspect.
else else
Illegal_Indexing Illegal_Indexing
......
...@@ -735,9 +735,6 @@ package Sinfo is ...@@ -735,9 +735,6 @@ package Sinfo is
-- they are systematically expanded into loops (for arrays) and -- they are systematically expanded into loops (for arrays) and
-- individual assignments (for records). -- individual assignments (for records).
-- Initialization procedures (init procs) for records and arrays are
-- not inlined.
------------------------------------ ------------------------------------
-- Description of Semantic Fields -- -- Description of Semantic Fields --
------------------------------------ ------------------------------------
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment