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