/* Static functions (internal). */
-static tree ffe_type_for_mode PARAMS ((enum machine_mode, int));
-static tree ffe_type_for_size PARAMS ((unsigned int, int));
-static tree ffe_unsigned_type PARAMS ((tree));
-static tree ffe_signed_type PARAMS ((tree));
-static tree ffe_signed_or_unsigned_type PARAMS ((int, tree));
-static bool ffe_mark_addressable PARAMS ((tree));
-static tree ffe_truthvalue_conversion PARAMS ((tree));
-static void ffecom_init_decl_processing PARAMS ((void));
+static tree ffe_type_for_mode (enum machine_mode, int);
+static tree ffe_type_for_size (unsigned int, int);
+static tree ffe_unsigned_type (tree);
+static tree ffe_signed_type (tree);
+static tree ffe_signed_or_unsigned_type (int, tree);
+static bool ffe_mark_addressable (tree);
+static tree ffe_truthvalue_conversion (tree);
+static void ffecom_init_decl_processing (void);
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,
\f
/* Return the subscript expression, modified to do range-checking.
- `array' is the array to be checked against.
+ `array' is the array type to be checked against.
`element' is the subscript expression to check.
`dim' is the dimension number (starting at 0).
`total_dims' is the total number of dimensions (0 for CHARACTER substring).
+ `item' is the array decl or NULL_TREE.
*/
static tree
ffecom_subscript_check_ (tree array, tree element, int dim, int total_dims,
- const char *array_name)
+ const char *array_name, tree item)
{
tree low = TYPE_MIN_VALUE (TYPE_DOMAIN (array));
tree high = TYPE_MAX_VALUE (TYPE_DOMAIN (array));
}
}
+ /* If the array index is safe at compile-time, return element. */
+ if (integer_nonzerop (cond))
+ return element;
+
{
int len;
char *proc;
TREE_SIDE_EFFECTS (die) = 1;
die = convert (void_type_node, die);
- element = ffecom_3 (COND_EXPR,
- TREE_TYPE (element),
- cond,
- element,
- die);
+ if (integer_zerop (cond) && item)
+ ffe_mark_addressable (item);
- return element;
+ return ffecom_3 (COND_EXPR, TREE_TYPE (element), cond, element, die);
}
/* Return the computed element of an array reference.
element = ffecom_expr_ (dims[i], NULL, NULL, NULL, FALSE, TRUE);
if (flag_bounds_check)
element = ffecom_subscript_check_ (array, element, i, total_dims,
- array_name);
+ array_name, item);
if (element == error_mark_node)
return element;
element = ffecom_expr_ (dims[i], NULL, NULL, NULL, FALSE, TRUE);
if (flag_bounds_check)
element = ffecom_subscript_check_ (array, element, i, total_dims,
- array_name);
+ array_name, item);
if (element == error_mark_node)
return element;
static bool
ffecom_overlap_ (tree dest_decl, tree dest_offset, tree dest_size,
- tree source_tree, ffebld source UNUSED,
- bool scalar_arg)
+ tree source_tree, ffebld source UNUSED, bool scalar_arg)
{
tree source_decl;
tree source_offset;
case MIN_EXPR:
case MAX_EXPR:
case ABS_EXPR:
- case FFS_EXPR:
case LSHIFT_EXPR:
case RSHIFT_EXPR:
case LROTATE_EXPR:
case BIT_IOR_EXPR:
case BIT_XOR_EXPR:
case BIT_AND_EXPR:
- case BIT_ANDTC_EXPR:
case BIT_NOT_EXPR:
case TRUTH_ANDIF_EXPR:
case TRUTH_ORIF_EXPR:
in a COMMON area the callee might know about (and thus modify). */
static bool
-ffecom_args_overlapping_ (tree dest_tree, ffebld dest UNUSED,
- tree args, tree callee_commons,
- bool scalar_args)
+ffecom_args_overlapping_ (tree dest_tree, ffebld dest UNUSED, tree args,
+ tree callee_commons, bool scalar_args)
{
tree arg;
tree dest_decl;
to the arglist a pointer to a temporary to receive the return value. */
static tree
-ffecom_call_ (tree fn, ffeinfoKindtype kt, bool is_f2c_complex,
- tree type, tree args, tree dest_tree,
- ffebld dest, bool *dest_used, tree callee_commons,
- bool scalar_args, tree hook)
+ffecom_call_ (tree fn, ffeinfoKindtype kt, bool is_f2c_complex, tree type,
+ tree args, tree dest_tree, ffebld dest, bool *dest_used,
+ tree callee_commons, bool scalar_args, tree hook)
{
tree item;
tree tempvar;
static tree
ffecom_call_binop_ (tree fn, ffeinfoKindtype kt, bool is_f2c_complex,
- tree type, ffebld left, ffebld right,
- tree dest_tree, ffebld dest, bool *dest_used,
- tree callee_commons, bool scalar_args, bool ref, tree hook)
+ tree type, ffebld left, ffebld right, tree dest_tree,
+ ffebld dest, bool *dest_used, tree callee_commons,
+ bool scalar_args, bool ref, tree hook)
{
tree left_tree;
tree right_tree;
end_tree = ffecom_expr (end);
if (flag_bounds_check)
end_tree = ffecom_subscript_check_ (array, end_tree, 1, 0,
- char_name);
+ char_name, NULL_TREE);
end_tree = convert (ffecom_f2c_ftnlen_type_node,
end_tree);
start_tree = ffecom_expr (start);
if (flag_bounds_check)
start_tree = ffecom_subscript_check_ (array, start_tree, 0, 0,
- char_name);
+ char_name, NULL_TREE);
start_tree = convert (ffecom_f2c_ftnlen_type_node,
start_tree);
end_tree = ffecom_expr (end);
if (flag_bounds_check)
end_tree = ffecom_subscript_check_ (array, end_tree, 1, 0,
- char_name);
+ char_name, NULL_TREE);
end_tree = convert (ffecom_f2c_ftnlen_type_node,
end_tree);
made, destination used instead, and dest_used flag set TRUE. */
static tree
-ffecom_expr_ (ffebld expr, tree dest_tree, ffebld dest,
- bool *dest_used, bool assignp, bool widenp)
+ffecom_expr_ (ffebld expr, tree dest_tree, ffebld dest, bool *dest_used,
+ bool assignp, bool widenp)
{
tree item;
tree list;
subroutines. */
static tree
-ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree,
- ffebld dest, bool *dest_used)
+ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree, ffebld dest,
+ bool *dest_used)
{
tree expr_tree;
tree saved_expr1; /* For those who need it. */
given size. */
static void
-ffecom_f2c_set_lio_code_ (ffeinfoBasictype bt, int size,
- int code)
+ffecom_f2c_set_lio_code_ (ffeinfoBasictype bt, int size, int code)
{
int j;
tree t;
}
static tree
-ffecom_intrinsic_ichar_ (tree tree_type, ffebld arg,
- tree *maybe_tree)
+ffecom_intrinsic_ichar_ (tree tree_type, ffebld arg, tree *maybe_tree)
{
tree expr_tree;
tree length_tree;
equivalent of a Fortran program unit. */
static void
-ffecom_start_progunit_ ()
+ffecom_start_progunit_ (void)
{
ffesymbol fn = ffecom_primary_entry_;
ffebld arglist;
{
ffetargetOffset offset;
ffestorag cst;
+ tree toffset;
cst = ffestorag_parent (st);
assert (cst == ffesymbol_storage (cs));
ffecom_1 (ADDR_EXPR,
build_pointer_type (TREE_TYPE (ct)),
ct));
+ toffset = build_int_2 (offset, 0);
+ TREE_TYPE (toffset) = ssizetype;
t = ffecom_2 (PLUS_EXPR, TREE_TYPE (t),
- t,
- build_int_2 (offset, 0));
+ t, toffset);
t = convert (build_pointer_type (type),
t);
TREE_CONSTANT (t) = 1;
DECL_EXTERNAL (t) = 1;
TREE_PUBLIC (t) = 1;
- t = start_decl (t, FALSE);
- finish_decl (t, NULL_TREE, FALSE);
+ t = start_decl (t, ffe_is_globals ());
+ finish_decl (t, NULL_TREE, ffe_is_globals ());
if ((g != NULL)
&& ((ffeglobal_type (g) == FFEGLOBAL_typeSUBR)
taking into account different units of measurements for offsets. */
static void
-ffecom_tree_canonize_ptr_ (tree *decl, tree *offset,
- tree t)
+ffecom_tree_canonize_ptr_ (tree *decl, tree *offset, tree t)
{
switch (TREE_CODE (t))
{
reveal the overlap. */
static void
-ffecom_tree_canonize_ref_ (tree *decl, tree *offset,
- tree *size, tree t)
+ffecom_tree_canonize_ref_ (tree *decl, tree *offset, tree *size, tree t)
{
/* The default path is to report a nonexistant decl. */
*decl = NULL_TREE;
case MIN_EXPR:
case MAX_EXPR:
case ABS_EXPR:
- case FFS_EXPR:
case LSHIFT_EXPR:
case RSHIFT_EXPR:
case LROTATE_EXPR:
case BIT_IOR_EXPR:
case BIT_XOR_EXPR:
case BIT_AND_EXPR:
- case BIT_ANDTC_EXPR:
case BIT_NOT_EXPR:
case TRUTH_ANDIF_EXPR:
case TRUTH_ORIF_EXPR:
/* Do divide operation appropriate to type of operands. */
static tree
-ffecom_tree_divide_ (tree tree_type, tree left, tree right,
- tree dest_tree, ffebld dest, bool *dest_used,
- tree hook)
+ffecom_tree_divide_ (tree tree_type, tree left, tree right, tree dest_tree,
+ ffebld dest, bool *dest_used, tree hook)
{
if ((left == error_mark_node)
|| (right == error_mark_node))
/* Build type info for non-dummy variable. */
static tree
-ffecom_type_localvar_ (ffesymbol s, ffeinfoBasictype bt,
- ffeinfoKindtype kt)
+ffecom_type_localvar_ (ffesymbol s, ffeinfoBasictype bt, ffeinfoKindtype kt)
{
tree type;
ffebld dl;
static GTY(()) tree ffecom_type_namelist_var;
static tree
-ffecom_type_namelist_ ()
+ffecom_type_namelist_ (void)
{
if (ffecom_type_namelist_var == NULL_TREE)
{
static GTY(()) tree ffecom_type_vardesc_var;
static tree
-ffecom_type_vardesc_ ()
+ffecom_type_vardesc_ (void)
{
if (ffecom_type_vardesc_var == NULL_TREE)
{
checking for certain housekeeping things. */
tree
-ffecom_2 (enum tree_code code, tree type, tree node1,
- tree node2)
+ffecom_2 (enum tree_code code, tree type, tree node1, tree node2)
{
tree item;
TREE_SIDE_EFFECTS. */
tree
-ffecom_2s (enum tree_code code, tree type, tree node1,
- tree node2)
+ffecom_2s (enum tree_code code, tree type, tree node1, tree node2)
{
tree item;
checking for certain housekeeping things. */
tree
-ffecom_3 (enum tree_code code, tree type, tree node1,
- tree node2, tree node3)
+ffecom_3 (enum tree_code code, tree type, tree node1, tree node2, tree node3)
{
tree item;
TREE_SIDE_EFFECTS. */
tree
-ffecom_3s (enum tree_code code, tree type, tree node1,
- tree node2, tree node3)
+ffecom_3s (enum tree_code code, tree type, tree node1, tree node2, tree node3)
{
tree item;
/* Transform constant-union to tree, with the type known. */
tree
-ffecom_constantunion_with_type (ffebldConstantUnion *cu,
- tree tree_type, ffebldConst ct)
+ffecom_constantunion_with_type (ffebldConstantUnion *cu, tree tree_type,
+ ffebldConst ct)
{
tree item;
/* Handy way to make a field in a struct/union. */
tree
-ffecom_decl_field (tree context, tree prevfield,
- const char *name, tree type)
+ffecom_decl_field (tree context, tree prevfield, const char *name, tree type)
{
tree field;
Calls ffecom_sym_end_transition for each global and local symbol. */
void
-ffecom_end_transition ()
+ffecom_end_transition (void)
{
ffebld item;
Make sure error updating not inhibited. */
void
-ffecom_exec_transition ()
+ffecom_exec_transition (void)
{
bool inhibited;
/* Do global stuff. */
void
-ffecom_finish_compile ()
+ffecom_finish_compile (void)
{
assert (ffecom_outer_function_decl_ == NULL_TREE);
assert (current_function_decl == NULL_TREE);
/* Finish a program unit. */
void
-ffecom_finish_progunit ()
+ffecom_finish_progunit (void)
{
ffecom_end_compstmt ();
}
void
-ffecom_init_0 ()
+ffecom_init_0 (void)
{
tree endlink;
int i;
ffecom_float_zero_ = build_real (float_type_node, dconst0);
ffecom_double_zero_ = build_real (double_type_node, dconst0);
- {
- REAL_VALUE_TYPE point_5;
-
- REAL_ARITHMETIC (point_5, RDIV_EXPR, dconst1, dconst2);
- ffecom_float_half_ = build_real (float_type_node, point_5);
- ffecom_double_half_ = build_real (double_type_node, point_5);
- }
+ ffecom_float_half_ = build_real (float_type_node, dconsthalf);
+ ffecom_double_half_ = build_real (double_type_node, dconsthalf);
/* Do "extern int xargc;". */
ffecom_init_2(); */
void
-ffecom_init_2 ()
+ffecom_init_2 (void)
{
assert (ffecom_outer_function_decl_ == NULL_TREE);
assert (current_function_decl == NULL_TREE);
the MODIFY_EXPR. */
tree
-ffecom_modify (tree newtype, tree lhs,
- tree rhs)
+ffecom_modify (tree newtype, tree lhs, tree rhs)
{
if (lhs == error_mark_node || rhs == error_mark_node)
return error_mark_node;
/* Create temporary gcc label. */
tree
-ffecom_temp_label ()
+ffecom_temp_label (void)
{
tree glabel;
static int mynumber = 0;
first ENTRY statement, and so on). */
tree
-ffecom_which_entrypoint_decl ()
+ffecom_which_entrypoint_decl (void)
{
assert (ffecom_which_entrypoint_decl_ != NULL_TREE);
"bison_rule_foo_" so they are easy to find. */
static void
-bison_rule_pushlevel_ ()
+bison_rule_pushlevel_ (void)
{
- emit_line_note (input_filename, input_line);
+ emit_line_note (input_location);
pushlevel (0);
clear_last_expr ();
expand_start_bindings (0);
}
static tree
-bison_rule_compstmt_ ()
+bison_rule_compstmt_ (void)
{
tree t;
int keep = kept_level_p ();
if (! keep)
current_binding_level->names = NULL_TREE;
- emit_line_note (input_filename, input_line);
+ emit_line_note (input_location);
expand_end_bindings (getdecls (), keep, 0);
t = poplevel (keep, 1, 0);
tree
builtin_function (const char *name, tree type, int function_code,
- enum built_in_class class,
- const char *library_name,
+ enum built_in_class class, const char *library_name,
tree attrs ATTRIBUTE_UNUSED)
{
tree decl = build_decl (FUNCTION_DECL, get_identifier (name), type);
if ((DECL_INITIAL (newdecl) == 0 && DECL_INITIAL (olddecl) != 0)
|| (DECL_CONTEXT (newdecl) != 0 && DECL_CONTEXT (olddecl) == 0))
{
- DECL_SOURCE_LINE (newdecl) = DECL_SOURCE_LINE (olddecl);
- DECL_SOURCE_FILE (newdecl) = DECL_SOURCE_FILE (olddecl);
+ DECL_SOURCE_LOCATION (newdecl) = DECL_SOURCE_LOCATION (olddecl);
if (DECL_CONTEXT (olddecl) == 0
&& TREE_CODE (newdecl) != FUNCTION_DECL)
/* Obey `register' declarations if `setjmp' is called in this fn. */
/* Generate rtl for function exit. */
- expand_function_end (input_filename, input_line, 0);
+ expand_function_end ();
/* If this is a nested function, protect the local variables in the stack
above us from being collected while we're compiling this function. */
/* Create a new `struct f_binding_level'. */
static struct f_binding_level *
-make_binding_level ()
+make_binding_level (void)
{
/* NOSTRICT */
return ggc_alloc (sizeof (struct f_binding_level));
/* Restore the variables used during compilation of a C function. */
static void
-pop_f_function_context ()
+pop_f_function_context (void)
{
struct f_function *p = f_function_chain;
tree link;
used during compilation of a C function. */
static void
-push_f_function_context ()
+push_f_function_context (void)
{
- struct f_function *p
- = (struct f_function *) xmalloc (sizeof (struct f_function));
+ struct f_function *p = xmalloc (sizeof (struct f_function));
push_function_context ();
DECL_ARGUMENTS (fndecl) = storedecls (nreverse (getdecls ()));
/* Initialize the RTL code for the function. */
-
- init_function_start (fndecl, input_filename, input_line);
+ init_function_start (fndecl);
/* Set up parameters and prepare for return, for the function. */
-
expand_function_start (fndecl, 0);
}
store the result back using `storedecls' or you will lose. */
tree
-getdecls ()
+getdecls (void)
{
return current_binding_level->names;
}
/* Nonzero if we are currently in the global binding level. */
int
-global_bindings_p ()
+global_bindings_p (void)
{
return current_binding_level == global_binding_level;
}
static void
-ffecom_init_decl_processing ()
+ffecom_init_decl_processing (void)
{
malloc_init ();
}
/* Each front end provides its own. */
-static bool ffe_init PARAMS ((void));
-static void ffe_finish PARAMS ((void));
-static bool ffe_post_options PARAMS ((const char **));
-static int ffe_init_options PARAMS ((void));
-static void ffe_print_identifier PARAMS ((FILE *, tree, int));
+static bool ffe_init (void);
+static void ffe_finish (void);
+static bool ffe_post_options (const char **);
+static void ffe_print_identifier (FILE *, tree, int);
struct language_function GTY(())
{
#undef DEFTREECODE
static bool
-ffe_post_options (pfilename)
- const char **pfilename;
+ffe_post_options (const char **pfilename)
{
const char *filename = *pfilename;
static bool
-ffe_init ()
+ffe_init (void)
{
#ifdef IO_BUFFER_SIZE
- setvbuf (finput, (char *) xmalloc (IO_BUFFER_SIZE), _IOFBF, IO_BUFFER_SIZE);
+ setvbuf (finput, xmalloc (IO_BUFFER_SIZE), _IOFBF, IO_BUFFER_SIZE);
#endif
ffecom_init_decl_processing ();
to try doing this. */
ffelex_hash_kludge (finput);
+ push_srcloc (input_filename, 0);
+
/* FIXME: The ffelex_hash_kludge code needs to be cleaned up to
set the new file name. Maybe in ffe_post_options. */
return true;
}
static void
-ffe_finish ()
+ffe_finish (void)
{
ffe_terminate_0 ();
fclose (finput);
}
-static int
-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;
-
- return 0;
-}
-
static bool
ffe_mark_addressable (tree exp)
{
/* Nonzero if the current level needs to have a BLOCK made. */
static int
-kept_level_p ()
+kept_level_p (void)
{
tree decl;
case NEGATE_EXPR:
case ABS_EXPR:
case FLOAT_EXPR:
- case FFS_EXPR:
/* These don't change whether an object is nonzero or zero. */
return ffe_truthvalue_conversion (TREE_OPERAND (expr, 0));
} instack[INPUT_STACK_MAX];
static int last_error_tick = 0; /* Incremented each time we print it. */
-static int input_file_stack_tick = 0; /* Incremented when status changes. */
/* Current nesting level of input sources.
`instack[indepth]' is the level currently being read. */
FIRST is the beginning of the chain to append, and LAST is the end. */
static void
-append_include_chain (struct file_name_list *first, struct file_name_list *last)
+append_include_chain (struct file_name_list *first,
+ struct file_name_list *last)
{
struct file_name_list *dir;
}
else
{
- dir = (char *) xmalloc (p - filename + 1);
+ dir = xmalloc (p - filename + 1);
memcpy (dir, filename, p - filename);
dir[p - filename] = '\0';
from = p + 1;
if (! strcmp (map_list_ptr->map_list_name, dirname))
return map_list_ptr->map_list_map;
- map_list_ptr = ((struct file_name_map_list *)
- xmalloc (sizeof (struct file_name_map_list)));
+ map_list_ptr = xmalloc (sizeof (struct file_name_map_list));
map_list_ptr->map_list_name = xstrdup (dirname);
map_list_ptr->map_list_map = NULL;
;
to = read_filename_string (ch, f);
- ptr = ((struct file_name_map *)
- xmalloc (sizeof (struct file_name_map)));
+ ptr = xmalloc (sizeof (struct file_name_map));
ptr->map_from = from;
/* Make the real filename absolute. */
early #line directives (when -g is in effect). */
fp = &instack[++indepth];
- memset ((char *) fp, 0, sizeof (FILE_BUF));
+ memset (fp, 0, sizeof (FILE_BUF));
if (name == NULL)
name = "";
fp->nominal_fname = fp->fname = name;
ignore_srcdir = 1;
else
{
- struct file_name_list *dirtmp = (struct file_name_list *)
- xmalloc (sizeof (struct file_name_list));
+ struct file_name_list *dirtmp
+ = xmalloc (sizeof (struct file_name_list));
dirtmp->next = 0; /* New one goes on the end */
dirtmp->fname = dir;
dirtmp->got_name_map = 0;
instack[indepth].column = ffewhere_column_use (c);
fp = &instack[indepth + 1];
- memset ((char *) fp, 0, sizeof (FILE_BUF));
+ memset (fp, 0, sizeof (FILE_BUF));
fp->nominal_fname = fp->fname = fname;
fp->dir = searchptr;
OSDN Git Service
