gcc/fortran/f95-lang.c

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