#include "config.h"
#include "system.h"
#include "ansidecl.h"
#include "system.h"
#include "coretypes.h"
#include "tree.h"
#include "tree-gimple.h"
#include "flags.h"
#include "langhooks.h"
#include "langhooks-def.h"
#include "timevar.h"
#include "tm.h"
#include "function.h"
#include "ggc.h"
#include "toplev.h"
#include "target.h"
#include "debug.h"
#include "diagnostic.h"
#include "tree-dump.h"
#include "cgraph.h"
#include "gfortran.h"
#include "trans.h"
#include "trans-types.h"
#include "trans-const.h"
struct lang_identifier
GTY(())
{
struct tree_identifier common;
};
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)"))) generic;
struct lang_identifier GTY((tag ("1"))) identifier;
};
struct language_function
GTY(())
{
struct binding_level *binding_level;
};
void yyerror (const char *str);
int yylex (void);
static void gfc_init_decl_processing (void);
static void gfc_init_builtin_functions (void);
static bool gfc_init (void);
static void gfc_finish (void);
static void gfc_print_identifier (FILE *, tree, int);
static bool gfc_mark_addressable (tree);
void do_function_end (void);
int global_bindings_p (void);
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 HOST_WIDE_INT gfc_get_alias_set (tree);
#undef LANG_HOOKS_NAME
#undef LANG_HOOKS_INIT
#undef LANG_HOOKS_FINISH
#undef LANG_HOOKS_INIT_OPTIONS
#undef LANG_HOOKS_HANDLE_OPTION
#undef LANG_HOOKS_POST_OPTIONS
#undef LANG_HOOKS_PRINT_IDENTIFIER
#undef LANG_HOOKS_PARSE_FILE
#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
#define LANG_HOOKS_NAME "GNU F95"
#define LANG_HOOKS_INIT gfc_init
#define LANG_HOOKS_FINISH gfc_finish
#define LANG_HOOKS_INIT_OPTIONS gfc_init_options
#define LANG_HOOKS_HANDLE_OPTION gfc_handle_option
#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_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
const struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
enum { blabla } c_language;
const char *constant_string_class_name = "die die";
int disable_typechecking_for_spec_flag = 0;
void build_modify_expr (void);
void iasm_addr (void);
void iasm_build_bracket (void);
void build_function_call (void);
void iasm_get_register_var (void);
bool iasm_is_pseudo (void);
void iasm_for_constraint (void);
void iasm_print_operand (void);
void iasm_force_constraint (void);
void pointer_int_sum (void);
void decl_constant_value (void);
void lookup_name (void);
void build_modify_expr (void) { abort (); }
void iasm_addr (void) { abort (); }
void iasm_build_bracket (void) { abort (); }
void build_function_call (void) { abort (); }
void iasm_get_register_var (void) { abort (); }
bool iasm_is_pseudo (void) { abort (); }
void iasm_for_constraint (void) { abort (); }
void iasm_print_operand (void) { abort (); }
void iasm_force_constraint (void) { abort (); }
void pointer_int_sum (void) { abort (); }
void decl_constant_value (void) { abort (); }
void lookup_name (void) { abort (); }
#define DEFTREECODE(SYM, NAME, TYPE, LENGTH) TYPE,
const enum tree_code_class tree_code_type[] = {
#include "tree.def"
};
#undef DEFTREECODE
#define DEFTREECODE(SYM, NAME, TYPE, LENGTH) LENGTH,
const unsigned char tree_code_length[] = {
#include "tree.def"
};
#undef DEFTREECODE
#define DEFTREECODE(SYM, NAME, TYPE, LEN) NAME,
const char *const tree_code_name[] = {
#include "tree.def"
};
#undef DEFTREECODE
#define NULL_BINDING_LEVEL (struct binding_level *) NULL
static GTY(()) struct binding_level *free_binding_level;
tree *ridpointers = NULL;
static void
gfc_expand_function (tree fndecl)
{
tree t;
if (DECL_INITIAL (fndecl)
&& BLOCK_SUBBLOCKS (DECL_INITIAL (fndecl)))
{
t = BLOCK_SUBBLOCKS (DECL_INITIAL (fndecl));
for (t = BLOCK_VARS (t); t; t = TREE_CHAIN (t))
if (TREE_CODE (t) == VAR_DECL && DECL_HAS_VALUE_EXPR_P (t)
&& TREE_STATIC (t))
{
tree expr = DECL_VALUE_EXPR (t);
if (TREE_CODE (expr) == COMPONENT_REF
&& 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
&& errorcount == 0 && sorrycount == 0)
{
timevar_push (TV_SYMOUT);
(*debug_hooks->global_decl) (t);
timevar_pop (TV_SYMOUT);
}
}
}
tree_rest_of_compilation (fndecl);
}
tree
gfc_truthvalue_conversion (tree expr)
{
switch (TREE_CODE (TREE_TYPE (expr)))
{
case BOOLEAN_TYPE:
if (TREE_TYPE (expr) == boolean_type_node)
return 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));
else
return build1 (NOP_EXPR, boolean_type_node, expr);
case INTEGER_TYPE:
if (TREE_CODE (expr) == INTEGER_CST)
return integer_zerop (expr) ? boolean_false_node : boolean_true_node;
else
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_builtin_functions ();
gfc_build_builtin_function_decls ();
gfc_init_constants ();
}
static void
gfc_be_parse_file (int set_yydebug ATTRIBUTE_UNUSED)
{
int errors;
int warnings;
gfc_create_decls ();
gfc_parse_file ();
gfc_generate_constructors ();
cgraph_finalize_compilation_unit ();
cgraph_optimize ();
gfc_get_errors (&warnings, &errors);
errorcount += errors;
warningcount += warnings;
}
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
gfc_init_decl_processing ();
gfc_static_ctors = NULL_TREE;
gfc_init_1 ();
if (gfc_new_file () != SUCCESS)
fatal_error ("can't open input file: %s", gfc_source_file);
return true;
}
static void
gfc_finish (void)
{
gfc_done_1 ();
gfc_release_include_path ();
return;
}
static void
gfc_print_identifier (FILE * file ATTRIBUTE_UNUSED,
tree node ATTRIBUTE_UNUSED,
int indent ATTRIBUTE_UNUSED)
{
return;
}
struct binding_level
GTY(())
{
tree names;
tree blocks;
struct binding_level *level_chain;
};
static GTY(()) struct binding_level *current_binding_level = NULL;
static GTY(()) struct binding_level *global_binding_level;
static struct binding_level clear_binding_level = { NULL, NULL, NULL };
int
global_bindings_p (void)
{
return current_binding_level == global_binding_level ? -1 : 0;
}
tree
getdecls (void)
{
return current_binding_level->names;
}
void
pushlevel (int ignore ATTRIBUTE_UNUSED)
{
struct binding_level *newlevel
= (struct binding_level *) ggc_alloc (sizeof (struct binding_level));
*newlevel = clear_binding_level;
newlevel->level_chain = current_binding_level;
current_binding_level = newlevel;
}
tree
poplevel (int keep, int reverse, int functionbody)
{
tree block_node = NULL_TREE;
tree decl_chain;
tree subblock_chain = current_binding_level->blocks;
tree subblock_node;
decl_chain = (reverse) ? nreverse (current_binding_level->names)
: current_binding_level->names;
if (keep || functionbody)
block_node = build_block (keep ? decl_chain : 0, subblock_chain, 0, 0);
for (subblock_node = subblock_chain; subblock_node;
subblock_node = TREE_CHAIN (subblock_node))
BLOCK_SUPERCONTEXT (subblock_node) = block_node;
for (subblock_node = decl_chain; subblock_node;
subblock_node = TREE_CHAIN (subblock_node))
if (DECL_NAME (subblock_node) != 0)
if (DECL_EXTERNAL (subblock_node))
{
if (TREE_USED (subblock_node))
TREE_USED (DECL_NAME (subblock_node)) = 1;
if (TREE_ADDRESSABLE (subblock_node))
TREE_ADDRESSABLE (DECL_ASSEMBLER_NAME (subblock_node)) = 1;
}
current_binding_level = current_binding_level->level_chain;
if (functionbody)
{
DECL_INITIAL (current_function_decl) = block_node;
BLOCK_VARS (block_node) = 0;
}
else if (block_node)
{
current_binding_level->blocks
= chainon (current_binding_level->blocks, block_node);
}
else if (subblock_chain)
current_binding_level->blocks
= chainon (current_binding_level->blocks, subblock_chain);
if (block_node)
TREE_USED (block_node) = 1;
return block_node;
}
void
insert_block (tree block)
{
TREE_USED (block) = 1;
current_binding_level->blocks
= chainon (current_binding_level->blocks, block);
}
tree
pushdecl (tree decl)
{
if ((DECL_EXTERNAL (decl)) || (decl == current_function_decl))
DECL_CONTEXT (decl) = 0;
else
DECL_CONTEXT (decl) = current_function_decl;
TREE_CHAIN (decl) = current_binding_level->names;
current_binding_level->names = decl;
if (TREE_CODE (decl) == TYPE_DECL && TYPE_NAME (TREE_TYPE (decl)) == 0)
{
if (DECL_SOURCE_LINE (decl) == 0)
TYPE_NAME (TREE_TYPE (decl)) = decl;
else
TYPE_NAME (TREE_TYPE (decl)) = DECL_NAME (decl);
}
return decl;
}
tree
pushdecl_top_level (tree x)
{
tree t;
struct binding_level *b = current_binding_level;
current_binding_level = global_binding_level;
t = pushdecl (x);
current_binding_level = b;
return t;
}
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
#ifndef INT_TYPE_SIZE
#define INT_TYPE_SIZE BITS_PER_WORD
#endif
#undef SIZE_TYPE
#define SIZE_TYPE "long unsigned int"
static void
gfc_init_decl_processing (void)
{
current_function_decl = NULL;
current_binding_level = NULL_BINDING_LEVEL;
free_binding_level = NULL_BINDING_LEVEL;
pushlevel (0);
global_binding_level = current_binding_level;
build_common_tree_nodes (false, false);
set_sizetype (long_unsigned_type_node);
build_common_tree_nodes_2 (0);
void_list_node = build_tree_list (NULL_TREE, void_type_node);
gfc_init_kinds ();
gfc_init_types ();
}
bool
gfc_mark_addressable (tree exp)
{
register tree x = exp;
while (1)
switch (TREE_CODE (x))
{
case COMPONENT_REF:
case ADDR_EXPR:
case ARRAY_REF:
case REALPART_EXPR:
case IMAGPART_EXPR:
x = TREE_OPERAND (x, 0);
break;
case CONSTRUCTOR:
TREE_ADDRESSABLE (x) = 1;
return true;
case VAR_DECL:
case CONST_DECL:
case PARM_DECL:
case RESULT_DECL:
if (DECL_REGISTER (x) && !TREE_ADDRESSABLE (x) && DECL_NONLOCAL (x))
{
if (TREE_PUBLIC (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",
IDENTIFIER_POINTER (DECL_NAME (x)));
}
else if (DECL_REGISTER (x) && !TREE_ADDRESSABLE (x))
{
if (TREE_PUBLIC (x))
{
error ("address of global register variable %qs requested",
IDENTIFIER_POINTER (DECL_NAME (x)));
return true;
}
#if 0
else if (C_TYPE_FIELDS_VOLATILE (TREE_TYPE (x)))
{
error ("cannot put object with volatile field into register");
return false;
}
#endif
pedwarn ("address of register variable %qs requested",
IDENTIFIER_POINTER (DECL_NAME (x)));
}
case FUNCTION_DECL:
TREE_ADDRESSABLE (x) = 1;
default:
return true;
}
}
static HOST_WIDE_INT
gfc_get_alias_set (tree t)
{
tree u;
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;
}
int ggc_p = 1;
tree
builtin_function (const char *name,
tree type,
int function_code,
enum built_in_class class,
const char *library_name,
tree attrs)
{
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));
#ifndef ENABLE_LLVM
make_decl_rtl (decl);
#else
make_decl_llvm (decl);
#endif
pushdecl (decl);
DECL_BUILT_IN_CLASS (decl) = class;
DECL_FUNCTION_CODE (decl) = function_code;
if (attrs)
{
if (lookup_attribute ( "const", attrs ))
TREE_READONLY (decl) = 1;
}
return decl;
}
static void
gfc_define_builtin (const char * name,
tree type,
int code,
const char * library_name,
bool const_p)
{
tree decl;
decl = builtin_function (name, type, code, BUILT_IN_NORMAL,
library_name, NULL_TREE);
if (const_p)
TREE_READONLY (decl) = 1;
built_in_decls[code] = decl;
implicit_built_in_decls[code] = decl;
}
#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", tbase##float[argtype], \
BUILT_IN_ ## code ## F, name "f", true);
#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)
static void
build_builtin_fntypes (tree * fntype, tree type)
{
tree tmp;
tmp = tree_cons (NULL_TREE, type, void_list_node);
fntype[0] = build_function_type (type, tmp);
tmp = tree_cons (NULL_TREE, type, tmp);
fntype[1] = build_function_type (type, tmp);
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;
}
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
{
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;
tree func_cdouble_double;
tree func_clongdouble_longdouble;
tree ftype;
tree tmp;
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, complex_double_type_node, void_list_node);
func_cdouble_double = build_function_type (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);
#include "mathbuiltins.def"
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);
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);
tmp = tree_cons (NULL_TREE, long_integer_type_node, void_list_node);
tmp = tree_cons (NULL_TREE, long_integer_type_node, tmp);
ftype = build_function_type (long_integer_type_node, tmp);
gfc_define_builtin ("__builtin_expect", ftype, BUILT_IN_EXPECT,
"__builtin_expect", 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;
#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)
{
#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
}
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;
build_common_builtin_nodes ();
targetm.init_builtins ();
}
#undef DEFINE_MATH_BUILTIN_C
#undef DEFINE_MATH_BUILTIN
#include "gt-fortran-f95-lang.h"
#include "gtype-fortran.h"