===================================================================
@@ -4238,10 +4238,10 @@
-- When a function call appears in Object.Operation format, the
-- original representation has two possible forms depending on the
-- availability of actual parameters:
- --
- -- Obj.Func_Call -- N_Selected_Component
- -- Obj.Func_Call (Param) -- N_Indexed_Component
+ -- Obj.Func_Call N_Selected_Component
+ -- Obj.Func_Call (Param) N_Indexed_Component
+
else
if Nkind (Expr) = N_Indexed_Component then
Expr := Prefix (Expr);
@@ -5295,18 +5295,34 @@
function Is_Volatile_Reference (N : Node_Id) return Boolean is
begin
- if Nkind (N) in N_Has_Etype
- and then Present (Etype (N))
- and then Treat_As_Volatile (Etype (N))
- then
+ -- Only source references are to be treated as volatile, internally
+ -- generated stuff cannot have volatile external effects.
+
+ if not Comes_From_Source (N) then
+ return False;
+
+ -- Never true for reference to a type
+
+ elsif Is_Entity_Name (N) and then Is_Type (Entity (N)) then
+ return False;
+
+ -- True if object reference with volatile type
+
+ elsif Is_Volatile_Object (N) then
return True;
+ -- True if reference to volatile entity
+
elsif Is_Entity_Name (N) then
return Treat_As_Volatile (Entity (N));
+ -- True for slice of volatile array
+
elsif Nkind (N) = N_Slice then
return Is_Volatile_Reference (Prefix (N));
+ -- True if volatile component
+
elsif Nkind_In (N, N_Indexed_Component, N_Selected_Component) then
if (Is_Entity_Name (Prefix (N))
and then Has_Volatile_Components (Entity (Prefix (N))))
@@ -5318,6 +5334,8 @@
return Is_Volatile_Reference (Prefix (N));
end if;
+ -- Otherwise false
+
else
return False;
end if;
@@ -6844,9 +6862,7 @@
-- (this happens because routines Duplicate_Subexpr_XX implicitly invoke
-- Remove_Side_Effects).
- if No (Exp_Type)
- or else Ekind (Exp_Type) = E_Access_Attribute_Type
- then
+ if No (Exp_Type) or else Ekind (Exp_Type) = E_Access_Attribute_Type then
return;
-- No action needed for side-effect free expressions
@@ -6913,9 +6929,12 @@
Insert_Action (Exp, E);
-- If the expression has the form v.all then we can just capture the
- -- pointer, and then do an explicit dereference on the result.
+ -- pointer, and then do an explicit dereference on the result, but
+ -- this is not right if this is a volatile reference.
- elsif Nkind (Exp) = N_Explicit_Dereference then
+ elsif Nkind (Exp) = N_Explicit_Dereference
+ and then not Is_Volatile_Reference (Exp)
+ then
Def_Id := Make_Temporary (Loc, 'R', Exp);
Res :=
Make_Explicit_Dereference (Loc, New_Occurrence_Of (Def_Id, Loc));
@@ -6987,17 +7006,21 @@
-- This is needed for correctness in the case of a volatile object of
-- a non-volatile type because the Make_Reference call of the "default"
-- approach would generate an illegal access value (an access value
- -- cannot designate such an object - see Analyze_Reference). We skip
- -- using this scheme if we have an object of a volatile type and we do
- -- not have Name_Req set true (see comments for Side_Effect_Free).
+ -- cannot designate such an object - see Analyze_Reference).
- -- In Ada 2012 a qualified expression is an object, but for purposes of
- -- removing side effects it still need to be transformed into a separate
- -- declaration, particularly if the expression is an aggregate.
-
elsif Is_Object_Reference (Exp)
and then Nkind (Exp) /= N_Function_Call
+
+ -- In Ada 2012 a qualified expression is an object, but for purposes
+ -- of removing side effects it still need to be transformed into a
+ -- separate declaration, particularly in the case of an aggregate.
+
and then Nkind (Exp) /= N_Qualified_Expression
+
+ -- We skip using this scheme if we have an object of a volatile
+ -- type and we do not have Name_Req set true (see comments for
+ -- Side_Effect_Free).
+
and then (Name_Req or else not Treat_As_Volatile (Exp_Type))
then
Def_Id := Make_Temporary (Loc, 'R', Exp);
@@ -8030,6 +8053,12 @@
-- Start of processing for Side_Effect_Free
begin
+ -- If volatile reference, always consider it to have side effects
+
+ if Is_Volatile_Reference (N) then
+ return False;
+ end if;
+
-- Note on checks that could raise Constraint_Error. Strictly, if we
-- take advantage of 11.6, these checks do not count as side effects.
-- However, we would prefer to consider that they are side effects,
@@ -8043,12 +8072,17 @@
if Is_Entity_Name (N) then
+ -- A type reference is always side effect free
+
+ if Is_Type (Entity (N)) then
+ return True;
+
-- Variables are considered to be a side effect if Variable_Ref
-- is set or if we have a volatile reference and Name_Req is off.
-- If Name_Req is True then we can't help returning a name which
-- effectively allows multiple references in any case.
- if Is_Variable (N, Use_Original_Node => False) then
+ elsif Is_Variable (N, Use_Original_Node => False) then
return not Variable_Ref
and then (not Is_Volatile_Reference (N) or else Name_Req);
===================================================================
@@ -3627,6 +3627,16 @@
-- references a subprogram that is a renaming, then the front end must
-- rewrite the attribute to refer directly to the renamed entity.
+ -- Note: syntactically the prefix of an attribute reference must be a
+ -- name, and this (somewhat artificial) requirement is enforced by the
+ -- parser. However, for many attributes, such as 'Valid, it is quite
+ -- reasonable to apply the attribute to any value, and hence to any
+ -- expression. Internally in the tree, the prefix is an expression which
+ -- does not have to be a name, and this is handled fine by the semantic
+ -- analysis and expansion, and back ends. This arises for the case of
+ -- attribute references built by the expander (e.g. 'Valid for the case
+ -- of an implicit validity check).
+
-- Note: In generated code, the Address and Unrestricted_Access
-- attributes can be applied to any expression, and the meaning is
-- to create an object containing the value (the object is in the
@@ -3638,7 +3648,7 @@
-- N_Attribute_Reference
-- Sloc points to apostrophe
- -- Prefix (Node3)
+ -- Prefix (Node3) (general expression, see note above)
-- Attribute_Name (Name2) identifier name from attribute designator
-- Expressions (List1) (set to No_List if no associated expressions)
-- Entity (Node4-Sem) used if the attribute yields a type
===================================================================
@@ -6478,15 +6478,24 @@
-- Force evaluation to avoid multiple reads for atomic/volatile
+ -- Note: we set Name_Req to False. We used to set it to True, with
+ -- the thinking that a name is required as the prefix of the 'Valid
+ -- call, but in fact the check that the prefix of an attribute is
+ -- a name is in the parser, and we just don't require it here.
+ -- Moreover, when we set Name_Req to True, that interfered with the
+ -- checking for Volatile, since we couldn't just capture the value.
+
if Is_Entity_Name (Exp)
and then Is_Volatile (Entity (Exp))
then
- Force_Evaluation (Exp, Name_Req => True);
+ -- Same reasoning as above for setting Name_Req to False
+
+ Force_Evaluation (Exp, Name_Req => False);
end if;
-- Build the prefix for the 'Valid call
- PV := Duplicate_Subexpr_No_Checks (Exp, Name_Req => True);
+ PV := Duplicate_Subexpr_No_Checks (Exp, Name_Req => False);
-- A rather specialized kludge. If PV is an analyzed expression
-- which is an indexed component of a packed array that has not
@@ -6504,7 +6513,9 @@
Set_Analyzed (PV, False);
end if;
- -- Build the raise CE node to check for validity
+ -- Build the raise CE node to check for validity. We build a type
+ -- qualification for the prefix, since it may not be of the form of
+ -- a name, and we don't care in this context!
CE :=
Make_Raise_Constraint_Error (Loc,
This corrects a situation in which extra reads of volatile objects was being done. It was detected in the case of validity checks being done on case expressions that were volatile, where two reads were being done, one for the validity check, and one for the actual case selection. But the problem is more general and potentially applies to any situation in which side effects must be executed only once. Consider this example: 1. procedure VolCase (X : Natural) is 2. Y : Natural; 3. pragma Volatile (Y); 4. 5. type R is new Natural; 6. pragma Volatile (R); 7. type APtr is access all R; 8. ARV : APtr := new R'(R(X)); 9. AR : R; 10. 11. begin 12. Y := X; 13. case Y is 14. when 0 => return; 15. when 1 .. Natural'Last => null; 16. end case; 17. 18. case ARV.all is 19. when 0 => return; 20. when 1 .. R'Last => null; 21. end case; 22. 23. AR := ARV.all ** 4; 24. end; The first case at line 13 was handled OK, but the second one at line 18 caused two reads, and additionally the exponentiation at line 23 did multiple reads. Now with this fix, we get the following -gnatG output from this example: Source recreated from tree for Volcase (body) with interfaces; procedure volcase (x : natural) is y : natural; pragma volatile (y); [type volcase__TrB is new integer] freeze volcase__TrB [] type volcase__r is new natural; pragma volatile (volcase__r); type volcase__aptr is access all volcase__r; arv : volcase__aptr := new volcase__r'(volcase__r(x)); ar : volcase__r; begin y := x; R3b : constant natural := y; [constraint_error when not (interfaces__unsigned_32!(R3b) <= 16#7FFF_FFFF#) "invalid data"] if R3b = 0 then return; else null; end if; R5b : constant volcase__r := arv.all; [constraint_error when not (interfaces__unsigned_32!(R5b) <= 16#7FFF_FFFF#) "invalid data"] if R5b = 0 then return; else null; end if; R7b : constant volcase__r := arv.all; R8b : constant volcase__TrB := do E6b : constant volcase__TrB := R7b * R7b; in E6b * E6b end ; [constraint_error when not (R8b >= 0) "range check failed"] ar := R8b; return; end volcase; And as can be seen from the expanded code, there is only one read of the volatile variable in each of the three cases. Tested on x86_64-pc-linux-gnu, committed on trunk 2014-07-17 Robert Dewar <dewar@adacore.com> * checks.adb (Insert_Valid_Check): Don't insist on a name for the prefix when we make calls to Force_Evaluation and Duplicate_Subexpr_No_Checks. * exp_util.adb (Is_Volatile_Reference): Handle all cases properly (Remove_Side_Effects): Handle all volatile references right (Side_Effect_Free): Volatile reference is never side effect free * sinfo.ads (N_Attribute_Reference): Add comments explaining that in the tree, the prefix can be a general expression.