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