From cf9e38295f751336e2ce4bc08fe8bf9f7b3ae898 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Fri, 3 Jan 2020 15:31:08 +0100 Subject: [PATCH] [Ada] Avoid creating temporaries in Universal_Integer for range checks 2020-06-03 Eric Botcazou 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) : Call it. (Remove_Side_Effects): Remove the side effects of the prefix for an attribute reference whose prefix is not a name. --- gcc/ada/checks.adb | 34 ++++++++++++- gcc/ada/exp_util.adb | 115 ++++++++++++++++++++++--------------------- 2 files changed, 91 insertions(+), 58 deletions(-) diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 71c9564e131..a2fa7d099ce 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 0bccfcb21e3..5fd224be580 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 -- ---------------------------------- -- 2.30.2