From patchwork Sun Nov 7 16:16:34 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Mikael Morin X-Patchwork-Id: 1551982 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: bilbo.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=OzNufJ7m; dkim-atps=neutral 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+incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) 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 bilbo.ozlabs.org (Postfix) with ESMTPS id 4HnKKD44sjz9sPf for ; Mon, 8 Nov 2021 03:22:39 +1100 (AEDT) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id A6714385781F for ; Sun, 7 Nov 2021 16:22:36 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org A6714385781F DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1636302156; bh=TIKaYeKQlJtPGytzJVVB8c7RsPU3CT2jMKSPxbzqnyY=; h=To:Subject:Date:In-Reply-To:References:List-Id:List-Unsubscribe: List-Archive:List-Post:List-Help:List-Subscribe:From:Reply-To: From; b=OzNufJ7mtSYuvmjxrKyzmFdBX/Fdz1m3+GYqcR6k/1S6a8vPcu6uOCJNH9nmDk5QM SbPeBbZmQHGkPlzTuJ2l+a2EuDmjJmWy7pluHssLRhf8Bxp7cfjv4PYWeqhA/ChEgC 1eO94oa1TryXEDhAy6S52+PESSgwaDwuUPFMICHA= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from smtp.smtpout.orange.fr (smtp09.smtpout.orange.fr [80.12.242.131]) by sourceware.org (Postfix) with ESMTPS id 52E49385842E for ; Sun, 7 Nov 2021 16:16:44 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 52E49385842E Received: from cyrano.home ([92.167.144.168]) by smtp.orange.fr with ESMTPA id jkqTmFEb9E8xTjkqZm8cr6; Sun, 07 Nov 2021 17:16:43 +0100 X-ME-Helo: cyrano.home X-ME-Auth: MDU4MTIxYWM4YWI0ZGE4ZTUwZWZmNTExZmI2ZWZlMThkM2ZhYiE5OWRkOGM= X-ME-Date: Sun, 07 Nov 2021 17:16:43 +0100 X-ME-IP: 92.167.144.168 To: fortran@gcc.gnu.org, gcc-patches@gcc.gnu.org Subject: [PATCH v3 3/5] fortran: simplify elemental arguments walking Date: Sun, 7 Nov 2021 17:16:34 +0100 Message-Id: <20211107161636.1167116-4-mikael@gcc.gnu.org> X-Mailer: git-send-email 2.33.0 In-Reply-To: <20211107161636.1167116-1-mikael@gcc.gnu.org> References: <20211107161636.1167116-1-mikael@gcc.gnu.org> MIME-Version: 1.0 X-Spam-Status: No, score=-12.4 required=5.0 tests=BAYES_00, GIT_PATCH_0, JMQ_SPF_NEUTRAL, KAM_DMARC_STATUS, RCVD_IN_DNSWL_NONE, RCVD_IN_MSPIKE_H2, SPF_HELO_NONE, SPF_NEUTRAL, TXREP autolearn=unavailable autolearn_force=no version=3.4.4 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) 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: Mikael Morin via Gcc-patches From: Mikael Morin Reply-To: Mikael Morin Errors-To: gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org Sender: "Gcc-patches" This adds two functions working with the wrapper struct gfc_dummy_arg and makes usage of them to simplify a bit the walking of elemental procedure arguments for scalarization. As information about dummy arguments can be obtained from the actual argument through the just-introduced associated_dummy field, there is no need to carry around the procedure interface and walk dummy arguments manually together with actual arguments. gcc/fortran/ChangeLog: * interface.c (gfc_dummy_arg_get_typespec, gfc_dummy_arg_is_optional): New functions. * gfortran.h (gfc_dummy_arg_get_typespec, gfc_dummy_arg_is_optional): Declare them. * trans.h (gfc_ss_info::dummy_arg): Use the wrapper type as declaration type. * trans-array.c (gfc_scalar_elemental_arg_saved_as_reference): use gfc_dummy_arg_get_typespec function to get the type. (gfc_walk_elemental_function_args): Remove proc_ifc argument. Get info about the dummy arg using the associated_dummy field. * trans-array.h (gfc_walk_elemental_function_args): Update declaration. * trans-intrinsic.c (gfc_walk_intrinsic_function): Update call to gfc_walk_elemental_function_args. * trans-stmt.c (gfc_trans_call): Ditto. (get_proc_ifc_for_call): Remove. --- gcc/fortran/gfortran.h | 4 ++++ gcc/fortran/interface.c | 34 ++++++++++++++++++++++++++++++++++ gcc/fortran/trans-array.c | 19 ++++++------------- gcc/fortran/trans-array.h | 2 +- gcc/fortran/trans-intrinsic.c | 2 +- gcc/fortran/trans-stmt.c | 22 ---------------------- gcc/fortran/trans.h | 4 ++-- 7 files changed, 48 insertions(+), 39 deletions(-) diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index d678c6b56dc..7e76e482b98 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -2333,6 +2333,10 @@ struct gfc_dummy_arg #define gfc_get_dummy_arg() XCNEW (gfc_dummy_arg) +const gfc_typespec & gfc_dummy_arg_get_typespec (gfc_dummy_arg &); +bool gfc_dummy_arg_is_optional (gfc_dummy_arg &); + + /* Specifies the various kinds of check functions used to verify the argument lists of intrinsic functions. fX with X an integer refer to check functions of intrinsics with X arguments. f1m is used for diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index c4ec0d89a58..db0b3b01b8c 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -5503,3 +5503,37 @@ gfc_get_formal_from_actual_arglist (gfc_symbol *sym, f = &((*f)->next); } } + + +const gfc_typespec & +gfc_dummy_arg_get_typespec (gfc_dummy_arg & dummy_arg) +{ + switch (dummy_arg.intrinsicness) + { + case GFC_INTRINSIC_DUMMY_ARG: + return dummy_arg.u.intrinsic->ts; + + case GFC_NON_INTRINSIC_DUMMY_ARG: + return dummy_arg.u.non_intrinsic->sym->ts; + + default: + gcc_unreachable (); + } +} + + +bool +gfc_dummy_arg_is_optional (gfc_dummy_arg & dummy_arg) +{ + switch (dummy_arg.intrinsicness) + { + case GFC_INTRINSIC_DUMMY_ARG: + return dummy_arg.u.intrinsic->optional; + + case GFC_NON_INTRINSIC_DUMMY_ARG: + return dummy_arg.u.non_intrinsic->sym->attr.optional; + + default: + gcc_unreachable (); + } +} diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 79321854498..d37c1e7ad7f 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -3010,7 +3010,8 @@ gfc_scalar_elemental_arg_saved_as_reference (gfc_ss_info * ss_info) /* If the expression is of polymorphic type, it's actual size is not known, so we avoid copying it anywhere. */ if (ss_info->data.scalar.dummy_arg - && ss_info->data.scalar.dummy_arg->ts.type == BT_CLASS + && gfc_dummy_arg_get_typespec (*ss_info->data.scalar.dummy_arg).type + == BT_CLASS && ss_info->expr->ts.type == BT_CLASS) return true; @@ -11521,9 +11522,8 @@ arg_evaluated_for_scalarization (gfc_intrinsic_sym *function, gfc_ss * gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg, gfc_intrinsic_sym *intrinsic_sym, - gfc_symbol *proc_ifc, gfc_ss_type type) + gfc_ss_type type) { - gfc_formal_arglist *dummy_arg; int scalar; gfc_ss *head; gfc_ss *tail; @@ -11532,15 +11532,11 @@ gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg, head = gfc_ss_terminator; tail = NULL; - if (proc_ifc) - dummy_arg = gfc_sym_get_dummy_args (proc_ifc); - else - dummy_arg = NULL; - int arg_num = 0; scalar = 1; for (; arg; arg = arg->next) { + gfc_dummy_arg * const dummy_arg = arg->associated_dummy; if (!arg->expr || arg->expr->expr_type == EXPR_NULL || !arg_evaluated_for_scalarization (intrinsic_sym, *arg, arg_num)) @@ -11554,13 +11550,13 @@ gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg, newss = gfc_get_scalar_ss (head, arg->expr); newss->info->type = type; if (dummy_arg) - newss->info->data.scalar.dummy_arg = dummy_arg->sym; + newss->info->data.scalar.dummy_arg = dummy_arg; } else scalar = 0; if (dummy_arg != NULL - && dummy_arg->sym->attr.optional + && gfc_dummy_arg_is_optional (*dummy_arg) && arg->expr->expr_type == EXPR_VARIABLE && (gfc_expr_attr (arg->expr).optional || gfc_expr_attr (arg->expr).allocatable @@ -11577,8 +11573,6 @@ gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg, loop_continue: arg_num++; - if (dummy_arg != NULL) - dummy_arg = dummy_arg->next; } if (scalar) @@ -11638,7 +11632,6 @@ gfc_walk_function_expr (gfc_ss * ss, gfc_expr * expr) ss = gfc_walk_elemental_function_args (old_ss, expr->value.function.actual, gfc_get_intrinsic_for_expr (expr), - gfc_get_proc_ifc_for_expr (expr), GFC_SS_REFERENCE); if (ss != old_ss && (comp diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h index 8f806c32f80..9c4bd06d414 100644 --- a/gcc/fortran/trans-array.h +++ b/gcc/fortran/trans-array.h @@ -87,7 +87,7 @@ gfc_ss *gfc_walk_array_ref (gfc_ss *, gfc_expr *, gfc_ref * ref); /* Walk the arguments of an elemental function. */ gfc_ss *gfc_walk_elemental_function_args (gfc_ss *, gfc_actual_arglist *, gfc_intrinsic_sym *, - gfc_symbol *, gfc_ss_type); + gfc_ss_type); /* Walk an intrinsic function. */ gfc_ss *gfc_walk_intrinsic_function (gfc_ss *, gfc_expr *, gfc_intrinsic_sym *); diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 3f867911af5..c1b51f4da26 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -11085,7 +11085,7 @@ gfc_walk_intrinsic_function (gfc_ss * ss, gfc_expr * expr, if (isym->elemental) return gfc_walk_elemental_function_args (ss, expr->value.function.actual, expr->value.function.isym, - NULL, GFC_SS_SCALAR); + GFC_SS_SCALAR); if (expr->rank == 0) return ss; diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index bdf7957c4a0..1fc6d3adda5 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -375,27 +375,6 @@ get_intrinsic_for_code (gfc_code *code) } -/* Get the interface symbol for the procedure corresponding to the given call. - We can't get the procedure symbol directly as we have to handle the case - of (deferred) type-bound procedures. */ - -static gfc_symbol * -get_proc_ifc_for_call (gfc_code *c) -{ - gfc_symbol *sym; - - gcc_assert (c->op == EXEC_ASSIGN_CALL || c->op == EXEC_CALL); - - sym = gfc_get_proc_ifc_for_expr (c->expr1); - - /* Fall back/last resort try. */ - if (sym == NULL) - sym = c->resolved_sym; - - return sym; -} - - /* Translate the CALL statement. Builds a call to an F95 subroutine. */ tree @@ -422,7 +401,6 @@ gfc_trans_call (gfc_code * code, bool dependency_check, if (code->resolved_sym->attr.elemental) ss = gfc_walk_elemental_function_args (ss, code->ext.actual, get_intrinsic_for_code (code), - get_proc_ifc_for_call (code), GFC_SS_REFERENCE); /* MVBITS is inlined but needs the dependency checking found here. */ diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 0d4eed20d20..15012a336ff 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -266,8 +266,8 @@ typedef struct gfc_ss_info struct { /* If the scalar is passed as actual argument to an (elemental) procedure, - this is the symbol of the corresponding dummy argument. */ - gfc_symbol *dummy_arg; + this is the corresponding dummy argument. */ + gfc_dummy_arg *dummy_arg; tree value; /* Tells that the scalar is a reference to a variable that might be present on the lhs, so that we should evaluate the value