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(-)
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;
}
