diff options
Diffstat (limited to 'gcc/ada/exp_ch7.adb')
| -rw-r--r-- | gcc/ada/exp_ch7.adb | 106 |
1 files changed, 18 insertions, 88 deletions
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 591606e6d84..ddf6d7ea819 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -511,7 +511,6 @@ package body Exp_Ch7 is declare Spec : constant Node_Id := Parent (Corresponding_Spec (N)); Conc_Typ : Entity_Id; - Nam : Node_Id; Param : Node_Id; Param_Typ : Entity_Id; @@ -532,81 +531,12 @@ package body Exp_Ch7 is pragma Assert (Present (Param)); - -- If the associated protected object has entries, a protected - -- procedure has to service entry queues. In this case generate: + -- Historical note: In earlier versions of GNAT, there was code + -- at this point to generate stuff to service entry queues. It is + -- now abstracted in Build_Protected_Subprogram_Call_Cleanup. - -- Service_Entries (_object._object'Access); - - if Nkind (Specification (N)) = N_Procedure_Specification - and then Has_Entries (Conc_Typ) - then - case Corresponding_Runtime_Package (Conc_Typ) is - when System_Tasking_Protected_Objects_Entries => - Nam := New_Reference_To (RTE (RE_Service_Entries), Loc); - - when System_Tasking_Protected_Objects_Single_Entry => - Nam := New_Reference_To (RTE (RE_Service_Entry), Loc); - - when others => - raise Program_Error; - end case; - - Append_To (Stmts, - Make_Procedure_Call_Statement (Loc, - Name => Nam, - Parameter_Associations => New_List ( - Make_Attribute_Reference (Loc, - Prefix => - Make_Selected_Component (Loc, - Prefix => New_Reference_To ( - Defining_Identifier (Param), Loc), - Selector_Name => - Make_Identifier (Loc, Name_uObject)), - Attribute_Name => Name_Unchecked_Access)))); - - else - -- Generate: - -- Unlock (_object._object'Access); - - case Corresponding_Runtime_Package (Conc_Typ) is - when System_Tasking_Protected_Objects_Entries => - Nam := New_Reference_To (RTE (RE_Unlock_Entries), Loc); - - when System_Tasking_Protected_Objects_Single_Entry => - Nam := New_Reference_To (RTE (RE_Unlock_Entry), Loc); - - when System_Tasking_Protected_Objects => - Nam := New_Reference_To (RTE (RE_Unlock), Loc); - - when others => - raise Program_Error; - end case; - - Append_To (Stmts, - Make_Procedure_Call_Statement (Loc, - Name => Nam, - Parameter_Associations => New_List ( - Make_Attribute_Reference (Loc, - Prefix => - Make_Selected_Component (Loc, - Prefix => - New_Reference_To - (Defining_Identifier (Param), Loc), - Selector_Name => - Make_Identifier (Loc, Name_uObject)), - Attribute_Name => Name_Unchecked_Access)))); - end if; - - -- Generate: - -- Abort_Undefer; - - if Abort_Allowed then - Append_To (Stmts, - Make_Procedure_Call_Statement (Loc, - Name => - New_Reference_To (RTE (RE_Abort_Undefer), Loc), - Parameter_Associations => Empty_List)); - end if; + Build_Protected_Subprogram_Call_Cleanup + (Specification (N), Conc_Typ, Loc, Stmts); end; -- Add a call to Expunge_Unactivated_Tasks for dynamically allocated @@ -3612,7 +3542,7 @@ package body Exp_Ch7 is -- This procedure is called each time a transient block has to be inserted -- that is to say for each call to a function with unconstrained or tagged -- result. It creates a new scope on the stack scope in order to enclose - -- all transient variables generated + -- all transient variables generated. procedure Establish_Transient_Scope (N : Node_Id; Sec_Stack : Boolean) is Loc : constant Source_Ptr := Sloc (N); @@ -5157,14 +5087,14 @@ package body Exp_Ch7 is Exceptions_OK : constant Boolean := not Restriction_Active (No_Exception_Propagation); - procedure Build_Indices; - -- Generate the indices used in the dimension loops + procedure Build_Indexes; + -- Generate the indexes used in the dimension loops ------------------- - -- Build_Indices -- + -- Build_Indexes -- ------------------- - procedure Build_Indices is + procedure Build_Indexes is begin -- Generate the following identifiers: -- Jnn - for initialization @@ -5173,14 +5103,14 @@ package body Exp_Ch7 is Append_To (Index_List, Make_Defining_Identifier (Loc, New_External_Name ('J', Dim))); end loop; - end Build_Indices; + end Build_Indexes; -- Start of processing for Build_Adjust_Or_Finalize_Statements begin Finalizer_Decls := New_List; - Build_Indices; + Build_Indexes; Build_Object_Declarations (Finalizer_Data, Finalizer_Decls, Loc); Comp_Ref := @@ -5335,8 +5265,8 @@ package body Exp_Ch7 is function Build_Finalization_Call return Node_Id; -- Generate a deep finalization call for an array element - procedure Build_Indices; - -- Generate the initialization and finalization indices used in the + procedure Build_Indexes; + -- Generate the initialization and finalization indexes used in the -- dimension loops. function Build_Initialization_Call return Node_Id; @@ -5411,10 +5341,10 @@ package body Exp_Ch7 is end Build_Finalization_Call; ------------------- - -- Build_Indices -- + -- Build_Indexes -- ------------------- - procedure Build_Indices is + procedure Build_Indexes is begin -- Generate the following identifiers: -- Jnn - for initialization @@ -5427,7 +5357,7 @@ package body Exp_Ch7 is Append_To (Final_List, Make_Defining_Identifier (Loc, New_External_Name ('F', Dim))); end loop; - end Build_Indices; + end Build_Indexes; ------------------------------- -- Build_Initialization_Call -- @@ -5454,7 +5384,7 @@ package body Exp_Ch7 is Counter_Id := Make_Temporary (Loc, 'C'); Finalizer_Decls := New_List; - Build_Indices; + Build_Indexes; Build_Object_Declarations (Finalizer_Data, Finalizer_Decls, Loc); -- Generate the block which houses the finalization call, the index |