From 4f0fae8eaaf1c34db1c4d9fa1577768a145d35f8 Mon Sep 17 00:00:00 2001 From: tobi Date: Thu, 24 Feb 2005 18:26:27 +0000 Subject: [PATCH] Unrevert previously reversed patch, adding this patch: * module.c (find_true_name): Deal with NULL module. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@95506 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/check.c | 4 +-- gcc/fortran/dump-parse-tree.c | 2 +- gcc/fortran/gfortran.h | 20 ++++++------ gcc/fortran/interface.c | 7 ++-- gcc/fortran/intrinsic.c | 30 +++++++++-------- gcc/fortran/intrinsic.h | 4 +-- gcc/fortran/module.c | 76 ++++++++++++++++++++++++++++++------------- gcc/fortran/primary.c | 4 +-- gcc/fortran/symbol.c | 16 ++++----- gcc/fortran/trans-array.c | 2 +- gcc/fortran/trans-decl.c | 12 +++---- gcc/fortran/trans-io.c | 5 +-- 12 files changed, 108 insertions(+), 74 deletions(-) diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index 7986c968f9b..7a971f20038 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -1214,7 +1214,7 @@ gfc_check_minloc_maxloc (gfc_actual_arglist * ap) m = ap->next->next->expr; if (m == NULL && d != NULL && d->ts.type == BT_LOGICAL - && ap->next->name[0] == '\0') + && ap->next->name == NULL) { m = d; d = NULL; @@ -1259,7 +1259,7 @@ check_reduction (gfc_actual_arglist * ap) m = ap->next->next->expr; if (m == NULL && d != NULL && d->ts.type == BT_LOGICAL - && ap->next->name[0] == '\0') + && ap->next->name == NULL) { m = d; d = NULL; diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c index e60b4c082de..f8df9dabb12 100644 --- a/gcc/fortran/dump-parse-tree.c +++ b/gcc/fortran/dump-parse-tree.c @@ -106,7 +106,7 @@ gfc_show_actual_arglist (gfc_actual_arglist * a) for (; a; a = a->next) { gfc_status_char ('('); - if (a->name[0] != '\0') + if (a->name != NULL) gfc_status ("%s = ", a->name); if (a->expr != NULL) gfc_show_expr (a->expr); diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index eb24cba4a8b..adbccc11486 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -540,7 +540,7 @@ gfc_array_spec; /* Components of derived types. */ typedef struct gfc_component { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name; gfc_typespec ts; int pointer, dimension; @@ -571,7 +571,7 @@ gfc_formal_arglist; /* The gfc_actual_arglist structure is for actual arguments. */ typedef struct gfc_actual_arglist { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name; /* Alternate return label when the expr member is null. */ struct gfc_st_label *label; @@ -636,7 +636,7 @@ gfc_interface; /* User operator nodes. These are like stripped down symbols. */ typedef struct { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name; gfc_interface *operator; struct gfc_namespace *ns; @@ -652,8 +652,8 @@ gfc_user_op; typedef struct gfc_symbol { - char name[GFC_MAX_SYMBOL_LEN + 1]; /* Primary name, before renaming */ - char module[GFC_MAX_SYMBOL_LEN + 1]; /* Module this symbol came from */ + const char *name; /* Primary name, before renaming */ + const char *module; /* Module this symbol came from */ locus declared_at; gfc_typespec ts; @@ -744,7 +744,7 @@ gfc_entry_list; typedef struct gfc_symtree { BBT_HEADER (gfc_symtree); - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name; int ambiguous; union { @@ -1003,7 +1003,7 @@ gfc_resolve_f; typedef struct gfc_intrinsic_sym { - char name[GFC_MAX_SYMBOL_LEN + 1], lib_name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name, *lib_name; gfc_intrinsic_arg *formal; gfc_typespec ts; int elemental, pure, generic, specific, actual_ok, standard; @@ -1654,8 +1654,8 @@ void gfc_save_all (gfc_namespace *); void gfc_symbol_state (void); -gfc_gsymbol *gfc_get_gsymbol (char *); -gfc_gsymbol *gfc_find_gsymbol (gfc_gsymbol *, char *); +gfc_gsymbol *gfc_get_gsymbol (const char *); +gfc_gsymbol *gfc_find_gsymbol (gfc_gsymbol *, const char *); /* intrinsic.c */ extern int gfc_init_expr; @@ -1664,7 +1664,7 @@ extern int gfc_init_expr; by placing it into a special module that is otherwise impossible to read or write. */ -#define gfc_intrinsic_symbol(SYM) strcpy (SYM->module, "(intrinsic)") +#define gfc_intrinsic_symbol(SYM) SYM->module = gfc_get_string ("(intrinsic)") void gfc_intrinsic_init_1 (void); void gfc_intrinsic_done_1 (void); diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 9f163d0efd2..ecbf9a27aac 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -340,8 +340,9 @@ gfc_compare_types (gfc_typespec * ts1, gfc_typespec * ts2) true names and module names are the same and the module name is nonnull, then they are equal. */ if (strcmp (ts1->derived->name, ts2->derived->name) == 0 - && ts1->derived->module[0] != '\0' - && strcmp (ts1->derived->module, ts2->derived->module) == 0) + && ((ts1->derived->module == NULL && ts2->derived->module == NULL) + || (ts1->derived != NULL && ts2->derived != NULL + && strcmp (ts1->derived->module, ts2->derived->module) == 0))) return 1; /* Compare type via the rules of the standard. Both types must have @@ -1165,7 +1166,7 @@ compare_actual_formal (gfc_actual_arglist ** ap, for (a = actual; a; a = a->next, f = f->next) { - if (a->name[0] != '\0') + if (a->name != NULL) { i = 0; for (f = formal; f; f = f->next, i++) diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index f9642c78ac8..ebf5cb2edda 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -37,7 +37,8 @@ int gfc_init_expr = 0; /* Pointers to an intrinsic function and its argument names that are being checked. */ -char *gfc_current_intrinsic, *gfc_current_intrinsic_arg[MAX_INTRINSIC_ARGS]; +const char *gfc_current_intrinsic; +const char *gfc_current_intrinsic_arg[MAX_INTRINSIC_ARGS]; locus *gfc_current_intrinsic_where; static gfc_intrinsic_sym *functions, *subroutines, *conversion, *next_sym; @@ -107,7 +108,7 @@ gfc_get_intrinsic_sub_symbol (const char * name) /* Return a pointer to the name of a conversion function given two typespecs. */ -static char * +static const char * conv_name (gfc_typespec * from, gfc_typespec * to) { static char name[30]; @@ -115,7 +116,7 @@ conv_name (gfc_typespec * from, gfc_typespec * to) sprintf (name, "__convert_%c%d_%c%d", gfc_type_letter (from->type), from->kind, gfc_type_letter (to->type), to->kind); - return name; + return gfc_get_string (name); } @@ -127,7 +128,7 @@ static gfc_intrinsic_sym * find_conv (gfc_typespec * from, gfc_typespec * to) { gfc_intrinsic_sym *sym; - char *target; + const char *target; int i; target = conv_name (from, to); @@ -213,7 +214,7 @@ add_sym (const char *name, int elemental, int actual_ok ATTRIBUTE_UNUSED, bt type, int kind, int standard, gfc_check_f check, gfc_simplify_f simplify, gfc_resolve_f resolve, ...) { - + char buf[GFC_MAX_SYMBOL_LEN + 11]; /* 10 for '_gfortran_', 1 for '\0' */ int optional, first_flag; va_list argp; @@ -233,10 +234,11 @@ add_sym (const char *name, int elemental, int actual_ok ATTRIBUTE_UNUSED, break; case SZ_NOTHING: - strcpy (next_sym->name, name); + next_sym->name = gfc_get_string (name); - strcpy (next_sym->lib_name, "_gfortran_"); - strcat (next_sym->lib_name, name); + strcpy (buf, "_gfortran_"); + strcat (buf, name); + next_sym->lib_name = gfc_get_string (buf); next_sym->elemental = elemental; next_sym->ts.type = type; @@ -785,11 +787,11 @@ make_generic (const char *name, gfc_generic_isym_id generic_id, int standard) g->generic = 1; g->specific = 1; g->generic_id = generic_id; - if ((g + 1)->name[0] != '\0') + if ((g + 1)->name != NULL) g->specific_head = g + 1; g++; - while (g->name[0] != '\0') + while (g->name != NULL) { g->next = g + 1; g->specific = 1; @@ -828,7 +830,7 @@ make_alias (const char *name, int standard) case SZ_NOTHING: next_sym[0] = next_sym[-1]; - strcpy (next_sym->name, name); + next_sym->name = gfc_get_string (name); next_sym++; break; @@ -2152,8 +2154,8 @@ add_conv (bt from_type, int from_kind, bt to_type, int to_kind, sym = conversion + nconv; - strcpy (sym->name, conv_name (&from, &to)); - strcpy (sym->lib_name, sym->name); + sym->name = conv_name (&from, &to); + sym->lib_name = sym->name; sym->simplify.cc = simplify; sym->elemental = 1; sym->ts = to; @@ -2359,7 +2361,7 @@ sort_actual (const char *name, gfc_actual_arglist ** ap, if (a == NULL) goto optional; - if (a->name[0] != '\0') + if (a->name != NULL) goto keywords; f->actual = a; diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h index 0c4472afd73..3f5fcba3736 100644 --- a/gcc/fortran/intrinsic.h +++ b/gcc/fortran/intrinsic.h @@ -368,6 +368,6 @@ void gfc_resolve_unlink_sub (gfc_code *); #define MAX_INTRINSIC_ARGS 5 -extern char *gfc_current_intrinsic, - *gfc_current_intrinsic_arg[MAX_INTRINSIC_ARGS]; +extern const char *gfc_current_intrinsic; +extern const char *gfc_current_intrinsic_arg[MAX_INTRINSIC_ARGS]; extern locus *gfc_current_intrinsic_where; diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index 8df1b9adf63..4b69b738db1 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -655,7 +655,8 @@ compare_true_names (void * _t1, void * _t2) t1 = (true_name *) _t1; t2 = (true_name *) _t2; - c = strcmp (t1->sym->module, t2->sym->module); + c = ((t1->sym->module > t2->sym->module) + - (t1->sym->module < t2->sym->module)); if (c != 0) return c; @@ -673,8 +674,11 @@ find_true_name (const char *name, const char *module) gfc_symbol sym; int c; - strcpy (sym.name, name); - strcpy (sym.module, module); + sym.name = gfc_get_string (name); + if (module != NULL) + sym.module = gfc_get_string (module); + else + sym.module = NULL; t.sym = &sym; p = true_name_root; @@ -1341,8 +1345,33 @@ mio_allocated_string (const char *s) } -/* Read or write a string that is in static memory or inside of some - already-allocated structure. */ +/* Read or write a string that is in static memory. */ + +static void +mio_pool_string (const char **stringp) +{ + /* TODO: one could write the string only once, and refer to it via a + fixup pointer. */ + + /* As a special case we have to deal with a NULL string. This + happens for the 'module' member of 'gfc_symbol's that are not in a + module. We read / write these as the empty string. */ + if (iomode == IO_OUTPUT) + { + const char *p = *stringp == NULL ? "" : *stringp; + write_atom (ATOM_STRING, p); + } + else + { + require_atom (ATOM_STRING); + *stringp = atom_string[0] == '\0' ? NULL : gfc_get_string (atom_string); + gfc_free (atom_string); + } +} + + +/* Read or write a string that is inside of some already-allocated + structure. */ static void mio_internal_string (char *string) @@ -1802,7 +1831,7 @@ mio_component_ref (gfc_component ** cp, gfc_symbol * sym) p->type = P_COMPONENT; if (iomode == IO_OUTPUT) - mio_internal_string ((*cp)->name); + mio_pool_string (&(*cp)->name); else { mio_internal_string (name); @@ -1851,7 +1880,7 @@ mio_component (gfc_component * c) if (p->type == P_UNKNOWN) p->type = P_COMPONENT; - mio_internal_string (c->name); + mio_pool_string (&c->name); mio_typespec (&c->ts); mio_array_spec (&c->as); @@ -1907,7 +1936,7 @@ mio_actual_arg (gfc_actual_arglist * a) { mio_lparen (); - mio_internal_string (a->name); + mio_pool_string (&a->name); mio_expr (&a->expr); mio_rparen (); } @@ -2599,14 +2628,14 @@ mio_interface (gfc_interface ** ip) /* Save/restore a named operator interface. */ static void -mio_symbol_interface (char *name, char *module, +mio_symbol_interface (const char **name, const char **module, gfc_interface ** ip) { mio_lparen (); - mio_internal_string (name); - mio_internal_string (module); + mio_pool_string (name); + mio_pool_string (module); mio_interface_rest (ip); } @@ -2884,7 +2913,7 @@ load_needed (pointer_info * p) } sym = gfc_new_symbol (p->u.rsym.true_name, ns); - strcpy (sym->module, p->u.rsym.module); + sym->module = gfc_get_string (p->u.rsym.module); associate_integer_pointer (p, sym); } @@ -3037,7 +3066,7 @@ read_module (void) sym = info->u.rsym.sym = gfc_new_symbol (info->u.rsym.true_name, gfc_current_ns); - strcpy (sym->module, info->u.rsym.module); + sym->module = gfc_get_string (info->u.rsym.module); } st->n.sym = sym; @@ -3170,7 +3199,7 @@ write_common (gfc_symtree *st) write_common(st->right); mio_lparen(); - mio_internal_string(st->name); + mio_pool_string(&st->name); p = st->n.common; mio_symbol_ref(&p->head); @@ -3190,9 +3219,9 @@ write_symbol (int n, gfc_symbol * sym) gfc_internal_error ("write_symbol(): bad module symbol '%s'", sym->name); mio_integer (&n); - mio_internal_string (sym->name); + mio_pool_string (&sym->name); - mio_internal_string (sym->module); + mio_pool_string (&sym->module); mio_pointer_ref (&sym->ns); mio_symbol (sym); @@ -3217,8 +3246,8 @@ write_symbol0 (gfc_symtree * st) write_symbol0 (st->right); sym = st->n.sym; - if (sym->module[0] == '\0') - strcpy (sym->module, module_name); + if (sym->module == NULL) + sym->module = gfc_get_string (module_name); if (sym->attr.flavor == FL_PROCEDURE && sym->attr.generic && !sym->attr.subroutine && !sym->attr.function) @@ -3265,8 +3294,8 @@ write_symbol1 (pointer_info * p) /* FIXME: This shouldn't be necessary, but it works around deficiencies in the module loader or/and symbol handling. */ - if (p->u.wsym.sym->module[0] == '\0' && p->u.wsym.sym->attr.dummy) - strcpy (p->u.wsym.sym->module, module_name); + if (p->u.wsym.sym->module == NULL && p->u.wsym.sym->attr.dummy) + p->u.wsym.sym->module = gfc_get_string (module_name); p->u.wsym.state = WRITTEN; write_symbol (p->integer, p->u.wsym.sym); @@ -3281,12 +3310,13 @@ static void write_operator (gfc_user_op * uop) { static char nullstring[] = ""; + const char *p = nullstring; if (uop->operator == NULL || !gfc_check_access (uop->access, uop->ns->default_access)) return; - mio_symbol_interface (uop->name, nullstring, &uop->operator); + mio_symbol_interface (&uop->name, &p, &uop->operator); } @@ -3300,7 +3330,7 @@ write_generic (gfc_symbol * sym) || !gfc_check_access (sym->attr.access, sym->ns->default_access)) return; - mio_symbol_interface (sym->name, sym->module, &sym->generic); + mio_symbol_interface (&sym->name, &sym->module, &sym->generic); } @@ -3323,7 +3353,7 @@ write_symtree (gfc_symtree * st) if (p == NULL) gfc_internal_error ("write_symtree(): Symbol not written"); - mio_internal_string (st->name); + mio_pool_string (&st->name); mio_integer (&st->ambiguous); mio_integer (&p->integer); } diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index f122779b136..f3c51ab4675 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -1273,7 +1273,7 @@ match_keyword_arg (gfc_actual_arglist * actual, gfc_actual_arglist * base) if (name[0] != '\0') { for (a = base; a; a = a->next) - if (strcmp (a->name, name) == 0) + if (a->name != NULL && strcmp (a->name, name) == 0) { gfc_error ("Keyword '%s' at %C has already appeared in the current " @@ -1282,7 +1282,7 @@ match_keyword_arg (gfc_actual_arglist * actual, gfc_actual_arglist * base) } } - strcpy (actual->name, name); + actual->name = gfc_get_string (name); return MATCH_YES; cleanup: diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 77d3f1a3a2d..0b5e8e727a4 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -1157,7 +1157,7 @@ gfc_add_component (gfc_symbol * sym, const char *name, gfc_component ** componen else tail->next = p; - strcpy (p->name, name); + p->name = gfc_get_string (name); p->loc = gfc_current_locus; *component = p; @@ -1613,7 +1613,7 @@ gfc_new_symtree (gfc_symtree ** root, const char *name) gfc_symtree *st; st = gfc_getmem (sizeof (gfc_symtree)); - strcpy (st->name, name); + st->name = gfc_get_string (name); gfc_insert_bbt (root, st, compare_symtree); return st; @@ -1629,7 +1629,7 @@ delete_symtree (gfc_symtree ** root, const char *name) st0 = gfc_find_symtree (*root, name); - strcpy (st.name, name); + st.name = gfc_get_string (name); gfc_delete_bbt (root, &st, compare_symtree); gfc_free (st0); @@ -1674,7 +1674,7 @@ gfc_get_uop (const char *name) st = gfc_new_symtree (&gfc_current_ns->uop_root, name); uop = st->n.uop = gfc_getmem (sizeof (gfc_user_op)); - strcpy (uop->name, name); + uop->name = gfc_get_string (name); uop->access = ACCESS_UNKNOWN; uop->ns = gfc_current_ns; @@ -1743,7 +1743,7 @@ gfc_new_symbol (const char *name, gfc_namespace * ns) if (strlen (name) > GFC_MAX_SYMBOL_LEN) gfc_internal_error ("new_symbol(): Symbol name too long"); - strcpy (p->name, name); + p->name = gfc_get_string (name); return p; } @@ -1754,7 +1754,7 @@ static void ambiguous_symbol (const char *name, gfc_symtree * st) { - if (st->n.sym->module[0]) + if (st->n.sym->module) gfc_error ("Name '%s' at %C is an ambiguous reference to '%s' " "from module '%s'", name, st->n.sym->name, st->n.sym->module); else @@ -2362,7 +2362,7 @@ gfc_symbol_state(void) { /* Search a tree for the global symbol. */ gfc_gsymbol * -gfc_find_gsymbol (gfc_gsymbol *symbol, char *name) +gfc_find_gsymbol (gfc_gsymbol *symbol, const char *name) { gfc_gsymbol *s; @@ -2399,7 +2399,7 @@ gsym_compare (void * _s1, void * _s2) /* Get a global symbol, creating it if it doesn't exist. */ gfc_gsymbol * -gfc_get_gsymbol (char *name) +gfc_get_gsymbol (const char *name) { gfc_gsymbol *s; diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 985abd47836..2ed83e65089 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -3071,7 +3071,7 @@ gfc_trans_auto_array_allocation (tree decl, gfc_symbol * sym, tree fnbody) gcc_assert (!sym->attr.use_assoc); gcc_assert (!TREE_STATIC (decl)); - gcc_assert (!sym->module[0]); + gcc_assert (!sym->module); if (sym->ts.type == BT_CHARACTER && !INTEGER_CST_P (sym->ts.cl->backend_decl)) diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 6567695ad29..b81b9862207 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -272,7 +272,7 @@ gfc_sym_mangled_identifier (gfc_symbol * sym) { char name[GFC_MAX_MANGLED_SYMBOL_LEN + 1]; - if (sym->module[0] == 0) + if (sym->module == NULL) return gfc_sym_identifier (sym); else { @@ -290,8 +290,8 @@ gfc_sym_mangled_function_id (gfc_symbol * sym) int has_underscore; char name[GFC_MAX_MANGLED_SYMBOL_LEN + 1]; - if (sym->module[0] == 0 || sym->attr.proc == PROC_EXTERNAL - || (sym->module[0] != 0 && sym->attr.if_source == IFSRC_IFBODY)) + if (sym->module == NULL || sym->attr.proc == PROC_EXTERNAL + || (sym->module != NULL && sym->attr.if_source == IFSRC_IFBODY)) { if (strcmp (sym->name, "MAIN__") == 0 || sym->attr.proc == PROC_INTRINSIC) @@ -404,7 +404,7 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym) DECL_EXTERNAL (decl) = 1; TREE_PUBLIC (decl) = 1; } - else if (sym->module[0] && !sym->attr.result && !sym->attr.dummy) + else if (sym->module && !sym->attr.result && !sym->attr.dummy) { /* TODO: Don't set sym->module for result or dummy variables. */ gcc_assert (current_function_decl == NULL_TREE); @@ -766,7 +766,7 @@ gfc_get_symbol_decl (gfc_symbol * sym) /* Symbols from modules should have their assembler names mangled. This is done here rather than in gfc_finish_var_decl because it is different for string length variables. */ - if (sym->module[0]) + if (sym->module) SET_DECL_ASSEMBLER_NAME (decl, gfc_sym_mangled_identifier (sym)); if (sym->attr.dimension) @@ -808,7 +808,7 @@ gfc_get_symbol_decl (gfc_symbol * sym) { char name[GFC_MAX_MANGLED_SYMBOL_LEN + 2]; - if (sym->module[0]) + if (sym->module) { /* Also prefix the mangled name for symbols from modules. */ strcpy (&name[1], sym->name); diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c index b5ef13f5e16..26f05f1e9fb 100644 --- a/gcc/fortran/trans-io.c +++ b/gcc/fortran/trans-io.c @@ -816,7 +816,7 @@ gfc_trans_inquire (gfc_code * code) static gfc_expr * -gfc_new_nml_name_expr (char * name) +gfc_new_nml_name_expr (const char * name) { gfc_expr * nml_name; nml_name = gfc_get_expr(); @@ -825,7 +825,8 @@ gfc_new_nml_name_expr (char * name) nml_name->ts.kind = gfc_default_character_kind; nml_name->ts.type = BT_CHARACTER; nml_name->value.character.length = strlen(name); - nml_name->value.character.string = name; + nml_name->value.character.string = gfc_getmem (strlen (name) + 1); + strcpy (nml_name->value.character.string, name); return nml_name; } -- 2.11.0