gcc/fortran/f95-lang.c

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