public inbox for gcc-cvs@sourceware.org help / color / mirror / Atom feed
From: Pierre-Marie de Rodat <pmderodat@gcc.gnu.org> To: gcc-cvs@gcc.gnu.org Subject: [gcc r12-2147] [Ada] Unsynchronized concurrent access to a Boolean variable Date: Thu, 8 Jul 2021 13:36:29 +0000 (GMT) [thread overview] Message-ID: <20210708133629.182E8398B86D@sourceware.org> (raw) https://gcc.gnu.org/g:5478d8a7aefbec4d93d32237fb29b9fdb8347b6b commit r12-2147-g5478d8a7aefbec4d93d32237fb29b9fdb8347b6b Author: Steve Baird <baird@adacore.com> Date: Mon May 24 14:38:07 2021 -0700 [Ada] Unsynchronized concurrent access to a Boolean variable gcc/ada/ * rtsfind.ads, rtsfind.adb: Add support for finding the packages System.Atomic_Operations and System.Atomic_Operations.Test_And_Set and the declarations within that latter package of the type Test_And_Set_Flag and the function Atomic_Test_And_Set. * exp_ch11.adb (Expand_N_Exception_Declaration): If an exception is declared other than at library level, then we need to call Register_Exception the first time (and only the first time) the declaration is elaborated. In order to decide whether to perform this call for a given elaboration of the declaration, we used to unconditionally use a (library-level) Boolean variable. Now we instead use a variable of type System.Atomic_Operations.Test_And_Set.Test_And_Set_Flag unless either that type is unavailable or a No_Tasking restriction is in effect (in which case we use a Boolean variable as before). Diff: --- gcc/ada/exp_ch11.adb | 83 +++++++++++++++++++++++++++++++++++++++------------- gcc/ada/rtsfind.adb | 8 +++++ 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 605882600cd..40288e47c96 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 6fe6f8567ac..5a89076dfb1 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 6bec611c808..99f870ad9ea 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,
reply other threads:[~2021-07-08 13:36 UTC|newest] Thread overview: [no followups] expand[flat|nested] mbox.gz Atom feed
Reply instructions: You may reply publicly to this message via plain-text email using any one of the following methods: * Save the following mbox file, import it into your mail client, and reply-to-all from there: mbox Avoid top-posting and favor interleaved quoting: https://en.wikipedia.org/wiki/Posting_style#Interleaved_style * Reply using the --to, --cc, and --in-reply-to switches of git-send-email(1): git send-email \ --in-reply-to=20210708133629.182E8398B86D@sourceware.org \ --to=pmderodat@gcc.gnu.org \ --cc=gcc-cvs@gcc.gnu.org \ /path/to/YOUR_REPLY https://kernel.org/pub/software/scm/git/docs/git-send-email.html * If your mail client supports setting the In-Reply-To header via mailto: links, try the mailto: linkBe sure your reply has a Subject: header at the top and a blank line before the message body.
This is a public inbox, see mirroring instructions for how to clone and mirror all data and code used for this inbox; as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).