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