From patchwork Thu Oct 21 10:06:11 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 68563 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]) by ozlabs.org (Postfix) with SMTP id 13E7FB6EEC for ; Thu, 21 Oct 2010 21:06:25 +1100 (EST) Received: (qmail 11346 invoked by alias); 21 Oct 2010 10:06:23 -0000 Received: (qmail 11333 invoked by uid 22791); 21 Oct 2010 10:06:21 -0000 X-SWARE-Spam-Status: No, hits=-1.3 required=5.0 tests=AWL, BAYES_00, T_RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from mel.act-europe.fr (HELO mel.act-europe.fr) (194.98.77.210) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Thu, 21 Oct 2010 10:06:14 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id 02455CB0308; Thu, 21 Oct 2010 12:06:12 +0200 (CEST) Received: from mel.act-europe.fr ([127.0.0.1]) by localhost (smtp.eu.adacore.com [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id Vo4GPQEmdNQT; Thu, 21 Oct 2010 12:06:11 +0200 (CEST) Received: from saumur.act-europe.fr (saumur.act-europe.fr [10.10.0.183]) by mel.act-europe.fr (Postfix) with ESMTP id E0E9ECB0305; Thu, 21 Oct 2010 12:06:11 +0200 (CEST) Received: by saumur.act-europe.fr (Postfix, from userid 525) id BA3D9D9BB5; Thu, 21 Oct 2010 12:06:11 +0200 (CEST) Date: Thu, 21 Oct 2010 12:06:11 +0200 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Ed Schonberg Subject: [Ada] Optimization of array aggregates Message-ID: <20101021100611.GA18228@adacore.com> Mime-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.9i X-IsSubscribed: yes 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 This patch improves the handling of array aggregates with static components. It allows constant folding of aggregates with a single association given by an expanded name, and it allows in-place assignments for aggregates when the array type has an index type that has a non-standard representation. Tested on x86_64-pc-linux-gnu, committed on trunk 2010-10-21 Ed Schonberg * exp_aggr.adb (Flatten): An association for a subtype may be an expanded name. (Safe_Left_Hand_Side): An unchecked conversion is part of a safe left-hand side if the expression is. (Is_Safe_Index): new predicate Minor clean up in identier names (Indices -> Indexes). * exp_ch3.adb (Expand_Freeze_Enumeration_Type): Indicate that the generated Rep_To_Pos function is a Pure_Function. Index: exp_aggr.adb =================================================================== --- exp_aggr.adb (revision 165755) +++ exp_aggr.adb (working copy) @@ -227,7 +227,7 @@ package body Exp_Aggr is Index : Node_Id; Into : Node_Id; Scalar_Comp : Boolean; - Indices : List_Id := No_List; + Indexes : List_Id := No_List; Flist : Node_Id := Empty) return List_Id; -- This recursive routine returns a list of statements containing the -- loops and assignments that are needed for the expansion of the array @@ -244,7 +244,7 @@ package body Exp_Aggr is -- -- Scalar_Comp is True if the component type of the aggregate is scalar. -- - -- Indices is the current list of expressions used to index the + -- Indexes is the current list of expressions used to index the -- object we are writing into. -- -- Flist is an expression representing the finalization list on which @@ -701,7 +701,7 @@ package body Exp_Aggr is Index : Node_Id; Into : Node_Id; Scalar_Comp : Boolean; - Indices : List_Id := No_List; + Indexes : List_Id := No_List; Flist : Node_Id := Empty) return List_Id is Loc : constant Source_Ptr := Sloc (N); @@ -728,7 +728,7 @@ package body Exp_Aggr is -- N to Build_Loop contains no sub-aggregates, then this function -- returns the assignment statement: -- - -- Into (Indices, Ind) := Expr; + -- Into (Indexes, Ind) := Expr; -- -- Otherwise we call Build_Code recursively -- @@ -741,7 +741,7 @@ package body Exp_Aggr is -- This routine returns the for loop statement -- -- for J in Index_Base'(L) .. Index_Base'(H) loop - -- Into (Indices, J) := Expr; + -- Into (Indexes, J) := Expr; -- end loop; -- -- Otherwise we call Build_Code recursively. @@ -756,7 +756,7 @@ package body Exp_Aggr is -- J : Index_Base := L; -- while J < H loop -- J := Index_Base'Succ (J); - -- Into (Indices, J) := Expr; + -- Into (Indexes, J) := Expr; -- end loop; -- -- Otherwise we call Build_Code recursively @@ -942,7 +942,7 @@ package body Exp_Aggr is F : Entity_Id; A : Node_Id; - New_Indices : List_Id; + New_Indexes : List_Id; Indexed_Comp : Node_Id; Expr_Q : Node_Id; Comp_Type : Entity_Id := Empty; @@ -982,13 +982,13 @@ package body Exp_Aggr is -- Start of processing for Gen_Assign begin - if No (Indices) then - New_Indices := New_List; + if No (Indexes) then + New_Indexes := New_List; else - New_Indices := New_Copy_List_Tree (Indices); + New_Indexes := New_Copy_List_Tree (Indexes); end if; - Append_To (New_Indices, Ind); + Append_To (New_Indexes, Ind); if Present (Flist) then F := New_Copy_Tree (Flist); @@ -1014,7 +1014,7 @@ package body Exp_Aggr is Index => Next_Index (Index), Into => Into, Scalar_Comp => Scalar_Comp, - Indices => New_Indices, + Indexes => New_Indexes, Flist => F)); end if; @@ -1024,7 +1024,7 @@ package body Exp_Aggr is Checks_Off (Make_Indexed_Component (Loc, Prefix => New_Copy_Tree (Into), - Expressions => New_Indices)); + Expressions => New_Indexes)); Set_Assignment_OK (Indexed_Comp); @@ -1045,7 +1045,7 @@ package body Exp_Aggr is Comp_Type := Component_Type (Etype (N)); pragma Assert (Comp_Type = Ctype); -- AI-287 - elsif Present (Next (First (New_Indices))) then + elsif Present (Next (First (New_Indexes))) then -- Ada 2005 (AI-287): Do nothing in case of default initialized -- component because we have received the component type in @@ -3946,9 +3946,9 @@ package body Exp_Aggr is exit Component_Loop; - -- Case of a subtype mark + -- Case of a subtype mark, identifier or expanded name - elsif Nkind (Choice) = N_Identifier + elsif Is_Entity_Name (Choice) and then Is_Type (Entity (Choice)) then Lo := Type_Low_Bound (Etype (Choice)); @@ -4217,7 +4217,7 @@ package body Exp_Aggr is Comp : Node_Id; Decl : Node_Id; Typ : constant Entity_Id := Etype (N); - Indices : constant List_Id := New_List; + Indexes : constant List_Id := New_List; Num : Int; Sub_Agg : Node_Id; @@ -4239,7 +4239,7 @@ package body Exp_Aggr is Next (Comp); end loop; - Append_To (Indices, + Append_To (Indexes, Make_Range (Loc, Low_Bound => Make_Integer_Literal (Loc, 1), High_Bound => Make_Integer_Literal (Loc, Num))); @@ -4255,7 +4255,7 @@ package body Exp_Aggr is Make_Range (Loc, Low_Bound => Aggr_Low (D), High_Bound => Aggr_High (D)), - Indices); + Indexes); end loop; end if; @@ -4264,10 +4264,10 @@ package body Exp_Aggr is Defining_Identifier => Agg_Type, Type_Definition => Make_Constrained_Array_Definition (Loc, - Discrete_Subtype_Definitions => Indices, - Component_Definition => + Discrete_Subtype_Definitions => Indexes, + Component_Definition => Make_Component_Definition (Loc, - Aliased_Present => False, + Aliased_Present => False, Subtype_Indication => New_Occurrence_Of (Component_Type (Typ), Loc)))); @@ -4940,6 +4940,41 @@ package body Exp_Aggr is ------------------------- function Safe_Left_Hand_Side (N : Node_Id) return Boolean is + function Is_Safe_Index (Indx : Node_Id) return Boolean; + -- If the left-hand side includes an indexed component, check that + -- the indexes are free of side-effect. + + ------------------- + -- Is_Safe_Index -- + ------------------- + + function Is_Safe_Index (Indx : Node_Id) return Boolean is + begin + if Is_Entity_Name (Indx) then + return True; + + elsif Nkind (Indx) = N_Integer_Literal then + return True; + + elsif Nkind (Indx) = N_Function_Call + and then Is_Entity_Name (Name (Indx)) + and then + Has_Pragma_Pure_Function (Entity (Name (Indx))) + then + return True; + + elsif Nkind (Indx) = N_Type_Conversion + and then Is_Safe_Index (Expression (Indx)) + then + return True; + + else + return False; + end if; + end Is_Safe_Index; + + -- Start of processing for Safe_Left_Hand_Side + begin if Is_Entity_Name (N) then return True; @@ -4952,10 +4987,13 @@ package body Exp_Aggr is elsif Nkind (N) = N_Indexed_Component and then Safe_Left_Hand_Side (Prefix (N)) and then - (Is_Entity_Name (First (Expressions (N))) - or else Nkind (First (Expressions (N))) = N_Integer_Literal) + Is_Safe_Index (First (Expressions (N))) then return True; + + elsif Nkind (N) = N_Unchecked_Type_Conversion then + return Safe_Left_Hand_Side (Expression (N)); + else return False; end if; @@ -6101,7 +6139,7 @@ package body Exp_Aggr is Index => First_Index (Typ), Into => Target, Scalar_Comp => Is_Scalar_Type (Component_Type (Typ)), - Indices => No_List, + Indexes => No_List, Flist => Flist); end if; end Late_Expansion; Index: exp_ch3.adb =================================================================== --- exp_ch3.adb (revision 165755) +++ exp_ch3.adb (working copy) @@ -5858,6 +5858,11 @@ package body Exp_Ch3 is Set_TSS (Typ, Fent); Set_Is_Pure (Fent); + -- The Pure flag will be reset is the current context is not pure. + -- For optimization purposes and constant-folding, indicate that the + -- Rep_To_Pos function can be considered free of side effects. + + Set_Has_Pragma_Pure_Function (Fent); if not Debug_Generated_Code then Set_Debug_Info_Off (Fent);