From patchwork Fri Jan 13 11:17:09 2017 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 714987 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 3v0Kq73KKDz9vJQ for ; Fri, 13 Jan 2017 22:17:39 +1100 (AEDT) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="vFvfCGSw"; 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=w2NcSFI3CMzOk2BCXhhbMyW0lYa5Ia7rfjQcPvqVHnxC3viz/e mj89exl720ElTWdQP0T5cILIni1VEy2GO3vQmFlW5grw+WVARA1howYGW0yeHC3g zRgx097icFd5RxadO/6iBV/BZlq2kt6gFshTHsdoMcq0nY2JiXxhJtnCU= 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=oYCzyTfxLVv3NJE/miMqIwjKjZc=; b=vFvfCGSwY75X587BjT07 fmtCKvD1hljX5zB6AvIOC/92vKYgwPH22pmRRfy/3SHq6BOydI0OGMK5U7+JaxVn 4nsW1NmMmsvso/vB0b5e+KlVk0+5wW7n7Uj/k8HM22OGBIIkEasiJqlm+PTNNUOb RCO+OUQOcWBe7X+oaQykss4= Received: (qmail 93325 invoked by alias); 13 Jan 2017 11:17:19 -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 93269 invoked by uid 89); 13 Jan 2017 11:17:15 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=1.6 required=5.0 tests=AWL, BAYES_50, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=no version=3.3.2 spammy=Nam, contracts, sk:Paramet, sk:paramet 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; Fri, 13 Jan 2017 11:17:10 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 417301174CE; Fri, 13 Jan 2017 06:17:09 -0500 (EST) 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 wbC282D8uHiS; Fri, 13 Jan 2017 06:17:09 -0500 (EST) Received: from tron.gnat.com (tron.gnat.com [205.232.38.10]) by rock.gnat.com (Postfix) with ESMTP id 2E8FC116615; Fri, 13 Jan 2017 06:17:09 -0500 (EST) Received: by tron.gnat.com (Postfix, from userid 4192) id 2CC774BA; Fri, 13 Jan 2017 06:17:09 -0500 (EST) Date: Fri, 13 Jan 2017 06:17:09 -0500 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Javier Miranda Subject: [Ada] Inlining of expression function returning controlled object Message-ID: <20170113111709.GA102186@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) Pragma Inline_Always has been extended to support inlining of calls to expression functions that return a controlled object if the expression function fulfills all the following requirements: 1. Has pragma/aspect Inline_Always 2. Has no formals 3. Has no contracts 4. Has no dispatching primitive 5. Its result subtype is controlled (or with controlled components) 6. Its result subtype not subject to type-invariant checks 7. Its result subtype not a class-wide type 8. Its return expression naming an object global to the function 9. The nominal subtype of the returned object statically compatible with the result subtype of the expression function. After this enhancement, using the following sources, the call to the expression function Ada_Exception_Trace is now inlined. with Ada.Finalization; package Param is type T is abstract tagged private; private type T is abstract new Ada.Finalization.Controlled with null record; procedure Initialize (Obj : in out T); procedure Adjust (Obj : in out T); procedure Finalize (Obj : in out T); end; package Param.Debug is type T is private; function Value (Parameter : T) return Boolean with Inline_Always; function Ada_Exception_Trace return T with Inline_Always; procedure Do_Test; private type Comp_T is new Param.T with record Value : Boolean := True; end record; type T is record Component : Comp_T; end record; function Value (Parameter : T) return Boolean is (Parameter.Component.Value); Private_Ada_Exception_Trace : T; function Ada_Exception_Trace return T -- Test is (Private_Ada_Exception_Trace); end Param.Debug; with Ada.Text_IO; use Ada.Text_IO; package body Param is procedure Initialize (Obj : in out T) is begin Put_Line ("Initialize()"); end; procedure Adjust (Obj : in out T) is begin Put_Line ("Adjust()"); end; procedure Finalize (Obj : in out T) is begin Put_Line ("Finalize()"); end; end; with Ada.Text_IO; use Ada.Text_IO; package body Param.Debug is procedure Do_Test is begin if Value (Ada_Exception_Trace) then -- Test Put_Line ("Do_Test()"); end if; end; end; with Param.Debug; procedure Main is begin Param.Debug.Do_Test; end; Command: gnatmake main.adb; ./main Output: Initialize() Do_Test() Finalize() Tested on x86_64-pc-linux-gnu, committed on trunk 2017-01-13 Javier Miranda * sem_res.adb (Resolve_Call): Do not establish a transient scope for a call to inlinable expression function (since the call will be replaced by its returned object). * exp_ch6.ads (Is_Inlinable_Expression_Function): New subprogram. * exp_ch6.adb (Expression_Of_Expression_Function): New subprogram. (Expand_Call): For inlinable expression function call replace the call by its returned object. (Is_Inlinable_Expression_Function): New subprogram. Index: sem_res.adb =================================================================== --- sem_res.adb (revision 244418) +++ sem_res.adb (working copy) @@ -6260,7 +6260,10 @@ -- within the specialized Exp_Ch6 procedures for expanding those -- build-in-place calls. - -- e) If the subprogram is marked Inline_Always, then even if it returns + -- e) Calls to inlinable expression functions do not use the secondary + -- stack (since the call will be replaced by its returned object). + + -- f) If the subprogram is marked Inline_Always, then even if it returns -- an unconstrained type the call does not require use of the secondary -- stack. However, inlining will only take place if the body to inline -- is already present. It may not be available if e.g. the subprogram is @@ -6281,6 +6284,7 @@ elsif Ekind (Nam) = E_Enumeration_Literal or else Is_Build_In_Place_Function (Nam) or else Is_Intrinsic_Subprogram (Nam) + or else Is_Inlinable_Expression_Function (Nam) then null; Index: exp_ch6.adb =================================================================== --- exp_ch6.adb (revision 244418) +++ exp_ch6.adb (working copy) @@ -219,6 +219,10 @@ -- reference to the object itself, and the call becomes a call to the -- corresponding protected subprogram. + function Expression_Of_Expression_Function + (Subp : Entity_Id) return Node_Id; + -- Return the expression of the expression function Subp + function Has_Unconstrained_Access_Discriminants (Subtyp : Entity_Id) return Boolean; -- Returns True if the given subtype is unconstrained and has one @@ -3938,6 +3942,14 @@ if not Is_Inlined (Subp) then null; + -- Frontend inlining of expression functions (performed also when + -- backend inlining is enabled) + + elsif Is_Inlinable_Expression_Function (Subp) then + Rewrite (N, New_Copy (Expression_Of_Expression_Function (Subp))); + Analyze (N); + return; + -- Handle frontend inlining elsif not Back_End_Inlining then @@ -6958,6 +6970,36 @@ end if; end Expand_Simple_Function_Return; + --------------------------------------- + -- Expression_Of_Expression_Function -- + --------------------------------------- + + function Expression_Of_Expression_Function + (Subp : Entity_Id) return Node_Id + is + Expr_Func : Node_Id; + + begin + pragma Assert (Is_Expression_Function_Or_Completion (Subp)); + + if Nkind (Original_Node (Subprogram_Spec (Subp))) + = N_Expression_Function + then + Expr_Func := Original_Node (Subprogram_Spec (Subp)); + + elsif Nkind (Original_Node (Subprogram_Body (Subp))) + = N_Expression_Function + then + Expr_Func := Original_Node (Subprogram_Body (Subp)); + + else + pragma Assert (False); + null; + end if; + + return Original_Node (Expression (Expr_Func)); + end Expression_Of_Expression_Function; + -------------------------------------------- -- Has_Unconstrained_Access_Discriminants -- -------------------------------------------- @@ -7285,6 +7327,39 @@ end if; end Freeze_Subprogram; + -------------------------------------- + -- Is_Inlinable_Expression_Function -- + -------------------------------------- + + function Is_Inlinable_Expression_Function (Subp : Entity_Id) return Boolean + is + Return_Expr : Node_Id; + + begin + if Is_Expression_Function_Or_Completion (Subp) + and then Has_Pragma_Inline_Always (Subp) + and then Needs_No_Actuals (Subp) + and then No (Contract (Subp)) + and then not Is_Dispatching_Operation (Subp) + and then Needs_Finalization (Etype (Subp)) + and then not Is_Class_Wide_Type (Etype (Subp)) + and then not (Has_Invariants (Etype (Subp))) + and then Present (Subprogram_Body (Subp)) + and then Was_Expression_Function (Subprogram_Body (Subp)) + then + Return_Expr := Expression_Of_Expression_Function (Subp); + + -- The returned object must not have a qualified expression and its + -- nominal subtype must be statically compatible with the result + -- subtype of the expression function. + + return Nkind (Return_Expr) = N_Identifier + and then Etype (Return_Expr) = Etype (Subp); + end if; + + return False; + end Is_Inlinable_Expression_Function; + ----------------------- -- Is_Null_Procedure -- ----------------------- Index: exp_ch6.ads =================================================================== --- exp_ch6.ads (revision 244418) +++ exp_ch6.ads (working copy) @@ -137,6 +137,20 @@ -- that requires handling as a build-in-place call or is a qualified -- expression applied to such a call; otherwise returns False. + function Is_Inlinable_Expression_Function (Subp : Entity_Id) return Boolean; + -- Return True if Subp is an expression function that fulfills all the + -- following requirements for inlining: + -- 1. pragma/aspect Inline_Always + -- 2. No formals + -- 3. No contracts + -- 4. No dispatching primitive + -- 5. Result subtype controlled (or with controlled components) + -- 6. Result subtype not subject to type-invariant checks + -- 7. Result subtype not a class-wide type + -- 8. Return expression naming an object global to the function + -- 9. Nominal subtype of the returned object statically compatible + -- with the result subtype of the expression function. + function Is_Null_Procedure (Subp : Entity_Id) return Boolean; -- Predicate to recognize stubbed procedures and null procedures, which -- can be inlined unconditionally in all cases.