gcc/fortran/f95-lang.c

   1 /* gfortran backend interface
   2    Copyright (C) 2000-2015 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). Also, we
 495      want double_type_node to actually have double precision.  */
 496   build_common_tree_nodes (false, false);
 497
 498   void_list_node = build_tree_list (NULL_TREE, void_type_node);
 499
 500   /* Set up F95 type nodes.  */
 501   gfc_init_kinds ();
 502   gfc_init_types ();
 503   gfc_init_c_interop_kinds ();
 504 }
 505
 506
 507 /* Return the typed-based alias set for T, which may be an expression
 508    or a type.  Return -1 if we don't do anything special.  */
 509
 510 static alias_set_type
 511 gfc_get_alias_set (tree t)
 512 {
 513   tree u;
 514
 515   /* Permit type-punning when accessing an EQUIVALENCEd variable or
 516      mixed type entry master's return value.  */
 517   for (u = t; handled_component_p (u); u = TREE_OPERAND (u, 0))
 518     if (TREE_CODE (u) == COMPONENT_REF
 519         && TREE_CODE (TREE_TYPE (TREE_OPERAND (u, 0))) == UNION_TYPE)
 520       return 0;
 521
 522   return -1;
 523 }
 524
 525 /* Builtin function initialization.  */
 526
 527 static tree
 528 gfc_builtin_function (tree decl)
 529 {
 530   pushdecl (decl);
 531   return decl;
 532 }
 533
 534 /* So far we need just these 7 attribute types.  */
 535 #define ATTR_NULL                       0
 536 #define ATTR_LEAF_LIST                  (ECF_LEAF)
 537 #define ATTR_NOTHROW_LEAF_LIST          (ECF_NOTHROW | ECF_LEAF)
 538 #define ATTR_NOTHROW_LEAF_MALLOC_LIST   (ECF_NOTHROW | ECF_LEAF | ECF_MALLOC)
 539 #define ATTR_CONST_NOTHROW_LEAF_LIST    (ECF_NOTHROW | ECF_LEAF | ECF_CONST)
 540 #define ATTR_PURE_NOTHROW_LEAF_LIST     (ECF_NOTHROW | ECF_LEAF | ECF_PURE)
 541 #define ATTR_NOTHROW_LIST               (ECF_NOTHROW)
 542 #define ATTR_CONST_NOTHROW_LIST         (ECF_NOTHROW | ECF_CONST)
 543
 544 static void
 545 gfc_define_builtin (const char *name, tree type, enum built_in_function code,
 546                     const char *library_name, int attr)
 547 {
 548   tree decl;
 549
 550   decl = add_builtin_function (name, type, code, BUILT_IN_NORMAL,
 551                                library_name, NULL_TREE);
 552   set_call_expr_flags (decl, attr);
 553
 554   set_builtin_decl (code, decl, true);
 555 }
 556
 557
 558 #define DO_DEFINE_MATH_BUILTIN(code, name, argtype, tbase) \
 559     gfc_define_builtin ("__builtin_" name "l", tbase##longdouble[argtype], \
 560                         BUILT_IN_ ## code ## L, name "l", \
 561                         ATTR_CONST_NOTHROW_LEAF_LIST); \
 562     gfc_define_builtin ("__builtin_" name, tbase##double[argtype], \
 563                         BUILT_IN_ ## code, name, \
 564                         ATTR_CONST_NOTHROW_LEAF_LIST); \
 565     gfc_define_builtin ("__builtin_" name "f", tbase##float[argtype], \
 566                         BUILT_IN_ ## code ## F, name "f", \
 567                         ATTR_CONST_NOTHROW_LEAF_LIST);
 568
 569 #define DEFINE_MATH_BUILTIN(code, name, argtype) \
 570     DO_DEFINE_MATH_BUILTIN (code, name, argtype, mfunc_)
 571
 572 #define DEFINE_MATH_BUILTIN_C(code, name, argtype) \
 573     DO_DEFINE_MATH_BUILTIN (code, name, argtype, mfunc_) \
 574     DO_DEFINE_MATH_BUILTIN (C##code, "c" name, argtype, mfunc_c)
 575
 576
 577 /* Create function types for builtin functions.  */
 578
 579 static void
 580 build_builtin_fntypes (tree *fntype, tree type)
 581 {
 582   /* type (*) (type) */
 583   fntype[0] = build_function_type_list (type, type, NULL_TREE);
 584   /* type (*) (type, type) */
 585   fntype[1] = build_function_type_list (type, type, type, NULL_TREE);
 586   /* type (*) (type, int) */
 587   fntype[2] = build_function_type_list (type,
 588                                         type, integer_type_node, NULL_TREE);
 589   /* type (*) (void) */
 590   fntype[3] = build_function_type_list (type, NULL_TREE);
 591   /* type (*) (type, &int) */
 592   fntype[4] = build_function_type_list (type, type,
 593                                         build_pointer_type (integer_type_node),
 594                                         NULL_TREE);
 595   /* type (*) (int, type) */
 596   fntype[5] = build_function_type_list (type,
 597                                         integer_type_node, type, NULL_TREE);
 598 }
 599
 600
 601 static tree
 602 builtin_type_for_size (int size, bool unsignedp)
 603 {
 604   tree type = gfc_type_for_size (size, unsignedp);
 605   return type ? type : error_mark_node;
 606 }
 607
 608 /* Initialization of builtin function nodes.  */
 609
 610 static void
 611 gfc_init_builtin_functions (void)
 612 {
 613   enum builtin_type
 614   {
 615 #define DEF_PRIMITIVE_TYPE(NAME, VALUE) NAME,
 616 #define DEF_FUNCTION_TYPE_0(NAME, RETURN) NAME,
 617 #define DEF_FUNCTION_TYPE_1(NAME, RETURN, ARG1) NAME,
 618 #define DEF_FUNCTION_TYPE_2(NAME, RETURN, ARG1, ARG2) NAME,
 619 #define DEF_FUNCTION_TYPE_3(NAME, RETURN, ARG1, ARG2, ARG3) NAME,
 620 #define DEF_FUNCTION_TYPE_4(NAME, RETURN, ARG1, ARG2, ARG3, ARG4) NAME,
 621 #define DEF_FUNCTION_TYPE_5(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5) NAME,
 622 #define DEF_FUNCTION_TYPE_6(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
 623                             ARG6) NAME,
 624 #define DEF_FUNCTION_TYPE_7(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
 625                             ARG6, ARG7) NAME,
 626 #define DEF_FUNCTION_TYPE_8(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
 627                             ARG6, ARG7, ARG8) NAME,
 628 #define DEF_FUNCTION_TYPE_9(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
 629                             ARG6, ARG7, ARG8, ARG9) NAME,
 630 #define DEF_FUNCTION_TYPE_10(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
 631                              ARG6, ARG7, ARG8, ARG9, ARG10) NAME,
 632 #define DEF_FUNCTION_TYPE_11(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
 633                              ARG6, ARG7, ARG8, ARG9, ARG10, ARG11) NAME,
 634 #define DEF_FUNCTION_TYPE_VAR_0(NAME, RETURN) NAME,
 635 #define DEF_FUNCTION_TYPE_VAR_1(NAME, RETURN, ARG1) NAME,
 636 #define DEF_FUNCTION_TYPE_VAR_2(NAME, RETURN, ARG1, ARG2) NAME,
 637 #define DEF_FUNCTION_TYPE_VAR_6(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
 638                                  ARG6) NAME,
 639 #define DEF_FUNCTION_TYPE_VAR_7(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
 640                                 ARG6, ARG7) NAME,
 641 #define DEF_POINTER_TYPE(NAME, TYPE) NAME,
 642 #include "types.def"
 643 #undef DEF_PRIMITIVE_TYPE
 644 #undef DEF_FUNCTION_TYPE_0
 645 #undef DEF_FUNCTION_TYPE_1
 646 #undef DEF_FUNCTION_TYPE_2
 647 #undef DEF_FUNCTION_TYPE_3
 648 #undef DEF_FUNCTION_TYPE_4
 649 #undef DEF_FUNCTION_TYPE_5
 650 #undef DEF_FUNCTION_TYPE_6
 651 #undef DEF_FUNCTION_TYPE_7
 652 #undef DEF_FUNCTION_TYPE_8
 653 #undef DEF_FUNCTION_TYPE_9
 654 #undef DEF_FUNCTION_TYPE_10
 655 #undef DEF_FUNCTION_TYPE_11
 656 #undef DEF_FUNCTION_TYPE_VAR_0
 657 #undef DEF_FUNCTION_TYPE_VAR_1
 658 #undef DEF_FUNCTION_TYPE_VAR_2
 659 #undef DEF_FUNCTION_TYPE_VAR_6
 660 #undef DEF_FUNCTION_TYPE_VAR_7
 661 #undef DEF_POINTER_TYPE
 662     BT_LAST
 663   };
 664
 665   tree mfunc_float[6];
 666   tree mfunc_double[6];
 667   tree mfunc_longdouble[6];
 668   tree mfunc_cfloat[6];
 669   tree mfunc_cdouble[6];
 670   tree mfunc_clongdouble[6];
 671   tree func_cfloat_float, func_float_cfloat;
 672   tree func_cdouble_double, func_double_cdouble;
 673   tree func_clongdouble_longdouble, func_longdouble_clongdouble;
 674   tree func_float_floatp_floatp;
 675   tree func_double_doublep_doublep;
 676   tree func_longdouble_longdoublep_longdoublep;
 677   tree ftype, ptype;
 678   tree builtin_types[(int) BT_LAST + 1];
 679
 680   int attr;
 681
 682   build_builtin_fntypes (mfunc_float, float_type_node);
 683   build_builtin_fntypes (mfunc_double, double_type_node);
 684   build_builtin_fntypes (mfunc_longdouble, long_double_type_node);
 685   build_builtin_fntypes (mfunc_cfloat, complex_float_type_node);
 686   build_builtin_fntypes (mfunc_cdouble, complex_double_type_node);
 687   build_builtin_fntypes (mfunc_clongdouble, complex_long_double_type_node);
 688
 689   func_cfloat_float = build_function_type_list (float_type_node,
 690                                                 complex_float_type_node,
 691                                                 NULL_TREE);
 692
 693   func_float_cfloat = build_function_type_list (complex_float_type_node,
 694                                                 float_type_node, NULL_TREE);
 695
 696   func_cdouble_double = build_function_type_list (double_type_node,
 697                                                   complex_double_type_node,
 698                                                   NULL_TREE);
 699
 700   func_double_cdouble = build_function_type_list (complex_double_type_node,
 701                                                   double_type_node, NULL_TREE);
 702
 703   func_clongdouble_longdouble =
 704     build_function_type_list (long_double_type_node,
 705                               complex_long_double_type_node, NULL_TREE);
 706
 707   func_longdouble_clongdouble =
 708     build_function_type_list (complex_long_double_type_node,
 709                               long_double_type_node, NULL_TREE);
 710
 711   ptype = build_pointer_type (float_type_node);
 712   func_float_floatp_floatp =
 713     build_function_type_list (void_type_node, ptype, ptype, NULL_TREE);
 714
 715   ptype = build_pointer_type (double_type_node);
 716   func_double_doublep_doublep =
 717     build_function_type_list (void_type_node, ptype, ptype, NULL_TREE);
 718
 719   ptype = build_pointer_type (long_double_type_node);
 720   func_longdouble_longdoublep_longdoublep =
 721     build_function_type_list (void_type_node, ptype, ptype, NULL_TREE);
 722
 723 /* Non-math builtins are defined manually, so they're not included here.  */
 724 #define OTHER_BUILTIN(ID,NAME,TYPE,CONST)
 725
 726 #include "mathbuiltins.def"
 727
 728   gfc_define_builtin ("__builtin_roundl", mfunc_longdouble[0],
 729                       BUILT_IN_ROUNDL, "roundl", ATTR_CONST_NOTHROW_LEAF_LIST);
 730   gfc_define_builtin ("__builtin_round", mfunc_double[0],
 731                       BUILT_IN_ROUND, "round", ATTR_CONST_NOTHROW_LEAF_LIST);
 732   gfc_define_builtin ("__builtin_roundf", mfunc_float[0],
 733                       BUILT_IN_ROUNDF, "roundf", ATTR_CONST_NOTHROW_LEAF_LIST);
 734
 735   gfc_define_builtin ("__builtin_truncl", mfunc_longdouble[0],
 736                       BUILT_IN_TRUNCL, "truncl", ATTR_CONST_NOTHROW_LEAF_LIST);
 737   gfc_define_builtin ("__builtin_trunc", mfunc_double[0],
 738                       BUILT_IN_TRUNC, "trunc", ATTR_CONST_NOTHROW_LEAF_LIST);
 739   gfc_define_builtin ("__builtin_truncf", mfunc_float[0],
 740                       BUILT_IN_TRUNCF, "truncf", ATTR_CONST_NOTHROW_LEAF_LIST);
 741
 742   gfc_define_builtin ("__builtin_cabsl", func_clongdouble_longdouble,
 743                       BUILT_IN_CABSL, "cabsl", ATTR_CONST_NOTHROW_LEAF_LIST);
 744   gfc_define_builtin ("__builtin_cabs", func_cdouble_double,
 745                       BUILT_IN_CABS, "cabs", ATTR_CONST_NOTHROW_LEAF_LIST);
 746   gfc_define_builtin ("__builtin_cabsf", func_cfloat_float,
 747                       BUILT_IN_CABSF, "cabsf", ATTR_CONST_NOTHROW_LEAF_LIST);
 748
 749   gfc_define_builtin ("__builtin_copysignl", mfunc_longdouble[1],
 750                       BUILT_IN_COPYSIGNL, "copysignl",
 751                       ATTR_CONST_NOTHROW_LEAF_LIST);
 752   gfc_define_builtin ("__builtin_copysign", mfunc_double[1],
 753                       BUILT_IN_COPYSIGN, "copysign",
 754                       ATTR_CONST_NOTHROW_LEAF_LIST);
 755   gfc_define_builtin ("__builtin_copysignf", mfunc_float[1],
 756                       BUILT_IN_COPYSIGNF, "copysignf",
 757                       ATTR_CONST_NOTHROW_LEAF_LIST);
 758
 759   gfc_define_builtin ("__builtin_nextafterl", mfunc_longdouble[1],
 760                       BUILT_IN_NEXTAFTERL, "nextafterl",
 761                       ATTR_CONST_NOTHROW_LEAF_LIST);
 762   gfc_define_builtin ("__builtin_nextafter", mfunc_double[1],
 763                       BUILT_IN_NEXTAFTER, "nextafter",
 764                       ATTR_CONST_NOTHROW_LEAF_LIST);
 765   gfc_define_builtin ("__builtin_nextafterf", mfunc_float[1],
 766                       BUILT_IN_NEXTAFTERF, "nextafterf",
 767                       ATTR_CONST_NOTHROW_LEAF_LIST);
 768
 769   /* Some built-ins depend on rounding mode. Depending on compilation options, they
 770      will be "pure" or "const".  */
 771   attr = flag_rounding_math ? ATTR_PURE_NOTHROW_LEAF_LIST : ATTR_CONST_NOTHROW_LEAF_LIST;
 772
 773   gfc_define_builtin ("__builtin_rintl", mfunc_longdouble[0],
 774                       BUILT_IN_RINTL, "rintl", attr);
 775   gfc_define_builtin ("__builtin_rint", mfunc_double[0],
 776                       BUILT_IN_RINT, "rint", attr);
 777   gfc_define_builtin ("__builtin_rintf", mfunc_float[0],
 778                       BUILT_IN_RINTF, "rintf", attr);
 779
 780   gfc_define_builtin ("__builtin_remainderl", mfunc_longdouble[1],
 781                       BUILT_IN_REMAINDERL, "remainderl", attr);
 782   gfc_define_builtin ("__builtin_remainder", mfunc_double[1],
 783                       BUILT_IN_REMAINDER, "remainder", attr);
 784   gfc_define_builtin ("__builtin_remainderf", mfunc_float[1],
 785                       BUILT_IN_REMAINDERF, "remainderf", attr);
 786
 787   gfc_define_builtin ("__builtin_logbl", mfunc_longdouble[0],
 788                       BUILT_IN_LOGBL, "logbl", ATTR_CONST_NOTHROW_LEAF_LIST);
 789   gfc_define_builtin ("__builtin_logb", mfunc_double[0],
 790                       BUILT_IN_LOGB, "logb", ATTR_CONST_NOTHROW_LEAF_LIST);
 791   gfc_define_builtin ("__builtin_logbf", mfunc_float[0],
 792                       BUILT_IN_LOGBF, "logbf", ATTR_CONST_NOTHROW_LEAF_LIST);
 793
 794
 795   gfc_define_builtin ("__builtin_frexpl", mfunc_longdouble[4],
 796                       BUILT_IN_FREXPL, "frexpl", ATTR_NOTHROW_LEAF_LIST);
 797   gfc_define_builtin ("__builtin_frexp", mfunc_double[4],
 798                       BUILT_IN_FREXP, "frexp", ATTR_NOTHROW_LEAF_LIST);
 799   gfc_define_builtin ("__builtin_frexpf", mfunc_float[4],
 800                       BUILT_IN_FREXPF, "frexpf", ATTR_NOTHROW_LEAF_LIST);
 801
 802   gfc_define_builtin ("__builtin_fabsl", mfunc_longdouble[0],
 803                       BUILT_IN_FABSL, "fabsl", ATTR_CONST_NOTHROW_LEAF_LIST);
 804   gfc_define_builtin ("__builtin_fabs", mfunc_double[0],
 805                       BUILT_IN_FABS, "fabs", ATTR_CONST_NOTHROW_LEAF_LIST);
 806   gfc_define_builtin ("__builtin_fabsf", mfunc_float[0],
 807                       BUILT_IN_FABSF, "fabsf", ATTR_CONST_NOTHROW_LEAF_LIST);
 808
 809   gfc_define_builtin ("__builtin_scalbnl", mfunc_longdouble[2],
 810                       BUILT_IN_SCALBNL, "scalbnl", ATTR_CONST_NOTHROW_LEAF_LIST);
 811   gfc_define_builtin ("__builtin_scalbn", mfunc_double[2],
 812                       BUILT_IN_SCALBN, "scalbn", ATTR_CONST_NOTHROW_LEAF_LIST);
 813   gfc_define_builtin ("__builtin_scalbnf", mfunc_float[2],
 814                       BUILT_IN_SCALBNF, "scalbnf", ATTR_CONST_NOTHROW_LEAF_LIST);
 815
 816   gfc_define_builtin ("__builtin_fmodl", mfunc_longdouble[1],
 817                       BUILT_IN_FMODL, "fmodl", ATTR_CONST_NOTHROW_LEAF_LIST);
 818   gfc_define_builtin ("__builtin_fmod", mfunc_double[1],
 819                       BUILT_IN_FMOD, "fmod", ATTR_CONST_NOTHROW_LEAF_LIST);
 820   gfc_define_builtin ("__builtin_fmodf", mfunc_float[1],
 821                       BUILT_IN_FMODF, "fmodf", ATTR_CONST_NOTHROW_LEAF_LIST);
 822
 823   /* iround{f,,l}, lround{f,,l} and llround{f,,l} */
 824   ftype = build_function_type_list (integer_type_node,
 825                                     float_type_node, NULL_TREE);
 826   gfc_define_builtin("__builtin_iroundf", ftype, BUILT_IN_IROUNDF,
 827                      "iroundf", ATTR_CONST_NOTHROW_LEAF_LIST);
 828   ftype = build_function_type_list (long_integer_type_node,
 829                                     float_type_node, NULL_TREE);
 830   gfc_define_builtin ("__builtin_lroundf", ftype, BUILT_IN_LROUNDF,
 831                       "lroundf", ATTR_CONST_NOTHROW_LEAF_LIST);
 832   ftype = build_function_type_list (long_long_integer_type_node,
 833                                     float_type_node, NULL_TREE);
 834   gfc_define_builtin ("__builtin_llroundf", ftype, BUILT_IN_LLROUNDF,
 835                       "llroundf", ATTR_CONST_NOTHROW_LEAF_LIST);
 836
 837   ftype = build_function_type_list (integer_type_node,
 838                                     double_type_node, NULL_TREE);
 839   gfc_define_builtin("__builtin_iround", ftype, BUILT_IN_IROUND,
 840                      "iround", ATTR_CONST_NOTHROW_LEAF_LIST);
 841   ftype = build_function_type_list (long_integer_type_node,
 842                                     double_type_node, NULL_TREE);
 843   gfc_define_builtin ("__builtin_lround", ftype, BUILT_IN_LROUND,
 844                       "lround", ATTR_CONST_NOTHROW_LEAF_LIST);
 845   ftype = build_function_type_list (long_long_integer_type_node,
 846                                     double_type_node, NULL_TREE);
 847   gfc_define_builtin ("__builtin_llround", ftype, BUILT_IN_LLROUND,
 848                       "llround", ATTR_CONST_NOTHROW_LEAF_LIST);
 849
 850   ftype = build_function_type_list (integer_type_node,
 851                                     long_double_type_node, NULL_TREE);
 852   gfc_define_builtin("__builtin_iroundl", ftype, BUILT_IN_IROUNDL,
 853                      "iroundl", ATTR_CONST_NOTHROW_LEAF_LIST);
 854   ftype = build_function_type_list (long_integer_type_node,
 855                                     long_double_type_node, NULL_TREE);
 856   gfc_define_builtin ("__builtin_lroundl", ftype, BUILT_IN_LROUNDL,
 857                       "lroundl", ATTR_CONST_NOTHROW_LEAF_LIST);
 858   ftype = build_function_type_list (long_long_integer_type_node,
 859                                     long_double_type_node, NULL_TREE);
 860   gfc_define_builtin ("__builtin_llroundl", ftype, BUILT_IN_LLROUNDL,
 861                       "llroundl", ATTR_CONST_NOTHROW_LEAF_LIST);
 862
 863   /* These are used to implement the ** operator.  */
 864   gfc_define_builtin ("__builtin_powl", mfunc_longdouble[1],
 865                       BUILT_IN_POWL, "powl", ATTR_CONST_NOTHROW_LEAF_LIST);
 866   gfc_define_builtin ("__builtin_pow", mfunc_double[1],
 867                       BUILT_IN_POW, "pow", ATTR_CONST_NOTHROW_LEAF_LIST);
 868   gfc_define_builtin ("__builtin_powf", mfunc_float[1],
 869                       BUILT_IN_POWF, "powf", ATTR_CONST_NOTHROW_LEAF_LIST);
 870   gfc_define_builtin ("__builtin_cpowl", mfunc_clongdouble[1],
 871                       BUILT_IN_CPOWL, "cpowl", ATTR_CONST_NOTHROW_LEAF_LIST);
 872   gfc_define_builtin ("__builtin_cpow", mfunc_cdouble[1],
 873                       BUILT_IN_CPOW, "cpow", ATTR_CONST_NOTHROW_LEAF_LIST);
 874   gfc_define_builtin ("__builtin_cpowf", mfunc_cfloat[1],
 875                       BUILT_IN_CPOWF, "cpowf", ATTR_CONST_NOTHROW_LEAF_LIST);
 876   gfc_define_builtin ("__builtin_powil", mfunc_longdouble[2],
 877                       BUILT_IN_POWIL, "powil", ATTR_CONST_NOTHROW_LEAF_LIST);
 878   gfc_define_builtin ("__builtin_powi", mfunc_double[2],
 879                       BUILT_IN_POWI, "powi", ATTR_CONST_NOTHROW_LEAF_LIST);
 880   gfc_define_builtin ("__builtin_powif", mfunc_float[2],
 881                       BUILT_IN_POWIF, "powif", ATTR_CONST_NOTHROW_LEAF_LIST);
 882
 883
 884   if (targetm.libc_has_function (function_c99_math_complex))
 885     {
 886       gfc_define_builtin ("__builtin_cbrtl", mfunc_longdouble[0],
 887                           BUILT_IN_CBRTL, "cbrtl",
 888                           ATTR_CONST_NOTHROW_LEAF_LIST);
 889       gfc_define_builtin ("__builtin_cbrt", mfunc_double[0],
 890                           BUILT_IN_CBRT, "cbrt",
 891                           ATTR_CONST_NOTHROW_LEAF_LIST);
 892       gfc_define_builtin ("__builtin_cbrtf", mfunc_float[0],
 893                           BUILT_IN_CBRTF, "cbrtf",
 894                           ATTR_CONST_NOTHROW_LEAF_LIST);
 895       gfc_define_builtin ("__builtin_cexpil", func_longdouble_clongdouble,
 896                           BUILT_IN_CEXPIL, "cexpil",
 897                           ATTR_CONST_NOTHROW_LEAF_LIST);
 898       gfc_define_builtin ("__builtin_cexpi", func_double_cdouble,
 899                           BUILT_IN_CEXPI, "cexpi",
 900                           ATTR_CONST_NOTHROW_LEAF_LIST);
 901       gfc_define_builtin ("__builtin_cexpif", func_float_cfloat,
 902                           BUILT_IN_CEXPIF, "cexpif",
 903                           ATTR_CONST_NOTHROW_LEAF_LIST);
 904     }
 905
 906   if (targetm.libc_has_function (function_sincos))
 907     {
 908       gfc_define_builtin ("__builtin_sincosl",
 909                           func_longdouble_longdoublep_longdoublep,
 910                           BUILT_IN_SINCOSL, "sincosl", ATTR_NOTHROW_LEAF_LIST);
 911       gfc_define_builtin ("__builtin_sincos", func_double_doublep_doublep,
 912                           BUILT_IN_SINCOS, "sincos", ATTR_NOTHROW_LEAF_LIST);
 913       gfc_define_builtin ("__builtin_sincosf", func_float_floatp_floatp,
 914                           BUILT_IN_SINCOSF, "sincosf", ATTR_NOTHROW_LEAF_LIST);
 915     }
 916
 917   /* For LEADZ, TRAILZ, POPCNT and POPPAR.  */
 918   ftype = build_function_type_list (integer_type_node,
 919                                     unsigned_type_node, NULL_TREE);
 920   gfc_define_builtin ("__builtin_clz", ftype, BUILT_IN_CLZ,
 921                       "__builtin_clz", ATTR_CONST_NOTHROW_LEAF_LIST);
 922   gfc_define_builtin ("__builtin_ctz", ftype, BUILT_IN_CTZ,
 923                       "__builtin_ctz", ATTR_CONST_NOTHROW_LEAF_LIST);
 924   gfc_define_builtin ("__builtin_parity", ftype, BUILT_IN_PARITY,
 925                       "__builtin_parity", ATTR_CONST_NOTHROW_LEAF_LIST);
 926   gfc_define_builtin ("__builtin_popcount", ftype, BUILT_IN_POPCOUNT,
 927                       "__builtin_popcount", ATTR_CONST_NOTHROW_LEAF_LIST);
 928
 929   ftype = build_function_type_list (integer_type_node,
 930                                     long_unsigned_type_node, NULL_TREE);
 931   gfc_define_builtin ("__builtin_clzl", ftype, BUILT_IN_CLZL,
 932                       "__builtin_clzl", ATTR_CONST_NOTHROW_LEAF_LIST);
 933   gfc_define_builtin ("__builtin_ctzl", ftype, BUILT_IN_CTZL,
 934                       "__builtin_ctzl", ATTR_CONST_NOTHROW_LEAF_LIST);
 935   gfc_define_builtin ("__builtin_parityl", ftype, BUILT_IN_PARITYL,
 936                       "__builtin_parityl", ATTR_CONST_NOTHROW_LEAF_LIST);
 937   gfc_define_builtin ("__builtin_popcountl", ftype, BUILT_IN_POPCOUNTL,
 938                       "__builtin_popcountl", ATTR_CONST_NOTHROW_LEAF_LIST);
 939
 940   ftype = build_function_type_list (integer_type_node,
 941                                     long_long_unsigned_type_node, NULL_TREE);
 942   gfc_define_builtin ("__builtin_clzll", ftype, BUILT_IN_CLZLL,
 943                       "__builtin_clzll", ATTR_CONST_NOTHROW_LEAF_LIST);
 944   gfc_define_builtin ("__builtin_ctzll", ftype, BUILT_IN_CTZLL,
 945                       "__builtin_ctzll", ATTR_CONST_NOTHROW_LEAF_LIST);
 946   gfc_define_builtin ("__builtin_parityll", ftype, BUILT_IN_PARITYLL,
 947                       "__builtin_parityll", ATTR_CONST_NOTHROW_LEAF_LIST);
 948   gfc_define_builtin ("__builtin_popcountll", ftype, BUILT_IN_POPCOUNTLL,
 949                       "__builtin_popcountll", ATTR_CONST_NOTHROW_LEAF_LIST);
 950
 951   /* Other builtin functions we use.  */
 952
 953   ftype = build_function_type_list (long_integer_type_node,
 954                                     long_integer_type_node,
 955                                     long_integer_type_node, NULL_TREE);
 956   gfc_define_builtin ("__builtin_expect", ftype, BUILT_IN_EXPECT,
 957                       "__builtin_expect", ATTR_CONST_NOTHROW_LEAF_LIST);
 958
 959   ftype = build_function_type_list (void_type_node,
 960                                     pvoid_type_node, NULL_TREE);
 961   gfc_define_builtin ("__builtin_free", ftype, BUILT_IN_FREE,
 962                       "free", ATTR_NOTHROW_LEAF_LIST);
 963
 964   ftype = build_function_type_list (pvoid_type_node,
 965                                     size_type_node, NULL_TREE);
 966   gfc_define_builtin ("__builtin_malloc", ftype, BUILT_IN_MALLOC,
 967                       "malloc", ATTR_NOTHROW_LEAF_MALLOC_LIST);
 968
 969   ftype = build_function_type_list (pvoid_type_node, size_type_node,
 970                                     size_type_node, NULL_TREE);
 971   gfc_define_builtin ("__builtin_calloc", ftype, BUILT_IN_CALLOC,
 972                       "calloc", ATTR_NOTHROW_LEAF_MALLOC_LIST);
 973   DECL_IS_MALLOC (builtin_decl_explicit (BUILT_IN_CALLOC)) = 1;
 974
 975   ftype = build_function_type_list (pvoid_type_node,
 976                                     size_type_node, pvoid_type_node,
 977                                     NULL_TREE);
 978   gfc_define_builtin ("__builtin_realloc", ftype, BUILT_IN_REALLOC,
 979                       "realloc", ATTR_NOTHROW_LEAF_LIST);
 980
 981   /* Type-generic floating-point classification built-ins.  */
 982
 983   ftype = build_function_type (integer_type_node, NULL_TREE);
 984   gfc_define_builtin ("__builtin_isfinite", ftype, BUILT_IN_ISFINITE,
 985                       "__builtin_isfinite", ATTR_CONST_NOTHROW_LEAF_LIST);
 986   gfc_define_builtin ("__builtin_isinf", ftype, BUILT_IN_ISINF,
 987                       "__builtin_isinf", ATTR_CONST_NOTHROW_LEAF_LIST);
 988   gfc_define_builtin ("__builtin_isinf_sign", ftype, BUILT_IN_ISINF_SIGN,
 989                       "__builtin_isinf_sign", ATTR_CONST_NOTHROW_LEAF_LIST);
 990   gfc_define_builtin ("__builtin_isnan", ftype, BUILT_IN_ISNAN,
 991                       "__builtin_isnan", ATTR_CONST_NOTHROW_LEAF_LIST);
 992   gfc_define_builtin ("__builtin_isnormal", ftype, BUILT_IN_ISNORMAL,
 993                       "__builtin_isnormal", ATTR_CONST_NOTHROW_LEAF_LIST);
 994   gfc_define_builtin ("__builtin_signbit", ftype, BUILT_IN_SIGNBIT,
 995                       "__builtin_signbit", ATTR_CONST_NOTHROW_LEAF_LIST);
 996
 997   ftype = build_function_type (integer_type_node, NULL_TREE);
 998   gfc_define_builtin ("__builtin_isless", ftype, BUILT_IN_ISLESS,
 999                       "__builtin_isless", ATTR_CONST_NOTHROW_LEAF_LIST);
1000   gfc_define_builtin ("__builtin_islessequal", ftype, BUILT_IN_ISLESSEQUAL,
1001                       "__builtin_islessequal", ATTR_CONST_NOTHROW_LEAF_LIST);
1002   gfc_define_builtin ("__builtin_islessgreater", ftype, BUILT_IN_ISLESSGREATER,
1003                       "__builtin_islessgreater", ATTR_CONST_NOTHROW_LEAF_LIST);
1004   gfc_define_builtin ("__builtin_isgreater", ftype, BUILT_IN_ISGREATER,
1005                       "__builtin_isgreater", ATTR_CONST_NOTHROW_LEAF_LIST);
1006   gfc_define_builtin ("__builtin_isgreaterequal", ftype,
1007                       BUILT_IN_ISGREATEREQUAL, "__builtin_isgreaterequal",
1008                       ATTR_CONST_NOTHROW_LEAF_LIST);
1009   gfc_define_builtin ("__builtin_isunordered", ftype, BUILT_IN_ISUNORDERED,
1010                       "__builtin_isunordered", ATTR_CONST_NOTHROW_LEAF_LIST);
1011
1012
1013 #define DEF_PRIMITIVE_TYPE(ENUM, VALUE) \
1014   builtin_types[(int) ENUM] = VALUE;
1015 #define DEF_FUNCTION_TYPE_0(ENUM, RETURN)                       \
1016   builtin_types[(int) ENUM]                                     \
1017     = build_function_type_list (builtin_types[(int) RETURN],    \
1018                                 NULL_TREE);
1019 #define DEF_FUNCTION_TYPE_1(ENUM, RETURN, ARG1)                         \
1020   builtin_types[(int) ENUM]                                             \
1021     = build_function_type_list (builtin_types[(int) RETURN],            \
1022                                 builtin_types[(int) ARG1],              \
1023                                 NULL_TREE);
1024 #define DEF_FUNCTION_TYPE_2(ENUM, RETURN, ARG1, ARG2)           \
1025   builtin_types[(int) ENUM]                                     \
1026     = build_function_type_list (builtin_types[(int) RETURN],    \
1027                                 builtin_types[(int) ARG1],      \
1028                                 builtin_types[(int) ARG2],      \
1029                                 NULL_TREE);
1030 #define DEF_FUNCTION_TYPE_3(ENUM, RETURN, ARG1, ARG2, ARG3)             \
1031   builtin_types[(int) ENUM]                                             \
1032     = build_function_type_list (builtin_types[(int) RETURN],            \
1033                                 builtin_types[(int) ARG1],              \
1034                                 builtin_types[(int) ARG2],              \
1035                                 builtin_types[(int) ARG3],              \
1036                                 NULL_TREE);
1037 #define DEF_FUNCTION_TYPE_4(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4)       \
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                                 NULL_TREE);
1045 #define DEF_FUNCTION_TYPE_5(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5) \
1046   builtin_types[(int) ENUM]                                             \
1047     = build_function_type_list (builtin_types[(int) RETURN],            \
1048                                 builtin_types[(int) ARG1],              \
1049                                 builtin_types[(int) ARG2],              \
1050                                 builtin_types[(int) ARG3],              \
1051                                 builtin_types[(int) ARG4],              \
1052                                 builtin_types[(int) ARG5],              \
1053                                 NULL_TREE);
1054 #define DEF_FUNCTION_TYPE_6(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
1055                             ARG6)                                       \
1056   builtin_types[(int) ENUM]                                             \
1057     = build_function_type_list (builtin_types[(int) RETURN],            \
1058                                 builtin_types[(int) ARG1],              \
1059                                 builtin_types[(int) ARG2],              \
1060                                 builtin_types[(int) ARG3],              \
1061                                 builtin_types[(int) ARG4],              \
1062                                 builtin_types[(int) ARG5],              \
1063                                 builtin_types[(int) ARG6],              \
1064                                 NULL_TREE);
1065 #define DEF_FUNCTION_TYPE_7(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
1066                             ARG6, ARG7)                                 \
1067   builtin_types[(int) ENUM]                                             \
1068     = build_function_type_list (builtin_types[(int) RETURN],            \
1069                                 builtin_types[(int) ARG1],              \
1070                                 builtin_types[(int) ARG2],              \
1071                                 builtin_types[(int) ARG3],              \
1072                                 builtin_types[(int) ARG4],              \
1073                                 builtin_types[(int) ARG5],              \
1074                                 builtin_types[(int) ARG6],              \
1075                                 builtin_types[(int) ARG7],              \
1076                                 NULL_TREE);
1077 #define DEF_FUNCTION_TYPE_8(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
1078                             ARG6, ARG7, ARG8)                           \
1079   builtin_types[(int) ENUM]                                             \
1080     = build_function_type_list (builtin_types[(int) RETURN],            \
1081                                 builtin_types[(int) ARG1],              \
1082                                 builtin_types[(int) ARG2],              \
1083                                 builtin_types[(int) ARG3],              \
1084                                 builtin_types[(int) ARG4],              \
1085                                 builtin_types[(int) ARG5],              \
1086                                 builtin_types[(int) ARG6],              \
1087                                 builtin_types[(int) ARG7],              \
1088                                 builtin_types[(int) ARG8],              \
1089                                 NULL_TREE);
1090 #define DEF_FUNCTION_TYPE_9(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
1091                             ARG6, ARG7, ARG8, ARG9)                     \
1092   builtin_types[(int) ENUM]                                             \
1093     = build_function_type_list (builtin_types[(int) RETURN],            \
1094                                 builtin_types[(int) ARG1],              \
1095                                 builtin_types[(int) ARG2],              \
1096                                 builtin_types[(int) ARG3],              \
1097                                 builtin_types[(int) ARG4],              \
1098                                 builtin_types[(int) ARG5],              \
1099                                 builtin_types[(int) ARG6],              \
1100                                 builtin_types[(int) ARG7],              \
1101                                 builtin_types[(int) ARG8],              \
1102                                 builtin_types[(int) ARG9],              \
1103                                 NULL_TREE);
1104 #define DEF_FUNCTION_TYPE_10(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4,      \
1105                              ARG5, ARG6, ARG7, ARG8, ARG9, ARG10)       \
1106   builtin_types[(int) ENUM]                                             \
1107     = build_function_type_list (builtin_types[(int) RETURN],            \
1108                                 builtin_types[(int) ARG1],              \
1109                                 builtin_types[(int) ARG2],              \
1110                                 builtin_types[(int) ARG3],              \
1111                                 builtin_types[(int) ARG4],              \
1112                                 builtin_types[(int) ARG5],              \
1113                                 builtin_types[(int) ARG6],              \
1114                                 builtin_types[(int) ARG7],              \
1115                                 builtin_types[(int) ARG8],              \
1116                                 builtin_types[(int) ARG9],              \
1117                                 builtin_types[(int) ARG10],             \
1118                                 NULL_TREE);
1119 #define DEF_FUNCTION_TYPE_11(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4,      \
1120                              ARG5, ARG6, ARG7, ARG8, ARG9, ARG10, ARG11)\
1121   builtin_types[(int) ENUM]                                             \
1122     = build_function_type_list (builtin_types[(int) RETURN],            \
1123                                 builtin_types[(int) ARG1],              \
1124                                 builtin_types[(int) ARG2],              \
1125                                 builtin_types[(int) ARG3],              \
1126                                 builtin_types[(int) ARG4],              \
1127                                 builtin_types[(int) ARG5],              \
1128                                 builtin_types[(int) ARG6],              \
1129                                 builtin_types[(int) ARG7],              \
1130                                 builtin_types[(int) ARG8],              \
1131                                 builtin_types[(int) ARG9],              \
1132                                 builtin_types[(int) ARG10],             \
1133                                 builtin_types[(int) ARG11],             \
1134                                 NULL_TREE);
1135 #define DEF_FUNCTION_TYPE_VAR_0(ENUM, RETURN)                           \
1136   builtin_types[(int) ENUM]                                             \
1137     = build_varargs_function_type_list (builtin_types[(int) RETURN],    \
1138                                         NULL_TREE);
1139 #define DEF_FUNCTION_TYPE_VAR_1(ENUM, RETURN, ARG1)                     \
1140   builtin_types[(int) ENUM]                                             \
1141     = build_varargs_function_type_list (builtin_types[(int) RETURN],    \
1142                                         builtin_types[(int) ARG1],      \
1143                                         NULL_TREE);
1144 #define DEF_FUNCTION_TYPE_VAR_2(ENUM, RETURN, ARG1, ARG2)               \
1145   builtin_types[(int) ENUM]                                             \
1146     = build_varargs_function_type_list (builtin_types[(int) RETURN],    \
1147                                         builtin_types[(int) ARG1],      \
1148                                         builtin_types[(int) ARG2],      \
1149                                         NULL_TREE);
1150 #define DEF_FUNCTION_TYPE_VAR_6(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
1151                                 ARG6)   \
1152   builtin_types[(int) ENUM]                                             \
1153     = build_varargs_function_type_list (builtin_types[(int) RETURN],    \
1154                                         builtin_types[(int) ARG1],      \
1155                                         builtin_types[(int) ARG2],      \
1156                                         builtin_types[(int) ARG3],      \
1157                                         builtin_types[(int) ARG4],      \
1158                                         builtin_types[(int) ARG5],      \
1159                                         builtin_types[(int) ARG6],      \
1160                                         NULL_TREE);
1161 #define DEF_FUNCTION_TYPE_VAR_7(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
1162                                 ARG6, ARG7)                             \
1163   builtin_types[(int) ENUM]                                             \
1164     = build_varargs_function_type_list (builtin_types[(int) RETURN],    \
1165                                         builtin_types[(int) ARG1],      \
1166                                         builtin_types[(int) ARG2],      \
1167                                         builtin_types[(int) ARG3],      \
1168                                         builtin_types[(int) ARG4],      \
1169                                         builtin_types[(int) ARG5],      \
1170                                         builtin_types[(int) ARG6],      \
1171                                         builtin_types[(int) ARG7],      \
1172                                         NULL_TREE);
1173 #define DEF_POINTER_TYPE(ENUM, TYPE)                    \
1174   builtin_types[(int) ENUM]                             \
1175     = build_pointer_type (builtin_types[(int) TYPE]);
1176 #include "types.def"
1177 #undef DEF_PRIMITIVE_TYPE
1178 #undef DEF_FUNCTION_TYPE_0
1179 #undef DEF_FUNCTION_TYPE_1
1180 #undef DEF_FUNCTION_TYPE_2
1181 #undef DEF_FUNCTION_TYPE_3
1182 #undef DEF_FUNCTION_TYPE_4
1183 #undef DEF_FUNCTION_TYPE_5
1184 #undef DEF_FUNCTION_TYPE_6
1185 #undef DEF_FUNCTION_TYPE_7
1186 #undef DEF_FUNCTION_TYPE_8
1187 #undef DEF_FUNCTION_TYPE_10
1188 #undef DEF_FUNCTION_TYPE_VAR_0
1189 #undef DEF_FUNCTION_TYPE_VAR_1
1190 #undef DEF_FUNCTION_TYPE_VAR_2
1191 #undef DEF_FUNCTION_TYPE_VAR_6
1192 #undef DEF_FUNCTION_TYPE_VAR_7
1193 #undef DEF_POINTER_TYPE
1194   builtin_types[(int) BT_LAST] = NULL_TREE;
1195
1196   /* Initialize synchronization builtins.  */
1197 #undef DEF_SYNC_BUILTIN
1198 #define DEF_SYNC_BUILTIN(code, name, type, attr) \
1199     gfc_define_builtin (name, builtin_types[type], code, name, \
1200                         attr);
1201 #include "../sync-builtins.def"
1202 #undef DEF_SYNC_BUILTIN
1203
1204   if (flag_openacc)
1205     {
1206 #undef DEF_GOACC_BUILTIN
1207 #define DEF_GOACC_BUILTIN(code, name, type, attr) \
1208       gfc_define_builtin ("__builtin_" name, builtin_types[type], \
1209                           code, name, attr);
1210 #undef DEF_GOACC_BUILTIN_COMPILER
1211 #define DEF_GOACC_BUILTIN_COMPILER(code, name, type, attr) \
1212       gfc_define_builtin (name, builtin_types[type], code, name, attr);
1213 #undef DEF_GOMP_BUILTIN
1214 #define DEF_GOMP_BUILTIN(code, name, type, attr) /* ignore */
1215 #include "../omp-builtins.def"
1216 #undef DEF_GOACC_BUILTIN
1217 #undef DEF_GOACC_BUILTIN_COMPILER
1218 #undef DEF_GOMP_BUILTIN
1219     }
1220
1221   if (flag_openmp || flag_openmp_simd || flag_tree_parallelize_loops)
1222     {
1223 #undef DEF_GOACC_BUILTIN
1224 #define DEF_GOACC_BUILTIN(code, name, type, attr) /* ignore */
1225 #undef DEF_GOACC_BUILTIN_COMPILER
1226 #define DEF_GOACC_BUILTIN_COMPILER(code, name, type, attr)  /* ignore */
1227 #undef DEF_GOMP_BUILTIN
1228 #define DEF_GOMP_BUILTIN(code, name, type, attr) \
1229       gfc_define_builtin ("__builtin_" name, builtin_types[type], \
1230                           code, name, attr);
1231 #include "../omp-builtins.def"
1232 #undef DEF_GOACC_BUILTIN
1233 #undef DEF_GOACC_BUILTIN_COMPILER
1234 #undef DEF_GOMP_BUILTIN
1235     }
1236
1237   gfc_define_builtin ("__builtin_trap", builtin_types[BT_FN_VOID],
1238                       BUILT_IN_TRAP, NULL, ATTR_NOTHROW_LEAF_LIST);
1239   TREE_THIS_VOLATILE (builtin_decl_explicit (BUILT_IN_TRAP)) = 1;
1240
1241   ftype = build_varargs_function_type_list (ptr_type_node, const_ptr_type_node,
1242                                             size_type_node, NULL_TREE);
1243   gfc_define_builtin ("__builtin_assume_aligned", ftype,
1244                       BUILT_IN_ASSUME_ALIGNED,
1245                       "__builtin_assume_aligned",
1246                       ATTR_CONST_NOTHROW_LEAF_LIST);
1247
1248   gfc_define_builtin ("__emutls_get_address",
1249                       builtin_types[BT_FN_PTR_PTR],
1250                       BUILT_IN_EMUTLS_GET_ADDRESS,
1251                       "__emutls_get_address", ATTR_CONST_NOTHROW_LEAF_LIST);
1252   gfc_define_builtin ("__emutls_register_common",
1253                       builtin_types[BT_FN_VOID_PTR_WORD_WORD_PTR],
1254                       BUILT_IN_EMUTLS_REGISTER_COMMON,
1255                       "__emutls_register_common", ATTR_NOTHROW_LEAF_LIST);
1256
1257   build_common_builtin_nodes ();
1258   targetm.init_builtins ();
1259 }
1260
1261 #undef DEFINE_MATH_BUILTIN_C
1262 #undef DEFINE_MATH_BUILTIN
1263
1264 static void
1265 gfc_init_ts (void)
1266 {
1267   tree_contains_struct[NAMESPACE_DECL][TS_DECL_NON_COMMON] = 1;
1268   tree_contains_struct[NAMESPACE_DECL][TS_DECL_WITH_VIS] = 1;
1269   tree_contains_struct[NAMESPACE_DECL][TS_DECL_WRTL] = 1;
1270   tree_contains_struct[NAMESPACE_DECL][TS_DECL_COMMON] = 1;
1271   tree_contains_struct[NAMESPACE_DECL][TS_DECL_MINIMAL] = 1;
1272 }
1273
1274 void
1275 gfc_maybe_initialize_eh (void)
1276 {
1277   if (!flag_exceptions || gfc_eh_initialized_p)
1278     return;
1279
1280   gfc_eh_initialized_p = true;
1281   using_eh_for_cleanups ();
1282 }
1283
1284
1285 #include "gt-fortran-f95-lang.h"
1286 #include "gtype-fortran.h"