gcc/fortran/f95-lang.c

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