Merge from pch-branch up to tag pch-commit-20020603.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@54232 138bc75d-0d04-0410-961f-82ee72b054a4

7 files changed, 171 insertions, 288 deletions

diff --git a/gcc/f/ChangeLog b/gcc/f/ChangeLog
index 005b151bbdc..f4634d16672 100644
--- a/gcc/f/ChangeLog
+++ b/gcc/f/ChangeLog
@@ -1,3 +1,42 @@
+2002-06-03  Geoffrey Keating  <geoffk@redhat.com>
+
+	* Make-lang.in (f/com.o): Depend on debug.h.
+	* com.c: Include debug.h.
+	(LANG_HOOKS_MARK_TREE): Delete.
+	(struct lang_identifier): Use gengtype.
+	(union lang_tree_node): New.
+	(struct lang_decl): New dummy definition.
+	(struct lang_type): New dummy definition.
+	(ffe_mark_tree): Delete.
+
+	* com.c (struct language_function): New dummy structure.
+
+	* Make-lang.in: Add rules to generate gt-f-ste.h gtype-f.h; allow
+	for filename changes.
+	(com.o): Allow for filename changes; add gtype-f.h as dependency.
+	(ste.o): Add gt-f-ste.h as dependency.
+	* config-lang.in (gtfiles): Add com.h, ste.c.
+	* com.c: Replace uses of ggc_add_* with GTY markers.  Include
+	gtype-f.h.
+	(mark_binding_level): Delete.
+	* com.h: Replace uses of ggc_add_* with GTY markers.
+	* ste.c: Replace uses of ggc_add_* with GTY markers.  Include
+	gt-f-ste.h.
+
+	* Make-lang.in (f/gt-com.h): Build using gengtype.
+	(com.o): Depend on f/gt-com.h.
+	* com.c: Rename struct binding_level to f_binding_level.
+	(struct f_binding_level): Use gengtype.
+	(struct tree_ggc_tracker): Use gengtype.
+	(mark_tracker_head): Use gt_ggc_m_tree_ggc_tracker.
+	(make_binding_level): Use GGC.
+	(mark_binding_level): Use gt_ggc_m_f_binding_level.
+	(ffecom_init_decl_processing): Change free_binding_level
+	to a deletable root.
+	* config-lang.in (gtfiles): Define.
+	* where.c: Strings need no longer be allocated in GCable memory;
+	remove my change of 30 Dec 1999.
+
 2002-05-31  Matthew Woodcraft  <mattheww@chiark.greenend.org.uk>
 
 	* lang-specs.h: Use cpp_debug_options.
diff --git a/gcc/f/Make-lang.in b/gcc/f/Make-lang.in
index 288ed9a156f..86cf411fa37 100644
--- a/gcc/f/Make-lang.in
+++ b/gcc/f/Make-lang.in
@@ -137,6 +137,8 @@ f/fini.o:
 	$(HOST_CC) $(HOST_CFLAGS) $(HOST_CPPFLAGS) $(INCLUDES) \
 	      -c $(srcdir)/f/fini.c $(OUTPUT_OPTION)
 
+gt-f-com.h gt-f-ste.h gtype-f.h : s-gtype; @true
+
 #
 # Build hooks:
 
@@ -364,7 +366,7 @@ f/com.o: f/com.c f/proj.h $(CONFIG_H) $(SYSTEM_H) flags.h $(RTL_H) $(TREE_H) \
  f/bad.def f/where.h glimits.h f/top.h f/lex.h f/type.h f/intrin.h \
  f/intrin.def f/lab.h f/symbol.h f/symbol.def f/equiv.h f/storag.h f/global.h \
  f/name.h f/expr.h f/implic.h f/src.h f/st.h $(GGC_H) toplev.h diagnostic.h \
- langhooks.h langhooks-def.h intl.h real.h
+ $(LANGHOOKS_DEF) langhooks.h intl.h real.h debug.h gt-f-com.h gtype-f.h
 f/data.o: f/data.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/data.h f/bld.h f/bld-op.def \
  f/bit.h f/malloc.h f/com.h f/com-rt.def $(TREE_H) f/info.h f/info-b.def \
  f/info-k.def f/info-w.def f/target.h f/bad.h f/bad.def f/where.h glimits.h \
@@ -460,7 +462,8 @@ f/ste.o: f/ste.c f/proj.h $(CONFIG_H) $(SYSTEM_H) $(RTL_H) toplev.h f/ste.h \
  f/info.h f/info-b.def f/info-k.def f/info-w.def f/target.h f/bad.h f/bad.def \
  f/where.h glimits.h f/top.h f/lex.h f/type.h f/lab.h f/storag.h f/symbol.h \
  f/symbol.def f/equiv.h f/global.h f/name.h f/intrin.h f/intrin.def f/stp.h \
- f/stt.h f/stamp-str f/sts.h f/stv.h f/stw.h f/expr.h f/sta.h $(GGC_H)
+ f/stt.h f/stamp-str f/sts.h f/stv.h f/stw.h f/expr.h f/sta.h $(GGC_H) \
+ gt-f-ste.h
 f/storag.o: f/storag.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/storag.h f/bld.h  \
  f/bld-op.def f/bit.h f/malloc.h f/com.h f/com-rt.def $(TREE_H) \
  f/info.h f/info-b.def f/info-k.def f/info-w.def f/target.h f/bad.h \
diff --git a/gcc/f/com.c b/gcc/f/com.c
index d66951542b4..310a3107677 100644
--- a/gcc/f/com.c
+++ b/gcc/f/com.c
@@ -93,6 +93,7 @@ the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
 #include "intl.h"
 #include "langhooks.h"
 #include "langhooks-def.h"
+#include "debug.h"
 
 /* VMS-specific definitions */
 #ifdef VMS
@@ -155,7 +156,7 @@ tree string_type_node;
    inventions should be renamed to be canonical.  Note that only
    the ones currently required to be global are so.  */
 
-static tree ffecom_tree_fun_type_void;
+static GTY(()) tree ffecom_tree_fun_type_void;
 
 tree ffecom_integer_type_node;	/* Abbrev for _tree_type[blah][blah]. */
 tree ffecom_integer_zero_node;	/* Like *_*_* with g77's integer type. */
@@ -166,13 +167,14 @@ tree ffecom_tree_type[FFEINFO_basictype][FFEINFO_kindtype];
    just use build_function_type and build_pointer_type on the
    appropriate _tree_type array element.  */
 
-static tree ffecom_tree_fun_type[FFEINFO_basictype][FFEINFO_kindtype];
-static tree ffecom_tree_ptr_to_fun_type[FFEINFO_basictype][FFEINFO_kindtype];
-static tree ffecom_tree_subr_type;
-static tree ffecom_tree_ptr_to_subr_type;
-static tree ffecom_tree_blockdata_type;
+static GTY(()) tree ffecom_tree_fun_type[FFEINFO_basictype][FFEINFO_kindtype];
+static GTY(()) tree 
+  ffecom_tree_ptr_to_fun_type[FFEINFO_basictype][FFEINFO_kindtype];
+static GTY(()) tree ffecom_tree_subr_type;
+static GTY(()) tree ffecom_tree_ptr_to_subr_type;
+static GTY(()) tree ffecom_tree_blockdata_type;
 
-static tree ffecom_tree_xargc_;
+static GTY(()) tree ffecom_tree_xargc_;
 
 ffecomSymbol ffecom_symbol_null_
 =
@@ -188,10 +190,10 @@ ffeinfoKindtype ffecom_label_kind_ = FFEINFO_basictypeNONE;
 
 int ffecom_f2c_typecode_[FFEINFO_basictype][FFEINFO_kindtype];
 tree ffecom_f2c_integer_type_node;
-tree ffecom_f2c_ptr_to_integer_type_node;
+static GTY(()) tree ffecom_f2c_ptr_to_integer_type_node;
 tree ffecom_f2c_address_type_node;
 tree ffecom_f2c_real_type_node;
-tree ffecom_f2c_ptr_to_real_type_node;
+static GTY(()) tree ffecom_f2c_ptr_to_real_type_node;
 tree ffecom_f2c_doublereal_type_node;
 tree ffecom_f2c_complex_type_node;
 tree ffecom_f2c_doublecomplex_type_node;
@@ -375,7 +377,7 @@ static void finish_function (int nested);
 static const char *ffe_printable_name (tree decl, int v);
 static void ffe_print_error_function (diagnostic_context *, const char *);
 static tree lookup_name_current_level (tree name);
-static struct binding_level *make_binding_level (void);
+static struct f_binding_level *make_binding_level (void);
 static void pop_f_function_context (void);
 static void push_f_function_context (void);
 static void push_parm_decl (tree parm);
@@ -397,15 +399,15 @@ static ffesymbol ffecom_primary_entry_ = NULL;
 static ffesymbol ffecom_nested_entry_ = NULL;
 static ffeinfoKind ffecom_primary_entry_kind_;
 static bool ffecom_primary_entry_is_proc_;
-static tree ffecom_outer_function_decl_;
-static tree ffecom_previous_function_decl_;
-static tree ffecom_which_entrypoint_decl_;
-static tree ffecom_float_zero_ = NULL_TREE;
-static tree ffecom_float_half_ = NULL_TREE;
-static tree ffecom_double_zero_ = NULL_TREE;
-static tree ffecom_double_half_ = NULL_TREE;
-static tree ffecom_func_result_;/* For functions. */
-static tree ffecom_func_length_;/* For CHARACTER fns. */
+static GTY(()) tree ffecom_outer_function_decl_;
+static GTY(()) tree ffecom_previous_function_decl_;
+static GTY(()) tree ffecom_which_entrypoint_decl_;
+static GTY(()) tree ffecom_float_zero_;
+static GTY(()) tree ffecom_float_half_;
+static GTY(()) tree ffecom_double_zero_;
+static GTY(()) tree ffecom_double_half_;
+static GTY(()) tree ffecom_func_result_;/* For functions. */
+static GTY(()) tree ffecom_func_length_;/* For CHARACTER fns. */
 static ffebld ffecom_list_blockdata_;
 static ffebld ffecom_list_common_;
 static ffebld ffecom_master_arglist_;
@@ -415,9 +417,9 @@ static ffetargetCharacterSize ffecom_master_size_;
 static int ffecom_num_fns_ = 0;
 static int ffecom_num_entrypoints_ = 0;
 static bool ffecom_is_altreturning_ = FALSE;
-static tree ffecom_multi_type_node_;
-static tree ffecom_multi_retval_;
-static tree
+static GTY(()) tree ffecom_multi_type_node_;
+static GTY(()) tree ffecom_multi_retval_;
+static GTY(()) tree
   ffecom_multi_fields_[FFEINFO_basictype][FFEINFO_kindtype];
 static bool ffecom_member_namelisted_;	/* _member_phase1_ namelisted? */
 static bool ffecom_doing_entry_ = FALSE;
@@ -427,13 +429,7 @@ static int ffecom_typesize_integer1_;
 
 /* Holds pointer-to-function expressions.  */
 
-static tree ffecom_gfrt_[FFECOM_gfrt]
-=
-{
-#define DEFGFRT(CODE,NAME,TYPE,ARGS,VOLATILE,COMPLEX,CONST) NULL_TREE,
-#include "com-rt.def"
-#undef DEFGFRT
-};
+static GTY(()) tree ffecom_gfrt_[FFECOM_gfrt];
 
 /* Holds the external names of the functions.  */
 
@@ -530,7 +526,7 @@ static const char *const ffecom_gfrt_argstring_[FFECOM_gfrt]
 /* Note that the information in the `names' component of the global contour
    is duplicated in the IDENTIFIER_GLOBAL_VALUEs of all identifiers.  */
 
-struct binding_level
+struct f_binding_level GTY(())
   {
     /* A chain of _DECL nodes for all variables, constants, functions,
        and typedef types.  These are in the reverse of the order supplied.
@@ -547,7 +543,7 @@ struct binding_level
     tree this_block;
 
     /* The binding level which this one is contained in (inherits from).  */
-    struct binding_level *level_chain;
+    struct f_binding_level *level_chain;
 
     /* 0: no ffecom_prepare_* functions called at this level yet;
        1: ffecom_prepare* functions called, except not ffecom_prepare_end;
@@ -555,36 +551,38 @@ struct binding_level
     int prep_state;
   };
 
-#define NULL_BINDING_LEVEL (struct binding_level *) NULL
+#define NULL_BINDING_LEVEL (struct f_binding_level *) NULL
 
 /* The binding level currently in effect.  */
 
-static struct binding_level *current_binding_level;
+static GTY(()) struct f_binding_level *current_binding_level;
 
 /* A chain of binding_level structures awaiting reuse.  */
 
-static struct binding_level *free_binding_level;
+static GTY((deletable (""))) struct f_binding_level *free_binding_level;
 
 /* The outermost binding level, for names of file scope.
    This is created when the compiler is started and exists
    through the entire run.  */
 
-static struct binding_level *global_binding_level;
+static struct f_binding_level *global_binding_level;
 
 /* Binding level structures are initialized by copying this one.  */
 
-static const struct binding_level clear_binding_level
+static const struct f_binding_level clear_binding_level
 =
 {NULL, NULL, NULL, NULL_BINDING_LEVEL, 0};
 
 /* Language-dependent contents of an identifier.  */
 
-struct lang_identifier
-  {
-    struct tree_identifier ignore;
-    tree global_value, local_value, label_value;
-    bool invented;
-  };
+struct lang_identifier GTY(())
+{
+  struct tree_identifier common;
+  tree global_value;
+  tree local_value;
+  tree label_value;
+  bool invented;
+};
 
 /* Macros for access to language-specific slots in an identifier.  */
 /* Each of these slots contains a DECL node or null.  */
@@ -605,6 +603,24 @@ struct lang_identifier
 #define IDENTIFIER_INVENTED(NODE)	\
   (((struct lang_identifier *)(NODE))->invented)
 
+/* The resulting tree type.  */
+union lang_tree_node 
+  GTY((desc ("TREE_CODE (&%h.generic) == IDENTIFIER_NODE")))
+{
+  union tree_node GTY ((tag ("0"), 
+			desc ("tree_node_structure (&%h)"))) 
+    generic;
+  struct lang_identifier GTY ((tag ("1"))) identifier;
+};
+
+/* Fortran doesn't use either of these.  */
+struct lang_decl GTY(()) 
+{
+};
+struct lang_type GTY(())
+{
+};
+
 /* In identifiers, C uses the following fields in a special way:
    TREE_PUBLIC	      to record that there was a previous local extern decl.
    TREE_USED	      to record that such a decl was used.
@@ -614,11 +630,11 @@ struct lang_identifier
    that have names.  Here so we can clear out their names' definitions
    at the end of the function.  */
 
-static tree named_labels;
+static GTY(()) tree named_labels;
 
 /* A list of LABEL_DECLs from outer contexts that are currently shadowed.  */
 
-static tree shadowed_labels;
+static GTY(()) tree shadowed_labels;
 
 /* Return the subscript expression, modified to do range-checking.
 
@@ -6276,27 +6292,12 @@ ffecom_gfrt_tree_ (ffecomGfrt ix)
 /* A somewhat evil way to prevent the garbage collector
    from collecting 'tree' structures.  */
 #define NUM_TRACKED_CHUNK 63
-static struct tree_ggc_tracker
+struct tree_ggc_tracker GTY(())
 {
   struct tree_ggc_tracker *next;
   tree trees[NUM_TRACKED_CHUNK];
-} *tracker_head = NULL;
-
-static void
-mark_tracker_head (void *arg)
-{
-  struct tree_ggc_tracker *head;
-  int i;
-
-  for (head = * (struct tree_ggc_tracker **) arg;
-       head != NULL;
-       head = head->next)
-  {
-    ggc_mark (head);
-    for (i = 0; i < NUM_TRACKED_CHUNK; i++)
-      ggc_mark_tree (head->trees[i]);
-  }
-}
+};
+static GTY(()) struct tree_ggc_tracker *tracker_head;
 
 void
 ffecom_save_tree_forever (tree t)
@@ -9214,15 +9215,13 @@ ffecom_type_localvar_ (ffesymbol s, ffeinfoBasictype bt,
 
 /* Build Namelist type.  */
 
+static GTY(()) tree ffecom_type_namelist_var;
 static tree
 ffecom_type_namelist_ ()
 {
-  static tree type = NULL_TREE;
-
-  if (type == NULL_TREE)
+  if (ffecom_type_namelist_var == NULL_TREE)
     {
-      static tree namefield, varsfield, nvarsfield;
-      tree vardesctype;
+      tree namefield, varsfield, nvarsfield, vardesctype, type;
 
       vardesctype = ffecom_type_vardesc_ ();
 
@@ -9239,22 +9238,21 @@ ffecom_type_namelist_ ()
       TYPE_FIELDS (type) = namefield;
       layout_type (type);
 
-      ggc_add_tree_root (&type, 1);
+      ffecom_type_namelist_var = type;
     }
 
-  return type;
+  return ffecom_type_namelist_var;
 }
 
 /* Build Vardesc type.  */
 
+static GTY(()) tree ffecom_type_vardesc_var;
 static tree
 ffecom_type_vardesc_ ()
 {
-  static tree type = NULL_TREE;
-  static tree namefield, addrfield, dimsfield, typefield;
-
-  if (type == NULL_TREE)
+  if (ffecom_type_vardesc_var == NULL_TREE)
     {
+      tree namefield, addrfield, dimsfield, typefield, type;
       type = make_node (RECORD_TYPE);
 
       namefield = ffecom_decl_field (type, NULL_TREE, "name",
@@ -9269,10 +9267,10 @@ ffecom_type_vardesc_ ()
       TYPE_FIELDS (type) = namefield;
       layout_type (type);
 
-      ggc_add_tree_root (&type, 1);
+      ffecom_type_vardesc_var = type;
     }
 
-  return type;
+  return ffecom_type_vardesc_var;
 }
 
 static tree
@@ -13732,13 +13730,13 @@ lookup_name_current_level (tree name)
   return t;
 }
 
-/* Create a new `struct binding_level'.  */
+/* Create a new `struct f_binding_level'.  */
 
-static struct binding_level *
+static struct f_binding_level *
 make_binding_level ()
 {
   /* NOSTRICT */
-  return (struct binding_level *) xmalloc (sizeof (struct binding_level));
+  return ggc_alloc (sizeof (struct f_binding_level));
 }
 
 /* Save and restore the variables in this file and elsewhere
@@ -13750,7 +13748,7 @@ struct f_function
   struct f_function *next;
   tree named_labels;
   tree shadowed_labels;
-  struct binding_level *binding_level;
+  struct f_binding_level *binding_level;
 };
 
 struct f_function *f_function_chain;
@@ -13838,7 +13836,7 @@ pushdecl_top_level (x)
      tree x;
 {
   register tree t;
-  register struct binding_level *b = current_binding_level;
+  register struct f_binding_level *b = current_binding_level;
   register tree f = current_function_decl;
 
   current_binding_level = global_binding_level;
@@ -14078,86 +14076,11 @@ global_bindings_p ()
   return current_binding_level == global_binding_level;
 }
 
-/* Mark ARG for GC.  */
-static void
-mark_binding_level (void *arg)
-{
-  struct binding_level *level = *(struct binding_level **) arg;
-
-  while (level)
-    {
-      ggc_mark_tree (level->names);
-      ggc_mark_tree (level->blocks);
-      ggc_mark_tree (level->this_block);
-      level = level->level_chain;
-    }
-}
-
 static void
 ffecom_init_decl_processing ()
 {
-  static tree *const tree_roots[] = {
-    &current_function_decl,
-    &string_type_node,
-    &ffecom_tree_fun_type_void,
-    &ffecom_integer_zero_node,
-    &ffecom_integer_one_node,
-    &ffecom_tree_subr_type,
-    &ffecom_tree_ptr_to_subr_type,
-    &ffecom_tree_blockdata_type,
-    &ffecom_tree_xargc_,
-    &ffecom_f2c_integer_type_node,
-    &ffecom_f2c_ptr_to_integer_type_node,
-    &ffecom_f2c_address_type_node,
-    &ffecom_f2c_real_type_node,
-    &ffecom_f2c_ptr_to_real_type_node,
-    &ffecom_f2c_doublereal_type_node,
-    &ffecom_f2c_complex_type_node,
-    &ffecom_f2c_doublecomplex_type_node,
-    &ffecom_f2c_longint_type_node,
-    &ffecom_f2c_logical_type_node,
-    &ffecom_f2c_flag_type_node,
-    &ffecom_f2c_ftnlen_type_node,
-    &ffecom_f2c_ftnlen_zero_node,
-    &ffecom_f2c_ftnlen_one_node,
-    &ffecom_f2c_ftnlen_two_node,
-    &ffecom_f2c_ptr_to_ftnlen_type_node,
-    &ffecom_f2c_ftnint_type_node,
-    &ffecom_f2c_ptr_to_ftnint_type_node,
-    &ffecom_outer_function_decl_,
-    &ffecom_previous_function_decl_,
-    &ffecom_which_entrypoint_decl_,
-    &ffecom_float_zero_,
-    &ffecom_float_half_,
-    &ffecom_double_zero_,
-    &ffecom_double_half_,
-    &ffecom_func_result_,
-    &ffecom_func_length_,
-    &ffecom_multi_type_node_,
-    &ffecom_multi_retval_,
-    &named_labels,
-    &shadowed_labels
-  };
-  size_t i;
-
   malloc_init ();
 
-  /* Record our roots.  */
-  for (i = 0; i < ARRAY_SIZE (tree_roots); i++)
-    ggc_add_tree_root (tree_roots[i], 1);
-  ggc_add_tree_root (&ffecom_tree_type[0][0],
-		     FFEINFO_basictype*FFEINFO_kindtype);
-  ggc_add_tree_root (&ffecom_tree_fun_type[0][0],
-		     FFEINFO_basictype*FFEINFO_kindtype);
-  ggc_add_tree_root (&ffecom_tree_ptr_to_fun_type[0][0],
-		     FFEINFO_basictype*FFEINFO_kindtype);
-  ggc_add_tree_root (ffecom_gfrt_, FFECOM_gfrt);
-  ggc_add_root (&current_binding_level, 1, sizeof current_binding_level,
-                mark_binding_level);
-  ggc_add_root (&free_binding_level, 1, sizeof current_binding_level,
-                mark_binding_level);
-  ggc_add_root (&tracker_head, 1, sizeof tracker_head, mark_tracker_head);
-
   ffe_init_0 ();
 }
 
@@ -14199,7 +14122,11 @@ static const char *ffe_init PARAMS ((const char *));
 static void ffe_finish PARAMS ((void));
 static void ffe_init_options PARAMS ((void));
 static void ffe_print_identifier PARAMS ((FILE *, tree, int));
-static void ffe_mark_tree (tree);
+
+struct language_function GTY(())
+{
+  int unused;
+};
 
 #undef  LANG_HOOKS_NAME
 #define LANG_HOOKS_NAME			"GNU F77"
@@ -14213,8 +14140,6 @@ static void ffe_mark_tree (tree);
 #define LANG_HOOKS_DECODE_OPTION	ffe_decode_option
 #undef  LANG_HOOKS_PARSE_FILE
 #define LANG_HOOKS_PARSE_FILE		ffe_parse_file
-#undef  LANG_HOOKS_MARK_TREE
-#define LANG_HOOKS_MARK_TREE		ffe_mark_tree
 #undef  LANG_HOOKS_MARK_ADDRESSABLE
 #define LANG_HOOKS_MARK_ADDRESSABLE	ffe_mark_addressable
 #undef  LANG_HOOKS_PRINT_IDENTIFIER
@@ -14517,7 +14442,7 @@ poplevel (keep, reverse, functionbody)
   /* Pop the current level, and free the structure for reuse.  */
 
   {
-    register struct binding_level *level = current_binding_level;
+    register struct f_binding_level *level = current_binding_level;
     current_binding_level = current_binding_level->level_chain;
 
     level->level_chain = free_binding_level;
@@ -14572,7 +14497,7 @@ pushdecl (x)
 {
   register tree t;
   register tree name = DECL_NAME (x);
-  register struct binding_level *b = current_binding_level;
+  register struct f_binding_level *b = current_binding_level;
 
   if ((TREE_CODE (x) == FUNCTION_DECL)
       && (DECL_INITIAL (x) == 0)
@@ -14704,7 +14629,7 @@ void
 pushlevel (tag_transparent)
      int tag_transparent;
 {
-  register struct binding_level *newlevel = NULL_BINDING_LEVEL;
+  register struct f_binding_level *newlevel = NULL_BINDING_LEVEL;
 
   assert (! tag_transparent);
 
@@ -15138,21 +15063,6 @@ ffe_unsigned_type (type)
 
   return type;
 }
-
-static void
-ffe_mark_tree (t)
-     tree t;
-{
-  if (TREE_CODE (t) == IDENTIFIER_NODE)
-    {
-      struct lang_identifier *i = (struct lang_identifier *) t;
-      ggc_mark_tree (IDENTIFIER_GLOBAL_VALUE (i));
-      ggc_mark_tree (IDENTIFIER_LOCAL_VALUE (i));
-      ggc_mark_tree (IDENTIFIER_LABEL_VALUE (i));
-    }
-  else if (TYPE_P (t) && TYPE_LANG_SPECIFIC (t))
-    ggc_mark (TYPE_LANG_SPECIFIC (t));
-}
 
 /* From gcc/cccp.c, the code to handle -I.  */
 
@@ -16656,3 +16566,6 @@ typedef doublereal E_f; // real function with -R not specified //
 -------- (end output file from f2c)
 
 */
+
+#include "gt-f-com.h"
+#include "gtype-f.h"
diff --git a/gcc/f/com.h b/gcc/f/com.h
index be49242ff92..8b8bb861e82 100644
--- a/gcc/f/com.h
+++ b/gcc/f/com.h
@@ -167,32 +167,32 @@ extern tree pushdecl				PARAMS ((tree));
 
 /* Global objects accessed by users of this module. */
 
-extern tree string_type_node;
-extern tree ffecom_integer_type_node;
-extern tree ffecom_integer_zero_node;
-extern tree ffecom_integer_one_node;
-extern tree ffecom_tree_type[FFEINFO_basictype][FFEINFO_kindtype];
+extern GTY(()) tree string_type_node;
+extern GTY(()) tree ffecom_integer_type_node;
+extern GTY(()) tree ffecom_integer_zero_node;
+extern GTY(()) tree ffecom_integer_one_node;
+extern GTY(()) tree ffecom_tree_type[FFEINFO_basictype][FFEINFO_kindtype];
 extern ffecomSymbol ffecom_symbol_null_;
 extern ffeinfoKindtype ffecom_pointer_kind_;
 extern ffeinfoKindtype ffecom_label_kind_;
 
 extern int ffecom_f2c_typecode_[FFEINFO_basictype][FFEINFO_kindtype];
-extern tree ffecom_f2c_integer_type_node;
-extern tree ffecom_f2c_address_type_node;
-extern tree ffecom_f2c_real_type_node;
-extern tree ffecom_f2c_doublereal_type_node;
-extern tree ffecom_f2c_complex_type_node;
-extern tree ffecom_f2c_doublecomplex_type_node;
-extern tree ffecom_f2c_longint_type_node;
-extern tree ffecom_f2c_logical_type_node;
-extern tree ffecom_f2c_flag_type_node;
-extern tree ffecom_f2c_ftnlen_type_node;
-extern tree ffecom_f2c_ftnlen_zero_node;
-extern tree ffecom_f2c_ftnlen_one_node;
-extern tree ffecom_f2c_ftnlen_two_node;
-extern tree ffecom_f2c_ptr_to_ftnlen_type_node;
-extern tree ffecom_f2c_ftnint_type_node;
-extern tree ffecom_f2c_ptr_to_ftnint_type_node;
+extern GTY(()) tree ffecom_f2c_integer_type_node;
+extern GTY(()) tree ffecom_f2c_address_type_node;
+extern GTY(()) tree ffecom_f2c_real_type_node;
+extern GTY(()) tree ffecom_f2c_doublereal_type_node;
+extern GTY(()) tree ffecom_f2c_complex_type_node;
+extern GTY(()) tree ffecom_f2c_doublecomplex_type_node;
+extern GTY(()) tree ffecom_f2c_longint_type_node;
+extern GTY(()) tree ffecom_f2c_logical_type_node;
+extern GTY(()) tree ffecom_f2c_flag_type_node;
+extern GTY(()) tree ffecom_f2c_ftnlen_type_node;
+extern GTY(()) tree ffecom_f2c_ftnlen_zero_node;
+extern GTY(()) tree ffecom_f2c_ftnlen_one_node;
+extern GTY(()) tree ffecom_f2c_ftnlen_two_node;
+extern GTY(()) tree ffecom_f2c_ptr_to_ftnlen_type_node;
+extern GTY(()) tree ffecom_f2c_ftnint_type_node;
+extern GTY(()) tree ffecom_f2c_ptr_to_ftnint_type_node;
 
 /* Declare functions with prototypes. */
 
diff --git a/gcc/f/config-lang.in b/gcc/f/config-lang.in
index 168daadfc9e..2c5bd2d5572 100644
--- a/gcc/f/config-lang.in
+++ b/gcc/f/config-lang.in
@@ -32,3 +32,5 @@ compilers="f771\$(exeext)"
 stagestuff="g77\$(exeext) g77-cross\$(exeext) f771\$(exeext)"
 
 target_libs=target-libf2c
+
+gtfiles="\$(srcdir)/f/com.c \$(srcdir)/f/com.h \$(srcdir)/f/ste.c"
diff --git a/gcc/f/ste.c b/gcc/f/ste.c
index 2959984c4b8..d7d84954eef 100644
--- a/gcc/f/ste.c
+++ b/gcc/f/ste.c
@@ -1162,13 +1162,13 @@ ffeste_io_douio_ (ffebld expr)
    declaration of variables (temporaries) to the expanding of expressions,
    statements, etc.  */
 
+static GTY(()) tree f2c_alist_struct;
 static tree
 ffeste_io_ialist_ (bool have_err,
 		   ffestvUnit unit,
 		   ffebld unit_expr,
 		   int unit_dflt)
 {
-  static tree f2c_alist_struct = NULL_TREE;
   tree t;
   tree ttype;
   tree field;
@@ -1193,8 +1193,6 @@ ffeste_io_ialist_ (bool have_err,
       TYPE_FIELDS (ref) = errfield;
       layout_type (ref);
 
-      ggc_add_tree_root (&f2c_alist_struct, 1);
-
       f2c_alist_struct = ref;
     }
 
@@ -1283,6 +1281,7 @@ ffeste_io_ialist_ (bool have_err,
    declaration of variables (temporaries) to the expanding of expressions,
    statements, etc.  */
 
+static GTY(()) tree f2c_cilist_struct;
 static tree
 ffeste_io_cilist_ (bool have_err,
 		   ffestvUnit unit,
@@ -1294,7 +1293,6 @@ ffeste_io_cilist_ (bool have_err,
 		   bool rec,
 		   ffebld rec_expr)
 {
-  static tree f2c_cilist_struct = NULL_TREE;
   tree t;
   tree ttype;
   tree field;
@@ -1325,8 +1323,6 @@ ffeste_io_cilist_ (bool have_err,
       TYPE_FIELDS (ref) = errfield;
       layout_type (ref);
 
-      ggc_add_tree_root (&f2c_cilist_struct, 1);
-
       f2c_cilist_struct = ref;
     }
 
@@ -1508,12 +1504,12 @@ ffeste_io_cilist_ (bool have_err,
    declaration of variables (temporaries) to the expanding of expressions,
    statements, etc.  */
 
+static GTY(()) tree f2c_close_struct;
 static tree
 ffeste_io_cllist_ (bool have_err,
 		   ffebld unit_expr,
 		   ffestpFile *stat_spec)
 {
-  static tree f2c_close_struct = NULL_TREE;
   tree t;
   tree ttype;
   tree field;
@@ -1541,8 +1537,6 @@ ffeste_io_cllist_ (bool have_err,
       TYPE_FIELDS (ref) = errfield;
       layout_type (ref);
 
-      ggc_add_tree_root (&f2c_close_struct, 1);
-
       f2c_close_struct = ref;
     }
 
@@ -1622,6 +1616,7 @@ ffeste_io_cllist_ (bool have_err,
    declaration of variables (temporaries) to the expanding of expressions,
    statements, etc.  */
 
+static GTY(()) tree f2c_icilist_struct;
 static tree
 ffeste_io_icilist_ (bool have_err,
 		    ffebld unit_expr,
@@ -1629,7 +1624,6 @@ ffeste_io_icilist_ (bool have_err,
 		    ffestvFormat format,
 		    ffestpFile *format_spec)
 {
-  static tree f2c_icilist_struct = NULL_TREE;
   tree t;
   tree ttype;
   tree field;
@@ -1663,8 +1657,6 @@ ffeste_io_icilist_ (bool have_err,
       TYPE_FIELDS (ref) = errfield;
       layout_type (ref);
 
-      ggc_add_tree_root (&f2c_icilist_struct, 1);
-
       f2c_icilist_struct = ref;
     }
 
@@ -1851,6 +1843,7 @@ ffeste_io_icilist_ (bool have_err,
    declaration of variables (temporaries) to the expanding of expressions,
    statements, etc.  */
 
+static GTY(()) tree f2c_inquire_struct;
 static tree
 ffeste_io_inlist_ (bool have_err,
 		   ffestpFile *unit_spec,
@@ -1870,7 +1863,6 @@ ffeste_io_inlist_ (bool have_err,
 		   ffestpFile *nextrec_spec,
 		   ffestpFile *blank_spec)
 {
-  static tree f2c_inquire_struct = NULL_TREE;
   tree t;
   tree ttype;
   tree field;
@@ -1959,8 +1951,6 @@ ffeste_io_inlist_ (bool have_err,
       TYPE_FIELDS (ref) = errfield;
       layout_type (ref);
 
-      ggc_add_tree_root (&f2c_inquire_struct, 1);
-
       f2c_inquire_struct = ref;
     }
 
@@ -2109,6 +2099,7 @@ ffeste_io_inlist_ (bool have_err,
    declaration of variables (temporaries) to the expanding of expressions,
    statements, etc.  */
 
+static GTY(()) tree f2c_open_struct;
 static tree
 ffeste_io_olist_ (bool have_err,
 		  ffebld unit_expr,
@@ -2119,7 +2110,6 @@ ffeste_io_olist_ (bool have_err,
 		  ffestpFile *recl_spec,
 		  ffestpFile *blank_spec)
 {
-  static tree f2c_open_struct = NULL_TREE;
   tree t;
   tree ttype;
   tree field;
@@ -2163,8 +2153,6 @@ ffeste_io_olist_ (bool have_err,
       TYPE_FIELDS (ref) = errfield;
       layout_type (ref);
 
-      ggc_add_tree_root (&f2c_open_struct, 1);
-
       f2c_open_struct = ref;
     }
 
@@ -4618,3 +4606,5 @@ ffeste_terminate_2 (void)
   assert (! ffeste_top_block_);
 }
 #endif
+
+#include "gt-f-ste.h"
diff --git a/gcc/f/where.c b/gcc/f/where.c
index 9f853545c67..e7d2e990090 100644
--- a/gcc/f/where.c
+++ b/gcc/f/where.c
@@ -33,7 +33,6 @@ the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
 #include "where.h"
 #include "lex.h"
 #include "malloc.h"
-#include "ggc.h"
 
 /* Externals defined here. */
 
@@ -109,32 +108,6 @@ 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 (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
@@ -144,18 +117,9 @@ mark_ffewhere_head (void *arg)
 void
 ffewhere_file_kill (ffewhereFile wf)
 {
-  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();
+  malloc_kill_ks (ffe_pool_file (), wf,
+		  offsetof (struct _ffewhere_file_, text)
+		  + wf->length + 1);
 }
 
 /* Create file object.  */
@@ -164,42 +128,14 @@ ffewhereFile
 ffewhere_file_new (const char *name, size_t length)
 {
   ffewhereFile wf;
-  int filepos;
- 
-  wf = ggc_alloc (offsetof (struct _ffewhere_file_, text)
-		  + length + 1);
+
+  wf = malloc_new_ks (ffe_pool_file (), "ffewhereFile",
+		      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;
 }