OSDN Git Service

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