===================================================================
@@ -5875,7 +5875,6 @@
E : Entity_Id;
E_Id : Node_Id;
K : Node_Kind;
- Utyp : Entity_Id;
procedure Set_Atomic_VFA (E : Entity_Id);
-- Set given type as Is_Atomic or Is_Volatile_Full_Access. Also, if
@@ -6053,46 +6052,6 @@
then
Set_Has_Delayed_Freeze (E);
end if;
-
- -- An interesting improvement here. If an object of composite
- -- type X is declared atomic, and the type X isn't, that's a
- -- pity, since it may not have appropriate alignment etc. We
- -- can rescue this in the special case where the object and
- -- type are in the same unit by just setting the type as
- -- atomic, so that the back end will process it as atomic.
-
- -- Note: we used to do this for elementary types as well,
- -- but that turns out to be a bad idea and can have unwanted
- -- effects, most notably if the type is elementary, the object
- -- a simple component within a record, and both are in a spec:
- -- every object of this type in the entire program will be
- -- treated as atomic, thus incurring a potentially costly
- -- synchronization operation for every access.
-
- -- For Volatile_Full_Access we can do this for elementary types
- -- too, since there is no issue of atomic synchronization.
-
- -- Of course it would be best if the back end could just adjust
- -- the alignment etc for the specific object, but that's not
- -- something we are capable of doing at this point.
-
- Utyp := Underlying_Type (Etype (E));
-
- if Present (Utyp)
- and then (Is_Composite_Type (Utyp)
- or else Prag_Id = Pragma_Volatile_Full_Access)
- and then Sloc (E) > No_Location
- and then Sloc (Utyp) > No_Location
- and then
- Get_Source_File_Index (Sloc (E)) =
- Get_Source_File_Index (Sloc (Utyp))
- then
- if Prag_Id = Pragma_Volatile_Full_Access then
- Set_Is_Volatile_Full_Access (Utyp);
- else
- Set_Is_Atomic (Utyp);
- end if;
- end if;
end if;
-- Atomic/Shared/Volatile_Full_Access imply Independent
===================================================================
@@ -1459,17 +1459,15 @@
-- Is_Atomic_VFA_Aggregate --
-----------------------------
- function Is_Atomic_VFA_Aggregate
- (E : Entity_Id;
- Typ : Entity_Id) return Boolean
- is
- Loc : constant Source_Ptr := Sloc (E);
+ function Is_Atomic_VFA_Aggregate (N : Node_Id) return Boolean is
+ Loc : constant Source_Ptr := Sloc (N);
New_N : Node_Id;
Par : Node_Id;
Temp : Entity_Id;
+ Typ : Entity_Id;
begin
- Par := Parent (E);
+ Par := Parent (N);
-- Array may be qualified, so find outer context
@@ -1477,24 +1475,45 @@
Par := Parent (Par);
end if;
- if Nkind_In (Par, N_Object_Declaration, N_Assignment_Statement)
- and then Comes_From_Source (Par)
- then
- Temp := Make_Temporary (Loc, 'T', E);
- New_N :=
- Make_Object_Declaration (Loc,
- Defining_Identifier => Temp,
- Object_Definition => New_Occurrence_Of (Typ, Loc),
- Expression => Relocate_Node (E));
- Insert_Before (Par, New_N);
- Analyze (New_N);
+ if not Comes_From_Source (Par) then
+ return False;
+ end if;
- Set_Expression (Par, New_Occurrence_Of (Temp, Loc));
- return True;
+ case Nkind (Par) is
+ when N_Assignment_Statement =>
+ Typ := Etype (Name (Par));
- else
- return False;
- end if;
+ if not Is_Atomic_Or_VFA (Typ)
+ and then not (Is_Entity_Name (Name (Par))
+ and then Is_Atomic_Or_VFA (Entity (Name (Par))))
+ then
+ return False;
+ end if;
+
+ when N_Object_Declaration =>
+ Typ := Etype (Defining_Identifier (Par));
+
+ if not Is_Atomic_Or_VFA (Typ)
+ and then not Is_Atomic_Or_VFA (Defining_Identifier (Par))
+ then
+ return False;
+ end if;
+
+ when others =>
+ return False;
+ end case;
+
+ Temp := Make_Temporary (Loc, 'T', N);
+ New_N :=
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Temp,
+ Object_Definition => New_Occurrence_Of (Typ, Loc),
+ Expression => Relocate_Node (N));
+ Insert_Before (Par, New_N);
+ Analyze (New_N);
+
+ Set_Expression (Par, New_Occurrence_Of (Temp, Loc));
+ return True;
end Is_Atomic_VFA_Aggregate;
-----------------------------------------------
@@ -4821,8 +4840,7 @@
and then Nkind (Parent (E)) = N_Object_Declaration
and then Present (Expression (Parent (E)))
and then Nkind (Expression (Parent (E))) = N_Aggregate
- and then
- Is_Atomic_VFA_Aggregate (Expression (Parent (E)), Etype (E))
+ and then Is_Atomic_VFA_Aggregate (Expression (Parent (E)))
then
null;
end if;
===================================================================
@@ -174,9 +174,7 @@
-- do not allow a size clause if the size would not otherwise be known at
-- compile time in any case.
- function Is_Atomic_VFA_Aggregate
- (E : Entity_Id;
- Typ : Entity_Id) return Boolean;
+ function Is_Atomic_VFA_Aggregate (N : Node_Id) return Boolean;
-- If an atomic/VFA object is initialized with an aggregate or is assigned
-- an aggregate, we have to prevent a piecemeal access or assignment to the
-- object, even if the aggregate is to be expanded. We create a temporary
===================================================================
@@ -5950,10 +5950,7 @@
-- temporary instead, so that the back end can generate an atomic move
-- for it.
- if Is_Atomic_Or_VFA (Typ)
- and then Comes_From_Source (Parent (N))
- and then Is_Atomic_VFA_Aggregate (N, Typ)
- then
+ if Is_Atomic_VFA_Aggregate (N) then
return;
-- No special management required for aggregates used to initialize