diff options
Diffstat (limited to 'gcc/ada/exp_disp.adb')
-rw-r--r-- | gcc/ada/exp_disp.adb | 175 |
1 files changed, 79 insertions, 96 deletions
diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index 6386fdaede1..2c0832df15e 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -30,6 +30,7 @@ with Einfo; use Einfo; with Elists; use Elists; with Errout; use Errout; with Exp_Atag; use Exp_Atag; +with Exp_Ch6; use Exp_Ch6; with Exp_Ch7; use Exp_Ch7; with Exp_CG; use Exp_CG; with Exp_Dbug; use Exp_Dbug; @@ -1421,7 +1422,7 @@ package body Exp_Disp is and then Is_Class_Wide_Type (Formal_Typ) then -- No need to displace the pointer if the type of the actual - -- coindices with the type of the formal. + -- coincides with the type of the formal. if Actual_Typ = Formal_Typ then null; @@ -1437,6 +1438,19 @@ package body Exp_Disp is -- the displacement of the pointer. else + -- Normally, expansion of actuals for calls to build-in-place + -- functions happens as part of Expand_Actuals, but in this + -- case the call will be wrapped in a conversion and soon after + -- expanded further to handle the displacement for a class-wide + -- interface conversion, so if this is a BIP call then we need + -- to handle it now. + + if Ada_Version >= Ada_2005 + and then Is_Build_In_Place_Function_Call (Actual) + then + Make_Build_In_Place_Call_In_Anonymous_Context (Actual); + end if; + Conversion := Convert_To (Formal_Typ, Relocate_Node (Actual)); Rewrite (Actual, Conversion); Analyze_And_Resolve (Actual, Formal_Typ); @@ -2145,12 +2159,12 @@ package body Exp_Disp is Make_Unchecked_Type_Conversion (Loc, -- entry index Subtype_Mark => New_Reference_To - (RTE (RE_Protected_Entry_Index), Loc), + (RTE (RE_Protected_Entry_Index), Loc), Expression => Make_Identifier (Loc, Name_uI)), Make_Identifier (Loc, Name_uP), -- parameter block - New_Reference_To ( -- Asynchronous_Call - RTE (RE_Asynchronous_Call), Loc), + New_Reference_To -- Asynchronous_Call + (RTE (RE_Asynchronous_Call), Loc), New_Reference_To (Com_Block, Loc)))); -- comm block @@ -2172,7 +2186,7 @@ package body Exp_Disp is Obj_Ref, Make_Attribute_Reference (Loc, - Prefix => Make_Identifier (Loc, Name_uP), + Prefix => Make_Identifier (Loc, Name_uP), Attribute_Name => Name_Address), New_Reference_To @@ -2187,8 +2201,7 @@ package body Exp_Disp is Append_To (Stmts, Make_Assignment_Statement (Loc, - Name => - Make_Identifier (Loc, Name_uB), + Name => Make_Identifier (Loc, Name_uB), Expression => Make_Unchecked_Type_Conversion (Loc, Subtype_Mark => @@ -2218,20 +2231,17 @@ package body Exp_Disp is Parameter_Associations => New_List ( Make_Selected_Component (Loc, -- T._task_id - Prefix => - Make_Identifier (Loc, Name_uT), - Selector_Name => - Make_Identifier (Loc, Name_uTask_Id)), + Prefix => Make_Identifier (Loc, Name_uT), + Selector_Name => Make_Identifier (Loc, Name_uTask_Id)), Make_Unchecked_Type_Conversion (Loc, -- entry index Subtype_Mark => New_Reference_To (RTE (RE_Task_Entry_Index), Loc), - Expression => - Make_Identifier (Loc, Name_uI)), + Expression => Make_Identifier (Loc, Name_uI)), Make_Identifier (Loc, Name_uP), -- parameter block - New_Reference_To ( -- Asynchronous_Call - RTE (RE_Asynchronous_Call), Loc), + New_Reference_To -- Asynchronous_Call + (RTE (RE_Asynchronous_Call), Loc), Make_Identifier (Loc, Name_uF)))); -- status flag end if; @@ -2467,8 +2477,7 @@ package body Exp_Disp is Append_To (Stmts, Make_Assignment_Statement (Loc, - Name => - Make_Identifier (Loc, Name_uI), + Name => Make_Identifier (Loc, Name_uI), Expression => Make_Function_Call (Loc, Name => @@ -2540,7 +2549,7 @@ package body Exp_Disp is Obj_Ref, Make_Attribute_Reference (Loc, - Prefix => Make_Identifier (Loc, Name_uP), + Prefix => Make_Identifier (Loc, Name_uP), Attribute_Name => Name_Address), New_Reference_To @@ -2557,8 +2566,7 @@ package body Exp_Disp is Append_To (Stmts, Make_Assignment_Statement (Loc, - Name => - Make_Identifier (Loc, Name_uF), + Name => Make_Identifier (Loc, Name_uF), Expression => Make_Op_Not (Loc, Right_Opnd => @@ -2590,20 +2598,17 @@ package body Exp_Disp is New_List ( Make_Selected_Component (Loc, -- T._task_id - Prefix => - Make_Identifier (Loc, Name_uT), - Selector_Name => - Make_Identifier (Loc, Name_uTask_Id)), + Prefix => Make_Identifier (Loc, Name_uT), + Selector_Name => Make_Identifier (Loc, Name_uTask_Id)), Make_Unchecked_Type_Conversion (Loc, -- entry index Subtype_Mark => New_Reference_To (RTE (RE_Task_Entry_Index), Loc), - Expression => - Make_Identifier (Loc, Name_uI)), + Expression => Make_Identifier (Loc, Name_uI)), Make_Identifier (Loc, Name_uP), -- parameter block - New_Reference_To ( -- Conditional_Call - RTE (RE_Conditional_Call), Loc), + New_Reference_To -- Conditional_Call + (RTE (RE_Conditional_Call), Loc), Make_Identifier (Loc, Name_uF)))); -- status flag end if; @@ -2818,10 +2823,8 @@ package body Exp_Disp is New_Reference_To (RTE (RE_Address), Loc), Expression => Make_Selected_Component (Loc, - Prefix => - Make_Identifier (Loc, Name_uT), - Selector_Name => - Make_Identifier (Loc, Name_uTask_Id)))); + Prefix => Make_Identifier (Loc, Name_uT), + Selector_Name => Make_Identifier (Loc, Name_uTask_Id)))); -- A null body is constructed for non-task types @@ -2928,8 +2931,7 @@ package body Exp_Disp is else Append_To (Stmts, Make_If_Statement (Loc, - Condition => - Make_Identifier (Loc, Name_uF), + Condition => Make_Identifier (Loc, Name_uF), Then_Statements => New_List ( @@ -2955,7 +2957,7 @@ package body Exp_Disp is Name_Unchecked_Access, Prefix => Make_Selected_Component (Loc, - Prefix => + Prefix => Make_Identifier (Loc, Name_uO), Selector_Name => Make_Identifier (Loc, Name_uObject))), @@ -2964,8 +2966,7 @@ package body Exp_Disp is Subtype_Mark => New_Reference_To ( RTE (RE_Protected_Entry_Index), Loc), - Expression => - Make_Identifier (Loc, Name_uI)), + Expression => Make_Identifier (Loc, Name_uI)), Make_Identifier (Loc, Name_uA)))), -- abort status @@ -3019,70 +3020,55 @@ package body Exp_Disp is Append_To (Stmts, Make_If_Statement (Loc, - Condition => - Make_Identifier (Loc, Name_uF), + Condition => Make_Identifier (Loc, Name_uF), - Then_Statements => - New_List ( + Then_Statements => New_List ( - -- Call to Requeue_Protected_To_Task_Entry + -- Call to Requeue_Protected_To_Task_Entry - Make_Procedure_Call_Statement (Loc, - Name => - New_Reference_To ( - RTE (RE_Requeue_Protected_To_Task_Entry), Loc), + Make_Procedure_Call_Statement (Loc, + Name => + New_Reference_To + (RTE (RE_Requeue_Protected_To_Task_Entry), Loc), - Parameter_Associations => - New_List ( + Parameter_Associations => New_List ( - Make_Unchecked_Type_Conversion (Loc, -- PEA (P) - Subtype_Mark => - New_Reference_To ( - RTE (RE_Protection_Entries_Access), Loc), - Expression => - Make_Identifier (Loc, Name_uP)), + Make_Unchecked_Type_Conversion (Loc, -- PEA (P) + Subtype_Mark => + New_Reference_To + (RTE (RE_Protection_Entries_Access), Loc), + Expression => Make_Identifier (Loc, Name_uP)), - Make_Selected_Component (Loc, -- O._task_id - Prefix => - Make_Identifier (Loc, Name_uO), - Selector_Name => - Make_Identifier (Loc, Name_uTask_Id)), + Make_Selected_Component (Loc, -- O._task_id + Prefix => Make_Identifier (Loc, Name_uO), + Selector_Name => Make_Identifier (Loc, Name_uTask_Id)), - Make_Unchecked_Type_Conversion (Loc, -- entry index - Subtype_Mark => - New_Reference_To ( - RTE (RE_Task_Entry_Index), Loc), - Expression => - Make_Identifier (Loc, Name_uI)), + Make_Unchecked_Type_Conversion (Loc, -- entry index + Subtype_Mark => + New_Reference_To (RTE (RE_Task_Entry_Index), Loc), + Expression => Make_Identifier (Loc, Name_uI)), - Make_Identifier (Loc, Name_uA)))), -- abort status + Make_Identifier (Loc, Name_uA)))), -- abort status - Else_Statements => - New_List ( + Else_Statements => New_List ( - -- Call to Requeue_Task_Entry + -- Call to Requeue_Task_Entry - Make_Procedure_Call_Statement (Loc, - Name => - New_Reference_To (RTE (RE_Requeue_Task_Entry), Loc), + Make_Procedure_Call_Statement (Loc, + Name => New_Reference_To (RTE (RE_Requeue_Task_Entry), Loc), - Parameter_Associations => - New_List ( + Parameter_Associations => New_List ( - Make_Selected_Component (Loc, -- O._task_id - Prefix => - Make_Identifier (Loc, Name_uO), - Selector_Name => - Make_Identifier (Loc, Name_uTask_Id)), + Make_Selected_Component (Loc, -- O._task_id + Prefix => Make_Identifier (Loc, Name_uO), + Selector_Name => Make_Identifier (Loc, Name_uTask_Id)), - Make_Unchecked_Type_Conversion (Loc, -- entry index - Subtype_Mark => - New_Reference_To ( - RTE (RE_Task_Entry_Index), Loc), - Expression => - Make_Identifier (Loc, Name_uI)), + Make_Unchecked_Type_Conversion (Loc, -- entry index + Subtype_Mark => + New_Reference_To (RTE (RE_Task_Entry_Index), Loc), + Expression => Make_Identifier (Loc, Name_uI)), - Make_Identifier (Loc, Name_uA)))))); -- abort status + Make_Identifier (Loc, Name_uA)))))); -- abort status end if; -- Even though no declarations are needed in both cases, we allocate @@ -3304,8 +3290,7 @@ package body Exp_Disp is Append_To (Stmts, Make_Assignment_Statement (Loc, - Name => - Make_Identifier (Loc, Name_uI), + Name => Make_Identifier (Loc, Name_uI), Expression => Make_Function_Call (Loc, Name => @@ -3418,16 +3403,13 @@ package body Exp_Disp is New_List ( Make_Selected_Component (Loc, -- T._task_id - Prefix => - Make_Identifier (Loc, Name_uT), - Selector_Name => - Make_Identifier (Loc, Name_uTask_Id)), + Prefix => Make_Identifier (Loc, Name_uT), + Selector_Name => Make_Identifier (Loc, Name_uTask_Id)), Make_Unchecked_Type_Conversion (Loc, -- entry index Subtype_Mark => New_Reference_To (RTE (RE_Task_Entry_Index), Loc), - Expression => - Make_Identifier (Loc, Name_uI)), + Expression => Make_Identifier (Loc, Name_uI)), Make_Identifier (Loc, Name_uP), -- parameter block Make_Identifier (Loc, Name_uD), -- delay @@ -7345,7 +7327,7 @@ package body Exp_Disp is (Nkind (Parent (Typ)) = N_Private_Extension_Declaration and then Is_Generic_Type (Typ))) and then In_Open_Scopes (Scope (Etype (Typ))) - and then Typ = Base_Type (Typ) + and then Is_Base_Type (Typ) then Handle_Inherited_Private_Subprograms (Typ); end if; @@ -7831,7 +7813,8 @@ package body Exp_Disp is New_Reference_To (Node (Tag_Elmt), Loc), Expression => Make_Selected_Component (Loc, - Prefix => Make_Identifier (Loc, Name_uInit), + Prefix => + Make_Identifier (Loc, Name_uInit), Selector_Name => New_Reference_To (Tag_Comp, Loc)))); |