projects / gcc.git / blob
? search:


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