appropriate _tree_type array element. */
static GTY(()) tree ffecom_tree_fun_type[FFEINFO_basictype][FFEINFO_kindtype];
-static GTY(()) tree
+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 void start_function (tree name, tree type, int nested, int public);
static void ffecom_file_ (const char *name);
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);
(((struct lang_identifier *)(NODE))->invented)
/* The resulting tree type. */
-union lang_tree_node
+union lang_tree_node
GTY((desc ("TREE_CODE (&%h.generic) == IDENTIFIER_NODE"),
chain_next ("(union lang_tree_node *)TREE_CHAIN (&%h.generic)")))
{
- union tree_node GTY ((tag ("0"),
- desc ("tree_node_structure (&%h)")))
+ 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_decl GTY(())
{
};
struct lang_type GTY(())
arg3);
arg4 = convert (ffecom_f2c_ftnint_type_node,
- build_int_2 (lineno, 0));
+ build_int_2 (input_line, 0));
arg1 = build_tree_list (NULL_TREE, arg1);
arg2 = build_tree_list (NULL_TREE, arg2);
CHARACTER. */
bool cmplxfunc; /* Use f2c way of returning COMPLEX. */
bool multi; /* Master fn has multiple return types. */
- bool altreturning = FALSE; /* This entry point has alternate returns. */
- int old_lineno = lineno;
- const char *old_input_filename = input_filename;
+ bool altreturning = FALSE; /* This entry point has alternate
+ returns. */
+ location_t old_loc = input_location;
input_filename = ffesymbol_where_filename (fn);
- lineno = ffesymbol_where_filelinenum (fn);
+ input_line = ffesymbol_where_filelinenum (fn);
ffecom_doing_entry_ = TRUE; /* Don't bother with array dimensions. */
finish_function (0);
- lineno = old_lineno;
- input_filename = old_input_filename;
+ input_location = old_loc;
ffecom_doing_entry_ = FALSE;
}
if (!ffe_is_underscoring ()
|| (strcmp (name, FFETARGET_nameBLANK_COMMON) == 0)
-#if FFETARGET_isENFORCED_MAIN_NAME
- || (strcmp (name, FFETARGET_nameENFORCED_NAME) == 0)
-#else
|| (strcmp (name, FFETARGET_nameUNNAMED_MAIN) == 0)
-#endif
|| (strcmp (name, FFETARGET_nameUNNAMED_BLOCK_DATA) == 0))
return get_identifier (name);
tree result;
bool charfunc = (bt == FFEINFO_basictypeCHARACTER);
static bool recurse = FALSE;
- int old_lineno = lineno;
- const char *old_input_filename = input_filename;
+ location_t old_loc = input_location;
ffecom_nested_entry_ = s;
see how it works at this point. */
input_filename = ffesymbol_where_filename (s);
- lineno = ffesymbol_where_filelinenum (s);
+ input_line = ffesymbol_where_filelinenum (s);
/* Pretransform the expression so any newly discovered things belong to the
outer program unit, not to the statement function. */
recurse = FALSE;
- lineno = old_lineno;
- input_filename = old_input_filename;
+ input_location = old_loc;
ffecom_nested_entry_ = NULL;
&& (ffecom_primary_entry_kind_ == FFEINFO_kindFUNCTION)
&& (ffecom_master_bt_ == FFEINFO_basictypeNONE);
bool main_program = FALSE;
- int old_lineno = lineno;
- const char *old_input_filename = input_filename;
+ location_t old_loc = input_location;
assert (fn != NULL);
assert (ffesymbol_hook (fn).decl_tree == NULL_TREE);
input_filename = ffesymbol_where_filename (fn);
- lineno = ffesymbol_where_filelinenum (fn);
+ input_line = ffesymbol_where_filelinenum (fn);
switch (ffecom_primary_entry_kind_)
{
/* Disallow temp vars at this level. */
current_binding_level->prep_state = 2;
- lineno = old_lineno;
- input_filename = old_input_filename;
+ input_location = old_loc;
/* This handles any symbols still untransformed, in case -g specified.
This used to be done in ffecom_finish_progunit, but it turns out to
ffeinfoBasictype bt;
ffeinfoKindtype kt;
ffeglobal g;
- int old_lineno = lineno;
- const char *old_input_filename = input_filename;
+ location_t old_loc = input_location;
/* Must ensure special ASSIGN variables are declared at top of outermost
block, else they'll end up in the innermost block when their first
if (ffesymbol_sfdummyparent (s) == NULL)
{
input_filename = ffesymbol_where_filename (s);
- lineno = ffesymbol_where_filelinenum (s);
+ input_line = ffesymbol_where_filelinenum (s);
}
else
{
ffesymbol sf = ffesymbol_sfdummyparent (s);
input_filename = ffesymbol_where_filename (sf);
- lineno = ffesymbol_where_filelinenum (sf);
+ input_line = ffesymbol_where_filelinenum (sf);
}
bt = ffeinfo_basictype (ffebld_info (s));
ffestorag st = ffesymbol_storage (s);
tree type;
- if ((st != NULL)
- && (ffestorag_size (st) == 0))
+ type = ffecom_type_localvar_ (s, bt, kt);
+
+ if (type == error_mark_node)
{
t = error_mark_node;
break;
}
- type = ffecom_type_localvar_ (s, bt, kt);
-
- if (type == error_mark_node)
+ if ((st != NULL)
+ && (ffestorag_size (st) == 0))
{
t = error_mark_node;
break;
DECL_EXTERNAL (t) = 1;
TREE_PUBLIC (t) = 1;
- t = start_decl (t, FALSE);
- finish_decl (t, NULL_TREE, FALSE);
+ t = start_decl (t, TRUE);
+ finish_decl (t, NULL_TREE, TRUE);
if ((g != NULL)
&& ((ffeglobal_type (g) == FFEGLOBAL_typeSUBR)
ffesymbol_hook (s).length_tree = tlen;
ffesymbol_hook (s).addr = addr;
- lineno = old_lineno;
- input_filename = old_input_filename;
+ input_location = old_loc;
return s;
}
ffecom_sym_transform_assign_ (ffesymbol s)
{
tree t; /* Transformed thingy. */
- int old_lineno = lineno;
- const char *old_input_filename = input_filename;
+ location_t old_loc = input_location;
if (ffesymbol_sfdummyparent (s) == NULL)
{
input_filename = ffesymbol_where_filename (s);
- lineno = ffesymbol_where_filelinenum (s);
+ input_line = ffesymbol_where_filelinenum (s);
}
else
{
ffesymbol sf = ffesymbol_sfdummyparent (s);
input_filename = ffesymbol_where_filename (sf);
- lineno = ffesymbol_where_filelinenum (sf);
+ input_line = ffesymbol_where_filelinenum (sf);
}
assert (!ffecom_transform_only_dummies_);
ffesymbol_hook (s).assign_tree = t;
- lineno = old_lineno;
- input_filename = old_input_filename;
+ input_location = old_loc;
return s;
}
case FFEBLD_opPERCENT_DESCR:
switch (ffeinfo_basictype (ffebld_info (expr)))
{
-#ifdef PASS_HOLLERITH_BY_DESCRIPTOR
- case FFEINFO_basictypeHOLLERITH:
-#endif
case FFEINFO_basictypeCHARACTER:
break; /* Passed by descriptor anyway. */
break;
}
-#ifdef PASS_HOLLERITH_BY_DESCRIPTOR
- if ((ffeinfo_basictype (ffebld_info (expr)) == FFEINFO_basictypeHOLLERITH)
- && (length != NULL))
- { /* Pass Hollerith by descriptor. */
- ffetargetHollerith h;
-
- assert (ffebld_op (expr) == FFEBLD_opCONTER);
- h = ffebld_cu_val_hollerith (ffebld_constant_union
- (ffebld_conter (expr)));
- *length
- = build_int_2 (h.length, 0);
- TREE_TYPE (*length) = ffecom_f2c_ftnlen_type_node;
- }
-#endif
-
if (ffeinfo_basictype (ffebld_info (expr)) != FFEINFO_basictypeCHARACTER)
return ffecom_ptr_to_expr (expr);
{
case FFEINFO_basictypeINTEGER:
{
- int val;
+ HOST_WIDE_INT hi, lo;
switch (kt)
{
#if FFETARGET_okINTEGER1
case FFEINFO_kindtypeINTEGER1:
- val = ffebld_cu_val_integer1 (*cu);
+ lo = ffebld_cu_val_integer1 (*cu);
+ hi = (lo < 0) ? -1 : 0;
break;
#endif
#if FFETARGET_okINTEGER2
case FFEINFO_kindtypeINTEGER2:
- val = ffebld_cu_val_integer2 (*cu);
+ lo = ffebld_cu_val_integer2 (*cu);
+ hi = (lo < 0) ? -1 : 0;
break;
#endif
#if FFETARGET_okINTEGER3
case FFEINFO_kindtypeINTEGER3:
- val = ffebld_cu_val_integer3 (*cu);
+ lo = ffebld_cu_val_integer3 (*cu);
+ hi = (lo < 0) ? -1 : 0;
break;
#endif
#if FFETARGET_okINTEGER4
case FFEINFO_kindtypeINTEGER4:
- val = ffebld_cu_val_integer4 (*cu);
+#if HOST_BITS_PER_LONGLONG > HOST_BITS_PER_WIDE_INT
+ {
+ long long int big = ffebld_cu_val_integer4 (*cu);
+ hi = (HOST_WIDE_INT) (big >> HOST_BITS_PER_WIDE_INT);
+ lo = (HOST_WIDE_INT) big;
+ }
+#else
+ lo = ffebld_cu_val_integer4 (*cu);
+ hi = (lo < 0) ? -1 : 0;
+#endif
break;
#endif
case FFEINFO_kindtypeANY:
return error_mark_node;
}
- item = build_int_2 (val, (val < 0) ? -1 : 0);
+ item = build_int_2 (lo, hi);
TREE_TYPE (item) = tree_type;
}
break;
break;
#endif
-#if FFETARGET_okREAL4
- case FFEINFO_kindtypeREAL4:
- val = ffetarget_value_real4 (ffebld_cu_val_real4 (*cu));
- break;
-#endif
-
default:
assert ("bad REAL constant kind type" == NULL);
/* Fall through. */
break;
#endif
-#if FFETARGET_okCOMPLEX4
- case FFEINFO_kindtypeREAL4:
- real = ffetarget_value_real4 (ffebld_cu_val_complex4 (*cu).real);
- imag = ffetarget_value_real4 (ffebld_cu_val_complex4 (*cu).imaginary);
- break;
-#endif
-
default:
assert ("bad REAL constant kind type" == NULL);
/* Fall through. */
{
#if FFETARGET_okINTEGER1
case FFEBLD_constINTEGER1:
- val = ffebld_cu_val_integer1 (*cu);
+ val = ffebld_cu_val_integer1 (*cu);
item = build_int_2 (val, (val < 0) ? -1 : 0);
break;
#endif
#endif
#if FFETARGET_okINTEGER4
case FFEBLD_constINTEGER4:
+#if HOST_BITS_PER_LONGLONG > HOST_BITS_PER_WIDE_INT
+ {
+ long long int big = ffebld_cu_val_integer4 (*cu);
+ item = build_int_2 ((HOST_WIDE_INT) big,
+ (HOST_WIDE_INT)
+ (big >> HOST_BITS_PER_WIDE_INT));
+ }
+#else
val = ffebld_cu_val_integer4 (*cu);
item = build_int_2 (val, (val < 0) ? -1 : 0);
+#endif
break;
#endif
#if FFETARGET_okLOGICAL1
if (ffebld_arity (expr) == 0
&& (ffebld_op (expr) != FFEBLD_opSYMTER
-#if NEWCOMMON
- /* ~~Enable once common/equivalence is handled properly? */
- || ffebld_where (expr) == FFEINFO_whereCOMMON
-#endif
|| ffebld_where (expr) == FFEINFO_whereGLOBAL
|| ffebld_where (expr) == FFEINFO_whereINTRINSIC))
{
ffecom_close_include_ (f);
}
-int
-ffecom_decode_include_option (char *spec)
-{
- return ffecom_decode_include_option_ (spec);
-}
-
/* End a compound statement (block). */
tree
expr_tree = source_tree;
else if (assign_temp)
{
-#ifdef MOVE_EXPR
- /* The back end understands a conceptual move (evaluate source;
- store into dest), so use that, in case it can determine
- that it is going to use, say, two registers as temporaries
- anyway. So don't use the temp (and someday avoid generating
- it, once this code starts triggering regularly). */
- expr_tree = ffecom_2s (MOVE_EXPR, void_type_node,
- dest_tree,
- source_tree);
-#else
expr_tree = ffecom_2s (MODIFY_EXPR, void_type_node,
assign_temp,
source_tree);
expr_tree = ffecom_2s (MODIFY_EXPR, void_type_node,
dest_tree,
assign_temp);
-#endif
}
else
expr_tree = ffecom_2s (MODIFY_EXPR, void_type_node,
tree field;
ffetype type;
ffetype base_type;
- tree double_ftype_double;
- tree float_ftype_float;
- tree ldouble_ftype_ldouble;
+ tree double_ftype_double, double_ftype_double_double;
+ tree float_ftype_float, float_ftype_float_float;
+ tree ldouble_ftype_ldouble, ldouble_ftype_ldouble_ldouble;
tree ffecom_tree_ptr_to_fun_type_void;
/* This block of code comes from the now-obsolete cktyps.c. It checks
endlink = tree_cons (NULL_TREE, void_type_node, NULL_TREE);
- float_ftype_float
- = build_function_type (float_type_node,
- tree_cons (NULL_TREE, float_type_node, endlink));
+ t = tree_cons (NULL_TREE, float_type_node, endlink);
+ float_ftype_float = build_function_type (float_type_node, t);
+ t = tree_cons (NULL_TREE, float_type_node, t);
+ float_ftype_float_float = build_function_type (float_type_node, t);
- double_ftype_double
- = build_function_type (double_type_node,
- tree_cons (NULL_TREE, double_type_node, endlink));
+ t = tree_cons (NULL_TREE, double_type_node, endlink);
+ double_ftype_double = build_function_type (double_type_node, t);
+ t = tree_cons (NULL_TREE, double_type_node, t);
+ double_ftype_double_double = build_function_type (double_type_node, t);
- ldouble_ftype_ldouble
- = build_function_type (long_double_type_node,
- tree_cons (NULL_TREE, long_double_type_node,
- endlink));
+ t = tree_cons (NULL_TREE, long_double_type_node, endlink);
+ ldouble_ftype_ldouble = build_function_type (long_double_type_node, t);
+ t = tree_cons (NULL_TREE, long_double_type_node, t);
+ ldouble_ftype_ldouble_ldouble = build_function_type (long_double_type_node,
+ t);
for (i = 0; ((size_t) i) < ARRAY_SIZE (ffecom_tree_type); ++i)
for (j = 0; ((size_t) j) < ARRAY_SIZE (ffecom_tree_type[0]); ++j)
ffecom_tree_blockdata_type
= build_function_type (void_type_node, NULL_TREE);
- builtin_function ("__builtin_sqrtf", float_ftype_float,
- BUILT_IN_SQRTF, BUILT_IN_NORMAL, "sqrtf", NULL_TREE);
- builtin_function ("__builtin_sqrt", double_ftype_double,
- BUILT_IN_SQRT, BUILT_IN_NORMAL, "sqrt", NULL_TREE);
- builtin_function ("__builtin_sqrtl", ldouble_ftype_ldouble,
- BUILT_IN_SQRTL, BUILT_IN_NORMAL, "sqrtl", NULL_TREE);
- builtin_function ("__builtin_sinf", float_ftype_float,
- BUILT_IN_SINF, BUILT_IN_NORMAL, "sinf", NULL_TREE);
- builtin_function ("__builtin_sin", double_ftype_double,
- BUILT_IN_SIN, BUILT_IN_NORMAL, "sin", NULL_TREE);
- builtin_function ("__builtin_sinl", ldouble_ftype_ldouble,
- BUILT_IN_SINL, BUILT_IN_NORMAL, "sinl", NULL_TREE);
+ builtin_function ("__builtin_atanf", float_ftype_float,
+ BUILT_IN_ATANF, BUILT_IN_NORMAL, "atanf", NULL_TREE);
+ builtin_function ("__builtin_atan", double_ftype_double,
+ BUILT_IN_ATAN, BUILT_IN_NORMAL, "atan", NULL_TREE);
+ builtin_function ("__builtin_atanl", ldouble_ftype_ldouble,
+ BUILT_IN_ATANL, BUILT_IN_NORMAL, "atanl", NULL_TREE);
+
+ builtin_function ("__builtin_atan2f", float_ftype_float_float,
+ BUILT_IN_ATAN2F, BUILT_IN_NORMAL, "atan2f", NULL_TREE);
+ builtin_function ("__builtin_atan2", double_ftype_double_double,
+ BUILT_IN_ATAN2, BUILT_IN_NORMAL, "atan2", NULL_TREE);
+ builtin_function ("__builtin_atan2l", ldouble_ftype_ldouble_ldouble,
+ BUILT_IN_ATAN2L, BUILT_IN_NORMAL, "atan2l", NULL_TREE);
+
builtin_function ("__builtin_cosf", float_ftype_float,
BUILT_IN_COSF, BUILT_IN_NORMAL, "cosf", NULL_TREE);
builtin_function ("__builtin_cos", double_ftype_double,
builtin_function ("__builtin_cosl", ldouble_ftype_ldouble,
BUILT_IN_COSL, BUILT_IN_NORMAL, "cosl", NULL_TREE);
+ builtin_function ("__builtin_expf", float_ftype_float,
+ BUILT_IN_EXPF, BUILT_IN_NORMAL, "expf", NULL_TREE);
+ builtin_function ("__builtin_exp", double_ftype_double,
+ BUILT_IN_EXP, BUILT_IN_NORMAL, "exp", NULL_TREE);
+ builtin_function ("__builtin_expl", ldouble_ftype_ldouble,
+ BUILT_IN_EXPL, BUILT_IN_NORMAL, "expl", NULL_TREE);
+
+ builtin_function ("__builtin_floorf", float_ftype_float,
+ BUILT_IN_FLOORF, BUILT_IN_NORMAL, "floorf", NULL_TREE);
+ builtin_function ("__builtin_floor", double_ftype_double,
+ BUILT_IN_FLOOR, BUILT_IN_NORMAL, "floor", NULL_TREE);
+ builtin_function ("__builtin_floorl", ldouble_ftype_ldouble,
+ BUILT_IN_FLOORL, BUILT_IN_NORMAL, "floorl", NULL_TREE);
+
+ builtin_function ("__builtin_fmodf", float_ftype_float_float,
+ BUILT_IN_FMODF, BUILT_IN_NORMAL, "fmodf", NULL_TREE);
+ builtin_function ("__builtin_fmod", double_ftype_double_double,
+ BUILT_IN_FMOD, BUILT_IN_NORMAL, "fmod", NULL_TREE);
+ builtin_function ("__builtin_fmodl", ldouble_ftype_ldouble_ldouble,
+ BUILT_IN_FMODL, BUILT_IN_NORMAL, "fmodl", NULL_TREE);
+
+ builtin_function ("__builtin_logf", float_ftype_float,
+ BUILT_IN_LOGF, BUILT_IN_NORMAL, "logf", NULL_TREE);
+ builtin_function ("__builtin_log", double_ftype_double,
+ BUILT_IN_LOG, BUILT_IN_NORMAL, "log", NULL_TREE);
+ builtin_function ("__builtin_logl", ldouble_ftype_ldouble,
+ BUILT_IN_LOGL, BUILT_IN_NORMAL, "logl", NULL_TREE);
+
+ builtin_function ("__builtin_powf", float_ftype_float_float,
+ BUILT_IN_POWF, BUILT_IN_NORMAL, "powf", NULL_TREE);
+ builtin_function ("__builtin_pow", double_ftype_double_double,
+ BUILT_IN_POW, BUILT_IN_NORMAL, "pow", NULL_TREE);
+ builtin_function ("__builtin_powl", ldouble_ftype_ldouble_ldouble,
+ BUILT_IN_POWL, BUILT_IN_NORMAL, "powl", NULL_TREE);
+
+ builtin_function ("__builtin_sinf", float_ftype_float,
+ BUILT_IN_SINF, BUILT_IN_NORMAL, "sinf", NULL_TREE);
+ builtin_function ("__builtin_sin", double_ftype_double,
+ BUILT_IN_SIN, BUILT_IN_NORMAL, "sin", NULL_TREE);
+ builtin_function ("__builtin_sinl", ldouble_ftype_ldouble,
+ BUILT_IN_SINL, BUILT_IN_NORMAL, "sinl", NULL_TREE);
+
+ builtin_function ("__builtin_sqrtf", float_ftype_float,
+ BUILT_IN_SQRTF, BUILT_IN_NORMAL, "sqrtf", NULL_TREE);
+ builtin_function ("__builtin_sqrt", double_ftype_double,
+ BUILT_IN_SQRT, BUILT_IN_NORMAL, "sqrt", NULL_TREE);
+ builtin_function ("__builtin_sqrtl", ldouble_ftype_ldouble,
+ BUILT_IN_SQRTL, BUILT_IN_NORMAL, "sqrtl", NULL_TREE);
+
+ builtin_function ("__builtin_tanf", float_ftype_float,
+ BUILT_IN_TANF, BUILT_IN_NORMAL, "tanf", NULL_TREE);
+ builtin_function ("__builtin_tan", double_ftype_double,
+ BUILT_IN_TAN, BUILT_IN_NORMAL, "tan", NULL_TREE);
+ builtin_function ("__builtin_tanl", ldouble_ftype_ldouble,
+ BUILT_IN_TANL, BUILT_IN_NORMAL, "tanl", NULL_TREE);
+
pedantic_lvalues = FALSE;
ffecom_f2c_make_type_ (&ffecom_f2c_integer_type_node,
static void
bison_rule_pushlevel_ ()
{
- emit_line_note (input_filename, lineno);
+ emit_line_note (input_filename, input_line);
pushlevel (0);
clear_last_expr ();
expand_start_bindings (0);
if (! keep)
current_binding_level->names = NULL_TREE;
- emit_line_note (input_filename, lineno);
+ emit_line_note (input_filename, input_line);
expand_end_bindings (getdecls (), keep, 0);
t = poplevel (keep, 1, 0);
if (DECL_SECTION_NAME (newdecl) == NULL_TREE)
DECL_SECTION_NAME (newdecl) = DECL_SECTION_NAME (olddecl);
+ /* Copy the assembler name. */
+ COPY_DECL_ASSEMBLER_NAME (olddecl, newdecl);
+
if (TREE_CODE (newdecl) == FUNCTION_DECL)
{
DECL_STATIC_CONSTRUCTOR(newdecl) |= DECL_STATIC_CONSTRUCTOR(olddecl);
DECL_STATIC_DESTRUCTOR (newdecl) |= DECL_STATIC_DESTRUCTOR (olddecl);
+ TREE_THIS_VOLATILE (newdecl) |= TREE_THIS_VOLATILE (olddecl);
+ TREE_READONLY (newdecl) |= TREE_READONLY (olddecl);
+ DECL_IS_MALLOC (newdecl) |= DECL_IS_MALLOC (olddecl);
+ DECL_IS_PURE (newdecl) |= DECL_IS_PURE (olddecl);
}
}
/* If cannot merge, then use the new type and qualifiers,
/* Obey `register' declarations if `setjmp' is called in this fn. */
/* Generate rtl for function exit. */
- expand_function_end (input_filename, lineno, 0);
+ expand_function_end (input_filename, input_line, 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. */
DECL_ARGUMENTS (fndecl) = storedecls (nreverse (getdecls ()));
/* Initialize the RTL code for the function. */
-
- init_function_start (fndecl, input_filename, lineno);
+ init_function_start (fndecl);
/* Set up parameters and prepare for return, for the function. */
-
expand_function_start (fndecl, 0);
}
static bool ffe_init PARAMS ((void));
static void ffe_finish PARAMS ((void));
static bool ffe_post_options PARAMS ((const char **));
-static void ffe_init_options PARAMS ((void));
static void ffe_print_identifier PARAMS ((FILE *, tree, int));
struct language_function GTY(())
#define LANG_HOOKS_FINISH ffe_finish
#undef LANG_HOOKS_INIT_OPTIONS
#define LANG_HOOKS_INIT_OPTIONS ffe_init_options
-#undef LANG_HOOKS_DECODE_OPTION
-#define LANG_HOOKS_DECODE_OPTION ffe_decode_option
+#undef LANG_HOOKS_HANDLE_OPTION
+#define LANG_HOOKS_HANDLE_OPTION ffe_handle_option
#undef LANG_HOOKS_POST_OPTIONS
#define LANG_HOOKS_POST_OPTIONS ffe_post_options
#undef LANG_HOOKS_PARSE_FILE
finput = fopen (filename, "r");
if (finput == 0)
- fatal_io_error ("can't open %s", filename);
+ fatal_error ("can't open %s: %m", filename);
return false;
}
fclose (finput);
}
-static void
-ffe_init_options ()
-{
- /* Set default options for Fortran. */
- flag_move_all_movables = 1;
- flag_reduce_all_givs = 1;
- flag_argument_noalias = 2;
- flag_merge_constants = 2;
- flag_errno_math = 0;
- flag_complex_divide_method = 1;
-}
-
static bool
ffe_mark_addressable (tree exp)
{
struct file_name_list
{
struct file_name_list *next;
- char *fname;
+ const char *fname;
/* Mapping of file names for this directory. */
struct file_name_map *name_map;
/* Nonzero if name_map is valid. */
ffewhere_column_kill (instack[indepth].column);
}
-static int
-ffecom_decode_include_option_ (char *spec)
+void
+ffecom_decode_include_option (const char *dir)
{
- struct file_name_list *dirtmp;
-
- if (! ignore_srcdir && !strcmp (spec, "-"))
+ if (! ignore_srcdir && !strcmp (dir, "-"))
ignore_srcdir = 1;
else
{
- dirtmp = (struct file_name_list *)
+ struct file_name_list *dirtmp = (struct file_name_list *)
xmalloc (sizeof (struct file_name_list));
dirtmp->next = 0; /* New one goes on the end */
- dirtmp->fname = spec;
+ dirtmp->fname = dir;
dirtmp->got_name_map = 0;
- if (spec[0] == 0)
- error ("directory name must immediately follow -I");
- else
- append_include_chain (dirtmp, dirtmp);
+ append_include_chain (dirtmp, dirtmp);
}
- return 1;
}
/* Open INCLUDEd file. */
if (ep != NULL)
{
n = ep - nam;
- dsp[0].fname = (char *) xmalloc (n + 1);
- strncpy (dsp[0].fname, nam, n);
- dsp[0].fname[n] = '\0';
+ fname = xmalloc (n + 1);
+ strncpy (fname, nam, n);
+ fname[n] = '\0';
+ dsp[0].fname = fname;
if (n + INCLUDE_LEN_FUDGE > max_include_len)
max_include_len = n + INCLUDE_LEN_FUDGE;
}
}
if (dsp[0].fname != NULL)
- free (dsp[0].fname);
+ free ((char *) dsp[0].fname);
if (f == NULL)
return NULL;