From patchwork Thu Jun 16 10:23:12 2016 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 636333 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org 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 3rVfc42QX2z9t0d for ; Thu, 16 Jun 2016 20:23:32 +1000 (AEST) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b=Kk0LIgPu; dkim-atps=neutral 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=nKGAQuYu2CjOiQWXfuDHA+aZhne1n8iBPqD+V5OifxsIRtqYHL 3M8AWHwyzQW/A1pVcpG0KfL/vct94zsjQexU/JK3Ff5mUb9qNI3R7Jnl2/XUCKXS /QRUwXNdVipV1MBsBA2t5AWX3KTkiC4rO47vi8KsqnFOnlvbeiaNygP2E= 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=7/3A+V920JgzX4eQ4h27yUm0IGE=; b=Kk0LIgPuNAYbrjCBQawh +Bz9WpIICqJuFiydpjy4jfuZFDkmqhNdqWRVo9Dfy9KvMwn34XfzgK8MLFNl/pS9 bwnZpw61Vm4ndKY3ObJ9ds0s8w+OUlDsvVEq7hDybEN0C1PRf13bF1I16mgSxc9O 90mj81FzbOIgUlZUabOlJDw= Received: (qmail 104184 invoked by alias); 16 Jun 2016 10:23:25 -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 104164 invoked by uid 89); 16 Jun 2016 10:23:24 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=1.7 required=5.0 tests=AWL, BAYES_50, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=no version=3.3.2 spammy=D*adacore.com, set_etype, Set_Etype, 237429 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 (AES256-SHA encrypted) ESMTPS; Thu, 16 Jun 2016 10:23:14 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id F0DF9116BD0; Thu, 16 Jun 2016 06:23:12 -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 npyowE3IWRcq; Thu, 16 Jun 2016 06:23:12 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [205.232.38.10]) by rock.gnat.com (Postfix) with ESMTP id E049B1169B6; Thu, 16 Jun 2016 06:23:12 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4192) id DABFC497; Thu, 16 Jun 2016 06:23:12 -0400 (EDT) Date: Thu, 16 Jun 2016 06:23:12 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Justin Squirek Subject: [Ada] Avoid anonymous array object for aggregates with qualified expressions Message-ID: <20160616102312.GA62932@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) This patch enhances the memory usage of object declarations initialized by a qualified array aggregate. Previously, as per RM 4.3(5), an anonymous object was created to capture the value of the array aggregate, effectively doubling the memory consumption. The changes above remove the anonymous object declaration and instead ignore the qualified expression. As noted in the comments this is allowed due to RM 7.6(17 1/3). ------------ -- Source -- ------------ -- pack.adb procedure Pack is type Rec is record I : Integer; SI : Short_Integer; B : Boolean; end record; type Arr is array (1 .. 3, 0 .. 255) of Rec; Obj_1 : Arr := Arr'(others => (others => Rec'(0, 0, False))); begin null; end Pack; ---------------------------- -- Compilation and output -- ---------------------------- gnatmake -g -f -gnatD pack.adb grep "obj_1[ ]*:[ a-z_]*;" pack.adb.dg obj_1 : pack__arr; Tested on x86_64-pc-linux-gnu, committed on trunk 2016-06-16 Justin Squirek * sem_ch3.adb (Analyze_Object_Declaration): Add a missing check for optimized aggregate arrays with qualified expressions. * exp_aggr.adb (Expand_Array_Aggregate): Fix block and conditional statement in charge of deciding whether to perform in-place expansion. Specifically, use Parent_Node to jump over the qualified expression to the object declaration node. Also, a check has been inserted to skip the optimization if SPARK 2005 is being used in strict adherence to RM 4.3(5). Index: sem_ch3.adb =================================================================== --- sem_ch3.adb (revision 237439) +++ sem_ch3.adb (working copy) @@ -3471,7 +3471,7 @@ -- In case of aggregates we must also take care of the correct -- initialization of nested aggregates bug this is done at the - -- point of the analysis of the aggregate (see sem_aggr.adb). + -- point of the analysis of the aggregate (see sem_aggr.adb) ??? if Present (Expression (N)) and then Nkind (Expression (N)) = N_Aggregate @@ -4038,7 +4038,10 @@ elsif Is_Array_Type (T) and then No_Initialization (N) - and then Nkind (Original_Node (E)) = N_Aggregate + and then (Nkind (Original_Node (E)) = N_Aggregate + or else (Nkind (Original_Node (E)) = N_Qualified_Expression + and then Nkind (Original_Node (Expression + (Original_Node (E)))) = N_Aggregate)) then if not Is_Entity_Name (Object_Definition (N)) then Act_T := Etype (E); Index: exp_aggr.adb =================================================================== --- exp_aggr.adb (revision 237429) +++ exp_aggr.adb (working copy) @@ -5433,8 +5433,8 @@ -- STEP 3 - -- Delay expansion for nested aggregates: it will be taken care of - -- when the parent aggregate is expanded. + -- Delay expansion for nested aggregates: it will be taken care of when + -- the parent aggregate is expanded. Parent_Node := Parent (N); Parent_Kind := Nkind (Parent_Node); @@ -5524,14 +5524,18 @@ and then Parent_Kind = N_Object_Declaration and then not Must_Slide (Etype (Defining_Identifier (Parent_Node)), Typ) - and then N = Expression (Parent_Node) + and then Present (Expression (Parent_Node)) + and then not Has_Controlled_Component (Typ) and then not Is_Bit_Packed_Array (Typ) - and then not Has_Controlled_Component (Typ) + + -- ??? the test for SPARK 05 needs documentation + + and then not Restriction_Check_Required (SPARK_05) then In_Place_Assign_OK_For_Declaration := True; - Tmp := Defining_Identifier (Parent (N)); - Set_No_Initialization (Parent (N)); - Set_Expression (Parent (N), Empty); + Tmp := Defining_Identifier (Parent_Node); + Set_No_Initialization (Parent_Node); + Set_Expression (Parent_Node, Empty); -- Set kind and type of the entity, for use in the analysis -- of the subsequent assignments. If the nominal type is not @@ -5544,10 +5548,10 @@ if not Is_Constrained (Typ) then Build_Constrained_Type (Positional => False); - elsif Is_Entity_Name (Object_Definition (Parent (N))) - and then Is_Constrained (Entity (Object_Definition (Parent (N)))) + elsif Is_Entity_Name (Object_Definition (Parent_Node)) + and then Is_Constrained (Entity (Object_Definition (Parent_Node))) then - Set_Etype (Tmp, Entity (Object_Definition (Parent (N)))); + Set_Etype (Tmp, Entity (Object_Definition (Parent_Node))); else Set_Size_Known_At_Compile_Time (Typ, False);