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