void do_function_end (void);
int global_bindings_p (void);
void insert_block (tree);
-void set_block (tree);
+static void gfc_clear_binding_stack (void);
static void gfc_be_parse_file (int);
static void gfc_expand_function (tree);
#undef LANG_HOOKS_SIGNED_TYPE
#undef LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE
#undef LANG_HOOKS_CALLGRAPH_EXPAND_FUNCTION
+#undef LANG_HOOKS_CLEAR_BINDING_STACK
/* Define lang hooks. */
#define LANG_HOOKS_NAME "GNU F95"
#define LANG_HOOKS_SIGNED_TYPE gfc_signed_type
#define LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE gfc_signed_or_unsigned_type
#define LANG_HOOKS_CALLGRAPH_EXPAND_FUNCTION gfc_expand_function
+#define LANG_HOOKS_CLEAR_BINDING_STACK gfc_clear_binding_stack
const struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
if (TREE_CODE (expr) == INTEGER_CST)
return integer_zerop (expr) ? boolean_false_node : boolean_true_node;
else
- return build (NE_EXPR, boolean_type_node, expr, integer_zero_node);
+ return build2 (NE_EXPR, boolean_type_node, expr, integer_zero_node);
default:
internal_error ("Unexpected type in truthvalue_conversion");
/* For each level (except the global one), a chain of BLOCK nodes for all
the levels that were entered and exited one level down from this one. */
tree blocks;
- /* The back end may need, for its own internal processing, to create a BLOCK
- node. This field is set aside for this purpose. If this field is non-null
- when the level is popped, i.e. when poplevel is invoked, we will use such
- block instead of creating a new one from the 'names' field, that is the
- ..._DECL nodes accumulated so far. Typically the routine 'pushlevel'
- will be called before setting this field, so that if the front-end had
- inserted ..._DECL nodes in the current block they will not be lost. */
- tree block_created_by_back_end;
/* The binding level containing this one (the enclosing binding level). */
struct binding_level *level_chain;
};
static GTY(()) struct binding_level *global_binding_level;
/* Binding level structures are initialized by copying this one. */
-static struct binding_level clear_binding_level = { NULL, NULL, NULL, NULL };
+static struct binding_level clear_binding_level = { NULL, NULL, NULL };
\f
/* Return non-zero if we are currently in the global binding level. */
tree decl_chain;
tree subblock_chain = current_binding_level->blocks;
tree subblock_node;
- tree block_created_by_back_end;
/* Reverse the list of XXXX_DECL nodes if desired. Note that the ..._DECL
nodes chained through the `names' field of current_binding_level are in
decl_chain = (reverse) ? nreverse (current_binding_level->names)
: current_binding_level->names;
- block_created_by_back_end =
- current_binding_level->block_created_by_back_end;
- if (block_created_by_back_end != 0)
- {
- block_node = block_created_by_back_end;
-
- /* Check if we are about to discard some information that was gathered
- by the front-end. Nameley check if the back-end created a new block
- without calling pushlevel first. To understand why things are lost
- just look at the next case (i.e. no block created by back-end. */
- if ((keep || functionbody) && (decl_chain || subblock_chain))
- abort ();
- }
-
/* If there were any declarations in the current binding level, or if this
binding level is a function body, or if there are any nested blocks then
create a BLOCK node to record them for the life of this function. */
- else if (keep || functionbody)
+ if (keep || functionbody)
block_node = build_block (keep ? decl_chain : 0, 0, subblock_chain, 0, 0);
/* Record the BLOCK node just built as the subblock its enclosing scope. */
}
else if (block_node)
{
- if (block_created_by_back_end == NULL)
- current_binding_level->blocks
- = chainon (current_binding_level->blocks, block_node);
+ current_binding_level->blocks
+ = chainon (current_binding_level->blocks, block_node);
}
/* If we did not make a block for the level just exited, any blocks made for
= chainon (current_binding_level->blocks, block);
}
-/* Set the BLOCK node for the innermost scope
- (the one we are currently in). */
-
-void
-set_block (tree block)
-{
- current_binding_level->block_created_by_back_end = block;
-}
-
/* Records a ..._DECL node DECL as belonging to the current lexical scope.
Returns the ..._DECL node. */
}
+/* Clear the binding stack. */
+static void
+gfc_clear_binding_stack (void)
+{
+ while (!global_bindings_p ())
+ poplevel (0, 0, 0);
+}
+
+
#ifndef CHAR_TYPE_SIZE
#define CHAR_TYPE_SIZE BITS_PER_UNIT
#endif
/* Build common tree nodes. char_type_node is unsigned because we
only use it for actual characters, not for INTEGER(1). Also, we
want double_type_node to actually have double precision. */
- build_common_tree_nodes (0);
+ build_common_tree_nodes (false, false);
set_sizetype (long_unsigned_type_node);
build_common_tree_nodes_2 (0);
pedwarn ("address of register variable `%s' requested",
IDENTIFIER_POINTER (DECL_NAME (x)));
}
- put_var_into_stack (x, /*rescan=*/true);
/* drops in */
case FUNCTION_DECL:
TREE_PUBLIC (decl) = 1;
if (library_name)
SET_DECL_ASSEMBLER_NAME (decl, get_identifier (library_name));
- make_decl_rtl (decl, NULL);
+ make_decl_rtl (decl);
pushdecl (decl);
DECL_BUILT_IN_CLASS (decl) = class;
DECL_FUNCTION_CODE (decl) = function_code;
{
tree mfunc_float[2];
tree mfunc_double[2];
+ tree func_cfloat_float;
+ tree func_cdouble_double;
tree ftype;
tree tmp;
mfunc_float[0] = build_function_type (float_type_node, tmp);
tmp = tree_cons (NULL_TREE, float_type_node, tmp);
mfunc_float[1] = build_function_type (float_type_node, tmp);
+
+ tmp = tree_cons (NULL_TREE, complex_float_type_node, void_list_node);
+ func_cfloat_float = build_function_type (float_type_node, tmp);
+
tmp = tree_cons (NULL_TREE, double_type_node, void_list_node);
mfunc_double[0] = build_function_type (double_type_node, tmp);
tmp = tree_cons (NULL_TREE, double_type_node, tmp);
mfunc_double[1] = build_function_type (double_type_node, tmp);
+
+
+ tmp = tree_cons (NULL_TREE, complex_double_type_node, void_list_node);
+ func_cdouble_double = build_function_type (double_type_node, tmp);
#include "mathbuiltins.def"
BUILT_IN_ROUND, "round", true);
gfc_define_builtin ("__builtin_roundf", mfunc_float[0],
BUILT_IN_ROUNDF, "roundf", true);
+
+ gfc_define_builtin ("__builtin_cabs", func_cdouble_double,
+ BUILT_IN_CABS, "cabs", true);
+ gfc_define_builtin ("__builtin_cabsf", func_cfloat_float,
+ BUILT_IN_CABSF, "cabsf", true);
+
+
+ gfc_define_builtin ("__builtin_copysign", mfunc_double[1],
+ BUILT_IN_COPYSIGN, "copysign", true);
+ gfc_define_builtin ("__builtin_copysignf", mfunc_float[1],
+ BUILT_IN_COPYSIGNF, "copysignf", true);
/* These are used to implement the ** operator. */
- gfc_define_builtin ("__builtin_pow", mfunc_double[0],
+ gfc_define_builtin ("__builtin_pow", mfunc_double[1],
BUILT_IN_POW, "pow", true);
- gfc_define_builtin ("__builtin_powf", mfunc_float[0],
+ gfc_define_builtin ("__builtin_powf", mfunc_float[1],
BUILT_IN_POWF, "powf", true);
/* Other builtin functions we use. */
gfc_define_builtin ("__builtin_adjust_trampoline", ftype,
BUILT_IN_ADJUST_TRAMPOLINE, "adjust_trampoline", true);
- tmp = tree_cons (NULL_TREE, pvoid_type_node, void_list_node);
- tmp = tree_cons (NULL_TREE, size_type_node, void_list_node);
- ftype = build_function_type (pvoid_type_node, tmp);
- gfc_define_builtin ("__builtin_stack_alloc", ftype, BUILT_IN_STACK_ALLOC,
- "stack_alloc", false);
+ /* The stack_save, stack_restore, and alloca builtins aren't used directly.
+ They are inserted during gimplification to implement variable sized
+ stack allocation. */
- /* The stack_save and stack_restore builtins aren't used directly. They
- are inserted during gimplification to implement stack_alloc calls. */
ftype = build_function_type (pvoid_type_node, void_list_node);
gfc_define_builtin ("__builtin_stack_save", ftype, BUILT_IN_STACK_SAVE,
"stack_save", false);
+
tmp = tree_cons (NULL_TREE, pvoid_type_node, void_list_node);
ftype = build_function_type (void_type_node, tmp);
gfc_define_builtin ("__builtin_stack_restore", ftype, BUILT_IN_STACK_RESTORE,
"stack_restore", false);
+
+ tmp = tree_cons (NULL_TREE, size_type_node, void_list_node);
+ ftype = build_function_type (pvoid_type_node, tmp);
+ gfc_define_builtin ("__builtin_alloca", ftype, BUILT_IN_ALLOCA,
+ "alloca", false);
}
#undef DEFINE_MATH_BUILTIN
OSDN Git Service
