/* gfortran backend interface
- Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006
+ Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
Free Software Foundation, Inc.
Contributed by Paul Brook.
union lang_tree_node
GTY((desc ("TREE_CODE (&%h.generic) == IDENTIFIER_NODE"),
- chain_next ("(union lang_tree_node *)TREE_CHAIN (&%h.generic)")))
+ chain_next ("(GIMPLE_STMT_P (&%h.generic) ? (union lang_tree_node *) 0 : (union lang_tree_node *)TREE_CHAIN (&%h.generic))")))
+
{
union tree_node GTY((tag ("0"),
desc ("tree_node_structure (&%h)"))) generic;
&& TREE_CODE (TREE_OPERAND (expr, 0)) == VAR_DECL
&& TREE_CODE (TREE_TYPE (TREE_OPERAND (expr, 0)))
== UNION_TYPE
- && cgraph_varpool_node (TREE_OPERAND (expr, 0))->needed
+ && varpool_node (TREE_OPERAND (expr, 0))->needed
&& errorcount == 0 && sorrycount == 0)
{
timevar_push (TV_SYMOUT);
tree_rest_of_compilation (fndecl);
}
-\f
+
/* Prepare expr to be an argument of a TRUTH_NOT_EXPR,
or validate its data type for an `if' or `while' statement or ?..: exp.
return expr;
}
else if (TREE_CODE (expr) == NOP_EXPR)
- return build1 (NOP_EXPR, boolean_type_node,
- TREE_OPERAND (expr, 0));
+ return build1 (NOP_EXPR, boolean_type_node, TREE_OPERAND (expr, 0));
else
return build1 (NOP_EXPR, boolean_type_node, expr);
}
}
+
static void
gfc_create_decls (void)
{
gfc_init_constants ();
}
+
static void
gfc_be_parse_file (int set_yydebug ATTRIBUTE_UNUSED)
{
errorcount += errors;
warningcount += warnings;
}
-\f
+
+
/* Initialize everything. */
static bool
{
return;
}
-\f
+
/* These functions and variables deal with binding contours. We only
need these functions for the list of PARM_DECLs, but we leave the
functions more general; these are a simplified version of the
functions from GNAT. */
-/* For each binding contour we allocate a binding_level structure which records
- the entities defined or declared in that contour. Contours include:
+/* For each binding contour we allocate a binding_level structure which
+ records the entities defined or declared in that contour. Contours
+ include:
the global one
one for each subprogram definition
/* Binding level structures are initialized by copying this one. */
static struct binding_level clear_binding_level = { NULL, NULL, NULL };
-\f
+
+
/* Return nonzero if we are currently in the global binding level. */
int
reverse order except for PARM_DECL node, which are explicitly stored in
the right order. */
decl_chain = (reverse) ? nreverse (current_binding_level->names)
- : current_binding_level->names;
+ : current_binding_level->names;
/* 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
return block_node;
}
-\f
+
+
/* Insert BLOCK at the end of the list of subblocks of the
current binding level. This is used when a BIND_EXPR is expanded,
to handle the BLOCK node inside the BIND_EXPR. */
= chainon (current_binding_level->blocks, block);
}
+
/* Records a ..._DECL node DECL as belonging to the current lexical scope.
Returns the ..._DECL node. */
gfc_init_types ();
}
+
/* Mark EXP saying that we need to be able to take the
address of it; it should not be allocated in a register.
In Fortran 95 this is only the case for variables with
likely future Cray pointer extension.
Value is 1 if successful. */
/* TODO: Check/fix mark_addressable. */
+
bool
gfc_mark_addressable (tree exp)
{
{
if (TREE_PUBLIC (x))
{
- error
- ("global register variable %qs used in nested function",
- IDENTIFIER_POINTER (DECL_NAME (x)));
+ error ("global register variable %qs used in nested function",
+ IDENTIFIER_POINTER (DECL_NAME (x)));
return false;
}
pedwarn ("register variable %qs used in nested function",
}
}
+
/* Return the typed-based alias set for T, which may be an expression
or a type. Return -1 if we don't do anything special. */
return -1;
}
+
/* press the big red button - garbage (ggc) collection is on */
int ggc_p = 1;
static void
-gfc_define_builtin (const char * name,
+gfc_define_builtin (const char *name,
tree type,
int code,
- const char * library_name,
+ const char *library_name,
bool const_p)
{
tree decl;
/* Create function types for builtin functions. */
static void
-build_builtin_fntypes (tree * fntype, tree type)
+build_builtin_fntypes (tree *fntype, tree type)
{
tree tmp;
fntype[2] = build_function_type (type, tmp);
}
+
static tree
builtin_type_for_size (int size, bool unsignedp)
{
tree mfunc_cfloat[3];
tree mfunc_cdouble[3];
tree mfunc_clongdouble[3];
- tree func_cfloat_float;
- tree func_cdouble_double;
- tree func_clongdouble_longdouble;
- tree ftype;
+ tree func_cfloat_float, func_float_cfloat;
+ tree func_cdouble_double, func_double_cdouble;
+ tree func_clongdouble_longdouble, func_longdouble_clongdouble;
+ tree func_float_floatp_floatp;
+ tree func_double_doublep_doublep;
+ tree func_longdouble_longdoublep_longdoublep;
+ tree ftype, ptype;
tree tmp;
tree builtin_types[(int) BT_LAST + 1];
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, float_type_node, void_list_node);
+ func_float_cfloat = build_function_type (complex_float_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);
+ tmp = tree_cons (NULL_TREE, double_type_node, void_list_node);
+ func_double_cdouble = build_function_type (complex_double_type_node, tmp);
+
tmp = tree_cons (NULL_TREE, complex_long_double_type_node, void_list_node);
func_clongdouble_longdouble =
build_function_type (long_double_type_node, tmp);
+ tmp = tree_cons (NULL_TREE, long_double_type_node, void_list_node);
+ func_longdouble_clongdouble =
+ build_function_type (complex_long_double_type_node, tmp);
+
+ ptype = build_pointer_type (float_type_node);
+ tmp = tree_cons (NULL_TREE, float_type_node,
+ tree_cons (NULL_TREE, ptype,
+ build_tree_list (NULL_TREE, ptype)));
+ func_float_floatp_floatp =
+ build_function_type (void_type_node, tmp);
+
+ ptype = build_pointer_type (double_type_node);
+ tmp = tree_cons (NULL_TREE, double_type_node,
+ tree_cons (NULL_TREE, ptype,
+ build_tree_list (NULL_TREE, ptype)));
+ func_double_doublep_doublep =
+ build_function_type (void_type_node, tmp);
+
+ ptype = build_pointer_type (long_double_type_node);
+ tmp = tree_cons (NULL_TREE, long_double_type_node,
+ tree_cons (NULL_TREE, ptype,
+ build_tree_list (NULL_TREE, ptype)));
+ func_longdouble_longdoublep_longdoublep =
+ build_function_type (void_type_node, tmp);
+
#include "mathbuiltins.def"
/* We define these separately as the fortran versions have different
BUILT_IN_COPYSIGN, "copysign", true);
gfc_define_builtin ("__builtin_copysignf", mfunc_float[1],
BUILT_IN_COPYSIGNF, "copysignf", true);
+
+ gfc_define_builtin ("__builtin_fmodl", mfunc_longdouble[1],
+ BUILT_IN_FMODL, "fmodl", true);
+ gfc_define_builtin ("__builtin_fmod", mfunc_double[1],
+ BUILT_IN_FMOD, "fmod", true);
+ gfc_define_builtin ("__builtin_fmodf", mfunc_float[1],
+ BUILT_IN_FMODF, "fmodf", true);
/* These are used to implement the ** operator. */
gfc_define_builtin ("__builtin_powl", mfunc_longdouble[1],
gfc_define_builtin ("__builtin_powf", mfunc_float[1],
BUILT_IN_POWF, "powf", true);
+ if (TARGET_C99_FUNCTIONS)
+ {
+ gfc_define_builtin ("__builtin_cbrtl", mfunc_longdouble[0],
+ BUILT_IN_CBRTL, "cbrtl", true);
+ gfc_define_builtin ("__builtin_cbrt", mfunc_double[0],
+ BUILT_IN_CBRT, "cbrt", true);
+ gfc_define_builtin ("__builtin_cbrtf", mfunc_float[0],
+ BUILT_IN_CBRTF, "cbrtf", true);
+ gfc_define_builtin ("__builtin_cexpil", func_longdouble_clongdouble,
+ BUILT_IN_CEXPIL, "cexpil", true);
+ gfc_define_builtin ("__builtin_cexpi", func_double_cdouble,
+ BUILT_IN_CEXPI, "cexpi", true);
+ gfc_define_builtin ("__builtin_cexpif", func_float_cfloat,
+ BUILT_IN_CEXPIF, "cexpif", true);
+ }
+
+ if (TARGET_HAS_SINCOS)
+ {
+ gfc_define_builtin ("__builtin_sincosl",
+ func_longdouble_longdoublep_longdoublep,
+ BUILT_IN_SINCOSL, "sincosl", false);
+ gfc_define_builtin ("__builtin_sincos", func_double_doublep_doublep,
+ BUILT_IN_SINCOS, "sincos", false);
+ gfc_define_builtin ("__builtin_sincosf", func_float_floatp_floatp,
+ BUILT_IN_SINCOSF, "sincosf", false);
+ }
+
/* Other builtin functions we use. */
tmp = tree_cons (NULL_TREE, long_integer_type_node, void_list_node);
BUILT_IN_TRAP, NULL, false);
TREE_THIS_VOLATILE (built_in_decls[BUILT_IN_TRAP]) = 1;
+ gfc_define_builtin ("__emutls_get_address",
+ builtin_types[BT_FN_PTR_PTR], BUILT_IN_EMUTLS_GET_ADDRESS,
+ "__emutls_get_address", true);
+ gfc_define_builtin ("__emutls_register_common",
+ builtin_types[BT_FN_VOID_PTR_WORD_WORD_PTR],
+ BUILT_IN_EMUTLS_REGISTER_COMMON,
+ "__emutls_register_common", false);
+
build_common_builtin_nodes ();
targetm.init_builtins ();
}
OSDN Git Service
