diff options
Diffstat (limited to 'gcc/f/com.c')
| -rw-r--r-- | gcc/f/com.c | 419 |
1 files changed, 22 insertions, 397 deletions
diff --git a/gcc/f/com.c b/gcc/f/com.c index 16050f69b2c..821a637fd5a 100644 --- a/gcc/f/com.c +++ b/gcc/f/com.c @@ -81,7 +81,6 @@ the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA /* Include files. */ #include "proj.h" -#if FFECOM_targetCURRENT == FFECOM_targetGCC #include "flags.h" #include "rtl.h" #include "toplev.h" @@ -91,9 +90,6 @@ the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA #include "ggc.h" #include "diagnostic.h" #include "langhooks.h" -#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ - -#define FFECOM_GCC_INCLUDE 1 /* Enable -I. */ /* VMS-specific definitions */ #ifdef VMS @@ -139,8 +135,6 @@ typedef struct { unsigned :16, :16, :16; } vms_ino_t; /* Externals defined here. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC - /* ~~gcc/tree.h *should* declare this, because toplev.c and dwarfout.c reference it. */ @@ -213,7 +207,6 @@ tree ffecom_f2c_ftnlen_two_node; tree ffecom_f2c_ptr_to_ftnlen_type_node; tree ffecom_f2c_ftnint_type_node; tree ffecom_f2c_ptr_to_ftnint_type_node; -#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ /* Simple definitions and enumerations. */ @@ -253,16 +246,13 @@ typedef enum /* Internal typedefs. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC typedef struct _ffecom_concat_list_ ffecomConcatList_; -#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ /* Private include files. */ /* Internal structure definitions. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC struct _ffecom_concat_list_ { ffebld *exprs; @@ -271,11 +261,9 @@ struct _ffecom_concat_list_ ffetargetCharacterSize minlen; ffetargetCharacterSize maxlen; }; -#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ /* Static functions (internal). */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_arglist_expr_ (const char *argstring, ffebld args); static tree ffecom_widest_expr_type_ (ffebld list); static bool ffecom_overlap_ (tree dest_decl, tree dest_offset, @@ -368,12 +356,10 @@ static tree ffecom_vardesc_array_ (ffesymbol s); static tree ffecom_vardesc_dims_ (ffesymbol s); static tree ffecom_convert_narrow_ (tree type, tree expr); static tree ffecom_convert_widen_ (tree type, tree expr); -#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ /* These are static functions that parallel those found in the C front end and thus have the same names. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree bison_rule_compstmt_ (void); static void bison_rule_pushlevel_ (void); static void delete_block (tree block); @@ -392,15 +378,12 @@ static tree storedecls (tree decls); static void store_parm_decls (int is_main_program); static tree start_decl (tree decl, bool is_top_level); static void start_function (tree name, tree type, int nested, int public); -#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ -#if FFECOM_GCC_INCLUDE static void ffecom_file_ (const char *name); static void ffecom_initialize_char_syntax_ (void); static void ffecom_close_include_ (FILE *f); static int ffecom_decode_include_option_ (char *spec); static FILE *ffecom_open_include_ (char *name, ffewhereLine l, ffewhereColumn c); -#endif /* FFECOM_GCC_INCLUDE */ /* Static objects accessed by functions in this module. */ @@ -408,7 +391,6 @@ 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_; -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_outer_function_decl_; static tree ffecom_previous_function_decl_; static tree ffecom_which_entrypoint_decl_; @@ -507,12 +489,9 @@ static const char *const ffecom_gfrt_argstring_[FFECOM_gfrt] #include "com-rt.def" #undef DEFGFRT }; -#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ /* Internal macros. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC - /* We let tm.h override the types used here, to handle trivial differences such as the choice of unsigned int or long unsigned int for size_t. When machines start needing nontrivial differences in the size type, @@ -634,8 +613,6 @@ static tree named_labels; /* A list of LABEL_DECLs from outer contexts that are currently shadowed. */ static tree shadowed_labels; - -#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ /* Return the subscript expression, modified to do range-checking. @@ -700,7 +677,7 @@ ffecom_subscript_check_ (tree array, tree element, int dim, int total_dims, else { /* Array reference substring range checking. */ - + cond = ffecom_2 (LE_EXPR, integer_type_node, low, element); @@ -980,7 +957,6 @@ ffecom_arrayref_ (tree item, ffebld expr, int want_ptr) and such might well be stable too, but for things like calculations, we do need to calculate a snapshot of a value before picking at it. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_stabilize_aggregate_ (tree ref) { @@ -1053,13 +1029,11 @@ ffecom_stabilize_aggregate_ (tree ref) return result; } -#endif /* A rip-off of gcc's convert.c convert_to_complex function, reworked to handle complex implemented as C structures (RECORD_TYPE with two fields, real and imaginary `r' and `i'). */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_convert_to_complex_ (tree type, tree expr) { @@ -1069,7 +1043,7 @@ ffecom_convert_to_complex_ (tree type, tree expr) assert (TREE_CODE (type) == RECORD_TYPE); subtype = TREE_TYPE (TYPE_FIELDS (type)); - + if (form == REAL_TYPE || form == INTEGER_TYPE || form == ENUMERAL_TYPE) { expr = convert (subtype, expr); @@ -1102,16 +1076,14 @@ ffecom_convert_to_complex_ (tree type, tree expr) error ("pointer value used where a complex was expected"); else error ("aggregate value used where a complex was expected"); - + return ffecom_2 (COMPLEX_EXPR, type, convert (subtype, integer_zero_node), convert (subtype, integer_zero_node)); } -#endif /* Like gcc's convert(), but crashes if widening might happen. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_convert_narrow_ (type, expr) tree type, expr; @@ -1180,11 +1152,9 @@ ffecom_convert_narrow_ (type, expr) assert ("conversion to non-scalar type requested" == NULL); return error_mark_node; } -#endif /* Like gcc's convert(), but crashes if narrowing might happen. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_convert_widen_ (type, expr) tree type, expr; @@ -1253,13 +1223,11 @@ ffecom_convert_widen_ (type, expr) assert ("conversion to non-scalar type requested" == NULL); return error_mark_node; } -#endif /* Handles making a COMPLEX type, either the standard (but buggy?) gbe way, or the safer (but less elegant?) f2c way. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_make_complex_type_ (tree subtype) { @@ -1284,12 +1252,10 @@ ffecom_make_complex_type_ (tree subtype) return type; } -#endif /* Chooses either the gbe or the f2c way to build a complex constant. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_build_complex_constant_ (tree type, tree realpart, tree imagpart) { @@ -1308,9 +1274,7 @@ ffecom_build_complex_constant_ (tree type, tree realpart, tree imagpart) return bothparts; } -#endif -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_arglist_expr_ (const char *c, ffebld expr) { @@ -1456,9 +1420,7 @@ ffecom_arglist_expr_ (const char *c, ffebld expr) return list; } -#endif -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_widest_expr_type_ (ffebld list) { @@ -1494,7 +1456,6 @@ ffecom_widest_expr_type_ (ffebld list) assert (t != NULL_TREE); return t; } -#endif /* Check whether a partial overlap between two expressions is possible. @@ -1546,7 +1507,6 @@ ffecom_possible_partial_overlap_ (ffebld expr1, ffebld expr2 ATTRIBUTE_UNUSED) change before it is finally modified. dest_* are the canonized destination itself. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static bool ffecom_overlap_ (tree dest_decl, tree dest_offset, tree dest_size, tree source_tree, ffebld source UNUSED, @@ -1726,12 +1686,10 @@ ffecom_overlap_ (tree dest_decl, tree dest_offset, tree dest_size, return TRUE; /* Destination and source overlap. */ } -#endif /* Check whether dest might overlap any of a list of arguments or is in a COMMON area the callee might know about (and thus modify). */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static bool ffecom_args_overlapping_ (tree dest_tree, ffebld dest UNUSED, tree args, tree callee_commons, @@ -1767,13 +1725,11 @@ ffecom_args_overlapping_ (tree dest_tree, ffebld dest UNUSED, return FALSE; } -#endif /* Build a string for a variable name as used by NAMELIST. This means that if we're using the f2c library, we build an uppercase string, since f2c does this. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_build_f2c_string_ (int i, const char *s) { @@ -1805,13 +1761,11 @@ ffecom_build_f2c_string_ (int i, const char *s) } } -#endif /* Returns CALL_EXPR or equivalent with given type (pass NULL_TREE for type to just get whatever the function returns), handling the f2c value-returning convention, if required, by prepending to the arglist a pointer to a temporary to receive the return value. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_call_ (tree fn, ffeinfoKindtype kt, bool is_f2c_complex, tree type, tree args, tree dest_tree, @@ -1875,12 +1829,10 @@ ffecom_call_ (tree fn, ffeinfoKindtype kt, bool is_f2c_complex, return item; } -#endif /* Given two arguments, transform them and make a call to the given function via ffecom_call_. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_call_binop_ (tree fn, ffeinfoKindtype kt, bool is_f2c_complex, tree type, ffebld left, ffebld right, @@ -1929,7 +1881,6 @@ ffecom_call_binop_ (tree fn, ffeinfoKindtype kt, bool is_f2c_complex, dest_tree, dest, dest_used, callee_commons, scalar_args, hook); } -#endif /* Return ptr/length args for char subexpression @@ -1941,7 +1892,6 @@ ffecom_call_binop_ (tree fn, ffeinfoKindtype kt, bool is_f2c_complex, Note that if with_null is TRUE, and the expression is an opCONTER, a null byte is appended to the string. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static void ffecom_char_args_x_ (tree *xitem, tree *length, ffebld expr, bool with_null) { @@ -2295,7 +2245,6 @@ ffecom_char_args_x_ (tree *xitem, tree *length, ffebld expr, bool with_null) *xitem = item; } -#endif /* Check the size of the type to be sure it doesn't overflow the "portable" capacities of the compiler back end. `dummy' types @@ -2304,7 +2253,6 @@ ffecom_char_args_x_ (tree *xitem, tree *length, ffebld expr, bool with_null) must still enforce its size requirements, though, and the back end takes care of this in stor-layout.c. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_check_size_overflow_ (ffesymbol s, tree type, bool dummy) { @@ -2331,13 +2279,11 @@ ffecom_check_size_overflow_ (ffesymbol s, tree type, bool dummy) return type; } -#endif /* Builds a length argument (PARM_DECL). Also wraps type in an array type where the dimension info is (1:size) where <size> is ffesymbol_size(s) if known, length_arg if not known (FFETARGET_charactersizeNONE). */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_char_enhance_arg_ (tree *xtype, ffesymbol s) { @@ -2356,9 +2302,7 @@ ffecom_char_enhance_arg_ (tree *xtype, ffesymbol s) else tlen = ffecom_get_invented_identifier ("__g77_%s", "length"); tlen = build_decl (PARM_DECL, tlen, ffecom_f2c_ftnlen_type_node); -#if BUILT_FOR_270 DECL_ARTIFICIAL (tlen) = 1; -#endif } if (sz == FFETARGET_charactersizeNONE) @@ -2381,7 +2325,6 @@ ffecom_char_enhance_arg_ (tree *xtype, ffesymbol s) return tlen; } -#endif /* ffecom_concat_list_gather_ -- Gather list of concatenated string exprs ffecomConcatList_ catlist; @@ -2392,14 +2335,13 @@ ffecom_char_enhance_arg_ (tree *xtype, ffesymbol s) Scans expr for character subexpressions, updates and returns catlist accordingly. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static ffecomConcatList_ ffecom_concat_list_gather_ (ffecomConcatList_ catlist, ffebld expr, ffetargetCharacterSize max) { ffetargetCharacterSize sz; -recurse: /* :::::::::::::::::::: */ + recurse: if (expr == NULL) return catlist; @@ -2495,7 +2437,6 @@ recurse: /* :::::::::::::::::::: */ } } -#endif /* ffecom_concat_list_kill_ -- Kill list of concatenated string exprs ffecomConcatList_ catlist; @@ -2503,7 +2444,6 @@ recurse: /* :::::::::::::::::::: */ Anything allocated within the list info is deallocated. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static void ffecom_concat_list_kill_ (ffecomConcatList_ catlist) { @@ -2512,13 +2452,11 @@ ffecom_concat_list_kill_ (ffecomConcatList_ catlist) catlist.max * sizeof (catlist.exprs[0])); } -#endif /* Make list of concatenated string exprs. Returns a flattened list of concatenated subexpressions given a tree of such expressions. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static ffecomConcatList_ ffecom_concat_list_new_ (ffebld expr, ffetargetCharacterSize max) { @@ -2528,13 +2466,10 @@ ffecom_concat_list_new_ (ffebld expr, ffetargetCharacterSize max) return ffecom_concat_list_gather_ (catlist, expr, max); } -#endif - /* Provide some kind of useful info on member of aggregate area, since current g77/gcc technology does not provide debug info on these members. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static void ffecom_debug_kludge_ (tree aggr, const char *aggr_type, ffesymbol member, tree member_type UNUSED, ffetargetOffset offset) @@ -2613,7 +2548,6 @@ ffecom_debug_kludge_ (tree aggr, const char *aggr_type, ffesymbol member, if (buff != &space[0]) malloc_kill_ks (malloc_pool_image (), buff, len + 1); } -#endif /* ffecom_do_entry_ -- Do compilation of a particular entrypoint @@ -2624,7 +2558,6 @@ ffecom_debug_kludge_ (tree aggr, const char *aggr_type, ffesymbol member, Makes a public entry point that calls our private master fn (already compiled). */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static void ffecom_do_entry_ (ffesymbol fn, int entrynum) { @@ -2981,7 +2914,6 @@ ffecom_do_entry_ (ffesymbol fn, int entrynum) ffecom_doing_entry_ = FALSE; } -#endif /* Transform expr into gcc tree with possible destination Recursive descent on expr while making corresponding tree nodes and @@ -2989,7 +2921,6 @@ ffecom_do_entry_ (ffesymbol fn, int entrynum) with temporary that would be made in certain cases, temporary isn't made, destination used instead, and dest_used flag set TRUE. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_expr_ (ffebld expr, tree dest_tree, ffebld dest, bool *dest_used, bool assignp, bool widenp) @@ -3240,7 +3171,7 @@ ffecom_expr_ (ffebld expr, tree dest_tree, ffebld dest, case FFEBLD_opUMINUS: left = ffecom_expr_ (ffebld_left (expr), NULL, NULL, NULL, FALSE, widenp); - if (tree_type_x) + if (tree_type_x) { tree_type = tree_type_x; left = convert (tree_type, left); @@ -3250,7 +3181,7 @@ ffecom_expr_ (ffebld expr, tree dest_tree, ffebld dest, case FFEBLD_opADD: left = ffecom_expr_ (ffebld_left (expr), NULL, NULL, NULL, FALSE, widenp); right = ffecom_expr_ (ffebld_right (expr), NULL, NULL, NULL, FALSE, widenp); - if (tree_type_x) + if (tree_type_x) { tree_type = tree_type_x; left = convert (tree_type, left); @@ -3261,7 +3192,7 @@ ffecom_expr_ (ffebld expr, tree dest_tree, ffebld dest, case FFEBLD_opSUBTRACT: left = ffecom_expr_ (ffebld_left (expr), NULL, NULL, NULL, FALSE, widenp); right = ffecom_expr_ (ffebld_right (expr), NULL, NULL, NULL, FALSE, widenp); - if (tree_type_x) + if (tree_type_x) { tree_type = tree_type_x; left = convert (tree_type, left); @@ -3272,7 +3203,7 @@ ffecom_expr_ (ffebld expr, tree dest_tree, ffebld dest, case FFEBLD_opMULTIPLY: left = ffecom_expr_ (ffebld_left (expr), NULL, NULL, NULL, FALSE, widenp); right = ffecom_expr_ (ffebld_right (expr), NULL, NULL, NULL, FALSE, widenp); - if (tree_type_x) + if (tree_type_x) { tree_type = tree_type_x; left = convert (tree_type, left); @@ -3283,7 +3214,7 @@ ffecom_expr_ (ffebld expr, tree dest_tree, ffebld dest, case FFEBLD_opDIVIDE: left = ffecom_expr_ (ffebld_left (expr), NULL, NULL, NULL, FALSE, widenp); right = ffecom_expr_ (ffebld_right (expr), NULL, NULL, NULL, FALSE, widenp); - if (tree_type_x) + if (tree_type_x) { tree_type = tree_type_x; left = convert (tree_type, left); @@ -3845,14 +3776,12 @@ ffecom_expr_ (ffebld expr, tree dest_tree, ffebld dest, #endif } -#endif /* Returns the tree that does the intrinsic invocation. Note: this function applies only to intrinsics returning CHARACTER*1 or non-CHARACTER results, and to intrinsic subroutines. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree, ffebld dest, bool *dest_used) @@ -5478,12 +5407,10 @@ ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree, the bottom of this source file. */ } -#endif /* For power (exponentiation) where right-hand operand is type INTEGER, generate in-line code to do it the fast way (which, if the operand is a constant, might just mean a series of multiplies). */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_expr_power_integer_ (ffebld expr) { @@ -5851,7 +5778,6 @@ ffecom_expr_power_integer_ (ffebld expr) return result; } -#endif /* ffecom_expr_transform_ -- Transform symbols in expr ffebld expr; // FFE expression. @@ -5859,14 +5785,13 @@ ffecom_expr_power_integer_ (ffebld expr) Recursive descent on expr while transforming any untransformed SYMTERs. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static void ffecom_expr_transform_ (ffebld expr) { tree t; ffesymbol s; -tail_recurse: /* :::::::::::::::::::: */ + tail_recurse: if (expr == NULL) return; @@ -5914,10 +5839,8 @@ tail_recurse: /* :::::::::::::::::::: */ return; } -#endif /* Make a type based on info in live f2c.h file. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static void ffecom_f2c_make_type_ (tree *type, int tcode, const char *name) { @@ -5986,8 +5909,6 @@ ffecom_f2c_make_type_ (tree *type, int tcode, const char *name) *type)); } -#endif -#if FFECOM_targetCURRENT == FFECOM_targetGCC /* Set the f2c list-directed-I/O code for whatever (integral) type has the given size. */ @@ -6008,12 +5929,10 @@ ffecom_f2c_set_lio_code_ (ffeinfoBasictype bt, int size, } } -#endif /* Finish up globals after doing all program units in file Need to handle only uninitialized COMMON areas. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static ffeglobal ffecom_finish_global_ (ffeglobal global) { @@ -6056,10 +5975,8 @@ ffecom_finish_global_ (ffeglobal global) return global; } -#endif /* Finish up any untransformed symbols. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static ffesymbol ffecom_finish_symbol_transform_ (ffesymbol s) { @@ -6103,12 +6020,10 @@ ffecom_finish_symbol_transform_ (ffesymbol s) return s; } -#endif /* Append underscore(s) to name before calling get_identifier. "us" is nonzero if the name already contains an underscore and thus needs two underscores appended. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_get_appended_identifier_ (char us, const char *name) { @@ -6130,11 +6045,9 @@ ffecom_get_appended_identifier_ (char us, const char *name) return id; } -#endif /* Decide whether to append underscore to name before calling get_identifier. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_get_external_identifier_ (ffesymbol s) { @@ -6160,7 +6073,6 @@ ffecom_get_external_identifier_ (ffesymbol s) return ffecom_get_appended_identifier_ (us, name); } -#endif /* Decide whether to append underscore to internal name before calling get_identifier. @@ -6176,7 +6088,6 @@ ffecom_get_external_identifier_ (ffesymbol s) If the name does contain an underscore, then transform it just like we transform an external identifier. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_get_identifier_ (const char *name) { @@ -6190,7 +6101,6 @@ ffecom_get_identifier_ (const char *name) name); } -#endif /* ffecom_gen_sfuncdef_ -- Generate definition of statement function tree t; @@ -6201,7 +6111,6 @@ ffecom_get_identifier_ (const char *name) Call after setting up containing function and getting trees for all other symbols. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_gen_sfuncdef_ (ffesymbol s, ffeinfoBasictype bt, ffeinfoKindtype kt) { @@ -6330,17 +6239,12 @@ ffecom_gen_sfuncdef_ (ffesymbol s, ffeinfoBasictype bt, ffeinfoKindtype kt) return func; } -#endif - -#if FFECOM_targetCURRENT == FFECOM_targetGCC static const char * ffecom_gfrt_args_ (ffecomGfrt ix) { return ffecom_gfrt_argstring_[ix]; } -#endif -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_gfrt_tree_ (ffecomGfrt ix) { @@ -6352,25 +6256,23 @@ ffecom_gfrt_tree_ (ffecomGfrt ix) ffecom_gfrt_[ix]); } -#endif /* 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 +static struct tree_ggc_tracker { struct tree_ggc_tracker *next; tree trees[NUM_TRACKED_CHUNK]; } *tracker_head = NULL; -static void +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) @@ -6396,7 +6298,7 @@ ffecom_save_tree_forever (tree t) { /* 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; @@ -6438,8 +6340,6 @@ ffecom_init_zero_ (tree decl) return init; } -#endif -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_intrinsic_ichar_ (tree tree_type, ffebld arg, tree *maybe_tree) @@ -6543,7 +6443,6 @@ ffecom_intrinsic_ichar_ (tree tree_type, ffebld arg, } } -#endif /* ffecom_intrinsic_len_ -- Return length info for char arg (LEN()) tree length_arg; @@ -6554,7 +6453,6 @@ ffecom_intrinsic_ichar_ (tree tree_type, ffebld arg, subexpressions by constructing the appropriate tree for the length-of-character-text argument in a calling sequence. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_intrinsic_len_ (ffebld expr) { @@ -6695,14 +6593,12 @@ ffecom_intrinsic_len_ (ffebld expr) return length; } -#endif /* Handle CHARACTER assignments. Generates code to do the assignment. Used by ordinary assignment statement handler ffecom_let_stmt and by statement-function handler to generate code for a statement function. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static void ffecom_let_char_ (tree dest_tree, tree dest_length, ffetargetCharacterSize dest_size, ffebld source) @@ -6904,7 +6800,6 @@ ffecom_let_char_ (tree dest_tree, tree dest_length, ffecom_concat_list_kill_ (catlist); } -#endif /* ffecom_make_gfrt_ -- Make initial info for run-time routine ffecomGfrt ix; @@ -6913,7 +6808,6 @@ ffecom_let_char_ (tree dest_tree, tree dest_length, Assumes gfrt_[ix] is NULL_TREE, and replaces it with the FUNCTION_DECL for the indicated run-time routine (ix). */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static void ffecom_make_gfrt_ (ffecomGfrt ix) { @@ -7012,10 +6906,8 @@ ffecom_make_gfrt_ (ffecomGfrt ix) ffecom_gfrt_[ix] = t; } -#endif /* Phase 1 pass over each member of a COMMON/EQUIVALENCE group. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static void ffecom_member_phase1_ (ffestorag mst UNUSED, ffestorag st) { @@ -7025,12 +6917,10 @@ ffecom_member_phase1_ (ffestorag mst UNUSED, ffestorag st) ffecom_member_namelisted_ = TRUE; } -#endif /* Phase 2 pass over each member of a COMMON/EQUIVALENCE group. Declare the member so debugger will see it. Otherwise nobody should be referencing the member. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static void ffecom_member_phase2_ (ffestorag mst, ffestorag st) { @@ -7075,7 +6965,6 @@ ffecom_member_phase2_ (ffestorag mst, ffestorag st) finish_decl (t, NULL_TREE, FALSE); } -#endif /* Prepare source expression for assignment into a destination perhaps known to be of a specific size. */ @@ -7131,7 +7020,6 @@ ffecom_prepare_let_char_ (ffetargetCharacterSize dest_size, ffebld source) always known by both the caller and the callee, though the code allows for someday permitting CHAR*(*) stmtfunc dummies). */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static void ffecom_push_dummy_decls_ (ffebld dummy_list, bool stmtfunc) { @@ -7201,13 +7089,11 @@ ffecom_push_dummy_decls_ (ffebld dummy_list, bool stmtfunc) ffecom_transform_only_dummies_ = FALSE; } -#endif /* ffecom_start_progunit_ -- Beginning of program unit Does GNU back end stuff necessary to teach it about the start of its equivalent of a Fortran program unit. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static void ffecom_start_progunit_ () { @@ -7430,7 +7316,6 @@ ffecom_start_progunit_ () ffesymbol_drive (ffecom_finish_symbol_transform_); } -#endif /* ffecom_sym_transform_ -- Transform FFE sym into backend sym ffesymbol s; @@ -7439,7 +7324,6 @@ ffecom_start_progunit_ () The ffesymbol_hook info for s is updated with appropriate backend info on the symbol. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static ffesymbol ffecom_sym_transform_ (ffesymbol s) { @@ -7503,9 +7387,7 @@ ffecom_sym_transform_ (ffesymbol s) t = build_decl (PARM_DECL, ffecom_get_identifier_ (ffesymbol_text (s)), ffecom_tree_ptr_to_subr_type); -#if BUILT_FOR_270 DECL_ARTIFICIAL (t) = 1; -#endif addr = TRUE; break; @@ -7972,9 +7854,7 @@ ffecom_sym_transform_ (ffesymbol s) } t = build_decl (PARM_DECL, t, type); -#if BUILT_FOR_270 DECL_ARTIFICIAL (t) = 1; -#endif /* If this arg is present in every entry point's list of dummy args, then we're done. */ @@ -8194,9 +8074,7 @@ ffecom_sym_transform_ (ffesymbol s) t = build_decl (PARM_DECL, ffecom_get_identifier_ (ffesymbol_text (s)), t); -#if BUILT_FOR_270 DECL_ARTIFICIAL (t) = 1; -#endif addr = TRUE; break; @@ -8264,9 +8142,7 @@ ffecom_sym_transform_ (ffesymbol s) t = build_decl (PARM_DECL, ffecom_get_identifier_ (ffesymbol_text (s)), ffecom_tree_ptr_to_subr_type); -#if BUILT_FOR_270 DECL_ARTIFICIAL (t) = 1; -#endif addr = TRUE; break; @@ -8459,7 +8335,6 @@ ffecom_sym_transform_ (ffesymbol s) return s; } -#endif /* Transform into ASSIGNable symbol. Symbol has already been transformed, but for whatever reason, the @@ -8468,7 +8343,6 @@ ffecom_sym_transform_ (ffesymbol s) another local symbol of type void * and stuff that in the assign_tree argument. The F77/F90 standards allow this implementation. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static ffesymbol ffecom_sym_transform_assign_ (ffesymbol s) { @@ -8542,7 +8416,6 @@ ffecom_sym_transform_assign_ (ffesymbol s) return s; } -#endif /* Implement COMMON area in back end. Because COMMON-based variables can be referenced in the dimension @@ -8571,7 +8444,6 @@ ffecom_sym_transform_assign_ (ffesymbol s) though we might do that as well just for debugging purposes (and stuff the rtl with the appropriate offset expression). */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static void ffecom_transform_common_ (ffesymbol s) { @@ -8723,10 +8595,8 @@ ffecom_transform_common_ (ffesymbol s) ffecom_save_tree_forever (cbt); } -#endif /* Make master area for local EQUIVALENCE. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static void ffecom_transform_equiv_ (ffestorag eqst) { @@ -8856,10 +8726,8 @@ ffecom_transform_equiv_ (ffestorag eqst) eqst); } -#endif /* Implement NAMELIST in back end. See f2c/format.c for more info. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_transform_namelist_ (ffesymbol s) { @@ -8939,14 +8807,11 @@ ffecom_transform_namelist_ (ffesymbol s) return nmlt; } -#endif - /* A subroutine of ffecom_tree_canonize_ref_. The incoming tree is analyzed on the assumption it is calculating a pointer to be indirected through. It must return the proper decl and offset, taking into account different units of measurements for offsets. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static void ffecom_tree_canonize_ptr_ (tree *decl, tree *offset, tree t) @@ -9001,7 +8866,6 @@ ffecom_tree_canonize_ptr_ (tree *decl, tree *offset, break; } } -#endif /* Given a tree that is possibly intended for use as an lvalue, return information representing a canonical view of that tree as a decl, an @@ -9034,7 +8898,6 @@ ffecom_tree_canonize_ptr_ (tree *decl, tree *offset, whereas converting the array offsets to consistant offsets will reveal the overlap. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static void ffecom_tree_canonize_ref_ (tree *decl, tree *offset, tree *size, tree t) @@ -9186,11 +9049,9 @@ ffecom_tree_canonize_ref_ (tree *decl, tree *offset, return; } } -#endif /* Do divide operation appropriate to type of operands. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_tree_divide_ (tree tree_type, tree left, tree right, tree dest_tree, ffebld dest, bool *dest_used, @@ -9278,10 +9139,8 @@ ffecom_tree_divide_ (tree tree_type, tree left, tree right, } } -#endif /* Build type info for non-dummy variable. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_type_localvar_ (ffesymbol s, ffeinfoBasictype bt, ffeinfoKindtype kt) @@ -9338,10 +9197,8 @@ ffecom_type_localvar_ (ffesymbol s, ffeinfoBasictype bt, return type; } -#endif /* Build Namelist type. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_type_namelist_ () { @@ -9373,11 +9230,8 @@ ffecom_type_namelist_ () return type; } -#endif - /* Build Vardesc type. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_type_vardesc_ () { @@ -9406,9 +9260,6 @@ ffecom_type_vardesc_ () return type; } -#endif - -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_vardesc_ (ffebld expr) { @@ -9497,8 +9348,6 @@ ffecom_vardesc_ (ffebld expr) return ffesymbol_hook (s).vardesc_tree; } -#endif -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_vardesc_array_ (ffesymbol s) { @@ -9544,8 +9393,6 @@ ffecom_vardesc_array_ (ffesymbol s) return var; } -#endif -#if FFECOM_targetCURRENT == FFECOM_targetGCC static tree ffecom_vardesc_dims_ (ffesymbol s) { @@ -9655,14 +9502,12 @@ ffecom_vardesc_dims_ (ffesymbol s) } } -#endif /* Essentially does a "fold (build1 (code, type, node))" while checking for certain housekeeping things. NOTE: for building an ADDR_EXPR around a FUNCTION_DECL, use ffecom_1_fn instead. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_1 (enum tree_code code, tree type, tree node) { @@ -9720,7 +9565,6 @@ ffecom_1 (enum tree_code code, tree type, tree node) TREE_CONSTANT (item) = 1; return fold (item); } -#endif /* Like ffecom_1 (ADDR_EXPR, TREE_TYPE (node), node), except handles TREE_CODE (node) == FUNCTION_DECL. In particular, @@ -9728,7 +9572,6 @@ ffecom_1 (enum tree_code code, tree type, tree node) function does not mean the function needs to be separately compiled). */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_1_fn (tree node) { @@ -9749,12 +9592,10 @@ ffecom_1_fn (tree node) TREE_CONSTANT (item) = 1; return fold (item); } -#endif /* Essentially does a "fold (build (code, type, node1, node2))" while checking for certain housekeeping things. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_2 (enum tree_code code, tree type, tree node1, tree node2) @@ -9923,7 +9764,6 @@ ffecom_2 (enum tree_code code, tree type, tree node1, return fold (item); } -#endif /* ffecom_2pass_advise_entrypoint -- Advise that there's this entrypoint ffesymbol s; // the ENTRY point itself @@ -9942,7 +9782,6 @@ ffecom_2 (enum tree_code code, tree type, tree node1, 03-Jan-92 JCB 2.0 Return FALSE if the return type conflicts with previous entrypoints. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC bool ffecom_2pass_advise_entrypoint (ffesymbol entry) { @@ -10080,7 +9919,6 @@ ffecom_2pass_advise_entrypoint (ffesymbol entry) return TRUE; } -#endif /* ffecom_2pass_do_entrypoint -- Do compilation of entrypoint ffesymbol s; // the ENTRY point itself @@ -10090,7 +9928,6 @@ ffecom_2pass_advise_entrypoint (ffesymbol entry) happen. Must be called for each entrypoint after ffecom_finish_progunit is called. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC void ffecom_2pass_do_entrypoint (ffesymbol entry) { @@ -10111,13 +9948,10 @@ ffecom_2pass_do_entrypoint (ffesymbol entry) ffecom_do_entry_ (entry, ent_num); } -#endif - /* Essentially does a "fold (build (code, type, node1, node2))" while checking for certain housekeeping things. Always sets TREE_SIDE_EFFECTS. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_2s (enum tree_code code, tree type, tree node1, tree node2) @@ -10134,11 +9968,9 @@ ffecom_2s (enum tree_code code, tree type, tree node1, return fold (item); } -#endif /* Essentially does a "fold (build (code, type, node1, node2, node3))" while checking for certain housekeeping things. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_3 (enum tree_code code, tree type, tree node1, tree node2, tree node3) @@ -10158,12 +9990,10 @@ ffecom_3 (enum tree_code code, tree type, tree node1, return fold (item); } -#endif /* Essentially does a "fold (build (code, type, node1, node2, node3))" while checking for certain housekeeping things. Always sets TREE_SIDE_EFFECTS. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_3s (enum tree_code code, tree type, tree node1, tree node2, tree node3) @@ -10181,8 +10011,6 @@ ffecom_3s (enum tree_code code, tree type, tree node1, return fold (item); } -#endif - /* ffecom_arg_expr -- Transform argument expr into gcc tree See use by ffecom_list_expr. @@ -10200,7 +10028,6 @@ ffecom_3s (enum tree_code code, tree type, tree node1, we allow CHARACTER*(*) dummies to statement functions, we'll need it). */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_arg_expr (ffebld expr, tree *length) { @@ -10217,7 +10044,6 @@ ffecom_arg_expr (ffebld expr, tree *length) return ffecom_arg_ptr_to_expr (expr, &ign); } -#endif /* Transform expression into constant argument-pointer-to-expression tree. If the expression can be transformed into a argument-pointer-to-expression @@ -10286,7 +10112,6 @@ ffecom_arg_ptr_to_const_expr (ffebld expr, tree *length) length argument. This might even be seen as a feature, if a null byte can always be appended. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_arg_ptr_to_expr (ffebld expr, tree *length) { @@ -10529,7 +10354,6 @@ ffecom_arg_ptr_to_expr (ffebld expr, tree *length) return item; } -#endif /* Generate call to run-time function. The first arg is the GNU Fortran Run-Time function index, the second @@ -10537,7 +10361,6 @@ ffecom_arg_ptr_to_expr (ffebld expr, tree *length) (WITHOUT TREE_SIDE_EFFECTS set!) that makes the call and returns the result (which may be void). */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_call_gfrt (ffecomGfrt ix, tree args, tree hook) { @@ -10547,11 +10370,9 @@ ffecom_call_gfrt (ffecomGfrt ix, tree args, tree hook) NULL_TREE, args, NULL_TREE, NULL, NULL, NULL_TREE, TRUE, hook); } -#endif /* Transform constant-union to tree. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_constantunion (ffebldConstantUnion *cu, ffeinfoBasictype bt, ffeinfoKindtype kt, tree tree_type) @@ -10819,8 +10640,6 @@ ffecom_constantunion (ffebldConstantUnion *cu, ffeinfoBasictype bt, return item; } -#endif - /* Transform expression into constant tree. If the expression can be transformed into a tree that is constant, @@ -10860,7 +10679,6 @@ ffecom_const_expr (ffebld expr) /* Handy way to make a field in a struct/union. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_decl_field (tree context, tree prevfield, const char *name, tree type) @@ -10877,35 +10695,25 @@ ffecom_decl_field (tree context, tree prevfield, return field; } -#endif - void ffecom_close_include (FILE *f) { -#if FFECOM_GCC_INCLUDE ffecom_close_include_ (f); -#endif } int ffecom_decode_include_option (char *spec) { -#if FFECOM_GCC_INCLUDE return ffecom_decode_include_option_ (spec); -#else - return 1; -#endif } /* End a compound statement (block). */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_end_compstmt (void) { return bison_rule_compstmt_ (); } -#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ /* ffecom_end_transition -- Perform end transition on all symbols @@ -10916,28 +10724,20 @@ ffecom_end_compstmt (void) void ffecom_end_transition () { -#if FFECOM_targetCURRENT == FFECOM_targetGCC ffebld item; -#endif if (ffe_is_ffedebug ()) fprintf (dmpout, "; end_stmt_transition\n"); -#if FFECOM_targetCURRENT == FFECOM_targetGCC ffecom_list_blockdata_ = NULL; ffecom_list_common_ = NULL; -#endif ffesymbol_drive (ffecom_sym_end_transition); if (ffe_is_ffedebug ()) { ffestorag_report (); -#if FFECOM_targetCURRENT == FFECOM_targetFFE - ffesymbol_report_all (); -#endif } -#if FFECOM_targetCURRENT == FFECOM_targetGCC ffecom_start_progunit_ (); for (item = ffecom_list_blockdata_; @@ -10988,7 +10788,6 @@ ffecom_end_transition () ffecom_transform_common_ (ffebld_symter (ffebld_head (item))); ffecom_list_common_ = NULL; -#endif } /* ffecom_exec_transition -- Perform exec transition on all symbols @@ -11014,9 +10813,6 @@ ffecom_exec_transition () if (ffe_is_ffedebug ()) { ffestorag_report (); -#if FFECOM_targetCURRENT == FFECOM_targetFFE - ffesymbol_report_all (); -#endif } if (inhibited) @@ -11028,7 +10824,6 @@ ffecom_exec_transition () Convert dest and source using ffecom_expr, then join them with an ASSIGN op and pass the whole thing to expand_expr_stmt. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC void ffecom_expand_let_stmt (ffebld dest, ffebld source) { @@ -11138,7 +10933,6 @@ ffecom_expand_let_stmt (ffebld dest, ffebld source) source); } -#endif /* ffecom_expr -- Transform expr into gcc tree tree t; @@ -11148,41 +10942,34 @@ ffecom_expand_let_stmt (ffebld dest, ffebld source) Recursive descent on expr while making corresponding tree nodes and attaching type info and such. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_expr (ffebld expr) { return ffecom_expr_ (expr, NULL_TREE, NULL, NULL, FALSE, FALSE); } -#endif /* Like ffecom_expr, but return tree usable for assigned GOTO or FORMAT. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_expr_assign (ffebld expr) { return ffecom_expr_ (expr, NULL_TREE, NULL, NULL, TRUE, FALSE); } -#endif /* Like ffecom_expr_rw, but return tree usable for ASSIGN. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_expr_assign_w (ffebld expr) { return ffecom_expr_ (expr, NULL_TREE, NULL, NULL, TRUE, FALSE); } -#endif /* Transform expr for use as into read/write tree and stabilize the reference. Not for use on CHARACTER expressions. Recursive descent on expr while making corresponding tree nodes and attaching type info and such. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_expr_rw (tree type, ffebld expr) { @@ -11193,14 +10980,12 @@ ffecom_expr_rw (tree type, ffebld expr) return stabilize_reference (ffecom_expr (expr)); } -#endif /* Transform expr for use as into write tree and stabilize the reference. Not for use on CHARACTER expressions. Recursive descent on expr while making corresponding tree nodes and attaching type info and such. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_expr_w (tree type, ffebld expr) { @@ -11211,10 +10996,8 @@ ffecom_expr_w (tree type, ffebld expr) return stabilize_reference (ffecom_expr (expr)); } -#endif /* Do global stuff. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC void ffecom_finish_compile () { @@ -11224,10 +11007,8 @@ ffecom_finish_compile () ffeglobal_drive (ffecom_finish_global_); } -#endif /* Public entry point for front end to access finish_decl. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC void ffecom_finish_decl (tree decl, tree init, bool is_top_level) { @@ -11235,10 +11016,8 @@ ffecom_finish_decl (tree decl, tree init, bool is_top_level) finish_decl (decl, init, FALSE); } -#endif /* Finish a program unit. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC void ffecom_finish_progunit () { @@ -11250,11 +11029,8 @@ ffecom_finish_progunit () finish_function (0); } -#endif - /* Wrapper for get_identifier. pattern is sprintf-like. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_get_invented_identifier (const char *pattern, ...) { @@ -11420,9 +11196,7 @@ ffecom_init_0 () } } -#if FFECOM_GCC_INCLUDE ffecom_initialize_char_syntax_ (); -#endif ffecom_outer_function_decl_ = NULL_TREE; current_function_decl = NULL_TREE; @@ -11962,9 +11736,7 @@ ffecom_init_0 () builtin_function ("__builtin_cosl", ldouble_ftype_ldouble, BUILT_IN_COS, BUILT_IN_NORMAL, "cosl"); -#if BUILT_FOR_270 pedantic_lvalues = FALSE; -#endif ffecom_f2c_make_type_ (&ffecom_f2c_integer_type_node, FFECOM_f2cINTEGER, @@ -12080,12 +11852,10 @@ ffecom_init_0 () #endif } -#endif /* ffecom_init_2 -- Initialize ffecom_init_2(); */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC void ffecom_init_2 () { @@ -12101,7 +11871,6 @@ ffecom_init_2 () ffecom_multi_retval_ = NULL_TREE; } -#endif /* ffecom_list_expr -- Transform list of exprs into gcc tree tree t; @@ -12110,7 +11879,6 @@ ffecom_init_2 () List of actual args is transformed into corresponding gcc backend list. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_list_expr (ffebld expr) { @@ -12142,7 +11910,6 @@ ffecom_list_expr (ffebld expr) return list; } -#endif /* ffecom_list_ptr_to_expr -- Transform list of exprs into gcc tree tree t; @@ -12152,7 +11919,6 @@ ffecom_list_expr (ffebld expr) List of actual args is transformed into corresponding gcc backend list for use in calling an external procedure (vs. a statement function). */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_list_ptr_to_expr (ffebld expr) { @@ -12184,10 +11950,8 @@ ffecom_list_ptr_to_expr (ffebld expr) return list; } -#endif /* Obtain gcc's LABEL_DECL tree for label. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_lookup_label (ffelab label) { @@ -12247,13 +12011,11 @@ ffecom_lookup_label (ffelab label) return glabel; } -#endif /* Stabilizes the arguments. Don't use this if the lhs and rhs come from a single source specification (as in the fourth argument of MVBITS). If the type is NULL_TREE, the type of lhs is used to make the type of the MODIFY_EXPR. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_modify (tree newtype, tree lhs, tree rhs) @@ -12270,16 +12032,12 @@ ffecom_modify (tree newtype, tree lhs, return ffecom_2s (MODIFY_EXPR, newtype, lhs, rhs); } -#endif - /* Register source file name. */ void ffecom_file (const char *name) { -#if FFECOM_GCC_INCLUDE ffecom_file_ (name); -#endif } /* ffecom_notify_init_storage -- An aggregate storage is now fully init'ed @@ -12314,10 +12072,6 @@ void ffecom_notify_init_storage (ffestorag st) { ffebld init; /* The initialization expression. */ -#if 0 && FFECOM_targetCURRENT == FFECOM_targetGCC - ffetargetOffset size; /* The size of the entity. */ - ffetargetAlign pad; /* Its initial padding. */ -#endif if (ffestorag_init (st) == NULL) { @@ -12325,50 +12079,8 @@ ffecom_notify_init_storage (ffestorag st) assert (init != NULL); ffestorag_set_accretion (st, NULL); ffestorag_set_accretes (st, 0); - -#if 0 && FFECOM_targetCURRENT == FFECOM_targetGCC - /* For GNU backend, just turn ACCTER into ARRTER and proceed. */ - size = ffebld_accter_size (init); - pad = ffebld_accter_pad (init); - ffebit_kill (ffebld_accter_bits (init)); - ffebld_set_op (init, FFEBLD_opARRTER); - ffebld_set_arrter (init, ffebld_accter (init)); - ffebld_arrter_set_size (init, size); - ffebld_arrter_set_pad (init, size); -#endif - -#if FFECOM_TWOPASS ffestorag_set_init (st, init); -#endif } -#if FFECOM_ONEPASS - else - init = ffestorag_init (st); -#endif - -#if FFECOM_ONEPASS /* Process the inits, wipe 'em out. */ - ffestorag_set_init (st, ffebld_new_any ()); - - if (ffebld_op (init) == FFEBLD_opANY) - return; /* Oh, we already did this! */ - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - { - ffesymbol s; - - if (ffestorag_symbol (st) != NULL) - s = ffestorag_symbol (st); - else - s = ffestorag_typesymbol (st); - - fprintf (dmpout, "= initialize_storage \"%s\" ", - (s != NULL) ? ffesymbol_text (s) : "(unnamed)"); - ffebld_dump (init); - fputc ('\n', dmpout); - } -#endif - -#endif /* if FFECOM_ONEPASS */ } /* ffecom_notify_init_symbol -- A symbol is now fully init'ed @@ -12403,10 +12115,6 @@ void ffecom_notify_init_symbol (ffesymbol s) { ffebld init; /* The initialization expression. */ -#if 0 && FFECOM_targetCURRENT == FFECOM_targetGCC - ffetargetOffset size; /* The size of the entity. */ - ffetargetAlign pad; /* Its initial padding. */ -#endif if (ffesymbol_storage (s) == NULL) return; /* Do nothing until COMMON/EQUIVALENCE @@ -12417,40 +12125,8 @@ ffecom_notify_init_symbol (ffesymbol s) { ffesymbol_set_accretion (s, NULL); ffesymbol_set_accretes (s, 0); - -#if 0 && FFECOM_targetCURRENT == FFECOM_targetGCC - /* For GNU backend, just turn ACCTER into ARRTER and proceed. */ - size = ffebld_accter_size (init); - pad = ffebld_accter_pad (init); - ffebit_kill (ffebld_accter_bits (init)); - ffebld_set_op (init, FFEBLD_opARRTER); - ffebld_set_arrter (init, ffebld_accter (init)); - ffebld_arrter_set_size (init, size); - ffebld_arrter_set_pad (init, size); -#endif - -#if FFECOM_TWOPASS ffesymbol_set_init (s, init); -#endif } -#if FFECOM_ONEPASS - else - init = ffesymbol_init (s); -#endif - -#if FFECOM_ONEPASS - ffesymbol_set_init (s, ffebld_new_any ()); - - if (ffebld_op (init) == FFEBLD_opANY) - return; /* Oh, we already did this! */ - -#if FFECOM_targetCURRENT == FFECOM_targetFFE - fprintf (dmpout, "= initialize_symbol \"%s\" ", ffesymbol_text (s)); - ffebld_dump (init); - fputc ('\n', dmpout); -#endif - -#endif /* if FFECOM_ONEPASS */ } /* ffecom_notify_primary_entry -- Learn which is the primary entry point @@ -12482,7 +12158,6 @@ ffecom_notify_primary_entry (ffesymbol s) fprintf (stderr, " %s:\n", ffesymbol_text (s)); } -#if FFECOM_targetCURRENT == FFECOM_targetGCC if (ffecom_primary_entry_kind_ == FFEINFO_kindSUBROUTINE) { ffebld list; @@ -12500,17 +12175,12 @@ ffecom_notify_primary_entry (ffesymbol s) } } } -#endif } FILE * ffecom_open_include (char *name, ffewhereLine l, ffewhereColumn c) { -#if FFECOM_GCC_INCLUDE return ffecom_open_include_ (name, l, c); -#else - return fopen (name, "r"); -#endif } /* ffecom_ptr_to_expr -- Transform expr into gcc tree with & in front @@ -12521,7 +12191,6 @@ ffecom_open_include (char *name, ffewhereLine l, ffewhereColumn c) Like ffecom_expr, but sticks address-of in front of most things. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_ptr_to_expr (ffebld expr) { @@ -12624,7 +12293,6 @@ ffecom_ptr_to_expr (ffebld expr) return error_mark_node; } -#endif /* Obtain a temp var with given data type. size is FFETARGET_charactersizeNONE for a non-CHARACTER type @@ -12632,7 +12300,6 @@ ffecom_ptr_to_expr (ffebld expr) elements is -1 for a scalar or > 0 for an array of type. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_make_tempvar (const char *commentary, tree type, ffetargetCharacterSize size, int elements) @@ -12667,7 +12334,6 @@ ffecom_make_tempvar (const char *commentary, tree type, return t; } -#endif /* Prepare argument pointer to expression. @@ -13040,7 +12706,6 @@ ffecom_ptr_to_const_expr (ffebld expr) meaning no return value or the caller expects it to be returned somewhere else (which is handled by other parts of this module). */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_return_expr (ffebld expr) { @@ -13111,30 +12776,24 @@ ffecom_return_expr (ffebld expr) return rtn; } -#endif /* Do save_expr only if tree is not error_mark_node. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_save_tree (tree t) { return save_expr (t); } -#endif /* Start a compound statement (block). */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC void ffecom_start_compstmt (void) { bison_rule_pushlevel_ (); } -#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ /* Public entry point for front end to access start_decl. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_start_decl (tree decl, bool is_initialized) { @@ -13142,7 +12801,6 @@ ffecom_start_decl (tree decl, bool is_initialized) return start_decl (decl, FALSE); } -#endif /* ffecom_sym_commit -- Symbol's state being committed to reality ffesymbol s; @@ -13151,14 +12809,12 @@ ffecom_start_decl (tree decl, bool is_initialized) Does whatever the backend needs when a symbol is committed after having been backtrackable for a period of time. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC void ffecom_sym_commit (ffesymbol s UNUSED) { assert (!ffesymbol_retractable ()); } -#endif /* ffecom_sym_end_transition -- Perform end transition on all symbols ffecom_sym_end_transition(); @@ -13178,7 +12834,6 @@ ffecom_sym_end_transition (ffesymbol s) s = ffest_sym_end_transition (s); -#if FFECOM_targetCURRENT == FFECOM_targetGCC if ((ffesymbol_kind (s) == FFEINFO_kindBLOCKDATA) && (ffesymbol_where (s) == FFEINFO_whereGLOBAL)) { @@ -13188,7 +12843,6 @@ ffecom_sym_end_transition (ffesymbol s) FFEINTRIN_impNONE), ffecom_list_blockdata_); } -#endif /* This is where we finally notice that a symbol has partial initialization and finalize it. */ @@ -13206,7 +12860,6 @@ ffecom_sym_end_transition (ffesymbol s) ffecom_notify_init_storage (st); } -#if FFECOM_targetCURRENT == FFECOM_targetGCC if ((ffesymbol_kind (s) == FFEINFO_kindCOMMON) && (ffesymbol_where (s) == FFEINFO_whereLOCAL) && (ffesymbol_storage (s) != NULL)) @@ -13217,7 +12870,6 @@ ffecom_sym_end_transition (ffesymbol s) FFEINTRIN_impNONE), ffecom_list_common_); } -#endif return s; } @@ -13295,7 +12947,6 @@ ffecom_sym_learned (ffesymbol s) Does whatever the backend needs when a symbol is retracted after having been backtrackable for a period of time. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC void ffecom_sym_retract (ffesymbol s UNUSED) { @@ -13327,10 +12978,8 @@ ffecom_sym_retract (ffesymbol s UNUSED) #endif } -#endif /* Create temporary gcc label. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_temp_label () { @@ -13347,35 +12996,29 @@ ffecom_temp_label () return glabel; } -#endif /* Return an expression that is usable as an arg in a conditional context (IF, DO WHILE, .NOT., and so on). Use the one provided for the back end as of >2.6.0. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_truth_value (tree expr) { return truthvalue_conversion (expr); } -#endif /* Return the inversion of a truth value (the inversion of what ffecom_truth_value builds). Apparently invert_truthvalue, which is properly in the back end, is enough for now, so just use it. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_truth_value_invert (tree expr) { return invert_truthvalue (ffecom_truth_value (expr)); } -#endif - /* Return the tree that is the type of the expression, as would be returned in TREE_TYPE(ffecom_expr(expr)), without otherwise transforming the expression, generating temporaries, etc. */ @@ -13451,7 +13094,6 @@ ffecom_type_expr (ffebld expr) run time with the entrypoint number (0 for SUBROUTINE/FUNCTION, 1 for first ENTRY statement, and so on). */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC tree ffecom_which_entrypoint_decl () { @@ -13459,8 +13101,6 @@ ffecom_which_entrypoint_decl () return ffecom_which_entrypoint_decl_; } - -#endif /* The following sections consists of private and public functions that have the same names and perform roughly the same functions @@ -13477,8 +13117,6 @@ ffecom_which_entrypoint_decl () Functions named after rule "foo:" in c-parse.y are named "bison_rule_foo_" so they are easy to find. */ -#if FFECOM_targetCURRENT == FFECOM_targetGCC - static void bison_rule_pushlevel_ () { @@ -13699,13 +13337,11 @@ duplicate_decls (tree newdecl, tree olddecl) if (DECL_SECTION_NAME (newdecl) == NULL_TREE) DECL_SECTION_NAME (newdecl) = DECL_SECTION_NAME (olddecl); -#if BUILT_FOR_270 if (TREE_CODE (newdecl) == FUNCTION_DECL) { DECL_STATIC_CONSTRUCTOR(newdecl) |= DECL_STATIC_CONSTRUCTOR(olddecl); DECL_STATIC_DESTRUCTOR (newdecl) |= DECL_STATIC_DESTRUCTOR (olddecl); } -#endif } /* If cannot merge, then use the new type and qualifiers, and don't preserve the old rtl. */ @@ -14015,7 +13651,6 @@ lang_printable_name (tree decl, int v) /* g77's function to print out name of current function that caused an error. */ -#if BUILT_FOR_270 static void lang_print_error_function (diagnostic_context *context __attribute__((unused)), const char *file) @@ -14087,7 +13722,6 @@ lang_print_error_function (diagnostic_context *context __attribute__((unused)), last_s = s; } } -#endif /* Similar to `lookup_name' but look only at current binding level. */ @@ -14480,7 +14114,7 @@ incomplete_type_error (value, type) } /* Mark ARG for GC. */ -static void +static void mark_binding_level (void *arg) { struct binding_level *level = *(struct binding_level **) arg; @@ -14546,11 +14180,11 @@ init_decl_processing () /* 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], + ggc_add_tree_root (&ffecom_tree_type[0][0], FFEINFO_basictype*FFEINFO_kindtype); - ggc_add_tree_root (&ffecom_tree_fun_type[0][0], + 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], + 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, @@ -14584,9 +14218,7 @@ init_parse (filename) /* Make identifier nodes long enough for the language-specific slots. */ set_identifier_size (sizeof (struct lang_identifier)); decl_printable_name = lang_printable_name; -#if BUILT_FOR_270 print_error_function = lang_print_error_function; -#endif return filename; } @@ -14989,9 +14621,7 @@ pushdecl (x) { if (IDENTIFIER_INVENTED (name)) { -#if BUILT_FOR_270 DECL_ARTIFICIAL (x) = 1; -#endif DECL_IN_SYSTEM_HEADER (x) = 1; } @@ -15557,7 +15187,7 @@ unsigned_type (type) return type; } -void +void lang_mark_tree (t) union tree_node *t ATTRIBUTE_UNUSED; { @@ -15571,11 +15201,7 @@ lang_mark_tree (t) else if (TYPE_P (t) && TYPE_LANG_SPECIFIC (t)) ggc_mark (TYPE_LANG_SPECIFIC (t)); } - -#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */ -#if FFECOM_GCC_INCLUDE - /* From gcc/cccp.c, the code to handle -I. */ /* Skip leading "./" from a directory name. @@ -16254,7 +15880,6 @@ ffecom_open_include_ (char *name, ffewhereLine l, ffewhereColumn c) return f; } -#endif /* FFECOM_GCC_INCLUDE */ /**INDENT* (Do not reformat this comment even with -fca option.) Data-gathering files: Given the source file listed below, compiled with @@ -16740,12 +16365,12 @@ typedef doublereal E_f; // real function with -R not specified // void pow_ci(); double pow_dd(); void pow_zz(); - double acos(), r_imag(), r_int(), log(), r_lg10(), r_mod(), r_nint(), + double acos(), r_imag(), r_int(), log(), r_lg10(), r_mod(), r_nint(), asin(), atan(), atan2(), c_abs(); void c_cos(), c_exp(), c_log(), r_cnjg(); double cos(), cosh(); void c_sin(), c_sqrt(); - double d_dim(), exp(), r_dim(), d_int(), d_lg10(), d_mod(), d_nint(), + double d_dim(), exp(), r_dim(), d_int(), d_lg10(), d_mod(), d_nint(), d_sign(), sin(), sinh(), sqrt(), tan(), tanh(); integer i_dim(), i_dnnt(), i_indx(), i_sign(), i_len(); logical l_ge(), l_gt(), l_le(), l_lt(); @@ -16753,7 +16378,7 @@ typedef doublereal E_f; // real function with -R not specified // double r_sign(); // Local variables // - extern // Subroutine // int fooa_(), fooc_(), food_(), fooi_(), foor_(), + extern // Subroutine // int fooa_(), fooc_(), food_(), fooi_(), foor_(), fool_(), fooz_(), getem_(); static char a1[10], a2[10]; static complex c1, c2; |
