diff options
Diffstat (limited to 'gcc/ada')
| -rw-r--r-- | gcc/ada/exp_ch11.adb | 83 | ||||
| -rw-r--r-- | gcc/ada/rtsfind.adb | 8 | ||||
| -rw-r--r-- | gcc/ada/rtsfind.ads | 11 |
3 files changed, 81 insertions, 21 deletions
diff --git a/gcc/ada/exp_ch11.adb b/gcc/ada/exp_ch11.adb index 6058826..40288e4 100644 --- a/gcc/ada/exp_ch11.adb +++ b/gcc/ada/exp_ch11.adb @@ -1088,10 +1088,19 @@ package body Exp_Ch11 is -- (protecting test only needed if not at library level) - -- exceptF : Boolean := True -- static data + -- exceptF : aliased System.Atomic_Operations.Test_And_Set. + -- .Test_And_Set_Flag := 0; -- static data + -- if not Atomic_Test_And_Set (exceptF) then + -- Register_Exception (except'Unrestricted_Access); + -- end if; + + -- If a No_Tasking restriction is in effect, or if Test_And_Set_Flag + -- is unavailable, then use Boolean instead. In that case, we generate: + -- + -- exceptF : Boolean := True; -- static data -- if exceptF then - -- exceptF := False; - -- Register_Exception (except'Unchecked_Access); + -- ExceptF := False; + -- Register_Exception (except'Unrestricted_Access); -- end if; procedure Expand_N_Exception_Declaration (N : Node_Id) is @@ -1275,7 +1284,7 @@ package body Exp_Ch11 is Force_Static_Allocation_Of_Referenced_Objects (Expression (N)); - -- Register_Exception (except'Unchecked_Access); + -- Register_Exception (except'Unrestricted_Access); if not No_Exception_Handlers_Set and then not Restriction_Active (No_Exception_Registration) @@ -1296,27 +1305,59 @@ package body Exp_Ch11 is Flag_Id := Make_Defining_Identifier (Loc, Chars => New_External_Name (Chars (Id), 'F')); - - Insert_Action (N, - Make_Object_Declaration (Loc, - Defining_Identifier => Flag_Id, - Object_Definition => - New_Occurrence_Of (Standard_Boolean, Loc), - Expression => - New_Occurrence_Of (Standard_True, Loc))); - Set_Is_Statically_Allocated (Flag_Id); - Append_To (L, - Make_Assignment_Statement (Loc, - Name => New_Occurrence_Of (Flag_Id, Loc), - Expression => New_Occurrence_Of (Standard_False, Loc))); + declare + Use_Test_And_Set_Flag : constant Boolean := + (not Global_No_Tasking) + and then RTE_Available (RE_Test_And_Set_Flag); + + Flag_Decl : Node_Id; + Condition : Node_Id; + begin + if Use_Test_And_Set_Flag then + Flag_Decl := + Make_Object_Declaration (Loc, + Defining_Identifier => Flag_Id, + Aliased_Present => True, + Object_Definition => + New_Occurrence_Of (RTE (RE_Test_And_Set_Flag), Loc), + Expression => + Make_Integer_Literal (Loc, 0)); + else + Flag_Decl := + Make_Object_Declaration (Loc, + Defining_Identifier => Flag_Id, + Object_Definition => + New_Occurrence_Of (Standard_Boolean, Loc), + Expression => + New_Occurrence_Of (Standard_True, Loc)); + end if; - Insert_After_And_Analyze (N, - Make_Implicit_If_Statement (N, - Condition => New_Occurrence_Of (Flag_Id, Loc), - Then_Statements => L)); + Insert_Action (N, Flag_Decl); + + if Use_Test_And_Set_Flag then + Condition := + Make_Op_Not (Loc, + Make_Function_Call (Loc, + Name => New_Occurrence_Of + (RTE (RE_Atomic_Test_And_Set), Loc), + Parameter_Associations => + New_List (New_Occurrence_Of (Flag_Id, Loc)))); + else + Condition := New_Occurrence_Of (Flag_Id, Loc); + + Append_To (L, + Make_Assignment_Statement (Loc, + Name => New_Occurrence_Of (Flag_Id, Loc), + Expression => New_Occurrence_Of (Standard_False, Loc))); + end if; + Insert_After_And_Analyze (N, + Make_Implicit_If_Statement (N, + Condition => Condition, + Then_Statements => L)); + end; else Insert_List_After_And_Analyze (N, L); end if; diff --git a/gcc/ada/rtsfind.adb b/gcc/ada/rtsfind.adb index 6fe6f85..5a89076 100644 --- a/gcc/ada/rtsfind.adb +++ b/gcc/ada/rtsfind.adb @@ -602,6 +602,10 @@ package body Rtsfind is subtype System_Descendant is RTU_Id range System_Address_Image .. System_Tasking_Stages; + subtype System_Atomic_Operations_Descendant is System_Descendant + range System_Atomic_Operations_Test_And_Set .. + System_Atomic_Operations_Test_And_Set; + subtype System_Dim_Descendant is System_Descendant range System_Dim_Float_IO .. System_Dim_Integer_IO; @@ -689,6 +693,10 @@ package body Rtsfind is elsif U_Id in System_Descendant then Name_Buffer (7) := '.'; + if U_Id in System_Atomic_Operations_Descendant then + Name_Buffer (25) := '.'; + end if; + if U_Id in System_Dim_Descendant then Name_Buffer (11) := '.'; end if; diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads index 6bec611..99f870a 100644 --- a/gcc/ada/rtsfind.ads +++ b/gcc/ada/rtsfind.ads @@ -195,6 +195,7 @@ package Rtsfind is System_Arith_128, System_AST_Handling, System_Assertions, + System_Atomic_Operations, System_Atomic_Primitives, System_Aux_DEC, System_Bignums, @@ -468,6 +469,10 @@ package Rtsfind is System_WWd_Enum, System_WWd_Wchar, + -- Children of System.Atomic_Operations + + System_Atomic_Operations_Test_And_Set, + -- Children of System.Dim System_Dim_Float_IO, @@ -800,6 +805,9 @@ package Rtsfind is RE_Uint32, -- System.Atomic_Primitives RE_Uint64, -- System.Atomic_Primitives + RE_Test_And_Set_Flag, -- System.Atomic_Operations.Test_And_Set + RE_Atomic_Test_And_Set, -- System.Atomic_Operations.Test_And_Set + RE_AST_Handler, -- System.Aux_DEC RE_Import_Address, -- System.Aux_DEC RE_Import_Value, -- System.Aux_DEC @@ -2482,6 +2490,9 @@ package Rtsfind is RE_Uint32 => System_Atomic_Primitives, RE_Uint64 => System_Atomic_Primitives, + RE_Test_And_Set_Flag => System_Atomic_Operations_Test_And_Set, + RE_Atomic_Test_And_Set => System_Atomic_Operations_Test_And_Set, + RE_AST_Handler => System_Aux_DEC, RE_Import_Address => System_Aux_DEC, RE_Import_Value => System_Aux_DEC, |