Initial check-in of gcc 4.7.2.

Change-Id: I4a2f5a921c21741a0e18bda986d77e5f1bef0365

1 files changed, 1170 insertions, 0 deletions

diff --git a/gcc-4.7/gcc/fortran/f95-lang.c b/gcc-4.7/gcc/fortran/f95-lang.c
new file mode 100644
index 000000000..a68d2fc83
--- /dev/null
+++ b/gcc-4.7/gcc/fortran/f95-lang.c
@@ -0,0 +1,1170 @@
+/* gfortran backend interface
+   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2010
+   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 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+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 "tree.h"
+#include "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 "cpp.h"
+#include "trans.h"
+#include "trans-types.h"
+#include "trans-const.h"
+
+/* Language-dependent contents of an identifier.  */
+
+struct GTY(())
+lang_identifier {
+  struct tree_identifier common;
+};
+
+/* The resulting tree type.  */
+
+union GTY((desc ("TREE_CODE (&%h.generic) == IDENTIFIER_NODE"),
+     chain_next ("CODE_CONTAINS_STRUCT (TREE_CODE (&%h.generic), TS_COMMON) ? ((union lang_tree_node *) TREE_CHAIN (&%h.generic)) : NULL")))
+
+lang_tree_node {
+  union tree_node GTY((tag ("0"),
+		       desc ("tree_node_structure (&%h)"))) generic;
+  struct lang_identifier GTY((tag ("1"))) identifier;
+};
+
+/* Save and restore the variables in this file and elsewhere
+   that keep track of the progress of compilation of the current function.
+   Used for nested functions.  */
+
+struct GTY(())
+language_function {
+  /* struct gfc_language_function base; */
+  struct binding_level *binding_level;
+};
+
+/* We don't have a lex/yacc lexer/parser, but toplev expects these to
+   exist anyway.  */
+void yyerror (const char *str);
+int yylex (void);
+
+static void gfc_init_decl_processing (void);
+static void gfc_init_builtin_functions (void);
+
+/* Each front end provides its own.  */
+static bool gfc_init (void);
+static void gfc_finish (void);
+static void gfc_write_global_declarations (void);
+static void gfc_print_identifier (FILE *, tree, int);
+void do_function_end (void);
+bool global_bindings_p (void);
+static void clear_binding_stack (void);
+static void gfc_be_parse_file (void);
+static alias_set_type gfc_get_alias_set (tree);
+static void gfc_init_ts (void);
+
+#undef LANG_HOOKS_NAME
+#undef LANG_HOOKS_INIT
+#undef LANG_HOOKS_FINISH
+#undef LANG_HOOKS_WRITE_GLOBALS
+#undef LANG_HOOKS_OPTION_LANG_MASK
+#undef LANG_HOOKS_INIT_OPTIONS_STRUCT
+#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_GET_ALIAS_SET
+#undef LANG_HOOKS_INIT_TS
+#undef LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE
+#undef LANG_HOOKS_OMP_PREDETERMINED_SHARING
+#undef LANG_HOOKS_OMP_REPORT_DECL
+#undef LANG_HOOKS_OMP_CLAUSE_DEFAULT_CTOR
+#undef LANG_HOOKS_OMP_CLAUSE_COPY_CTOR
+#undef LANG_HOOKS_OMP_CLAUSE_ASSIGN_OP
+#undef LANG_HOOKS_OMP_CLAUSE_DTOR
+#undef LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR
+#undef LANG_HOOKS_OMP_PRIVATE_DEBUG_CLAUSE
+#undef LANG_HOOKS_OMP_PRIVATE_OUTER_REF
+#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 Fortran"
+#define LANG_HOOKS_INIT                 gfc_init
+#define LANG_HOOKS_FINISH               gfc_finish
+#define LANG_HOOKS_WRITE_GLOBALS	gfc_write_global_declarations
+#define LANG_HOOKS_OPTION_LANG_MASK	gfc_option_lang_mask
+#define LANG_HOOKS_INIT_OPTIONS_STRUCT  gfc_init_options_struct
+#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_TYPE_FOR_MODE	gfc_type_for_mode
+#define LANG_HOOKS_TYPE_FOR_SIZE	gfc_type_for_size
+#define LANG_HOOKS_GET_ALIAS_SET	gfc_get_alias_set
+#define LANG_HOOKS_INIT_TS		gfc_init_ts
+#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_REPORT_DECL		gfc_omp_report_decl
+#define LANG_HOOKS_OMP_CLAUSE_DEFAULT_CTOR	gfc_omp_clause_default_ctor
+#define LANG_HOOKS_OMP_CLAUSE_COPY_CTOR		gfc_omp_clause_copy_ctor
+#define LANG_HOOKS_OMP_CLAUSE_ASSIGN_OP		gfc_omp_clause_assign_op
+#define LANG_HOOKS_OMP_CLAUSE_DTOR		gfc_omp_clause_dtor
+#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_PRIVATE_OUTER_REF	gfc_omp_private_outer_ref
+#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
+
+struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
+
+#define NULL_BINDING_LEVEL (struct binding_level *) NULL
+
+/* A chain of binding_level structures awaiting reuse.  */
+
+static GTY(()) struct binding_level *free_binding_level;
+
+/* The elements of `ridpointers' are identifier nodes
+   for the reserved type names and storage classes.
+   It is indexed by a RID_... value.  */
+tree *ridpointers = NULL;
+
+/* True means we've initialized exception handling.  */
+bool gfc_eh_initialized_p;
+
+/* The current translation unit.  */
+static GTY(()) tree current_translation_unit;
+
+
+/* Prepare expr to be an argument of a TRUTH_NOT_EXPR,
+   or validate its data type for an `if' or `while' statement or ?..: exp.
+
+   This preparation consists of taking the ordinary
+   representation of an expression expr and producing a valid tree
+   boolean expression describing whether expr is nonzero.  We could
+   simply always do build_binary_op (NE_EXPR, expr, boolean_false_node, 1),
+   but we optimize comparisons, &&, ||, and !.
+
+   The resulting type should always be `boolean_type_node'.
+   This is much simpler than the corresponding C version because we have a
+   distinct boolean type.  */
+
+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 fold_build1_loc (input_location, NOP_EXPR,
+			    boolean_type_node, TREE_OPERAND (expr, 0));
+      else
+        return fold_build1_loc (input_location, 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 fold_build2_loc (input_location, 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)
+{
+  /* GCC builtins.  */
+  gfc_init_builtin_functions ();
+
+  /* Runtime/IO library functions.  */
+  gfc_build_builtin_function_decls ();
+
+  gfc_init_constants ();
+
+  /* Build our translation-unit decl.  */
+  current_translation_unit = build_translation_unit_decl (NULL_TREE);
+}
+
+
+static void
+gfc_be_parse_file (void)
+{
+  int errors;
+  int warnings;
+
+  gfc_create_decls ();
+  gfc_parse_file ();
+  gfc_generate_constructors ();
+
+  /* Tell the frontend about any errors.  */
+  gfc_get_errors (&warnings, &errors);
+  errorcount += errors;
+  warningcount += warnings;
+
+  clear_binding_stack ();
+}
+
+
+/* Initialize everything.  */
+
+static bool
+gfc_init (void)
+{
+  if (!gfc_cpp_enabled ())
+    {
+      linemap_add (line_table, LC_ENTER, false, gfc_source_file, 1);
+      linemap_add (line_table, LC_RENAME, false, "<built-in>", 0);
+    }
+  else
+    gfc_cpp_init_0 ();
+
+  gfc_init_decl_processing ();
+  gfc_static_ctors = NULL_TREE;
+
+  if (gfc_cpp_enabled ())
+    gfc_cpp_init ();
+
+  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_cpp_done ();
+  gfc_done_1 ();
+  gfc_release_include_path ();
+  return;
+}
+
+/* ??? This is something of a hack.
+
+   Emulated tls lowering needs to see all TLS variables before we call
+   cgraph_finalize_compilation_unit.  The C/C++ front ends manage this
+   by calling decl_rest_of_compilation on each global and static variable
+   as they are seen.  The Fortran front end waits until this hook.
+
+   A Correct solution is for cgraph_finalize_compilation_unit not to be
+   called during the WRITE_GLOBALS langhook, and have that hook only do what
+   its name suggests and write out globals.  But the C++ and Java front ends
+   have (unspecified) problems with aliases that gets in the way.  It has
+   been suggested that these problems would be solved by completing the
+   conversion to cgraph-based aliases.  */
+
+static void
+gfc_write_global_declarations (void)
+{
+  tree decl;
+
+  /* Finalize all of the globals.  */
+  for (decl = getdecls(); decl ; decl = DECL_CHAIN (decl))
+    rest_of_decl_compilation (decl, true, true);
+
+  write_global_declarations ();
+}
+
+
+static void
+gfc_print_identifier (FILE * file ATTRIBUTE_UNUSED,
+		      tree node ATTRIBUTE_UNUSED,
+		      int indent ATTRIBUTE_UNUSED)
+{
+  return;
+}
+
+
+/* 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:
+
+        the global one
+        one for each subprogram definition
+        one for each compound statement (declare block)
+
+   Binding contours are used to create GCC tree BLOCK nodes.  */
+
+struct GTY(())
+binding_level {
+  /* A chain of ..._DECL nodes for all variables, constants, functions,
+     parameters and type declarations.  These ..._DECL nodes are chained
+     through the DECL_CHAIN field. Note that these ..._DECL nodes are stored
+     in the reverse of the order supplied to be compatible with the
+     back-end.  */
+  tree names;
+  /* 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).  */
+  struct binding_level *level_chain;
+};
+
+/* The binding level currently in effect.  */
+static GTY(()) struct binding_level *current_binding_level = NULL;
+
+/* The outermost binding level. This binding level is created when the
+   compiler is started and it will exist through the entire compilation.  */
+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 };
+
+
+/* Return true if we are in the global binding level.  */
+
+bool
+global_bindings_p (void)
+{
+  return current_binding_level == global_binding_level;
+}
+
+tree
+getdecls (void)
+{
+  return current_binding_level->names;
+}
+
+/* Enter a new binding level. The input parameter is ignored, but has to be
+   specified for back-end compatibility.  */
+
+void
+pushlevel (int ignore ATTRIBUTE_UNUSED)
+{
+  struct binding_level *newlevel = ggc_alloc_binding_level ();
+
+  *newlevel = clear_binding_level;
+
+  /* Add this level to the front of the chain (stack) of levels that are
+     active.  */
+  newlevel->level_chain = current_binding_level;
+  current_binding_level = newlevel;
+}
+
+/* Exit a binding level.
+   Pop the level off, and restore the state of the identifier-decl mappings
+   that were in effect when this level was entered.
+
+   If KEEP is nonzero, this level had explicit declarations, so
+   and create a "block" (a BLOCK node) for the level
+   to record its declarations and subblocks for symbol table output.
+
+   If FUNCTIONBODY is nonzero, this level is the body of a function,
+   so create a block as if KEEP were set and also clear out all
+   label names.
+
+   If REVERSE is nonzero, reverse the order of decls before putting
+   them into the BLOCK.  */
+
+tree
+poplevel (int keep, int reverse, int functionbody)
+{
+  /* 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;
+  tree decl_chain;
+  tree subblock_chain = current_binding_level->blocks;
+  tree subblock_node;
+
+  /* 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 explicitly stored in
+     the right order.  */
+  decl_chain = (reverse) ? nreverse (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, 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 = BLOCK_CHAIN (subblock_node))
+    BLOCK_SUPERCONTEXT (subblock_node) = block_node;
+
+  /* Clear out the meanings of the local variables of this level.  */
+
+  for (subblock_node = decl_chain; subblock_node;
+       subblock_node = DECL_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.  */
+      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;
+	}
+
+  /* Pop the current level.  */
+  current_binding_level = current_binding_level->level_chain;
+
+  if (functionbody)
+    /* This is the top level block of a function. */
+    DECL_INITIAL (current_function_decl) = block_node;
+  else if (current_binding_level == global_binding_level)
+    /* When using gfc_start_block/gfc_finish_block from middle-end hooks,
+       don't add newly created BLOCKs as subblocks of global_binding_level.  */
+    ;
+  else if (block_node)
+    {
+      current_binding_level->blocks
+	= block_chainon (current_binding_level->blocks, block_node);
+    }
+
+  /* If we did not make a block for the level just exited, any blocks made for
+     inner levels (since they cannot be recorded as subblocks in that level)
+     must be carried forward so they will later become subblocks of something
+     else.  */
+  else if (subblock_chain)
+    current_binding_level->blocks
+      = block_chainon (current_binding_level->blocks, subblock_chain);
+  if (block_node)
+    TREE_USED (block_node) = 1;
+
+  return block_node;
+}
+
+
+/* Records a ..._DECL node DECL as belonging to the current lexical scope.
+   Returns the ..._DECL node.  */
+
+tree
+pushdecl (tree decl)
+{
+  if (global_bindings_p ())
+    DECL_CONTEXT (decl) = current_translation_unit;
+  else
+    {
+      /* External objects aren't nested.  For debug info insert a copy
+         of the decl into the binding level.  */
+      if (DECL_EXTERNAL (decl))
+	{
+	  tree orig = decl;
+	  decl = copy_node (decl);
+	  DECL_CONTEXT (orig) = NULL_TREE;
+	}
+      DECL_CONTEXT (decl) = current_function_decl;
+    }
+
+  /* Put the declaration on the list.  The list of declarations is in reverse
+     order. The list will be reversed later if necessary.  This needs to be
+     this way for compatibility with the back-end.  */
+
+  DECL_CHAIN (decl) = current_binding_level->names;
+  current_binding_level->names = decl;
+
+  /* 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)
+    {
+      if (DECL_SOURCE_LINE (decl) == 0)
+	TYPE_NAME (TREE_TYPE (decl)) = decl;
+      else
+	TYPE_NAME (TREE_TYPE (decl)) = DECL_NAME (decl);
+    }
+
+  return decl;
+}
+
+
+/* Like pushdecl, only it places X in GLOBAL_BINDING_LEVEL.  */
+
+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;
+}
+
+
+/* Clear the binding stack.  */
+static void
+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"
+
+/* Create tree nodes for the basic scalar types of Fortran 95,
+   and some nodes representing standard constants (0, 1, (void *) 0).
+   Initialize the global binding level.
+   Make definitions for built-in primitive functions.  */
+static void
+gfc_init_decl_processing (void)
+{
+  current_function_decl = NULL;
+  current_binding_level = NULL_BINDING_LEVEL;
+  free_binding_level = NULL_BINDING_LEVEL;
+
+  /* Make the binding_level structure for global names. We move all
+     variables that are in a COMMON block to this binding level.  */
+  pushlevel (0);
+  global_binding_level = current_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.  */
+  build_common_tree_nodes (false, false);
+
+  void_list_node = build_tree_list (NULL_TREE, void_type_node);
+
+  /* Set up F95 type nodes.  */
+  gfc_init_kinds ();
+  gfc_init_types ();
+  gfc_init_c_interop_kinds ();
+}
+
+
+/* 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;
+
+  /* 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 */
+
+int ggc_p = 1;
+
+/* Builtin function initialization.  */
+
+tree
+gfc_builtin_function (tree decl)
+{
+  make_decl_rtl (decl);
+  pushdecl (decl);
+  return decl;
+}
+
+/* So far we need just these 4 attribute types.  */
+#define ATTR_NOTHROW_LEAF_LIST		(ECF_NOTHROW | ECF_LEAF)
+#define ATTR_CONST_NOTHROW_LEAF_LIST	(ECF_NOTHROW | ECF_LEAF | ECF_CONST)
+#define ATTR_NOTHROW_LIST		(ECF_NOTHROW)
+#define ATTR_CONST_NOTHROW_LIST		(ECF_NOTHROW | ECF_CONST)
+
+static void
+gfc_define_builtin (const char *name, tree type, enum built_in_function code,
+		    const char *library_name, int attr)
+{
+  tree decl;
+
+  decl = add_builtin_function (name, type, code, BUILT_IN_NORMAL,
+			       library_name, NULL_TREE);
+  if (attr & ECF_CONST)
+    TREE_READONLY (decl) = 1;
+  if (attr & ECF_NOTHROW)
+    TREE_NOTHROW (decl) = 1;
+  if (attr & ECF_LEAF)
+    DECL_ATTRIBUTES (decl) = tree_cons (get_identifier ("leaf"),
+					NULL, DECL_ATTRIBUTES (decl));
+
+  set_builtin_decl (code, decl, true);
+}
+
+
+#define DO_DEFINE_MATH_BUILTIN(code, name, argtype, tbase) \
+    gfc_define_builtin ("__builtin_" name "l", tbase##longdouble[argtype], \
+			BUILT_IN_ ## code ## L, name "l", \
+			ATTR_CONST_NOTHROW_LEAF_LIST); \
+    gfc_define_builtin ("__builtin_" name, tbase##double[argtype], \
+			BUILT_IN_ ## code, name, \
+			ATTR_CONST_NOTHROW_LEAF_LIST); \
+    gfc_define_builtin ("__builtin_" name "f", tbase##float[argtype], \
+			BUILT_IN_ ## code ## F, name "f", \
+			ATTR_CONST_NOTHROW_LEAF_LIST);
+
+#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
+build_builtin_fntypes (tree *fntype, tree type)
+{
+  /* type (*) (type) */
+  fntype[0] = build_function_type_list (type, type, NULL_TREE);
+  /* type (*) (type, type) */
+  fntype[1] = build_function_type_list (type, type, type, NULL_TREE);
+  /* type (*) (type, int) */
+  fntype[2] = build_function_type_list (type,
+                                        type, integer_type_node, NULL_TREE);
+  /* type (*) (void) */
+  fntype[3] = build_function_type_list (type, NULL_TREE);
+  /* type (*) (type, &int) */
+  fntype[4] = build_function_type_list (type, type,
+                                        build_pointer_type (integer_type_node),
+                                        NULL_TREE);
+  /* type (*) (int, type) */
+  fntype[5] = build_function_type_list (type,
+                                        integer_type_node, type, NULL_TREE);
+}
+
+
+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;
+
+  tree mfunc_float[6];
+  tree mfunc_double[6];
+  tree mfunc_longdouble[6];
+  tree mfunc_cfloat[6];
+  tree mfunc_cdouble[6];
+  tree mfunc_clongdouble[6];
+  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 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);
+
+  func_cfloat_float = build_function_type_list (float_type_node,
+                                                complex_float_type_node,
+                                                NULL_TREE);
+
+  func_float_cfloat = build_function_type_list (complex_float_type_node,
+                                                float_type_node, NULL_TREE);
+
+  func_cdouble_double = build_function_type_list (double_type_node,
+                                                  complex_double_type_node,
+                                                  NULL_TREE);
+
+  func_double_cdouble = build_function_type_list (complex_double_type_node,
+                                                  double_type_node, NULL_TREE);
+
+  func_clongdouble_longdouble =
+    build_function_type_list (long_double_type_node,
+                              complex_long_double_type_node, NULL_TREE);
+
+  func_longdouble_clongdouble =
+    build_function_type_list (complex_long_double_type_node,
+                              long_double_type_node, NULL_TREE);
+
+  ptype = build_pointer_type (float_type_node);
+  func_float_floatp_floatp =
+    build_function_type_list (void_type_node, ptype, ptype, NULL_TREE);
+
+  ptype = build_pointer_type (double_type_node);
+  func_double_doublep_doublep =
+    build_function_type_list (void_type_node, ptype, ptype, NULL_TREE);
+
+  ptype = build_pointer_type (long_double_type_node);
+  func_longdouble_longdoublep_longdoublep =
+    build_function_type_list (void_type_node, ptype, ptype, NULL_TREE);
+
+/* Non-math builtins are defined manually, so they're not included here.  */
+#define OTHER_BUILTIN(ID,NAME,TYPE,CONST)
+
+#include "mathbuiltins.def"
+
+  gfc_define_builtin ("__builtin_roundl", mfunc_longdouble[0], 
+		      BUILT_IN_ROUNDL, "roundl", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_round", mfunc_double[0], 
+		      BUILT_IN_ROUND, "round", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_roundf", mfunc_float[0], 
+		      BUILT_IN_ROUNDF, "roundf", ATTR_CONST_NOTHROW_LEAF_LIST);
+
+  gfc_define_builtin ("__builtin_truncl", mfunc_longdouble[0],
+		      BUILT_IN_TRUNCL, "truncl", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_trunc", mfunc_double[0],
+		      BUILT_IN_TRUNC, "trunc", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_truncf", mfunc_float[0],
+		      BUILT_IN_TRUNCF, "truncf", ATTR_CONST_NOTHROW_LEAF_LIST);
+
+  gfc_define_builtin ("__builtin_cabsl", func_clongdouble_longdouble, 
+		      BUILT_IN_CABSL, "cabsl", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_cabs", func_cdouble_double, 
+		      BUILT_IN_CABS, "cabs", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_cabsf", func_cfloat_float, 
+		      BUILT_IN_CABSF, "cabsf", ATTR_CONST_NOTHROW_LEAF_LIST);
+ 
+  gfc_define_builtin ("__builtin_copysignl", mfunc_longdouble[1], 
+		      BUILT_IN_COPYSIGNL, "copysignl",
+		      ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_copysign", mfunc_double[1], 
+		      BUILT_IN_COPYSIGN, "copysign",
+		      ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_copysignf", mfunc_float[1], 
+		      BUILT_IN_COPYSIGNF, "copysignf",
+		      ATTR_CONST_NOTHROW_LEAF_LIST);
+ 
+  gfc_define_builtin ("__builtin_nextafterl", mfunc_longdouble[1], 
+		      BUILT_IN_NEXTAFTERL, "nextafterl",
+		      ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_nextafter", mfunc_double[1], 
+		      BUILT_IN_NEXTAFTER, "nextafter",
+		      ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_nextafterf", mfunc_float[1], 
+		      BUILT_IN_NEXTAFTERF, "nextafterf",
+		      ATTR_CONST_NOTHROW_LEAF_LIST);
+ 
+  gfc_define_builtin ("__builtin_frexpl", mfunc_longdouble[4], 
+		      BUILT_IN_FREXPL, "frexpl", ATTR_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_frexp", mfunc_double[4], 
+		      BUILT_IN_FREXP, "frexp", ATTR_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_frexpf", mfunc_float[4], 
+		      BUILT_IN_FREXPF, "frexpf", ATTR_NOTHROW_LEAF_LIST);
+ 
+  gfc_define_builtin ("__builtin_fabsl", mfunc_longdouble[0], 
+		      BUILT_IN_FABSL, "fabsl", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_fabs", mfunc_double[0], 
+		      BUILT_IN_FABS, "fabs", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_fabsf", mfunc_float[0], 
+		      BUILT_IN_FABSF, "fabsf", ATTR_CONST_NOTHROW_LEAF_LIST);
+ 
+  gfc_define_builtin ("__builtin_scalbnl", mfunc_longdouble[5], 
+		      BUILT_IN_SCALBNL, "scalbnl", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_scalbn", mfunc_double[5], 
+		      BUILT_IN_SCALBN, "scalbn", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_scalbnf", mfunc_float[5], 
+		      BUILT_IN_SCALBNF, "scalbnf", ATTR_CONST_NOTHROW_LEAF_LIST);
+ 
+  gfc_define_builtin ("__builtin_fmodl", mfunc_longdouble[1], 
+		      BUILT_IN_FMODL, "fmodl", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_fmod", mfunc_double[1], 
+		      BUILT_IN_FMOD, "fmod", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_fmodf", mfunc_float[1], 
+		      BUILT_IN_FMODF, "fmodf", ATTR_CONST_NOTHROW_LEAF_LIST);
+
+  /* lround{f,,l} and llround{f,,l} */
+  ftype = build_function_type_list (long_integer_type_node,
+                                    float_type_node, NULL_TREE); 
+  gfc_define_builtin ("__builtin_lroundf", ftype, BUILT_IN_LROUNDF,
+		      "lroundf", ATTR_CONST_NOTHROW_LEAF_LIST);
+  ftype = build_function_type_list (long_long_integer_type_node,
+                                    float_type_node, NULL_TREE); 
+  gfc_define_builtin ("__builtin_llroundf", ftype, BUILT_IN_LLROUNDF,
+		      "llroundf", ATTR_CONST_NOTHROW_LEAF_LIST);
+
+  ftype = build_function_type_list (long_integer_type_node,
+                                    double_type_node, NULL_TREE); 
+  gfc_define_builtin ("__builtin_lround", ftype, BUILT_IN_LROUND,
+		      "lround", ATTR_CONST_NOTHROW_LEAF_LIST);
+  ftype = build_function_type_list (long_long_integer_type_node,
+                                    double_type_node, NULL_TREE); 
+  gfc_define_builtin ("__builtin_llround", ftype, BUILT_IN_LLROUND,
+		      "llround", ATTR_CONST_NOTHROW_LEAF_LIST);
+
+  ftype = build_function_type_list (long_integer_type_node,
+                                    long_double_type_node, NULL_TREE); 
+  gfc_define_builtin ("__builtin_lroundl", ftype, BUILT_IN_LROUNDL,
+		      "lroundl", ATTR_CONST_NOTHROW_LEAF_LIST);
+  ftype = build_function_type_list (long_long_integer_type_node,
+                                    long_double_type_node, NULL_TREE); 
+  gfc_define_builtin ("__builtin_llroundl", ftype, BUILT_IN_LLROUNDL,
+		      "llroundl", ATTR_CONST_NOTHROW_LEAF_LIST);
+
+  /* These are used to implement the ** operator.  */
+  gfc_define_builtin ("__builtin_powl", mfunc_longdouble[1], 
+		      BUILT_IN_POWL, "powl", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_pow", mfunc_double[1], 
+		      BUILT_IN_POW, "pow", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_powf", mfunc_float[1], 
+		      BUILT_IN_POWF, "powf", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_cpowl", mfunc_clongdouble[1], 
+		      BUILT_IN_CPOWL, "cpowl", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_cpow", mfunc_cdouble[1], 
+		      BUILT_IN_CPOW, "cpow", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_cpowf", mfunc_cfloat[1], 
+		      BUILT_IN_CPOWF, "cpowf", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_powil", mfunc_longdouble[2], 
+		      BUILT_IN_POWIL, "powil", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_powi", mfunc_double[2], 
+		      BUILT_IN_POWI, "powi", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_powif", mfunc_float[2], 
+		      BUILT_IN_POWIF, "powif", ATTR_CONST_NOTHROW_LEAF_LIST);
+
+
+  if (TARGET_C99_FUNCTIONS)
+    {
+      gfc_define_builtin ("__builtin_cbrtl", mfunc_longdouble[0],
+			  BUILT_IN_CBRTL, "cbrtl",
+			  ATTR_CONST_NOTHROW_LEAF_LIST);
+      gfc_define_builtin ("__builtin_cbrt", mfunc_double[0],
+			  BUILT_IN_CBRT, "cbrt",
+			  ATTR_CONST_NOTHROW_LEAF_LIST);
+      gfc_define_builtin ("__builtin_cbrtf", mfunc_float[0],
+			  BUILT_IN_CBRTF, "cbrtf",
+			  ATTR_CONST_NOTHROW_LEAF_LIST);
+      gfc_define_builtin ("__builtin_cexpil", func_longdouble_clongdouble, 
+			  BUILT_IN_CEXPIL, "cexpil",
+			  ATTR_CONST_NOTHROW_LEAF_LIST);
+      gfc_define_builtin ("__builtin_cexpi", func_double_cdouble,
+			  BUILT_IN_CEXPI, "cexpi",
+			  ATTR_CONST_NOTHROW_LEAF_LIST);
+      gfc_define_builtin ("__builtin_cexpif", func_float_cfloat,
+			  BUILT_IN_CEXPIF, "cexpif",
+			  ATTR_CONST_NOTHROW_LEAF_LIST);
+    }
+
+  if (TARGET_HAS_SINCOS)
+    {
+      gfc_define_builtin ("__builtin_sincosl",
+			  func_longdouble_longdoublep_longdoublep,
+			  BUILT_IN_SINCOSL, "sincosl", ATTR_NOTHROW_LEAF_LIST);
+      gfc_define_builtin ("__builtin_sincos", func_double_doublep_doublep,
+			  BUILT_IN_SINCOS, "sincos", ATTR_NOTHROW_LEAF_LIST);
+      gfc_define_builtin ("__builtin_sincosf", func_float_floatp_floatp,
+			  BUILT_IN_SINCOSF, "sincosf", ATTR_NOTHROW_LEAF_LIST);
+    }
+
+  /* For LEADZ, TRAILZ, POPCNT and POPPAR.  */
+  ftype = build_function_type_list (integer_type_node,
+                                    unsigned_type_node, NULL_TREE);
+  gfc_define_builtin ("__builtin_clz", ftype, BUILT_IN_CLZ,
+		      "__builtin_clz", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_ctz", ftype, BUILT_IN_CTZ,
+		      "__builtin_ctz", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_parity", ftype, BUILT_IN_PARITY,
+		      "__builtin_parity", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_popcount", ftype, BUILT_IN_POPCOUNT,
+		      "__builtin_popcount", ATTR_CONST_NOTHROW_LEAF_LIST);
+
+  ftype = build_function_type_list (integer_type_node,
+                                    long_unsigned_type_node, NULL_TREE);
+  gfc_define_builtin ("__builtin_clzl", ftype, BUILT_IN_CLZL,
+		      "__builtin_clzl", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_ctzl", ftype, BUILT_IN_CTZL,
+		      "__builtin_ctzl", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_parityl", ftype, BUILT_IN_PARITYL,
+		      "__builtin_parityl", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_popcountl", ftype, BUILT_IN_POPCOUNTL,
+		      "__builtin_popcountl", ATTR_CONST_NOTHROW_LEAF_LIST);
+
+  ftype = build_function_type_list (integer_type_node,
+                                    long_long_unsigned_type_node, NULL_TREE);
+  gfc_define_builtin ("__builtin_clzll", ftype, BUILT_IN_CLZLL,
+		      "__builtin_clzll", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_ctzll", ftype, BUILT_IN_CTZLL,
+		      "__builtin_ctzll", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_parityll", ftype, BUILT_IN_PARITYLL,
+		      "__builtin_parityll", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_popcountll", ftype, BUILT_IN_POPCOUNTLL,
+		      "__builtin_popcountll", ATTR_CONST_NOTHROW_LEAF_LIST);
+
+  /* Other builtin functions we use.  */
+
+  ftype = build_function_type_list (long_integer_type_node,
+                                    long_integer_type_node,
+                                    long_integer_type_node, NULL_TREE);
+  gfc_define_builtin ("__builtin_expect", ftype, BUILT_IN_EXPECT,
+		      "__builtin_expect", ATTR_CONST_NOTHROW_LEAF_LIST);
+
+  ftype = build_function_type_list (void_type_node,
+                                    pvoid_type_node, NULL_TREE);
+  gfc_define_builtin ("__builtin_free", ftype, BUILT_IN_FREE,
+		      "free", ATTR_NOTHROW_LEAF_LIST);
+
+  ftype = build_function_type_list (pvoid_type_node,
+                                    size_type_node, NULL_TREE);
+  gfc_define_builtin ("__builtin_malloc", ftype, BUILT_IN_MALLOC,
+		      "malloc", ATTR_NOTHROW_LEAF_LIST);
+  DECL_IS_MALLOC (builtin_decl_explicit (BUILT_IN_MALLOC)) = 1;
+
+  ftype = build_function_type_list (pvoid_type_node, size_type_node,
+				    size_type_node, NULL_TREE);
+  gfc_define_builtin ("__builtin_calloc", ftype, BUILT_IN_CALLOC,
+		      "calloc", ATTR_NOTHROW_LEAF_LIST);
+  DECL_IS_MALLOC (builtin_decl_explicit (BUILT_IN_CALLOC)) = 1;
+
+  ftype = build_function_type_list (pvoid_type_node,
+                                    size_type_node, pvoid_type_node,
+                                    NULL_TREE);
+  gfc_define_builtin ("__builtin_realloc", ftype, BUILT_IN_REALLOC,
+		      "realloc", ATTR_NOTHROW_LEAF_LIST);
+
+  ftype = build_function_type_list (integer_type_node,
+                                    void_type_node, NULL_TREE);
+  gfc_define_builtin ("__builtin_isnan", ftype, BUILT_IN_ISNAN,
+		      "__builtin_isnan", ATTR_CONST_NOTHROW_LEAF_LIST);
+
+#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_list (builtin_types[(int) RETURN],	\
+                                NULL_TREE);
+#define DEF_FUNCTION_TYPE_1(ENUM, RETURN, ARG1)				\
+  builtin_types[(int) ENUM]						\
+    = build_function_type_list (builtin_types[(int) RETURN],            \
+                                builtin_types[(int) ARG1],              \
+                                NULL_TREE);
+#define DEF_FUNCTION_TYPE_2(ENUM, RETURN, ARG1, ARG2)           \
+  builtin_types[(int) ENUM]                                     \
+    = build_function_type_list (builtin_types[(int) RETURN],    \
+                                builtin_types[(int) ARG1],      \
+                                builtin_types[(int) ARG2],      \
+                                NULL_TREE);
+#define DEF_FUNCTION_TYPE_3(ENUM, RETURN, ARG1, ARG2, ARG3)             \
+  builtin_types[(int) ENUM]                                             \
+    = build_function_type_list (builtin_types[(int) RETURN],            \
+                                builtin_types[(int) ARG1],              \
+                                builtin_types[(int) ARG2],              \
+                                builtin_types[(int) ARG3],              \
+                                NULL_TREE);
+#define DEF_FUNCTION_TYPE_4(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4)	\
+  builtin_types[(int) ENUM]						\
+    = build_function_type_list (builtin_types[(int) RETURN],            \
+                                builtin_types[(int) ARG1],              \
+                                builtin_types[(int) ARG2],              \
+                                builtin_types[(int) ARG3],		\
+                                builtin_types[(int) ARG4],              \
+                                NULL_TREE);
+#define DEF_FUNCTION_TYPE_5(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5)	\
+  builtin_types[(int) ENUM]						\
+    = build_function_type_list (builtin_types[(int) RETURN],            \
+                                builtin_types[(int) ARG1],              \
+                                builtin_types[(int) ARG2],              \
+                                builtin_types[(int) ARG3],		\
+                                builtin_types[(int) ARG4],              \
+                                builtin_types[(int) ARG5],              \
+                                NULL_TREE);
+#define DEF_FUNCTION_TYPE_6(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
+			    ARG6)					\
+  builtin_types[(int) ENUM]						\
+    = build_function_type_list (builtin_types[(int) RETURN],            \
+                                builtin_types[(int) ARG1],              \
+                                builtin_types[(int) ARG2],              \
+                                builtin_types[(int) ARG3],		\
+                                builtin_types[(int) ARG4],		\
+                                builtin_types[(int) ARG5],              \
+                                builtin_types[(int) ARG6],              \
+                                NULL_TREE);
+#define DEF_FUNCTION_TYPE_7(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
+			    ARG6, ARG7)					\
+  builtin_types[(int) ENUM]						\
+    = build_function_type_list (builtin_types[(int) RETURN],            \
+                                builtin_types[(int) ARG1],              \
+                                builtin_types[(int) ARG2],              \
+                                builtin_types[(int) ARG3],		\
+                                builtin_types[(int) ARG4],		\
+                                builtin_types[(int) ARG5],              \
+                                builtin_types[(int) ARG6],              \
+                                builtin_types[(int) ARG7],              \
+                                NULL_TREE);
+#define DEF_FUNCTION_TYPE_VAR_0(ENUM, RETURN)				\
+  builtin_types[(int) ENUM]						\
+    = build_varargs_function_type_list (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);
+#include "../sync-builtins.def"
+#undef DEF_SYNC_BUILTIN
+
+  if (gfc_option.gfc_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);
+#include "../omp-builtins.def"
+#undef DEF_GOMP_BUILTIN
+    }
+
+  gfc_define_builtin ("__builtin_trap", builtin_types[BT_FN_VOID],
+		      BUILT_IN_TRAP, NULL, ATTR_NOTHROW_LEAF_LIST);
+  TREE_THIS_VOLATILE (builtin_decl_explicit (BUILT_IN_TRAP)) = 1;
+
+  gfc_define_builtin ("__emutls_get_address",
+		      builtin_types[BT_FN_PTR_PTR],
+		      BUILT_IN_EMUTLS_GET_ADDRESS,
+		      "__emutls_get_address", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__emutls_register_common",
+		      builtin_types[BT_FN_VOID_PTR_WORD_WORD_PTR],
+		      BUILT_IN_EMUTLS_REGISTER_COMMON,
+		      "__emutls_register_common", ATTR_NOTHROW_LEAF_LIST);
+
+  build_common_builtin_nodes ();
+  targetm.init_builtins ();
+}
+
+#undef DEFINE_MATH_BUILTIN_C
+#undef DEFINE_MATH_BUILTIN
+
+static void
+gfc_init_ts (void)
+{
+  tree_contains_struct[NAMESPACE_DECL][TS_DECL_NON_COMMON] = 1;
+  tree_contains_struct[NAMESPACE_DECL][TS_DECL_WITH_VIS] = 1;
+  tree_contains_struct[NAMESPACE_DECL][TS_DECL_WRTL] = 1;
+  tree_contains_struct[NAMESPACE_DECL][TS_DECL_COMMON] = 1;
+  tree_contains_struct[NAMESPACE_DECL][TS_DECL_MINIMAL] = 1;
+}
+
+void
+gfc_maybe_initialize_eh (void)
+{
+  if (!flag_exceptions || gfc_eh_initialized_p)
+    return;
+
+  gfc_eh_initialized_p = true;
+  using_eh_for_cleanups ();
+}
+
+
+#include "gt-fortran-f95-lang.h"
+#include "gtype-fortran.h"