diff options
Diffstat (limited to 'gcc/ada/exp_ch9.adb')
| -rw-r--r-- | gcc/ada/exp_ch9.adb | 152 |
1 files changed, 120 insertions, 32 deletions
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index a55a7f51698..57193cbf74f 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -4878,6 +4878,12 @@ package body Exp_Ch9 is Ldecl2 : Node_Id; begin + -- In formal verification mode, do not expand tasking constructs + + if ALFA_Mode then + return; + end if; + if Expander_Active then -- If we have no handled statement sequence, we may need to build @@ -5290,6 +5296,12 @@ package body Exp_Ch9 is Tasknm : Node_Id; begin + -- Do not expand tasking constructs in formal verification mode + + if ALFA_Mode then + return; + end if; + Aggr := Make_Aggregate (Loc, Component_Associations => New_List); Count := 0; @@ -5421,6 +5433,12 @@ package body Exp_Ch9 is -- Start of processing for Expand_N_Accept_Statement begin + -- Do not expand tasking constructs in formal verification mode + + if ALFA_Mode then + return; + end if; + -- If accept statement is not part of a list, then its parent must be -- an accept alternative, and, as described above, we do not do any -- expansion for such accept statements at this level. @@ -5848,6 +5866,7 @@ package body Exp_Ch9 is Enqueue_Call : Node_Id; Formals : List_Id; Hdle : List_Id; + Handler_Stmt : Node_Id; Index : Node_Id; Lim_Typ_Stmts : List_Id; N_Orig : Node_Id; @@ -5859,9 +5878,7 @@ package body Exp_Ch9 is ProtP_Stmts : List_Id; Stmt : Node_Id; Stmts : List_Id; - Target_Undefer : RE_Id; TaskE_Stmts : List_Id; - Undefer_Args : List_Id := No_List; B : Entity_Id; -- Call status flag Bnn : Entity_Id; -- Communication block @@ -5872,6 +5889,12 @@ package body Exp_Ch9 is T : Entity_Id; -- Additional status flag begin + -- Do not expand tasking constructs in formal verification mode + + if ALFA_Mode then + return; + end if; + Process_Statements_For_Controlled_Objects (Trig); Process_Statements_For_Controlled_Objects (Abrt); @@ -6352,13 +6375,7 @@ package body Exp_Ch9 is -- Create the inner block to protect the abortable part - Hdle := New_List ( - Make_Implicit_Exception_Handler (Loc, - Exception_Choices => - New_List (New_Reference_To (Stand.Abort_Signal, Loc)), - Statements => New_List ( - Make_Procedure_Call_Statement (Loc, - Name => New_Reference_To (RTE (RE_Abort_Undefer), Loc))))); + Hdle := New_List (Build_Abort_Block_Handler (Loc)); Prepend_To (Astats, Make_Procedure_Call_Statement (Loc, @@ -6494,8 +6511,7 @@ package body Exp_Ch9 is Append_To (Stmts, Make_Implicit_If_Statement (N, Condition => Make_Function_Call (Loc, - Name => New_Reference_To ( - RTE (RE_Enqueued), Loc), + Name => New_Reference_To (RTE (RE_Enqueued), Loc), Parameter_Associations => New_List ( New_Reference_To (Cancel_Param, Loc))), Then_Statements => Astats)); @@ -6513,13 +6529,25 @@ package body Exp_Ch9 is -- See 4jexcept.ads for an explanation. if VM_Target = No_VM then - Target_Undefer := RE_Abort_Undefer; + if Exception_Mechanism = Back_End_Exceptions then + + -- Aborts are not deferred at beginning of exception handlers + -- in ZCX. + + Handler_Stmt := Make_Null_Statement (Loc); + + else + Handler_Stmt := Make_Procedure_Call_Statement (Loc, + Name => New_Reference_To (RTE (RE_Abort_Undefer), Loc), + Parameter_Associations => No_List); + end if; else - Target_Undefer := RE_Update_Exception; - Undefer_Args := - New_List (Make_Function_Call (Loc, - Name => New_Occurrence_Of - (RTE (RE_Current_Target_Exception), Loc))); + Handler_Stmt := Make_Procedure_Call_Statement (Loc, + Name => New_Reference_To (RTE (RE_Update_Exception), Loc), + Parameter_Associations => New_List ( + Make_Function_Call (Loc, + Name => New_Occurrence_Of + (RTE (RE_Current_Target_Exception), Loc)))); end if; Stmts := New_List ( @@ -6542,11 +6570,7 @@ package body Exp_Ch9 is Exception_Choices => New_List (New_Reference_To (Stand.Abort_Signal, Loc)), - Statements => New_List ( - Make_Procedure_Call_Statement (Loc, - Name => New_Reference_To ( - RTE (Target_Undefer), Loc), - Parameter_Associations => Undefer_Args)))))), + Statements => New_List (Handler_Stmt))))), -- if not Cancelled (Bnn) then -- triggered statements @@ -6602,14 +6626,7 @@ package body Exp_Ch9 is -- Create the inner block to protect the abortable part - Hdle := New_List ( - Make_Implicit_Exception_Handler (Loc, - Exception_Choices => - New_List (New_Reference_To (Stand.Abort_Signal, Loc)), - Statements => - New_List ( - Make_Procedure_Call_Statement (Loc, - Name => New_Reference_To (RTE (RE_Abort_Undefer), Loc))))); + Hdle := New_List (Build_Abort_Block_Handler (Loc)); Prepend_To (Astats, Make_Procedure_Call_Statement (Loc, @@ -6827,6 +6844,12 @@ package body Exp_Ch9 is S : Entity_Id; -- Primitive operation slot begin + -- Do not expand tasking constructs in formal verification mode + + if ALFA_Mode then + return; + end if; + Process_Statements_For_Controlled_Objects (N); if Ada_Version >= Ada_2005 @@ -7143,6 +7166,12 @@ package body Exp_Ch9 is procedure Expand_N_Delay_Relative_Statement (N : Node_Id) is Loc : constant Source_Ptr := Sloc (N); begin + -- Do not expand tasking constructs in formal verification mode + + if ALFA_Mode then + return; + end if; + Rewrite (N, Make_Procedure_Call_Statement (Loc, Name => New_Reference_To (RTE (RO_CA_Delay_For), Loc), @@ -7162,6 +7191,12 @@ package body Exp_Ch9 is Typ : Entity_Id; begin + -- Do not expand tasking constructs in formal verification mode + + if ALFA_Mode then + return; + end if; + if Is_RTE (Base_Type (Etype (Expression (N))), RO_CA_Time) then Typ := RTE (RO_CA_Delay_Until); else @@ -7182,6 +7217,12 @@ package body Exp_Ch9 is procedure Expand_N_Entry_Body (N : Node_Id) is begin + -- Do not expand tasking constructs in formal verification mode + + if ALFA_Mode then + return; + end if; + -- Associate discriminals with the next protected operation body to be -- expanded. @@ -7203,6 +7244,12 @@ package body Exp_Ch9 is Index : Node_Id; begin + -- Do not expand tasking constructs in formal verification mode + + if ALFA_Mode then + return; + end if; + if No_Run_Time_Mode then Error_Msg_CRT ("entry call", N); return; @@ -7259,6 +7306,12 @@ package body Exp_Ch9 is Acc_Ent : Entity_Id; begin + -- Do not expand tasking constructs in formal verification mode + + if ALFA_Mode then + return; + end if; + Formal := First_Formal (Entry_Ent); Last_Decl := N; @@ -7527,6 +7580,12 @@ package body Exp_Ch9 is -- Start of processing for Expand_N_Protected_Body begin + -- Do not expand tasking constructs in formal verification mode + + if ALFA_Mode then + return; + end if; + if No_Run_Time_Mode then Error_Msg_CRT ("protected body", N); return; @@ -9079,6 +9138,12 @@ package body Exp_Ch9 is -- Start of processing for Expand_N_Requeue_Statement begin + -- Do not expand tasking constructs in formal verification mode + + if ALFA_Mode then + return; + end if; + -- Extract the components of the entry call Extract_Entry (N, Concval, Ename, Index); @@ -9665,6 +9730,12 @@ package body Exp_Ch9 is -- Start of processing for Expand_N_Selective_Accept begin + -- Do not expand tasking constructs in formal verification mode + + if ALFA_Mode then + return; + end if; + Process_Statements_For_Controlled_Objects (N); -- First insert some declarations before the select. The first is: @@ -10295,6 +10366,12 @@ package body Exp_Ch9 is -- Used to determine the proper location of wrapper body insertions begin + -- Do not expand tasking constructs in formal verification mode + + if ALFA_Mode then + return; + end if; + -- Add renaming declarations for discriminals and a declaration for the -- entry family index (if applicable). @@ -10991,6 +11068,11 @@ package body Exp_Ch9 is -- end if; -- end; + -- The triggering statement and the sequence of timed statements have not + -- been analyzed yet (see Analyzed_Timed_Entry_Call). They may contain + -- local declarations, and therefore the copies that are made during + -- expansion must be disjoint, as for any other inlining. + procedure Expand_N_Timed_Entry_Call (N : Node_Id) is Loc : constant Source_Ptr := Sloc (N); @@ -11036,6 +11118,12 @@ package body Exp_Ch9 is S : Entity_Id; -- Primitive operation slot begin + -- Do not expand tasking constructs in formal verification mode + + if ALFA_Mode then + return; + end if; + -- Under the Ravenscar profile, timed entry calls are excluded. An error -- was already reported on spec, so do not attempt to expand the call. @@ -11284,7 +11372,7 @@ package body Exp_Ch9 is -- <timed-statements> -- end if; - N_Stats := New_Copy_List_Tree (E_Stats); + N_Stats := Copy_Separate_List (E_Stats); Prepend_To (N_Stats, Make_If_Statement (Loc, @@ -11327,7 +11415,7 @@ package body Exp_Ch9 is -- <dispatching-call>; -- <triggering-statements> - Lim_Typ_Stmts := New_Copy_List_Tree (E_Stats); + Lim_Typ_Stmts := Copy_Separate_List (E_Stats); Prepend_To (Lim_Typ_Stmts, New_Copy_Tree (E_Call)); -- Generate: |