public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r12-2147] [Ada] Unsynchronized concurrent access to a Boolean variable
@ 2021-07-08 13:36 Pierre-Marie de Rodat
0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2021-07-08 13:36 UTC (permalink / raw)
To: gcc-cvs
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,
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2021-07-08 13:36 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-07-08 13:36 [gcc r12-2147] [Ada] Unsynchronized concurrent access to a Boolean variable Pierre-Marie de Rodat
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).