gcc/fortran/f95-lang.c

   1 /* gfortran backend interface
   2    Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
   3    Free Software Foundation, Inc.
   4    Contributed by Paul Brook.
   5
   6 This file is part of GCC.
   7
   8 GCC is free software; you can redistribute it and/or modify it under
   9 the terms of the GNU General Public License as published by the Free
  10 Software Foundation; either version 3, or (at your option) any later
  11 version.
  12
  13 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
  14 WARRANTY; without even the implied warranty of MERCHANTABILITY or
  15 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  16 for more details.
  17
  18 You should have received a copy of the GNU General Public License
  19 along with GCC; see the file COPYING3.  If not see
  20 <http://www.gnu.org/licenses/>.  */
  21
  22 /* f95-lang.c-- GCC backend interface stuff */
  23
  24 /* declare required prototypes: */
  25
  26 #include "config.h"
  27 #include "system.h"
  28 #include "ansidecl.h"
  29 #include "system.h"
  30 #include "coretypes.h"
  31 #include "tree.h"
  32 #include "gimple.h"
  33 #include "flags.h"
  34 #include "langhooks.h"
  35 #include "langhooks-def.h"
  36 #include "timevar.h"
  37 #include "tm.h"
  38 #include "function.h"
  39 #include "ggc.h"
  40 #include "toplev.h"
  41 #include "target.h"
  42 #include "debug.h"
  43 #include "diagnostic.h"
  44 #include "tree-dump.h"
  45 #include "cgraph.h"
  46 /* For gfc_maybe_initialize_eh.  */
  47 #include "libfuncs.h"
  48 #include "expr.h"
  49 #include "except.h"
  50
  51 #include "gfortran.h"
  52 #include "cpp.h"
  53 #include "trans.h"
  54 #include "trans-types.h"
  55 #include "trans-const.h"
  56
  57 /* Language-dependent contents of an identifier.  */
  58
  59 struct GTY(())
  60 lang_identifier {
  61   struct tree_identifier common;
  62 };
  63
  64 /* The resulting tree type.  */
  65
  66 union GTY((desc ("TREE_CODE (&%h.generic) == IDENTIFIER_NODE"),
  67      chain_next ("(union lang_tree_node *)TREE_CHAIN (&%h.generic)")))
  68
  69 lang_tree_node {
  70   union tree_node GTY((tag ("0"),
  71                        desc ("tree_node_structure (&%h)"))) generic;
  72   struct lang_identifier GTY((tag ("1"))) identifier;
  73 };
  74
  75 /* Save and restore the variables in this file and elsewhere
  76    that keep track of the progress of compilation of the current function.
  77    Used for nested functions.  */
  78
  79 struct GTY(())
  80 language_function {
  81   /* struct gfc_language_function base; */
  82   struct binding_level *binding_level;
  83 };
  84
  85 /* We don't have a lex/yacc lexer/parser, but toplev expects these to
  86    exist anyway.  */
  87 void yyerror (const char *str);
  88 int yylex (void);
  89
  90 static void gfc_init_decl_processing (void);
  91 static void gfc_init_builtin_functions (void);
  92
  93 /* Each front end provides its own.  */
  94 static bool gfc_init (void);
  95 static void gfc_finish (void);
  96 static void gfc_print_identifier (FILE *, tree, int);
  97 void do_function_end (void);
  98 int global_bindings_p (void);
  99 static void clear_binding_stack (void);
 100 static void gfc_be_parse_file (int);
 101 static alias_set_type gfc_get_alias_set (tree);
 102 static void gfc_init_ts (void);
 103
 104 #undef LANG_HOOKS_NAME
 105 #undef LANG_HOOKS_INIT
 106 #undef LANG_HOOKS_FINISH
 107 #undef LANG_HOOKS_INIT_OPTIONS
 108 #undef LANG_HOOKS_HANDLE_OPTION
 109 #undef LANG_HOOKS_POST_OPTIONS
 110 #undef LANG_HOOKS_PRINT_IDENTIFIER
 111 #undef LANG_HOOKS_PARSE_FILE
 112 #undef LANG_HOOKS_MARK_ADDRESSABLE
 113 #undef LANG_HOOKS_TYPE_FOR_MODE
 114 #undef LANG_HOOKS_TYPE_FOR_SIZE
 115 #undef LANG_HOOKS_GET_ALIAS_SET
 116 #undef LANG_HOOKS_INIT_TS
 117 #undef LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE
 118 #undef LANG_HOOKS_OMP_PREDETERMINED_SHARING
 119 #undef LANG_HOOKS_OMP_CLAUSE_DEFAULT_CTOR
 120 #undef LANG_HOOKS_OMP_CLAUSE_COPY_CTOR
 121 #undef LANG_HOOKS_OMP_CLAUSE_ASSIGN_OP
 122 #undef LANG_HOOKS_OMP_CLAUSE_DTOR
 123 #undef LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR
 124 #undef LANG_HOOKS_OMP_PRIVATE_DEBUG_CLAUSE
 125 #undef LANG_HOOKS_OMP_PRIVATE_OUTER_REF
 126 #undef LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES
 127 #undef LANG_HOOKS_BUILTIN_FUNCTION
 128 #undef LANG_HOOKS_GET_ARRAY_DESCR_INFO
 129
 130 /* Define lang hooks.  */
 131 #define LANG_HOOKS_NAME                 "GNU Fortran"
 132 #define LANG_HOOKS_INIT                 gfc_init
 133 #define LANG_HOOKS_FINISH               gfc_finish
 134 #define LANG_HOOKS_INIT_OPTIONS         gfc_init_options
 135 #define LANG_HOOKS_HANDLE_OPTION        gfc_handle_option
 136 #define LANG_HOOKS_POST_OPTIONS         gfc_post_options
 137 #define LANG_HOOKS_PRINT_IDENTIFIER     gfc_print_identifier
 138 #define LANG_HOOKS_PARSE_FILE           gfc_be_parse_file
 139 #define LANG_HOOKS_TYPE_FOR_MODE        gfc_type_for_mode
 140 #define LANG_HOOKS_TYPE_FOR_SIZE        gfc_type_for_size
 141 #define LANG_HOOKS_GET_ALIAS_SET        gfc_get_alias_set
 142 #define LANG_HOOKS_INIT_TS              gfc_init_ts
 143 #define LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE   gfc_omp_privatize_by_reference
 144 #define LANG_HOOKS_OMP_PREDETERMINED_SHARING    gfc_omp_predetermined_sharing
 145 #define LANG_HOOKS_OMP_CLAUSE_DEFAULT_CTOR      gfc_omp_clause_default_ctor
 146 #define LANG_HOOKS_OMP_CLAUSE_COPY_CTOR         gfc_omp_clause_copy_ctor
 147 #define LANG_HOOKS_OMP_CLAUSE_ASSIGN_OP         gfc_omp_clause_assign_op
 148 #define LANG_HOOKS_OMP_CLAUSE_DTOR              gfc_omp_clause_dtor
 149 #define LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR     gfc_omp_disregard_value_expr
 150 #define LANG_HOOKS_OMP_PRIVATE_DEBUG_CLAUSE     gfc_omp_private_debug_clause
 151 #define LANG_HOOKS_OMP_PRIVATE_OUTER_REF        gfc_omp_private_outer_ref
 152 #define LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES \
 153   gfc_omp_firstprivatize_type_sizes
 154 #define LANG_HOOKS_BUILTIN_FUNCTION          gfc_builtin_function
 155 #define LANG_HOOKS_GET_ARRAY_DESCR_INFO      gfc_get_array_descr_info
 156
 157 struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
 158
 159 #define NULL_BINDING_LEVEL (struct binding_level *) NULL
 160
 161 /* A chain of binding_level structures awaiting reuse.  */
 162
 163 static GTY(()) struct binding_level *free_binding_level;
 164
 165 /* The elements of `ridpointers' are identifier nodes
 166    for the reserved type names and storage classes.
 167    It is indexed by a RID_... value.  */
 168 tree *ridpointers = NULL;
 169
 170 /* True means we've initialized exception handling.  */
 171 bool gfc_eh_initialized_p;
 172
 173
 174 /* Prepare expr to be an argument of a TRUTH_NOT_EXPR,
 175    or validate its data type for an `if' or `while' statement or ?..: exp.
 176
 177    This preparation consists of taking the ordinary
 178    representation of an expression expr and producing a valid tree
 179    boolean expression describing whether expr is nonzero.  We could
 180    simply always do build_binary_op (NE_EXPR, expr, boolean_false_node, 1),
 181    but we optimize comparisons, &&, ||, and !.
 182
 183    The resulting type should always be `boolean_type_node'.
 184    This is much simpler than the corresponding C version because we have a
 185    distinct boolean type.  */
 186
 187 tree
 188 gfc_truthvalue_conversion (tree expr)
 189 {
 190   switch (TREE_CODE (TREE_TYPE (expr)))
 191     {
 192     case BOOLEAN_TYPE:
 193       if (TREE_TYPE (expr) == boolean_type_node)
 194         return expr;
 195       else if (COMPARISON_CLASS_P (expr))
 196         {
 197           TREE_TYPE (expr) = boolean_type_node;
 198           return expr;
 199         }
 200       else if (TREE_CODE (expr) == NOP_EXPR)
 201         return fold_build1 (NOP_EXPR,
 202                             boolean_type_node, TREE_OPERAND (expr, 0));
 203       else
 204         return fold_build1 (NOP_EXPR, boolean_type_node, expr);
 205
 206     case INTEGER_TYPE:
 207       if (TREE_CODE (expr) == INTEGER_CST)
 208         return integer_zerop (expr) ? boolean_false_node : boolean_true_node;
 209       else
 210         return fold_build2 (NE_EXPR, boolean_type_node, expr,
 211                             build_int_cst (TREE_TYPE (expr), 0));
 212
 213     default:
 214       internal_error ("Unexpected type in truthvalue_conversion");
 215     }
 216 }
 217
 218
 219 static void
 220 gfc_create_decls (void)
 221 {
 222   /* GCC builtins.  */
 223   gfc_init_builtin_functions ();
 224
 225   /* Runtime/IO library functions.  */
 226   gfc_build_builtin_function_decls ();
 227
 228   gfc_init_constants ();
 229 }
 230
 231
 232 static void
 233 gfc_be_parse_file (int set_yydebug ATTRIBUTE_UNUSED)
 234 {
 235   int errors;
 236   int warnings;
 237
 238   gfc_create_decls ();
 239   gfc_parse_file ();
 240   gfc_generate_constructors ();
 241
 242   /* Tell the frontend about any errors.  */
 243   gfc_get_errors (&warnings, &errors);
 244   errorcount += errors;
 245   warningcount += warnings;
 246
 247   clear_binding_stack ();
 248 }
 249
 250
 251 /* Initialize everything.  */
 252
 253 static bool
 254 gfc_init (void)
 255 {
 256   if (!gfc_cpp_enabled ())
 257     {
 258       linemap_add (line_table, LC_ENTER, false, gfc_source_file, 1);
 259       linemap_add (line_table, LC_RENAME, false, "<built-in>", 0);
 260     }
 261   else
 262     gfc_cpp_init_0 ();
 263
 264   gfc_init_decl_processing ();
 265   gfc_static_ctors = NULL_TREE;
 266
 267   if (gfc_cpp_enabled ())
 268     gfc_cpp_init ();
 269
 270   gfc_init_1 ();
 271
 272   if (gfc_new_file () != SUCCESS)
 273     fatal_error ("can't open input file: %s", gfc_source_file);
 274
 275   return true;
 276 }
 277
 278
 279 static void
 280 gfc_finish (void)
 281 {
 282   gfc_cpp_done ();
 283   gfc_done_1 ();
 284   gfc_release_include_path ();
 285   return;
 286 }
 287
 288 static void
 289 gfc_print_identifier (FILE * file ATTRIBUTE_UNUSED,
 290                       tree node ATTRIBUTE_UNUSED,
 291                       int indent ATTRIBUTE_UNUSED)
 292 {
 293   return;
 294 }
 295
 296
 297 /* These functions and variables deal with binding contours.  We only
 298    need these functions for the list of PARM_DECLs, but we leave the
 299    functions more general; these are a simplified version of the
 300    functions from GNAT.  */
 301
 302 /* For each binding contour we allocate a binding_level structure which
 303    records the entities defined or declared in that contour.  Contours
 304    include:
 305
 306         the global one
 307         one for each subprogram definition
 308         one for each compound statement (declare block)
 309
 310    Binding contours are used to create GCC tree BLOCK nodes.  */
 311
 312 struct GTY(())
 313 binding_level {
 314   /* A chain of ..._DECL nodes for all variables, constants, functions,
 315      parameters and type declarations.  These ..._DECL nodes are chained
 316      through the TREE_CHAIN field. Note that these ..._DECL nodes are stored
 317      in the reverse of the order supplied to be compatible with the
 318      back-end.  */
 319   tree names;
 320   /* For each level (except the global one), a chain of BLOCK nodes for all
 321      the levels that were entered and exited one level down from this one.  */
 322   tree blocks;
 323   /* The binding level containing this one (the enclosing binding level).  */
 324   struct binding_level *level_chain;
 325 };
 326
 327 /* The binding level currently in effect.  */
 328 static GTY(()) struct binding_level *current_binding_level = NULL;
 329
 330 /* The outermost binding level. This binding level is created when the
 331    compiler is started and it will exist through the entire compilation.  */
 332 static GTY(()) struct binding_level *global_binding_level;
 333
 334 /* Binding level structures are initialized by copying this one.  */
 335 static struct binding_level clear_binding_level = { NULL, NULL, NULL };
 336
 337
 338 /* Return nonzero if we are currently in the global binding level.  */
 339
 340 int
 341 global_bindings_p (void)
 342 {
 343   return current_binding_level == global_binding_level ? -1 : 0;
 344 }
 345
 346 tree
 347 getdecls (void)
 348 {
 349   return current_binding_level->names;
 350 }
 351
 352 /* Enter a new binding level. The input parameter is ignored, but has to be
 353    specified for back-end compatibility.  */
 354
 355 void
 356 pushlevel (int ignore ATTRIBUTE_UNUSED)
 357 {
 358   struct binding_level *newlevel
 359     = (struct binding_level *) ggc_alloc (sizeof (struct binding_level));
 360
 361   *newlevel = clear_binding_level;
 362
 363   /* Add this level to the front of the chain (stack) of levels that are
 364      active.  */
 365   newlevel->level_chain = current_binding_level;
 366   current_binding_level = newlevel;
 367 }
 368
 369 /* Exit a binding level.
 370    Pop the level off, and restore the state of the identifier-decl mappings
 371    that were in effect when this level was entered.
 372
 373    If KEEP is nonzero, this level had explicit declarations, so
 374    and create a "block" (a BLOCK node) for the level
 375    to record its declarations and subblocks for symbol table output.
 376
 377    If FUNCTIONBODY is nonzero, this level is the body of a function,
 378    so create a block as if KEEP were set and also clear out all
 379    label names.
 380
 381    If REVERSE is nonzero, reverse the order of decls before putting
 382    them into the BLOCK.  */
 383
 384 tree
 385 poplevel (int keep, int reverse, int functionbody)
 386 {
 387   /* Points to a BLOCK tree node. This is the BLOCK node constructed for the
 388      binding level that we are about to exit and which is returned by this
 389      routine.  */
 390   tree block_node = NULL_TREE;
 391   tree decl_chain;
 392   tree subblock_chain = current_binding_level->blocks;
 393   tree subblock_node;
 394
 395   /* Reverse the list of XXXX_DECL nodes if desired.  Note that the ..._DECL
 396      nodes chained through the `names' field of current_binding_level are in
 397      reverse order except for PARM_DECL node, which are explicitly stored in
 398      the right order.  */
 399   decl_chain = (reverse) ? nreverse (current_binding_level->names)
 400                          : current_binding_level->names;
 401
 402   /* If there were any declarations in the current binding level, or if this
 403      binding level is a function body, or if there are any nested blocks then
 404      create a BLOCK node to record them for the life of this function.  */
 405   if (keep || functionbody)
 406     block_node = build_block (keep ? decl_chain : 0, subblock_chain, 0, 0);
 407
 408   /* Record the BLOCK node just built as the subblock its enclosing scope.  */
 409   for (subblock_node = subblock_chain; subblock_node;
 410        subblock_node = TREE_CHAIN (subblock_node))
 411     BLOCK_SUPERCONTEXT (subblock_node) = block_node;
 412
 413   /* Clear out the meanings of the local variables of this level.  */
 414
 415   for (subblock_node = decl_chain; subblock_node;
 416        subblock_node = TREE_CHAIN (subblock_node))
 417     if (DECL_NAME (subblock_node) != 0)
 418       /* If the identifier was used or addressed via a local extern decl,
 419          don't forget that fact.  */
 420       if (DECL_EXTERNAL (subblock_node))
 421         {
 422           if (TREE_USED (subblock_node))
 423             TREE_USED (DECL_NAME (subblock_node)) = 1;
 424           if (TREE_ADDRESSABLE (subblock_node))
 425             TREE_ADDRESSABLE (DECL_ASSEMBLER_NAME (subblock_node)) = 1;
 426         }
 427
 428   /* Pop the current level.  */
 429   current_binding_level = current_binding_level->level_chain;
 430
 431   if (functionbody)
 432     /* This is the top level block of a function. */
 433     DECL_INITIAL (current_function_decl) = block_node;
 434   else if (current_binding_level == global_binding_level)
 435     /* When using gfc_start_block/gfc_finish_block from middle-end hooks,
 436        don't add newly created BLOCKs as subblocks of global_binding_level.  */
 437     ;
 438   else if (block_node)
 439     {
 440       current_binding_level->blocks
 441         = chainon (current_binding_level->blocks, block_node);
 442     }
 443
 444   /* If we did not make a block for the level just exited, any blocks made for
 445      inner levels (since they cannot be recorded as subblocks in that level)
 446      must be carried forward so they will later become subblocks of something
 447      else.  */
 448   else if (subblock_chain)
 449     current_binding_level->blocks
 450       = chainon (current_binding_level->blocks, subblock_chain);
 451   if (block_node)
 452     TREE_USED (block_node) = 1;
 453
 454   return block_node;
 455 }
 456
 457
 458 /* Records a ..._DECL node DECL as belonging to the current lexical scope.
 459    Returns the ..._DECL node.  */
 460
 461 tree
 462 pushdecl (tree decl)
 463 {
 464   /* External objects aren't nested, other objects may be.  */
 465   if ((DECL_EXTERNAL (decl)) || (decl == current_function_decl))
 466     DECL_CONTEXT (decl) = 0;
 467   else
 468     DECL_CONTEXT (decl) = current_function_decl;
 469
 470   /* Put the declaration on the list.  The list of declarations is in reverse
 471      order. The list will be reversed later if necessary.  This needs to be
 472      this way for compatibility with the back-end.  */
 473
 474   TREE_CHAIN (decl) = current_binding_level->names;
 475   current_binding_level->names = decl;
 476
 477   /* For the declaration of a type, set its name if it is not already set.  */
 478
 479   if (TREE_CODE (decl) == TYPE_DECL && TYPE_NAME (TREE_TYPE (decl)) == 0)
 480     {
 481       if (DECL_SOURCE_LINE (decl) == 0)
 482         TYPE_NAME (TREE_TYPE (decl)) = decl;
 483       else
 484         TYPE_NAME (TREE_TYPE (decl)) = DECL_NAME (decl);
 485     }
 486
 487   return decl;
 488 }
 489
 490
 491 /* Like pushdecl, only it places X in GLOBAL_BINDING_LEVEL.  */
 492
 493 tree
 494 pushdecl_top_level (tree x)
 495 {
 496   tree t;
 497   struct binding_level *b = current_binding_level;
 498
 499   current_binding_level = global_binding_level;
 500   t = pushdecl (x);
 501   current_binding_level = b;
 502   return t;
 503 }
 504
 505
 506 /* Clear the binding stack.  */
 507 static void
 508 clear_binding_stack (void)
 509 {
 510   while (!global_bindings_p ())
 511     poplevel (0, 0, 0);
 512 }
 513
 514
 515 #ifndef CHAR_TYPE_SIZE
 516 #define CHAR_TYPE_SIZE BITS_PER_UNIT
 517 #endif
 518
 519 #ifndef INT_TYPE_SIZE
 520 #define INT_TYPE_SIZE BITS_PER_WORD
 521 #endif
 522
 523 #undef SIZE_TYPE
 524 #define SIZE_TYPE "long unsigned int"
 525
 526 /* Create tree nodes for the basic scalar types of Fortran 95,
 527    and some nodes representing standard constants (0, 1, (void *) 0).
 528    Initialize the global binding level.
 529    Make definitions for built-in primitive functions.  */
 530 static void
 531 gfc_init_decl_processing (void)
 532 {
 533   current_function_decl = NULL;
 534   current_binding_level = NULL_BINDING_LEVEL;
 535   free_binding_level = NULL_BINDING_LEVEL;
 536
 537   /* Make the binding_level structure for global names. We move all
 538      variables that are in a COMMON block to this binding level.  */
 539   pushlevel (0);
 540   global_binding_level = current_binding_level;
 541
 542   /* Build common tree nodes. char_type_node is unsigned because we
 543      only use it for actual characters, not for INTEGER(1). Also, we
 544      want double_type_node to actually have double precision.  */
 545   build_common_tree_nodes (false);
 546   /* x86_64 mingw32 has a sizetype of "unsigned long long", most other hosts
 547      have a sizetype of "unsigned long". Therefore choose the correct size
 548      in mostly target independent way.  */
 549   if (TYPE_MODE (long_unsigned_type_node) == ptr_mode)
 550     set_sizetype (long_unsigned_type_node);
 551   else if (TYPE_MODE (long_long_unsigned_type_node) == ptr_mode)
 552     set_sizetype (long_long_unsigned_type_node);
 553   else
 554     set_sizetype (long_unsigned_type_node);
 555   build_common_tree_nodes_2 (0);
 556   void_list_node = build_tree_list (NULL_TREE, void_type_node);
 557
 558   /* Set up F95 type nodes.  */
 559   gfc_init_kinds ();
 560   gfc_init_types ();
 561 }
 562
 563
 564 /* Return the typed-based alias set for T, which may be an expression
 565    or a type.  Return -1 if we don't do anything special.  */
 566
 567 static alias_set_type
 568 gfc_get_alias_set (tree t)
 569 {
 570   tree u;
 571
 572   /* Permit type-punning when accessing an EQUIVALENCEd variable or
 573      mixed type entry master's return value.  */
 574   for (u = t; handled_component_p (u); u = TREE_OPERAND (u, 0))
 575     if (TREE_CODE (u) == COMPONENT_REF
 576         && TREE_CODE (TREE_TYPE (TREE_OPERAND (u, 0))) == UNION_TYPE)
 577       return 0;
 578
 579   return -1;
 580 }
 581
 582
 583 /* press the big red button - garbage (ggc) collection is on */
 584
 585 int ggc_p = 1;
 586
 587 /* Builtin function initialization.  */
 588
 589 tree
 590 gfc_builtin_function (tree decl)
 591 {
 592   make_decl_rtl (decl);
 593   pushdecl (decl);
 594   return decl;
 595 }
 596
 597
 598 static void
 599 gfc_define_builtin (const char *name,
 600                     tree type,
 601                     int code,
 602                     const char *library_name,
 603                     bool const_p)
 604 {
 605   tree decl;
 606
 607   decl = add_builtin_function (name, type, code, BUILT_IN_NORMAL,
 608                                library_name, NULL_TREE);
 609   if (const_p)
 610     TREE_READONLY (decl) = 1;
 611
 612   built_in_decls[code] = decl;
 613   implicit_built_in_decls[code] = decl;
 614 }
 615
 616
 617 #define DO_DEFINE_MATH_BUILTIN(code, name, argtype, tbase) \
 618     gfc_define_builtin ("__builtin_" name "l", tbase##longdouble[argtype], \
 619                        BUILT_IN_ ## code ## L, name "l", true); \
 620     gfc_define_builtin ("__builtin_" name, tbase##double[argtype], \
 621                         BUILT_IN_ ## code, name, true); \
 622     gfc_define_builtin ("__builtin_" name "f", tbase##float[argtype], \
 623                         BUILT_IN_ ## code ## F, name "f", true);
 624
 625 #define DEFINE_MATH_BUILTIN(code, name, argtype) \
 626     DO_DEFINE_MATH_BUILTIN (code, name, argtype, mfunc_)
 627
 628 #define DEFINE_MATH_BUILTIN_C(code, name, argtype) \
 629     DO_DEFINE_MATH_BUILTIN (code, name, argtype, mfunc_) \
 630     DO_DEFINE_MATH_BUILTIN (C##code, "c" name, argtype, mfunc_c)
 631
 632
 633 /* Create function types for builtin functions.  */
 634
 635 static void
 636 build_builtin_fntypes (tree *fntype, tree type)
 637 {
 638   tree tmp;
 639
 640   /* type (*) (type) */
 641   tmp = tree_cons (NULL_TREE, type, void_list_node);
 642   fntype[0] = build_function_type (type, tmp);
 643   /* type (*) (type, type) */
 644   tmp = tree_cons (NULL_TREE, type, tmp);
 645   fntype[1] = build_function_type (type, tmp);
 646   /* type (*) (int, type) */
 647   tmp = tree_cons (NULL_TREE, integer_type_node, void_list_node);
 648   tmp = tree_cons (NULL_TREE, type, tmp);
 649   fntype[2] = build_function_type (type, tmp);
 650   /* type (*) (void) */
 651   fntype[3] = build_function_type (type, void_list_node);
 652   /* type (*) (type, &int) */
 653   tmp = tree_cons (NULL_TREE, type, void_list_node);
 654   tmp = tree_cons (NULL_TREE, build_pointer_type (integer_type_node), tmp);
 655   fntype[4] = build_function_type (type, tmp);
 656   /* type (*) (type, int) */
 657   tmp = tree_cons (NULL_TREE, type, void_list_node);
 658   tmp = tree_cons (NULL_TREE, integer_type_node, tmp);
 659   fntype[5] = build_function_type (type, tmp);
 660 }
 661
 662
 663 static tree
 664 builtin_type_for_size (int size, bool unsignedp)
 665 {
 666   tree type = lang_hooks.types.type_for_size (size, unsignedp);
 667   return type ? type : error_mark_node;
 668 }
 669
 670 /* Initialization of builtin function nodes.  */
 671
 672 static void
 673 gfc_init_builtin_functions (void)
 674 {
 675   enum builtin_type
 676   {
 677 #define DEF_PRIMITIVE_TYPE(NAME, VALUE) NAME,
 678 #define DEF_FUNCTION_TYPE_0(NAME, RETURN) NAME,
 679 #define DEF_FUNCTION_TYPE_1(NAME, RETURN, ARG1) NAME,
 680 #define DEF_FUNCTION_TYPE_2(NAME, RETURN, ARG1, ARG2) NAME,
 681 #define DEF_FUNCTION_TYPE_3(NAME, RETURN, ARG1, ARG2, ARG3) NAME,
 682 #define DEF_FUNCTION_TYPE_4(NAME, RETURN, ARG1, ARG2, ARG3, ARG4) NAME,
 683 #define DEF_FUNCTION_TYPE_5(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5) NAME,
 684 #define DEF_FUNCTION_TYPE_6(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, ARG6) NAME,
 685 #define DEF_FUNCTION_TYPE_7(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, ARG6, ARG7) NAME,
 686 #define DEF_FUNCTION_TYPE_VAR_0(NAME, RETURN) NAME,
 687 #define DEF_POINTER_TYPE(NAME, TYPE) NAME,
 688 #include "types.def"
 689 #undef DEF_PRIMITIVE_TYPE
 690 #undef DEF_FUNCTION_TYPE_0
 691 #undef DEF_FUNCTION_TYPE_1
 692 #undef DEF_FUNCTION_TYPE_2
 693 #undef DEF_FUNCTION_TYPE_3
 694 #undef DEF_FUNCTION_TYPE_4
 695 #undef DEF_FUNCTION_TYPE_5
 696 #undef DEF_FUNCTION_TYPE_6
 697 #undef DEF_FUNCTION_TYPE_7
 698 #undef DEF_FUNCTION_TYPE_VAR_0
 699 #undef DEF_POINTER_TYPE
 700     BT_LAST
 701   };
 702   typedef enum builtin_type builtin_type;
 703   enum
 704   {
 705     /* So far we need just these 2 attribute types.  */
 706     ATTR_NOTHROW_LIST,
 707     ATTR_CONST_NOTHROW_LIST
 708   };
 709
 710   tree mfunc_float[6];
 711   tree mfunc_double[6];
 712   tree mfunc_longdouble[6];
 713   tree mfunc_cfloat[6];
 714   tree mfunc_cdouble[6];
 715   tree mfunc_clongdouble[6];
 716   tree func_cfloat_float, func_float_cfloat;
 717   tree func_cdouble_double, func_double_cdouble;
 718   tree func_clongdouble_longdouble, func_longdouble_clongdouble;
 719   tree func_float_floatp_floatp;
 720   tree func_double_doublep_doublep;
 721   tree func_longdouble_longdoublep_longdoublep;
 722   tree ftype, ptype;
 723   tree tmp, type;
 724   tree builtin_types[(int) BT_LAST + 1];
 725
 726   build_builtin_fntypes (mfunc_float, float_type_node);
 727   build_builtin_fntypes (mfunc_double, double_type_node);
 728   build_builtin_fntypes (mfunc_longdouble, long_double_type_node);
 729   build_builtin_fntypes (mfunc_cfloat, complex_float_type_node);
 730   build_builtin_fntypes (mfunc_cdouble, complex_double_type_node);
 731   build_builtin_fntypes (mfunc_clongdouble, complex_long_double_type_node);
 732
 733   tmp = tree_cons (NULL_TREE, complex_float_type_node, void_list_node);
 734   func_cfloat_float = build_function_type (float_type_node, tmp);
 735
 736   tmp = tree_cons (NULL_TREE, float_type_node, void_list_node);
 737   func_float_cfloat = build_function_type (complex_float_type_node, tmp);
 738
 739   tmp = tree_cons (NULL_TREE, complex_double_type_node, void_list_node);
 740   func_cdouble_double = build_function_type (double_type_node, tmp);
 741
 742   tmp = tree_cons (NULL_TREE, double_type_node, void_list_node);
 743   func_double_cdouble = build_function_type (complex_double_type_node, tmp);
 744
 745   tmp = tree_cons (NULL_TREE, complex_long_double_type_node, void_list_node);
 746   func_clongdouble_longdouble =
 747     build_function_type (long_double_type_node, tmp);
 748
 749   tmp = tree_cons (NULL_TREE, long_double_type_node, void_list_node);
 750   func_longdouble_clongdouble =
 751     build_function_type (complex_long_double_type_node, tmp);
 752
 753   ptype = build_pointer_type (float_type_node);
 754   tmp = tree_cons (NULL_TREE, float_type_node,
 755                    tree_cons (NULL_TREE, ptype,
 756                               tree_cons (NULL_TREE, ptype, void_list_node)));
 757   func_float_floatp_floatp =
 758     build_function_type (void_type_node, tmp);
 759
 760   ptype = build_pointer_type (double_type_node);
 761   tmp = tree_cons (NULL_TREE, double_type_node,
 762                    tree_cons (NULL_TREE, ptype,
 763                               tree_cons (NULL_TREE, ptype, void_list_node)));
 764   func_double_doublep_doublep =
 765     build_function_type (void_type_node, tmp);
 766
 767   ptype = build_pointer_type (long_double_type_node);
 768   tmp = tree_cons (NULL_TREE, long_double_type_node,
 769                    tree_cons (NULL_TREE, ptype,
 770                               tree_cons (NULL_TREE, ptype, void_list_node)));
 771   func_longdouble_longdoublep_longdoublep =
 772     build_function_type (void_type_node, tmp);
 773
 774 #include "mathbuiltins.def"
 775
 776   /* We define these separately as the fortran versions have different
 777      semantics (they return an integer type) */
 778   gfc_define_builtin ("__builtin_roundl", mfunc_longdouble[0],
 779                       BUILT_IN_ROUNDL, "roundl", true);
 780   gfc_define_builtin ("__builtin_round", mfunc_double[0],
 781                       BUILT_IN_ROUND, "round", true);
 782   gfc_define_builtin ("__builtin_roundf", mfunc_float[0],
 783                       BUILT_IN_ROUNDF, "roundf", true);
 784
 785   gfc_define_builtin ("__builtin_truncl", mfunc_longdouble[0],
 786                       BUILT_IN_TRUNCL, "truncl", true);
 787   gfc_define_builtin ("__builtin_trunc", mfunc_double[0],
 788                       BUILT_IN_TRUNC, "trunc", true);
 789   gfc_define_builtin ("__builtin_truncf", mfunc_float[0],
 790                       BUILT_IN_TRUNCF, "truncf", true);
 791
 792   gfc_define_builtin ("__builtin_cabsl", func_clongdouble_longdouble,
 793                       BUILT_IN_CABSL, "cabsl", true);
 794   gfc_define_builtin ("__builtin_cabs", func_cdouble_double,
 795                       BUILT_IN_CABS, "cabs", true);
 796   gfc_define_builtin ("__builtin_cabsf", func_cfloat_float,
 797                       BUILT_IN_CABSF, "cabsf", true);
 798
 799   gfc_define_builtin ("__builtin_copysignl", mfunc_longdouble[1],
 800                       BUILT_IN_COPYSIGNL, "copysignl", true);
 801   gfc_define_builtin ("__builtin_copysign", mfunc_double[1],
 802                       BUILT_IN_COPYSIGN, "copysign", true);
 803   gfc_define_builtin ("__builtin_copysignf", mfunc_float[1],
 804                       BUILT_IN_COPYSIGNF, "copysignf", true);
 805
 806   gfc_define_builtin ("__builtin_nextafterl", mfunc_longdouble[1],
 807                       BUILT_IN_NEXTAFTERL, "nextafterl", true);
 808   gfc_define_builtin ("__builtin_nextafter", mfunc_double[1],
 809                       BUILT_IN_NEXTAFTER, "nextafter", true);
 810   gfc_define_builtin ("__builtin_nextafterf", mfunc_float[1],
 811                       BUILT_IN_NEXTAFTERF, "nextafterf", true);
 812
 813   gfc_define_builtin ("__builtin_frexpl", mfunc_longdouble[4],
 814                       BUILT_IN_FREXPL, "frexpl", false);
 815   gfc_define_builtin ("__builtin_frexp", mfunc_double[4],
 816                       BUILT_IN_FREXP, "frexp", false);
 817   gfc_define_builtin ("__builtin_frexpf", mfunc_float[4],
 818                       BUILT_IN_FREXPF, "frexpf", false);
 819
 820   gfc_define_builtin ("__builtin_fabsl", mfunc_longdouble[0],
 821                       BUILT_IN_FABSL, "fabsl", true);
 822   gfc_define_builtin ("__builtin_fabs", mfunc_double[0],
 823                       BUILT_IN_FABS, "fabs", true);
 824   gfc_define_builtin ("__builtin_fabsf", mfunc_float[0],
 825                       BUILT_IN_FABSF, "fabsf", true);
 826
 827   gfc_define_builtin ("__builtin_scalbnl", mfunc_longdouble[5],
 828                       BUILT_IN_SCALBNL, "scalbnl", true);
 829   gfc_define_builtin ("__builtin_scalbn", mfunc_double[5],
 830                       BUILT_IN_SCALBN, "scalbn", true);
 831   gfc_define_builtin ("__builtin_scalbnf", mfunc_float[5],
 832                       BUILT_IN_SCALBNF, "scalbnf", true);
 833
 834   gfc_define_builtin ("__builtin_fmodl", mfunc_longdouble[1],
 835                       BUILT_IN_FMODL, "fmodl", true);
 836   gfc_define_builtin ("__builtin_fmod", mfunc_double[1],
 837                       BUILT_IN_FMOD, "fmod", true);
 838   gfc_define_builtin ("__builtin_fmodf", mfunc_float[1],
 839                       BUILT_IN_FMODF, "fmodf", true);
 840
 841   gfc_define_builtin ("__builtin_huge_vall", mfunc_longdouble[3],
 842                       BUILT_IN_HUGE_VALL, "__builtin_huge_vall", true);
 843   gfc_define_builtin ("__builtin_huge_val", mfunc_double[3],
 844                       BUILT_IN_HUGE_VAL, "__builtin_huge_val", true);
 845   gfc_define_builtin ("__builtin_huge_valf", mfunc_float[3],
 846                       BUILT_IN_HUGE_VALF, "__builtin_huge_valf", true);
 847
 848   /* lround{f,,l} and llround{f,,l} */
 849   type = tree_cons (NULL_TREE, float_type_node, void_list_node);
 850   tmp = build_function_type (long_integer_type_node, type);
 851   gfc_define_builtin ("__builtin_lroundf", tmp, BUILT_IN_LROUNDF,
 852                       "lroundf", true);
 853   tmp = build_function_type (long_long_integer_type_node, type);
 854   gfc_define_builtin ("__builtin_llroundf", tmp, BUILT_IN_LLROUNDF,
 855                       "llroundf", true);
 856
 857   type = tree_cons (NULL_TREE, double_type_node, void_list_node);
 858   tmp = build_function_type (long_integer_type_node, type);
 859   gfc_define_builtin ("__builtin_lround", tmp, BUILT_IN_LROUND,
 860                       "lround", true);
 861   tmp = build_function_type (long_long_integer_type_node, type);
 862   gfc_define_builtin ("__builtin_llround", tmp, BUILT_IN_LLROUND,
 863                       "llround", true);
 864
 865   type = tree_cons (NULL_TREE, long_double_type_node, void_list_node);
 866   tmp = build_function_type (long_integer_type_node, type);
 867   gfc_define_builtin ("__builtin_lroundl", tmp, BUILT_IN_LROUNDL,
 868                       "lroundl", true);
 869   tmp = build_function_type (long_long_integer_type_node, type);
 870   gfc_define_builtin ("__builtin_llroundl", tmp, BUILT_IN_LLROUNDL,
 871                       "llroundl", true);
 872
 873   /* These are used to implement the ** operator.  */
 874   gfc_define_builtin ("__builtin_powl", mfunc_longdouble[1],
 875                       BUILT_IN_POWL, "powl", true);
 876   gfc_define_builtin ("__builtin_pow", mfunc_double[1],
 877                       BUILT_IN_POW, "pow", true);
 878   gfc_define_builtin ("__builtin_powf", mfunc_float[1],
 879                       BUILT_IN_POWF, "powf", true);
 880   gfc_define_builtin ("__builtin_cpowl", mfunc_clongdouble[1],
 881                       BUILT_IN_CPOWL, "cpowl", true);
 882   gfc_define_builtin ("__builtin_cpow", mfunc_cdouble[1],
 883                       BUILT_IN_CPOW, "cpow", true);
 884   gfc_define_builtin ("__builtin_cpowf", mfunc_cfloat[1],
 885                       BUILT_IN_CPOWF, "cpowf", true);
 886   gfc_define_builtin ("__builtin_powil", mfunc_longdouble[2],
 887                       BUILT_IN_POWIL, "powil", true);
 888   gfc_define_builtin ("__builtin_powi", mfunc_double[2],
 889                       BUILT_IN_POWI, "powi", true);
 890   gfc_define_builtin ("__builtin_powif", mfunc_float[2],
 891                       BUILT_IN_POWIF, "powif", true);
 892
 893
 894   if (TARGET_C99_FUNCTIONS)
 895     {
 896       gfc_define_builtin ("__builtin_cbrtl", mfunc_longdouble[0],
 897                           BUILT_IN_CBRTL, "cbrtl", true);
 898       gfc_define_builtin ("__builtin_cbrt", mfunc_double[0],
 899                           BUILT_IN_CBRT, "cbrt", true);
 900       gfc_define_builtin ("__builtin_cbrtf", mfunc_float[0],
 901                           BUILT_IN_CBRTF, "cbrtf", true);
 902       gfc_define_builtin ("__builtin_cexpil", func_longdouble_clongdouble,
 903                           BUILT_IN_CEXPIL, "cexpil", true);
 904       gfc_define_builtin ("__builtin_cexpi", func_double_cdouble,
 905                           BUILT_IN_CEXPI, "cexpi", true);
 906       gfc_define_builtin ("__builtin_cexpif", func_float_cfloat,
 907                           BUILT_IN_CEXPIF, "cexpif", true);
 908     }
 909
 910   if (TARGET_HAS_SINCOS)
 911     {
 912       gfc_define_builtin ("__builtin_sincosl",
 913                           func_longdouble_longdoublep_longdoublep,
 914                           BUILT_IN_SINCOSL, "sincosl", false);
 915       gfc_define_builtin ("__builtin_sincos", func_double_doublep_doublep,
 916                           BUILT_IN_SINCOS, "sincos", false);
 917       gfc_define_builtin ("__builtin_sincosf", func_float_floatp_floatp,
 918                           BUILT_IN_SINCOSF, "sincosf", false);
 919     }
 920
 921   /* For LEADZ / TRAILZ.  */
 922   tmp = tree_cons (NULL_TREE, unsigned_type_node, void_list_node);
 923   ftype = build_function_type (integer_type_node, tmp);
 924   gfc_define_builtin ("__builtin_clz", ftype, BUILT_IN_CLZ,
 925                       "__builtin_clz", true);
 926
 927   tmp = tree_cons (NULL_TREE, long_unsigned_type_node, void_list_node);
 928   ftype = build_function_type (integer_type_node, tmp);
 929   gfc_define_builtin ("__builtin_clzl", ftype, BUILT_IN_CLZL,
 930                       "__builtin_clzl", true);
 931
 932   tmp = tree_cons (NULL_TREE, long_long_unsigned_type_node, void_list_node);
 933   ftype = build_function_type (integer_type_node, tmp);
 934   gfc_define_builtin ("__builtin_clzll", ftype, BUILT_IN_CLZLL,
 935                       "__builtin_clzll", true);
 936
 937   tmp = tree_cons (NULL_TREE, unsigned_type_node, void_list_node);
 938   ftype = build_function_type (integer_type_node, tmp);
 939   gfc_define_builtin ("__builtin_ctz", ftype, BUILT_IN_CTZ,
 940                       "__builtin_ctz", true);
 941
 942   tmp = tree_cons (NULL_TREE, long_unsigned_type_node, void_list_node);
 943   ftype = build_function_type (integer_type_node, tmp);
 944   gfc_define_builtin ("__builtin_ctzl", ftype, BUILT_IN_CTZL,
 945                       "__builtin_ctzl", true);
 946
 947   tmp = tree_cons (NULL_TREE, long_long_unsigned_type_node, void_list_node);
 948   ftype = build_function_type (integer_type_node, tmp);
 949   gfc_define_builtin ("__builtin_ctzll", ftype, BUILT_IN_CTZLL,
 950                       "__builtin_ctzll", true);
 951
 952   /* Other builtin functions we use.  */
 953
 954   tmp = tree_cons (NULL_TREE, long_integer_type_node, void_list_node);
 955   tmp = tree_cons (NULL_TREE, long_integer_type_node, tmp);
 956   ftype = build_function_type (long_integer_type_node, tmp);
 957   gfc_define_builtin ("__builtin_expect", ftype, BUILT_IN_EXPECT,
 958                       "__builtin_expect", true);
 959
 960   tmp = tree_cons (NULL_TREE, pvoid_type_node, void_list_node);
 961   ftype = build_function_type (void_type_node, tmp);
 962   gfc_define_builtin ("__builtin_free", ftype, BUILT_IN_FREE,
 963                       "free", false);
 964
 965   tmp = tree_cons (NULL_TREE, size_type_node, void_list_node);
 966   ftype = build_function_type (pvoid_type_node, tmp);
 967   gfc_define_builtin ("__builtin_malloc", ftype, BUILT_IN_MALLOC,
 968                       "malloc", false);
 969   DECL_IS_MALLOC (built_in_decls[BUILT_IN_MALLOC]) = 1;
 970
 971   tmp = tree_cons (NULL_TREE, pvoid_type_node, void_list_node);
 972   tmp = tree_cons (NULL_TREE, size_type_node, tmp);
 973   ftype = build_function_type (pvoid_type_node, tmp);
 974   gfc_define_builtin ("__builtin_realloc", ftype, BUILT_IN_REALLOC,
 975                       "realloc", false);
 976
 977   tmp = tree_cons (NULL_TREE, void_type_node, void_list_node);
 978   ftype = build_function_type (integer_type_node, tmp);
 979   gfc_define_builtin ("__builtin_isnan", ftype, BUILT_IN_ISNAN,
 980                       "__builtin_isnan", true);
 981
 982 #define DEF_PRIMITIVE_TYPE(ENUM, VALUE) \
 983   builtin_types[(int) ENUM] = VALUE;
 984 #define DEF_FUNCTION_TYPE_0(ENUM, RETURN)               \
 985   builtin_types[(int) ENUM]                             \
 986     = build_function_type (builtin_types[(int) RETURN], \
 987                            void_list_node);
 988 #define DEF_FUNCTION_TYPE_1(ENUM, RETURN, ARG1)                         \
 989   builtin_types[(int) ENUM]                                             \
 990     = build_function_type (builtin_types[(int) RETURN],                 \
 991                            tree_cons (NULL_TREE,                        \
 992                                       builtin_types[(int) ARG1],        \
 993                                       void_list_node));
 994 #define DEF_FUNCTION_TYPE_2(ENUM, RETURN, ARG1, ARG2)   \
 995   builtin_types[(int) ENUM]                             \
 996     = build_function_type                               \
 997       (builtin_types[(int) RETURN],                     \
 998        tree_cons (NULL_TREE,                            \
 999                   builtin_types[(int) ARG1],            \
1000                   tree_cons (NULL_TREE,                 \
1001                              builtin_types[(int) ARG2], \
1002                              void_list_node)));
1003 #define DEF_FUNCTION_TYPE_3(ENUM, RETURN, ARG1, ARG2, ARG3)              \
1004   builtin_types[(int) ENUM]                                              \
1005     = build_function_type                                                \
1006       (builtin_types[(int) RETURN],                                      \
1007        tree_cons (NULL_TREE,                                             \
1008                   builtin_types[(int) ARG1],                             \
1009                   tree_cons (NULL_TREE,                                  \
1010                              builtin_types[(int) ARG2],                  \
1011                              tree_cons (NULL_TREE,                       \
1012                                         builtin_types[(int) ARG3],       \
1013                                         void_list_node))));
1014 #define DEF_FUNCTION_TYPE_4(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4)       \
1015   builtin_types[(int) ENUM]                                             \
1016     = build_function_type                                               \
1017       (builtin_types[(int) RETURN],                                     \
1018        tree_cons (NULL_TREE,                                            \
1019                   builtin_types[(int) ARG1],                            \
1020                   tree_cons (NULL_TREE,                                 \
1021                              builtin_types[(int) ARG2],                 \
1022                              tree_cons                                  \
1023                              (NULL_TREE,                                \
1024                               builtin_types[(int) ARG3],                \
1025                               tree_cons (NULL_TREE,                     \
1026                                          builtin_types[(int) ARG4],     \
1027                                          void_list_node)))));
1028 #define DEF_FUNCTION_TYPE_5(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5) \
1029   builtin_types[(int) ENUM]                                             \
1030     = build_function_type                                               \
1031       (builtin_types[(int) RETURN],                                     \
1032        tree_cons (NULL_TREE,                                            \
1033                   builtin_types[(int) ARG1],                            \
1034                   tree_cons (NULL_TREE,                                 \
1035                              builtin_types[(int) ARG2],                 \
1036                              tree_cons                                  \
1037                              (NULL_TREE,                                \
1038                               builtin_types[(int) ARG3],                \
1039                               tree_cons (NULL_TREE,                     \
1040                                          builtin_types[(int) ARG4],     \
1041                                          tree_cons (NULL_TREE,          \
1042                                               builtin_types[(int) ARG5],\
1043                                               void_list_node))))));
1044 #define DEF_FUNCTION_TYPE_6(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
1045                             ARG6)                                       \
1046   builtin_types[(int) ENUM]                                             \
1047     = build_function_type                                               \
1048       (builtin_types[(int) RETURN],                                     \
1049        tree_cons (NULL_TREE,                                            \
1050                   builtin_types[(int) ARG1],                            \
1051                   tree_cons (NULL_TREE,                                 \
1052                              builtin_types[(int) ARG2],                 \
1053                              tree_cons                                  \
1054                              (NULL_TREE,                                \
1055                               builtin_types[(int) ARG3],                \
1056                               tree_cons                                 \
1057                               (NULL_TREE,                               \
1058                                builtin_types[(int) ARG4],               \
1059                                tree_cons (NULL_TREE,                    \
1060                                          builtin_types[(int) ARG5],     \
1061                                          tree_cons (NULL_TREE,          \
1062                                               builtin_types[(int) ARG6],\
1063                                               void_list_node)))))));
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                                               \
1068       (builtin_types[(int) RETURN],                                     \
1069        tree_cons (NULL_TREE,                                            \
1070                   builtin_types[(int) ARG1],                            \
1071                   tree_cons (NULL_TREE,                                 \
1072                              builtin_types[(int) ARG2],                 \
1073                              tree_cons                                  \
1074                              (NULL_TREE,                                \
1075                               builtin_types[(int) ARG3],                \
1076                               tree_cons                                 \
1077                               (NULL_TREE,                               \
1078                                builtin_types[(int) ARG4],               \
1079                                tree_cons (NULL_TREE,                    \
1080                                          builtin_types[(int) ARG5],     \
1081                                          tree_cons (NULL_TREE,          \
1082                                               builtin_types[(int) ARG6],\
1083                                          tree_cons (NULL_TREE,          \
1084                                               builtin_types[(int) ARG6], \
1085                                               void_list_node))))))));
1086 #define DEF_FUNCTION_TYPE_VAR_0(ENUM, RETURN)                           \
1087   builtin_types[(int) ENUM]                                             \
1088     = build_function_type (builtin_types[(int) RETURN], NULL_TREE);
1089 #define DEF_POINTER_TYPE(ENUM, TYPE)                    \
1090   builtin_types[(int) ENUM]                             \
1091     = build_pointer_type (builtin_types[(int) TYPE]);
1092 #include "types.def"
1093 #undef DEF_PRIMITIVE_TYPE
1094 #undef DEF_FUNCTION_TYPE_1
1095 #undef DEF_FUNCTION_TYPE_2
1096 #undef DEF_FUNCTION_TYPE_3
1097 #undef DEF_FUNCTION_TYPE_4
1098 #undef DEF_FUNCTION_TYPE_5
1099 #undef DEF_FUNCTION_TYPE_6
1100 #undef DEF_FUNCTION_TYPE_VAR_0
1101 #undef DEF_POINTER_TYPE
1102   builtin_types[(int) BT_LAST] = NULL_TREE;
1103
1104   /* Initialize synchronization builtins.  */
1105 #undef DEF_SYNC_BUILTIN
1106 #define DEF_SYNC_BUILTIN(code, name, type, attr) \
1107     gfc_define_builtin (name, builtin_types[type], code, name, \
1108                         attr == ATTR_CONST_NOTHROW_LIST);
1109 #include "../sync-builtins.def"
1110 #undef DEF_SYNC_BUILTIN
1111
1112   if (gfc_option.flag_openmp || flag_tree_parallelize_loops)
1113     {
1114 #undef DEF_GOMP_BUILTIN
1115 #define DEF_GOMP_BUILTIN(code, name, type, attr) \
1116       gfc_define_builtin ("__builtin_" name, builtin_types[type], \
1117                           code, name, attr == ATTR_CONST_NOTHROW_LIST);
1118 #include "../omp-builtins.def"
1119 #undef DEF_GOMP_BUILTIN
1120     }
1121
1122   gfc_define_builtin ("__builtin_trap", builtin_types[BT_FN_VOID],
1123                       BUILT_IN_TRAP, NULL, false);
1124   TREE_THIS_VOLATILE (built_in_decls[BUILT_IN_TRAP]) = 1;
1125
1126   gfc_define_builtin ("__emutls_get_address",
1127                       builtin_types[BT_FN_PTR_PTR], BUILT_IN_EMUTLS_GET_ADDRESS,
1128                       "__emutls_get_address", true);
1129   gfc_define_builtin ("__emutls_register_common",
1130                       builtin_types[BT_FN_VOID_PTR_WORD_WORD_PTR],
1131                       BUILT_IN_EMUTLS_REGISTER_COMMON,
1132                       "__emutls_register_common", false);
1133
1134   build_common_builtin_nodes ();
1135   targetm.init_builtins ();
1136 }
1137
1138 #undef DEFINE_MATH_BUILTIN_C
1139 #undef DEFINE_MATH_BUILTIN
1140
1141 static void
1142 gfc_init_ts (void)
1143 {
1144   tree_contains_struct[NAMESPACE_DECL][TS_DECL_NON_COMMON] = 1;
1145   tree_contains_struct[NAMESPACE_DECL][TS_DECL_WITH_VIS] = 1;
1146   tree_contains_struct[NAMESPACE_DECL][TS_DECL_WRTL] = 1;
1147   tree_contains_struct[NAMESPACE_DECL][TS_DECL_COMMON] = 1;
1148   tree_contains_struct[NAMESPACE_DECL][TS_DECL_MINIMAL] = 1;
1149 }
1150
1151 void
1152 gfc_maybe_initialize_eh (void)
1153 {
1154   if (!flag_exceptions || gfc_eh_initialized_p)
1155     return;
1156
1157   gfc_eh_initialized_p = true;
1158   using_eh_for_cleanups ();
1159 }
1160
1161
1162 #include "gt-fortran-f95-lang.h"
1163 #include "gtype-fortran.h"