This is an internal optimization that reduces the number of cases
in which we generate N_Reference nodes. Generally has no effect
on functional behavior, but the following test:
1. function StrangeRef (A, B : Integer) return Integer is
2. X : Integer;
3. begin
4. X := Integer'Max ((if A > 4 then B else 15), B);
5. return X;
6. end StrangeRef;
compiled with -gnatG and -gnatd.u can be used to see that we do properly
optimize this case and avoid generating an N_Reference node which is what
we used to do:
Source recreated from tree for Strangeref (body)
function strangeref (a : integer; b : integer) return integer is
x : integer;
begin
R1b : constant integer := (if a > 4 then integer(b) else 15);
x := (if (R1b) >= b then (R1b) else integer(b));
return x;
end strangeref;
Previously R1b generated an N_Reference node
Tested on x86_64-pc-linux-gnu, committed on trunk
2014-02-18 Robert Dewar <de...@adacore.com>
* exp_attr.adb: Minor reformatting.
* exp_ch4.ads, exp_ch4.adb (Expand_N_Reference): New procedure.
* exp_util.adb (Remove_Side_Effects): Add conditional expressions
as another case where we don't generate N_Reference nodes for
primitive types.
* expander.adb (Expand): Add call to Expand_N_Reference.
Index: exp_util.adb
===================================================================
--- exp_util.adb (revision 207537)
+++ exp_util.adb (working copy)
@@ -6972,17 +6972,28 @@
Scope_Suppress.Suppress := (others => True);
-- If it is a scalar type and we need to capture the value, just make
- -- a copy. Likewise for a function call, an attribute reference, an
- -- allocator, or an operator. And if we have a volatile reference and
- -- Name_Req is not set (see comments above for Side_Effect_Free).
+ -- a copy. Likewise for a function call, an attribute reference, a
+ -- conditional expression, an allocator, or an operator. And if we have
+ -- a volatile reference and Name_Req is not set (see comments above for
+ -- Side_Effect_Free).
if Is_Elementary_Type (Exp_Type)
+
+ -- Note: this test is rather mysterious??? Why can't we just test ONLY
+ -- Is_Elementary_Type and be done with it. If we try that approach, we
+ -- get some failures (infinite recursions) from the Duplicate_Subexpr
+ -- call at the end of Checks.Apply_Predicate_Check. To be
+ -- investigated ???
+
and then (Variable_Ref
- or else Nkind_In (Exp, N_Function_Call,
- N_Attribute_Reference,
- N_Allocator)
+ or else Nkind_In (Exp, N_Attribute_Reference,
+ N_Allocator,
+ N_Case_Expression,
+ N_If_Expression,
+ N_Function_Call)
or else Nkind (Exp) in N_Op
- or else (not Name_Req and then Is_Volatile_Reference (Exp)))
+ or else (not Name_Req
+ and then Is_Volatile_Reference (Exp)))
then
Def_Id := Make_Temporary (Loc, 'R', Exp);
Set_Etype (Def_Id, Exp_Type);
@@ -7230,6 +7241,7 @@
E := Exp;
if Nkind (E) = N_Explicit_Dereference then
New_Exp := Relocate_Node (Prefix (E));
+
else
E := Relocate_Node (E);
Index: exp_attr.adb
===================================================================
--- exp_attr.adb (revision 207559)
+++ exp_attr.adb (working copy)
@@ -1132,20 +1132,20 @@
-- copies from being created when the unchecked conversion
-- is expanded (which would happen in Remove_Side_Effects
-- if Expand_N_Unchecked_Conversion were allowed to call
- -- Force_Evaluation). The copy could violate Ada semantics
- -- in cases such as an actual that is an out parameter.
- -- Note that this approach is also used in exp_ch7 for calls
- -- to controlled type operations to prevent problems with
- -- actuals wrapped in unchecked conversions.
+ -- Force_Evaluation). The copy could violate Ada semantics in
+ -- cases such as an actual that is an out parameter. Note that
+ -- this approach is also used in exp_ch7 for calls to controlled
+ -- type operations to prevent problems with actuals wrapped in
+ -- unchecked conversions.
if Is_Untagged_Derivation (Etype (Expression (Item))) then
Set_Assignment_OK (Item);
end if;
end if;
- -- The stream operation to call maybe a renaming created by
- -- an attribute definition clause, and may not be frozen yet.
- -- Ensure that it has the necessary extra formals.
+ -- The stream operation to call may be a renaming created by an
+ -- attribute definition clause, and may not be frozen yet. Ensure
+ -- that it has the necessary extra formals.
if not Is_Frozen (Pname) then
Create_Extra_Formals (Pname);
Index: expander.adb
===================================================================
--- expander.adb (revision 207533)
+++ expander.adb (working copy)
@@ -411,6 +411,9 @@
when N_Record_Representation_Clause =>
Expand_N_Record_Representation_Clause (N);
+ when N_Reference =>
+ Expand_N_Reference (N);
+
when N_Requeue_Statement =>
Expand_N_Requeue_Statement (N);
Index: exp_ch4.adb
===================================================================
--- exp_ch4.adb (revision 207546)
+++ exp_ch4.adb (working copy)
@@ -9225,6 +9225,65 @@
Analyze_And_Resolve (N, Standard_Boolean);
end Expand_N_Quantified_Expression;
+ ------------------------
+ -- Expand_N_Reference --
+ ------------------------
+
+ -- It is a little unclear why we generate references to expression values,
+ -- but we definitely do! At the very least in Modify_Tree_For_C, we need to
+ -- get rid of such constructs. We do this by expanding:
+
+ -- expression'Reference
+
+ -- into
+
+ -- Tnn : constant typ := expression;
+ -- ...
+ -- Tnn'Reference
+
+ procedure Expand_N_Reference (N : Node_Id) is
+ begin
+ -- No problem if Modify_Tree_For_C not set, the existing back ends will
+ -- correctly handle P'Reference where P is a general expression.
+
+ if not Modify_Tree_For_C then
+ return;
+
+ -- No problem if we have an entity name since we can take its address
+
+ elsif Is_Entity_Name (Prefix (N)) then
+ return;
+
+ -- Can't go copying limited types
+
+ elsif Is_Limited_Record (Etype (Prefix (N)))
+ or else Is_Limited_Composite (Etype (Prefix (N)))
+ then
+ return;
+
+ -- Here is the case where we do the transformation discussed above
+
+ else
+ declare
+ Loc : constant Source_Ptr := Sloc (N);
+ Expr : constant Node_Id := Prefix (N);
+ Typ : constant Entity_Id := Etype (N);
+ Tnn : constant Entity_Id := Make_Temporary (Loc, 'T', Expr);
+ begin
+ Insert_Action (N,
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Tnn,
+ Constant_Present => True,
+ Object_Definition => New_Occurrence_Of (Etype (Expr), Loc),
+ Expression => Expr));
+ Rewrite (N,
+ Make_Reference (Loc,
+ Prefix => New_Occurrence_Of (Tnn, Loc)));
+ Analyze_And_Resolve (N, Typ);
+ end;
+ end if;
+ end Expand_N_Reference;
+
---------------------------------
-- Expand_N_Selected_Component --
---------------------------------
Index: exp_ch4.ads
===================================================================
--- exp_ch4.ads (revision 207533)
+++ exp_ch4.ads (working copy)
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -68,6 +68,7 @@
procedure Expand_N_Or_Else (N : Node_Id);
procedure Expand_N_Qualified_Expression (N : Node_Id);
procedure Expand_N_Quantified_Expression (N : Node_Id);
+ procedure Expand_N_Reference (N : Node_Id);
procedure Expand_N_Selected_Component (N : Node_Id);
procedure Expand_N_Slice (N : Node_Id);
procedure Expand_N_Type_Conversion (N : Node_Id);
