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