gcc/fortran/f95-lang.c

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