From patchwork Sun Nov 15 17:52:40 2020 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Thomas Koenig X-Patchwork-Id: 1400521 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=2620:52:3:1:0:246e:9693:128c; helo=sourceware.org; envelope-from=gcc-patches-bounces@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=pass (p=none dis=none) header.from=gcc.gnu.org Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.a=rsa-sha256 header.s=default header.b=GuSx/5SY; dkim-atps=neutral Received: from sourceware.org (server2.sourceware.org [IPv6:2620:52:3:1:0:246e:9693:128c]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (4096 bits) server-digest SHA256) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4CZ0D56Bn5z9s0b for ; Mon, 16 Nov 2020 04:52:52 +1100 (AEDT) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id C7978388A421; Sun, 15 Nov 2020 17:52:47 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org C7978388A421 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1605462767; bh=vMxGHvWOVkclSbU5GPhVExCI5Qt+uUfgiAr12WPdaHs=; h=To:Subject:Date:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:Cc:From; b=GuSx/5SYiUuGmA1ulMRcL8EutO3mxDRMHc6OtruAghmDJnzdxfcVvDlu/5zkSMWDv JdrOL9tu/Zvkcnhyly1TDS0+z9mlXPKoVdgSFH58cH5uqakefaNEKEdf1oaVJJ+q8y yD6PwbxKTGVslubI2e3E1PtrUfZE0viMmGmn8TAA= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from cc-smtpout1.netcologne.de (cc-smtpout1.netcologne.de [89.1.8.211]) by sourceware.org (Postfix) with ESMTPS id 656F13857808; Sun, 15 Nov 2020 17:52:43 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org 656F13857808 Received: from cc-smtpin1.netcologne.de (cc-smtpin1.netcologne.de [89.1.8.201]) by cc-smtpout1.netcologne.de (Postfix) with ESMTP id CE27F13943; Sun, 15 Nov 2020 18:52:41 +0100 (CET) Received: from localhost (localhost [127.0.0.1]) by cc-smtpin1.netcologne.de (Postfix) with ESMTP id BFDDC11D79; Sun, 15 Nov 2020 18:52:41 +0100 (CET) Received: from [2001:4dd6:2e5:0:6a76:6314:3fa7:a77f] (helo=cc-smtpin1.netcologne.de) by localhost with ESMTP (eXpurgate 4.11.6) (envelope-from ) id 5fb16ae9-02f5-7f0000012729-7f000001da9c-1 for ; Sun, 15 Nov 2020 18:52:41 +0100 Received: from localhost.localdomain (2001-4dd6-2e5-0-6a76-6314-3fa7-a77f.ipv6dyn.netcologne.de [IPv6:2001:4dd6:2e5:0:6a76:6314:3fa7:a77f]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (2048 bits) server-digest SHA256) (No client certificate requested) by cc-smtpin1.netcologne.de (Postfix) with ESMTPSA; Sun, 15 Nov 2020 18:52:40 +0100 (CET) To: "fortran@gcc.gnu.org" Subject: [patch, fortran] Correct fndecls for some library functions Message-ID: <7d637428-5aab-f3f6-e698-ecaf93084c96@netcologne.de> Date: Sun, 15 Nov 2020 18:52:40 +0100 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:78.0) Gecko/20100101 Thunderbird/78.4.0 MIME-Version: 1.0 Content-Language: de-DE X-Spam-Status: No, score=-10.3 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, KAM_STOCKGEN, RCVD_IN_DNSWL_LOW, RCVD_IN_MSPIKE_H3, RCVD_IN_MSPIKE_WL, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.2 X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-Patchwork-Original-From: Thomas Koenig via Gcc-patches From: Thomas Koenig Reply-To: Thomas Koenig Cc: gcc-patches Errors-To: gcc-patches-bounces@gcc.gnu.org Sender: "Gcc-patches" Hello world, this patch makes sure that we pass the correct fn decls for some of our library functions. cshift and others still remain to be implemented. This is a step in our voyage to stop lying to the middle end :-) Regression-tested. OK for trunk? Best regards Thomas Generate correct fn specs for some Fortran library functions. This patch works by generating the correct fn spec from the actual arguments in specific_intrinsic_symbol, and by passing this down via gfc_get_extern_function_decl to gfc_get_function_type. CSHIFT remains to be done. gcc/fortran/ChangeLog: PR fortran/97454 * trans-decl.c (gfc_get_extern_function_decl): Add argument fnspec. * trans-intrinsic.c (MAX_SPEC_ARG): Define. (intrinsic_fnspec): New function. (ADD_CHAR): Define. (specific_intrinsic_symbol): Adjust comment. Pass fn spec to gfc_get_extern_function_decl. (gfc_conv_intrinsic_funcall): Add ANY, ALL, NORM2, PRODUCT and SUM intrnisic. Add FIXME for cshift et al. * trans-types.c (gfc_get_function_type): Add fnspec argument, handle it. * trans-types.h (gfc_get_function_type): Add optinal fnspec argument. * trans.h (gfc_get_extern_function_decl): Likewise. diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 71d5c670e55..b556e7598a0 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -2075,7 +2075,8 @@ get_proc_pointer_decl (gfc_symbol *sym) /* Get a basic decl for an external function. */ tree -gfc_get_extern_function_decl (gfc_symbol * sym, gfc_actual_arglist *actual_args) +gfc_get_extern_function_decl (gfc_symbol * sym, gfc_actual_arglist *actual_args, + const char *fnspec) { tree type; tree fndecl; @@ -2287,7 +2288,8 @@ module_sym: mangled_name = gfc_sym_mangled_function_id (sym); } - type = gfc_get_function_type (sym, actual_args); + type = gfc_get_function_type (sym, actual_args, fnspec); + fndecl = build_decl (input_location, FUNCTION_DECL, name, type); diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index e0afc10d105..98230963adc 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -40,6 +40,8 @@ along with GCC; see the file COPYING3. If not see #include "trans-types.h" #include "trans-array.h" #include "dependency.h" /* For CAF array alias analysis. */ +#include "attribs.h" + /* Only for gfc_trans_assign and gfc_trans_pointer_assign. */ /* This maps Fortran intrinsic math functions to external library or GCC @@ -4257,10 +4259,67 @@ remove_empty_actual_arguments (gfc_actual_arglist **ap) } } +#define MAX_SPEC_ARG 12 + +/* Make up an fn spec that's right for intrinsic functions that we + want to call. */ + +static char * +intrinsic_fnspec (gfc_expr *expr) +{ + static char fnspec_buf[MAX_SPEC_ARG*2+1]; + char *fp; + int i; + int num_char_args; + +#define ADD_CHAR(c) do { *fp++ = c; *fp++ = ' '; } while(0) + + /* Set the fndecl. */ + fp = fnspec_buf; + ADD_CHAR ('.'); /* Function return. */ + if (expr->rank == 0) + { + if (expr->ts.type == BT_CHARACTER) + { + ADD_CHAR ('w'); /* Address of character. */ + ADD_CHAR ('.'); /* Length of character. */ + } + } + else + ADD_CHAR ('w'); /* Return value is a descriptor. */ + + num_char_args = 0; + for (gfc_actual_arglist *a = expr->value.function.actual; a; a = a->next) + { + if (a->expr == NULL) + continue; + + if (a->name && strcmp (a->name,"%VAL") == 0) + ADD_CHAR ('.'); + else + { + if (a->expr->rank > 0) + ADD_CHAR ('r'); + else + ADD_CHAR ('R'); + } + num_char_args += a->expr->ts.type == BT_CHARACTER; + gcc_assert (fp - fnspec_buf + num_char_args <= MAX_SPEC_ARG*2); + } + + for (i = 0; i < num_char_args; i++) + ADD_CHAR ('.'); + + *fp = '\0'; + return fnspec_buf; +} + +#undef MAX_SPEC_ARG +#undef ADD_CHAR + /* Generate the right symbol for the specific intrinsic function and modify the expr accordingly. This assumes that absent optional - arguments should be removed. FIXME: This should be extended for - procedures which do not ignore optional arguments (PR 97454). */ + arguments should be removed. */ gfc_symbol * specific_intrinsic_symbol (gfc_expr *expr) @@ -4278,14 +4337,19 @@ specific_intrinsic_symbol (gfc_expr *expr) gfc_copy_formal_args_intr (sym, expr->value.function.isym, expr->value.function.actual, true); sym->backend_decl - = gfc_get_extern_function_decl (sym, expr->value.function.actual); + = gfc_get_extern_function_decl (sym, expr->value.function.actual, + intrinsic_fnspec (expr)); } + remove_empty_actual_arguments (&(expr->value.function.actual)); return sym; } -/* Generate a call to an external intrinsic function. */ +/* Generate a call to an external intrinsic function. FIXME: So far, + this only works for functions which are called with well-defined + types; CSHIFT and friends will come later. */ + static void gfc_conv_intrinsic_funcall (gfc_se * se, gfc_expr * expr) { @@ -4302,11 +4366,16 @@ gfc_conv_intrinsic_funcall (gfc_se * se, gfc_expr * expr) switch (expr->value.function.isym->id) { + case GFC_ISYM_ANY: + case GFC_ISYM_ALL: case GFC_ISYM_FINDLOC: case GFC_ISYM_MAXLOC: case GFC_ISYM_MINLOC: case GFC_ISYM_MAXVAL: case GFC_ISYM_MINVAL: + case GFC_ISYM_NORM2: + case GFC_ISYM_PRODUCT: + case GFC_ISYM_SUM: specific_symbol = true; break; default: diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index b7129dcbe6d..281cc7d34ab 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -3009,7 +3009,8 @@ create_fn_spec (gfc_symbol *sym, tree fntype) } tree -gfc_get_function_type (gfc_symbol * sym, gfc_actual_arglist *actual_args) +gfc_get_function_type (gfc_symbol * sym, gfc_actual_arglist *actual_args, + const char *fnspec) { tree type; vec *typelist = NULL; @@ -3193,7 +3194,19 @@ arg_type_list_done: type = build_varargs_function_type_vec (type, typelist); else type = build_function_type_vec (type, typelist); - type = create_fn_spec (sym, type); + + /* If we were passed an fn spec, add it here, otherwise determine it from + the formal arguments. */ + if (fnspec) + { + tree tmp; + int spec_len = strlen (fnspec); + tmp = build_tree_list (NULL_TREE, build_string (spec_len, fnspec)); + tmp = tree_cons (get_identifier ("fn spec"), tmp, TYPE_ATTRIBUTES (type)); + type = build_type_attribute_variant (type, tmp); + } + else + type = create_fn_spec (sym, type); return type; } diff --git a/gcc/fortran/trans-types.h b/gcc/fortran/trans-types.h index 56074f1b83b..1b59287996b 100644 --- a/gcc/fortran/trans-types.h +++ b/gcc/fortran/trans-types.h @@ -88,7 +88,8 @@ tree gfc_sym_type (gfc_symbol *); tree gfc_typenode_for_spec (gfc_typespec *, int c = 0); int gfc_copy_dt_decls_ifequal (gfc_symbol *, gfc_symbol *, bool); -tree gfc_get_function_type (gfc_symbol *, gfc_actual_arglist *args = NULL); +tree gfc_get_function_type (gfc_symbol *, gfc_actual_arglist *args = NULL, + const char *fnspec = NULL); tree gfc_type_for_size (unsigned, int); tree gfc_type_for_mode (machine_mode, int); diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 16b4215605e..6e417c43e8c 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -608,7 +608,8 @@ tree gfc_get_label_decl (gfc_st_label *); /* Return the decl for an external function. */ tree gfc_get_extern_function_decl (gfc_symbol *, - gfc_actual_arglist *args = NULL); + gfc_actual_arglist *args = NULL, + const char *fnspec = NULL); /* Return the decl for a function. */ tree gfc_get_function_decl (gfc_symbol *);