gcc/fortran/f95-lang.c

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