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