OSDN Git Service

(root) / pf3gnuchains / gcc-fork.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
* builtin-types.def (BT_FN_PTR_PTR_SIZE): New type.
[pf3gnuchains/gcc-fork.git] / gcc / fortran / f95-lang.c
diff --git a/gcc/fortran/f95-lang.c b/gcc/fortran/f95-lang.c
index 8edf569..05f6750 100644 (file)
--- a/gcc/fortran/f95-lang.c
+++ b/gcc/fortran/f95-lang.c
@@ -1,13 +1,13 @@
 /* gfortran backend interface
 /* gfortran backend interface
-   Copyright (C) 2000, 2001, 2002, 2003, 2004 Free Software Foundation,
-   Inc.
+   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
    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
 version.
 
 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
@@ -16,15 +16,15 @@ 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
 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"
 
 /* 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 "ansidecl.h"
 #include "system.h"
 #include "coretypes.h"
@@ -49,8 +49,6 @@ Software Foundation, 59 Temple Place - Suite 330, Boston, MA
 #include "trans-types.h"
 #include "trans-const.h"
 
 #include "trans-types.h"
 #include "trans-const.h"
 
-#include <stdio.h>
-
 /* Language-dependent contents of an identifier.  */
 
 struct lang_identifier
 /* Language-dependent contents of an identifier.  */
 
 struct lang_identifier
@@ -62,7 +60,9 @@ GTY(())
 /* The resulting tree type.  */
 
 union lang_tree_node
 /* 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;
 {
   union tree_node GTY((tag ("0"),
                       desc ("tree_node_structure (&%h)"))) generic;
@@ -77,12 +77,6 @@ struct language_function
 GTY(())
 {
   /* struct gfc_language_function base; */
 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;
 };
 
   struct binding_level *binding_level;
 };
 
@@ -105,6 +99,7 @@ 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 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_NAME
 #undef LANG_HOOKS_INIT
@@ -114,15 +109,19 @@ static void gfc_expand_function (tree);
 #undef LANG_HOOKS_POST_OPTIONS
 #undef LANG_HOOKS_PRINT_IDENTIFIER
 #undef LANG_HOOKS_PARSE_FILE
 #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_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_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
 
 /* Define lang hooks.  */
 #define LANG_HOOKS_NAME                 "GNU F95"
 
 /* Define lang hooks.  */
 #define LANG_HOOKS_NAME                 "GNU F95"
@@ -133,15 +132,20 @@ static void gfc_expand_function (tree);
 #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_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_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_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
 
 const struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
 
 
 const struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
 
@@ -178,7 +182,6 @@ const char *const tree_code_name[] = {
 };
 #undef DEFTREECODE
 
 };
 #undef DEFTREECODE
 
-static tree named_labels;
 
 #define NULL_BINDING_LEVEL (struct binding_level *) NULL
 
 
 #define NULL_BINDING_LEVEL (struct binding_level *) NULL
 
@@ -196,9 +199,39 @@ tree *ridpointers = NULL;
 static void
 gfc_expand_function (tree fndecl)
 {
 static void
 gfc_expand_function (tree fndecl)
 {
-  tree_rest_of_compilation (fndecl, 0);
+  tree t;
+
+  if (DECL_INITIAL (fndecl)
+      && BLOCK_SUBBLOCKS (DECL_INITIAL (fndecl)))
+    {
+      /* Local static equivalenced variables are never seen by
+        check_global_declarations, so we need to output debug
+        info by hand.  */
+
+      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
+               && 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);
 }
 }
-\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.
 
 /* Prepare expr to be an argument of a TRUTH_NOT_EXPR,
    or validate its data type for an `if' or `while' statement or ?..: exp.
@@ -227,8 +260,7 @@ gfc_truthvalue_conversion (tree expr)
          return expr;
        }
       else if (TREE_CODE (expr) == NOP_EXPR)
          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);
 
       else
         return build1 (NOP_EXPR, boolean_type_node, expr);
 
@@ -236,13 +268,15 @@ gfc_truthvalue_conversion (tree expr)
       if (TREE_CODE (expr) == INTEGER_CST)
        return integer_zerop (expr) ? boolean_false_node : boolean_true_node;
       else
       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, 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");
     }
 }
 
 
     default:
       internal_error ("Unexpected type in truthvalue_conversion");
     }
 }
 
+
 static void
 gfc_create_decls (void)
 {
 static void
 gfc_create_decls (void)
 {
@@ -255,6 +289,7 @@ gfc_create_decls (void)
   gfc_init_constants ();
 }
 
   gfc_init_constants ();
 }
 
+
 static void
 gfc_be_parse_file (int set_yydebug ATTRIBUTE_UNUSED)
 {
 static void
 gfc_be_parse_file (int set_yydebug ATTRIBUTE_UNUSED)
 {
@@ -273,14 +308,15 @@ gfc_be_parse_file (int set_yydebug ATTRIBUTE_UNUSED)
   errorcount += errors;
   warningcount += warnings;
 }
   errorcount += errors;
   warningcount += warnings;
 }
-\f
+
+
 /* Initialize everything.  */
 
 static bool
 gfc_init (void)
 {
 #ifdef USE_MAPPED_LOCATION
 /* Initialize everything.  */
 
 static bool
 gfc_init (void)
 {
 #ifdef USE_MAPPED_LOCATION
-  linemap_add (&line_table, LC_ENTER, false, gfc_option.source, 1);
+  linemap_add (&line_table, LC_ENTER, false, gfc_source_file, 1);
   linemap_add (&line_table, LC_RENAME, false, "<built-in>", 0);
 #endif
 
   linemap_add (&line_table, LC_RENAME, false, "<built-in>", 0);
 #endif
 
@@ -291,8 +327,8 @@ gfc_init (void)
   /* Then the frontend.  */
   gfc_init_1 ();
 
   /* 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 true;
 }
 
@@ -312,15 +348,16 @@ gfc_print_identifier (FILE * file ATTRIBUTE_UNUSED,
 {
   return;
 }
 {
   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.  */
 
 
 /* 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
 
         the global one
         one for each subprogram definition
@@ -340,7 +377,7 @@ GTY(())
   /* 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;
   /* 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;
 };
 
   struct binding_level *level_chain;
 };
 
@@ -353,7 +390,8 @@ 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 };
 
 /* Binding level structures are initialized by copying this one.  */
 static struct binding_level clear_binding_level = { NULL, NULL, NULL };
-\f
+
+
 /* Return nonzero if we are currently in the global binding level.  */
 
 int
 /* Return nonzero if we are currently in the global binding level.  */
 
 int
@@ -416,13 +454,13 @@ poplevel (int keep, int reverse, int functionbody)
      reverse order except for PARM_DECL node, which are explicitly stored in
      the right order.  */
   decl_chain = (reverse) ? nreverse (current_binding_level->names)
      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)
 
   /* 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;
 
   /* Record the BLOCK node just built as the subblock its enclosing scope.  */
   for (subblock_node = subblock_chain; subblock_node;
@@ -435,7 +473,7 @@ poplevel (int keep, int reverse, int functionbody)
        subblock_node = TREE_CHAIN (subblock_node))
     if (DECL_NAME (subblock_node) != 0)
       /* If the identifier was used or addressed via a local extern decl,
        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))
       if (DECL_EXTERNAL (subblock_node))
        {
          if (TREE_USED (subblock_node))
@@ -474,7 +512,8 @@ poplevel (int keep, int reverse, int functionbody)
 
   return block_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.  */
 /* 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.  */
@@ -487,8 +526,9 @@ insert_block (tree block)
     = chainon (current_binding_level->blocks, block);
 }
 
     = chainon (current_binding_level->blocks, block);
 }
 
+
 /* Records a ..._DECL node DECL as belonging to the current lexical scope.
 /* 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
 pushdecl (tree decl)
@@ -506,7 +546,7 @@ pushdecl (tree decl)
   TREE_CHAIN (decl) = current_binding_level->names;
   current_binding_level->names = 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)
     {
 
   if (TREE_CODE (decl) == TYPE_DECL && TYPE_NAME (TREE_TYPE (decl)) == 0)
     {
@@ -563,7 +603,6 @@ static void
 gfc_init_decl_processing (void)
 {
   current_function_decl = NULL;
 gfc_init_decl_processing (void)
 {
   current_function_decl = NULL;
-  named_labels = NULL;
   current_binding_level = NULL_BINDING_LEVEL;
   free_binding_level = NULL_BINDING_LEVEL;
 
   current_binding_level = NULL_BINDING_LEVEL;
   free_binding_level = NULL_BINDING_LEVEL;
 
@@ -574,16 +613,26 @@ gfc_init_decl_processing (void)
 
   /* Build common tree nodes. char_type_node is unsigned because we
      only use it for actual characters, not for INTEGER(1). Also, we
 
   /* 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);
   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);
   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 ();
 }
 
 
   /* 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
 /* 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
@@ -591,6 +640,7 @@ gfc_init_decl_processing (void)
    likely future Cray pointer extension.
    Value is 1 if successful.  */
 /* TODO: Check/fix mark_addressable.  */
    likely future Cray pointer extension.
    Value is 1 if successful.  */
 /* TODO: Check/fix mark_addressable.  */
+
 bool
 gfc_mark_addressable (tree exp)
 {
 bool
 gfc_mark_addressable (tree exp)
 {
@@ -618,19 +668,18 @@ gfc_mark_addressable (tree exp)
          {
            if (TREE_PUBLIC (x))
              {
          {
            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;
              }
                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))
              {
                     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;
              }
                       IDENTIFIER_POINTER (DECL_NAME (x)));
                return true;
              }
@@ -648,7 +697,7 @@ gfc_mark_addressable (tree exp)
              }
 #endif
 
              }
 #endif
 
-           pedwarn ("address of register variable `%s' requested",
+           pedwarn ("address of register variable %qs requested",
                     IDENTIFIER_POINTER (DECL_NAME (x)));
          }
 
                     IDENTIFIER_POINTER (DECL_NAME (x)));
          }
 
@@ -661,53 +710,52 @@ gfc_mark_addressable (tree exp)
       }
 }
 
       }
 }
 
+
+/* 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.  */
 
 /* press the big red button - garbage (ggc) collection is on */
 
 int ggc_p = 1;
 
 /* Builtin function initialization.  */
 
-/* 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.
-
-   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.  */
-
 tree
 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);
   make_decl_rtl (decl);
   pushdecl (decl);
-  DECL_BUILT_IN_CLASS (decl) = class;
-  DECL_FUNCTION_CODE (decl) = function_code;
   return decl;
 }
 
 
 static void
   return decl;
 }
 
 
 static void
-gfc_define_builtin (const char * name,
+gfc_define_builtin (const char *name,
                    tree type,
                    int code,
                    tree type,
                    int code,
-                   const char * library_name,
+                   const char *library_name,
                    bool const_p)
 {
   tree decl;
 
                    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;
 
   if (const_p)
     TREE_READONLY (decl) = 1;
 
@@ -717,6 +765,8 @@ gfc_define_builtin (const char * name,
 
 
 #define DO_DEFINE_MATH_BUILTIN(code, name, argtype, tbase) \
 
 
 #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], \
     gfc_define_builtin ("__builtin_" name, tbase##double[argtype], \
                        BUILT_IN_ ## code, name, true); \
     gfc_define_builtin ("__builtin_" name "f", tbase##float[argtype], \
@@ -725,25 +775,23 @@ gfc_define_builtin (const char * name,
 #define DEFINE_MATH_BUILTIN(code, name, argtype) \
     DO_DEFINE_MATH_BUILTIN (code, name, argtype, mfunc_)
 
 #define DEFINE_MATH_BUILTIN(code, name, argtype) \
     DO_DEFINE_MATH_BUILTIN (code, name, argtype, mfunc_)
 
-/* The middle-end is missing builtins for some complex math functions, so
-   we don't use them yet.  */
 #define DEFINE_MATH_BUILTIN_C(code, name, argtype) \
 #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)*/
+    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
 
 
 /* Create function types for builtin functions.  */
 
 static void
-build_builtin_fntypes (tree * fntype, tree type)
+build_builtin_fntypes (tree *fntype, tree type)
 {
   tree tmp;
 
   /* type (*) (type) */
 {
   tree tmp;
 
   /* type (*) (type) */
-  tmp = tree_cons (NULL_TREE, float_type_node, void_list_node);
+  tmp = tree_cons (NULL_TREE, type, void_list_node);
   fntype[0] = build_function_type (type, tmp);
   /* type (*) (type, type) */
   fntype[0] = build_function_type (type, tmp);
   /* type (*) (type, type) */
-  tmp = tree_cons (NULL_TREE, float_type_node, tmp);
+  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);
   fntype[1] = build_function_type (type, tmp);
   /* type (*) (int, type) */
   tmp = tree_cons (NULL_TREE, integer_type_node, void_list_node);
@@ -752,60 +800,222 @@ build_builtin_fntypes (tree * fntype, tree type)
 }
 
 
 }
 
 
+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)
 {
 /* 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_float[3];
   tree mfunc_double[3];
+  tree mfunc_longdouble[3];
   tree mfunc_cfloat[3];
   tree mfunc_cdouble[3];
   tree mfunc_cfloat[3];
   tree mfunc_cdouble[3];
-  tree func_cfloat_float;
-  tree func_cdouble_double;
-  tree ftype;
-  tree tmp;
+  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_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_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_float_type_node, void_list_node);
   func_cfloat_float = build_function_type (float_type_node, tmp);
 
+  tmp = tree_cons (NULL_TREE, float_type_node, void_list_node);
+  func_float_cfloat = build_function_type (complex_float_type_node, tmp);
+
   tmp = tree_cons (NULL_TREE, complex_double_type_node, void_list_node);
   func_cdouble_double = build_function_type (double_type_node, tmp);
 
   tmp = tree_cons (NULL_TREE, 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"
 
 #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) */
      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_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_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_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.  */
 
   /* 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_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.  */
 
 
   /* Other builtin functions we use.  */
 
@@ -815,54 +1025,182 @@ gfc_init_builtin_functions (void)
   gfc_define_builtin ("__builtin_expect", ftype, BUILT_IN_EXPECT,
                      "__builtin_expect", true);
 
   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, 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);
   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, pvoid_type_node, void_list_node);
+  tmp = tree_cons (NULL_TREE, size_type_node, tmp);
   ftype = build_function_type (pvoid_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)
+    {
+#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_C
About OSDN
Find Software
Develop Software
Help