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