[Ada] Extend atomic synchronization handling to selections
Arnaud Charlet
charlet@adacore.com
Fri Nov 4 13:44:00 GMT 2011
This patch extends atomic synchronization to selected components and
explicit dereferences when the result is a type for which atomic sync
is enabled. Also it handles the case of an indexed selection from an
array with atomic components.
Tested on x86_64-pc-linux-gnu, committed on trunk
2011-11-04 Robert Dewar <dewar@adacore.com>
* exp_ch2.adb (Expand_Entity_Reference): Do not set
Atomic_Sync_Required for the case of a prefix of an attribute.
* exp_ch4.adb (Expand_N_Explicit_Dereference): May require
atomic synchronization
(Expand_N_Indexed_Component): Ditto.
(Expand_B_Selected_Component): Ditto.
* sem_prag.adb (Process_Suppress_Unsuppress):
Disable/Enable_Atomic_Synchronization can now occur for array
types with pragma Atomic_Components.
* sinfo.ads, sinfo.adb (Atomic_Sync_Required): Can now occur on
N_Explicit_Dereference nodes and on N_Indexed_Component nodes.
-------------- next part --------------
Index: sinfo.adb
===================================================================
--- sinfo.adb (revision 180934)
+++ sinfo.adb (working copy)
@@ -254,7 +254,9 @@
begin
pragma Assert (False
or else NT (N).Nkind = N_Expanded_Name
- or else NT (N).Nkind = N_Identifier);
+ or else NT (N).Nkind = N_Explicit_Dereference
+ or else NT (N).Nkind = N_Identifier
+ or else NT (N).Nkind = N_Indexed_Component);
return Flag14 (N);
end Atomic_Sync_Required;
@@ -3323,7 +3325,9 @@
begin
pragma Assert (False
or else NT (N).Nkind = N_Expanded_Name
- or else NT (N).Nkind = N_Identifier);
+ or else NT (N).Nkind = N_Explicit_Dereference
+ or else NT (N).Nkind = N_Identifier
+ or else NT (N).Nkind = N_Indexed_Component);
Set_Flag14 (N, Val);
end Set_Atomic_Sync_Required;
Index: sinfo.ads
===================================================================
--- sinfo.ads (revision 180934)
+++ sinfo.ads (working copy)
@@ -609,7 +609,13 @@
-- This flag is set in an identifier or expanded name node if the
-- corresponding reference (or assignment when on the left side of
-- an assignment) requires atomic synchronization, as a result of
- -- Atomic_Synchronization being enabled for the corresponding entity.
+ -- Atomic_Synchronization being enabled for the corresponding entity
+ -- or its type. Also set for Selector_Name of an N_Selected Component
+ -- node if the type is atomic and requires atomic synchronization.
+ -- Also set on an N_Explicit Dereference node if the resulting type
+ -- is atomic and requires atomic synchronization. Finally it is set
+ -- on an N_Indexed_Component node if the resulting type is Atomic, or
+ -- if the array type or the array has pragma Atomic_Components set.
-- At_End_Proc (Node1)
-- This field is present in an N_Handled_Sequence_Of_Statements node.
@@ -3175,6 +3181,7 @@
-- Sloc points to ALL
-- Prefix (Node3)
-- Actual_Designated_Subtype (Node4-Sem)
+ -- Atomic_Sync_Required (Flag14-Sem)
-- plus fields for expression
-------------------------------
@@ -3197,6 +3204,7 @@
-- Sloc contains a copy of the Sloc value of the Prefix
-- Prefix (Node3)
-- Expressions (List1)
+ -- Atomic_Sync_Required (Flag14-Sem)
-- plus fields for expression
-- Note: if any of the subscripts requires a range check, then the
Index: sem_prag.adb
===================================================================
--- sem_prag.adb (revision 180939)
+++ sem_prag.adb (working copy)
@@ -5462,7 +5462,7 @@
-- a non-atomic variable.
if C = Atomic_Synchronization
- and then not Is_Atomic (E)
+ and then not (Is_Atomic (E) or else Has_Atomic_Components (E))
then
Error_Msg_N
("pragma & requires atomic type or variable",
Index: exp_ch2.adb
===================================================================
--- exp_ch2.adb (revision 180939)
+++ exp_ch2.adb (working copy)
@@ -404,6 +404,15 @@
if Nkind_In (N, N_Identifier, N_Expanded_Name)
and then Ekind (E) = E_Variable
and then (Is_Atomic (E) or else Is_Atomic (Etype (E)))
+
+ -- Don't go setting the flag for the prefix of an attribute because
+ -- we don't want atomic sync for X'Size, X'Access etc.
+
+ -- Is this right in all cases of attributes???
+ -- Are there other exemptions required ???
+
+ and then (Nkind (Parent (N)) /= N_Attribute_Reference
+ or else Prefix (Parent (N)) /= N)
then
declare
Set : Boolean;
@@ -444,6 +453,7 @@
-- Set flag if required
if Set then
+ Set_Atomic_Sync_Required (N);
-- Generate info message if requested
@@ -457,8 +467,6 @@
Error_Msg_N
("?info: atomic synchronization set for &", MLoc);
end if;
-
- Set_Atomic_Sync_Required (N);
end if;
end;
end if;
Index: exp_ch4.adb
===================================================================
--- exp_ch4.adb (revision 180934)
+++ exp_ch4.adb (working copy)
@@ -591,8 +591,7 @@
-- 1) Get access to the allocated object
Rewrite (N,
- Make_Explicit_Dereference (Loc,
- Relocate_Node (N)));
+ Make_Explicit_Dereference (Loc, Relocate_Node (N)));
Set_Etype (N, Etyp);
Set_Analyzed (N);
@@ -4472,6 +4471,21 @@
-- Insert explicit dereference call for the checked storage pool case
Insert_Dereference_Action (Prefix (N));
+
+ -- If the type is an Atomic type for which Atomic_Sync is enabled, then
+ -- we set the atomic sync flag.
+
+ if Is_Atomic (Etype (N))
+ and then not Atomic_Synchronization_Disabled (Etype (N))
+ then
+ Set_Atomic_Sync_Required (N);
+
+ -- Generate info message if requested
+
+ if Warn_On_Atomic_Synchronization then
+ Error_Msg_N ("?info: atomic synchronization set", N);
+ end if;
+ end if;
end Expand_N_Explicit_Dereference;
--------------------------------------
@@ -5245,6 +5259,7 @@
Typ : constant Entity_Id := Etype (N);
P : constant Node_Id := Prefix (N);
T : constant Entity_Id := Etype (P);
+ Atp : Entity_Id;
begin
-- A special optimization, if we have an indexed component that is
@@ -5290,6 +5305,9 @@
if Is_Access_Type (T) then
Insert_Explicit_Dereference (P);
Analyze_And_Resolve (P, Designated_Type (T));
+ Atp := Designated_Type (T);
+ else
+ Atp := T;
end if;
-- Generate index and validity checks
@@ -5300,6 +5318,23 @@
Apply_Subscript_Validity_Checks (N);
end if;
+ -- If selecting from an array with atomic components, and atomic sync
+ -- is not suppressed for this array type, set atomic sync flag.
+
+ if (Has_Atomic_Components (Atp)
+ and then not Atomic_Synchronization_Disabled (Atp))
+ or else (Is_Atomic (Typ)
+ and then not Atomic_Synchronization_Disabled (Typ))
+ then
+ Set_Atomic_Sync_Required (N);
+
+ -- Generate info message if requested
+
+ if Warn_On_Atomic_Synchronization then
+ Error_Msg_N ("?info: atomic synchronization set", N);
+ end if;
+ end if;
+
-- All done for the non-packed case
if not Is_Packed (Etype (Prefix (N))) then
@@ -7869,9 +7904,6 @@
-- Expand_N_Selected_Component --
---------------------------------
- -- If the selector is a discriminant of a concurrent object, rewrite the
- -- prefix to denote the corresponding record type.
-
procedure Expand_N_Selected_Component (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N);
Par : constant Node_Id := Parent (N);
@@ -8175,6 +8207,24 @@
Rewrite (N, New_N);
Analyze (N);
end if;
+
+ -- If we still have a selected component, and the type is an Atomic
+ -- type for which Atomic_Sync is enabled, then we set the atomic sync
+ -- flag on the selector.
+
+ if Nkind (N) = N_Selected_Component
+ and then Is_Atomic (Etype (N))
+ and then not Atomic_Synchronization_Disabled (Etype (N))
+ then
+ Set_Atomic_Sync_Required (Selector_Name (N));
+
+ -- Generate info message if requested
+
+ if Warn_On_Atomic_Synchronization then
+ Error_Msg_N
+ ("?info: atomic synchronization set for &", Selector_Name (N));
+ end if;
+ end if;
end Expand_N_Selected_Component;
--------------------
More information about the Gcc-patches
mailing list