[Ada] Avoid creating temporaries in Universal_Integer for range checks

2020-06-03  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

	* checks.adb (Is_Single_Attribute_Reference): New predicate.
	(Generate_Range_Check): Do not force the evaluation if the
	node is a single attribute reference.
	* exp_util.adb (Side_Effect_Free_Attribute): New predicate.
	(Side_Effect_Free) <N_Attribute_Reference>: Call it.
	(Remove_Side_Effects): Remove the side effects of the prefix
	for an attribute reference whose prefix is not a name.

2 files changed, 91 insertions, 58 deletions

diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index 71c9564..a2fa7d0 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -6875,6 +6875,10 @@ package body Checks is
       --  given Suppress argument. Then check the converted value against the
       --  range of the target subtype.
 
+      function Is_Single_Attribute_Reference (N : Node_Id) return Boolean;
+      --  Return True if N is an expression that contains a single attribute
+      --  reference, possibly as operand among only integer literal operands.
+
       -----------------------------
       -- Convert_And_Check_Range --
       -----------------------------
@@ -6934,6 +6938,31 @@ package body Checks is
          Set_Etype (N, Target_Base_Type);
       end Convert_And_Check_Range;
 
+      -------------------------------------
+      --  Is_Single_Attribute_Reference  --
+      -------------------------------------
+
+      function Is_Single_Attribute_Reference (N : Node_Id) return Boolean is
+      begin
+         if Nkind (N) = N_Attribute_Reference then
+            return True;
+
+         elsif Nkind (N) in N_Binary_Op then
+            if Nkind (Right_Opnd (N)) = N_Integer_Literal then
+               return Is_Single_Attribute_Reference (Left_Opnd (N));
+
+            elsif Nkind (Left_Opnd (N)) = N_Integer_Literal then
+               return Is_Single_Attribute_Reference (Right_Opnd (N));
+
+            else
+               return False;
+            end if;
+
+         else
+            return False;
+         end if;
+      end Is_Single_Attribute_Reference;
+
    --  Start of processing for Generate_Range_Check
 
    begin
@@ -6982,9 +7011,10 @@ package body Checks is
       --  We skip the evaluation of attribute references because, after these
       --  runtime checks are generated, the expander may need to rewrite this
       --  node (for example, see Attribute_Max_Size_In_Storage_Elements in
-      --  Expand_N_Attribute_Reference).
+      --  Expand_N_Attribute_Reference) and, in many cases, their return type
+      --  is universal integer, which is a very large type for a temporary.
 
-      if Nkind (N) /= N_Attribute_Reference
+      if not Is_Single_Attribute_Reference (N)
         and then (not Is_Entity_Name (N)
                    or else Treat_As_Volatile (Entity (N)))
       then
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 0bccfcb..5fd224b 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -224,6 +224,10 @@ package body Exp_Util is
    --  level, and False otherwise. Nested_Constructs is True when any nested
    --  packages declared in L must be processed, and False otherwise.
 
+   function Side_Effect_Free_Attribute (Name : Name_Id) return Boolean;
+   --  Return True if the evaluation of the given attribute is considered
+   --  side-effect free, independently of its prefix and expressions.
+
    -------------------------------------
    -- Activate_Atomic_Synchronization --
    -------------------------------------
@@ -11306,6 +11310,21 @@ package body Exp_Util is
 
       Scope_Suppress.Suppress := (others => True);
 
+      --  If this is a side-effect free attribute reference whose expressions
+      --  are also side-effect free and whose prefix is not a name, remove the
+      --  side effects of the prefix. A copy of the prefix is required in this
+      --  case and it is better not to make an additional one for the attribute
+      --  itself, because the return type of many of them is universal integer,
+      --  which is a very large type for a temporary.
+
+      if Nkind (Exp) = N_Attribute_Reference
+        and then Side_Effect_Free_Attribute (Attribute_Name (Exp))
+        and then Side_Effect_Free (Expressions (Exp), Name_Req, Variable_Ref)
+        and then not Is_Name_Reference (Prefix (Exp))
+      then
+         Remove_Side_Effects (Prefix (Exp), Name_Req, Variable_Ref);
+         goto Leave;
+
       --  If this is an elementary or a small not-by-reference record type, and
       --  we need to capture the value, just make a constant; this is cheap and
       --  objects of both kinds of types can be bit aligned, so it might not be
@@ -11316,12 +11335,12 @@ package body Exp_Util is
       --  anyway, see below). Also do it if we have a volatile reference and
       --  Name_Req is not set (see comments for Side_Effect_Free).
 
-      if (Is_Elementary_Type (Exp_Type)
-           or else (Is_Record_Type (Exp_Type)
-                     and then Known_Static_RM_Size (Exp_Type)
-                     and then RM_Size (Exp_Type) <= 64
-                     and then not Has_Discriminants (Exp_Type)
-                     and then not Is_By_Reference_Type (Exp_Type)))
+      elsif (Is_Elementary_Type (Exp_Type)
+              or else (Is_Record_Type (Exp_Type)
+                        and then Known_Static_RM_Size (Exp_Type)
+                        and then RM_Size (Exp_Type) <= 64
+                        and then not Has_Discriminants (Exp_Type)
+                        and then not Is_By_Reference_Type (Exp_Type)))
         and then (Variable_Ref
                    or else (not Is_Name_Reference (Exp)
                              and then Nkind (Exp) /= N_Type_Conversion)
@@ -13173,58 +13192,18 @@ package body Exp_Util is
 
       case Nkind (N) is
 
-         --  An attribute reference is side effect free if its expressions
-         --  are side effect free and its prefix is side effect free or
-         --  is an entity reference.
-
-         --  Is this right? what about x'first where x is a variable???
+         --  An attribute reference is side-effect free if its expressions
+         --  are side-effect free and its prefix is side-effect free or is
+         --  an entity reference.
 
          when N_Attribute_Reference =>
-            Attribute_Reference : declare
-
-               function Side_Effect_Free_Attribute
-                 (Attribute_Name : Name_Id) return Boolean;
-               --  Returns True if evaluation of the given attribute is
-               --  considered side-effect free (independent of prefix and
-               --  arguments).
-
-               --------------------------------
-               -- Side_Effect_Free_Attribute --
-               --------------------------------
-
-               function Side_Effect_Free_Attribute
-                 (Attribute_Name : Name_Id) return Boolean
-               is
-               begin
-                  case Attribute_Name is
-                     when Name_Input =>
-                        return False;
-
-                     when Name_Image
-                        | Name_Img
-                        | Name_Wide_Image
-                        | Name_Wide_Wide_Image
-                     =>
-                        --  CodePeer doesn't want to see replicated copies of
-                        --  'Image calls.
-
-                        return not CodePeer_Mode;
-
-                     when others =>
-                        return True;
-                  end case;
-               end Side_Effect_Free_Attribute;
-
-            --  Start of processing for Attribute_Reference
-
-            begin
-               return
-                 Side_Effect_Free (Expressions (N), Name_Req, Variable_Ref)
-                   and then Side_Effect_Free_Attribute (Attribute_Name (N))
-                   and then (Is_Entity_Name (Prefix (N))
-                              or else Side_Effect_Free
-                                        (Prefix (N), Name_Req, Variable_Ref));
-            end Attribute_Reference;
+            return Side_Effect_Free_Attribute (Attribute_Name (N))
+                     and then
+                   Side_Effect_Free (Expressions (N), Name_Req, Variable_Ref)
+                     and then
+                   (Is_Entity_Name (Prefix (N))
+                      or else
+                    Side_Effect_Free (Prefix (N), Name_Req, Variable_Ref));
 
          --  A binary operator is side effect free if and both operands are
          --  side effect free. For this purpose binary operators include
@@ -13383,6 +13362,30 @@ package body Exp_Util is
       end if;
    end Side_Effect_Free;
 
+   --------------------------------
+   -- Side_Effect_Free_Attribute --
+   --------------------------------
+
+   function Side_Effect_Free_Attribute (Name : Name_Id) return Boolean is
+   begin
+      case Name is
+         when Name_Input =>
+            return False;
+
+         when Name_Image
+            | Name_Img
+            | Name_Wide_Image
+            | Name_Wide_Wide_Image
+         =>
+            --  CodePeer doesn't want to see replicated copies of 'Image calls
+
+            return not CodePeer_Mode;
+
+         when others =>
+            return True;
+      end case;
+   end Side_Effect_Free_Attribute;
+
    ----------------------------------
    -- Silly_Boolean_Array_Not_Test --
    ----------------------------------