From: Tobias Schlüter Date: Tue, 29 Jun 2004 18:01:04 +0000 (+0200) Subject: Andrew Vaught X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=c95430028cde0571e4408ab54b8ce0e8dd469e26;p=gcc.git Andrew Vaught 2004-06-29 Tobias Schlueter Andrew Vaught * gfortran.h (gfc_gsymbol): New typedef. (gfc_gsym_root): New variable. (gfc_get_gsymbol, gfc_find_gsym): New prototypes. * parse.c (global_used): New function. (parse_block_data): Check for double empty BLOCK DATA, use global symbol table. (parse_module): Use global symbol table. (add_global_procedure, add_global_program): New functions. (gfc_parse_file): Use global symbol table. * symbol.c (gfc_gsym_root): New variable. (gfc_find_gsym, gsym_compare, gfc_get_gsymbol): New functions. Co-Authored-By: Andrew Vaught From-SVN: r83868 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index e3df360f717..b50d944a65a 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,19 @@ +2004-06-29 Tobias Schlueter + Andrew Vaught + + * gfortran.h (gfc_gsymbol): New typedef. + (gfc_gsym_root): New variable. + (gfc_get_gsymbol, gfc_find_gsym): New prototypes. + * parse.c (global_used): New function. + (parse_block_data): Check for double empty BLOCK DATA, + use global symbol table. + (parse_module): Use global symbol table. + (add_global_procedure, add_global_program): New functions. + (gfc_parse_file): Use global symbol table. + * symbol.c (gfc_gsym_root): New variable. + (gfc_find_gsym, gsym_compare, gfc_get_gsymbol): New + functions. + 2004-06-29 Tobias Schlueter * module.c (mio_gmp_real): Correct writing of negative numbers. diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index d9107dd32cd..bfd52e4b656 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -720,6 +720,24 @@ gfc_namespace; extern gfc_namespace *gfc_current_ns; +/* Global symbols are symbols of global scope. Currently we only use + this to detect collisions already when parsing. + TODO: Extend to verify procedure calls. */ + +typedef struct gfc_gsymbol +{ + BBT_HEADER(gfc_gsymbol); + + char name[GFC_MAX_SYMBOL_LEN+1]; + enum { GSYM_UNKNOWN=1, GSYM_PROGRAM, GSYM_FUNCTION, GSYM_SUBROUTINE, + GSYM_MODULE, GSYM_COMMON, GSYM_BLOCK_DATA } type; + + int defined, used; + locus where; +} +gfc_gsymbol; + +extern gfc_gsymbol *gfc_gsym_root; /* Information on interfaces being built. */ typedef struct @@ -1490,6 +1508,9 @@ 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 *); + /* intrinsic.c */ extern int gfc_init_expr; diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 3983db71650..812df4d8401 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -2319,12 +2319,79 @@ done: } +/* Come here to complain about a global symbol already in use as + something else. */ + +static void +global_used (gfc_gsymbol *sym, locus *where) +{ + const char *name; + + if (where == NULL) + where = &gfc_current_locus; + + switch(sym->type) + { + case GSYM_PROGRAM: + name = "PROGRAM"; + break; + case GSYM_FUNCTION: + name = "FUNCTION"; + break; + case GSYM_SUBROUTINE: + name = "SUBROUTINE"; + break; + case GSYM_COMMON: + name = "COMMON"; + break; + case GSYM_BLOCK_DATA: + name = "BLOCK DATA"; + break; + case GSYM_MODULE: + name = "MODULE"; + break; + default: + gfc_internal_error ("gfc_gsymbol_type(): Bad type"); + name = NULL; + } + + gfc_error("Global name '%s' at %L is already being used as a %s at %L", + gfc_new_block->name, where, name, &sym->where); +} + + /* Parse a block data program unit. */ static void parse_block_data (void) { gfc_statement st; + static locus blank_locus; + static int blank_block=0; + gfc_gsymbol *s; + + if (gfc_new_block == NULL) + { + if (blank_block) + gfc_error ("Blank BLOCK DATA at %C conflicts with " + "prior BLOCK DATA at %L", &blank_locus); + else + { + blank_block = 1; + blank_locus = gfc_current_locus; + } + } + else + { + s = gfc_get_gsymbol (gfc_new_block->name); + if (s->type != GSYM_UNKNOWN) + global_used(s, NULL); + else + { + s->type = GSYM_BLOCK_DATA; + s->where = gfc_current_locus; + } + } st = parse_spec (ST_NONE); @@ -2344,6 +2411,16 @@ static void parse_module (void) { gfc_statement st; + gfc_gsymbol *s; + + s = gfc_get_gsymbol (gfc_new_block->name); + if (s->type != GSYM_UNKNOWN) + global_used(s, NULL); + else + { + s->type = GSYM_MODULE; + s->where = gfc_current_locus; + } st = parse_spec (ST_NONE); @@ -2372,6 +2449,46 @@ loop: } +/* Add a procedure name to the global symbol table. */ + +static void +add_global_procedure (int sub) +{ + gfc_gsymbol *s; + + s = gfc_get_gsymbol(gfc_new_block->name); + + if (s->type != GSYM_UNKNOWN) + global_used(s, NULL); + else + { + s->type = sub ? GSYM_SUBROUTINE : GSYM_FUNCTION; + s->where = gfc_current_locus; + } +} + + +/* Add a program to the global symbol table. */ + +static void +add_global_program (void) +{ + gfc_gsymbol *s; + + if (gfc_new_block == NULL) + return; + s = gfc_get_gsymbol (gfc_new_block->name); + + if (s->type != GSYM_UNKNOWN) + global_used(s, NULL); + else + { + s->type = GSYM_PROGRAM; + s->where = gfc_current_locus; + } +} + + /* Top level parser. */ try @@ -2415,16 +2532,19 @@ loop: push_state (&s, COMP_PROGRAM, gfc_new_block); accept_statement (st); + add_global_program (); parse_progunit (ST_NONE); break; case ST_SUBROUTINE: + add_global_procedure (1); push_state (&s, COMP_SUBROUTINE, gfc_new_block); accept_statement (st); parse_progunit (ST_NONE); break; case ST_FUNCTION: + add_global_procedure (0); push_state (&s, COMP_FUNCTION, gfc_new_block); accept_statement (st); parse_progunit (ST_NONE); diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 6cdd23b4542..4b5f34e6d2d 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -88,6 +88,8 @@ static int next_dummy_order = 1; gfc_namespace *gfc_current_ns; +gfc_gsymbol *gfc_gsym_root = NULL; + static gfc_symbol *changed_syms = NULL; @@ -2419,3 +2421,63 @@ gfc_symbol_state(void) { } #endif + +/************** Global symbol handling ************/ + + +/* Search a tree for the global symbol. */ + +gfc_gsymbol * +gfc_find_gsymbol (gfc_gsymbol *symbol, char *name) +{ + gfc_gsymbol *s; + + if (symbol == NULL) + return NULL; + if (strcmp (symbol->name, name) == 0) + return symbol; + + s = gfc_find_gsymbol (symbol->left, name); + if (s != NULL) + return s; + + s = gfc_find_gsymbol (symbol->right, name); + if (s != NULL) + return s; + + return NULL; +} + + +/* Compare two global symbols. Used for managing the BB tree. */ + +static int +gsym_compare (void * _s1, void * _s2) +{ + gfc_gsymbol *s1, *s2; + + s1 = (gfc_gsymbol *)_s1; + s2 = (gfc_gsymbol *)_s2; + return strcmp(s1->name, s2->name); +} + + +/* Get a global symbol, creating it if it doesn't exist. */ + +gfc_gsymbol * +gfc_get_gsymbol (char *name) +{ + gfc_gsymbol *s; + + s = gfc_find_gsymbol (gfc_gsym_root, name); + if (s != NULL) + return s; + + s = gfc_getmem (sizeof (gfc_gsymbol)); + s->type = GSYM_UNKNOWN; + strcpy (s->name, name); + + gfc_insert_bbt (&gfc_gsym_root, s, gsym_compare); + + return s; +}