diff options
| -rw-r--r-- | gcc/f/ChangeLog | 44 | ||||
| -rw-r--r-- | gcc/f/Make-lang.in | 2 | ||||
| -rw-r--r-- | gcc/f/Makefile.in | 13 | ||||
| -rw-r--r-- | gcc/f/com.c | 260 | ||||
| -rw-r--r-- | gcc/f/com.h | 1 | ||||
| -rw-r--r-- | gcc/f/ggc.j | 29 | ||||
| -rw-r--r-- | gcc/f/lex.c | 3 | ||||
| -rw-r--r-- | gcc/f/ste.c | 37 | ||||
| -rw-r--r-- | gcc/f/where.c | 79 |
9 files changed, 340 insertions, 128 deletions
diff --git a/gcc/f/ChangeLog b/gcc/f/ChangeLog index 6e30f4f5a53..b1463dfbd9a 100644 --- a/gcc/f/ChangeLog +++ b/gcc/f/ChangeLog @@ -1,3 +1,47 @@ +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. diff --git a/gcc/f/Make-lang.in b/gcc/f/Make-lang.in index 1009b71008e..e791f2d20f5 100644 --- a/gcc/f/Make-lang.in +++ b/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`" \ diff --git a/gcc/f/Makefile.in b/gcc/f/Makefile.in index d369fad8b5e..77cc972ea35 100644 --- a/gcc/f/Makefile.in +++ b/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. diff --git a/gcc/f/com.c b/gcc/f/com.c index 92e028568fa..69d7e4578f7 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 "tree.j" #include "output.j" /* Must follow tree.j so TREE_CODE is defined! */ #include "convert.j" +#include "ggc.j" #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ #define FFECOM_GCC_INCLUDE 1 /* Enable -I. */ @@ -238,17 +239,12 @@ FILE *finput; tree string_type_node; -static tree double_ftype_double; -static tree float_ftype_float; -static tree ldouble_ftype_ldouble; - /* The rest of these are inventions for g77, though there might be similar things in the C front end. As they are found, these 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 tree ffecom_tree_ptr_to_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. */ @@ -6433,6 +6429,56 @@ ffecom_gfrt_tree_ (ffecomGfrt ix) /* Return initialize-to-zero expression for this VAR_DECL. */ #if FFECOM_targetCURRENT == FFECOM_targetGCC +/* 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 *next; + tree trees[NUM_TRACKED_CHUNK]; +} *tracker_head = NULL; + +static void +mark_tracker_head (arg) + 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]); + } +} + +void +ffecom_save_tree_forever (tree t) +{ + int i; + if (tracker_head != NULL) + for (i = 0; i < NUM_TRACKED_CHUNK; i++) + if (tracker_head->trees[i] == NULL) + { + tracker_head->trees[i] = t; + return; + } + + { + /* Need to allocate a new block. */ + struct tree_ggc_tracker *old_head = tracker_head; + + tracker_head = ggc_alloc (sizeof (*tracker_head)); + tracker_head->next = old_head; + tracker_head->trees[0] = t; + for (i = 1; i < NUM_TRACKED_CHUNK; i++) + tracker_head->trees[i] = NULL; + } +} + static tree ffecom_init_zero_ (tree decl) { @@ -6442,14 +6488,8 @@ ffecom_init_zero_ (tree decl) if (incremental) { - int momentary = suspend_momentary (); - push_obstacks_nochange (); - if (TREE_PERMANENT (decl)) - end_temporary_allocation (); make_decl_rtl (decl, NULL, TREE_PUBLIC (decl) ? 1 : 0); assemble_variable (decl, TREE_PUBLIC (decl) ? 1 : 0, 0, 1); - pop_obstacks (); - resume_momentary (momentary); } push_momentary (); @@ -6966,9 +7006,6 @@ ffecom_make_gfrt_ (ffecomGfrt ix) tree t; tree ttype; - push_obstacks_nochange (); - end_temporary_allocation (); - switch (ffecom_gfrt_type_[ix]) { case FFECOM_rttypeVOID_: @@ -7049,9 +7086,6 @@ ffecom_make_gfrt_ (ffecomGfrt ix) finish_decl (t, NULL_TREE, TRUE); - resume_temporary_allocation (); - pop_obstacks (); - ffecom_gfrt_[ix] = t; } @@ -7583,9 +7617,6 @@ ffecom_sym_transform_ (ffesymbol s) break; } - push_obstacks_nochange (); - end_temporary_allocation (); - t = build_decl (FUNCTION_DECL, ffecom_get_external_identifier_ (s), ffecom_tree_subr_type); /* Assume subr. */ @@ -7601,8 +7632,7 @@ ffecom_sym_transform_ (ffesymbol s) || (ffeglobal_type (g) == FFEGLOBAL_typeEXT))) ffeglobal_set_hook (g, t); - resume_temporary_allocation (); - pop_obstacks (); + ffecom_save_tree_forever (t); break; @@ -8247,9 +8277,6 @@ ffecom_sym_transform_ (ffesymbol s) break; } - push_obstacks_nochange (); - end_temporary_allocation (); - if (ffesymbol_is_f2c (s) && (ffesymbol_where (s) != FFEINFO_whereCONSTANT)) t = ffecom_tree_fun_type[bt][kt]; @@ -8270,8 +8297,7 @@ ffecom_sym_transform_ (ffesymbol s) || (ffeglobal_type (g) == FFEGLOBAL_typeEXT))) ffeglobal_set_hook (g, t); - resume_temporary_allocation (); - pop_obstacks (); + ffecom_save_tree_forever (t); break; @@ -8334,9 +8360,6 @@ ffecom_sym_transform_ (ffesymbol s) break; } - push_obstacks_nochange (); - end_temporary_allocation (); - t = build_decl (FUNCTION_DECL, ffecom_get_external_identifier_ (s), ffecom_tree_subr_type); @@ -8351,8 +8374,7 @@ ffecom_sym_transform_ (ffesymbol s) || (ffeglobal_type (g) == FFEGLOBAL_typeEXT))) ffeglobal_set_hook (g, t); - resume_temporary_allocation (); - pop_obstacks (); + ffecom_save_tree_forever (t); break; @@ -8421,9 +8443,6 @@ ffecom_sym_transform_ (ffesymbol s) case FFEINFO_whereGLOBAL: assert (!ffecom_transform_only_dummies_); - push_obstacks_nochange (); - end_temporary_allocation (); - t = build_decl (FUNCTION_DECL, ffecom_get_external_identifier_ (s), ffecom_tree_blockdata_type); @@ -8433,8 +8452,7 @@ ffecom_sym_transform_ (ffesymbol s) t = start_decl (t, FALSE); finish_decl (t, NULL_TREE, FALSE); - resume_temporary_allocation (); - pop_obstacks (); + ffecom_save_tree_forever (t); break; @@ -8757,9 +8775,6 @@ ffecom_transform_common_ (ffesymbol s) else init = NULL_TREE; - push_obstacks_nochange (); - end_temporary_allocation (); - /* cbtype must be permanently allocated! */ /* Allocate the MAX of the areas so far, seen filewide. */ @@ -8831,8 +8846,7 @@ ffecom_transform_common_ (ffesymbol s) ffestorag_set_hook (st, cbt); - resume_temporary_allocation (); - pop_obstacks (); + ffecom_save_tree_forever (cbt); } #endif @@ -9482,9 +9496,6 @@ ffecom_type_namelist_ () vardesctype = ffecom_type_vardesc_ (); - push_obstacks_nochange (); - end_temporary_allocation (); - type = make_node (RECORD_TYPE); vardesctype = build_pointer_type (build_pointer_type (vardesctype)); @@ -9498,8 +9509,7 @@ ffecom_type_namelist_ () TYPE_FIELDS (type) = namefield; layout_type (type); - resume_temporary_allocation (); - pop_obstacks (); + ggc_add_tree_root (&type, 1); } return type; @@ -9553,9 +9563,6 @@ ffecom_type_vardesc_ () if (type == NULL_TREE) { - push_obstacks_nochange (); - end_temporary_allocation (); - type = make_node (RECORD_TYPE); namefield = ffecom_decl_field (type, NULL_TREE, "name", @@ -9570,8 +9577,7 @@ ffecom_type_vardesc_ () TYPE_FIELDS (type) = namefield; layout_type (type); - resume_temporary_allocation (); - pop_obstacks (); + ggc_add_tree_root (&type, 1); } return type; @@ -11566,6 +11572,10 @@ ffecom_init_0 () tree field; ffetype type; ffetype base_type; + tree double_ftype_double; + tree float_ftype_float; + tree ldouble_ftype_ldouble; + tree ffecom_tree_ptr_to_fun_type_void; /* This block of code comes from the now-obsolete cktyps.c. It checks whether the compiler environment is buggy in known ways, some of which @@ -12392,9 +12402,6 @@ ffecom_lookup_label (ffelab label) break; case FFELAB_typeFORMAT: - push_obstacks_nochange (); - end_temporary_allocation (); - glabel = build_decl (VAR_DECL, ffecom_get_invented_identifier ("__g77_format_%d", (int) ffelab_value (label)), @@ -12409,8 +12416,7 @@ ffecom_lookup_label (ffelab label) make_decl_rtl (glabel, NULL, 0); expand_decl (glabel); - resume_temporary_allocation (); - pop_obstacks (); + ffecom_save_tree_forever (glabel); break; @@ -13777,17 +13783,6 @@ duplicate_decls (tree newdecl, tree olddecl) tree oldreturntype = TREE_TYPE (TREE_TYPE (olddecl)); tree newreturntype = TREE_TYPE (TREE_TYPE (newdecl)); - /* Make sure we put the new type in the same obstack as the old ones. - If the old types are not both in the same obstack, use the - permanent one. */ - if (TYPE_OBSTACK (oldtype) == TYPE_OBSTACK (newtype)) - push_obstacks (TYPE_OBSTACK (oldtype), TYPE_OBSTACK (oldtype)); - else - { - push_obstacks_nochange (); - end_temporary_allocation (); - } - if (TYPE_MODE (oldreturntype) == TYPE_MODE (newreturntype)) { /* Function types may be shared, so we can't just modify @@ -13800,8 +13795,6 @@ duplicate_decls (tree newdecl, tree olddecl) if (types_match) TREE_TYPE (olddecl) = newtype; } - - pop_obstacks (); } if (!types_match) return 0; @@ -13830,17 +13823,6 @@ duplicate_decls (tree newdecl, tree olddecl) if (types_match) { - /* Make sure we put the new type in the same obstack as the old ones. - If the old types are not both in the same obstack, use the permanent - one. */ - if (TYPE_OBSTACK (oldtype) == TYPE_OBSTACK (newtype)) - push_obstacks (TYPE_OBSTACK (oldtype), TYPE_OBSTACK (oldtype)); - else - { - push_obstacks_nochange (); - end_temporary_allocation (); - } - /* Merge the data types specified in the two decls. */ if (TREE_CODE (newdecl) != FUNCTION_DECL || !DECL_BUILT_IN (olddecl)) TREE_TYPE (newdecl) @@ -13919,8 +13901,6 @@ duplicate_decls (tree newdecl, tree olddecl) DECL_STATIC_DESTRUCTOR (newdecl) |= DECL_STATIC_DESTRUCTOR (olddecl); } #endif - - pop_obstacks (); } /* If cannot merge, then use the new type and qualifiers, and don't preserve the old rtl. */ @@ -14244,8 +14224,17 @@ finish_function (int nested) /* So we can tell if jump_optimize sets it to 1. */ can_reach_end = 0; + /* If this is a nested function, protect the local variables in the stack + above us from being collected while we're compiling this function. */ + if (ggc_p && nested) + ggc_push_context (); + /* Run the optimizers and output the assembler code for this function. */ rest_of_compilation (fndecl); + + /* Undo the GC context switch. */ + if (ggc_p && nested) + ggc_pop_context (); } /* Free all the tree nodes making up this function. */ @@ -14784,10 +14773,87 @@ incomplete_type_error (value, type) assert ("incomplete type?!?" == NULL); } +/* Mark ARG for GC. */ +static void +mark_binding_level (arg) + 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; + } +} + void init_decl_processing () { + static tree *const tree_roots[] = { + ¤t_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 < sizeof(tree_roots)/sizeof(tree_roots[0]); 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 (¤t_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 (); } @@ -15753,6 +15819,34 @@ unsigned_type (type) return type; } +/* Callback routines for garbage collection. */ + +int ggc_p = 1; + +void +lang_mark_tree (t) + union tree_node *t ATTRIBUTE_UNUSED; +{ + 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)); +} + +void +lang_mark_false_label_stack (l) + struct label_node *l; +{ + /* Fortran doesn't use false_label_stack. It better be NULL. */ + if (l != NULL) + abort(); +} + #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ #if FFECOM_GCC_INCLUDE diff --git a/gcc/f/com.h b/gcc/f/com.h index aa268931e47..84187a02bb0 100644 --- a/gcc/f/com.h +++ b/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); diff --git a/gcc/f/ggc.j b/gcc/f/ggc.j new file mode 100644 index 00000000000..1689b415cd4 --- /dev/null +++ b/gcc/f/ggc.j @@ -0,0 +1,29 @@ +/* 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 diff --git a/gcc/f/lex.c b/gcc/f/lex.c index b6198b215f1..cee6cabc4c4 100644 --- a/gcc/f/lex.c +++ b/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), diff --git a/gcc/f/ste.c b/gcc/f/ste.c index 0446daa57c5..6db4d48cce2 100644 --- a/gcc/f/ste.c +++ b/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; } diff --git a/gcc/f/where.c b/gcc/f/where.c index 2792899d410..1779098c50e 100644 --- a/gcc/f/where.c +++ b/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; } |