-/* G95 Backend interface
- Copyright (C) 2000, 2001, 2002, 2003, 2004 Free Software Foundation,
- Inc.
+/* gfortran backend interface
+ Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ Free Software Foundation, Inc.
Contributed by Paul Brook.
This file is part of GCC.
GCC is free software; you can redistribute it and/or modify it under
the terms of the GNU General Public License as published by the Free
-Software Foundation; either version 2, or (at your option) any later
+Software Foundation; either version 3, or (at your option) any later
version.
GCC is distributed in the hope that it will be useful, but WITHOUT ANY
for more details.
You should have received a copy of the GNU General Public License
-along with GCC; see the file COPYING. If not, write to the Free
-Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA. */
+along with GCC; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
/* f95-lang.c-- GCC backend interface stuff */
/* declare required prototypes: */
#include "config.h"
+#include "system.h"
#include "ansidecl.h"
#include "system.h"
#include "coretypes.h"
#include "trans-types.h"
#include "trans-const.h"
-#include <assert.h>
-#include <stdio.h>
-
/* Language-dependent contents of an identifier. */
struct lang_identifier
/* The resulting tree type. */
union lang_tree_node
-GTY((desc ("TREE_CODE (&%h.generic) == IDENTIFIER_NODE")))
+GTY((desc ("TREE_CODE (&%h.generic) == IDENTIFIER_NODE"),
+ chain_next ("(union lang_tree_node *)GENERIC_NEXT (&%h.generic)")))
+
{
union tree_node GTY((tag ("0"),
desc ("tree_node_structure (&%h)"))) generic;
GTY(())
{
/* struct gfc_language_function base; */
- tree named_labels;
- tree shadowed_labels;
- int returns_value;
- int returns_abnormally;
- int warn_about_return_type;
- int extern_inline;
struct binding_level *binding_level;
};
void insert_block (tree);
static void gfc_clear_binding_stack (void);
static void gfc_be_parse_file (int);
-static void gfc_expand_function (tree);
+static alias_set_type gfc_get_alias_set (tree);
#undef LANG_HOOKS_NAME
#undef LANG_HOOKS_INIT
#undef LANG_HOOKS_POST_OPTIONS
#undef LANG_HOOKS_PRINT_IDENTIFIER
#undef LANG_HOOKS_PARSE_FILE
-#undef LANG_HOOKS_TRUTHVALUE_CONVERSION
#undef LANG_HOOKS_MARK_ADDRESSABLE
#undef LANG_HOOKS_TYPE_FOR_MODE
#undef LANG_HOOKS_TYPE_FOR_SIZE
-#undef LANG_HOOKS_UNSIGNED_TYPE
-#undef LANG_HOOKS_SIGNED_TYPE
-#undef LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE
-#undef LANG_HOOKS_CALLGRAPH_EXPAND_FUNCTION
#undef LANG_HOOKS_CLEAR_BINDING_STACK
+#undef LANG_HOOKS_GET_ALIAS_SET
+#undef LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE
+#undef LANG_HOOKS_OMP_PREDETERMINED_SHARING
+#undef LANG_HOOKS_OMP_CLAUSE_DEFAULT_CTOR
+#undef LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR
+#undef LANG_HOOKS_OMP_PRIVATE_DEBUG_CLAUSE
+#undef LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES
+#undef LANG_HOOKS_BUILTIN_FUNCTION
+#undef LANG_HOOKS_GET_ARRAY_DESCR_INFO
/* Define lang hooks. */
#define LANG_HOOKS_NAME "GNU F95"
#define LANG_HOOKS_POST_OPTIONS gfc_post_options
#define LANG_HOOKS_PRINT_IDENTIFIER gfc_print_identifier
#define LANG_HOOKS_PARSE_FILE gfc_be_parse_file
-#define LANG_HOOKS_TRUTHVALUE_CONVERSION gfc_truthvalue_conversion
#define LANG_HOOKS_MARK_ADDRESSABLE gfc_mark_addressable
#define LANG_HOOKS_TYPE_FOR_MODE gfc_type_for_mode
#define LANG_HOOKS_TYPE_FOR_SIZE gfc_type_for_size
-#define LANG_HOOKS_UNSIGNED_TYPE gfc_unsigned_type
-#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
+#define LANG_HOOKS_GET_ALIAS_SET gfc_get_alias_set
+#define LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE gfc_omp_privatize_by_reference
+#define LANG_HOOKS_OMP_PREDETERMINED_SHARING gfc_omp_predetermined_sharing
+#define LANG_HOOKS_OMP_CLAUSE_DEFAULT_CTOR gfc_omp_clause_default_ctor
+#define LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR gfc_omp_disregard_value_expr
+#define LANG_HOOKS_OMP_PRIVATE_DEBUG_CLAUSE gfc_omp_private_debug_clause
+#define LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES \
+ gfc_omp_firstprivatize_type_sizes
+#define LANG_HOOKS_BUILTIN_FUNCTION gfc_builtin_function
+#define LANG_HOOKS_GET_ARRAY_DESCR_INFO gfc_get_array_descr_info
const struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
#define DEFTREECODE(SYM, NAME, TYPE, LENGTH) TYPE,
-const char tree_code_type[] = {
+const enum tree_code_class tree_code_type[] = {
#include "tree.def"
};
#undef DEFTREECODE
};
#undef DEFTREECODE
-static tree named_labels;
#define NULL_BINDING_LEVEL (struct binding_level *) NULL
It is indexed by a RID_... value. */
tree *ridpointers = NULL;
-/* language-specific flags. */
-
-static void
-gfc_expand_function (tree fndecl)
-{
- tree_rest_of_compilation (fndecl, 0);
-}
-\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.
case BOOLEAN_TYPE:
if (TREE_TYPE (expr) == boolean_type_node)
return expr;
- else if (TREE_CODE_CLASS (TREE_CODE (expr)) == '<')
+ else if (COMPARISON_CLASS_P (expr))
{
TREE_TYPE (expr) = boolean_type_node;
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);
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,
+ build_int_cst (TREE_TYPE (expr), 0));
default:
internal_error ("Unexpected type in truthvalue_conversion");
}
}
+
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
gfc_init (void)
{
+#ifdef USE_MAPPED_LOCATION
+ linemap_add (line_table, LC_ENTER, false, gfc_source_file, 1);
+ linemap_add (line_table, LC_RENAME, false, "<built-in>", 0);
+#endif
+
/* First initialize the backend. */
gfc_init_decl_processing ();
gfc_static_ctors = NULL_TREE;
/* Then the frontend. */
gfc_init_1 ();
- if (gfc_new_file (gfc_option.source, gfc_option.source_form) != SUCCESS)
- fatal_error ("can't open input file: %s", gfc_option.source);
+ if (gfc_new_file () != SUCCESS)
+ fatal_error ("can't open input file: %s", gfc_source_file);
return true;
}
{
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
/* 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 binding level containing this one (the enclosing binding level). */
+ /* The binding level containing this one (the enclosing binding level). */
struct binding_level *level_chain;
};
/* Binding level structures are initialized by copying this one. */
static struct binding_level clear_binding_level = { NULL, NULL, NULL };
-\f
-/* Return non-zero if we are currently in the global binding level. */
+
+
+/* Return nonzero if we are currently in the global binding level. */
int
global_bindings_p (void)
tree
poplevel (int keep, int reverse, int functionbody)
{
- /* Points to a BLOCK tree node. This is the BLOCK node construted for the
+ /* Points to a BLOCK tree node. This is the BLOCK node constructed for the
binding level that we are about to exit and which is returned by this
routine. */
tree block_node = NULL_TREE;
/* 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
- reverse order except for PARM_DECL node, which are explicitely stored in
+ 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
create a BLOCK node to record them for the life of this function. */
if (keep || functionbody)
- block_node = build_block (keep ? decl_chain : 0, 0, subblock_chain, 0, 0);
+ block_node = build_block (keep ? decl_chain : 0, subblock_chain, 0, 0);
/* Record the BLOCK node just built as the subblock its enclosing scope. */
for (subblock_node = subblock_chain; subblock_node;
subblock_node = TREE_CHAIN (subblock_node))
if (DECL_NAME (subblock_node) != 0)
/* If the identifier was used or addressed via a local extern decl,
- don't forget that fact. */
+ don't forget that fact. */
if (DECL_EXTERNAL (subblock_node))
{
if (TREE_USED (subblock_node))
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. */
+ Returns the ..._DECL node. */
tree
pushdecl (tree decl)
TREE_CHAIN (decl) = current_binding_level->names;
current_binding_level->names = decl;
- /* For the declartion of a type, set its name if it is not already set. */
+ /* For the declaration of a type, set its name if it is not already set. */
if (TREE_CODE (decl) == TYPE_DECL && TYPE_NAME (TREE_TYPE (decl)) == 0)
{
gfc_init_decl_processing (void)
{
current_function_decl = NULL;
- named_labels = NULL;
current_binding_level = NULL_BINDING_LEVEL;
free_binding_level = NULL_BINDING_LEVEL;
/* 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. */
+ want double_type_node to actually have double precision. */
build_common_tree_nodes (false, false);
- set_sizetype (long_unsigned_type_node);
+ /* x86_64 minw32 has a sizetype of "unsigned long long", most other hosts
+ have a sizetype of "unsigned long". Therefore choose the correct size
+ in mostly target independent way. */
+ if (TYPE_MODE (long_unsigned_type_node) == Pmode)
+ set_sizetype (long_unsigned_type_node);
+ else if (TYPE_MODE (long_long_unsigned_type_node) == Pmode)
+ set_sizetype (long_long_unsigned_type_node);
+ else
+ set_sizetype (long_unsigned_type_node);
build_common_tree_nodes_2 (0);
+ void_list_node = build_tree_list (NULL_TREE, void_type_node);
/* Set up F95 type nodes. */
+ gfc_init_kinds ();
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 `%s' 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 `%s' used in nested function",
+ pedwarn ("register variable %qs used in nested function",
IDENTIFIER_POINTER (DECL_NAME (x)));
}
else if (DECL_REGISTER (x) && !TREE_ADDRESSABLE (x))
{
if (TREE_PUBLIC (x))
{
- error ("address of global register variable `%s' requested",
+ error ("address of global register variable %qs requested",
IDENTIFIER_POINTER (DECL_NAME (x)));
return true;
}
}
#endif
- pedwarn ("address of register variable `%s' requested",
+ pedwarn ("address of register variable %qs requested",
IDENTIFIER_POINTER (DECL_NAME (x)));
}
}
}
-/* press the big red button - garbage (ggc) collection is on */
-int ggc_p = 1;
+/* 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. */
+
+static alias_set_type
+gfc_get_alias_set (tree t)
+{
+ tree u;
-/* Builtin function initialisation. */
+ /* Permit type-punning when accessing an EQUIVALENCEd variable or
+ mixed type entry master's return value. */
+ for (u = t; handled_component_p (u); u = TREE_OPERAND (u, 0))
+ if (TREE_CODE (u) == COMPONENT_REF
+ && TREE_CODE (TREE_TYPE (TREE_OPERAND (u, 0))) == UNION_TYPE)
+ return 0;
+
+ return -1;
+}
+
+
+/* press the big red button - garbage (ggc) collection is on */
-/* Return a definition for a builtin function named NAME and whose data type
- is TYPE. TYPE should be a function type with argument types.
- FUNCTION_CODE tells later passes how to compile calls to this function.
- See tree.h for its possible values.
+int ggc_p = 1;
- If LIBRARY_NAME is nonzero, use that for DECL_ASSEMBLER_NAME,
- the name to be called if we can't opencode the function. If
- ATTRS is nonzero, use that for the function's attribute list. */
+/* Builtin function initialization. */
tree
-builtin_function (const char *name,
- tree type,
- int function_code,
- enum built_in_class class,
- const char *library_name,
- tree attrs ATTRIBUTE_UNUSED)
+gfc_builtin_function (tree decl)
{
- tree decl = build_decl (FUNCTION_DECL, get_identifier (name), type);
- DECL_EXTERNAL (decl) = 1;
- TREE_PUBLIC (decl) = 1;
- if (library_name)
- SET_DECL_ASSEMBLER_NAME (decl, get_identifier (library_name));
make_decl_rtl (decl);
pushdecl (decl);
- DECL_BUILT_IN_CLASS (decl) = class;
- DECL_FUNCTION_CODE (decl) = function_code;
return decl;
}
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;
- decl = builtin_function (name, type, code, BUILT_IN_NORMAL,
- library_name, NULL_TREE);
+ decl = add_builtin_function (name, type, code, BUILT_IN_NORMAL,
+ library_name, NULL_TREE);
if (const_p)
TREE_READONLY (decl) = 1;
}
-#define DEFINE_MATH_BUILTIN(code, name, nargs) \
- gfc_define_builtin ("__builtin_" name, mfunc_double[nargs-1], \
+#define DO_DEFINE_MATH_BUILTIN(code, name, argtype, tbase) \
+ gfc_define_builtin ("__builtin_" name "l", tbase##longdouble[argtype], \
+ BUILT_IN_ ## code ## L, name "l", true); \
+ gfc_define_builtin ("__builtin_" name, tbase##double[argtype], \
BUILT_IN_ ## code, name, true); \
- gfc_define_builtin ("__builtin_" name "f", mfunc_float[nargs-1], \
+ gfc_define_builtin ("__builtin_" name "f", tbase##float[argtype], \
BUILT_IN_ ## code ## F, name "f", true);
-/* Initialisation of builtin function nodes. */
+#define DEFINE_MATH_BUILTIN(code, name, argtype) \
+ DO_DEFINE_MATH_BUILTIN (code, name, argtype, mfunc_)
+
+#define DEFINE_MATH_BUILTIN_C(code, name, argtype) \
+ DO_DEFINE_MATH_BUILTIN (code, name, argtype, mfunc_) \
+ DO_DEFINE_MATH_BUILTIN (C##code, "c" name, argtype, mfunc_c)
+
+
+/* Create function types for builtin functions. */
+
static void
-gfc_init_builtin_functions (void)
+build_builtin_fntypes (tree *fntype, tree type)
{
- tree mfunc_float[2];
- tree mfunc_double[2];
- tree func_cfloat_float;
- tree func_cdouble_double;
- tree ftype;
tree tmp;
- tmp = tree_cons (NULL_TREE, float_type_node, void_list_node);
- 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);
-
+ /* type (*) (type) */
+ tmp = tree_cons (NULL_TREE, type, void_list_node);
+ fntype[0] = build_function_type (type, tmp);
+ /* type (*) (type, type) */
+ tmp = tree_cons (NULL_TREE, type, tmp);
+ fntype[1] = build_function_type (type, tmp);
+ /* type (*) (int, type) */
+ tmp = tree_cons (NULL_TREE, integer_type_node, void_list_node);
+ tmp = tree_cons (NULL_TREE, type, tmp);
+ fntype[2] = build_function_type (type, tmp);
+}
+
+
+static tree
+builtin_type_for_size (int size, bool unsignedp)
+{
+ tree type = lang_hooks.types.type_for_size (size, unsignedp);
+ return type ? type : error_mark_node;
+}
+
+/* Initialization of builtin function nodes. */
+
+static void
+gfc_init_builtin_functions (void)
+{
+ enum builtin_type
+ {
+#define DEF_PRIMITIVE_TYPE(NAME, VALUE) NAME,
+#define DEF_FUNCTION_TYPE_0(NAME, RETURN) NAME,
+#define DEF_FUNCTION_TYPE_1(NAME, RETURN, ARG1) NAME,
+#define DEF_FUNCTION_TYPE_2(NAME, RETURN, ARG1, ARG2) NAME,
+#define DEF_FUNCTION_TYPE_3(NAME, RETURN, ARG1, ARG2, ARG3) NAME,
+#define DEF_FUNCTION_TYPE_4(NAME, RETURN, ARG1, ARG2, ARG3, ARG4) NAME,
+#define DEF_FUNCTION_TYPE_5(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5) NAME,
+#define DEF_FUNCTION_TYPE_6(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, ARG6) NAME,
+#define DEF_FUNCTION_TYPE_7(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, ARG6, ARG7) NAME,
+#define DEF_FUNCTION_TYPE_VAR_0(NAME, RETURN) NAME,
+#define DEF_POINTER_TYPE(NAME, TYPE) NAME,
+#include "types.def"
+#undef DEF_PRIMITIVE_TYPE
+#undef DEF_FUNCTION_TYPE_0
+#undef DEF_FUNCTION_TYPE_1
+#undef DEF_FUNCTION_TYPE_2
+#undef DEF_FUNCTION_TYPE_3
+#undef DEF_FUNCTION_TYPE_4
+#undef DEF_FUNCTION_TYPE_5
+#undef DEF_FUNCTION_TYPE_6
+#undef DEF_FUNCTION_TYPE_7
+#undef DEF_FUNCTION_TYPE_VAR_0
+#undef DEF_POINTER_TYPE
+ BT_LAST
+ };
+ typedef enum builtin_type builtin_type;
+ enum
+ {
+ /* So far we need just these 2 attribute types. */
+ ATTR_NOTHROW_LIST,
+ ATTR_CONST_NOTHROW_LIST
+ };
+
+ tree mfunc_float[3];
+ tree mfunc_double[3];
+ tree mfunc_longdouble[3];
+ tree mfunc_cfloat[3];
+ tree mfunc_cdouble[3];
+ tree mfunc_clongdouble[3];
+ 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, type;
+ tree builtin_types[(int) BT_LAST + 1];
+
+ build_builtin_fntypes (mfunc_float, float_type_node);
+ build_builtin_fntypes (mfunc_double, double_type_node);
+ build_builtin_fntypes (mfunc_longdouble, long_double_type_node);
+ build_builtin_fntypes (mfunc_cfloat, complex_float_type_node);
+ build_builtin_fntypes (mfunc_cdouble, complex_double_type_node);
+ build_builtin_fntypes (mfunc_clongdouble, complex_long_double_type_node);
+
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, 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 seperately as the fortran versions have different
+ /* We define these separately as the fortran versions have different
semantics (they return an integer type) */
- gfc_define_builtin ("__builtin_floor", mfunc_double[0],
- BUILT_IN_FLOOR, "floor", true);
- gfc_define_builtin ("__builtin_floorf", mfunc_float[0],
- BUILT_IN_FLOORF, "floorf", true);
+ gfc_define_builtin ("__builtin_roundl", mfunc_longdouble[0],
+ BUILT_IN_ROUNDL, "roundl", true);
gfc_define_builtin ("__builtin_round", mfunc_double[0],
BUILT_IN_ROUND, "round", true);
gfc_define_builtin ("__builtin_roundf", mfunc_float[0],
BUILT_IN_ROUNDF, "roundf", true);
-
+
+ gfc_define_builtin ("__builtin_truncl", mfunc_longdouble[0],
+ BUILT_IN_TRUNCL, "truncl", true);
+ gfc_define_builtin ("__builtin_trunc", mfunc_double[0],
+ BUILT_IN_TRUNC, "trunc", true);
+ gfc_define_builtin ("__builtin_truncf", mfunc_float[0],
+ BUILT_IN_TRUNCF, "truncf", true);
+
+ gfc_define_builtin ("__builtin_cabsl", func_clongdouble_longdouble,
+ BUILT_IN_CABSL, "cabsl", 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_copysignl", mfunc_longdouble[1],
+ BUILT_IN_COPYSIGNL, "copysignl", 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);
+
+ 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);
+
+ /* lround{f,,l} and llround{f,,l} */
+ type = tree_cons (NULL_TREE, float_type_node, void_list_node);
+ tmp = build_function_type (long_integer_type_node, type);
+ gfc_define_builtin ("__builtin_lroundf", tmp, BUILT_IN_LROUNDF,
+ "lroundf", true);
+ tmp = build_function_type (long_long_integer_type_node, type);
+ gfc_define_builtin ("__builtin_llroundf", tmp, BUILT_IN_LLROUNDF,
+ "llroundf", true);
+
+ type = tree_cons (NULL_TREE, double_type_node, void_list_node);
+ tmp = build_function_type (long_integer_type_node, type);
+ gfc_define_builtin ("__builtin_lround", tmp, BUILT_IN_LROUND,
+ "lround", true);
+ tmp = build_function_type (long_long_integer_type_node, type);
+ gfc_define_builtin ("__builtin_llround", tmp, BUILT_IN_LLROUND,
+ "llround", true);
+
+ type = tree_cons (NULL_TREE, long_double_type_node, void_list_node);
+ tmp = build_function_type (long_integer_type_node, type);
+ gfc_define_builtin ("__builtin_lroundl", tmp, BUILT_IN_LROUNDL,
+ "lroundl", true);
+ tmp = build_function_type (long_long_integer_type_node, type);
+ gfc_define_builtin ("__builtin_llroundl", tmp, BUILT_IN_LLROUNDL,
+ "llroundl", true);
/* These are used to implement the ** operator. */
+ gfc_define_builtin ("__builtin_powl", mfunc_longdouble[1],
+ BUILT_IN_POWL, "powl", true);
gfc_define_builtin ("__builtin_pow", mfunc_double[1],
BUILT_IN_POW, "pow", true);
gfc_define_builtin ("__builtin_powf", mfunc_float[1],
BUILT_IN_POWF, "powf", true);
+ gfc_define_builtin ("__builtin_powil", mfunc_longdouble[2],
+ BUILT_IN_POWIL, "powil", true);
+ gfc_define_builtin ("__builtin_powi", mfunc_double[2],
+ BUILT_IN_POWI, "powi", true);
+ gfc_define_builtin ("__builtin_powif", mfunc_float[2],
+ BUILT_IN_POWIF, "powif", 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. */
gfc_define_builtin ("__builtin_expect", ftype, BUILT_IN_EXPECT,
"__builtin_expect", true);
- tmp = tree_cons (NULL_TREE, size_type_node, void_list_node);
- tmp = tree_cons (NULL_TREE, pvoid_type_node, tmp);
- tmp = tree_cons (NULL_TREE, pvoid_type_node, tmp);
- ftype = build_function_type (pvoid_type_node, tmp);
- gfc_define_builtin ("__builtin_memcpy", ftype, BUILT_IN_MEMCPY,
- "memcpy", false);
-
- tmp = tree_cons (NULL_TREE, integer_type_node, void_list_node);
- ftype = build_function_type (integer_type_node, tmp);
- gfc_define_builtin ("__builtin_clz", ftype, BUILT_IN_CLZ, "clz", true);
-
- tmp = tree_cons (NULL_TREE, long_integer_type_node, void_list_node);
- ftype = build_function_type (integer_type_node, tmp);
- gfc_define_builtin ("__builtin_clzl", ftype, BUILT_IN_CLZL, "clzl", true);
-
- tmp = tree_cons (NULL_TREE, long_long_integer_type_node, void_list_node);
- ftype = build_function_type (integer_type_node, tmp);
- gfc_define_builtin ("__builtin_clzll", ftype, BUILT_IN_CLZLL, "clzll", true);
-
tmp = tree_cons (NULL_TREE, pvoid_type_node, void_list_node);
- tmp = tree_cons (NULL_TREE, pvoid_type_node, tmp);
- tmp = tree_cons (NULL_TREE, pvoid_type_node, tmp);
ftype = build_function_type (void_type_node, tmp);
- gfc_define_builtin ("__builtin_init_trampoline", ftype,
- BUILT_IN_INIT_TRAMPOLINE, "init_trampoline", false);
+ gfc_define_builtin ("__builtin_free", ftype, BUILT_IN_FREE,
+ "free", false);
+
+ tmp = tree_cons (NULL_TREE, size_type_node, void_list_node);
+ ftype = build_function_type (pvoid_type_node, tmp);
+ gfc_define_builtin ("__builtin_malloc", ftype, BUILT_IN_MALLOC,
+ "malloc", false);
+ DECL_IS_MALLOC (built_in_decls[BUILT_IN_MALLOC]) = 1;
tmp = tree_cons (NULL_TREE, pvoid_type_node, void_list_node);
+ tmp = tree_cons (NULL_TREE, size_type_node, tmp);
ftype = build_function_type (pvoid_type_node, tmp);
- gfc_define_builtin ("__builtin_adjust_trampoline", ftype,
- BUILT_IN_ADJUST_TRAMPOLINE, "adjust_trampoline", true);
+ gfc_define_builtin ("__builtin_realloc", ftype, BUILT_IN_REALLOC,
+ "realloc", false);
- /* The stack_save, stack_restore, and alloca builtins aren't used directly.
- They are inserted during gimplification to implement variable sized
- stack allocation. */
+ tmp = tree_cons (NULL_TREE, void_type_node, void_list_node);
+ ftype = build_function_type (integer_type_node, tmp);
+ gfc_define_builtin ("__builtin_isnan", ftype, BUILT_IN_ISNAN,
+ "__builtin_isnan", true);
+
+#define DEF_PRIMITIVE_TYPE(ENUM, VALUE) \
+ builtin_types[(int) ENUM] = VALUE;
+#define DEF_FUNCTION_TYPE_0(ENUM, RETURN) \
+ builtin_types[(int) ENUM] \
+ = build_function_type (builtin_types[(int) RETURN], \
+ void_list_node);
+#define DEF_FUNCTION_TYPE_1(ENUM, RETURN, ARG1) \
+ builtin_types[(int) ENUM] \
+ = build_function_type (builtin_types[(int) RETURN], \
+ tree_cons (NULL_TREE, \
+ builtin_types[(int) ARG1], \
+ void_list_node));
+#define DEF_FUNCTION_TYPE_2(ENUM, RETURN, ARG1, ARG2) \
+ builtin_types[(int) ENUM] \
+ = build_function_type \
+ (builtin_types[(int) RETURN], \
+ tree_cons (NULL_TREE, \
+ builtin_types[(int) ARG1], \
+ tree_cons (NULL_TREE, \
+ builtin_types[(int) ARG2], \
+ void_list_node)));
+#define DEF_FUNCTION_TYPE_3(ENUM, RETURN, ARG1, ARG2, ARG3) \
+ builtin_types[(int) ENUM] \
+ = build_function_type \
+ (builtin_types[(int) RETURN], \
+ tree_cons (NULL_TREE, \
+ builtin_types[(int) ARG1], \
+ tree_cons (NULL_TREE, \
+ builtin_types[(int) ARG2], \
+ tree_cons (NULL_TREE, \
+ builtin_types[(int) ARG3], \
+ void_list_node))));
+#define DEF_FUNCTION_TYPE_4(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4) \
+ builtin_types[(int) ENUM] \
+ = build_function_type \
+ (builtin_types[(int) RETURN], \
+ tree_cons (NULL_TREE, \
+ builtin_types[(int) ARG1], \
+ tree_cons (NULL_TREE, \
+ builtin_types[(int) ARG2], \
+ tree_cons \
+ (NULL_TREE, \
+ builtin_types[(int) ARG3], \
+ tree_cons (NULL_TREE, \
+ builtin_types[(int) ARG4], \
+ void_list_node)))));
+#define DEF_FUNCTION_TYPE_5(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5) \
+ builtin_types[(int) ENUM] \
+ = build_function_type \
+ (builtin_types[(int) RETURN], \
+ tree_cons (NULL_TREE, \
+ builtin_types[(int) ARG1], \
+ tree_cons (NULL_TREE, \
+ builtin_types[(int) ARG2], \
+ tree_cons \
+ (NULL_TREE, \
+ builtin_types[(int) ARG3], \
+ tree_cons (NULL_TREE, \
+ builtin_types[(int) ARG4], \
+ tree_cons (NULL_TREE, \
+ builtin_types[(int) ARG5],\
+ void_list_node))))));
+#define DEF_FUNCTION_TYPE_6(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
+ ARG6) \
+ builtin_types[(int) ENUM] \
+ = build_function_type \
+ (builtin_types[(int) RETURN], \
+ tree_cons (NULL_TREE, \
+ builtin_types[(int) ARG1], \
+ tree_cons (NULL_TREE, \
+ builtin_types[(int) ARG2], \
+ tree_cons \
+ (NULL_TREE, \
+ builtin_types[(int) ARG3], \
+ tree_cons \
+ (NULL_TREE, \
+ builtin_types[(int) ARG4], \
+ tree_cons (NULL_TREE, \
+ builtin_types[(int) ARG5], \
+ tree_cons (NULL_TREE, \
+ builtin_types[(int) ARG6],\
+ void_list_node)))))));
+#define DEF_FUNCTION_TYPE_7(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
+ ARG6, ARG7) \
+ builtin_types[(int) ENUM] \
+ = build_function_type \
+ (builtin_types[(int) RETURN], \
+ tree_cons (NULL_TREE, \
+ builtin_types[(int) ARG1], \
+ tree_cons (NULL_TREE, \
+ builtin_types[(int) ARG2], \
+ tree_cons \
+ (NULL_TREE, \
+ builtin_types[(int) ARG3], \
+ tree_cons \
+ (NULL_TREE, \
+ builtin_types[(int) ARG4], \
+ tree_cons (NULL_TREE, \
+ builtin_types[(int) ARG5], \
+ tree_cons (NULL_TREE, \
+ builtin_types[(int) ARG6],\
+ tree_cons (NULL_TREE, \
+ builtin_types[(int) ARG6], \
+ void_list_node))))))));
+#define DEF_FUNCTION_TYPE_VAR_0(ENUM, RETURN) \
+ builtin_types[(int) ENUM] \
+ = build_function_type (builtin_types[(int) RETURN], NULL_TREE);
+#define DEF_POINTER_TYPE(ENUM, TYPE) \
+ builtin_types[(int) ENUM] \
+ = build_pointer_type (builtin_types[(int) TYPE]);
+#include "types.def"
+#undef DEF_PRIMITIVE_TYPE
+#undef DEF_FUNCTION_TYPE_1
+#undef DEF_FUNCTION_TYPE_2
+#undef DEF_FUNCTION_TYPE_3
+#undef DEF_FUNCTION_TYPE_4
+#undef DEF_FUNCTION_TYPE_5
+#undef DEF_FUNCTION_TYPE_6
+#undef DEF_FUNCTION_TYPE_VAR_0
+#undef DEF_POINTER_TYPE
+ builtin_types[(int) BT_LAST] = NULL_TREE;
+
+ /* Initialize synchronization builtins. */
+#undef DEF_SYNC_BUILTIN
+#define DEF_SYNC_BUILTIN(code, name, type, attr) \
+ gfc_define_builtin (name, builtin_types[type], code, name, \
+ attr == ATTR_CONST_NOTHROW_LIST);
+#include "../sync-builtins.def"
+#undef DEF_SYNC_BUILTIN
+
+ if (gfc_option.flag_openmp || flag_tree_parallelize_loops)
+ {
+#undef DEF_GOMP_BUILTIN
+#define DEF_GOMP_BUILTIN(code, name, type, attr) \
+ gfc_define_builtin ("__builtin_" name, builtin_types[type], \
+ code, name, attr == ATTR_CONST_NOTHROW_LIST);
+#include "../omp-builtins.def"
+#undef DEF_GOMP_BUILTIN
+ }
- ftype = build_function_type (pvoid_type_node, void_list_node);
- gfc_define_builtin ("__builtin_stack_save", ftype, BUILT_IN_STACK_SAVE,
- "stack_save", false);
+ gfc_define_builtin ("__builtin_trap", builtin_types[BT_FN_VOID],
+ BUILT_IN_TRAP, NULL, false);
+ TREE_THIS_VOLATILE (built_in_decls[BUILT_IN_TRAP]) = 1;
- 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);
+ 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);
- 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);
+ build_common_builtin_nodes ();
+ targetm.init_builtins ();
}
+#undef DEFINE_MATH_BUILTIN_C
#undef DEFINE_MATH_BUILTIN
#include "gt-fortran-f95-lang.h"