OSDN Git Service

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