Andrew Vaught <andyv@firstinter.net>

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

1 files changed, 62 insertions, 0 deletions

diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 6cdd23b..4b5f34e 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;
+}