diff options
Diffstat (limited to 'gcc/f/com.c')
-rw-r--r-- | gcc/f/com.c | 265 |
1 files changed, 89 insertions, 176 deletions
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[] = { - ¤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 < 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 (¤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 (); } @@ -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" |