gcc/fortran/f95-lang.c

   1 /* gfortran backend interface
   2    Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
   3    Free Software Foundation, Inc.
   4    Contributed by Paul Brook.
   5
   6 This file is part of GCC.
   7
   8 GCC is free software; you can redistribute it and/or modify it under
   9 the terms of the GNU General Public License as published by the Free
  10 Software Foundation; either version 3, or (at your option) any later
  11 version.
  12
  13 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
  14 WARRANTY; without even the implied warranty of MERCHANTABILITY or
  15 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  16 for more details.
  17
  18 You should have received a copy of the GNU General Public License
  19 along with GCC; see the file COPYING3.  If not see
  20 <http://www.gnu.org/licenses/>.  */
  21
  22 /* f95-lang.c-- GCC backend interface stuff */
  23
  24 /* declare required prototypes: */
  25
  26 #include "config.h"
  27 #include "system.h"
  28 #include "ansidecl.h"
  29 #include "system.h"
  30 #include "coretypes.h"
  31 #include "tree.h"
  32 #include "tree-gimple.h"
  33 #include "flags.h"
  34 #include "langhooks.h"
  35 #include "langhooks-def.h"
  36 #include "timevar.h"
  37 #include "tm.h"
  38 #include "function.h"
  39 #include "ggc.h"
  40 #include "toplev.h"
  41 #include "target.h"
  42 #include "debug.h"
  43 #include "diagnostic.h"
  44 #include "tree-dump.h"
  45 #include "cgraph.h"
  46
  47 #include "gfortran.h"
  48 #include "cpp.h"
  49 #include "trans.h"
  50 #include "trans-types.h"
  51 #include "trans-const.h"
  52
  53 /* Language-dependent contents of an identifier.  */
  54
  55 struct lang_identifier
  56 GTY(())
  57 {
  58   struct tree_identifier common;
  59 };
  60
  61 /* The resulting tree type.  */
  62
  63 union lang_tree_node
  64 GTY((desc ("TREE_CODE (&%h.generic) == IDENTIFIER_NODE"),
  65      chain_next ("(union lang_tree_node *)GENERIC_NEXT (&%h.generic)")))
  66
  67 {
  68   union tree_node GTY((tag ("0"),
  69                        desc ("tree_node_structure (&%h)"))) generic;
  70   struct lang_identifier GTY((tag ("1"))) identifier;
  71 };
  72
  73 /* Save and restore the variables in this file and elsewhere
  74    that keep track of the progress of compilation of the current function.
  75    Used for nested functions.  */
  76
  77 struct language_function
  78 GTY(())
  79 {
  80   /* struct gfc_language_function base; */
  81   struct binding_level *binding_level;
  82 };
  83
  84 /* We don't have a lex/yacc lexer/parser, but toplev expects these to
  85    exist anyway.  */
  86 void yyerror (const char *str);
  87 int yylex (void);
  88
  89 static void gfc_init_decl_processing (void);
  90 static void gfc_init_builtin_functions (void);
  91
  92 /* Each front end provides its own.  */
  93 static bool gfc_init (void);
  94 static void gfc_finish (void);
  95 static void gfc_print_identifier (FILE *, tree, int);
  96 static bool gfc_mark_addressable (tree);
  97 void do_function_end (void);
  98 int global_bindings_p (void);
  99 static void clear_binding_stack (void);
 100 static void gfc_be_parse_file (int);
 101 static alias_set_type gfc_get_alias_set (tree);
 102
 103 #undef LANG_HOOKS_NAME
 104 #undef LANG_HOOKS_INIT
 105 #undef LANG_HOOKS_FINISH
 106 #undef LANG_HOOKS_INIT_OPTIONS
 107 #undef LANG_HOOKS_HANDLE_OPTION
 108 #undef LANG_HOOKS_POST_OPTIONS
 109 #undef LANG_HOOKS_PRINT_IDENTIFIER
 110 #undef LANG_HOOKS_PARSE_FILE
 111 #undef LANG_HOOKS_MARK_ADDRESSABLE
 112 #undef LANG_HOOKS_TYPE_FOR_MODE
 113 #undef LANG_HOOKS_TYPE_FOR_SIZE
 114 #undef LANG_HOOKS_GET_ALIAS_SET
 115 #undef LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE
 116 #undef LANG_HOOKS_OMP_PREDETERMINED_SHARING
 117 #undef LANG_HOOKS_OMP_CLAUSE_DEFAULT_CTOR
 118 #undef LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR
 119 #undef LANG_HOOKS_OMP_PRIVATE_DEBUG_CLAUSE
 120 #undef LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES
 121 #undef LANG_HOOKS_BUILTIN_FUNCTION
 122 #undef LANG_HOOKS_GET_ARRAY_DESCR_INFO
 123
 124 /* Define lang hooks.  */
 125 #define LANG_HOOKS_NAME                 "GNU Fortran"
 126 #define LANG_HOOKS_INIT                 gfc_init
 127 #define LANG_HOOKS_FINISH               gfc_finish
 128 #define LANG_HOOKS_INIT_OPTIONS         gfc_init_options
 129 #define LANG_HOOKS_HANDLE_OPTION        gfc_handle_option
 130 #define LANG_HOOKS_POST_OPTIONS         gfc_post_options
 131 #define LANG_HOOKS_PRINT_IDENTIFIER     gfc_print_identifier
 132 #define LANG_HOOKS_PARSE_FILE           gfc_be_parse_file
 133 #define LANG_HOOKS_MARK_ADDRESSABLE        gfc_mark_addressable
 134 #define LANG_HOOKS_TYPE_FOR_MODE           gfc_type_for_mode
 135 #define LANG_HOOKS_TYPE_FOR_SIZE           gfc_type_for_size
 136 #define LANG_HOOKS_GET_ALIAS_SET           gfc_get_alias_set
 137 #define LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE   gfc_omp_privatize_by_reference
 138 #define LANG_HOOKS_OMP_PREDETERMINED_SHARING    gfc_omp_predetermined_sharing
 139 #define LANG_HOOKS_OMP_CLAUSE_DEFAULT_CTOR      gfc_omp_clause_default_ctor
 140 #define LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR     gfc_omp_disregard_value_expr
 141 #define LANG_HOOKS_OMP_PRIVATE_DEBUG_CLAUSE     gfc_omp_private_debug_clause
 142 #define LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES \
 143   gfc_omp_firstprivatize_type_sizes
 144 #define LANG_HOOKS_BUILTIN_FUNCTION          gfc_builtin_function
 145 #define LANG_HOOKS_GET_ARRAY_DESCR_INFO      gfc_get_array_descr_info
 146
 147 const struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
 148
 149 /* A list (chain of TREE_LIST nodes) of all LABEL_DECLs in the function
 150    that have names.  Here so we can clear out their names' definitions
 151    at the end of the function.  */
 152
 153 /* Tree code classes.  */
 154
 155 #define DEFTREECODE(SYM, NAME, TYPE, LENGTH) TYPE,
 156
 157 const enum tree_code_class tree_code_type[] = {
 158 #include "tree.def"
 159 };
 160 #undef DEFTREECODE
 161
 162 /* Table indexed by tree code giving number of expression
 163    operands beyond the fixed part of the node structure.
 164    Not used for types or decls.  */
 165
 166 #define DEFTREECODE(SYM, NAME, TYPE, LENGTH) LENGTH,
 167
 168 const unsigned char tree_code_length[] = {
 169 #include "tree.def"
 170 };
 171 #undef DEFTREECODE
 172
 173 /* Names of tree components.
 174    Used for printing out the tree and error messages.  */
 175 #define DEFTREECODE(SYM, NAME, TYPE, LEN) NAME,
 176
 177 const char *const tree_code_name[] = {
 178 #include "tree.def"
 179 };
 180 #undef DEFTREECODE
 181
 182
 183 #define NULL_BINDING_LEVEL (struct binding_level *) NULL
 184
 185 /* A chain of binding_level structures awaiting reuse.  */
 186
 187 static GTY(()) struct binding_level *free_binding_level;
 188
 189 /* The elements of `ridpointers' are identifier nodes
 190    for the reserved type names and storage classes.
 191    It is indexed by a RID_... value.  */
 192 tree *ridpointers = NULL;
 193
 194 /* Prepare expr to be an argument of a TRUTH_NOT_EXPR,
 195    or validate its data type for an `if' or `while' statement or ?..: exp.
 196
 197    This preparation consists of taking the ordinary
 198    representation of an expression expr and producing a valid tree
 199    boolean expression describing whether expr is nonzero.  We could
 200    simply always do build_binary_op (NE_EXPR, expr, boolean_false_node, 1),
 201    but we optimize comparisons, &&, ||, and !.
 202
 203    The resulting type should always be `boolean_type_node'.
 204    This is much simpler than the corresponding C version because we have a
 205    distinct boolean type.  */
 206
 207 tree
 208 gfc_truthvalue_conversion (tree expr)
 209 {
 210   switch (TREE_CODE (TREE_TYPE (expr)))
 211     {
 212     case BOOLEAN_TYPE:
 213       if (TREE_TYPE (expr) == boolean_type_node)
 214         return expr;
 215       else if (COMPARISON_CLASS_P (expr))
 216         {
 217           TREE_TYPE (expr) = boolean_type_node;
 218           return expr;
 219         }
 220       else if (TREE_CODE (expr) == NOP_EXPR)
 221         return fold_build1 (NOP_EXPR,
 222                             boolean_type_node, TREE_OPERAND (expr, 0));
 223       else
 224         return fold_build1 (NOP_EXPR, boolean_type_node, expr);
 225
 226     case INTEGER_TYPE:
 227       if (TREE_CODE (expr) == INTEGER_CST)
 228         return integer_zerop (expr) ? boolean_false_node : boolean_true_node;
 229       else
 230         return fold_build2 (NE_EXPR, boolean_type_node, expr,
 231                             build_int_cst (TREE_TYPE (expr), 0));
 232
 233     default:
 234       internal_error ("Unexpected type in truthvalue_conversion");
 235     }
 236 }
 237
 238
 239 static void
 240 gfc_create_decls (void)
 241 {
 242   /* GCC builtins.  */
 243   gfc_init_builtin_functions ();
 244
 245   /* Runtime/IO library functions.  */
 246   gfc_build_builtin_function_decls ();
 247
 248   gfc_init_constants ();
 249 }
 250
 251
 252 static void
 253 gfc_be_parse_file (int set_yydebug ATTRIBUTE_UNUSED)
 254 {
 255   int errors;
 256   int warnings;
 257
 258   gfc_create_decls ();
 259   gfc_parse_file ();
 260   gfc_generate_constructors ();
 261
 262   cgraph_finalize_compilation_unit ();
 263   cgraph_optimize ();
 264
 265   /* Tell the frontent about any errors.  */
 266   gfc_get_errors (&warnings, &errors);
 267   errorcount += errors;
 268   warningcount += warnings;
 269
 270   clear_binding_stack ();
 271 }
 272
 273
 274 /* Initialize everything.  */
 275
 276 static bool
 277 gfc_init (void)
 278 {
 279   if (!gfc_cpp_enabled ())
 280     {
 281       linemap_add (line_table, LC_ENTER, false, gfc_source_file, 1);
 282       linemap_add (line_table, LC_RENAME, false, "<built-in>", 0);
 283     }
 284   else
 285     gfc_cpp_init_0 ();
 286
 287   gfc_init_decl_processing ();
 288   gfc_static_ctors = NULL_TREE;
 289
 290   if (gfc_cpp_enabled ())
 291     gfc_cpp_init ();
 292
 293   gfc_init_1 ();
 294
 295   if (gfc_new_file () != SUCCESS)
 296     fatal_error ("can't open input file: %s", gfc_source_file);
 297
 298   return true;
 299 }
 300
 301
 302 static void
 303 gfc_finish (void)
 304 {
 305   gfc_cpp_done ();
 306   gfc_done_1 ();
 307   gfc_release_include_path ();
 308   return;
 309 }
 310
 311 static void
 312 gfc_print_identifier (FILE * file ATTRIBUTE_UNUSED,
 313                       tree node ATTRIBUTE_UNUSED,
 314                       int indent ATTRIBUTE_UNUSED)
 315 {
 316   return;
 317 }
 318
 319
 320 /* These functions and variables deal with binding contours.  We only
 321    need these functions for the list of PARM_DECLs, but we leave the
 322    functions more general; these are a simplified version of the
 323    functions from GNAT.  */
 324
 325 /* For each binding contour we allocate a binding_level structure which
 326    records the entities defined or declared in that contour.  Contours
 327    include:
 328
 329         the global one
 330         one for each subprogram definition
 331         one for each compound statement (declare block)
 332
 333    Binding contours are used to create GCC tree BLOCK nodes.  */
 334
 335 struct binding_level
 336 GTY(())
 337 {
 338   /* A chain of ..._DECL nodes for all variables, constants, functions,
 339      parameters and type declarations.  These ..._DECL nodes are chained
 340      through the TREE_CHAIN field. Note that these ..._DECL nodes are stored
 341      in the reverse of the order supplied to be compatible with the
 342      back-end.  */
 343   tree names;
 344   /* For each level (except the global one), a chain of BLOCK nodes for all
 345      the levels that were entered and exited one level down from this one.  */
 346   tree blocks;
 347   /* The binding level containing this one (the enclosing binding level).  */
 348   struct binding_level *level_chain;
 349 };
 350
 351 /* The binding level currently in effect.  */
 352 static GTY(()) struct binding_level *current_binding_level = NULL;
 353
 354 /* The outermost binding level. This binding level is created when the
 355    compiler is started and it will exist through the entire compilation.  */
 356 static GTY(()) struct binding_level *global_binding_level;
 357
 358 /* Binding level structures are initialized by copying this one.  */
 359 static struct binding_level clear_binding_level = { NULL, NULL, NULL };
 360
 361
 362 /* Return nonzero if we are currently in the global binding level.  */
 363
 364 int
 365 global_bindings_p (void)
 366 {
 367   return current_binding_level == global_binding_level ? -1 : 0;
 368 }
 369
 370 tree
 371 getdecls (void)
 372 {
 373   return current_binding_level->names;
 374 }
 375
 376 /* Enter a new binding level. The input parameter is ignored, but has to be
 377    specified for back-end compatibility.  */
 378
 379 void
 380 pushlevel (int ignore ATTRIBUTE_UNUSED)
 381 {
 382   struct binding_level *newlevel
 383     = (struct binding_level *) ggc_alloc (sizeof (struct binding_level));
 384
 385   *newlevel = clear_binding_level;
 386
 387   /* Add this level to the front of the chain (stack) of levels that are
 388      active.  */
 389   newlevel->level_chain = current_binding_level;
 390   current_binding_level = newlevel;
 391 }
 392
 393 /* Exit a binding level.
 394    Pop the level off, and restore the state of the identifier-decl mappings
 395    that were in effect when this level was entered.
 396
 397    If KEEP is nonzero, this level had explicit declarations, so
 398    and create a "block" (a BLOCK node) for the level
 399    to record its declarations and subblocks for symbol table output.
 400
 401    If FUNCTIONBODY is nonzero, this level is the body of a function,
 402    so create a block as if KEEP were set and also clear out all
 403    label names.
 404
 405    If REVERSE is nonzero, reverse the order of decls before putting
 406    them into the BLOCK.  */
 407
 408 tree
 409 poplevel (int keep, int reverse, int functionbody)
 410 {
 411   /* Points to a BLOCK tree node. This is the BLOCK node constructed for the
 412      binding level that we are about to exit and which is returned by this
 413      routine.  */
 414   tree block_node = NULL_TREE;
 415   tree decl_chain;
 416   tree subblock_chain = current_binding_level->blocks;
 417   tree subblock_node;
 418
 419   /* Reverse the list of XXXX_DECL nodes if desired.  Note that the ..._DECL
 420      nodes chained through the `names' field of current_binding_level are in
 421      reverse order except for PARM_DECL node, which are explicitly stored in
 422      the right order.  */
 423   decl_chain = (reverse) ? nreverse (current_binding_level->names)
 424                          : current_binding_level->names;
 425
 426   /* If there were any declarations in the current binding level, or if this
 427      binding level is a function body, or if there are any nested blocks then
 428      create a BLOCK node to record them for the life of this function.  */
 429   if (keep || functionbody)
 430     block_node = build_block (keep ? decl_chain : 0, subblock_chain, 0, 0);
 431
 432   /* Record the BLOCK node just built as the subblock its enclosing scope.  */
 433   for (subblock_node = subblock_chain; subblock_node;
 434        subblock_node = TREE_CHAIN (subblock_node))
 435     BLOCK_SUPERCONTEXT (subblock_node) = block_node;
 436
 437   /* Clear out the meanings of the local variables of this level.  */
 438
 439   for (subblock_node = decl_chain; subblock_node;
 440        subblock_node = TREE_CHAIN (subblock_node))
 441     if (DECL_NAME (subblock_node) != 0)
 442       /* If the identifier was used or addressed via a local extern decl,
 443          don't forget that fact.  */
 444       if (DECL_EXTERNAL (subblock_node))
 445         {
 446           if (TREE_USED (subblock_node))
 447             TREE_USED (DECL_NAME (subblock_node)) = 1;
 448           if (TREE_ADDRESSABLE (subblock_node))
 449             TREE_ADDRESSABLE (DECL_ASSEMBLER_NAME (subblock_node)) = 1;
 450         }
 451
 452   /* Pop the current level.  */
 453   current_binding_level = current_binding_level->level_chain;
 454
 455   if (functionbody)
 456     {
 457       /* This is the top level block of a function. The ..._DECL chain stored
 458          in BLOCK_VARS are the function's parameters (PARM_DECL nodes). Don't
 459          leave them in the BLOCK because they are found in the FUNCTION_DECL
 460          instead.  */
 461       DECL_INITIAL (current_function_decl) = block_node;
 462       BLOCK_VARS (block_node) = 0;
 463     }
 464   else if (block_node)
 465     {
 466       current_binding_level->blocks
 467         = chainon (current_binding_level->blocks, block_node);
 468     }
 469
 470   /* If we did not make a block for the level just exited, any blocks made for
 471      inner levels (since they cannot be recorded as subblocks in that level)
 472      must be carried forward so they will later become subblocks of something
 473      else.  */
 474   else if (subblock_chain)
 475     current_binding_level->blocks
 476       = chainon (current_binding_level->blocks, subblock_chain);
 477   if (block_node)
 478     TREE_USED (block_node) = 1;
 479
 480   return block_node;
 481 }
 482
 483
 484 /* Records a ..._DECL node DECL as belonging to the current lexical scope.
 485    Returns the ..._DECL node.  */
 486
 487 tree
 488 pushdecl (tree decl)
 489 {
 490   /* External objects aren't nested, other objects may be.  */
 491   if ((DECL_EXTERNAL (decl)) || (decl == current_function_decl))
 492     DECL_CONTEXT (decl) = 0;
 493   else
 494     DECL_CONTEXT (decl) = current_function_decl;
 495
 496   /* Put the declaration on the list.  The list of declarations is in reverse
 497      order. The list will be reversed later if necessary.  This needs to be
 498      this way for compatibility with the back-end.  */
 499
 500   TREE_CHAIN (decl) = current_binding_level->names;
 501   current_binding_level->names = decl;
 502
 503   /* For the declaration of a type, set its name if it is not already set.  */
 504
 505   if (TREE_CODE (decl) == TYPE_DECL && TYPE_NAME (TREE_TYPE (decl)) == 0)
 506     {
 507       if (DECL_SOURCE_LINE (decl) == 0)
 508         TYPE_NAME (TREE_TYPE (decl)) = decl;
 509       else
 510         TYPE_NAME (TREE_TYPE (decl)) = DECL_NAME (decl);
 511     }
 512
 513   return decl;
 514 }
 515
 516
 517 /* Like pushdecl, only it places X in GLOBAL_BINDING_LEVEL.  */
 518
 519 tree
 520 pushdecl_top_level (tree x)
 521 {
 522   tree t;
 523   struct binding_level *b = current_binding_level;
 524
 525   current_binding_level = global_binding_level;
 526   t = pushdecl (x);
 527   current_binding_level = b;
 528   return t;
 529 }
 530
 531
 532 /* Clear the binding stack.  */
 533 static void
 534 clear_binding_stack (void)
 535 {
 536   while (!global_bindings_p ())
 537     poplevel (0, 0, 0);
 538 }
 539
 540
 541 #ifndef CHAR_TYPE_SIZE
 542 #define CHAR_TYPE_SIZE BITS_PER_UNIT
 543 #endif
 544
 545 #ifndef INT_TYPE_SIZE
 546 #define INT_TYPE_SIZE BITS_PER_WORD
 547 #endif
 548
 549 #undef SIZE_TYPE
 550 #define SIZE_TYPE "long unsigned int"
 551
 552 /* Create tree nodes for the basic scalar types of Fortran 95,
 553    and some nodes representing standard constants (0, 1, (void *) 0).
 554    Initialize the global binding level.
 555    Make definitions for built-in primitive functions.  */
 556 static void
 557 gfc_init_decl_processing (void)
 558 {
 559   current_function_decl = NULL;
 560   current_binding_level = NULL_BINDING_LEVEL;
 561   free_binding_level = NULL_BINDING_LEVEL;
 562
 563   /* Make the binding_level structure for global names. We move all
 564      variables that are in a COMMON block to this binding level.  */
 565   pushlevel (0);
 566   global_binding_level = current_binding_level;
 567
 568   /* Build common tree nodes. char_type_node is unsigned because we
 569      only use it for actual characters, not for INTEGER(1). Also, we
 570      want double_type_node to actually have double precision.  */
 571   build_common_tree_nodes (false, false);
 572   /* x86_64 minw32 has a sizetype of "unsigned long long", most other hosts
 573      have a sizetype of "unsigned long". Therefore choose the correct size
 574      in mostly target independent way.  */
 575   if (TYPE_MODE (long_unsigned_type_node) == ptr_mode)
 576     set_sizetype (long_unsigned_type_node);
 577   else if (TYPE_MODE (long_long_unsigned_type_node) == ptr_mode)
 578     set_sizetype (long_long_unsigned_type_node);
 579   else
 580     set_sizetype (long_unsigned_type_node);
 581   build_common_tree_nodes_2 (0);
 582   void_list_node = build_tree_list (NULL_TREE, void_type_node);
 583
 584   /* Set up F95 type nodes.  */
 585   gfc_init_kinds ();
 586   gfc_init_types ();
 587 }
 588
 589
 590 /* Mark EXP saying that we need to be able to take the
 591    address of it; it should not be allocated in a register.
 592    In Fortran 95 this is only the case for variables with
 593    the TARGET attribute, but we implement it here for a
 594    likely future Cray pointer extension.
 595    Value is 1 if successful.  */
 596 /* TODO: Check/fix mark_addressable.  */
 597
 598 bool
 599 gfc_mark_addressable (tree exp)
 600 {
 601   register tree x = exp;
 602   while (1)
 603     switch (TREE_CODE (x))
 604       {
 605       case COMPONENT_REF:
 606       case ADDR_EXPR:
 607       case ARRAY_REF:
 608       case REALPART_EXPR:
 609       case IMAGPART_EXPR:
 610         x = TREE_OPERAND (x, 0);
 611         break;
 612
 613       case CONSTRUCTOR:
 614         TREE_ADDRESSABLE (x) = 1;
 615         return true;
 616
 617       case VAR_DECL:
 618       case CONST_DECL:
 619       case PARM_DECL:
 620       case RESULT_DECL:
 621         if (DECL_REGISTER (x) && !TREE_ADDRESSABLE (x) && DECL_NONLOCAL (x))
 622           {
 623             if (TREE_PUBLIC (x))
 624               {
 625                 error ("global register variable %qs used in nested function",
 626                        IDENTIFIER_POINTER (DECL_NAME (x)));
 627                 return false;
 628               }
 629             pedwarn ("register variable %qs used in nested function",
 630                      IDENTIFIER_POINTER (DECL_NAME (x)));
 631           }
 632         else if (DECL_REGISTER (x) && !TREE_ADDRESSABLE (x))
 633           {
 634             if (TREE_PUBLIC (x))
 635               {
 636                 error ("address of global register variable %qs requested",
 637                        IDENTIFIER_POINTER (DECL_NAME (x)));
 638                 return true;
 639               }
 640
 641 #if 0
 642             /* If we are making this addressable due to its having
 643                volatile components, give a different error message.  Also
 644                handle the case of an unnamed parameter by not trying
 645                to give the name.  */
 646
 647             else if (C_TYPE_FIELDS_VOLATILE (TREE_TYPE (x)))
 648               {
 649                 error ("cannot put object with volatile field into register");
 650                 return false;
 651               }
 652 #endif
 653
 654             pedwarn ("address of register variable %qs requested",
 655                      IDENTIFIER_POINTER (DECL_NAME (x)));
 656           }
 657
 658         /* drops in */
 659       case FUNCTION_DECL:
 660         TREE_ADDRESSABLE (x) = 1;
 661
 662       default:
 663         return true;
 664       }
 665 }
 666
 667
 668 /* Return the typed-based alias set for T, which may be an expression
 669    or a type.  Return -1 if we don't do anything special.  */
 670
 671 static alias_set_type
 672 gfc_get_alias_set (tree t)
 673 {
 674   tree u;
 675
 676   /* Permit type-punning when accessing an EQUIVALENCEd variable or
 677      mixed type entry master's return value.  */
 678   for (u = t; handled_component_p (u); u = TREE_OPERAND (u, 0))
 679     if (TREE_CODE (u) == COMPONENT_REF
 680         && TREE_CODE (TREE_TYPE (TREE_OPERAND (u, 0))) == UNION_TYPE)
 681       return 0;
 682
 683   return -1;
 684 }
 685
 686
 687 /* press the big red button - garbage (ggc) collection is on */
 688
 689 int ggc_p = 1;
 690
 691 /* Builtin function initialization.  */
 692
 693 tree
 694 gfc_builtin_function (tree decl)
 695 {
 696   make_decl_rtl (decl);
 697   pushdecl (decl);
 698   return decl;
 699 }
 700
 701
 702 static void
 703 gfc_define_builtin (const char *name,
 704                     tree type,
 705                     int code,
 706                     const char *library_name,
 707                     bool const_p)
 708 {
 709   tree decl;
 710
 711   decl = add_builtin_function (name, type, code, BUILT_IN_NORMAL,
 712                                library_name, NULL_TREE);
 713   if (const_p)
 714     TREE_READONLY (decl) = 1;
 715
 716   built_in_decls[code] = decl;
 717   implicit_built_in_decls[code] = decl;
 718 }
 719
 720
 721 #define DO_DEFINE_MATH_BUILTIN(code, name, argtype, tbase) \
 722     gfc_define_builtin ("__builtin_" name "l", tbase##longdouble[argtype], \
 723                        BUILT_IN_ ## code ## L, name "l", true); \
 724     gfc_define_builtin ("__builtin_" name, tbase##double[argtype], \
 725                         BUILT_IN_ ## code, name, true); \
 726     gfc_define_builtin ("__builtin_" name "f", tbase##float[argtype], \
 727                         BUILT_IN_ ## code ## F, name "f", true);
 728
 729 #define DEFINE_MATH_BUILTIN(code, name, argtype) \
 730     DO_DEFINE_MATH_BUILTIN (code, name, argtype, mfunc_)
 731
 732 #define DEFINE_MATH_BUILTIN_C(code, name, argtype) \
 733     DO_DEFINE_MATH_BUILTIN (code, name, argtype, mfunc_) \
 734     DO_DEFINE_MATH_BUILTIN (C##code, "c" name, argtype, mfunc_c)
 735
 736
 737 /* Create function types for builtin functions.  */
 738
 739 static void
 740 build_builtin_fntypes (tree *fntype, tree type)
 741 {
 742   tree tmp;
 743
 744   /* type (*) (type) */
 745   tmp = tree_cons (NULL_TREE, type, void_list_node);
 746   fntype[0] = build_function_type (type, tmp);
 747   /* type (*) (type, type) */
 748   tmp = tree_cons (NULL_TREE, type, tmp);
 749   fntype[1] = build_function_type (type, tmp);
 750   /* type (*) (int, type) */
 751   tmp = tree_cons (NULL_TREE, integer_type_node, void_list_node);
 752   tmp = tree_cons (NULL_TREE, type, tmp);
 753   fntype[2] = build_function_type (type, tmp);
 754   /* type (*) (void) */
 755   fntype[3] = build_function_type (type, void_list_node);
 756   /* type (*) (type, &int) */
 757   tmp = tree_cons (NULL_TREE, type, void_list_node);
 758   tmp = tree_cons (NULL_TREE, build_pointer_type (integer_type_node), tmp);
 759   fntype[4] = build_function_type (type, tmp);
 760   /* type (*) (type, int) */
 761   tmp = tree_cons (NULL_TREE, type, void_list_node);
 762   tmp = tree_cons (NULL_TREE, integer_type_node, tmp);
 763   fntype[5] = build_function_type (type, tmp);
 764 }
 765
 766
 767 static tree
 768 builtin_type_for_size (int size, bool unsignedp)
 769 {
 770   tree type = lang_hooks.types.type_for_size (size, unsignedp);
 771   return type ? type : error_mark_node;
 772 }
 773
 774 /* Initialization of builtin function nodes.  */
 775
 776 static void
 777 gfc_init_builtin_functions (void)
 778 {
 779   enum builtin_type
 780   {
 781 #define DEF_PRIMITIVE_TYPE(NAME, VALUE) NAME,
 782 #define DEF_FUNCTION_TYPE_0(NAME, RETURN) NAME,
 783 #define DEF_FUNCTION_TYPE_1(NAME, RETURN, ARG1) NAME,
 784 #define DEF_FUNCTION_TYPE_2(NAME, RETURN, ARG1, ARG2) NAME,
 785 #define DEF_FUNCTION_TYPE_3(NAME, RETURN, ARG1, ARG2, ARG3) NAME,
 786 #define DEF_FUNCTION_TYPE_4(NAME, RETURN, ARG1, ARG2, ARG3, ARG4) NAME,
 787 #define DEF_FUNCTION_TYPE_5(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5) NAME,
 788 #define DEF_FUNCTION_TYPE_6(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, ARG6) NAME,
 789 #define DEF_FUNCTION_TYPE_7(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, ARG6, ARG7) NAME,
 790 #define DEF_FUNCTION_TYPE_VAR_0(NAME, RETURN) NAME,
 791 #define DEF_POINTER_TYPE(NAME, TYPE) NAME,
 792 #include "types.def"
 793 #undef DEF_PRIMITIVE_TYPE
 794 #undef DEF_FUNCTION_TYPE_0
 795 #undef DEF_FUNCTION_TYPE_1
 796 #undef DEF_FUNCTION_TYPE_2
 797 #undef DEF_FUNCTION_TYPE_3
 798 #undef DEF_FUNCTION_TYPE_4
 799 #undef DEF_FUNCTION_TYPE_5
 800 #undef DEF_FUNCTION_TYPE_6
 801 #undef DEF_FUNCTION_TYPE_7
 802 #undef DEF_FUNCTION_TYPE_VAR_0
 803 #undef DEF_POINTER_TYPE
 804     BT_LAST
 805   };
 806   typedef enum builtin_type builtin_type;
 807   enum
 808   {
 809     /* So far we need just these 2 attribute types.  */
 810     ATTR_NOTHROW_LIST,
 811     ATTR_CONST_NOTHROW_LIST
 812   };
 813
 814   tree mfunc_float[6];
 815   tree mfunc_double[6];
 816   tree mfunc_longdouble[6];
 817   tree mfunc_cfloat[6];
 818   tree mfunc_cdouble[6];
 819   tree mfunc_clongdouble[6];
 820   tree func_cfloat_float, func_float_cfloat;
 821   tree func_cdouble_double, func_double_cdouble;
 822   tree func_clongdouble_longdouble, func_longdouble_clongdouble;
 823   tree func_float_floatp_floatp;
 824   tree func_double_doublep_doublep;
 825   tree func_longdouble_longdoublep_longdoublep;
 826   tree ftype, ptype;
 827   tree tmp, type;
 828   tree builtin_types[(int) BT_LAST + 1];
 829
 830   build_builtin_fntypes (mfunc_float, float_type_node);
 831   build_builtin_fntypes (mfunc_double, double_type_node);
 832   build_builtin_fntypes (mfunc_longdouble, long_double_type_node);
 833   build_builtin_fntypes (mfunc_cfloat, complex_float_type_node);
 834   build_builtin_fntypes (mfunc_cdouble, complex_double_type_node);
 835   build_builtin_fntypes (mfunc_clongdouble, complex_long_double_type_node);
 836
 837   tmp = tree_cons (NULL_TREE, complex_float_type_node, void_list_node);
 838   func_cfloat_float = build_function_type (float_type_node, tmp);
 839
 840   tmp = tree_cons (NULL_TREE, float_type_node, void_list_node);
 841   func_float_cfloat = build_function_type (complex_float_type_node, tmp);
 842
 843   tmp = tree_cons (NULL_TREE, complex_double_type_node, void_list_node);
 844   func_cdouble_double = build_function_type (double_type_node, tmp);
 845
 846   tmp = tree_cons (NULL_TREE, double_type_node, void_list_node);
 847   func_double_cdouble = build_function_type (complex_double_type_node, tmp);
 848
 849   tmp = tree_cons (NULL_TREE, complex_long_double_type_node, void_list_node);
 850   func_clongdouble_longdouble =
 851     build_function_type (long_double_type_node, tmp);
 852
 853   tmp = tree_cons (NULL_TREE, long_double_type_node, void_list_node);
 854   func_longdouble_clongdouble =
 855     build_function_type (complex_long_double_type_node, tmp);
 856
 857   ptype = build_pointer_type (float_type_node);
 858   tmp = tree_cons (NULL_TREE, float_type_node,
 859                    tree_cons (NULL_TREE, ptype,
 860                               tree_cons (NULL_TREE, ptype, void_list_node)));
 861   func_float_floatp_floatp =
 862     build_function_type (void_type_node, tmp);
 863
 864   ptype = build_pointer_type (double_type_node);
 865   tmp = tree_cons (NULL_TREE, double_type_node,
 866                    tree_cons (NULL_TREE, ptype,
 867                               tree_cons (NULL_TREE, ptype, void_list_node)));
 868   func_double_doublep_doublep =
 869     build_function_type (void_type_node, tmp);
 870
 871   ptype = build_pointer_type (long_double_type_node);
 872   tmp = tree_cons (NULL_TREE, long_double_type_node,
 873                    tree_cons (NULL_TREE, ptype,
 874                               tree_cons (NULL_TREE, ptype, void_list_node)));
 875   func_longdouble_longdoublep_longdoublep =
 876     build_function_type (void_type_node, tmp);
 877
 878 #include "mathbuiltins.def"
 879
 880   /* We define these separately as the fortran versions have different
 881      semantics (they return an integer type) */
 882   gfc_define_builtin ("__builtin_roundl", mfunc_longdouble[0],
 883                       BUILT_IN_ROUNDL, "roundl", true);
 884   gfc_define_builtin ("__builtin_round", mfunc_double[0],
 885                       BUILT_IN_ROUND, "round", true);
 886   gfc_define_builtin ("__builtin_roundf", mfunc_float[0],
 887                       BUILT_IN_ROUNDF, "roundf", true);
 888
 889   gfc_define_builtin ("__builtin_truncl", mfunc_longdouble[0],
 890                       BUILT_IN_TRUNCL, "truncl", true);
 891   gfc_define_builtin ("__builtin_trunc", mfunc_double[0],
 892                       BUILT_IN_TRUNC, "trunc", true);
 893   gfc_define_builtin ("__builtin_truncf", mfunc_float[0],
 894                       BUILT_IN_TRUNCF, "truncf", true);
 895
 896   gfc_define_builtin ("__builtin_cabsl", func_clongdouble_longdouble,
 897                       BUILT_IN_CABSL, "cabsl", true);
 898   gfc_define_builtin ("__builtin_cabs", func_cdouble_double,
 899                       BUILT_IN_CABS, "cabs", true);
 900   gfc_define_builtin ("__builtin_cabsf", func_cfloat_float,
 901                       BUILT_IN_CABSF, "cabsf", true);
 902
 903   gfc_define_builtin ("__builtin_copysignl", mfunc_longdouble[1],
 904                       BUILT_IN_COPYSIGNL, "copysignl", true);
 905   gfc_define_builtin ("__builtin_copysign", mfunc_double[1],
 906                       BUILT_IN_COPYSIGN, "copysign", true);
 907   gfc_define_builtin ("__builtin_copysignf", mfunc_float[1],
 908                       BUILT_IN_COPYSIGNF, "copysignf", true);
 909
 910   gfc_define_builtin ("__builtin_nextafterl", mfunc_longdouble[1],
 911                       BUILT_IN_NEXTAFTERL, "nextafterl", true);
 912   gfc_define_builtin ("__builtin_nextafter", mfunc_double[1],
 913                       BUILT_IN_NEXTAFTER, "nextafter", true);
 914   gfc_define_builtin ("__builtin_nextafterf", mfunc_float[1],
 915                       BUILT_IN_NEXTAFTERF, "nextafterf", true);
 916
 917   gfc_define_builtin ("__builtin_frexpl", mfunc_longdouble[4],
 918                       BUILT_IN_FREXPL, "frexpl", false);
 919   gfc_define_builtin ("__builtin_frexp", mfunc_double[4],
 920                       BUILT_IN_FREXP, "frexp", false);
 921   gfc_define_builtin ("__builtin_frexpf", mfunc_float[4],
 922                       BUILT_IN_FREXPF, "frexpf", false);
 923
 924   gfc_define_builtin ("__builtin_fabsl", mfunc_longdouble[0],
 925                       BUILT_IN_FABSL, "fabsl", true);
 926   gfc_define_builtin ("__builtin_fabs", mfunc_double[0],
 927                       BUILT_IN_FABS, "fabs", true);
 928   gfc_define_builtin ("__builtin_fabsf", mfunc_float[0],
 929                       BUILT_IN_FABSF, "fabsf", true);
 930
 931   gfc_define_builtin ("__builtin_scalbnl", mfunc_longdouble[5],
 932                       BUILT_IN_SCALBNL, "scalbnl", true);
 933   gfc_define_builtin ("__builtin_scalbn", mfunc_double[5],
 934                       BUILT_IN_SCALBN, "scalbn", true);
 935   gfc_define_builtin ("__builtin_scalbnf", mfunc_float[5],
 936                       BUILT_IN_SCALBNF, "scalbnf", true);
 937
 938   gfc_define_builtin ("__builtin_fmodl", mfunc_longdouble[1],
 939                       BUILT_IN_FMODL, "fmodl", true);
 940   gfc_define_builtin ("__builtin_fmod", mfunc_double[1],
 941                       BUILT_IN_FMOD, "fmod", true);
 942   gfc_define_builtin ("__builtin_fmodf", mfunc_float[1],
 943                       BUILT_IN_FMODF, "fmodf", true);
 944
 945   gfc_define_builtin ("__builtin_infl", mfunc_longdouble[3],
 946                       BUILT_IN_INFL, "__builtin_infl", true);
 947   gfc_define_builtin ("__builtin_inf", mfunc_double[3],
 948                       BUILT_IN_INF, "__builtin_inf", true);
 949   gfc_define_builtin ("__builtin_inff", mfunc_float[3],
 950                       BUILT_IN_INFF, "__builtin_inff", true);
 951
 952   /* lround{f,,l} and llround{f,,l} */
 953   type = tree_cons (NULL_TREE, float_type_node, void_list_node);
 954   tmp = build_function_type (long_integer_type_node, type);
 955   gfc_define_builtin ("__builtin_lroundf", tmp, BUILT_IN_LROUNDF,
 956                       "lroundf", true);
 957   tmp = build_function_type (long_long_integer_type_node, type);
 958   gfc_define_builtin ("__builtin_llroundf", tmp, BUILT_IN_LLROUNDF,
 959                       "llroundf", true);
 960
 961   type = tree_cons (NULL_TREE, double_type_node, void_list_node);
 962   tmp = build_function_type (long_integer_type_node, type);
 963   gfc_define_builtin ("__builtin_lround", tmp, BUILT_IN_LROUND,
 964                       "lround", true);
 965   tmp = build_function_type (long_long_integer_type_node, type);
 966   gfc_define_builtin ("__builtin_llround", tmp, BUILT_IN_LLROUND,
 967                       "llround", true);
 968
 969   type = tree_cons (NULL_TREE, long_double_type_node, void_list_node);
 970   tmp = build_function_type (long_integer_type_node, type);
 971   gfc_define_builtin ("__builtin_lroundl", tmp, BUILT_IN_LROUNDL,
 972                       "lroundl", true);
 973   tmp = build_function_type (long_long_integer_type_node, type);
 974   gfc_define_builtin ("__builtin_llroundl", tmp, BUILT_IN_LLROUNDL,
 975                       "llroundl", true);
 976
 977   /* These are used to implement the ** operator.  */
 978   gfc_define_builtin ("__builtin_powl", mfunc_longdouble[1],
 979                       BUILT_IN_POWL, "powl", true);
 980   gfc_define_builtin ("__builtin_pow", mfunc_double[1],
 981                       BUILT_IN_POW, "pow", true);
 982   gfc_define_builtin ("__builtin_powf", mfunc_float[1],
 983                       BUILT_IN_POWF, "powf", true);
 984   gfc_define_builtin ("__builtin_cpowl", mfunc_clongdouble[1],
 985                       BUILT_IN_CPOWL, "cpowl", true);
 986   gfc_define_builtin ("__builtin_cpow", mfunc_cdouble[1],
 987                       BUILT_IN_CPOW, "cpow", true);
 988   gfc_define_builtin ("__builtin_cpowf", mfunc_cfloat[1],
 989                       BUILT_IN_CPOWF, "cpowf", true);
 990   gfc_define_builtin ("__builtin_powil", mfunc_longdouble[2],
 991                       BUILT_IN_POWIL, "powil", true);
 992   gfc_define_builtin ("__builtin_powi", mfunc_double[2],
 993                       BUILT_IN_POWI, "powi", true);
 994   gfc_define_builtin ("__builtin_powif", mfunc_float[2],
 995                       BUILT_IN_POWIF, "powif", true);
 996
 997
 998   if (TARGET_C99_FUNCTIONS)
 999     {
1000       gfc_define_builtin ("__builtin_cbrtl", mfunc_longdouble[0],
1001                           BUILT_IN_CBRTL, "cbrtl", true);
1002       gfc_define_builtin ("__builtin_cbrt", mfunc_double[0],
1003                           BUILT_IN_CBRT, "cbrt", true);
1004       gfc_define_builtin ("__builtin_cbrtf", mfunc_float[0],
1005                           BUILT_IN_CBRTF, "cbrtf", true);
1006       gfc_define_builtin ("__builtin_cexpil", func_longdouble_clongdouble,
1007                           BUILT_IN_CEXPIL, "cexpil", true);
1008       gfc_define_builtin ("__builtin_cexpi", func_double_cdouble,
1009                           BUILT_IN_CEXPI, "cexpi", true);
1010       gfc_define_builtin ("__builtin_cexpif", func_float_cfloat,
1011                           BUILT_IN_CEXPIF, "cexpif", true);
1012     }
1013
1014   if (TARGET_HAS_SINCOS)
1015     {
1016       gfc_define_builtin ("__builtin_sincosl",
1017                           func_longdouble_longdoublep_longdoublep,
1018                           BUILT_IN_SINCOSL, "sincosl", false);
1019       gfc_define_builtin ("__builtin_sincos", func_double_doublep_doublep,
1020                           BUILT_IN_SINCOS, "sincos", false);
1021       gfc_define_builtin ("__builtin_sincosf", func_float_floatp_floatp,
1022                           BUILT_IN_SINCOSF, "sincosf", false);
1023     }
1024
1025   /* Other builtin functions we use.  */
1026
1027   tmp = tree_cons (NULL_TREE, long_integer_type_node, void_list_node);
1028   tmp = tree_cons (NULL_TREE, long_integer_type_node, tmp);
1029   ftype = build_function_type (long_integer_type_node, tmp);
1030   gfc_define_builtin ("__builtin_expect", ftype, BUILT_IN_EXPECT,
1031                       "__builtin_expect", true);
1032
1033   tmp = tree_cons (NULL_TREE, pvoid_type_node, void_list_node);
1034   ftype = build_function_type (void_type_node, tmp);
1035   gfc_define_builtin ("__builtin_free", ftype, BUILT_IN_FREE,
1036                       "free", false);
1037
1038   tmp = tree_cons (NULL_TREE, size_type_node, void_list_node);
1039   ftype = build_function_type (pvoid_type_node, tmp);
1040   gfc_define_builtin ("__builtin_malloc", ftype, BUILT_IN_MALLOC,
1041                       "malloc", false);
1042   DECL_IS_MALLOC (built_in_decls[BUILT_IN_MALLOC]) = 1;
1043
1044   tmp = tree_cons (NULL_TREE, pvoid_type_node, void_list_node);
1045   tmp = tree_cons (NULL_TREE, size_type_node, tmp);
1046   ftype = build_function_type (pvoid_type_node, tmp);
1047   gfc_define_builtin ("__builtin_realloc", ftype, BUILT_IN_REALLOC,
1048                       "realloc", false);
1049
1050   tmp = tree_cons (NULL_TREE, void_type_node, void_list_node);
1051   ftype = build_function_type (integer_type_node, tmp);
1052   gfc_define_builtin ("__builtin_isnan", ftype, BUILT_IN_ISNAN,
1053                       "__builtin_isnan", true);
1054
1055 #define DEF_PRIMITIVE_TYPE(ENUM, VALUE) \
1056   builtin_types[(int) ENUM] = VALUE;
1057 #define DEF_FUNCTION_TYPE_0(ENUM, RETURN)               \
1058   builtin_types[(int) ENUM]                             \
1059     = build_function_type (builtin_types[(int) RETURN], \
1060                            void_list_node);
1061 #define DEF_FUNCTION_TYPE_1(ENUM, RETURN, ARG1)                         \
1062   builtin_types[(int) ENUM]                                             \
1063     = build_function_type (builtin_types[(int) RETURN],                 \
1064                            tree_cons (NULL_TREE,                        \
1065                                       builtin_types[(int) ARG1],        \
1066                                       void_list_node));
1067 #define DEF_FUNCTION_TYPE_2(ENUM, RETURN, ARG1, ARG2)   \
1068   builtin_types[(int) ENUM]                             \
1069     = build_function_type                               \
1070       (builtin_types[(int) RETURN],                     \
1071        tree_cons (NULL_TREE,                            \
1072                   builtin_types[(int) ARG1],            \
1073                   tree_cons (NULL_TREE,                 \
1074                              builtin_types[(int) ARG2], \
1075                              void_list_node)));
1076 #define DEF_FUNCTION_TYPE_3(ENUM, RETURN, ARG1, ARG2, ARG3)              \
1077   builtin_types[(int) ENUM]                                              \
1078     = build_function_type                                                \
1079       (builtin_types[(int) RETURN],                                      \
1080        tree_cons (NULL_TREE,                                             \
1081                   builtin_types[(int) ARG1],                             \
1082                   tree_cons (NULL_TREE,                                  \
1083                              builtin_types[(int) ARG2],                  \
1084                              tree_cons (NULL_TREE,                       \
1085                                         builtin_types[(int) ARG3],       \
1086                                         void_list_node))));
1087 #define DEF_FUNCTION_TYPE_4(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4)       \
1088   builtin_types[(int) ENUM]                                             \
1089     = build_function_type                                               \
1090       (builtin_types[(int) RETURN],                                     \
1091        tree_cons (NULL_TREE,                                            \
1092                   builtin_types[(int) ARG1],                            \
1093                   tree_cons (NULL_TREE,                                 \
1094                              builtin_types[(int) ARG2],                 \
1095                              tree_cons                                  \
1096                              (NULL_TREE,                                \
1097                               builtin_types[(int) ARG3],                \
1098                               tree_cons (NULL_TREE,                     \
1099                                          builtin_types[(int) ARG4],     \
1100                                          void_list_node)))));
1101 #define DEF_FUNCTION_TYPE_5(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5) \
1102   builtin_types[(int) ENUM]                                             \
1103     = build_function_type                                               \
1104       (builtin_types[(int) RETURN],                                     \
1105        tree_cons (NULL_TREE,                                            \
1106                   builtin_types[(int) ARG1],                            \
1107                   tree_cons (NULL_TREE,                                 \
1108                              builtin_types[(int) ARG2],                 \
1109                              tree_cons                                  \
1110                              (NULL_TREE,                                \
1111                               builtin_types[(int) ARG3],                \
1112                               tree_cons (NULL_TREE,                     \
1113                                          builtin_types[(int) ARG4],     \
1114                                          tree_cons (NULL_TREE,          \
1115                                               builtin_types[(int) ARG5],\
1116                                               void_list_node))))));
1117 #define DEF_FUNCTION_TYPE_6(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
1118                             ARG6)                                       \
1119   builtin_types[(int) ENUM]                                             \
1120     = build_function_type                                               \
1121       (builtin_types[(int) RETURN],                                     \
1122        tree_cons (NULL_TREE,                                            \
1123                   builtin_types[(int) ARG1],                            \
1124                   tree_cons (NULL_TREE,                                 \
1125                              builtin_types[(int) ARG2],                 \
1126                              tree_cons                                  \
1127                              (NULL_TREE,                                \
1128                               builtin_types[(int) ARG3],                \
1129                               tree_cons                                 \
1130                               (NULL_TREE,                               \
1131                                builtin_types[(int) ARG4],               \
1132                                tree_cons (NULL_TREE,                    \
1133                                          builtin_types[(int) ARG5],     \
1134                                          tree_cons (NULL_TREE,          \
1135                                               builtin_types[(int) ARG6],\
1136                                               void_list_node)))))));
1137 #define DEF_FUNCTION_TYPE_7(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
1138                             ARG6, ARG7)                                 \
1139   builtin_types[(int) ENUM]                                             \
1140     = build_function_type                                               \
1141       (builtin_types[(int) RETURN],                                     \
1142        tree_cons (NULL_TREE,                                            \
1143                   builtin_types[(int) ARG1],                            \
1144                   tree_cons (NULL_TREE,                                 \
1145                              builtin_types[(int) ARG2],                 \
1146                              tree_cons                                  \
1147                              (NULL_TREE,                                \
1148                               builtin_types[(int) ARG3],                \
1149                               tree_cons                                 \
1150                               (NULL_TREE,                               \
1151                                builtin_types[(int) ARG4],               \
1152                                tree_cons (NULL_TREE,                    \
1153                                          builtin_types[(int) ARG5],     \
1154                                          tree_cons (NULL_TREE,          \
1155                                               builtin_types[(int) ARG6],\
1156                                          tree_cons (NULL_TREE,          \
1157                                               builtin_types[(int) ARG6], \
1158                                               void_list_node))))))));
1159 #define DEF_FUNCTION_TYPE_VAR_0(ENUM, RETURN)                           \
1160   builtin_types[(int) ENUM]                                             \
1161     = build_function_type (builtin_types[(int) RETURN], NULL_TREE);
1162 #define DEF_POINTER_TYPE(ENUM, TYPE)                    \
1163   builtin_types[(int) ENUM]                             \
1164     = build_pointer_type (builtin_types[(int) TYPE]);
1165 #include "types.def"
1166 #undef DEF_PRIMITIVE_TYPE
1167 #undef DEF_FUNCTION_TYPE_1
1168 #undef DEF_FUNCTION_TYPE_2
1169 #undef DEF_FUNCTION_TYPE_3
1170 #undef DEF_FUNCTION_TYPE_4
1171 #undef DEF_FUNCTION_TYPE_5
1172 #undef DEF_FUNCTION_TYPE_6
1173 #undef DEF_FUNCTION_TYPE_VAR_0
1174 #undef DEF_POINTER_TYPE
1175   builtin_types[(int) BT_LAST] = NULL_TREE;
1176
1177   /* Initialize synchronization builtins.  */
1178 #undef DEF_SYNC_BUILTIN
1179 #define DEF_SYNC_BUILTIN(code, name, type, attr) \
1180     gfc_define_builtin (name, builtin_types[type], code, name, \
1181                         attr == ATTR_CONST_NOTHROW_LIST);
1182 #include "../sync-builtins.def"
1183 #undef DEF_SYNC_BUILTIN
1184
1185   if (gfc_option.flag_openmp || flag_tree_parallelize_loops)
1186     {
1187 #undef DEF_GOMP_BUILTIN
1188 #define DEF_GOMP_BUILTIN(code, name, type, attr) \
1189       gfc_define_builtin ("__builtin_" name, builtin_types[type], \
1190                           code, name, attr == ATTR_CONST_NOTHROW_LIST);
1191 #include "../omp-builtins.def"
1192 #undef DEF_GOMP_BUILTIN
1193     }
1194
1195   gfc_define_builtin ("__builtin_trap", builtin_types[BT_FN_VOID],
1196                       BUILT_IN_TRAP, NULL, false);
1197   TREE_THIS_VOLATILE (built_in_decls[BUILT_IN_TRAP]) = 1;
1198
1199   gfc_define_builtin ("__emutls_get_address",
1200                       builtin_types[BT_FN_PTR_PTR], BUILT_IN_EMUTLS_GET_ADDRESS,
1201                       "__emutls_get_address", true);
1202   gfc_define_builtin ("__emutls_register_common",
1203                       builtin_types[BT_FN_VOID_PTR_WORD_WORD_PTR],
1204                       BUILT_IN_EMUTLS_REGISTER_COMMON,
1205                       "__emutls_register_common", false);
1206
1207   build_common_builtin_nodes ();
1208   targetm.init_builtins ();
1209 }
1210
1211 #undef DEFINE_MATH_BUILTIN_C
1212 #undef DEFINE_MATH_BUILTIN
1213
1214 #include "gt-fortran-f95-lang.h"
1215 #include "gtype-fortran.h"