From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from rock.gnat.com (rock.gnat.com [IPv6:2620:20:4000:0:a9e:1ff:fe9b:1d1]) by sourceware.org (Postfix) with ESMTP id 6BC563984060 for ; Thu, 29 Apr 2021 08:03:56 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org 6BC563984060 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=derodat@adacore.com Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 61DA4561B9; Thu, 29 Apr 2021 04:03:48 -0400 (EDT) X-Virus-Scanned: Debian amavisd-new at gnat.com Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id pThDVRyaPMTZ; Thu, 29 Apr 2021 04:03:48 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [205.232.38.10]) by rock.gnat.com (Postfix) with ESMTP id 42F59561C0; Thu, 29 Apr 2021 04:03:48 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4862) id 3DAE8193; Thu, 29 Apr 2021 04:03:48 -0400 (EDT) Date: Thu, 29 Apr 2021 04:03:48 -0400 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [Ada] Eliminate useless 128-bit overflow check for conversion Message-ID: <20210429080348.GA134101@adacore.com> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="4Ckj6UjgE2iN1+kY" Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) X-Spam-Status: No, score=-12.0 required=5.0 tests=BAYES_00, GIT_PATCH_0, KAM_ASCII_DIVIDERS, KAM_DMARC_STATUS, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.2 X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-List-Received-Date: Thu, 29 Apr 2021 08:03:59 -0000 --4Ckj6UjgE2iN1+kY Content-Type: text/plain; charset=us-ascii Content-Disposition: inline This gets rid of overflow checks done using a 128-bit integer type on 64-bit platforms and that can be done in a narrower type, by reusing the machinery already implemented to narrow the type of operations. This runs afoul of the processing for Max_Size_In_Storage_Elements in Expand_N_Attribute_Reference, which attempts to second guess the expansion of checks done in universal integer contexts, so this code is simply removed, as it does not seem to serve any real purpose. Tested on x86_64-pc-linux-gnu, committed on trunk gcc/ada/ * exp_attr.adb (Expand_N_Attribute_Reference) : Apply the checks for universal integer contexts only in the default case. * exp_ch4.adb (Get_Size_For_Range): Move to library level. (Expand_N_Type_Conversion): If the operand has Universal_Integer type and the conversion requires an overflow check, try to do an intermediate conversion to a narrower type. --4Ckj6UjgE2iN1+kY Content-Type: text/x-diff; charset=us-ascii Content-Disposition: attachment; filename="patch.diff" diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -4598,13 +4598,7 @@ package body Exp_Attr is ---------------------------------- when Attribute_Max_Size_In_Storage_Elements => declare - Typ : constant Entity_Id := Etype (N); - Attr : Node_Id; - Atyp : Entity_Id; - - Conversion_Added : Boolean := False; - -- A flag which tracks whether the original attribute has been - -- wrapped inside a type conversion. + Typ : constant Entity_Id := Etype (N); begin -- If the prefix is X'Class, we transform it into a direct reference @@ -4618,40 +4612,22 @@ package body Exp_Attr is return; end if; - Apply_Universal_Integer_Attribute_Checks (N); - - -- The universal integer check may sometimes add a type conversion, - -- retrieve the original attribute reference from the expression. - - Attr := N; - - if Nkind (Attr) = N_Type_Conversion then - Attr := Expression (Attr); - Conversion_Added := True; - end if; - - pragma Assert (Nkind (Attr) = N_Attribute_Reference); - -- Heap-allocated controlled objects contain two extra pointers which -- are not part of the actual type. Transform the attribute reference -- into a runtime expression to add the size of the hidden header. - if Needs_Finalization (Ptyp) - and then not Header_Size_Added (Attr) - then - Set_Header_Size_Added (Attr); - - Atyp := Etype (Attr); + if Needs_Finalization (Ptyp) and then not Header_Size_Added (N) then + Set_Header_Size_Added (N); -- Generate: -- P'Max_Size_In_Storage_Elements + - -- Atyp (Header_Size_With_Padding (Ptyp'Alignment)) + -- Typ (Header_Size_With_Padding (Ptyp'Alignment)) - Rewrite (Attr, + Rewrite (N, Make_Op_Add (Loc, - Left_Opnd => Relocate_Node (Attr), + Left_Opnd => Relocate_Node (N), Right_Opnd => - Convert_To (Atyp, + Convert_To (Typ, Make_Function_Call (Loc, Name => New_Occurrence_Of @@ -4663,16 +4639,13 @@ package body Exp_Attr is New_Occurrence_Of (Ptyp, Loc), Attribute_Name => Name_Alignment)))))); - Analyze_And_Resolve (Attr, Atyp); - - -- Add a conversion to the target type - - if not Conversion_Added then - Convert_To_And_Rewrite (Typ, Attr); - end if; - + Analyze_And_Resolve (N, Typ); return; end if; + + -- In the other cases apply the required checks + + Apply_Universal_Integer_Attribute_Checks (N); end; -------------------- diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -172,6 +172,10 @@ package body Exp_Ch4 is -- routine is to find the real type by looking up the tree. We also -- determine if the operation must be rounded. + function Get_Size_For_Range (Lo, Hi : Uint) return Uint; + -- Return the size of a small signed integer type covering Lo .. Hi, the + -- main goal being to return a size lower than that of standard types. + function Has_Inferable_Discriminants (N : Node_Id) return Boolean; -- Ada 2005 (AI-216): A view of an Unchecked_Union object has inferable -- discriminants if it has a constrained nominal type, unless the object @@ -12270,6 +12274,41 @@ package body Exp_Ch4 is end; end if; + -- If the conversion is from Universal_Integer and requires an overflow + -- check, try to do an intermediate conversion to a narrower type first + -- without overflow check, in order to avoid doing the overflow check + -- in Universal_Integer, which can be a very large type. + + if Operand_Type = Universal_Integer and then Do_Overflow_Check (N) then + declare + Lo, Hi, Siz : Uint; + OK : Boolean; + Typ : Entity_Id; + + begin + Determine_Range (Operand, OK, Lo, Hi, Assume_Valid => True); + + if OK then + Siz := Get_Size_For_Range (Lo, Hi); + + -- We use the base type instead of the first subtype because + -- overflow checks are done in the base type, so this avoids + -- the need for useless conversions. + + if Siz < System_Max_Integer_Size then + Typ := Etype (Integer_Type_For (Siz, Uns => False)); + + Convert_To_And_Rewrite (Typ, Operand); + Analyze_And_Resolve + (Operand, Typ, Suppress => Overflow_Check); + + Analyze_And_Resolve (N, Target_Type); + goto Done; + end if; + end if; + end; + end if; + -- Do validity check if validity checking operands if Validity_Checks_On and Validity_Check_Operands then @@ -13328,6 +13367,54 @@ package body Exp_Ch4 is end if; end Fixup_Universal_Fixed_Operation; + ------------------------ + -- Get_Size_For_Range -- + ------------------------ + + function Get_Size_For_Range (Lo, Hi : Uint) return Uint is + + function Is_OK_For_Range (Siz : Uint) return Boolean; + -- Return True if a signed integer with given size can cover Lo .. Hi + + -------------------------- + -- Is_OK_For_Range -- + -------------------------- + + function Is_OK_For_Range (Siz : Uint) return Boolean is + B : constant Uint := Uint_2 ** (Siz - 1); + + begin + -- Test B = 2 ** (size - 1) (can accommodate -B .. +(B - 1)) + + return Lo >= -B and then Hi >= -B and then Lo < B and then Hi < B; + end Is_OK_For_Range; + + begin + -- This is (almost always) the size of Integer + + if Is_OK_For_Range (Uint_32) then + return Uint_32; + + -- Check 63 + + elsif Is_OK_For_Range (Uint_63) then + return Uint_63; + + -- This is (almost always) the size of Long_Long_Integer + + elsif Is_OK_For_Range (Uint_64) then + return Uint_64; + + -- Check 127 + + elsif Is_OK_For_Range (Uint_127) then + return Uint_127; + + else + return Uint_128; + end if; + end Get_Size_For_Range; + --------------------------------- -- Has_Inferable_Discriminants -- --------------------------------- @@ -14135,58 +14222,6 @@ package body Exp_Ch4 is Typ : constant Entity_Id := Etype (R); Tsiz : constant Uint := RM_Size (Typ); - function Get_Size_For_Range (Lo, Hi : Uint) return Uint; - -- Return the size of a small signed integer type covering Lo .. Hi. - -- The important thing is to return a size lower than that of Typ. - - ------------------------ - -- Get_Size_For_Range -- - ------------------------ - - function Get_Size_For_Range (Lo, Hi : Uint) return Uint is - - function Is_OK_For_Range (Siz : Uint) return Boolean; - -- Return True if a signed integer with given size can cover Lo .. Hi - - -------------------------- - -- Is_OK_For_Range -- - -------------------------- - - function Is_OK_For_Range (Siz : Uint) return Boolean is - B : constant Uint := Uint_2 ** (Siz - 1); - - begin - -- Test B = 2 ** (size - 1) (can accommodate -B .. +(B - 1)) - - return Lo >= -B and then Hi >= -B and then Lo < B and then Hi < B; - end Is_OK_For_Range; - - begin - -- This is (almost always) the size of Integer - - if Is_OK_For_Range (Uint_32) then - return Uint_32; - - -- If the size of Typ is 64 then check 63 - - elsif Tsiz = Uint_64 and then Is_OK_For_Range (Uint_63) then - return Uint_63; - - -- This is (almost always) the size of Long_Long_Integer - - elsif Is_OK_For_Range (Uint_64) then - return Uint_64; - - -- If the size of Typ is 128 then check 127 - - elsif Tsiz = Uint_128 and then Is_OK_For_Range (Uint_127) then - return Uint_127; - - else - return Uint_128; - end if; - end Get_Size_For_Range; - -- Local variables L : Node_Id; --4Ckj6UjgE2iN1+kY--