gcc/fortran/f95-lang.c

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