Make the Fortran front-end use garbage collection:

	* com.c (ffecom_init_0): Make double_ftype_double,
	float_ftype_float, ldouble_ftype_ldouble,
	ffecom_tree_ptr_to_fun_type_void local.
	(tracker_head): New static variable.
	(mark_tracker_head): New, marker procedure for tracker_head.
	(ffecom_save_tree_forever): New procedure.
	(ffecom_init_zero_): Remove obstack use.
	(ffecom_make_gfrt_): Remove obstack use.
	(ffecom_sym_transform_): Remove obstack use, save appropriate trees.
	(ffecom_transform_common_): Remove obstack use, save appropriate
	trees.
	(ffecom_type_namelist_): Remove obstack use, save appropriate
	trees.
	(ffecom_type_vardesc_): Remove obstack use, save appropriate trees.
	(ffecom_lookup_label): Remove obstack use, save appropriate trees.
	(duplicate_decls): Remove obstack use.
	(finish_function): push & pop ggc context around
	rest_of_compilation when building nested function.
	(mark_binding_level): New function.
	(init_decl_processing): Mark all the GC roots.
	(ggc_p): Set to 1.
	(lang_mark_tree): New function.
	(lang_mark_false_label_stack): New trivial function.
	* com.h (ffecom_save_tree_forever): Declare as external.
	* lex.c (ffelex_hash_): Use GC to allocate the filename string
	even when ffelex_kludge_flag_.
	* ste.c (ffeste_io_ialist_): Register a static root.
	(ffeste_io_inlist_): Likewise.
	(ffeste_io_icilist_): Likewise.
	(ffeste_io_cllist_): Likewise.
	(ffeste_io_cilist_): Likewise.
	(ffeste_io_olist_): Likewise.
	* Makefile.in (OBJS): Don't use ggc-callbacks.o.
	(OBJDEPS): Likewise.
	(GGC_H): New variable.
	Update dependencies.
	* where.c (ffewhere_head): New global.
	(mark_ffewhere_head): New marker procedure for ffewhere_head.
	(ffewhere_file_kill): Use GC to do memory management.
	(ffewhere_file_new): Use GC to do memory management.
	* ggc.j: New file.

From-SVN: r31142

gcc/f/ChangeLog

+Thu Dec 30 11:42:05 1999  Geoff Keating  <geoffk@cygnus.com>
+
+	* com.c (ffecom_init_0): Make double_ftype_double,
+	float_ftype_float, ldouble_ftype_ldouble,
+	ffecom_tree_ptr_to_fun_type_void local.
+	(tracker_head): New static variable.
+	(mark_tracker_head): New, marker procedure for tracker_head.
+	(ffecom_save_tree_forever): New procedure.
+	(ffecom_init_zero_): Remove obstack use.
+	(ffecom_make_gfrt_): Remove obstack use.
+	(ffecom_sym_transform_): Remove obstack use, save appropriate trees.
+	(ffecom_transform_common_): Remove obstack use, save appropriate 
+	trees.
+	(ffecom_type_namelist_): Remove obstack use, save appropriate 
+	trees.
+	(ffecom_type_vardesc_): Remove obstack use, save appropriate trees.
+	(ffecom_lookup_label): Remove obstack use, save appropriate trees.
+	(duplicate_decls): Remove obstack use.
+	(finish_function): push & pop ggc context around
+	rest_of_compilation when building nested function.
+	(mark_binding_level): New function.
+	(init_decl_processing): Mark all the GC roots.
+	(ggc_p): Set to 1.
+	(lang_mark_tree): New function.
+	(lang_mark_false_label_stack): New trivial function.
+	* com.h (ffecom_save_tree_forever): Declare as external.
+	* lex.c (ffelex_hash_): Use GC to allocate the filename string
+	even when ffelex_kludge_flag_.
+	* ste.c (ffeste_io_ialist_): Register a static root.
+	(ffeste_io_inlist_): Likewise.
+	(ffeste_io_icilist_): Likewise.
+	(ffeste_io_cllist_): Likewise.
+	(ffeste_io_cilist_): Likewise.
+	(ffeste_io_olist_): Likewise.
+	* Makefile.in (OBJS): Don't use ggc-callbacks.o.
+	(OBJDEPS): Likewise.
+	(GGC_H): New variable.
+	Update dependencies.
+	* where.c (ffewhere_head): New global.
+	(mark_ffewhere_head): New marker procedure for ffewhere_head.
+	(ffewhere_file_kill): Use GC to do memory management.
+	(ffewhere_file_new): Use GC to do memory management.
+	* ggc.j: New file.
+
 Wed Dec 29 19:29:26 1999  Gerald Pfeifer  <pfeifer@dbai.tuwien.ac.at>
 
 	* g77.texi (C Interfacing Tools): Fix an incorrect link.

gcc/f/Make-lang.in

@@ -200,7 +200,7 @@ F77_SRCS = \
  $(srcdir)/f/where.c \
  $(srcdir)/f/where.h
 
-f771$(exeext): $(P) $(F77_SRCS) $(LIBDEPS) ggc-callbacks.o stamp-objlist
+f771$(exeext): $(P) $(F77_SRCS) $(LIBDEPS) stamp-objlist
 	touch lang-f77
 	cd f; $(MAKE) $(FLAGS_TO_PASS) \
 	  HOST_CC="`case '$(HOST_CC)' in stage*) echo '$(HOST_CC)' | sed -e 's|stage|../stage|g';; *) echo '$(HOST_CC)';; esac`" \

gcc/f/Makefile.in

@@ -194,8 +194,8 @@ F77_OBJS = \
  where.o
 
 # Language-independent object files.
-OBJS = `cat ../stamp-objlist` ../ggc-callbacks.o
-OBJDEPS = ../stamp-objlist ../ggc-callbacks.o
+OBJS = `cat ../stamp-objlist`
+OBJDEPS = ../stamp-objlist
 
 compiler: ../f771$(exeext)
 ../f771$(exeext): $(P) $(F77_OBJS) $(OBJDEPS) $(LIBDEPS)
@@ -225,6 +225,7 @@ ASSERT_H = $(srcdir)/assert.j $(srcdir)/../assert.h
 CONFIG_H = $(srcdir)/config.j ../config.h
 CONVERT_H = $(srcdir)/convert.j $(srcdir)/../convert.h
 FLAGS_H = $(srcdir)/flags.j $(srcdir)/../flags.h
+GGC_H = $(srcdir)/ggc.j $(srcdir)/../ggc.h
 GLIMITS_H = $(srcdir)/glimits.j $(srcdir)/../glimits.h
 HCONFIG_H = $(srcdir)/hconfig.j ../hconfig.h
 INPUT_H = $(srcdir)/input.j $(srcdir)/../input.h
@@ -265,7 +266,7 @@ com.o: com.c proj.h $(CONFIG_H) $(SYSTEM_H) $(ASSERT_H) $(FLAGS_H) $(RTL_H) $(TO
  malloc.h info.h info-b.def info-k.def info-w.def target.h bad.h \
  bad.def where.h $(GLIMITS_H) top.h lex.h type.h intrin.h intrin.def \
  lab.h symbol.h symbol.def equiv.h storag.h global.h name.h expr.h \
- implic.h src.h st.h
+ implic.h src.h st.h $(GGC_H)
 data.o: data.c proj.h $(CONFIG_H) $(SYSTEM_H) $(ASSERT_H) data.h bld.h \
  bld-op.def bit.h malloc.h com.h com-rt.def $(TREE_H) info.h info-b.def \
  info-k.def info-w.def target.h bad.h bad.def where.h $(GLIMITS_H) top.h \
@@ -311,7 +312,7 @@ lex.o: lex.c proj.h $(CONFIG_H) $(SYSTEM_H) $(ASSERT_H) top.h malloc.h where.h \
  $(GLIMITS_H) bad.h bad.def com.h com-rt.def $(TREE_H) bld.h bld-op.def \
  bit.h info.h info-b.def info-k.def info-w.def target.h lex.h type.h \
  intrin.h intrin.def lab.h symbol.h symbol.def equiv.h storag.h \
- global.h name.h src.h $(FLAGS_H) $(INPUT_H) $(TOPLEV_H) $(OUTPUT_H)
+ global.h name.h src.h $(FLAGS_H) $(INPUT_H) $(TOPLEV_H) $(OUTPUT_H) $(GGC_H)
 malloc.o: malloc.c proj.h $(CONFIG_H) $(SYSTEM_H) $(ASSERT_H) malloc.h
 name.o: name.c proj.h $(CONFIG_H) $(SYSTEM_H) $(ASSERT_H) bad.h bad.def where.h \
  $(GLIMITS_H) top.h malloc.h name.h global.h info.h info-b.def info-k.def \
@@ -359,7 +360,7 @@ ste.o: ste.c proj.h $(CONFIG_H) $(SYSTEM_H) $(ASSERT_H) $(RTL_H) $(TOPLEV_H) ste
  info-b.def info-k.def info-w.def target.h bad.h bad.def where.h \
  $(GLIMITS_H) top.h lex.h type.h lab.h storag.h symbol.h symbol.def \
  equiv.h global.h name.h intrin.h intrin.def stp.h stt.h stamp-str sts.h \
- stv.h stw.h expr.h sta.h
+ stv.h stw.h expr.h sta.h $(GGC_H)
 storag.o: storag.c proj.h $(CONFIG_H) $(SYSTEM_H) $(ASSERT_H) storag.h bld.h \
  bld-op.def bit.h malloc.h com.h com-rt.def $(TREE_H) info.h info-b.def \
  info-k.def info-w.def target.h bad.h bad.def where.h $(GLIMITS_H) top.h \
@@ -413,7 +414,7 @@ top.o: top.c proj.h $(CONFIG_H) $(SYSTEM_H) $(ASSERT_H) top.h malloc.h where.h \
 type.o: type.c proj.h $(CONFIG_H) $(SYSTEM_H) $(ASSERT_H) type.h malloc.h
 version.o: version.c
 where.o: where.c proj.h $(CONFIG_H) $(SYSTEM_H) $(ASSERT_H) where.h $(GLIMITS_H) \
- top.h malloc.h lex.h
+ top.h malloc.h lex.h $(GGC_H)
 
 # The rest of this list (Fortran 77 language-specific files) is hand-generated.
 

gcc/f/com.h

@@ -318,6 +318,7 @@ tree ffecom_lookup_label (ffelab label);
 tree ffecom_make_tempvar (const char *commentary, tree type,
 			  ffetargetCharacterSize size, int elements);
 tree ffecom_modify (tree newtype, tree lhs, tree rhs);
+void ffecom_save_tree_forever (tree t);
 #endif	/* FFECOM_targetCURRENT == FFECOM_targetGCC */
 void ffecom_file (const char *name);
 void ffecom_notify_init_storage (ffestorag st);

gcc/f/ggc.j

+/* rtl.j -- Wrapper for GCC's rtl.h
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley.
+
+This file is part of GNU Fortran.
+
+GNU Fortran is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Fortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Fortran; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.  */
+
+#ifndef MAKING_DEPENDENCIES
+#ifndef _J_f_ggc
+#define _J_f_ggc
+#include "system.j"
+#include "config.j"
+#include "ggc.h"
+#endif
+#endif

gcc/f/lex.c

@@ -32,6 +32,7 @@ the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
 #include "toplev.j"
 #include "tree.j"
 #include "output.j"  /* Must follow tree.j so TREE_CODE is defined! */
+#include "ggc.j"
 #endif
 
 #ifdef DWARF_DEBUGGING_INFO
@@ -1320,7 +1321,7 @@ ffelex_hash_ (FILE *finput)
       lineno = l;
 
       if (ffelex_kludge_flag_)
-	input_filename = ffelex_token_text (token);
+	input_filename = ggc_alloc_string (ffelex_token_text (token), -1);
       else
 	{
 	  wf = ffewhere_file_new (ffelex_token_text (token),

gcc/f/ste.c

@@ -35,6 +35,7 @@ the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
 #if FFECOM_targetCURRENT == FFECOM_targetGCC
 #include "rtl.j"
 #include "toplev.j"
+#include "ggc.j"
 #endif
 
 #include "ste.h"
@@ -1218,9 +1219,6 @@ ffeste_io_ialist_ (bool have_err,
     {
       tree ref;
 
-      push_obstacks_nochange ();
-      end_temporary_allocation ();
-
       ref = make_node (RECORD_TYPE);
 
       errfield = ffecom_decl_field (ref, NULL_TREE, "err",
@@ -1231,8 +1229,7 @@ ffeste_io_ialist_ (bool have_err,
       TYPE_FIELDS (ref) = errfield;
       layout_type (ref);
 
-      resume_temporary_allocation ();
-      pop_obstacks ();
+      ggc_add_tree_root (&f2c_alist_struct, 1);
 
       f2c_alist_struct = ref;
     }
@@ -1355,9 +1352,6 @@ ffeste_io_cilist_ (bool have_err,
     {
       tree ref;
 
-      push_obstacks_nochange ();
-      end_temporary_allocation ();
-
       ref = make_node (RECORD_TYPE);
 
       errfield = ffecom_decl_field (ref, NULL_TREE, "err",
@@ -1374,8 +1368,7 @@ ffeste_io_cilist_ (bool have_err,
       TYPE_FIELDS (ref) = errfield;
       layout_type (ref);
 
-      resume_temporary_allocation ();
-      pop_obstacks ();
+      ggc_add_tree_root (&f2c_cilist_struct, 1);
 
       f2c_cilist_struct = ref;
     }
@@ -1586,9 +1579,6 @@ ffeste_io_cllist_ (bool have_err,
     {
       tree ref;
 
-      push_obstacks_nochange ();
-      end_temporary_allocation ();
-
       ref = make_node (RECORD_TYPE);
 
       errfield = ffecom_decl_field (ref, NULL_TREE, "err",
@@ -1601,8 +1591,7 @@ ffeste_io_cllist_ (bool have_err,
       TYPE_FIELDS (ref) = errfield;
       layout_type (ref);
 
-      resume_temporary_allocation ();
-      pop_obstacks ();
+      ggc_add_tree_root (&f2c_close_struct, 1);
 
       f2c_close_struct = ref;
     }
@@ -1713,9 +1702,6 @@ ffeste_io_icilist_ (bool have_err,
     {
       tree ref;
 
-      push_obstacks_nochange ();
-      end_temporary_allocation ();
-
       ref = make_node (RECORD_TYPE);
 
       errfield = ffecom_decl_field (ref, NULL_TREE, "err",
@@ -1734,8 +1720,7 @@ ffeste_io_icilist_ (bool have_err,
       TYPE_FIELDS (ref) = errfield;
       layout_type (ref);
 
-      resume_temporary_allocation ();
-      pop_obstacks ();
+      ggc_add_tree_root (&f2c_icilist_struct, 1);
 
       f2c_icilist_struct = ref;
     }
@@ -1976,9 +1961,6 @@ ffeste_io_inlist_ (bool have_err,
     {
       tree ref;
 
-      push_obstacks_nochange ();
-      end_temporary_allocation ();
-
       ref = make_node (RECORD_TYPE);
 
       errfield = ffecom_decl_field (ref, NULL_TREE, "err",
@@ -2041,8 +2023,7 @@ ffeste_io_inlist_ (bool have_err,
       TYPE_FIELDS (ref) = errfield;
       layout_type (ref);
 
-      resume_temporary_allocation ();
-      pop_obstacks ();
+      ggc_add_tree_root (&f2c_inquire_struct, 1);
 
       f2c_inquire_struct = ref;
     }
@@ -2229,9 +2210,6 @@ ffeste_io_olist_ (bool have_err,
     {
       tree ref;
 
-      push_obstacks_nochange ();
-      end_temporary_allocation ();
-
       ref = make_node (RECORD_TYPE);
 
       errfield = ffecom_decl_field (ref, NULL_TREE, "err",
@@ -2256,8 +2234,7 @@ ffeste_io_olist_ (bool have_err,
       TYPE_FIELDS (ref) = errfield;
       layout_type (ref);
 
-      resume_temporary_allocation ();
-      pop_obstacks ();
+      ggc_add_tree_root (&f2c_open_struct, 1);
 
       f2c_open_struct = ref;
     }

gcc/f/where.c

@@ -33,6 +33,7 @@ the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
 #include "where.h"
 #include "lex.h"
 #include "malloc.h"
+#include "ggc.j"
 
 /* Externals defined here. */
 
@@ -108,6 +109,33 @@ ffewhere_ll_lookup_ (ffewhereLineNumber ln)
   return NULL;
 }
 
+/* A somewhat evil way to prevent the garbage collector
+   from collecting 'file' structures.  */
+#define NUM_FFEWHERE_HEAD_FILES 31
+static struct ffewhere_ggc_tracker 
+{
+  struct ffewhere_ggc_tracker *next;
+  ffewhereFile files[NUM_FFEWHERE_HEAD_FILES];
+} *ffewhere_head = NULL;
+
+static void 
+mark_ffewhere_head (arg)
+     void *arg;
+{
+  struct ffewhere_ggc_tracker *head;
+  int i;
+  
+  for (head = * (struct ffewhere_ggc_tracker **) arg;
+       head != NULL;
+       head = head->next)
+  {
+    ggc_mark (head);
+    for (i = 0; i < NUM_FFEWHERE_HEAD_FILES; i++)
+      ggc_mark (head->files[i]);
+  }
+}
+
+
 /* Kill file object.
 
    Note that this object must not have been passed in a call
@@ -117,9 +145,18 @@ ffewhere_ll_lookup_ (ffewhereLineNumber ln)
 void
 ffewhere_file_kill (ffewhereFile wf)
 {
-  malloc_kill_ks (ffe_pool_file (), wf,
-		  offsetof (struct _ffewhere_file_, text)
-		  + wf->length + 1);
+  struct ffewhere_ggc_tracker *head;
+  int i;
+  
+  for (head = ffewhere_head; head != NULL; head = head->next)
+    for (i = 0; i < NUM_FFEWHERE_HEAD_FILES; i++)
+      if (head->files[i] == wf)
+	{
+	  head->files[i] = NULL;
+	  return;
+	}
+  /* Called on a file that has already been deallocated... */
+  abort();
 }
 
 /* Create file object.  */
@@ -128,14 +165,42 @@ ffewhereFile
 ffewhere_file_new (char *name, size_t length)
 {
   ffewhereFile wf;
-
-  wf = malloc_new_ks (ffe_pool_file (), "ffewhereFile",
-		      offsetof (struct _ffewhere_file_, text)
-		      + length + 1);
+  int filepos;
+ 
+  wf = ggc_alloc (offsetof (struct _ffewhere_file_, text)
+		  + length + 1);
   wf->length = length;
   memcpy (&wf->text[0], name, length);
   wf->text[length] = '\0';
 
+  if (ffewhere_head == NULL)
+    {
+      ggc_add_root (&ffewhere_head, 1, sizeof ffewhere_head,
+		    mark_ffewhere_head);
+      filepos = NUM_FFEWHERE_HEAD_FILES;
+    }
+  else
+    {
+      for (filepos = 0; filepos < NUM_FFEWHERE_HEAD_FILES; filepos++)
+	if (ffewhere_head->files[filepos] == NULL)
+	  {
+	    ffewhere_head->files[filepos] = wf;
+	    break;
+	  }
+    }
+  if (filepos == NUM_FFEWHERE_HEAD_FILES)
+    {
+      /* Need to allocate a new block.  */
+      struct ffewhere_ggc_tracker *old_head = ffewhere_head;
+      int i;
+      
+      ffewhere_head = ggc_alloc (sizeof (*ffewhere_head));
+      ffewhere_head->next = old_head;
+      ffewhere_head->files[0] = wf;
+      for (i = 1; i < NUM_FFEWHERE_HEAD_FILES; i++)
+	ffewhere_head->files[i] = NULL;
+    }
+
   return wf;
 }