From patchwork Thu Sep 19 13:28:19 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Pierre-Marie de Rodat X-Patchwork-Id: 1164615 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-509277-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=adacore.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="VNwzRR9K"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 46YyPs2jFKz9s4Y for ; Thu, 19 Sep 2019 23:29:53 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; q=dns; s=default; b=DWOdFErjZhs8hQuC9+g88N6uY2/uXE+pJtYMfsb0LQVwCyw3MW zsnXSWFgr8oh0ng2KRc3JV6zEJzJ+gOZeY6DEKqHg8n1z4ghTHLoazD6zIEuwReE Yvnsz+JYxliObm55IQtk0Q+tS9KJg2+6Upnn8fcnkua/zdRd9EKsT5/PY= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; s= default; bh=fhVsL03DbJkvBS7dVguGumOQ6gM=; b=VNwzRR9Kmw0YGxAASufm RjF7R9UVPucwAAg3je460Hqz8Ur70WWpQruW/BVC6rGVxB26Iw74XgakWcOPQE7Y NTaSFRU1xA1PYmNjWEUkOVKRm7ulrrRSDUwWpsQghB7bamMFSFZ/wsyFCSR2UsOZ +Y5vlZd8px5OENLvinsBdVw= Received: (qmail 1610 invoked by alias); 19 Sep 2019 13:28:27 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 1448 invoked by uid 89); 19 Sep 2019 13:28:26 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-11.9 required=5.0 tests=BAYES_00, GIT_PATCH_2, GIT_PATCH_3, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.1 spammy=Expr_Value, expr_value, sk:Expand_, formals X-HELO: rock.gnat.com Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Thu, 19 Sep 2019 13:28:24 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 7A5E056022; Thu, 19 Sep 2019 09:28:19 -0400 (EDT) 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 8p6JG7XYQb6T; Thu, 19 Sep 2019 09:28:19 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [IPv6:2620:20:4000:0:46a8:42ff:fe0e:e294]) by rock.gnat.com (Postfix) with ESMTP id 671EB5601D; Thu, 19 Sep 2019 09:28:19 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4862) id 6610E6B4; Thu, 19 Sep 2019 09:28:19 -0400 (EDT) Date: Thu, 19 Sep 2019 09:28:19 -0400 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [Ada] Streamline comparison for equality of 2-element arrays Message-ID: <20190919132819.GA41756@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) X-IsSubscribed: yes In the general case, the comparison for equality of array objects is implemented by a local function that contains, among other things, a loop running over the elements, comparing them one by one and exiting as soon as an element is not the same in the two array objects. For the specific case of constrained 2-element arrays, this is rather heavy and unnecessarily obfuscates the control flow of the program, so this change implements a simple conjunction of comparisons for it. Running these commands: gcc -c p.ads -O -gnatD grep loop p.ads.dg On the following sources: package P is type Rec is record Re : Float; Im : Float; end record; type Arr is array (1 .. 2) of Rec; function Equal (A, B : Arr) return Boolean is (A = B); end P; Should execute silently. Tested on x86_64-pc-linux-gnu, committed on trunk 2019-09-19 Eric Botcazou gcc/ada/ * exp_ch4.adb (Expand_Array_Equality): If optimization is enabled, generate a simple conjunction of comparisons for the specific case of constrained 1-dimensional 2-element arrays. Fix formatting. --- gcc/ada/exp_ch4.adb +++ gcc/ada/exp_ch4.adb @@ -1582,7 +1582,7 @@ package body Exp_Ch4 is Index_List1 : constant List_Id := New_List; Index_List2 : constant List_Id := New_List; - Actuals : List_Id; + First_Idx : Node_Id; Formals : List_Id; Func_Name : Entity_Id; Func_Body : Node_Id; @@ -1594,6 +1594,10 @@ package body Exp_Ch4 is Rtyp : Entity_Id; -- The parameter types to be used for the formals + New_Lhs : Node_Id; + New_Rhs : Node_Id; + -- The LHS and RHS converted to the parameter types + function Arr_Attr (Arr : Entity_Id; Nam : Name_Id; @@ -1962,6 +1966,82 @@ package body Exp_Ch4 is pragma Assert (Ltyp = Rtyp); end if; + -- If the array type is distinct from the type of the arguments, it + -- is the full view of a private type. Apply an unchecked conversion + -- to ensure that analysis of the code below succeeds. + + if No (Etype (Lhs)) + or else Base_Type (Etype (Lhs)) /= Base_Type (Ltyp) + then + New_Lhs := OK_Convert_To (Ltyp, Lhs); + else + New_Lhs := Lhs; + end if; + + if No (Etype (Rhs)) + or else Base_Type (Etype (Rhs)) /= Base_Type (Rtyp) + then + New_Rhs := OK_Convert_To (Rtyp, Rhs); + else + New_Rhs := Rhs; + end if; + + First_Idx := First_Index (Ltyp); + + -- If optimization is enabled and the array boils down to a couple of + -- consecutive elements, generate a simple conjunction of comparisons + -- which should be easier to optimize by the code generator. + + if Optimization_Level > 0 + and then Ltyp = Rtyp + and then Is_Constrained (Ltyp) + and then Number_Dimensions (Ltyp) = 1 + and then Nkind (First_Idx) = N_Range + and then Compile_Time_Known_Value (Low_Bound (First_Idx)) + and then Compile_Time_Known_Value (High_Bound (First_Idx)) + and then Expr_Value (High_Bound (First_Idx)) = + Expr_Value (Low_Bound (First_Idx)) + 1 + then + declare + Ctyp : constant Entity_Id := Component_Type (Ltyp); + L, R : Node_Id; + TestL, TestH : Node_Id; + Index_List : List_Id; + + begin + Index_List := New_List (New_Copy_Tree (Low_Bound (First_Idx))); + + L := + Make_Indexed_Component (Loc, + Prefix => New_Copy_Tree (New_Lhs), + Expressions => Index_List); + + R := + Make_Indexed_Component (Loc, + Prefix => New_Copy_Tree (New_Rhs), + Expressions => Index_List); + + TestL := Expand_Composite_Equality (Nod, Ctyp, L, R, Bodies); + + Index_List := New_List (New_Copy_Tree (High_Bound (First_Idx))); + + L := + Make_Indexed_Component (Loc, + Prefix => New_Lhs, + Expressions => Index_List); + + R := + Make_Indexed_Component (Loc, + Prefix => New_Rhs, + Expressions => Index_List); + + TestH := Expand_Composite_Equality (Nod, Ctyp, L, R, Bodies); + + return + Make_And_Then (Loc, Left_Opnd => TestL, Right_Opnd => TestH); + end; + end if; + -- Build list of formals for function Formals := New_List ( @@ -2004,46 +2084,20 @@ package body Exp_Ch4 is Make_Simple_Return_Statement (Loc, Expression => New_Occurrence_Of (Standard_False, Loc)))), - Handle_One_Dimension (1, First_Index (Ltyp)), + Handle_One_Dimension (1, First_Idx), Make_Simple_Return_Statement (Loc, Expression => New_Occurrence_Of (Standard_True, Loc))))); - Set_Has_Completion (Func_Name, True); - Set_Is_Inlined (Func_Name); - - -- If the array type is distinct from the type of the arguments, it - -- is the full view of a private type. Apply an unchecked conversion - -- to ensure that analysis of the call succeeds. - - declare - L, R : Node_Id; - - begin - L := Lhs; - R := Rhs; - - if No (Etype (Lhs)) - or else Base_Type (Etype (Lhs)) /= Base_Type (Ltyp) - then - L := OK_Convert_To (Ltyp, Lhs); - end if; - - if No (Etype (Rhs)) - or else Base_Type (Etype (Rhs)) /= Base_Type (Rtyp) - then - R := OK_Convert_To (Rtyp, Rhs); - end if; - - Actuals := New_List (L, R); - end; + Set_Has_Completion (Func_Name, True); + Set_Is_Inlined (Func_Name); - Append_To (Bodies, Func_Body); + Append_To (Bodies, Func_Body); - return - Make_Function_Call (Loc, - Name => New_Occurrence_Of (Func_Name, Loc), - Parameter_Associations => Actuals); + return + Make_Function_Call (Loc, + Name => New_Occurrence_Of (Func_Name, Loc), + Parameter_Associations => New_List (New_Lhs, New_Rhs)); end Expand_Array_Equality; -----------------------------