From patchwork Tue May 28 08:47:53 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Eric Botcazou X-Patchwork-Id: 1106155 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-501750-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="W9nC2hT/"; 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 45CnYQ6hB8z9s4V for ; Tue, 28 May 2019 18:48:09 +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:from :to:subject:date:message-id:mime-version:content-type :content-transfer-encoding; q=dns; s=default; b=FZpT7TEwsCh1HasE ff7BkzC8/7Vu+7SxUq1jnZpIaq+oACP+q5I9w0+lpbFKZ3Xtrhqa5N/AjXGtM/5D 0U+v2hzLjH7aSrRN1VSx6m/4HNe9Rm/h8WKTSA6zM/OXXqjIbXxXqZzxEs1EV1Hy xC/TadJ6N4FF88mLTAsTU1+tJP4= 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=5LeqA/dLqZUqMSWoTg8xHb 26yJs=; b=W9nC2hT/HGpdPAqNfl4WbJBT1M9kI4+ITuSIqD1n17weHl82Iwe11e JvgmXahU9aAe4hT02mxE7p6nOackriVFMS9LgpJmhBVmqbo08nJrStwzCGrD2nlS 8+r5Fug/kpmYIZHSkkG3/FpwOA9gp+D7+GInTnYUl3Om/S7W8PMWs= Received: (qmail 38366 invoked by alias); 28 May 2019 08:48:00 -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 38347 invoked by uid 89); 28 May 2019 08:48:00 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-6.5 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_2, GIT_PATCH_3, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.1 spammy=associates, fake, Next X-HELO: smtp.eu.adacore.com Received: from mel.act-europe.fr (HELO smtp.eu.adacore.com) (194.98.77.210) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Tue, 28 May 2019 08:47:57 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id 5534381387 for ; Tue, 28 May 2019 10:47:55 +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 hK5TePO8QRfU for ; Tue, 28 May 2019 10:47:55 +0200 (CEST) Received: from polaris.localnet (bon31-6-88-161-99-133.fbx.proxad.net [88.161.99.133]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by smtp.eu.adacore.com (Postfix) with ESMTPSA id 0F92381386 for ; Tue, 28 May 2019 10:47:55 +0200 (CEST) From: Eric Botcazou To: gcc-patches@gcc.gnu.org Subject: [Ada] Add support for selected generic function attributes in Ada Date: Tue, 28 May 2019 10:47:53 +0200 Message-ID: <3320378.E3WIE6NG7a@polaris> MIME-Version: 1.0 This adds support for the following function attributes in Ada: no_icf, noipa, flatten, used, cold, hot, target and target_clones. They are supported by means of the pragma Machine_Attribute, whose syntax is extended to accept more than one optional parameter for the latter attribute. Tested on x86_64-suse-linux, applied on the mainline. 2019-05-28 Eric Botcazou * doc/gnat_rm/implementation_defined_pragmas.rst (Machine_Attribute): Document additional optional parameters. * sem_prag.adb (Analyze_Pragma) : Accept more than one optional parameter. * gcc-interface/decl.c (prepend_one_attribute_pragma): Alphabetize the list of supported pragmas. Simplify the handling of parameters and add support for more than one optional parameter. * gcc-interface/utils.c (attr_cold_hot_exclusions): New constant. (gnat_internal_attribute_table): Add entry for no_icf, noipa, flatten, used, cold, hot, target and target_clones. (begin_subprog_body): Do not create the RTL for the subprogram here. (handle_noicf_attribute): New static function. (handle_noipa_attribute): Likewise. (handle_flatten_attribute): Likewise. (handle_used_attribute): Likewise. (handle_cold_attribute): Likewise. (handle_hot_attribute): Likewise. (handle_target_attribute): Likewise. (handle_target_clones_attribute): Likewise. 2019-05-28 Eric Botcazou * gnat.dg/machine_attr1.ad[sb]: New test. Index: doc/gnat_rm/implementation_defined_pragmas.rst =================================================================== --- doc/gnat_rm/implementation_defined_pragmas.rst (revision 271528) +++ doc/gnat_rm/implementation_defined_pragmas.rst (working copy) @@ -3766,18 +3766,19 @@ Syntax: pragma Machine_Attribute ( [Entity =>] LOCAL_NAME, [Attribute_Name =>] static_string_EXPRESSION - [, [Info =>] static_EXPRESSION] ); + [, [Info =>] static_EXPRESSION {, static_EXPRESSION}] ); Machine-dependent attributes can be specified for types and/or declarations. This pragma is semantically equivalent to :samp:`__attribute__(({attribute_name}))` (if ``info`` is not specified) or :samp:`__attribute__(({attribute_name(info})))` -in GNU C, where *attribute_name* is recognized by the -compiler middle-end or the ``TARGET_ATTRIBUTE_TABLE`` machine -specific macro. A string literal for the optional parameter ``info`` -is transformed into an identifier, which may make this pragma unusable -for some attributes. +or :samp:`__attribute__(({attribute_name(info,...})))` in GNU C, +where *attribute_name* is recognized by the compiler middle-end +or the ``TARGET_ATTRIBUTE_TABLE`` machine specific macro. Note +that a string literal for the optional parameter ``info`` or the +following ones is transformed by default into an identifier, +which may make this pragma unusable for some attributes. For further information see :title:`GNU Compiler Collection (GCC) Internals`. Pragma Main Index: gcc-interface/decl.c =================================================================== --- gcc-interface/decl.c (revision 271683) +++ gcc-interface/decl.c (working copy) @@ -6458,25 +6458,18 @@ prepend_one_attribute (struct attrib **a static void prepend_one_attribute_pragma (struct attrib **attr_list, Node_Id gnat_pragma) { - const Node_Id gnat_arg = Pragma_Argument_Associations (gnat_pragma); - tree gnu_arg0 = NULL_TREE, gnu_arg1 = NULL_TREE; + const Node_Id gnat_arg = First (Pragma_Argument_Associations (gnat_pragma)); + Node_Id gnat_next_arg = Next (gnat_arg); + tree gnu_arg1 = NULL_TREE, gnu_arg_list = NULL_TREE; enum attrib_type etype; /* Map the pragma at hand. Skip if this isn't one we know how to handle. */ switch (Get_Pragma_Id (Chars (Pragma_Identifier (gnat_pragma)))) { - case Pragma_Machine_Attribute: - etype = ATTR_MACHINE_ATTRIBUTE; - break; - case Pragma_Linker_Alias: etype = ATTR_LINK_ALIAS; break; - case Pragma_Linker_Section: - etype = ATTR_LINK_SECTION; - break; - case Pragma_Linker_Constructor: etype = ATTR_LINK_CONSTRUCTOR; break; @@ -6485,58 +6478,58 @@ prepend_one_attribute_pragma (struct att etype = ATTR_LINK_DESTRUCTOR; break; - case Pragma_Weak_External: - etype = ATTR_WEAK_EXTERNAL; + case Pragma_Linker_Section: + etype = ATTR_LINK_SECTION; + break; + + case Pragma_Machine_Attribute: + etype = ATTR_MACHINE_ATTRIBUTE; break; case Pragma_Thread_Local_Storage: etype = ATTR_THREAD_LOCAL_STORAGE; break; + case Pragma_Weak_External: + etype = ATTR_WEAK_EXTERNAL; + break; + default: return; } /* See what arguments we have and turn them into GCC trees for attribute - handlers. These expect identifier for strings. We handle at most two - arguments and static expressions only. */ - if (Present (gnat_arg) && Present (First (gnat_arg))) + handlers. The first one is always expected to be a string meant to be + turned into an identifier. The next ones are all static expressions, + among which strings meant to be turned into an identifier, except for + a couple of specific attributes that require raw strings. */ + if (Present (gnat_next_arg)) { - Node_Id gnat_arg0 = Next (First (gnat_arg)); - Node_Id gnat_arg1 = Empty; - - if (Present (gnat_arg0) - && Is_OK_Static_Expression (Expression (gnat_arg0))) - { - gnu_arg0 = gnat_to_gnu (Expression (gnat_arg0)); + gnu_arg1 = gnat_to_gnu (Expression (gnat_next_arg)); + gcc_assert (TREE_CODE (gnu_arg1) == STRING_CST); - if (TREE_CODE (gnu_arg0) == STRING_CST) - { - gnu_arg0 = get_identifier (TREE_STRING_POINTER (gnu_arg0)); - if (IDENTIFIER_LENGTH (gnu_arg0) == 0) - return; - } + const char *const p = TREE_STRING_POINTER (gnu_arg1); + const bool string_args + = strcmp (p, "target") == 0 || strcmp (p, "target_clones") == 0; + gnu_arg1 = get_identifier (p); + if (IDENTIFIER_LENGTH (gnu_arg1) == 0) + return; + gnat_next_arg = Next (gnat_next_arg); - gnat_arg1 = Next (gnat_arg0); - } - - if (Present (gnat_arg1) - && Is_OK_Static_Expression (Expression (gnat_arg1))) + while (Present (gnat_next_arg)) { - gnu_arg1 = gnat_to_gnu (Expression (gnat_arg1)); - - if (TREE_CODE (gnu_arg1) == STRING_CST) - gnu_arg1 = get_identifier (TREE_STRING_POINTER (gnu_arg1)); + tree gnu_arg = gnat_to_gnu (Expression (gnat_next_arg)); + if (TREE_CODE (gnu_arg) == STRING_CST && !string_args) + gnu_arg = get_identifier (TREE_STRING_POINTER (gnu_arg)); + gnu_arg_list + = chainon (gnu_arg_list, build_tree_list (NULL_TREE, gnu_arg)); + gnat_next_arg = Next (gnat_next_arg); } } - /* Prepend to the list. Make a list of the argument we might have, as GCC - expects it. */ - prepend_one_attribute (attr_list, etype, gnu_arg0, - gnu_arg1 - ? build_tree_list (NULL_TREE, gnu_arg1) : NULL_TREE, - Present (Next (First (gnat_arg))) - ? Expression (Next (First (gnat_arg))) : gnat_pragma); + prepend_one_attribute (attr_list, etype, gnu_arg1, gnu_arg_list, + Present (Next (gnat_arg)) + ? Expression (Next (gnat_arg)) : gnat_pragma); } /* Prepend to ATTR_LIST the list of attributes for GNAT_ENTITY, if any. */ Index: gcc-interface/utils.c =================================================================== --- gcc-interface/utils.c (revision 271681) +++ gcc-interface/utils.c (working copy) @@ -93,13 +93,28 @@ static tree handle_noreturn_attribute (t static tree handle_stack_protect_attribute (tree *, tree, tree, int, bool *); static tree handle_noinline_attribute (tree *, tree, tree, int, bool *); static tree handle_noclone_attribute (tree *, tree, tree, int, bool *); +static tree handle_noicf_attribute (tree *, tree, tree, int, bool *); +static tree handle_noipa_attribute (tree *, tree, tree, int, bool *); static tree handle_leaf_attribute (tree *, tree, tree, int, bool *); static tree handle_always_inline_attribute (tree *, tree, tree, int, bool *); static tree handle_malloc_attribute (tree *, tree, tree, int, bool *); static tree handle_type_generic_attribute (tree *, tree, tree, int, bool *); +static tree handle_flatten_attribute (tree *, tree, tree, int, bool *); +static tree handle_used_attribute (tree *, tree, tree, int, bool *); +static tree handle_cold_attribute (tree *, tree, tree, int, bool *); +static tree handle_hot_attribute (tree *, tree, tree, int, bool *); +static tree handle_target_attribute (tree *, tree, tree, int, bool *); +static tree handle_target_clones_attribute (tree *, tree, tree, int, bool *); static tree handle_vector_size_attribute (tree *, tree, tree, int, bool *); static tree handle_vector_type_attribute (tree *, tree, tree, int, bool *); +static const struct attribute_spec::exclusions attr_cold_hot_exclusions[] = +{ + { "cold", true, true, true }, + { "hot" , true, true, true }, + { NULL , false, false, false } +}; + /* Fake handler for attributes we don't properly support, typically because they'd require dragging a lot of the common-c front-end circuitry. */ static tree fake_attribute_handler (tree *, tree, tree, int, bool *); @@ -130,30 +145,49 @@ const struct attribute_spec gnat_interna handle_noinline_attribute, NULL }, { "noclone", 0, 0, true, false, false, false, handle_noclone_attribute, NULL }, + { "no_icf", 0, 0, true, false, false, false, + handle_noicf_attribute, NULL }, + { "noipa", 0, 0, true, false, false, false, + handle_noipa_attribute, NULL }, { "leaf", 0, 0, true, false, false, false, handle_leaf_attribute, NULL }, { "always_inline",0, 0, true, false, false, false, handle_always_inline_attribute, NULL }, { "malloc", 0, 0, true, false, false, false, handle_malloc_attribute, NULL }, - { "type generic", 0, 0, false, true, true, false, + { "type generic", 0, 0, false, true, true, false, handle_type_generic_attribute, NULL }, - { "vector_size", 1, 1, false, true, false, false, + { "flatten", 0, 0, true, false, false, false, + handle_flatten_attribute, NULL }, + { "used", 0, 0, true, false, false, false, + handle_used_attribute, NULL }, + { "cold", 0, 0, true, false, false, false, + handle_cold_attribute, attr_cold_hot_exclusions }, + { "hot", 0, 0, true, false, false, false, + handle_hot_attribute, attr_cold_hot_exclusions }, + { "target", 1, -1, true, false, false, false, + handle_target_attribute, NULL }, + { "target_clones",1, -1, true, false, false, false, + handle_target_clones_attribute, NULL }, + + { "vector_size", 1, 1, false, true, false, false, handle_vector_size_attribute, NULL }, - { "vector_type", 0, 0, false, true, false, false, + { "vector_type", 0, 0, false, true, false, false, handle_vector_type_attribute, NULL }, - { "may_alias", 0, 0, false, true, false, false, NULL, NULL }, + { "may_alias", 0, 0, false, true, false, false, + NULL, NULL }, /* ??? format and format_arg are heavy and not supported, which actually prevents support for stdio builtins, which we however declare as part of the common builtins.def contents. */ - { "format", 3, 3, false, true, true, false, fake_attribute_handler, - NULL }, - { "format_arg", 1, 1, false, true, true, false, fake_attribute_handler, - NULL }, + { "format", 3, 3, false, true, true, false, + fake_attribute_handler, NULL }, + { "format_arg", 1, 1, false, true, true, false, + fake_attribute_handler, NULL }, - { NULL, 0, 0, false, false, false, false, NULL, NULL } + { NULL, 0, 0, false, false, false, false, + NULL, NULL } }; /* Associates a GNAT tree node to a GCC tree node. It is used in @@ -3397,8 +3431,6 @@ begin_subprog_body (tree subprog_decl) for (param_decl = DECL_ARGUMENTS (subprog_decl); param_decl; param_decl = DECL_CHAIN (param_decl)) DECL_CONTEXT (param_decl) = subprog_decl; - - make_decl_rtl (subprog_decl); } /* Finish translating the current subprogram and set its BODY. */ @@ -6393,6 +6425,38 @@ handle_noclone_attribute (tree *node, tr return NULL_TREE; } +/* Handle a "no_icf" attribute; arguments as in + struct attribute_spec.handler. */ + +static tree +handle_noicf_attribute (tree *node, tree name, + tree ARG_UNUSED (args), + int ARG_UNUSED (flags), bool *no_add_attrs) +{ + if (TREE_CODE (*node) != FUNCTION_DECL) + { + warning (OPT_Wattributes, "%qE attribute ignored", name); + *no_add_attrs = true; + } + + return NULL_TREE; +} + +/* Handle a "noipa" attribute; arguments as in + struct attribute_spec.handler. */ + +static tree +handle_noipa_attribute (tree *node, tree name, tree, int, bool *no_add_attrs) +{ + if (TREE_CODE (*node) != FUNCTION_DECL) + { + warning (OPT_Wattributes, "%qE attribute ignored", name); + *no_add_attrs = true; + } + + return NULL_TREE; +} + /* Handle a "leaf" attribute; arguments as in struct attribute_spec.handler. */ @@ -6483,6 +6547,166 @@ handle_type_generic_attribute (tree *nod return NULL_TREE; } +/* Handle a "flatten" attribute; arguments as in + struct attribute_spec.handler. */ + +static tree +handle_flatten_attribute (tree *node, tree name, + tree args ATTRIBUTE_UNUSED, + int flags ATTRIBUTE_UNUSED, bool *no_add_attrs) +{ + if (TREE_CODE (*node) == FUNCTION_DECL) + /* Do nothing else, just set the attribute. We'll get at + it later with lookup_attribute. */ + ; + else + { + warning (OPT_Wattributes, "%qE attribute ignored", name); + *no_add_attrs = true; + } + + return NULL_TREE; +} + +/* Handle a "used" attribute; arguments as in + struct attribute_spec.handler. */ + +static tree +handle_used_attribute (tree *pnode, tree name, tree ARG_UNUSED (args), + int ARG_UNUSED (flags), bool *no_add_attrs) +{ + tree node = *pnode; + + if (TREE_CODE (node) == FUNCTION_DECL + || (VAR_P (node) && TREE_STATIC (node)) + || (TREE_CODE (node) == TYPE_DECL)) + { + TREE_USED (node) = 1; + DECL_PRESERVE_P (node) = 1; + if (VAR_P (node)) + DECL_READ_P (node) = 1; + } + else + { + warning (OPT_Wattributes, "%qE attribute ignored", name); + *no_add_attrs = true; + } + + return NULL_TREE; +} + +/* Handle a "cold" and attribute; arguments as in + struct attribute_spec.handler. */ + +static tree +handle_cold_attribute (tree *node, tree name, tree ARG_UNUSED (args), + int ARG_UNUSED (flags), bool *no_add_attrs) +{ + if (TREE_CODE (*node) == FUNCTION_DECL + || TREE_CODE (*node) == LABEL_DECL) + { + /* Attribute cold processing is done later with lookup_attribute. */ + } + else + { + warning (OPT_Wattributes, "%qE attribute ignored", name); + *no_add_attrs = true; + } + + return NULL_TREE; +} + +/* Handle a "hot" and attribute; arguments as in + struct attribute_spec.handler. */ + +static tree +handle_hot_attribute (tree *node, tree name, tree ARG_UNUSED (args), + int ARG_UNUSED (flags), bool *no_add_attrs) +{ + if (TREE_CODE (*node) == FUNCTION_DECL + || TREE_CODE (*node) == LABEL_DECL) + { + /* Attribute hot processing is done later with lookup_attribute. */ + } + else + { + warning (OPT_Wattributes, "%qE attribute ignored", name); + *no_add_attrs = true; + } + + return NULL_TREE; +} + +/* Handle a "target" attribute. */ + +static tree +handle_target_attribute (tree *node, tree name, tree args, int flags, + bool *no_add_attrs) +{ + /* Ensure we have a function type. */ + if (TREE_CODE (*node) != FUNCTION_DECL) + { + warning (OPT_Wattributes, "%qE attribute ignored", name); + *no_add_attrs = true; + } + else if (lookup_attribute ("target_clones", DECL_ATTRIBUTES (*node))) + { + warning (OPT_Wattributes, "%qE attribute ignored due to conflict " + "with %qs attribute", name, "target_clones"); + *no_add_attrs = true; + } + else if (!targetm.target_option.valid_attribute_p (*node, name, args, flags)) + *no_add_attrs = true; + + /* Check that there's no empty string in values of the attribute. */ + for (tree t = args; t != NULL_TREE; t = TREE_CHAIN (t)) + { + tree value = TREE_VALUE (t); + if (TREE_CODE (value) == STRING_CST + && TREE_STRING_LENGTH (value) == 1 + && TREE_STRING_POINTER (value)[0] == '\0') + { + warning (OPT_Wattributes, "empty string in attribute %"); + *no_add_attrs = true; + } + } + + return NULL_TREE; +} + +/* Handle a "target_clones" attribute. */ + +static tree +handle_target_clones_attribute (tree *node, tree name, tree ARG_UNUSED (args), + int ARG_UNUSED (flags), bool *no_add_attrs) +{ + /* Ensure we have a function type. */ + if (TREE_CODE (*node) == FUNCTION_DECL) + { + if (lookup_attribute ("always_inline", DECL_ATTRIBUTES (*node))) + { + warning (OPT_Wattributes, "%qE attribute ignored due to conflict " + "with %qs attribute", name, "always_inline"); + *no_add_attrs = true; + } + else if (lookup_attribute ("target", DECL_ATTRIBUTES (*node))) + { + warning (OPT_Wattributes, "%qE attribute ignored due to conflict " + "with %qs attribute", name, "target"); + *no_add_attrs = true; + } + else + /* Do not inline functions with multiple clone targets. */ + DECL_UNINLINABLE (*node) = 1; + } + else + { + warning (OPT_Wattributes, "%qE attribute ignored", name); + *no_add_attrs = true; + } + return NULL_TREE; +} + /* Handle a "vector_size" attribute; arguments as in struct attribute_spec.handler. */ Index: sem_prag.adb =================================================================== --- sem_prag.adb (revision 271528) +++ sem_prag.adb (working copy) @@ -19349,20 +19349,25 @@ package body Sem_Prag is ----------------------- -- pragma Machine_Attribute ( - -- [Entity =>] LOCAL_NAME, - -- [Attribute_Name =>] static_string_EXPRESSION - -- [, [Info =>] static_EXPRESSION] ); + -- [Entity =>] LOCAL_NAME, + -- [Attribute_Name =>] static_string_EXPRESSION + -- [, [Info =>] static_EXPRESSION {, static_EXPRESSION}] ); when Pragma_Machine_Attribute => Machine_Attribute : declare + Arg : Node_Id; Def_Id : Entity_Id; begin GNAT_Pragma; Check_Arg_Order ((Name_Entity, Name_Attribute_Name, Name_Info)); - if Arg_Count = 3 then + if Arg_Count >= 3 then Check_Optional_Identifier (Arg3, Name_Info); - Check_Arg_Is_OK_Static_Expression (Arg3); + Arg := Arg3; + while Present (Arg) loop + Check_Arg_Is_OK_Static_Expression (Arg); + Arg := Next (Arg); + end loop; else Check_Arg_Count (2); end if;