gcc/fortran/f95-lang.cc

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