From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from smtp.smtpout.orange.fr (smtp06.smtpout.orange.fr [80.12.242.128]) by sourceware.org (Postfix) with ESMTPS id C065F395BC11 for ; Tue, 3 Aug 2021 15:39:52 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org C065F395BC11 Received: from cyrano.home ([92.167.144.168]) by mwinf5d37 with ME id d3fl250063eCq5G033frDU; Tue, 03 Aug 2021 17:39:51 +0200 X-ME-Helo: cyrano.home X-ME-Auth: bW9yaW4tbWlrYWVsQG9yYW5nZS5mcg== X-ME-Date: Tue, 03 Aug 2021 17:39:51 +0200 X-ME-IP: 92.167.144.168 From: Mikael Morin To: fortran@gcc.gnu.org, gcc-patches@gcc.gnu.org, Mikael Morin Subject: [PATCH 1/7] fortran: new abstract class gfc_dummy_arg Date: Tue, 3 Aug 2021 17:39:39 +0200 Message-Id: <20210803153945.1309734-2-mikael@gcc.gnu.org> X-Mailer: git-send-email 2.30.2 In-Reply-To: <20210803153945.1309734-1-mikael@gcc.gnu.org> References: <20210803153945.1309734-1-mikael@gcc.gnu.org> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="------------2.30.2" Content-Transfer-Encoding: 8bit X-Spam-Status: No, score=-9.3 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: fortran@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Fortran mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Tue, 03 Aug 2021 15:39:55 -0000 This is a multi-part message in MIME format. --------------2.30.2 Content-Type: text/plain; charset=UTF-8; format=fixed Content-Transfer-Encoding: 8bit Introduce a new abstract class 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). gcc/fortran/ * gfortran.h (gfc_dummy_arg): New. (gfc_formal_arglist, gfc_intrinsic_arg): Inherit gfc_dummy_arg. (gfc_get_formal_arglist, gfc_get_intrinsic_arg): Call constructor. * intrinsic.c (gfc_intrinsic_init_1): Merge the memory area of conversion intrinsics with that of regular function and subroutine intrinsics. Use a separate memory area for arguments. (add_sym, gfc_intrinsic_init_1): Don’t do pointer arithmetics with next_arg. (add_sym, make_alias, add_conv, add_char_conversions, gfc_intrinsic_init_1): Call constructor before filling object data. * resolve.c (resolve_select_type): Same. --- gcc/fortran/gfortran.h | 22 ++++++++++++++------- gcc/fortran/intrinsic.c | 44 ++++++++++++++++++++++------------------- gcc/fortran/resolve.c | 10 ++++++---- 3 files changed, 45 insertions(+), 31 deletions(-) --------------2.30.2 Content-Type: text/x-patch; name="0001-fortran-new-abstract-class-gfc_dummy_arg.patch" Content-Transfer-Encoding: 8bit Content-Disposition: inline; filename="0001-fortran-new-abstract-class-gfc_dummy_arg.patch" diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 921aed93dc3..031e46d1457 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1131,17 +1131,25 @@ gfc_component; #define gfc_get_component() XCNEW (gfc_component) + +/* dummy arg of either an intrinsic or a user-defined procedure. */ +class gfc_dummy_arg +{ +}; + + /* Formal argument lists are lists of symbols. */ -typedef struct gfc_formal_arglist +struct gfc_formal_arglist : public gfc_dummy_arg { /* Symbol representing the argument at this position in the arglist. */ struct gfc_symbol *sym; /* Points to the next formal argument. */ struct gfc_formal_arglist *next; -} -gfc_formal_arglist; +}; + +#define GFC_NEW(T) new (XCNEW (T)) T -#define gfc_get_formal_arglist() XCNEW (gfc_formal_arglist) +#define gfc_get_formal_arglist() GFC_NEW (gfc_formal_arglist) /* The gfc_actual_arglist structure is for actual arguments and @@ -2159,7 +2167,7 @@ gfc_ref; /* Structures representing intrinsic symbols and their arguments lists. */ -typedef struct gfc_intrinsic_arg +struct gfc_intrinsic_arg : public gfc_dummy_arg { char name[GFC_MAX_SYMBOL_LEN + 1]; @@ -2169,9 +2177,9 @@ typedef struct gfc_intrinsic_arg gfc_actual_arglist *actual; struct gfc_intrinsic_arg *next; +}; -} -gfc_intrinsic_arg; +#define gfc_get_intrinsic_arg() GFC_NEW (gfc_intrinsic_arg) /* Specifies the various kinds of check functions used to verify the diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index 219f04f2317..ba79eb3242b 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -376,6 +376,7 @@ add_sym (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type break; case SZ_NOTHING: + next_sym = new (next_sym) gfc_intrinsic_sym; next_sym->name = gfc_get_string ("%s", name); strcpy (buf, "_gfortran_"); @@ -406,6 +407,7 @@ add_sym (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type va_start (argp, resolve); first_flag = 1; + gfc_intrinsic_arg * previous_arg; for (;;) { @@ -422,12 +424,12 @@ add_sym (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type nargs++; else { - next_arg++; + next_arg = new (next_arg) gfc_intrinsic_arg; if (first_flag) next_sym->formal = next_arg; else - (next_arg - 1)->next = next_arg; + previous_arg->next = next_arg; first_flag = 0; @@ -437,6 +439,9 @@ add_sym (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type next_arg->optional = optional; next_arg->value = 0; next_arg->intent = intent; + + previous_arg = next_arg; + next_arg++; } } @@ -1270,6 +1275,7 @@ make_alias (const char *name, int standard) break; case SZ_NOTHING: + next_sym = new (next_sym) gfc_intrinsic_sym; next_sym[0] = next_sym[-1]; next_sym->name = gfc_get_string ("%s", name); next_sym->standard = standard; @@ -3991,7 +3997,7 @@ add_conv (bt from_type, int from_kind, bt to_type, int to_kind, int standard) to.type = to_type; to.kind = to_kind; - sym = conversion + nconv; + sym = new (conversion + nconv) gfc_intrinsic_sym; sym->name = conv_name (&from, &to); sym->lib_name = sym->name; @@ -4167,15 +4173,17 @@ add_char_conversions (void) to.type = BT_CHARACTER; to.kind = gfc_character_kinds[j].kind; - char_conversions[n].name = conv_name (&from, &to); - char_conversions[n].lib_name = char_conversions[n].name; - char_conversions[n].simplify.cc = gfc_convert_char_constant; - char_conversions[n].standard = GFC_STD_F2003; - char_conversions[n].elemental = 1; - char_conversions[n].pure = 1; - char_conversions[n].conversion = 0; - char_conversions[n].ts = to; - char_conversions[n].id = GFC_ISYM_CONVERSION; + gfc_intrinsic_sym *current_conv; + current_conv = new (&char_conversions[n]) gfc_intrinsic_sym; + current_conv->name = conv_name (&from, &to); + current_conv->lib_name = char_conversions[n].name; + current_conv->simplify.cc = gfc_convert_char_constant; + current_conv->standard = GFC_STD_F2003; + current_conv->elemental = 1; + current_conv->pure = 1; + current_conv->conversion = 0; + current_conv->ts = to; + current_conv->id = GFC_ISYM_CONVERSION; n++; } @@ -4198,16 +4206,13 @@ gfc_intrinsic_init_1 (void) sizing = SZ_CONVS; add_conversions (); - functions = XCNEWVAR (struct gfc_intrinsic_sym, - sizeof (gfc_intrinsic_sym) * (nfunc + nsub) - + sizeof (gfc_intrinsic_arg) * nargs); + next_sym = XCNEWVEC (struct gfc_intrinsic_sym, nfunc + nsub + nconv); - next_sym = functions; + functions = next_sym; subroutines = functions + nfunc; + conversion = subroutines + nsub; - conversion = XCNEWVEC (gfc_intrinsic_sym, nconv); - - next_arg = ((gfc_intrinsic_arg *) (subroutines + nsub)) - 1; + next_arg = XCNEWVEC (gfc_intrinsic_arg, nargs); sizing = SZ_NOTHING; nconv = 0; @@ -4225,7 +4230,6 @@ void gfc_intrinsic_done_1 (void) { free (functions); - free (conversion); free (char_conversions); gfc_free_namespace (gfc_intrinsic_namespace); } diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 45c3ad387ac..8f13582e4b4 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -9676,10 +9676,12 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns) new_st->expr1->value.function.actual->next->expr = gfc_get_variable_expr (st); new_st->expr1->value.function.actual->next->expr->where = code->loc; /* Set up types in formal arg list. */ - new_st->expr1->value.function.isym->formal = XCNEW (gfc_intrinsic_arg); - new_st->expr1->value.function.isym->formal->ts = new_st->expr1->value.function.actual->expr->ts; - new_st->expr1->value.function.isym->formal->next = XCNEW (gfc_intrinsic_arg); - new_st->expr1->value.function.isym->formal->next->ts = new_st->expr1->value.function.actual->next->expr->ts; + gfc_intrinsic_sym *e1_isym = new_st->expr1->value.function.isym; + gfc_actual_arglist *e1_actual = new_st->expr1->value.function.actual; + e1_isym->formal = gfc_get_intrinsic_arg (); + e1_isym->formal->ts = e1_actual->expr->ts; + e1_isym->formal->next = gfc_get_intrinsic_arg (); + e1_isym->formal->next->ts = e1_actual->next->expr->ts; new_st->next = body->next; } --------------2.30.2--