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