FreeChainXenon/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Andrew Vaught <andyv@firstinter.net>

Browse source 
2004-06-29  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
Andrew Vaught  <andyv@firstinter.net>

* 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 <andyv@firstinter.net>

From-SVN: r83868
This commit is contained in:
Tobias Schlüter 2004-06-29 20:01:04 +02:00 • committed by Tobias Schlüter
parent 9c5fdae633
commit c95430028c
4 changed files with 219 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

16
gcc/fortran/ChangeLog
View file

@ -1,3 +1,19 @@
2004-06-29 Tobias Schlueter <tobias.schlueter@physik.uni-muenchen.de>
Andrew Vaught <andyv@firstinter.net>
* 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 <tobias.schlueter@physik.uni-muenchen.de>
* module.c (mio_gmp_real): Correct writing of negative numbers.

21
gcc/fortran/gfortran.h
View file

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

120
gcc/fortran/parse.c
View file

@ -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);

62
gcc/fortran/symbol.c
View file

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