From patchwork Fri May 24 09:31:53 2013 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Eric Botcazou X-Patchwork-Id: 246115 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 with cipher DHE-RSA-AES256-SHA (256/256 bits)) (Client CN "localhost", Issuer "www.qmailtoaster.com" (not verified)) by ozlabs.org (Postfix) with ESMTPS id 782B22C008E for ; Fri, 24 May 2013 19:32:13 +1000 (EST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:subject:date:message-id:mime-version:content-type :content-transfer-encoding; q=dns; s=default; b=ETykufO/JJa6zaY2 xzL0aVDBrHZ9jU+IsQmi5LQhCNYPAYPMbsE1ovBFFdkFkaY3J7lPCA99WsXxbzm4 7J6hz9wEin/zAeVkgAtVaGvsdeeOqHC/bVOLDtINUt3rMAzOnkWrYxNJy3++Axle xt39TYkWxNcJQxO9n+wTU+8qGvg= 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:from :to:subject:date:message-id:mime-version:content-type :content-transfer-encoding; s=default; bh=WCzKnZkldoMwnD8P6foHM9 YdjnU=; b=x33cb64LEERVV5OILcCPxbf6EB3DmppMo+ugWC4y/AHZEmL1EG33Tb tZj3232Sk4C5Dt99Je9iwEvXn04nn2w4fwK0GOYjwV6Xe4S4+XHELfVLm7o1VEnB H/suWgGQ+93MfZiSBDnwOl7MJ/FFFa5LDIlcfseJ6SmxA0sZaN00U= Received: (qmail 31716 invoked by alias); 24 May 2013 09:32:07 -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 31704 invoked by uid 89); 24 May 2013 09:32:06 -0000 X-Spam-SWARE-Status: No, score=-2.2 required=5.0 tests=AWL, BAYES_00, TW_TJ, TW_ZC autolearn=no version=3.3.1 Received: from mel.act-europe.fr (HELO smtp.eu.adacore.com) (194.98.77.210) by sourceware.org (qpsmtpd/0.84/v0.84-167-ge50287c) with ESMTP; Fri, 24 May 2013 09:32:05 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id 5A49E2647604 for ; Fri, 24 May 2013 11:30:41 +0200 (CEST) Received: from smtp.eu.adacore.com ([127.0.0.1]) by localhost (smtp.eu.adacore.com [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id pR24_GQl65Km for ; Fri, 24 May 2013 11:30:41 +0200 (CEST) Received: from polaris.localnet (bon31-6-88-161-99-133.fbx.proxad.net [88.161.99.133]) (using TLSv1 with cipher ECDHE-RSA-AES256-SHA (256/256 bits)) (No client certificate requested) by smtp.eu.adacore.com (Postfix) with ESMTPSA id 09F6126475DE for ; Fri, 24 May 2013 11:30:41 +0200 (CEST) From: Eric Botcazou To: gcc-patches@gcc.gnu.org Subject: [Ada] Add support for pragma No_Inline Date: Fri, 24 May 2013 11:31:53 +0200 Message-ID: <3787100.ivD65C73su@polaris> User-Agent: KMail/4.7.2 (Linux/3.1.10-1.19-desktop; KDE/4.7.2; x86_64; ; ) MIME-Version: 1.0 X-Virus-Found: No This is the gigi bits to enable support for pragma No_Inline in the Ada compiler. Nothing more to say, except that specifying also pragma Inline yields a warning and specifying also pragma Inline_Always is an error. Tested on x86_64-suse-linux, applied on the mainline. 2013-05-24 Eric Botcazou * gcc-interface/gigi.h (enum inline_status_t): New type. (create_subprog_decl): Adjust prototype. * gcc-interface/decl.c (gnat_to_gnu_entity) : Adjust calls to create_subprog_decl. (get_minimal_subprog_decl): Likewise. * gcc-interface/trans.c (gigi): Likewise. (build_raise_check): Likewise. (establish_gnat_vms_condition_handler): Likewise. (Compilation_Unit_to_gnu): Likewise. (gnat_to_gnu): Likewise. * gcc-interface/utils.c (create_subprog_decl): Change inline_flag parameter to inline_status and implement for suppressed inlining. 2013-05-24 Eric Botcazou * gnat.dg/specs/noinline1.ads: New test. * gnat.dg/noinline2.ad[sb]: Likewise. * gnat.dg/specs/noinline3.ads: Likewise. * gnat.dg/specs/noinline3_pkg.ad[sb]: New helper. Index: gcc-interface/utils.c =================================================================== --- gcc-interface/utils.c (revision 199275) +++ gcc-interface/utils.c (working copy) @@ -6,7 +6,7 @@ * * * C Implementation File * * * - * Copyright (C) 1992-2012, Free Software Foundation, Inc. * + * Copyright (C) 1992-2013, Free Software Foundation, Inc. * * * * GNAT is free software; you can redistribute it and/or modify it under * * terms of the GNU General Public License as published by the Free Soft- * @@ -2621,14 +2621,14 @@ create_label_decl (tree label_name, Node node), PARAM_DECL_LIST is the list of the subprogram arguments (a list of PARM_DECL nodes chained through the DECL_CHAIN field). - INLINE_FLAG, PUBLIC_FLAG, EXTERN_FLAG, ARTIFICIAL_FLAG and ATTR_LIST are + INLINE_STATUS, PUBLIC_FLAG, EXTERN_FLAG, ARTIFICIAL_FLAG and ATTR_LIST are used to set the appropriate fields in the FUNCTION_DECL. GNAT_NODE is used for the position of the decl. */ tree create_subprog_decl (tree subprog_name, tree asm_name, tree subprog_type, - tree param_decl_list, bool inline_flag, bool public_flag, - bool extern_flag, bool artificial_flag, + tree param_decl_list, enum inline_status_t inline_status, + bool public_flag, bool extern_flag, bool artificial_flag, struct attrib *attr_list, Node_Id gnat_node) { tree subprog_decl = build_decl (input_location, FUNCTION_DECL, subprog_name, @@ -2642,7 +2642,7 @@ create_subprog_decl (tree subprog_name, function in the current unit since it is private to the other unit. We could inline the nested function as well but it's probably better to err on the side of too little inlining. */ - if (!inline_flag + if (inline_status != is_enabled && !public_flag && current_function_decl && DECL_DECLARED_INLINE_P (current_function_decl) @@ -2651,8 +2651,24 @@ create_subprog_decl (tree subprog_name, DECL_ARTIFICIAL (subprog_decl) = artificial_flag; DECL_EXTERNAL (subprog_decl) = extern_flag; - DECL_DECLARED_INLINE_P (subprog_decl) = inline_flag; - DECL_NO_INLINE_WARNING_P (subprog_decl) = inline_flag && artificial_flag; + + switch (inline_status) + { + case is_suppressed: + DECL_UNINLINABLE (subprog_decl) = 1; + break; + + case is_disabled: + break; + + case is_enabled: + DECL_DECLARED_INLINE_P (subprog_decl) = 1; + DECL_NO_INLINE_WARNING_P (subprog_decl) = artificial_flag; + break; + + default: + gcc_unreachable (); + } TREE_PUBLIC (subprog_decl) = public_flag; TREE_READONLY (subprog_decl) = TYPE_READONLY (subprog_type); Index: gcc-interface/decl.c =================================================================== --- gcc-interface/decl.c (revision 199279) +++ gcc-interface/decl.c (working copy) @@ -4130,7 +4130,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entit tree gnu_stub_type = NULL_TREE, gnu_stub_name = NULL_TREE; tree gnu_ext_name = create_concat_name (gnat_entity, NULL); Entity_Id gnat_param; - bool inline_flag = Is_Inlined (gnat_entity); + enum inline_status_t inline_status + = Has_Pragma_No_Inline (gnat_entity) + ? is_suppressed + : (Is_Inlined (gnat_entity) ? is_enabled : is_disabled); bool public_flag = Is_Public (gnat_entity) || imported_p; bool extern_flag = (Is_Public (gnat_entity) && !definition) || imported_p; @@ -4686,15 +4689,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entit gnu_decl = create_subprog_decl (gnu_entity_name, gnu_ext_name, gnu_type, - gnu_param_list, inline_flag, public_flag, - extern_flag, artificial_flag, attr_list, - gnat_entity); + gnu_param_list, inline_status, + public_flag, extern_flag, artificial_flag, + attr_list, gnat_entity); if (has_stub) { tree gnu_stub_decl = create_subprog_decl (gnu_entity_name, gnu_stub_name, gnu_stub_type, gnu_stub_param_list, - inline_flag, true, extern_flag, + inline_status, true, extern_flag, false, attr_list, gnat_entity); SET_DECL_FUNCTION_STUB (gnu_decl, gnu_stub_decl); } @@ -5427,7 +5430,7 @@ get_minimal_subprog_decl (Entity_Id gnat return create_subprog_decl (gnu_entity_name, gnu_ext_name, void_ftype, NULL_TREE, - false, true, true, true, attr_list, gnat_entity); + is_disabled, true, true, true, attr_list, gnat_entity); } /* Return whether the E_Subprogram_Type/E_Function/E_Procedure GNAT_ENTITY is Index: gcc-interface/gigi.h =================================================================== --- gcc-interface/gigi.h (revision 199275) +++ gcc-interface/gigi.h (working copy) @@ -430,6 +430,17 @@ enum exception_info_kind exception_column }; +/* Define the inline status of a subprogram. */ +enum inline_status_t +{ + /* Inlining is suppressed for the subprogram. */ + is_suppressed, + /* No inlining is requested for the subprogram. */ + is_disabled, + /* Inlining is requested for the subprogram. */ + is_enabled +}; + extern GTY(()) tree gnat_std_decls[(int) ADT_LAST]; extern GTY(()) tree gnat_raise_decls[(int) LAST_REASON_CODE + 1]; extern GTY(()) tree gnat_raise_decls_ext[(int) LAST_REASON_CODE + 1]; @@ -718,13 +729,14 @@ extern tree create_label_decl (tree, Nod node), PARAM_DECL_LIST is the list of the subprogram arguments (a list of PARM_DECL nodes chained through the DECL_CHAIN field). - INLINE_FLAG, PUBLIC_FLAG, EXTERN_FLAG, ARTIFICIAL_FLAG and ATTR_LIST are + INLINE_STATUS, PUBLIC_FLAG, EXTERN_FLAG, ARTIFICIAL_FLAG and ATTR_LIST are used to set the appropriate fields in the FUNCTION_DECL. GNAT_NODE is used for the position of the decl. */ extern tree create_subprog_decl (tree subprog_name, tree asm_name, tree subprog_type, tree param_decl_list, - bool inline_flag, bool public_flag, - bool extern_flag, bool artificial_flag, + enum inline_status_t inline_status, + bool public_flag, bool extern_flag, + bool artificial_flag, struct attrib *attr_list, Node_Id gnat_node); /* Set up the framework for generating code for SUBPROG_DECL, a subprogram Index: gcc-interface/trans.c =================================================================== --- gcc-interface/trans.c (revision 199281) +++ gcc-interface/trans.c (working copy) @@ -413,16 +413,16 @@ gigi (Node_Id gnat_root, int max_gnat_no memory. */ malloc_decl = create_subprog_decl (get_identifier ("__gnat_malloc"), NULL_TREE, - ftype, NULL_TREE, false, true, true, true, NULL, - Empty); + ftype, NULL_TREE, is_disabled, true, true, true, + NULL, Empty); DECL_IS_MALLOC (malloc_decl) = 1; /* malloc32 is a function declaration tree for a function to allocate 32-bit memory on a 64-bit system. Needed only on 64-bit VMS. */ malloc32_decl = create_subprog_decl (get_identifier ("__gnat_malloc32"), NULL_TREE, - ftype, NULL_TREE, false, true, true, true, NULL, - Empty); + ftype, NULL_TREE, is_disabled, true, true, true, + NULL, Empty); DECL_IS_MALLOC (malloc32_decl) = 1; /* free is a function declaration tree for a function to free memory. */ @@ -431,14 +431,16 @@ gigi (Node_Id gnat_root, int max_gnat_no build_function_type_list (void_type_node, ptr_void_type_node, NULL_TREE), - NULL_TREE, false, true, true, true, NULL, Empty); + NULL_TREE, is_disabled, true, true, true, NULL, + Empty); /* This is used for 64-bit multiplication with overflow checking. */ mulv64_decl = create_subprog_decl (get_identifier ("__gnat_mulv64"), NULL_TREE, build_function_type_list (int64_type, int64_type, int64_type, NULL_TREE), - NULL_TREE, false, true, true, true, NULL, Empty); + NULL_TREE, is_disabled, true, true, true, NULL, + Empty); /* Name of the _Parent field in tagged record types. */ parent_name_id = get_identifier (Get_Name_String (Name_uParent)); @@ -459,7 +461,7 @@ gigi (Node_Id gnat_root, int max_gnat_no = create_subprog_decl (get_identifier ("system__soft_links__get_jmpbuf_address_soft"), NULL_TREE, build_function_type_list (jmpbuf_ptr_type, NULL_TREE), - NULL_TREE, false, true, true, true, NULL, Empty); + NULL_TREE, is_disabled, true, true, true, NULL, Empty); DECL_IGNORED_P (get_jmpbuf_decl) = 1; set_jmpbuf_decl @@ -467,7 +469,7 @@ gigi (Node_Id gnat_root, int max_gnat_no (get_identifier ("system__soft_links__set_jmpbuf_address_soft"), NULL_TREE, build_function_type_list (void_type_node, jmpbuf_ptr_type, NULL_TREE), - NULL_TREE, false, true, true, true, NULL, Empty); + NULL_TREE, is_disabled, true, true, true, NULL, Empty); DECL_IGNORED_P (set_jmpbuf_decl) = 1; /* setjmp returns an integer and has one operand, which is a pointer to @@ -477,7 +479,7 @@ gigi (Node_Id gnat_root, int max_gnat_no (get_identifier ("__builtin_setjmp"), NULL_TREE, build_function_type_list (integer_type_node, jmpbuf_ptr_type, NULL_TREE), - NULL_TREE, false, true, true, true, NULL, Empty); + NULL_TREE, is_disabled, true, true, true, NULL, Empty); DECL_BUILT_IN_CLASS (setjmp_decl) = BUILT_IN_NORMAL; DECL_FUNCTION_CODE (setjmp_decl) = BUILT_IN_SETJMP; @@ -487,7 +489,7 @@ gigi (Node_Id gnat_root, int max_gnat_no = create_subprog_decl (get_identifier ("__builtin_update_setjmp_buf"), NULL_TREE, build_function_type_list (void_type_node, jmpbuf_ptr_type, NULL_TREE), - NULL_TREE, false, true, true, true, NULL, Empty); + NULL_TREE, is_disabled, true, true, true, NULL, Empty); DECL_BUILT_IN_CLASS (update_setjmp_buf_decl) = BUILT_IN_NORMAL; DECL_FUNCTION_CODE (update_setjmp_buf_decl) = BUILT_IN_UPDATE_SETJMP_BUF; @@ -497,27 +499,27 @@ gigi (Node_Id gnat_root, int max_gnat_no begin_handler_decl = create_subprog_decl (get_identifier ("__gnat_begin_handler"), NULL_TREE, - ftype, NULL_TREE, false, true, true, true, NULL, - Empty); + ftype, NULL_TREE, is_disabled, true, true, true, + NULL, Empty); DECL_IGNORED_P (begin_handler_decl) = 1; end_handler_decl = create_subprog_decl (get_identifier ("__gnat_end_handler"), NULL_TREE, - ftype, NULL_TREE, false, true, true, true, NULL, - Empty); + ftype, NULL_TREE, is_disabled, true, true, true, + NULL, Empty); DECL_IGNORED_P (end_handler_decl) = 1; unhandled_except_decl = create_subprog_decl (get_identifier ("__gnat_unhandled_except_handler"), NULL_TREE, - ftype, NULL_TREE, false, true, true, true, NULL, - Empty); + ftype, NULL_TREE, is_disabled, true, true, true, + NULL, Empty); DECL_IGNORED_P (unhandled_except_decl) = 1; reraise_zcx_decl = create_subprog_decl (get_identifier ("__gnat_reraise_zcx"), NULL_TREE, - ftype, NULL_TREE, false, true, true, true, NULL, - Empty); + ftype, NULL_TREE, is_disabled, true, true, true, + NULL, Empty); /* Indicate that these never return. */ DECL_IGNORED_P (reraise_zcx_decl) = 1; TREE_THIS_VOLATILE (reraise_zcx_decl) = 1; @@ -537,7 +539,7 @@ gigi (Node_Id gnat_root, int max_gnat_no build_pointer_type (unsigned_char_type_node), integer_type_node, NULL_TREE), - NULL_TREE, false, true, true, true, NULL, Empty); + NULL_TREE, is_disabled, true, true, true, NULL, Empty); TREE_THIS_VOLATILE (decl) = 1; TREE_SIDE_EFFECTS (decl) = 1; TREE_TYPE (decl) @@ -570,7 +572,7 @@ gigi (Node_Id gnat_root, int max_gnat_no (get_identifier ("system__soft_links__get_gnat_exception"), NULL_TREE, build_function_type_list (build_pointer_type (except_type_node), NULL_TREE), - NULL_TREE, false, true, true, true, NULL, Empty); + NULL_TREE, is_disabled, true, true, true, NULL, Empty); DECL_IGNORED_P (get_excptr_decl) = 1; raise_nodefer_decl @@ -579,7 +581,7 @@ gigi (Node_Id gnat_root, int max_gnat_no build_function_type_list (void_type_node, build_pointer_type (except_type_node), NULL_TREE), - NULL_TREE, false, true, true, true, NULL, Empty); + NULL_TREE, is_disabled, true, true, true, NULL, Empty); /* Indicate that it never returns. */ TREE_THIS_VOLATILE (raise_nodefer_decl) = 1; @@ -752,7 +754,7 @@ build_raise_check (int check, enum excep result = create_subprog_decl (get_identifier (Name_Buffer), NULL_TREE, ftype, NULL_TREE, - false, true, true, true, NULL, Empty); + is_disabled, true, true, true, NULL, Empty); /* Indicate that it never returns. */ TREE_THIS_VOLATILE (result) = 1; @@ -2813,7 +2815,7 @@ establish_gnat_vms_condition_handler (vo ptr_void_type_node, ptr_void_type_node, NULL_TREE), - NULL_TREE, false, true, true, true, NULL, + NULL_TREE, is_disabled, true, true, true, NULL, Empty); /* ??? DECL_CONTEXT shouldn't have been set because of DECL_EXTERNAL. */ @@ -4867,7 +4869,7 @@ Compilation_Unit_to_gnu (Node_Id gnat_no tree gnu_elab_proc_decl = create_subprog_decl (create_concat_name (gnat_unit_entity, body_p ? "elabb" : "elabs"), - NULL_TREE, void_ftype, NULL_TREE, false, true, false, true, NULL, + NULL_TREE, void_ftype, NULL_TREE, is_disabled, true, false, true, NULL, gnat_unit); struct elab_info *info; @@ -5795,7 +5797,7 @@ gnat_to_gnu (Node_Id gnat_node) create_subprog_decl (create_concat_name (Entity (Prefix (gnat_node)), attr == Attr_Elab_Body ? "elabb" : "elabs"), - NULL_TREE, void_ftype, NULL_TREE, false, + NULL_TREE, void_ftype, NULL_TREE, is_disabled, true, true, true, NULL, gnat_node); gnu_result = Attribute_to_gnu (gnat_node, &gnu_result_type, attr);