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