OSDN Git Service

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