From patchwork Sun Nov 7 16:16:32 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Mikael Morin X-Patchwork-Id: 47184 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 96C2A3857C65 for ; Sun, 7 Nov 2021 16:17:13 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 96C2A3857C65 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1636301833; bh=HJIbpJU7cOQpIKG/5wjjX4/ie0BX7tV5hDFdFKAUyeE=; 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=uLywzalLVIT3VFbxjxDtUxhNHkdIEOQ40H+ZWImW6dVwbOlU8imitmyrOcaL/U0m8 iafLyo6yMcWcGIZTpNWhVb8F2em2/EgF4zwnrFB+xcHme4L7rfCXH4K0sNkOjeTFF+ H0MP/GjCTYyisZ2bkS+oLdslcIZqnEIaDIaPOsjw= 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 16C6C3858406 for ; Sun, 7 Nov 2021 16:16:43 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 16C6C3858406 Received: from cyrano.home ([92.167.144.168]) by smtp.orange.fr with ESMTPA id jkqTmFEb9E8xTjkqYm8cqy; 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 1/5] fortran: Tiny sort_actual internal refactoring Date: Sun, 7 Nov 2021 17:16:32 +0100 Message-Id: <20211107161636.1167116-2-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=-10.2 required=5.0 tests=BAYES_40, GIT_PATCH_0, JMQ_SPF_NEUTRAL, KAM_DMARC_STATUS, RCVD_IN_DNSWL_NONE, RCVD_IN_MSPIKE_H2, SPF_HELO_NONE, SPF_NEUTRAL, TXREP autolearn=ham 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+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" Preliminary refactoring to make further changes more obvious. No functional change. gcc/fortran/ChangeLog: * intrinsic.c (sort_actual): initialise variable and use it earlier. --- gcc/fortran/intrinsic.c | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index a6a18a471e3..49ef3b2a3d2 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -4378,19 +4378,18 @@ do_sort: for (f = formal; f; f = f->next) { - if (f->actual && f->actual->label != NULL && f->ts.type) + a = f->actual; + if (a && a->label != NULL && f->ts.type) { gfc_error ("ALTERNATE RETURN not permitted at %L", where); return false; } - if (f->actual == NULL) + if (a == NULL) { a = gfc_get_actual_arglist (); a->missing_arg_type = f->ts.type; } - else - a = f->actual; if (actual == NULL) *ap = a; From patchwork Sun Nov 7 16:16:33 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Mikael Morin X-Patchwork-Id: 47186 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 557083858421 for ; Sun, 7 Nov 2021 16:19:57 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 557083858421 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1636301997; bh=lReLctmTiIc3NhV31aQ3XOww78B4jAWBGMH1bO+SoGI=; 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=y2tlb78kLCYxlfXIJHZgH/MCJU07j2fVqgZ9Tf5d50TNkHJS5tPhuppwgtpaFHjbd NldOzHP/HLE1iGsGw48HCMAsTYsxSi97LiydtpVWCOxONsFp7F1N2m95C5GzkeSLBi N8R1kZXJLw/bA23r/1F7Li3gaaK8vYqQq4mCnwVE= 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 1F45D3858429 for ; Sun, 7 Nov 2021 16:16:43 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 1F45D3858429 Received: from cyrano.home ([92.167.144.168]) by smtp.orange.fr with ESMTPA id jkqTmFEb9E8xTjkqZm8cr1; 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 2/5] fortran: Reverse actual vs dummy argument mapping Date: Sun, 7 Nov 2021 17:16:33 +0100 Message-Id: <20211107161636.1167116-3-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.5 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+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" There was originally no way from an actual argument to get to the corresponding dummy argument, even if the job of sorting and matching actual with dummy arguments was done. The closest was a field named actual in gfc_intrinsic_arg that was used as scratch data when sorting arguments of one specific call. However that value was overwritten later on as arguments of another call to the same procedure were sorted and matched. This change removes that field from gfc_intrinsic_arg and adds instead a new field associated_dummy in gfc_actual_arglist. The new field has as type a new wrapper struct gfc_dummy_arg that provides a common interface to both dummy arguments of user-defined procedures (which have type gfc_formal_arglist) and dummy arguments of intrinsic procedures (which have type gfc_intrinsic_arg). As the removed field was used in the code sorting and matching arguments, that code has to be updated. Two local vectors with matching indices are introduced for respectively dummy and actual arguments, and the loops are modified to use indices and update those argument vectors. gcc/fortran/ChangeLog: * gfortran.h (gfc_dummy_arg_kind, gfc_dummy_arg): New. (gfc_actual_arglist): New field associated_dummy. (gfc_intrinsic_arg): Remove field actual. * interface.c (get_nonintrinsic_dummy_arg): New. (gfc_compare_actual): Initialize associated_dummy. * intrinsic.c (get_intrinsic_dummy_arg): New. (sort_actual):  Add argument vectors. Use loops with indices on argument vectors. Initialize associated_dummy. --- gcc/fortran/gfortran.h | 31 +++++++++++++++++++++++++++-- gcc/fortran/interface.c | 21 ++++++++++++++++++-- gcc/fortran/intrinsic.c | 43 ++++++++++++++++++++++++++++++----------- 3 files changed, 80 insertions(+), 15 deletions(-) diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 8c11cf6d18d..d678c6b56dc 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1199,6 +1199,9 @@ gfc_formal_arglist; #define gfc_get_formal_arglist() XCNEW (gfc_formal_arglist) +struct gfc_dummy_arg; + + /* The gfc_actual_arglist structure is for actual arguments and for type parameter specification lists. */ typedef struct gfc_actual_arglist @@ -1215,6 +1218,11 @@ typedef struct gfc_actual_arglist gfc_param_spec_type spec_type; struct gfc_expr *expr; + + /* The dummy arg this actual arg is associated with, if the interface + is explicit. NULL otherwise. */ + gfc_dummy_arg *associated_dummy; + struct gfc_actual_arglist *next; } gfc_actual_arglist; @@ -2298,14 +2306,33 @@ typedef struct gfc_intrinsic_arg gfc_typespec ts; unsigned optional:1, value:1; ENUM_BITFIELD (sym_intent) intent:2; - gfc_actual_arglist *actual; struct gfc_intrinsic_arg *next; - } gfc_intrinsic_arg; +typedef enum { + GFC_UNDEFINED_DUMMY_ARG = 0, + GFC_INTRINSIC_DUMMY_ARG, + GFC_NON_INTRINSIC_DUMMY_ARG +} +gfc_dummy_arg_intrinsicness; + +/* dummy arg of either an intrinsic or a user-defined procedure. */ +struct gfc_dummy_arg +{ + gfc_dummy_arg_intrinsicness intrinsicness; + + union { + gfc_intrinsic_arg *intrinsic; + gfc_formal_arglist *non_intrinsic; + } u; +}; + +#define gfc_get_dummy_arg() XCNEW (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 24698be8364..c4ec0d89a58 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -3043,6 +3043,18 @@ lookup_arg_fuzzy (const char *arg, gfc_formal_arglist *arguments) } +static gfc_dummy_arg * +get_nonintrinsic_dummy_arg (gfc_formal_arglist *formal) +{ + gfc_dummy_arg * const dummy_arg = gfc_get_dummy_arg (); + + dummy_arg->intrinsicness = GFC_NON_INTRINSIC_DUMMY_ARG; + dummy_arg->u.non_intrinsic = formal; + + return dummy_arg; +} + + /* Given formal and actual argument lists, see if they are compatible. If they are compatible, the actual argument list is sorted to correspond with the formal list, and elements for missing optional @@ -3150,6 +3162,8 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, "call at %L", where); return false; } + else + a->associated_dummy = get_nonintrinsic_dummy_arg (f); if (a->expr == NULL) { @@ -3646,9 +3660,12 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, /* The argument lists are compatible. We now relink a new actual argument list with null arguments in the right places. The head of the list remains the head. */ - for (i = 0; i < n; i++) + for (f = formal, i = 0; f; f = f->next, i++) if (new_arg[i] == NULL) - new_arg[i] = gfc_get_actual_arglist (); + { + new_arg[i] = gfc_get_actual_arglist (); + new_arg[i]->associated_dummy = get_nonintrinsic_dummy_arg (f); + } if (na != 0) { diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index 49ef3b2a3d2..f6d061a847c 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -4236,6 +4236,18 @@ remove_nullargs (gfc_actual_arglist **ap) } +static gfc_dummy_arg * +get_intrinsic_dummy_arg (gfc_intrinsic_arg *intrinsic) +{ + gfc_dummy_arg * const dummy_arg = gfc_get_dummy_arg (); + + dummy_arg->intrinsicness = GFC_INTRINSIC_DUMMY_ARG; + dummy_arg->u.intrinsic = intrinsic; + + return dummy_arg; +} + + /* Given an actual arglist and a formal arglist, sort the actual arglist so that its arguments are in a one-to-one correspondence with the format arglist. Arguments that are not present are given @@ -4253,8 +4265,14 @@ sort_actual (const char *name, gfc_actual_arglist **ap, remove_nullargs (ap); actual = *ap; + auto_vec dummy_args; + auto_vec ordered_actual_args; + for (f = formal; f; f = f->next) - f->actual = NULL; + dummy_args.safe_push (f); + + ordered_actual_args.safe_grow_cleared (dummy_args.length (), + /* exact = */true); f = formal; a = actual; @@ -4306,7 +4324,7 @@ sort_actual (const char *name, gfc_actual_arglist **ap, } } - for (;;) + for (int i = 0;; i++) { /* Put the nonkeyword arguments in a 1:1 correspondence */ if (f == NULL) break; @@ -4316,7 +4334,7 @@ sort_actual (const char *name, gfc_actual_arglist **ap, if (a->name != NULL) goto keywords; - f->actual = a; + ordered_actual_args[i] = a; f = f->next; a = a->next; @@ -4334,7 +4352,8 @@ keywords: to be keyword arguments. */ for (; a; a = a->next) { - for (f = formal; f; f = f->next) + int idx; + FOR_EACH_VEC_ELT (dummy_args, idx, f) if (strcmp (a->name, f->name) == 0) break; @@ -4349,21 +4368,21 @@ keywords: return false; } - if (f->actual != NULL) + if (ordered_actual_args[idx] != NULL) { gfc_error ("Argument %qs appears twice in call to %qs at %L", f->name, name, where); return false; } - - f->actual = a; + ordered_actual_args[idx] = a; } optional: /* At this point, all unmatched formal args must be optional. */ - for (f = formal; f; f = f->next) + int idx; + FOR_EACH_VEC_ELT (dummy_args, idx, f) { - if (f->actual == NULL && f->optional == 0) + if (ordered_actual_args[idx] == NULL && f->optional == 0) { gfc_error ("Missing actual argument %qs in call to %qs at %L", f->name, name, where); @@ -4376,9 +4395,9 @@ do_sort: together in a way that corresponds with the formal list. */ actual = NULL; - for (f = formal; f; f = f->next) + FOR_EACH_VEC_ELT (dummy_args, idx, f) { - a = f->actual; + a = ordered_actual_args[idx]; if (a && a->label != NULL && f->ts.type) { gfc_error ("ALTERNATE RETURN not permitted at %L", where); @@ -4391,6 +4410,8 @@ do_sort: a->missing_arg_type = f->ts.type; } + a->associated_dummy = get_intrinsic_dummy_arg (f); + if (actual == NULL) *ap = a; else 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: 47188 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id C4D833858038 for ; Sun, 7 Nov 2021 16:22:24 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org C4D833858038 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1636302144; 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=NOXCvs3bjCIXUPlGQDSlO0cv4oxkmwFztINxttEHn+L8Ko4ur8rHW7hRhJ8k0EhjW yVDczeOOID6TLHaviR74u2lc0iD6DBOQ1JOB8M8+vYc2Lmpxn0YIUCa7SBjUrjugEv jwM5Xi9v6Bp5mzYlLA8j6qpMIDk3MJ9zp1l7L3Pc= 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+patchwork=sourceware.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 From patchwork Sun Nov 7 16:16:35 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Mikael Morin X-Patchwork-Id: 47187 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 962E53858034 for ; Sun, 7 Nov 2021 16:21:27 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 962E53858034 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1636302087; bh=ohVz/foObt5kTfRPO5/0qyhvyndIDP4QHFHdVnWomUc=; 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=LWfjDeCxrPDtx0yfp4G6sHgNibh2Z0pZpi4vLXD+k7DjKw3zow7U+I1flvpdUiUZU cMXwOzP+bEvGQxzypM8LAeM3rXgIJp2hLVCJpY0Tp0yEI+3RRpXHu2EZkRHjd07OLd FhKPwkJ/dMa//O7XN42S3UrHI/IOPUlXAfChd+AE= 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 8077E385843B for ; Sun, 7 Nov 2021 16:16:44 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 8077E385843B Received: from cyrano.home ([92.167.144.168]) by smtp.orange.fr with ESMTPA id jkqTmFEb9E8xTjkqZm8cr8; 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 4/5] fortran: Delete redundant missing_arg_type field Date: Sun, 7 Nov 2021 17:16:35 +0100 Message-Id: <20211107161636.1167116-5-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=ham 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+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" Now that we can get information about an actual arg's associated dummy using the associated_dummy attribute, the field missing_arg_type contains redundant information. This removes it. gcc/fortran/ChangeLog: * gfortran.h (gfc_actual_arglist::missing_arg_type): Remove. * interface.c (gfc_compare_actual_formal): Remove missing_arg_type initialization. * intrinsic.c (sort_actual): Ditto. * trans-expr.c (gfc_conv_procedure_call): Use associated_dummy and gfc_dummy_arg_get_typespec to get the dummy argument type. --- gcc/fortran/gfortran.h | 5 ----- gcc/fortran/interface.c | 5 ----- gcc/fortran/intrinsic.c | 5 +---- gcc/fortran/trans-expr.c | 9 +++++++-- 4 files changed, 8 insertions(+), 16 deletions(-) diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 7e76e482b98..4879805ff0b 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1210,11 +1210,6 @@ typedef struct gfc_actual_arglist /* Alternate return label when the expr member is null. */ struct gfc_st_label *label; - /* This is set to the type of an eventual omitted optional - argument. This is used to determine if a hidden string length - argument has to be added to a function call. */ - bt missing_arg_type; - gfc_param_spec_type spec_type; struct gfc_expr *expr; diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index db0b3b01b8c..36b7a852066 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -3681,11 +3681,6 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, if (*ap == NULL && n > 0) *ap = new_arg[0]; - /* Note the types of omitted optional arguments. */ - for (a = *ap, f = formal; a; a = a->next, f = f->next) - if (a->expr == NULL && a->label == NULL) - a->missing_arg_type = f->sym->ts.type; - return true; } diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index f6d061a847c..3018315ed78 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -4405,10 +4405,7 @@ do_sort: } if (a == NULL) - { - a = gfc_get_actual_arglist (); - a->missing_arg_type = f->ts.type; - } + a = gfc_get_actual_arglist (); a->associated_dummy = get_intrinsic_dummy_arg (f); diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index e7aec3845d3..bc502c0f43c 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -6157,7 +6157,10 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, { /* Pass a NULL pointer for an absent arg. */ parmse.expr = null_pointer_node; - if (arg->missing_arg_type == BT_CHARACTER) + gfc_dummy_arg * const dummy_arg = arg->associated_dummy; + if (dummy_arg + && gfc_dummy_arg_get_typespec (*dummy_arg).type + == BT_CHARACTER) parmse.string_length = build_int_cst (gfc_charlen_type_node, 0); } @@ -6174,7 +6177,9 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, || !CLASS_DATA (fsym)->attr.allocatable)); gfc_init_se (&parmse, NULL); parmse.expr = null_pointer_node; - if (arg->missing_arg_type == BT_CHARACTER) + if (arg->associated_dummy + && gfc_dummy_arg_get_typespec (*arg->associated_dummy).type + == BT_CHARACTER) parmse.string_length = build_int_cst (gfc_charlen_type_node, 0); } else if (fsym && fsym->ts.type == BT_CLASS From patchwork Sun Nov 7 16:16:36 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Mikael Morin X-Patchwork-Id: 47192 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 2790B385800C for ; Sun, 7 Nov 2021 16:27:34 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 2790B385800C DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1636302454; bh=X1LfBBt4k5giqGoWFa+E4q6ZFB3B4bA+9vWhkJoOkbY=; 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=yLT/Egj7ZRPNNlEefaF9ZY4bk30FDEn1ZLNlCz4pPd9q8gor5KQImBw6MQXuGh18f Ty+PG+Lv2lNaqrJrFreMEkk5c2SBCgF6qu8SBoC3zd8CiJo3WSd2LQOLcohTD/TI6E e7AKKbfJJQmY3j7krMxbhwQzgdwi3BtSD4Hz0A5Y= 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 ESMTP id 6D48F3857C47 for ; Sun, 7 Nov 2021 16:24:13 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 6D48F3857C47 Received: from cyrano.home ([92.167.144.168]) by smtp.orange.fr with ESMTPA id jkqTmFEb9E8xTjkqZm8crB; 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 5/5] fortran: Identify arguments by their names Date: Sun, 7 Nov 2021 17:16:36 +0100 Message-Id: <20211107161636.1167116-6-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=-11.0 required=5.0 tests=BAYES_00, GIT_PATCH_0, JMQ_SPF_NEUTRAL, KAM_DMARC_STATUS, KAM_STOCKGEN, RCVD_IN_DNSWL_NONE, RCVD_IN_MSPIKE_H2, SPF_HELO_NONE, SPF_NEUTRAL, TXREP autolearn=ham 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+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" This provides a new function to get the name of a dummy argument, so that identifying an argument can be made using just its name instead of a mix of name matching (for keyword actual arguments) and argument counting (for other actual arguments). gcc/fortran/ChangeLog: * interface.c (gfc_dummy_arg_get_name): New function. * gfortran.h (gfc_dummy_arg_get_name): Declare it. * trans-array.c (arg_evaluated_for_scalarization): Pass a dummy argument wrapper as argument instead of an actual argument and an index number. Check it’s non-NULL. Use its name to identify it. (gfc_walk_elemental_function_args): Update call to arg_evaluated for scalarization. Remove argument counting. --- gcc/fortran/gfortran.h | 1 + gcc/fortran/interface.c | 17 +++++++++++++++++ gcc/fortran/trans-array.c | 16 +++++----------- 3 files changed, 23 insertions(+), 11 deletions(-) diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 4879805ff0b..ac4b3a8b6d4 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -2328,6 +2328,7 @@ struct gfc_dummy_arg #define gfc_get_dummy_arg() XCNEW (gfc_dummy_arg) +const char * gfc_dummy_arg_get_name (gfc_dummy_arg &); const gfc_typespec & gfc_dummy_arg_get_typespec (gfc_dummy_arg &); bool gfc_dummy_arg_is_optional (gfc_dummy_arg &); diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 36b7a852066..d87088f988d 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -5500,6 +5500,23 @@ gfc_get_formal_from_actual_arglist (gfc_symbol *sym, } +const char * +gfc_dummy_arg_get_name (gfc_dummy_arg & dummy_arg) +{ + switch (dummy_arg.intrinsicness) + { + case GFC_INTRINSIC_DUMMY_ARG: + return dummy_arg.u.intrinsic->name; + + case GFC_NON_INTRINSIC_DUMMY_ARG: + return dummy_arg.u.non_intrinsic->sym->name; + + default: + gcc_unreachable (); + } +} + + const gfc_typespec & gfc_dummy_arg_get_typespec (gfc_dummy_arg & dummy_arg) { diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index d37c1e7ad7f..2090adf01e7 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -11492,16 +11492,14 @@ gfc_get_intrinsic_for_expr (gfc_expr *call) static bool arg_evaluated_for_scalarization (gfc_intrinsic_sym *function, - gfc_actual_arglist &actual_arg, int arg_num) + gfc_dummy_arg *dummy_arg) { - if (function != NULL) + if (function != NULL && dummy_arg != NULL) { switch (function->id) { case GFC_ISYM_INDEX: - if ((actual_arg.name == NULL && arg_num == 3) - || (actual_arg.name != NULL - && strcmp ("kind", actual_arg.name) == 0)) + if (strcmp ("kind", gfc_dummy_arg_get_name (*dummy_arg)) == 0) return false; /* Fallthrough. */ @@ -11532,15 +11530,14 @@ gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg, head = gfc_ss_terminator; tail = 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)) - goto loop_continue; + || !arg_evaluated_for_scalarization (intrinsic_sym, dummy_arg)) + continue; newss = gfc_walk_subexpr (head, arg->expr); if (newss == head) @@ -11570,9 +11567,6 @@ gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg, while (tail->next != gfc_ss_terminator) tail = tail->next; } - -loop_continue: - arg_num++; } if (scalar)