From patchwork Thu Aug 5 16:26:10 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Mikael Morin X-Patchwork-Id: 1514017 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+incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) 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=Yu4x1ojl; 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 4GgZ263vh9z9sCD for ; Fri, 6 Aug 2021 02:34:22 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 4E56C3969032 for ; Thu, 5 Aug 2021 16:34:20 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 4E56C3969032 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1628181260; bh=1qOZyazB8sGd/okxWfUmtc59dDMN8PWqC3LA2rfH50Y=; h=To:Subject:Date:In-Reply-To:References:List-Id:List-Unsubscribe: List-Archive:List-Post:List-Help:List-Subscribe:From:Reply-To:Cc: From; b=Yu4x1ojlA4+8X+65TwwLPXnrb64QybgTsuKZIYf6sVdfBSclV9jRr7qIybHQL7BAS ZTjRJ44u+kClZebgoXsrGKGUgMF4hbFN1z5OGCxAOi3BYZLvACGedmHRLidYqxhSk7 a4ZdP7D0LmtjjvOuFZPR2haBrBqPcB3TmqN5T2uA= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from smtp.smtpout.orange.fr (smtp04.smtpout.orange.fr [80.12.242.126]) by sourceware.org (Postfix) with ESMTPS id B98703992CAE for ; Thu, 5 Aug 2021 16:26:21 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org B98703992CAE Received: from cyrano.home ([92.167.144.168]) by mwinf5d08 with ME id dsSE2500R3eCq5G03sSLYr; Thu, 05 Aug 2021 18:26:20 +0200 X-ME-Helo: cyrano.home X-ME-Auth: bW9yaW4tbWlrYWVsQG9yYW5nZS5mcg== X-ME-Date: Thu, 05 Aug 2021 18:26:20 +0200 X-ME-IP: 92.167.144.168 To: fortran@gcc.gnu.org Subject: [PATCH v2 3/7] fortran: Reverse actual vs dummy argument mapping Date: Thu, 5 Aug 2021 18:26:10 +0200 Message-Id: <20210805162614.647806-4-mikael@gcc.gnu.org> X-Mailer: git-send-email 2.30.2 In-Reply-To: <20210805162614.647806-1-mikael@gcc.gnu.org> References: <20210805162614.647806-1-mikael@gcc.gnu.org> MIME-Version: 1.0 X-Spam-Status: No, score=-12.8 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 Cc: gcc-patches@gcc.gnu.org Errors-To: gcc-patches-bounces+incoming=patchwork.ozlabs.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 and adds instead a new field associated_dummy in gfc_actual_arglist. This field uses the just introduced gfc_dummy_arg interface, which makes it usable with both external and intrinsic procedure dummy arguments. 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/ * gfortran.h (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 | 11 ++++++++++- gcc/fortran/interface.c | 21 ++++++++++++++++++-- gcc/fortran/intrinsic.c | 43 ++++++++++++++++++++++++++++++----------- 3 files changed, 61 insertions(+), 14 deletions(-) diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 55ac4a80549..c890d80bce0 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1144,6 +1144,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 @@ -1160,6 +1163,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; @@ -2166,7 +2174,6 @@ 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; } @@ -2191,6 +2198,8 @@ struct gfc_dummy_arg } 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 diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 9e3e8aa9da9..dba167559d1 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -3026,6 +3026,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->kind = 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 @@ -3131,6 +3143,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) { @@ -3546,9 +3560,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 ffeaf2841b7..c42891e7e1a 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -4269,6 +4269,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->kind = 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 @@ -4286,8 +4298,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; @@ -4339,7 +4357,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; @@ -4349,7 +4367,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; @@ -4367,7 +4385,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; @@ -4382,21 +4401,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); @@ -4409,9 +4428,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); @@ -4424,6 +4443,8 @@ do_sort: a->missing_arg_type = f->ts.type; } + a->associated_dummy = get_intrinsic_dummy_arg (f); + if (actual == NULL) *ap = a; else