gcc/fortran/f95-lang.cc

   1 /* gfortran backend interface
   2    Copyright (C) 2000-2024 Free Software Foundation, Inc.
   3    Contributed by Paul Brook.
   4
   5 This file is part of GCC.
   6
   7 GCC is free software; you can redistribute it and/or modify it under
   8 the terms of the GNU General Public License as published by the Free
   9 Software Foundation; either version 3, or (at your option) any later
  10 version.
  11
  12 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
  13 WARRANTY; without even the implied warranty of MERCHANTABILITY or
  14 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  15 for more details.
  16
  17 You should have received a copy of the GNU General Public License
  18 along with GCC; see the file COPYING3.  If not see
  19 <http://www.gnu.org/licenses/>.  */
  20
  21 /* f95-lang.cc-- GCC backend interface stuff */
  22
  23 /* declare required prototypes: */
  24
  25 #include "config.h"
  26 #include "system.h"
  27 #include "coretypes.h"
  28 #include "target.h"
  29 #include "function.h"
  30 #include "tree.h"
  31 #include "gfortran.h"
  32 #include "trans.h"
  33 #include "stringpool.h"
  34 #include "diagnostic.h" /* For errorcount/warningcount */
  35 #include "langhooks.h"
  36 #include "langhooks-def.h"
  37 #include "toplev.h"
  38 #include "debug.h"
  39 #include "cpp.h"
  40 #include "trans-types.h"
  41 #include "trans-const.h"
  42 #include "attribs.h"
  43
  44 /* Language-dependent contents of an identifier.  */
  45
  46 struct GTY(())
  47 lang_identifier {
  48   struct tree_identifier common;
  49 };
  50
  51 /* The resulting tree type.  */
  52
  53 union GTY((desc ("TREE_CODE (&%h.generic) == IDENTIFIER_NODE"),
  54      chain_next ("CODE_CONTAINS_STRUCT (TREE_CODE (&%h.generic), TS_COMMON) ? ((union lang_tree_node *) TREE_CHAIN (&%h.generic)) : NULL")))
  55 lang_tree_node {
  56   union tree_node GTY((tag ("0"),
  57                        desc ("tree_node_structure (&%h)"))) generic;
  58   struct lang_identifier GTY((tag ("1"))) identifier;
  59 };
  60
  61 /* Save and restore the variables in this file and elsewhere
  62    that keep track of the progress of compilation of the current function.
  63    Used for nested functions.  */
  64
  65 struct GTY(())
  66 language_function {
  67   /* struct gfc_language_function base; */
  68   struct binding_level *binding_level;
  69 };
  70
  71 static void gfc_init_decl_processing (void);
  72 static void gfc_init_builtin_functions (void);
  73 static bool global_bindings_p (void);
  74
  75 /* Each front end provides its own.  */
  76 static bool gfc_init (void);
  77 static void gfc_finish (void);
  78 static void gfc_be_parse_file (void);
  79 static void gfc_init_ts (void);
  80 static tree gfc_builtin_function (tree);
  81
  82 /* Handle an "omp declare target" attribute; arguments as in
  83    struct attribute_spec.handler.  */
  84 static tree
  85 gfc_handle_omp_declare_target_attribute (tree *, tree, tree, int, bool *)
  86 {
  87   return NULL_TREE;
  88 }
  89
  90 /* Table of valid Fortran attributes.  */
  91 static const attribute_spec gfc_gnu_attributes[] =
  92 {
  93   /* { name, min_len, max_len, decl_req, type_req, fn_type_req,
  94        affects_type_identity, handler, exclude } */
  95   { "omp declare target", 0, -1, true,  false, false, false,
  96     gfc_handle_omp_declare_target_attribute, NULL },
  97   { "omp declare target link", 0, 0, true,  false, false, false,
  98     gfc_handle_omp_declare_target_attribute, NULL },
  99   { "omp declare target indirect", 0, 0, true,  false, false, false,
 100     gfc_handle_omp_declare_target_attribute, NULL },
 101   { "oacc function", 0, -1, true,  false, false, false,
 102     gfc_handle_omp_declare_target_attribute, NULL },
 103 };
 104
 105 static const scoped_attribute_specs gfc_gnu_attribute_table =
 106 {
 107   "gnu", { gfc_gnu_attributes }
 108 };
 109
 110 static const scoped_attribute_specs *const gfc_attribute_table[] =
 111 {
 112   &gfc_gnu_attribute_table
 113 };
 114
 115 /* Get a value for the SARIF v2.1.0 "artifact.sourceLanguage" property,
 116    based on the list in SARIF v2.1.0 Appendix J.  */
 117
 118 static const char *
 119 gfc_get_sarif_source_language (const char *)
 120 {
 121   return "fortran";
 122 }
 123
 124 #undef LANG_HOOKS_NAME
 125 #undef LANG_HOOKS_INIT
 126 #undef LANG_HOOKS_FINISH
 127 #undef LANG_HOOKS_OPTION_LANG_MASK
 128 #undef LANG_HOOKS_INIT_OPTIONS_STRUCT
 129 #undef LANG_HOOKS_INIT_OPTIONS
 130 #undef LANG_HOOKS_HANDLE_OPTION
 131 #undef LANG_HOOKS_POST_OPTIONS
 132 #undef LANG_HOOKS_PARSE_FILE
 133 #undef LANG_HOOKS_MARK_ADDRESSABLE
 134 #undef LANG_HOOKS_TYPE_FOR_MODE
 135 #undef LANG_HOOKS_TYPE_FOR_SIZE
 136 #undef LANG_HOOKS_INIT_TS
 137 #undef LANG_HOOKS_OMP_ARRAY_DATA
 138 #undef LANG_HOOKS_OMP_ARRAY_SIZE
 139 #undef LANG_HOOKS_OMP_IS_ALLOCATABLE_OR_PTR
 140 #undef LANG_HOOKS_OMP_CHECK_OPTIONAL_ARGUMENT
 141 #undef LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE
 142 #undef LANG_HOOKS_OMP_PREDETERMINED_SHARING
 143 #undef LANG_HOOKS_OMP_PREDETERMINED_MAPPING
 144 #undef LANG_HOOKS_OMP_REPORT_DECL
 145 #undef LANG_HOOKS_OMP_CLAUSE_DEFAULT_CTOR
 146 #undef LANG_HOOKS_OMP_CLAUSE_COPY_CTOR
 147 #undef LANG_HOOKS_OMP_CLAUSE_ASSIGN_OP
 148 #undef LANG_HOOKS_OMP_CLAUSE_LINEAR_CTOR
 149 #undef LANG_HOOKS_OMP_CLAUSE_DTOR
 150 #undef LANG_HOOKS_OMP_FINISH_CLAUSE
 151 #undef LANG_HOOKS_OMP_ALLOCATABLE_P
 152 #undef LANG_HOOKS_OMP_SCALAR_TARGET_P
 153 #undef LANG_HOOKS_OMP_SCALAR_P
 154 #undef LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR
 155 #undef LANG_HOOKS_OMP_PRIVATE_DEBUG_CLAUSE
 156 #undef LANG_HOOKS_OMP_PRIVATE_OUTER_REF
 157 #undef LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES
 158 #undef LANG_HOOKS_BUILTIN_FUNCTION
 159 #undef LANG_HOOKS_BUILTIN_FUNCTION
 160 #undef LANG_HOOKS_GET_ARRAY_DESCR_INFO
 161 #undef LANG_HOOKS_ATTRIBUTE_TABLE
 162 #undef LANG_HOOKS_GET_SARIF_SOURCE_LANGUAGE
 163
 164 /* Define lang hooks.  */
 165 #define LANG_HOOKS_NAME                 "GNU Fortran"
 166 #define LANG_HOOKS_INIT                 gfc_init
 167 #define LANG_HOOKS_FINISH               gfc_finish
 168 #define LANG_HOOKS_OPTION_LANG_MASK     gfc_option_lang_mask
 169 #define LANG_HOOKS_INIT_OPTIONS_STRUCT  gfc_init_options_struct
 170 #define LANG_HOOKS_INIT_OPTIONS         gfc_init_options
 171 #define LANG_HOOKS_HANDLE_OPTION        gfc_handle_option
 172 #define LANG_HOOKS_POST_OPTIONS         gfc_post_options
 173 #define LANG_HOOKS_PARSE_FILE           gfc_be_parse_file
 174 #define LANG_HOOKS_TYPE_FOR_MODE        gfc_type_for_mode
 175 #define LANG_HOOKS_TYPE_FOR_SIZE        gfc_type_for_size
 176 #define LANG_HOOKS_INIT_TS              gfc_init_ts
 177 #define LANG_HOOKS_OMP_ARRAY_DATA               gfc_omp_array_data
 178 #define LANG_HOOKS_OMP_ARRAY_SIZE               gfc_omp_array_size
 179 #define LANG_HOOKS_OMP_IS_ALLOCATABLE_OR_PTR    gfc_omp_is_allocatable_or_ptr
 180 #define LANG_HOOKS_OMP_CHECK_OPTIONAL_ARGUMENT  gfc_omp_check_optional_argument
 181 #define LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE   gfc_omp_privatize_by_reference
 182 #define LANG_HOOKS_OMP_PREDETERMINED_SHARING    gfc_omp_predetermined_sharing
 183 #define LANG_HOOKS_OMP_PREDETERMINED_MAPPING    gfc_omp_predetermined_mapping
 184 #define LANG_HOOKS_OMP_REPORT_DECL              gfc_omp_report_decl
 185 #define LANG_HOOKS_OMP_CLAUSE_DEFAULT_CTOR      gfc_omp_clause_default_ctor
 186 #define LANG_HOOKS_OMP_CLAUSE_COPY_CTOR         gfc_omp_clause_copy_ctor
 187 #define LANG_HOOKS_OMP_CLAUSE_ASSIGN_OP         gfc_omp_clause_assign_op
 188 #define LANG_HOOKS_OMP_CLAUSE_LINEAR_CTOR       gfc_omp_clause_linear_ctor
 189 #define LANG_HOOKS_OMP_CLAUSE_DTOR              gfc_omp_clause_dtor
 190 #define LANG_HOOKS_OMP_FINISH_CLAUSE            gfc_omp_finish_clause
 191 #define LANG_HOOKS_OMP_ALLOCATABLE_P            gfc_omp_allocatable_p
 192 #define LANG_HOOKS_OMP_SCALAR_P                 gfc_omp_scalar_p
 193 #define LANG_HOOKS_OMP_SCALAR_TARGET_P          gfc_omp_scalar_target_p
 194 #define LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR     gfc_omp_disregard_value_expr
 195 #define LANG_HOOKS_OMP_PRIVATE_DEBUG_CLAUSE     gfc_omp_private_debug_clause
 196 #define LANG_HOOKS_OMP_PRIVATE_OUTER_REF        gfc_omp_private_outer_ref
 197 #define LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES \
 198   gfc_omp_firstprivatize_type_sizes
 199 #define LANG_HOOKS_BUILTIN_FUNCTION     gfc_builtin_function
 200 #define LANG_HOOKS_GET_ARRAY_DESCR_INFO gfc_get_array_descr_info
 201 #define LANG_HOOKS_ATTRIBUTE_TABLE      gfc_attribute_table
 202 #define LANG_HOOKS_GET_SARIF_SOURCE_LANGUAGE gfc_get_sarif_source_language
 203
 204 struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
 205
 206 #define NULL_BINDING_LEVEL (struct binding_level *) NULL
 207
 208 /* A chain of binding_level structures awaiting reuse.  */
 209
 210 static GTY(()) struct binding_level *free_binding_level;
 211
 212 /* True means we've initialized exception handling.  */
 213 static bool gfc_eh_initialized_p;
 214
 215 /* The current translation unit.  */
 216 static GTY(()) tree current_translation_unit;
 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   /* Build our translation-unit decl.  */
 231   current_translation_unit
 232     = build_translation_unit_decl (get_identifier (main_input_filename));
 233   debug_hooks->register_main_translation_unit (current_translation_unit);
 234 }
 235
 236
 237 static void
 238 gfc_be_parse_file (void)
 239 {
 240   gfc_create_decls ();
 241   gfc_parse_file ();
 242   gfc_generate_constructors ();
 243
 244   /* Clear the binding level stack.  */
 245   while (!global_bindings_p ())
 246     poplevel (0, 0);
 247
 248   /* Finalize all of the globals.
 249
 250      Emulated tls lowering needs to see all TLS variables before we
 251      call finalize_compilation_unit.  The C/C++ front ends manage this
 252      by calling decl_rest_of_compilation on each global and static
 253      variable as they are seen.  The Fortran front end waits until
 254      here.  */
 255   for (tree decl = getdecls (); decl ; decl = DECL_CHAIN (decl))
 256     rest_of_decl_compilation (decl, true, true);
 257
 258   /* Switch to the default tree diagnostics here, because there may be
 259      diagnostics before gfc_finish().  */
 260   gfc_diagnostics_finish ();
 261
 262   global_decl_processing ();
 263 }
 264
 265
 266 /* Initialize everything.  */
 267
 268 static bool
 269 gfc_init (void)
 270 {
 271   if (!gfc_cpp_enabled ())
 272     {
 273       linemap_add (line_table, LC_ENTER, false, gfc_source_file, 1);
 274       linemap_add (line_table, LC_RENAME, false, special_fname_builtin (), 0);
 275     }
 276   else
 277     gfc_cpp_init_0 ();
 278
 279   gfc_init_decl_processing ();
 280   gfc_static_ctors = NULL_TREE;
 281
 282   if (gfc_cpp_enabled ())
 283     gfc_cpp_init ();
 284
 285   gfc_init_1 ();
 286
 287   /* Calls exit in case of a fail. */
 288   gfc_new_file ();
 289
 290   if (flag_preprocess_only)
 291     return false;
 292
 293   return true;
 294 }
 295
 296
 297 static void
 298 gfc_finish (void)
 299 {
 300   gfc_cpp_done ();
 301   gfc_done_1 ();
 302   gfc_release_include_path ();
 303   return;
 304 }
 305
 306 /* These functions and variables deal with binding contours.  We only
 307    need these functions for the list of PARM_DECLs, but we leave the
 308    functions more general; these are a simplified version of the
 309    functions from GNAT.  */
 310
 311 /* For each binding contour we allocate a binding_level structure which
 312    records the entities defined or declared in that contour.  Contours
 313    include:
 314
 315         the global one
 316         one for each subprogram definition
 317         one for each compound statement (declare block)
 318
 319    Binding contours are used to create GCC tree BLOCK nodes.  */
 320
 321 struct GTY(())
 322 binding_level {
 323   /* A chain of ..._DECL nodes for all variables, constants, functions,
 324      parameters and type declarations.  These ..._DECL nodes are chained
 325      through the DECL_CHAIN field.  */
 326   tree names;
 327   /* For each level (except the global one), a chain of BLOCK nodes for all
 328      the levels that were entered and exited one level down from this one.  */
 329   tree blocks;
 330   /* The binding level containing this one (the enclosing binding level).  */
 331   struct binding_level *level_chain;
 332   /* True if nreverse has been already called on names; if false, names
 333      are ordered from newest declaration to oldest one.  */
 334   bool reversed;
 335 };
 336
 337 /* The binding level currently in effect.  */
 338 static GTY(()) struct binding_level *current_binding_level = NULL;
 339
 340 /* The outermost binding level. This binding level is created when the
 341    compiler is started and it will exist through the entire compilation.  */
 342 static GTY(()) struct binding_level *global_binding_level;
 343
 344 /* Binding level structures are initialized by copying this one.  */
 345 static struct binding_level clear_binding_level = { NULL, NULL, NULL, false };
 346
 347
 348 /* Return true if we are in the global binding level.  */
 349
 350 bool
 351 global_bindings_p (void)
 352 {
 353   return current_binding_level == global_binding_level;
 354 }
 355
 356 tree
 357 getdecls (void)
 358 {
 359   if (!current_binding_level->reversed)
 360     {
 361       current_binding_level->reversed = true;
 362       current_binding_level->names = nreverse (current_binding_level->names);
 363     }
 364   return current_binding_level->names;
 365 }
 366
 367 /* Enter a new binding level.  */
 368
 369 void
 370 pushlevel (void)
 371 {
 372   struct binding_level *newlevel = ggc_alloc<binding_level> ();
 373
 374   *newlevel = clear_binding_level;
 375
 376   /* Add this level to the front of the chain (stack) of levels that are
 377      active.  */
 378   newlevel->level_chain = current_binding_level;
 379   current_binding_level = newlevel;
 380 }
 381
 382 /* Exit a binding level.
 383    Pop the level off, and restore the state of the identifier-decl mappings
 384    that were in effect when this level was entered.
 385
 386    If KEEP is nonzero, this level had explicit declarations, so
 387    and create a "block" (a BLOCK node) for the level
 388    to record its declarations and subblocks for symbol table output.
 389
 390    If FUNCTIONBODY is nonzero, this level is the body of a function,
 391    so create a block as if KEEP were set and also clear out all
 392    label names.  */
 393
 394 tree
 395 poplevel (int keep, int functionbody)
 396 {
 397   /* Points to a BLOCK tree node. This is the BLOCK node constructed for the
 398      binding level that we are about to exit and which is returned by this
 399      routine.  */
 400   tree block_node = NULL_TREE;
 401   tree decl_chain = getdecls ();
 402   tree subblock_chain = current_binding_level->blocks;
 403   tree subblock_node;
 404
 405   /* If there were any declarations in the current binding level, or if this
 406      binding level is a function body, or if there are any nested blocks then
 407      create a BLOCK node to record them for the life of this function.  */
 408   if (keep || functionbody)
 409     block_node = build_block (keep ? decl_chain : 0, subblock_chain, 0, 0);
 410
 411   /* Record the BLOCK node just built as the subblock its enclosing scope.  */
 412   for (subblock_node = subblock_chain; subblock_node;
 413        subblock_node = BLOCK_CHAIN (subblock_node))
 414     BLOCK_SUPERCONTEXT (subblock_node) = block_node;
 415
 416   /* Clear out the meanings of the local variables of this level.  */
 417
 418   for (subblock_node = decl_chain; subblock_node;
 419        subblock_node = DECL_CHAIN (subblock_node))
 420     if (DECL_NAME (subblock_node) != 0)
 421       /* If the identifier was used or addressed via a local extern decl,
 422          don't forget that fact.  */
 423       if (DECL_EXTERNAL (subblock_node))
 424         {
 425           if (TREE_USED (subblock_node))
 426             TREE_USED (DECL_NAME (subblock_node)) = 1;
 427           if (TREE_ADDRESSABLE (subblock_node))
 428             TREE_ADDRESSABLE (DECL_ASSEMBLER_NAME (subblock_node)) = 1;
 429         }
 430
 431   /* Pop the current level.  */
 432   current_binding_level = current_binding_level->level_chain;
 433
 434   if (functionbody)
 435     /* This is the top level block of a function.  */
 436     DECL_INITIAL (current_function_decl) = block_node;
 437   else if (current_binding_level == global_binding_level)
 438     /* When using gfc_start_block/gfc_finish_block from middle-end hooks,
 439        don't add newly created BLOCKs as subblocks of global_binding_level.  */
 440     ;
 441   else if (block_node)
 442     {
 443       current_binding_level->blocks
 444         = block_chainon (current_binding_level->blocks, block_node);
 445     }
 446
 447   /* If we did not make a block for the level just exited, any blocks made for
 448      inner levels (since they cannot be recorded as subblocks in that level)
 449      must be carried forward so they will later become subblocks of something
 450      else.  */
 451   else if (subblock_chain)
 452     current_binding_level->blocks
 453       = block_chainon (current_binding_level->blocks, subblock_chain);
 454   if (block_node)
 455     TREE_USED (block_node) = 1;
 456
 457   return block_node;
 458 }
 459
 460
 461 /* Records a ..._DECL node DECL as belonging to the current lexical scope.
 462    Returns the ..._DECL node.  */
 463
 464 tree
 465 pushdecl (tree decl)
 466 {
 467   if (global_bindings_p ())
 468     DECL_CONTEXT (decl) = current_translation_unit;
 469   else
 470     {
 471       /* External objects aren't nested.  For debug info insert a copy
 472          of the decl into the binding level.  */
 473       if (DECL_EXTERNAL (decl))
 474         {
 475           tree orig = decl;
 476           decl = copy_node (decl);
 477           DECL_CONTEXT (orig) = NULL_TREE;
 478         }
 479       DECL_CONTEXT (decl) = current_function_decl;
 480     }
 481
 482   /* Put the declaration on the list.  */
 483   DECL_CHAIN (decl) = current_binding_level->names;
 484   current_binding_level->names = decl;
 485
 486   /* For the declaration of a type, set its name if it is not already set.  */
 487
 488   if (TREE_CODE (decl) == TYPE_DECL && TYPE_NAME (TREE_TYPE (decl)) == 0)
 489     {
 490       if (DECL_SOURCE_LINE (decl) == 0)
 491         TYPE_NAME (TREE_TYPE (decl)) = decl;
 492       else
 493         TYPE_NAME (TREE_TYPE (decl)) = DECL_NAME (decl);
 494     }
 495
 496   return decl;
 497 }
 498
 499
 500 /* Like pushdecl, only it places X in GLOBAL_BINDING_LEVEL.  */
 501
 502 tree
 503 pushdecl_top_level (tree x)
 504 {
 505   tree t;
 506   struct binding_level *b = current_binding_level;
 507
 508   current_binding_level = global_binding_level;
 509   t = pushdecl (x);
 510   current_binding_level = b;
 511   return t;
 512 }
 513
 514 #ifndef CHAR_TYPE_SIZE
 515 #define CHAR_TYPE_SIZE BITS_PER_UNIT
 516 #endif
 517
 518 #ifndef INT_TYPE_SIZE
 519 #define INT_TYPE_SIZE BITS_PER_WORD
 520 #endif
 521
 522 #undef SIZE_TYPE
 523 #define SIZE_TYPE "long unsigned int"
 524
 525 /* Create tree nodes for the basic scalar types of Fortran 95,
 526    and some nodes representing standard constants (0, 1, (void *) 0).
 527    Initialize the global binding level.
 528    Make definitions for built-in primitive functions.  */
 529 static void
 530 gfc_init_decl_processing (void)
 531 {
 532   current_function_decl = NULL;
 533   current_binding_level = NULL_BINDING_LEVEL;
 534   free_binding_level = NULL_BINDING_LEVEL;
 535
 536   /* Make the binding_level structure for global names. We move all
 537      variables that are in a COMMON block to this binding level.  */
 538   pushlevel ();
 539   global_binding_level = current_binding_level;
 540
 541   /* Build common tree nodes. char_type_node is unsigned because we
 542      only use it for actual characters, not for INTEGER(1).  */
 543   build_common_tree_nodes (false);
 544
 545   /* Set up F95 type nodes.  */
 546   gfc_init_kinds ();
 547   gfc_init_types ();
 548   gfc_init_c_interop_kinds ();
 549 }
 550
 551
 552 /* Builtin function initialization.  */
 553
 554 static tree
 555 gfc_builtin_function (tree decl)
 556 {
 557   pushdecl (decl);
 558   return decl;
 559 }
 560
 561 /* So far we need just these 10 attribute types.  */
 562 #define ATTR_NULL                       0
 563 #define ATTR_LEAF_LIST                  (ECF_LEAF)
 564 #define ATTR_NOTHROW_LEAF_LIST          (ECF_NOTHROW | ECF_LEAF)
 565 #define ATTR_NOTHROW_LEAF_MALLOC_LIST   (ECF_NOTHROW | ECF_LEAF | ECF_MALLOC)
 566 #define ATTR_CONST_NOTHROW_LEAF_LIST    (ECF_NOTHROW | ECF_LEAF | ECF_CONST)
 567 #define ATTR_PURE_NOTHROW_LEAF_LIST     (ECF_NOTHROW | ECF_LEAF | ECF_PURE)
 568 #define ATTR_NOTHROW_LIST               (ECF_NOTHROW)
 569 #define ATTR_CONST_NOTHROW_LIST         (ECF_NOTHROW | ECF_CONST)
 570 #define ATTR_ALLOC_WARN_UNUSED_RESULT_SIZE_2_NOTHROW_LIST \
 571                                         (ECF_NOTHROW | ECF_LEAF | ECF_MALLOC)
 572 #define ATTR_ALLOC_WARN_UNUSED_RESULT_SIZE_2_NOTHROW_LEAF_LIST \
 573                                         (ECF_NOTHROW | ECF_LEAF)
 574 #define ATTR_COLD_NORETURN_NOTHROW_LEAF_LIST \
 575                                         (ECF_COLD | ECF_NORETURN | \
 576                                          ECF_NOTHROW | ECF_LEAF)
 577
 578 static void
 579 gfc_define_builtin (const char *name, tree type, enum built_in_function code,
 580                     const char *library_name, int attr)
 581 {
 582   tree decl;
 583
 584   decl = add_builtin_function (name, type, code, BUILT_IN_NORMAL,
 585                                library_name, NULL_TREE);
 586   set_call_expr_flags (decl, attr);
 587
 588   set_builtin_decl (code, decl, true);
 589 }
 590
 591
 592 #define DO_DEFINE_MATH_BUILTIN(code, name, argtype, tbase) \
 593     gfc_define_builtin ("__builtin_" name "l", tbase##longdouble[argtype], \
 594                         BUILT_IN_ ## code ## L, name "l", \
 595                         ATTR_CONST_NOTHROW_LEAF_LIST); \
 596     gfc_define_builtin ("__builtin_" name, tbase##double[argtype], \
 597                         BUILT_IN_ ## code, name, \
 598                         ATTR_CONST_NOTHROW_LEAF_LIST); \
 599     gfc_define_builtin ("__builtin_" name "f", tbase##float[argtype], \
 600                         BUILT_IN_ ## code ## F, name "f", \
 601                         ATTR_CONST_NOTHROW_LEAF_LIST);
 602
 603 #define DEFINE_MATH_BUILTIN(code, name, argtype) \
 604     DO_DEFINE_MATH_BUILTIN (code, name, argtype, mfunc_)
 605
 606 #define DEFINE_MATH_BUILTIN_C(code, name, argtype) \
 607     DO_DEFINE_MATH_BUILTIN (code, name, argtype, mfunc_) \
 608     DO_DEFINE_MATH_BUILTIN (C##code, "c" name, argtype, mfunc_c)
 609
 610
 611 /* Create function types for builtin functions.  */
 612
 613 static void
 614 build_builtin_fntypes (tree *fntype, tree type)
 615 {
 616   /* type (*) (type) */
 617   fntype[0] = build_function_type_list (type, type, NULL_TREE);
 618   /* type (*) (type, type) */
 619   fntype[1] = build_function_type_list (type, type, type, NULL_TREE);
 620   /* type (*) (type, int) */
 621   fntype[2] = build_function_type_list (type,
 622                                         type, integer_type_node, NULL_TREE);
 623   /* type (*) (void) */
 624   fntype[3] = build_function_type_list (type, NULL_TREE);
 625   /* type (*) (type, &int) */
 626   fntype[4] = build_function_type_list (type, type,
 627                                         build_pointer_type (integer_type_node),
 628                                         NULL_TREE);
 629   /* type (*) (int, type) */
 630   fntype[5] = build_function_type_list (type,
 631                                         integer_type_node, type, NULL_TREE);
 632 }
 633
 634
 635 static tree
 636 builtin_type_for_size (int size, bool unsignedp)
 637 {
 638   tree type = gfc_type_for_size (size, unsignedp);
 639   return type ? type : error_mark_node;
 640 }
 641
 642 /* Initialization of builtin function nodes.  */
 643
 644 static void
 645 gfc_init_builtin_functions (void)
 646 {
 647   enum builtin_type
 648   {
 649 #define DEF_PRIMITIVE_TYPE(NAME, VALUE) NAME,
 650 #define DEF_FUNCTION_TYPE_0(NAME, RETURN) NAME,
 651 #define DEF_FUNCTION_TYPE_1(NAME, RETURN, ARG1) NAME,
 652 #define DEF_FUNCTION_TYPE_2(NAME, RETURN, ARG1, ARG2) NAME,
 653 #define DEF_FUNCTION_TYPE_3(NAME, RETURN, ARG1, ARG2, ARG3) NAME,
 654 #define DEF_FUNCTION_TYPE_4(NAME, RETURN, ARG1, ARG2, ARG3, ARG4) NAME,
 655 #define DEF_FUNCTION_TYPE_5(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5) NAME,
 656 #define DEF_FUNCTION_TYPE_6(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
 657                             ARG6) NAME,
 658 #define DEF_FUNCTION_TYPE_7(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
 659                             ARG6, ARG7) NAME,
 660 #define DEF_FUNCTION_TYPE_8(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
 661                             ARG6, ARG7, ARG8) NAME,
 662 #define DEF_FUNCTION_TYPE_9(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
 663                             ARG6, ARG7, ARG8, ARG9) NAME,
 664 #define DEF_FUNCTION_TYPE_10(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
 665                              ARG6, ARG7, ARG8, ARG9, ARG10) NAME,
 666 #define DEF_FUNCTION_TYPE_11(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
 667                              ARG6, ARG7, ARG8, ARG9, ARG10, ARG11) NAME,
 668 #define DEF_FUNCTION_TYPE_VAR_0(NAME, RETURN) NAME,
 669 #define DEF_FUNCTION_TYPE_VAR_1(NAME, RETURN, ARG1) NAME,
 670 #define DEF_FUNCTION_TYPE_VAR_2(NAME, RETURN, ARG1, ARG2) NAME,
 671 #define DEF_FUNCTION_TYPE_VAR_6(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
 672                                  ARG6) NAME,
 673 #define DEF_FUNCTION_TYPE_VAR_7(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
 674                                 ARG6, ARG7) NAME,
 675 #define DEF_POINTER_TYPE(NAME, TYPE) NAME,
 676 #include "types.def"
 677 #undef DEF_PRIMITIVE_TYPE
 678 #undef DEF_FUNCTION_TYPE_0
 679 #undef DEF_FUNCTION_TYPE_1
 680 #undef DEF_FUNCTION_TYPE_2
 681 #undef DEF_FUNCTION_TYPE_3
 682 #undef DEF_FUNCTION_TYPE_4
 683 #undef DEF_FUNCTION_TYPE_5
 684 #undef DEF_FUNCTION_TYPE_6
 685 #undef DEF_FUNCTION_TYPE_7
 686 #undef DEF_FUNCTION_TYPE_8
 687 #undef DEF_FUNCTION_TYPE_9
 688 #undef DEF_FUNCTION_TYPE_10
 689 #undef DEF_FUNCTION_TYPE_11
 690 #undef DEF_FUNCTION_TYPE_VAR_0
 691 #undef DEF_FUNCTION_TYPE_VAR_1
 692 #undef DEF_FUNCTION_TYPE_VAR_2
 693 #undef DEF_FUNCTION_TYPE_VAR_6
 694 #undef DEF_FUNCTION_TYPE_VAR_7
 695 #undef DEF_POINTER_TYPE
 696     BT_LAST
 697   };
 698
 699   tree mfunc_float[6];
 700   tree mfunc_double[6];
 701   tree mfunc_longdouble[6];
 702   tree mfunc_cfloat[6];
 703   tree mfunc_cdouble[6];
 704   tree mfunc_clongdouble[6];
 705   tree func_cfloat_float, func_float_cfloat;
 706   tree func_cdouble_double, func_double_cdouble;
 707   tree func_clongdouble_longdouble, func_longdouble_clongdouble;
 708   tree func_float_floatp_floatp;
 709   tree func_double_doublep_doublep;
 710   tree func_longdouble_longdoublep_longdoublep;
 711   tree ftype, ptype;
 712   tree builtin_types[(int) BT_LAST + 1];
 713
 714   int attr;
 715
 716   build_builtin_fntypes (mfunc_float, float_type_node);
 717   build_builtin_fntypes (mfunc_double, double_type_node);
 718   build_builtin_fntypes (mfunc_longdouble, long_double_type_node);
 719   build_builtin_fntypes (mfunc_cfloat, complex_float_type_node);
 720   build_builtin_fntypes (mfunc_cdouble, complex_double_type_node);
 721   build_builtin_fntypes (mfunc_clongdouble, complex_long_double_type_node);
 722
 723   func_cfloat_float = build_function_type_list (float_type_node,
 724                                                 complex_float_type_node,
 725                                                 NULL_TREE);
 726
 727   func_float_cfloat = build_function_type_list (complex_float_type_node,
 728                                                 float_type_node, NULL_TREE);
 729
 730   func_cdouble_double = build_function_type_list (double_type_node,
 731                                                   complex_double_type_node,
 732                                                   NULL_TREE);
 733
 734   func_double_cdouble = build_function_type_list (complex_double_type_node,
 735                                                   double_type_node, NULL_TREE);
 736
 737   func_clongdouble_longdouble
 738     = build_function_type_list (long_double_type_node,
 739                                 complex_long_double_type_node, NULL_TREE);
 740
 741   func_longdouble_clongdouble
 742     = build_function_type_list (complex_long_double_type_node,
 743                                 long_double_type_node, NULL_TREE);
 744
 745   ptype = build_pointer_type (float_type_node);
 746   func_float_floatp_floatp
 747     = build_function_type_list (void_type_node, float_type_node, ptype, ptype,
 748                                 NULL_TREE);
 749
 750   ptype = build_pointer_type (double_type_node);
 751   func_double_doublep_doublep
 752     = build_function_type_list (void_type_node, double_type_node, ptype,
 753                                 ptype, NULL_TREE);
 754
 755   ptype = build_pointer_type (long_double_type_node);
 756   func_longdouble_longdoublep_longdoublep
 757     = build_function_type_list (void_type_node, long_double_type_node, ptype,
 758                                 ptype, NULL_TREE);
 759
 760 /* Non-math builtins are defined manually, so they're not included here.  */
 761 #define OTHER_BUILTIN(ID,NAME,TYPE,CONST)
 762
 763 #include "mathbuiltins.def"
 764
 765   gfc_define_builtin ("__builtin_roundl", mfunc_longdouble[0],
 766                       BUILT_IN_ROUNDL, "roundl", ATTR_CONST_NOTHROW_LEAF_LIST);
 767   gfc_define_builtin ("__builtin_round", mfunc_double[0],
 768                       BUILT_IN_ROUND, "round", ATTR_CONST_NOTHROW_LEAF_LIST);
 769   gfc_define_builtin ("__builtin_roundf", mfunc_float[0],
 770                       BUILT_IN_ROUNDF, "roundf", ATTR_CONST_NOTHROW_LEAF_LIST);
 771
 772   gfc_define_builtin ("__builtin_truncl", mfunc_longdouble[0],
 773                       BUILT_IN_TRUNCL, "truncl", ATTR_CONST_NOTHROW_LEAF_LIST);
 774   gfc_define_builtin ("__builtin_trunc", mfunc_double[0],
 775                       BUILT_IN_TRUNC, "trunc", ATTR_CONST_NOTHROW_LEAF_LIST);
 776   gfc_define_builtin ("__builtin_truncf", mfunc_float[0],
 777                       BUILT_IN_TRUNCF, "truncf", ATTR_CONST_NOTHROW_LEAF_LIST);
 778
 779   gfc_define_builtin ("__builtin_cabsl", func_clongdouble_longdouble,
 780                       BUILT_IN_CABSL, "cabsl", ATTR_CONST_NOTHROW_LEAF_LIST);
 781   gfc_define_builtin ("__builtin_cabs", func_cdouble_double,
 782                       BUILT_IN_CABS, "cabs", ATTR_CONST_NOTHROW_LEAF_LIST);
 783   gfc_define_builtin ("__builtin_cabsf", func_cfloat_float,
 784                       BUILT_IN_CABSF, "cabsf", ATTR_CONST_NOTHROW_LEAF_LIST);
 785
 786   gfc_define_builtin ("__builtin_copysignl", mfunc_longdouble[1],
 787                       BUILT_IN_COPYSIGNL, "copysignl",
 788                       ATTR_CONST_NOTHROW_LEAF_LIST);
 789   gfc_define_builtin ("__builtin_copysign", mfunc_double[1],
 790                       BUILT_IN_COPYSIGN, "copysign",
 791                       ATTR_CONST_NOTHROW_LEAF_LIST);
 792   gfc_define_builtin ("__builtin_copysignf", mfunc_float[1],
 793                       BUILT_IN_COPYSIGNF, "copysignf",
 794                       ATTR_CONST_NOTHROW_LEAF_LIST);
 795
 796   gfc_define_builtin ("__builtin_nextafterl", mfunc_longdouble[1],
 797                       BUILT_IN_NEXTAFTERL, "nextafterl",
 798                       ATTR_CONST_NOTHROW_LEAF_LIST);
 799   gfc_define_builtin ("__builtin_nextafter", mfunc_double[1],
 800                       BUILT_IN_NEXTAFTER, "nextafter",
 801                       ATTR_CONST_NOTHROW_LEAF_LIST);
 802   gfc_define_builtin ("__builtin_nextafterf", mfunc_float[1],
 803                       BUILT_IN_NEXTAFTERF, "nextafterf",
 804                       ATTR_CONST_NOTHROW_LEAF_LIST);
 805
 806   /* Some built-ins depend on rounding mode. Depending on compilation options, they
 807      will be "pure" or "const".  */
 808   attr = flag_rounding_math ? ATTR_PURE_NOTHROW_LEAF_LIST : ATTR_CONST_NOTHROW_LEAF_LIST;
 809
 810   gfc_define_builtin ("__builtin_rintl", mfunc_longdouble[0],
 811                       BUILT_IN_RINTL, "rintl", attr);
 812   gfc_define_builtin ("__builtin_rint", mfunc_double[0],
 813                       BUILT_IN_RINT, "rint", attr);
 814   gfc_define_builtin ("__builtin_rintf", mfunc_float[0],
 815                       BUILT_IN_RINTF, "rintf", attr);
 816
 817   gfc_define_builtin ("__builtin_remainderl", mfunc_longdouble[1],
 818                       BUILT_IN_REMAINDERL, "remainderl", attr);
 819   gfc_define_builtin ("__builtin_remainder", mfunc_double[1],
 820                       BUILT_IN_REMAINDER, "remainder", attr);
 821   gfc_define_builtin ("__builtin_remainderf", mfunc_float[1],
 822                       BUILT_IN_REMAINDERF, "remainderf", attr);
 823
 824   gfc_define_builtin ("__builtin_logbl", mfunc_longdouble[0],
 825                       BUILT_IN_LOGBL, "logbl", ATTR_CONST_NOTHROW_LEAF_LIST);
 826   gfc_define_builtin ("__builtin_logb", mfunc_double[0],
 827                       BUILT_IN_LOGB, "logb", ATTR_CONST_NOTHROW_LEAF_LIST);
 828   gfc_define_builtin ("__builtin_logbf", mfunc_float[0],
 829                       BUILT_IN_LOGBF, "logbf", ATTR_CONST_NOTHROW_LEAF_LIST);
 830
 831
 832   gfc_define_builtin ("__builtin_frexpl", mfunc_longdouble[4],
 833                       BUILT_IN_FREXPL, "frexpl", ATTR_NOTHROW_LEAF_LIST);
 834   gfc_define_builtin ("__builtin_frexp", mfunc_double[4],
 835                       BUILT_IN_FREXP, "frexp", ATTR_NOTHROW_LEAF_LIST);
 836   gfc_define_builtin ("__builtin_frexpf", mfunc_float[4],
 837                       BUILT_IN_FREXPF, "frexpf", ATTR_NOTHROW_LEAF_LIST);
 838
 839   gfc_define_builtin ("__builtin_fabsl", mfunc_longdouble[0],
 840                       BUILT_IN_FABSL, "fabsl", ATTR_CONST_NOTHROW_LEAF_LIST);
 841   gfc_define_builtin ("__builtin_fabs", mfunc_double[0],
 842                       BUILT_IN_FABS, "fabs", ATTR_CONST_NOTHROW_LEAF_LIST);
 843   gfc_define_builtin ("__builtin_fabsf", mfunc_float[0],
 844                       BUILT_IN_FABSF, "fabsf", ATTR_CONST_NOTHROW_LEAF_LIST);
 845
 846   gfc_define_builtin ("__builtin_scalbnl", mfunc_longdouble[2],
 847                       BUILT_IN_SCALBNL, "scalbnl", ATTR_CONST_NOTHROW_LEAF_LIST);
 848   gfc_define_builtin ("__builtin_scalbn", mfunc_double[2],
 849                       BUILT_IN_SCALBN, "scalbn", ATTR_CONST_NOTHROW_LEAF_LIST);
 850   gfc_define_builtin ("__builtin_scalbnf", mfunc_float[2],
 851                       BUILT_IN_SCALBNF, "scalbnf", ATTR_CONST_NOTHROW_LEAF_LIST);
 852
 853   gfc_define_builtin ("__builtin_fmaxl", mfunc_longdouble[1],
 854                       BUILT_IN_FMAXL, "fmaxl", ATTR_CONST_NOTHROW_LEAF_LIST);
 855   gfc_define_builtin ("__builtin_fmax", mfunc_double[1],
 856                       BUILT_IN_FMAX, "fmax", ATTR_CONST_NOTHROW_LEAF_LIST);
 857   gfc_define_builtin ("__builtin_fmaxf", mfunc_float[1],
 858                       BUILT_IN_FMAXF, "fmaxf", ATTR_CONST_NOTHROW_LEAF_LIST);
 859
 860   gfc_define_builtin ("__builtin_fminl", mfunc_longdouble[1],
 861                       BUILT_IN_FMINL, "fminl", ATTR_CONST_NOTHROW_LEAF_LIST);
 862   gfc_define_builtin ("__builtin_fmin", mfunc_double[1],
 863                       BUILT_IN_FMIN, "fmin", ATTR_CONST_NOTHROW_LEAF_LIST);
 864   gfc_define_builtin ("__builtin_fminf", mfunc_float[1],
 865                       BUILT_IN_FMINF, "fminf", ATTR_CONST_NOTHROW_LEAF_LIST);
 866
 867   gfc_define_builtin ("__builtin_fmodl", mfunc_longdouble[1],
 868                       BUILT_IN_FMODL, "fmodl", ATTR_CONST_NOTHROW_LEAF_LIST);
 869   gfc_define_builtin ("__builtin_fmod", mfunc_double[1],
 870                       BUILT_IN_FMOD, "fmod", ATTR_CONST_NOTHROW_LEAF_LIST);
 871   gfc_define_builtin ("__builtin_fmodf", mfunc_float[1],
 872                       BUILT_IN_FMODF, "fmodf", ATTR_CONST_NOTHROW_LEAF_LIST);
 873
 874   /* iround{f,,l}, lround{f,,l} and llround{f,,l} */
 875   ftype = build_function_type_list (integer_type_node,
 876                                     float_type_node, NULL_TREE);
 877   gfc_define_builtin("__builtin_iroundf", ftype, BUILT_IN_IROUNDF,
 878                      "iroundf", ATTR_CONST_NOTHROW_LEAF_LIST);
 879   ftype = build_function_type_list (long_integer_type_node,
 880                                     float_type_node, NULL_TREE);
 881   gfc_define_builtin ("__builtin_lroundf", ftype, BUILT_IN_LROUNDF,
 882                       "lroundf", ATTR_CONST_NOTHROW_LEAF_LIST);
 883   ftype = build_function_type_list (long_long_integer_type_node,
 884                                     float_type_node, NULL_TREE);
 885   gfc_define_builtin ("__builtin_llroundf", ftype, BUILT_IN_LLROUNDF,
 886                       "llroundf", ATTR_CONST_NOTHROW_LEAF_LIST);
 887
 888   ftype = build_function_type_list (integer_type_node,
 889                                     double_type_node, NULL_TREE);
 890   gfc_define_builtin("__builtin_iround", ftype, BUILT_IN_IROUND,
 891                      "iround", ATTR_CONST_NOTHROW_LEAF_LIST);
 892   ftype = build_function_type_list (long_integer_type_node,
 893                                     double_type_node, NULL_TREE);
 894   gfc_define_builtin ("__builtin_lround", ftype, BUILT_IN_LROUND,
 895                       "lround", ATTR_CONST_NOTHROW_LEAF_LIST);
 896   ftype = build_function_type_list (long_long_integer_type_node,
 897                                     double_type_node, NULL_TREE);
 898   gfc_define_builtin ("__builtin_llround", ftype, BUILT_IN_LLROUND,
 899                       "llround", ATTR_CONST_NOTHROW_LEAF_LIST);
 900
 901   ftype = build_function_type_list (integer_type_node,
 902                                     long_double_type_node, NULL_TREE);
 903   gfc_define_builtin("__builtin_iroundl", ftype, BUILT_IN_IROUNDL,
 904                      "iroundl", ATTR_CONST_NOTHROW_LEAF_LIST);
 905   ftype = build_function_type_list (long_integer_type_node,
 906                                     long_double_type_node, NULL_TREE);
 907   gfc_define_builtin ("__builtin_lroundl", ftype, BUILT_IN_LROUNDL,
 908                       "lroundl", ATTR_CONST_NOTHROW_LEAF_LIST);
 909   ftype = build_function_type_list (long_long_integer_type_node,
 910                                     long_double_type_node, NULL_TREE);
 911   gfc_define_builtin ("__builtin_llroundl", ftype, BUILT_IN_LLROUNDL,
 912                       "llroundl", ATTR_CONST_NOTHROW_LEAF_LIST);
 913
 914   /* These are used to implement the ** operator.  */
 915   gfc_define_builtin ("__builtin_powl", mfunc_longdouble[1],
 916                       BUILT_IN_POWL, "powl", ATTR_CONST_NOTHROW_LEAF_LIST);
 917   gfc_define_builtin ("__builtin_pow", mfunc_double[1],
 918                       BUILT_IN_POW, "pow", ATTR_CONST_NOTHROW_LEAF_LIST);
 919   gfc_define_builtin ("__builtin_powf", mfunc_float[1],
 920                       BUILT_IN_POWF, "powf", ATTR_CONST_NOTHROW_LEAF_LIST);
 921   gfc_define_builtin ("__builtin_cpowl", mfunc_clongdouble[1],
 922                       BUILT_IN_CPOWL, "cpowl", ATTR_CONST_NOTHROW_LEAF_LIST);
 923   gfc_define_builtin ("__builtin_cpow", mfunc_cdouble[1],
 924                       BUILT_IN_CPOW, "cpow", ATTR_CONST_NOTHROW_LEAF_LIST);
 925   gfc_define_builtin ("__builtin_cpowf", mfunc_cfloat[1],
 926                       BUILT_IN_CPOWF, "cpowf", ATTR_CONST_NOTHROW_LEAF_LIST);
 927   gfc_define_builtin ("__builtin_powil", mfunc_longdouble[2],
 928                       BUILT_IN_POWIL, "powil", ATTR_CONST_NOTHROW_LEAF_LIST);
 929   gfc_define_builtin ("__builtin_powi", mfunc_double[2],
 930                       BUILT_IN_POWI, "powi", ATTR_CONST_NOTHROW_LEAF_LIST);
 931   gfc_define_builtin ("__builtin_powif", mfunc_float[2],
 932                       BUILT_IN_POWIF, "powif", ATTR_CONST_NOTHROW_LEAF_LIST);
 933
 934
 935   if (targetm.libc_has_function (function_c99_math_complex, NULL_TREE))
 936     {
 937       gfc_define_builtin ("__builtin_cbrtl", mfunc_longdouble[0],
 938                           BUILT_IN_CBRTL, "cbrtl",
 939                           ATTR_CONST_NOTHROW_LEAF_LIST);
 940       gfc_define_builtin ("__builtin_cbrt", mfunc_double[0],
 941                           BUILT_IN_CBRT, "cbrt",
 942                           ATTR_CONST_NOTHROW_LEAF_LIST);
 943       gfc_define_builtin ("__builtin_cbrtf", mfunc_float[0],
 944                           BUILT_IN_CBRTF, "cbrtf",
 945                           ATTR_CONST_NOTHROW_LEAF_LIST);
 946       gfc_define_builtin ("__builtin_cexpil", func_longdouble_clongdouble,
 947                           BUILT_IN_CEXPIL, "cexpil",
 948                           ATTR_CONST_NOTHROW_LEAF_LIST);
 949       gfc_define_builtin ("__builtin_cexpi", func_double_cdouble,
 950                           BUILT_IN_CEXPI, "cexpi",
 951                           ATTR_CONST_NOTHROW_LEAF_LIST);
 952       gfc_define_builtin ("__builtin_cexpif", func_float_cfloat,
 953                           BUILT_IN_CEXPIF, "cexpif",
 954                           ATTR_CONST_NOTHROW_LEAF_LIST);
 955     }
 956
 957   if (targetm.libc_has_function (function_sincos, NULL_TREE))
 958     {
 959       gfc_define_builtin ("__builtin_sincosl",
 960                           func_longdouble_longdoublep_longdoublep,
 961                           BUILT_IN_SINCOSL, "sincosl", ATTR_NOTHROW_LEAF_LIST);
 962       gfc_define_builtin ("__builtin_sincos", func_double_doublep_doublep,
 963                           BUILT_IN_SINCOS, "sincos", ATTR_NOTHROW_LEAF_LIST);
 964       gfc_define_builtin ("__builtin_sincosf", func_float_floatp_floatp,
 965                           BUILT_IN_SINCOSF, "sincosf", ATTR_NOTHROW_LEAF_LIST);
 966     }
 967
 968   /* For LEADZ, TRAILZ, POPCNT and POPPAR.  */
 969   ftype = build_function_type_list (integer_type_node,
 970                                     unsigned_type_node, NULL_TREE);
 971   gfc_define_builtin ("__builtin_clz", ftype, BUILT_IN_CLZ,
 972                       "__builtin_clz", ATTR_CONST_NOTHROW_LEAF_LIST);
 973   gfc_define_builtin ("__builtin_ctz", ftype, BUILT_IN_CTZ,
 974                       "__builtin_ctz", ATTR_CONST_NOTHROW_LEAF_LIST);
 975   gfc_define_builtin ("__builtin_parity", ftype, BUILT_IN_PARITY,
 976                       "__builtin_parity", ATTR_CONST_NOTHROW_LEAF_LIST);
 977   gfc_define_builtin ("__builtin_popcount", ftype, BUILT_IN_POPCOUNT,
 978                       "__builtin_popcount", ATTR_CONST_NOTHROW_LEAF_LIST);
 979
 980   ftype = build_function_type_list (integer_type_node,
 981                                     long_unsigned_type_node, NULL_TREE);
 982   gfc_define_builtin ("__builtin_clzl", ftype, BUILT_IN_CLZL,
 983                       "__builtin_clzl", ATTR_CONST_NOTHROW_LEAF_LIST);
 984   gfc_define_builtin ("__builtin_ctzl", ftype, BUILT_IN_CTZL,
 985                       "__builtin_ctzl", ATTR_CONST_NOTHROW_LEAF_LIST);
 986   gfc_define_builtin ("__builtin_parityl", ftype, BUILT_IN_PARITYL,
 987                       "__builtin_parityl", ATTR_CONST_NOTHROW_LEAF_LIST);
 988   gfc_define_builtin ("__builtin_popcountl", ftype, BUILT_IN_POPCOUNTL,
 989                       "__builtin_popcountl", ATTR_CONST_NOTHROW_LEAF_LIST);
 990
 991   ftype = build_function_type_list (integer_type_node,
 992                                     long_long_unsigned_type_node, NULL_TREE);
 993   gfc_define_builtin ("__builtin_clzll", ftype, BUILT_IN_CLZLL,
 994                       "__builtin_clzll", ATTR_CONST_NOTHROW_LEAF_LIST);
 995   gfc_define_builtin ("__builtin_ctzll", ftype, BUILT_IN_CTZLL,
 996                       "__builtin_ctzll", ATTR_CONST_NOTHROW_LEAF_LIST);
 997   gfc_define_builtin ("__builtin_parityll", ftype, BUILT_IN_PARITYLL,
 998                       "__builtin_parityll", ATTR_CONST_NOTHROW_LEAF_LIST);
 999   gfc_define_builtin ("__builtin_popcountll", ftype, BUILT_IN_POPCOUNTLL,
1000                       "__builtin_popcountll", ATTR_CONST_NOTHROW_LEAF_LIST);
1001
1002   /* Other builtin functions we use.  */
1003
1004   ftype = build_function_type_list (long_integer_type_node,
1005                                     long_integer_type_node,
1006                                     long_integer_type_node, NULL_TREE);
1007   gfc_define_builtin ("__builtin_expect", ftype, BUILT_IN_EXPECT,
1008                       "__builtin_expect", ATTR_CONST_NOTHROW_LEAF_LIST);
1009
1010   ftype = build_function_type_list (void_type_node,
1011                                     pvoid_type_node, NULL_TREE);
1012   gfc_define_builtin ("__builtin_free", ftype, BUILT_IN_FREE,
1013                       "free", ATTR_NOTHROW_LEAF_LIST);
1014
1015   ftype = build_function_type_list (pvoid_type_node,
1016                                     size_type_node, NULL_TREE);
1017   gfc_define_builtin ("__builtin_malloc", ftype, BUILT_IN_MALLOC,
1018                       "malloc", ATTR_NOTHROW_LEAF_MALLOC_LIST);
1019
1020   ftype = build_function_type_list (pvoid_type_node, size_type_node,
1021                                     size_type_node, NULL_TREE);
1022   gfc_define_builtin ("__builtin_calloc", ftype, BUILT_IN_CALLOC,
1023                       "calloc", ATTR_NOTHROW_LEAF_MALLOC_LIST);
1024   DECL_IS_MALLOC (builtin_decl_explicit (BUILT_IN_CALLOC)) = 1;
1025
1026   ftype = build_function_type_list (pvoid_type_node, pvoid_type_node,
1027                                     size_type_node, NULL_TREE);
1028   gfc_define_builtin ("__builtin_realloc", ftype, BUILT_IN_REALLOC,
1029                       "realloc", ATTR_NOTHROW_LEAF_LIST);
1030
1031   /* Type-generic floating-point classification built-ins.  */
1032
1033   ftype = build_function_type (integer_type_node, NULL_TREE);
1034   gfc_define_builtin ("__builtin_isfinite", ftype, BUILT_IN_ISFINITE,
1035                       "__builtin_isfinite", ATTR_CONST_NOTHROW_LEAF_LIST);
1036   gfc_define_builtin ("__builtin_isinf", ftype, BUILT_IN_ISINF,
1037                       "__builtin_isinf", ATTR_CONST_NOTHROW_LEAF_LIST);
1038   gfc_define_builtin ("__builtin_isinf_sign", ftype, BUILT_IN_ISINF_SIGN,
1039                       "__builtin_isinf_sign", ATTR_CONST_NOTHROW_LEAF_LIST);
1040   gfc_define_builtin ("__builtin_isnan", ftype, BUILT_IN_ISNAN,
1041                       "__builtin_isnan", ATTR_CONST_NOTHROW_LEAF_LIST);
1042   gfc_define_builtin ("__builtin_isnormal", ftype, BUILT_IN_ISNORMAL,
1043                       "__builtin_isnormal", ATTR_CONST_NOTHROW_LEAF_LIST);
1044   gfc_define_builtin ("__builtin_issignaling", ftype, BUILT_IN_ISSIGNALING,
1045                       "__builtin_issignaling", ATTR_CONST_NOTHROW_LEAF_LIST);
1046   gfc_define_builtin ("__builtin_signbit", ftype, BUILT_IN_SIGNBIT,
1047                       "__builtin_signbit", ATTR_CONST_NOTHROW_LEAF_LIST);
1048   gfc_define_builtin ("__builtin_fpclassify", ftype, BUILT_IN_FPCLASSIFY,
1049                       "__builtin_fpclassify", ATTR_CONST_NOTHROW_LEAF_LIST);
1050
1051   gfc_define_builtin ("__builtin_isless", ftype, BUILT_IN_ISLESS,
1052                       "__builtin_isless", ATTR_CONST_NOTHROW_LEAF_LIST);
1053   gfc_define_builtin ("__builtin_islessequal", ftype, BUILT_IN_ISLESSEQUAL,
1054                       "__builtin_islessequal", ATTR_CONST_NOTHROW_LEAF_LIST);
1055   gfc_define_builtin ("__builtin_islessgreater", ftype, BUILT_IN_ISLESSGREATER,
1056                       "__builtin_islessgreater", ATTR_CONST_NOTHROW_LEAF_LIST);
1057   gfc_define_builtin ("__builtin_isgreater", ftype, BUILT_IN_ISGREATER,
1058                       "__builtin_isgreater", ATTR_CONST_NOTHROW_LEAF_LIST);
1059   gfc_define_builtin ("__builtin_isgreaterequal", ftype,
1060                       BUILT_IN_ISGREATEREQUAL, "__builtin_isgreaterequal",
1061                       ATTR_CONST_NOTHROW_LEAF_LIST);
1062   gfc_define_builtin ("__builtin_isunordered", ftype, BUILT_IN_ISUNORDERED,
1063                       "__builtin_isunordered", ATTR_CONST_NOTHROW_LEAF_LIST);
1064   gfc_define_builtin ("__builtin_iseqsig", ftype, BUILT_IN_ISEQSIG,
1065                       "__builtin_iseqsig", ATTR_CONST_NOTHROW_LEAF_LIST);
1066
1067
1068 #define DEF_PRIMITIVE_TYPE(ENUM, VALUE) \
1069   builtin_types[(int) ENUM] = VALUE;
1070 #define DEF_FUNCTION_TYPE_0(ENUM, RETURN)                       \
1071   builtin_types[(int) ENUM]                                     \
1072     = build_function_type_list (builtin_types[(int) RETURN],    \
1073                                 NULL_TREE);
1074 #define DEF_FUNCTION_TYPE_1(ENUM, RETURN, ARG1)                         \
1075   builtin_types[(int) ENUM]                                             \
1076     = build_function_type_list (builtin_types[(int) RETURN],            \
1077                                 builtin_types[(int) ARG1],              \
1078                                 NULL_TREE);
1079 #define DEF_FUNCTION_TYPE_2(ENUM, RETURN, ARG1, ARG2)           \
1080   builtin_types[(int) ENUM]                                     \
1081     = build_function_type_list (builtin_types[(int) RETURN],    \
1082                                 builtin_types[(int) ARG1],      \
1083                                 builtin_types[(int) ARG2],      \
1084                                 NULL_TREE);
1085 #define DEF_FUNCTION_TYPE_3(ENUM, RETURN, ARG1, ARG2, ARG3)             \
1086   builtin_types[(int) ENUM]                                             \
1087     = build_function_type_list (builtin_types[(int) RETURN],            \
1088                                 builtin_types[(int) ARG1],              \
1089                                 builtin_types[(int) ARG2],              \
1090                                 builtin_types[(int) ARG3],              \
1091                                 NULL_TREE);
1092 #define DEF_FUNCTION_TYPE_4(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4)       \
1093   builtin_types[(int) ENUM]                                             \
1094     = build_function_type_list (builtin_types[(int) RETURN],            \
1095                                 builtin_types[(int) ARG1],              \
1096                                 builtin_types[(int) ARG2],              \
1097                                 builtin_types[(int) ARG3],              \
1098                                 builtin_types[(int) ARG4],              \
1099                                 NULL_TREE);
1100 #define DEF_FUNCTION_TYPE_5(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5) \
1101   builtin_types[(int) ENUM]                                             \
1102     = build_function_type_list (builtin_types[(int) RETURN],            \
1103                                 builtin_types[(int) ARG1],              \
1104                                 builtin_types[(int) ARG2],              \
1105                                 builtin_types[(int) ARG3],              \
1106                                 builtin_types[(int) ARG4],              \
1107                                 builtin_types[(int) ARG5],              \
1108                                 NULL_TREE);
1109 #define DEF_FUNCTION_TYPE_6(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
1110                             ARG6)                                       \
1111   builtin_types[(int) ENUM]                                             \
1112     = build_function_type_list (builtin_types[(int) RETURN],            \
1113                                 builtin_types[(int) ARG1],              \
1114                                 builtin_types[(int) ARG2],              \
1115                                 builtin_types[(int) ARG3],              \
1116                                 builtin_types[(int) ARG4],              \
1117                                 builtin_types[(int) ARG5],              \
1118                                 builtin_types[(int) ARG6],              \
1119                                 NULL_TREE);
1120 #define DEF_FUNCTION_TYPE_7(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
1121                             ARG6, ARG7)                                 \
1122   builtin_types[(int) ENUM]                                             \
1123     = build_function_type_list (builtin_types[(int) RETURN],            \
1124                                 builtin_types[(int) ARG1],              \
1125                                 builtin_types[(int) ARG2],              \
1126                                 builtin_types[(int) ARG3],              \
1127                                 builtin_types[(int) ARG4],              \
1128                                 builtin_types[(int) ARG5],              \
1129                                 builtin_types[(int) ARG6],              \
1130                                 builtin_types[(int) ARG7],              \
1131                                 NULL_TREE);
1132 #define DEF_FUNCTION_TYPE_8(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
1133                             ARG6, ARG7, ARG8)                           \
1134   builtin_types[(int) ENUM]                                             \
1135     = build_function_type_list (builtin_types[(int) RETURN],            \
1136                                 builtin_types[(int) ARG1],              \
1137                                 builtin_types[(int) ARG2],              \
1138                                 builtin_types[(int) ARG3],              \
1139                                 builtin_types[(int) ARG4],              \
1140                                 builtin_types[(int) ARG5],              \
1141                                 builtin_types[(int) ARG6],              \
1142                                 builtin_types[(int) ARG7],              \
1143                                 builtin_types[(int) ARG8],              \
1144                                 NULL_TREE);
1145 #define DEF_FUNCTION_TYPE_9(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
1146                             ARG6, ARG7, ARG8, ARG9)                     \
1147   builtin_types[(int) ENUM]                                             \
1148     = build_function_type_list (builtin_types[(int) RETURN],            \
1149                                 builtin_types[(int) ARG1],              \
1150                                 builtin_types[(int) ARG2],              \
1151                                 builtin_types[(int) ARG3],              \
1152                                 builtin_types[(int) ARG4],              \
1153                                 builtin_types[(int) ARG5],              \
1154                                 builtin_types[(int) ARG6],              \
1155                                 builtin_types[(int) ARG7],              \
1156                                 builtin_types[(int) ARG8],              \
1157                                 builtin_types[(int) ARG9],              \
1158                                 NULL_TREE);
1159 #define DEF_FUNCTION_TYPE_10(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4,      \
1160                              ARG5, ARG6, ARG7, ARG8, ARG9, ARG10)       \
1161   builtin_types[(int) ENUM]                                             \
1162     = build_function_type_list (builtin_types[(int) RETURN],            \
1163                                 builtin_types[(int) ARG1],              \
1164                                 builtin_types[(int) ARG2],              \
1165                                 builtin_types[(int) ARG3],              \
1166                                 builtin_types[(int) ARG4],              \
1167                                 builtin_types[(int) ARG5],              \
1168                                 builtin_types[(int) ARG6],              \
1169                                 builtin_types[(int) ARG7],              \
1170                                 builtin_types[(int) ARG8],              \
1171                                 builtin_types[(int) ARG9],              \
1172                                 builtin_types[(int) ARG10],             \
1173                                 NULL_TREE);
1174 #define DEF_FUNCTION_TYPE_11(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4,      \
1175                              ARG5, ARG6, ARG7, ARG8, ARG9, ARG10, ARG11)\
1176   builtin_types[(int) ENUM]                                             \
1177     = build_function_type_list (builtin_types[(int) RETURN],            \
1178                                 builtin_types[(int) ARG1],              \
1179                                 builtin_types[(int) ARG2],              \
1180                                 builtin_types[(int) ARG3],              \
1181                                 builtin_types[(int) ARG4],              \
1182                                 builtin_types[(int) ARG5],              \
1183                                 builtin_types[(int) ARG6],              \
1184                                 builtin_types[(int) ARG7],              \
1185                                 builtin_types[(int) ARG8],              \
1186                                 builtin_types[(int) ARG9],              \
1187                                 builtin_types[(int) ARG10],             \
1188                                 builtin_types[(int) ARG11],             \
1189                                 NULL_TREE);
1190 #define DEF_FUNCTION_TYPE_VAR_0(ENUM, RETURN)                           \
1191   builtin_types[(int) ENUM]                                             \
1192     = build_varargs_function_type_list (builtin_types[(int) RETURN],    \
1193                                         NULL_TREE);
1194 #define DEF_FUNCTION_TYPE_VAR_1(ENUM, RETURN, ARG1)                     \
1195   builtin_types[(int) ENUM]                                             \
1196     = build_varargs_function_type_list (builtin_types[(int) RETURN],    \
1197                                         builtin_types[(int) ARG1],      \
1198                                         NULL_TREE);
1199 #define DEF_FUNCTION_TYPE_VAR_2(ENUM, RETURN, ARG1, ARG2)               \
1200   builtin_types[(int) ENUM]                                             \
1201     = build_varargs_function_type_list (builtin_types[(int) RETURN],    \
1202                                         builtin_types[(int) ARG1],      \
1203                                         builtin_types[(int) ARG2],      \
1204                                         NULL_TREE);
1205 #define DEF_FUNCTION_TYPE_VAR_6(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
1206                                 ARG6)   \
1207   builtin_types[(int) ENUM]                                             \
1208     = build_varargs_function_type_list (builtin_types[(int) RETURN],    \
1209                                         builtin_types[(int) ARG1],      \
1210                                         builtin_types[(int) ARG2],      \
1211                                         builtin_types[(int) ARG3],      \
1212                                         builtin_types[(int) ARG4],      \
1213                                         builtin_types[(int) ARG5],      \
1214                                         builtin_types[(int) ARG6],      \
1215                                         NULL_TREE);
1216 #define DEF_FUNCTION_TYPE_VAR_7(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
1217                                 ARG6, ARG7)                             \
1218   builtin_types[(int) ENUM]                                             \
1219     = build_varargs_function_type_list (builtin_types[(int) RETURN],    \
1220                                         builtin_types[(int) ARG1],      \
1221                                         builtin_types[(int) ARG2],      \
1222                                         builtin_types[(int) ARG3],      \
1223                                         builtin_types[(int) ARG4],      \
1224                                         builtin_types[(int) ARG5],      \
1225                                         builtin_types[(int) ARG6],      \
1226                                         builtin_types[(int) ARG7],      \
1227                                         NULL_TREE);
1228 #define DEF_POINTER_TYPE(ENUM, TYPE)                    \
1229   builtin_types[(int) ENUM]                             \
1230     = build_pointer_type (builtin_types[(int) TYPE]);
1231 #include "types.def"
1232 #undef DEF_PRIMITIVE_TYPE
1233 #undef DEF_FUNCTION_TYPE_0
1234 #undef DEF_FUNCTION_TYPE_1
1235 #undef DEF_FUNCTION_TYPE_2
1236 #undef DEF_FUNCTION_TYPE_3
1237 #undef DEF_FUNCTION_TYPE_4
1238 #undef DEF_FUNCTION_TYPE_5
1239 #undef DEF_FUNCTION_TYPE_6
1240 #undef DEF_FUNCTION_TYPE_7
1241 #undef DEF_FUNCTION_TYPE_8
1242 #undef DEF_FUNCTION_TYPE_10
1243 #undef DEF_FUNCTION_TYPE_VAR_0
1244 #undef DEF_FUNCTION_TYPE_VAR_1
1245 #undef DEF_FUNCTION_TYPE_VAR_2
1246 #undef DEF_FUNCTION_TYPE_VAR_6
1247 #undef DEF_FUNCTION_TYPE_VAR_7
1248 #undef DEF_POINTER_TYPE
1249   builtin_types[(int) BT_LAST] = NULL_TREE;
1250
1251   /* Initialize synchronization builtins.  */
1252 #undef DEF_SYNC_BUILTIN
1253 #define DEF_SYNC_BUILTIN(code, name, type, attr) \
1254     gfc_define_builtin (name, builtin_types[type], code, name, \
1255                         attr);
1256 #include "../sync-builtins.def"
1257 #undef DEF_SYNC_BUILTIN
1258
1259   if (flag_openacc)
1260     {
1261 #undef DEF_GOACC_BUILTIN
1262 #define DEF_GOACC_BUILTIN(code, name, type, attr) \
1263       gfc_define_builtin ("__builtin_" name, builtin_types[type], \
1264                           code, name, attr);
1265 #undef DEF_GOACC_BUILTIN_COMPILER
1266 #define DEF_GOACC_BUILTIN_COMPILER(code, name, type, attr) \
1267       gfc_define_builtin (name, builtin_types[type], code, name, attr);
1268 #undef DEF_GOACC_BUILTIN_ONLY
1269 #define DEF_GOACC_BUILTIN_ONLY(code, name, type, attr) \
1270       gfc_define_builtin ("__builtin_" name, builtin_types[type], code, NULL, \
1271                           attr);
1272 #undef DEF_GOMP_BUILTIN
1273 #define DEF_GOMP_BUILTIN(code, name, type, attr) /* ignore */
1274 #undef DEF_GOMP_BUILTIN_COMPILER
1275 #define DEF_GOMP_BUILTIN_COMPILER(code, name, type, attr) /* ignore */
1276 #include "../omp-builtins.def"
1277 #undef DEF_GOACC_BUILTIN
1278 #undef DEF_GOACC_BUILTIN_COMPILER
1279 #undef DEF_GOMP_BUILTIN
1280 #undef DEF_GOMP_BUILTIN_COMPILER
1281     }
1282
1283   if (flag_openmp || flag_openmp_simd || flag_tree_parallelize_loops)
1284     {
1285 #undef DEF_GOACC_BUILTIN
1286 #define DEF_GOACC_BUILTIN(code, name, type, attr) /* ignore */
1287 #undef DEF_GOACC_BUILTIN_COMPILER
1288 #define DEF_GOACC_BUILTIN_COMPILER(code, name, type, attr)  /* ignore */
1289 #undef DEF_GOMP_BUILTIN
1290 #define DEF_GOMP_BUILTIN(code, name, type, attr) \
1291       gfc_define_builtin ("__builtin_" name, builtin_types[type], \
1292                           code, name, attr);
1293 #undef DEF_GOMP_BUILTIN_COMPILER
1294 #define DEF_GOMP_BUILTIN_COMPILER(code, name, type, attr) \
1295       if (flag_openmp) \
1296         gfc_define_builtin ("__builtin_" name, builtin_types[type], \
1297                               code, name, attr);
1298 #include "../omp-builtins.def"
1299 #undef DEF_GOACC_BUILTIN
1300 #undef DEF_GOACC_BUILTIN_COMPILER
1301 #undef DEF_GOMP_BUILTIN
1302 #undef DEF_GOMP_BUILTIN_COMPILER
1303       tree gomp_alloc = builtin_decl_explicit (BUILT_IN_GOMP_ALLOC);
1304       tree two = build_int_cst (integer_type_node, 2);
1305       DECL_ATTRIBUTES (gomp_alloc)
1306         = tree_cons (get_identifier ("warn_unused_result"), NULL_TREE,
1307                      tree_cons (get_identifier ("alloc_size"),
1308                                 build_tree_list (NULL_TREE, two),
1309                                 DECL_ATTRIBUTES (gomp_alloc)));
1310     }
1311
1312   gfc_define_builtin ("__builtin_trap", builtin_types[BT_FN_VOID],
1313                       BUILT_IN_TRAP, NULL, ATTR_NOTHROW_LEAF_LIST);
1314   TREE_THIS_VOLATILE (builtin_decl_explicit (BUILT_IN_TRAP)) = 1;
1315
1316   ftype = build_varargs_function_type_list (ptr_type_node, const_ptr_type_node,
1317                                             size_type_node, NULL_TREE);
1318   gfc_define_builtin ("__builtin_assume_aligned", ftype,
1319                       BUILT_IN_ASSUME_ALIGNED,
1320                       "__builtin_assume_aligned",
1321                       ATTR_CONST_NOTHROW_LEAF_LIST);
1322
1323   ftype = build_function_type_list (long_double_type_node, long_double_type_node,
1324                                     long_double_type_node, long_double_type_node,
1325                                     NULL_TREE);
1326   gfc_define_builtin ("__builtin_fmal", ftype, BUILT_IN_FMAL,
1327                       "fmal", ATTR_CONST_NOTHROW_LEAF_LIST);
1328   ftype = build_function_type_list (double_type_node, double_type_node,
1329                                     double_type_node, double_type_node,
1330                                     NULL_TREE);
1331   gfc_define_builtin ("__builtin_fma", ftype, BUILT_IN_FMA,
1332                       "fma", ATTR_CONST_NOTHROW_LEAF_LIST);
1333   ftype = build_function_type_list (float_type_node, float_type_node,
1334                                     float_type_node, float_type_node,
1335                                     NULL_TREE);
1336   gfc_define_builtin ("__builtin_fmaf", ftype, BUILT_IN_FMAF,
1337                       "fmaf", ATTR_CONST_NOTHROW_LEAF_LIST);
1338
1339   gfc_define_builtin ("__emutls_get_address",
1340                       builtin_types[BT_FN_PTR_PTR],
1341                       BUILT_IN_EMUTLS_GET_ADDRESS,
1342                       "__emutls_get_address", ATTR_CONST_NOTHROW_LEAF_LIST);
1343   gfc_define_builtin ("__emutls_register_common",
1344                       builtin_types[BT_FN_VOID_PTR_WORD_WORD_PTR],
1345                       BUILT_IN_EMUTLS_REGISTER_COMMON,
1346                       "__emutls_register_common", ATTR_NOTHROW_LEAF_LIST);
1347
1348   build_common_builtin_nodes ();
1349   targetm.init_builtins ();
1350 }
1351
1352 #undef DEFINE_MATH_BUILTIN_C
1353 #undef DEFINE_MATH_BUILTIN
1354
1355 static void
1356 gfc_init_ts (void)
1357 {
1358   tree_contains_struct[NAMESPACE_DECL][TS_DECL_NON_COMMON] = 1;
1359   tree_contains_struct[NAMESPACE_DECL][TS_DECL_WITH_VIS] = 1;
1360   tree_contains_struct[NAMESPACE_DECL][TS_DECL_WRTL] = 1;
1361   tree_contains_struct[NAMESPACE_DECL][TS_DECL_COMMON] = 1;
1362   tree_contains_struct[NAMESPACE_DECL][TS_DECL_MINIMAL] = 1;
1363 }
1364
1365 void
1366 gfc_maybe_initialize_eh (void)
1367 {
1368   if (!flag_exceptions || gfc_eh_initialized_p)
1369     return;
1370
1371   gfc_eh_initialized_p = true;
1372   using_eh_for_cleanups ();
1373 }
1374
1375
1376 #include "gt-fortran-f95-lang.h"
1377 #include "gtype-fortran.h"