OpenACC acc_on_device.
[official-gcc.git] / gcc / fortran / f95-lang.c
blob1b017b121f4b0abf94abaf0fecc3209bd2c890f2
1 /* gfortran backend interface
2 Copyright (C) 2000-2014 Free Software Foundation, Inc.
3 Contributed by Paul Brook.
5 This file is part of GCC.
7 GCC is free software; you can redistribute it and/or modify it under
8 the terms of the GNU General Public License as published by the Free
9 Software Foundation; either version 3, or (at your option) any later
10 version.
12 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
13 WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
15 for more details.
17 You should have received a copy of the GNU General Public License
18 along with GCC; see the file COPYING3. If not see
19 <http://www.gnu.org/licenses/>. */
21 /* f95-lang.c-- GCC backend interface stuff */
23 /* declare required prototypes: */
25 #include "config.h"
26 #include "system.h"
27 #include "ansidecl.h"
28 #include "system.h"
29 #include "coretypes.h"
30 #include "gfortran.h"
31 #include "tree.h"
32 #include "flags.h"
33 #include "langhooks.h"
34 #include "langhooks-def.h"
35 #include "timevar.h"
36 #include "tm.h"
37 #include "function.h"
38 #include "ggc.h"
39 #include "toplev.h"
40 #include "target.h"
41 #include "debug.h"
42 #include "diagnostic.h" /* For errorcount/warningcount */
43 #include "dumpfile.h"
44 #include "cgraph.h"
45 #include "cpp.h"
46 #include "trans.h"
47 #include "trans-types.h"
48 #include "trans-const.h"
50 /* Language-dependent contents of an identifier. */
52 struct GTY(())
53 lang_identifier {
54 struct tree_identifier common;
57 /* The resulting tree type. */
59 union GTY((desc ("TREE_CODE (&%h.generic) == IDENTIFIER_NODE"),
60 chain_next ("CODE_CONTAINS_STRUCT (TREE_CODE (&%h.generic), TS_COMMON) ? ((union lang_tree_node *) TREE_CHAIN (&%h.generic)) : NULL")))
61 lang_tree_node {
62 union tree_node GTY((tag ("0"),
63 desc ("tree_node_structure (&%h)"))) generic;
64 struct lang_identifier GTY((tag ("1"))) identifier;
67 /* Save and restore the variables in this file and elsewhere
68 that keep track of the progress of compilation of the current function.
69 Used for nested functions. */
71 struct GTY(())
72 language_function {
73 /* struct gfc_language_function base; */
74 struct binding_level *binding_level;
77 static void gfc_init_decl_processing (void);
78 static void gfc_init_builtin_functions (void);
79 static bool global_bindings_p (void);
81 /* Each front end provides its own. */
82 static bool gfc_init (void);
83 static void gfc_finish (void);
84 static void gfc_write_global_declarations (void);
85 static void gfc_be_parse_file (void);
86 static alias_set_type gfc_get_alias_set (tree);
87 static void gfc_init_ts (void);
88 static tree gfc_builtin_function (tree);
90 /* Handle an "omp declare target" attribute; arguments as in
91 struct attribute_spec.handler. */
92 static tree
93 gfc_handle_omp_declare_target_attribute (tree *, tree, tree, int, bool *)
95 return NULL_TREE;
98 /* Table of valid Fortran attributes. */
99 static const struct attribute_spec gfc_attribute_table[] =
101 /* { name, min_len, max_len, decl_req, type_req, fn_type_req, handler,
102 affects_type_identity } */
103 { "omp declare target", 0, 0, true, false, false,
104 gfc_handle_omp_declare_target_attribute, false },
105 { NULL, 0, 0, false, false, false, NULL, false }
108 #undef LANG_HOOKS_NAME
109 #undef LANG_HOOKS_INIT
110 #undef LANG_HOOKS_FINISH
111 #undef LANG_HOOKS_WRITE_GLOBALS
112 #undef LANG_HOOKS_OPTION_LANG_MASK
113 #undef LANG_HOOKS_INIT_OPTIONS_STRUCT
114 #undef LANG_HOOKS_INIT_OPTIONS
115 #undef LANG_HOOKS_HANDLE_OPTION
116 #undef LANG_HOOKS_POST_OPTIONS
117 #undef LANG_HOOKS_PARSE_FILE
118 #undef LANG_HOOKS_MARK_ADDRESSABLE
119 #undef LANG_HOOKS_TYPE_FOR_MODE
120 #undef LANG_HOOKS_TYPE_FOR_SIZE
121 #undef LANG_HOOKS_GET_ALIAS_SET
122 #undef LANG_HOOKS_INIT_TS
123 #undef LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE
124 #undef LANG_HOOKS_OMP_PREDETERMINED_SHARING
125 #undef LANG_HOOKS_OMP_REPORT_DECL
126 #undef LANG_HOOKS_OMP_CLAUSE_DEFAULT_CTOR
127 #undef LANG_HOOKS_OMP_CLAUSE_COPY_CTOR
128 #undef LANG_HOOKS_OMP_CLAUSE_ASSIGN_OP
129 #undef LANG_HOOKS_OMP_CLAUSE_LINEAR_CTOR
130 #undef LANG_HOOKS_OMP_CLAUSE_DTOR
131 #undef LANG_HOOKS_OMP_FINISH_CLAUSE
132 #undef LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR
133 #undef LANG_HOOKS_OMP_PRIVATE_DEBUG_CLAUSE
134 #undef LANG_HOOKS_OMP_PRIVATE_OUTER_REF
135 #undef LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES
136 #undef LANG_HOOKS_BUILTIN_FUNCTION
137 #undef LANG_HOOKS_BUILTIN_FUNCTION
138 #undef LANG_HOOKS_GET_ARRAY_DESCR_INFO
139 #undef LANG_HOOKS_ATTRIBUTE_TABLE
141 /* Define lang hooks. */
142 #define LANG_HOOKS_NAME "GNU Fortran"
143 #define LANG_HOOKS_INIT gfc_init
144 #define LANG_HOOKS_FINISH gfc_finish
145 #define LANG_HOOKS_WRITE_GLOBALS gfc_write_global_declarations
146 #define LANG_HOOKS_OPTION_LANG_MASK gfc_option_lang_mask
147 #define LANG_HOOKS_INIT_OPTIONS_STRUCT gfc_init_options_struct
148 #define LANG_HOOKS_INIT_OPTIONS gfc_init_options
149 #define LANG_HOOKS_HANDLE_OPTION gfc_handle_option
150 #define LANG_HOOKS_POST_OPTIONS gfc_post_options
151 #define LANG_HOOKS_PARSE_FILE gfc_be_parse_file
152 #define LANG_HOOKS_TYPE_FOR_MODE gfc_type_for_mode
153 #define LANG_HOOKS_TYPE_FOR_SIZE gfc_type_for_size
154 #define LANG_HOOKS_GET_ALIAS_SET gfc_get_alias_set
155 #define LANG_HOOKS_INIT_TS gfc_init_ts
156 #define LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE gfc_omp_privatize_by_reference
157 #define LANG_HOOKS_OMP_PREDETERMINED_SHARING gfc_omp_predetermined_sharing
158 #define LANG_HOOKS_OMP_REPORT_DECL gfc_omp_report_decl
159 #define LANG_HOOKS_OMP_CLAUSE_DEFAULT_CTOR gfc_omp_clause_default_ctor
160 #define LANG_HOOKS_OMP_CLAUSE_COPY_CTOR gfc_omp_clause_copy_ctor
161 #define LANG_HOOKS_OMP_CLAUSE_ASSIGN_OP gfc_omp_clause_assign_op
162 #define LANG_HOOKS_OMP_CLAUSE_LINEAR_CTOR gfc_omp_clause_linear_ctor
163 #define LANG_HOOKS_OMP_CLAUSE_DTOR gfc_omp_clause_dtor
164 #define LANG_HOOKS_OMP_FINISH_CLAUSE gfc_omp_finish_clause
165 #define LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR gfc_omp_disregard_value_expr
166 #define LANG_HOOKS_OMP_PRIVATE_DEBUG_CLAUSE gfc_omp_private_debug_clause
167 #define LANG_HOOKS_OMP_PRIVATE_OUTER_REF gfc_omp_private_outer_ref
168 #define LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES \
169 gfc_omp_firstprivatize_type_sizes
170 #define LANG_HOOKS_BUILTIN_FUNCTION gfc_builtin_function
171 #define LANG_HOOKS_GET_ARRAY_DESCR_INFO gfc_get_array_descr_info
172 #define LANG_HOOKS_ATTRIBUTE_TABLE gfc_attribute_table
174 struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
176 #define NULL_BINDING_LEVEL (struct binding_level *) NULL
178 /* A chain of binding_level structures awaiting reuse. */
180 static GTY(()) struct binding_level *free_binding_level;
182 /* True means we've initialized exception handling. */
183 static bool gfc_eh_initialized_p;
185 /* The current translation unit. */
186 static GTY(()) tree current_translation_unit;
189 static void
190 gfc_create_decls (void)
192 /* GCC builtins. */
193 gfc_init_builtin_functions ();
195 /* Runtime/IO library functions. */
196 gfc_build_builtin_function_decls ();
198 gfc_init_constants ();
200 /* Build our translation-unit decl. */
201 current_translation_unit = build_translation_unit_decl (NULL_TREE);
205 static void
206 gfc_be_parse_file (void)
208 int errors;
209 int warnings;
211 gfc_create_decls ();
212 gfc_parse_file ();
213 gfc_generate_constructors ();
215 /* Tell the frontend about any errors. */
216 gfc_get_errors (&warnings, &errors);
217 errorcount += errors;
218 warningcount += warnings;
220 /* Clear the binding level stack. */
221 while (!global_bindings_p ())
222 poplevel (0, 0);
226 /* Initialize everything. */
228 static bool
229 gfc_init (void)
231 if (!gfc_cpp_enabled ())
233 linemap_add (line_table, LC_ENTER, false, gfc_source_file, 1);
234 linemap_add (line_table, LC_RENAME, false, "<built-in>", 0);
236 else
237 gfc_cpp_init_0 ();
239 gfc_init_decl_processing ();
240 gfc_static_ctors = NULL_TREE;
242 if (gfc_cpp_enabled ())
243 gfc_cpp_init ();
245 gfc_init_1 ();
247 if (!gfc_new_file ())
248 fatal_error ("can't open input file: %s", gfc_source_file);
250 if (flag_preprocess_only)
251 return false;
253 return true;
257 static void
258 gfc_finish (void)
260 gfc_cpp_done ();
261 gfc_done_1 ();
262 gfc_release_include_path ();
263 return;
266 /* ??? This is something of a hack.
268 Emulated tls lowering needs to see all TLS variables before we call
269 finalize_compilation_unit. The C/C++ front ends manage this
270 by calling decl_rest_of_compilation on each global and static variable
271 as they are seen. The Fortran front end waits until this hook.
273 A Correct solution is for finalize_compilation_unit not to be
274 called during the WRITE_GLOBALS langhook, and have that hook only do what
275 its name suggests and write out globals. But the C++ and Java front ends
276 have (unspecified) problems with aliases that gets in the way. It has
277 been suggested that these problems would be solved by completing the
278 conversion to cgraph-based aliases. */
280 static void
281 gfc_write_global_declarations (void)
283 tree decl;
285 /* Finalize all of the globals. */
286 for (decl = getdecls(); decl ; decl = DECL_CHAIN (decl))
287 rest_of_decl_compilation (decl, true, true);
289 write_global_declarations ();
292 /* These functions and variables deal with binding contours. We only
293 need these functions for the list of PARM_DECLs, but we leave the
294 functions more general; these are a simplified version of the
295 functions from GNAT. */
297 /* For each binding contour we allocate a binding_level structure which
298 records the entities defined or declared in that contour. Contours
299 include:
301 the global one
302 one for each subprogram definition
303 one for each compound statement (declare block)
305 Binding contours are used to create GCC tree BLOCK nodes. */
307 struct GTY(())
308 binding_level {
309 /* A chain of ..._DECL nodes for all variables, constants, functions,
310 parameters and type declarations. These ..._DECL nodes are chained
311 through the DECL_CHAIN field. */
312 tree names;
313 /* For each level (except the global one), a chain of BLOCK nodes for all
314 the levels that were entered and exited one level down from this one. */
315 tree blocks;
316 /* The binding level containing this one (the enclosing binding level). */
317 struct binding_level *level_chain;
320 /* The binding level currently in effect. */
321 static GTY(()) struct binding_level *current_binding_level = NULL;
323 /* The outermost binding level. This binding level is created when the
324 compiler is started and it will exist through the entire compilation. */
325 static GTY(()) struct binding_level *global_binding_level;
327 /* Binding level structures are initialized by copying this one. */
328 static struct binding_level clear_binding_level = { NULL, NULL, NULL };
331 /* Return true if we are in the global binding level. */
333 bool
334 global_bindings_p (void)
336 return current_binding_level == global_binding_level;
339 tree
340 getdecls (void)
342 return current_binding_level->names;
345 /* Enter a new binding level. */
347 void
348 pushlevel (void)
350 struct binding_level *newlevel = ggc_alloc<binding_level> ();
352 *newlevel = clear_binding_level;
354 /* Add this level to the front of the chain (stack) of levels that are
355 active. */
356 newlevel->level_chain = current_binding_level;
357 current_binding_level = newlevel;
360 /* Exit a binding level.
361 Pop the level off, and restore the state of the identifier-decl mappings
362 that were in effect when this level was entered.
364 If KEEP is nonzero, this level had explicit declarations, so
365 and create a "block" (a BLOCK node) for the level
366 to record its declarations and subblocks for symbol table output.
368 If FUNCTIONBODY is nonzero, this level is the body of a function,
369 so create a block as if KEEP were set and also clear out all
370 label names. */
372 tree
373 poplevel (int keep, int functionbody)
375 /* Points to a BLOCK tree node. This is the BLOCK node constructed for the
376 binding level that we are about to exit and which is returned by this
377 routine. */
378 tree block_node = NULL_TREE;
379 tree decl_chain = current_binding_level->names;
380 tree subblock_chain = current_binding_level->blocks;
381 tree subblock_node;
383 /* If there were any declarations in the current binding level, or if this
384 binding level is a function body, or if there are any nested blocks then
385 create a BLOCK node to record them for the life of this function. */
386 if (keep || functionbody)
387 block_node = build_block (keep ? decl_chain : 0, subblock_chain, 0, 0);
389 /* Record the BLOCK node just built as the subblock its enclosing scope. */
390 for (subblock_node = subblock_chain; subblock_node;
391 subblock_node = BLOCK_CHAIN (subblock_node))
392 BLOCK_SUPERCONTEXT (subblock_node) = block_node;
394 /* Clear out the meanings of the local variables of this level. */
396 for (subblock_node = decl_chain; subblock_node;
397 subblock_node = DECL_CHAIN (subblock_node))
398 if (DECL_NAME (subblock_node) != 0)
399 /* If the identifier was used or addressed via a local extern decl,
400 don't forget that fact. */
401 if (DECL_EXTERNAL (subblock_node))
403 if (TREE_USED (subblock_node))
404 TREE_USED (DECL_NAME (subblock_node)) = 1;
405 if (TREE_ADDRESSABLE (subblock_node))
406 TREE_ADDRESSABLE (DECL_ASSEMBLER_NAME (subblock_node)) = 1;
409 /* Pop the current level. */
410 current_binding_level = current_binding_level->level_chain;
412 if (functionbody)
413 /* This is the top level block of a function. */
414 DECL_INITIAL (current_function_decl) = block_node;
415 else if (current_binding_level == global_binding_level)
416 /* When using gfc_start_block/gfc_finish_block from middle-end hooks,
417 don't add newly created BLOCKs as subblocks of global_binding_level. */
419 else if (block_node)
421 current_binding_level->blocks
422 = block_chainon (current_binding_level->blocks, block_node);
425 /* If we did not make a block for the level just exited, any blocks made for
426 inner levels (since they cannot be recorded as subblocks in that level)
427 must be carried forward so they will later become subblocks of something
428 else. */
429 else if (subblock_chain)
430 current_binding_level->blocks
431 = block_chainon (current_binding_level->blocks, subblock_chain);
432 if (block_node)
433 TREE_USED (block_node) = 1;
435 return block_node;
439 /* Records a ..._DECL node DECL as belonging to the current lexical scope.
440 Returns the ..._DECL node. */
442 tree
443 pushdecl (tree decl)
445 if (global_bindings_p ())
446 DECL_CONTEXT (decl) = current_translation_unit;
447 else
449 /* External objects aren't nested. For debug info insert a copy
450 of the decl into the binding level. */
451 if (DECL_EXTERNAL (decl))
453 tree orig = decl;
454 decl = copy_node (decl);
455 DECL_CONTEXT (orig) = NULL_TREE;
457 DECL_CONTEXT (decl) = current_function_decl;
460 /* Put the declaration on the list. */
461 DECL_CHAIN (decl) = current_binding_level->names;
462 current_binding_level->names = decl;
464 /* For the declaration of a type, set its name if it is not already set. */
466 if (TREE_CODE (decl) == TYPE_DECL && TYPE_NAME (TREE_TYPE (decl)) == 0)
468 if (DECL_SOURCE_LINE (decl) == 0)
469 TYPE_NAME (TREE_TYPE (decl)) = decl;
470 else
471 TYPE_NAME (TREE_TYPE (decl)) = DECL_NAME (decl);
474 return decl;
478 /* Like pushdecl, only it places X in GLOBAL_BINDING_LEVEL. */
480 tree
481 pushdecl_top_level (tree x)
483 tree t;
484 struct binding_level *b = current_binding_level;
486 current_binding_level = global_binding_level;
487 t = pushdecl (x);
488 current_binding_level = b;
489 return t;
492 #ifndef CHAR_TYPE_SIZE
493 #define CHAR_TYPE_SIZE BITS_PER_UNIT
494 #endif
496 #ifndef INT_TYPE_SIZE
497 #define INT_TYPE_SIZE BITS_PER_WORD
498 #endif
500 #undef SIZE_TYPE
501 #define SIZE_TYPE "long unsigned int"
503 /* Create tree nodes for the basic scalar types of Fortran 95,
504 and some nodes representing standard constants (0, 1, (void *) 0).
505 Initialize the global binding level.
506 Make definitions for built-in primitive functions. */
507 static void
508 gfc_init_decl_processing (void)
510 current_function_decl = NULL;
511 current_binding_level = NULL_BINDING_LEVEL;
512 free_binding_level = NULL_BINDING_LEVEL;
514 /* Make the binding_level structure for global names. We move all
515 variables that are in a COMMON block to this binding level. */
516 pushlevel ();
517 global_binding_level = current_binding_level;
519 /* Build common tree nodes. char_type_node is unsigned because we
520 only use it for actual characters, not for INTEGER(1). Also, we
521 want double_type_node to actually have double precision. */
522 build_common_tree_nodes (false, false);
524 void_list_node = build_tree_list (NULL_TREE, void_type_node);
526 /* Set up F95 type nodes. */
527 gfc_init_kinds ();
528 gfc_init_types ();
529 gfc_init_c_interop_kinds ();
533 /* Return the typed-based alias set for T, which may be an expression
534 or a type. Return -1 if we don't do anything special. */
536 static alias_set_type
537 gfc_get_alias_set (tree t)
539 tree u;
541 /* Permit type-punning when accessing an EQUIVALENCEd variable or
542 mixed type entry master's return value. */
543 for (u = t; handled_component_p (u); u = TREE_OPERAND (u, 0))
544 if (TREE_CODE (u) == COMPONENT_REF
545 && TREE_CODE (TREE_TYPE (TREE_OPERAND (u, 0))) == UNION_TYPE)
546 return 0;
548 return -1;
551 /* Builtin function initialization. */
553 static tree
554 gfc_builtin_function (tree decl)
556 pushdecl (decl);
557 return decl;
560 /* So far we need just these 7 attribute types. */
561 #define ATTR_NULL 0
562 #define ATTR_LEAF_LIST (ECF_LEAF)
563 #define ATTR_NOTHROW_LEAF_LIST (ECF_NOTHROW | ECF_LEAF)
564 #define ATTR_NOTHROW_LEAF_MALLOC_LIST (ECF_NOTHROW | ECF_LEAF | ECF_MALLOC)
565 #define ATTR_CONST_NOTHROW_LEAF_LIST (ECF_NOTHROW | ECF_LEAF | ECF_CONST)
566 #define ATTR_NOTHROW_LIST (ECF_NOTHROW)
567 #define ATTR_CONST_NOTHROW_LIST (ECF_NOTHROW | ECF_CONST)
569 static void
570 gfc_define_builtin (const char *name, tree type, enum built_in_function code,
571 const char *library_name, int attr)
573 tree decl;
575 decl = add_builtin_function (name, type, code, BUILT_IN_NORMAL,
576 library_name, NULL_TREE);
577 set_call_expr_flags (decl, attr);
579 set_builtin_decl (code, decl, true);
583 #define DO_DEFINE_MATH_BUILTIN(code, name, argtype, tbase) \
584 gfc_define_builtin ("__builtin_" name "l", tbase##longdouble[argtype], \
585 BUILT_IN_ ## code ## L, name "l", \
586 ATTR_CONST_NOTHROW_LEAF_LIST); \
587 gfc_define_builtin ("__builtin_" name, tbase##double[argtype], \
588 BUILT_IN_ ## code, name, \
589 ATTR_CONST_NOTHROW_LEAF_LIST); \
590 gfc_define_builtin ("__builtin_" name "f", tbase##float[argtype], \
591 BUILT_IN_ ## code ## F, name "f", \
592 ATTR_CONST_NOTHROW_LEAF_LIST);
594 #define DEFINE_MATH_BUILTIN(code, name, argtype) \
595 DO_DEFINE_MATH_BUILTIN (code, name, argtype, mfunc_)
597 #define DEFINE_MATH_BUILTIN_C(code, name, argtype) \
598 DO_DEFINE_MATH_BUILTIN (code, name, argtype, mfunc_) \
599 DO_DEFINE_MATH_BUILTIN (C##code, "c" name, argtype, mfunc_c)
602 /* Create function types for builtin functions. */
604 static void
605 build_builtin_fntypes (tree *fntype, tree type)
607 /* type (*) (type) */
608 fntype[0] = build_function_type_list (type, type, NULL_TREE);
609 /* type (*) (type, type) */
610 fntype[1] = build_function_type_list (type, type, type, NULL_TREE);
611 /* type (*) (type, int) */
612 fntype[2] = build_function_type_list (type,
613 type, integer_type_node, NULL_TREE);
614 /* type (*) (void) */
615 fntype[3] = build_function_type_list (type, NULL_TREE);
616 /* type (*) (type, &int) */
617 fntype[4] = build_function_type_list (type, type,
618 build_pointer_type (integer_type_node),
619 NULL_TREE);
620 /* type (*) (int, type) */
621 fntype[5] = build_function_type_list (type,
622 integer_type_node, type, NULL_TREE);
626 static tree
627 builtin_type_for_size (int size, bool unsignedp)
629 tree type = gfc_type_for_size (size, unsignedp);
630 return type ? type : error_mark_node;
633 /* Initialization of builtin function nodes. */
635 static void
636 gfc_init_builtin_functions (void)
638 enum builtin_type
640 #define DEF_PRIMITIVE_TYPE(NAME, VALUE) NAME,
641 #define DEF_FUNCTION_TYPE_0(NAME, RETURN) NAME,
642 #define DEF_FUNCTION_TYPE_1(NAME, RETURN, ARG1) NAME,
643 #define DEF_FUNCTION_TYPE_2(NAME, RETURN, ARG1, ARG2) NAME,
644 #define DEF_FUNCTION_TYPE_3(NAME, RETURN, ARG1, ARG2, ARG3) NAME,
645 #define DEF_FUNCTION_TYPE_4(NAME, RETURN, ARG1, ARG2, ARG3, ARG4) NAME,
646 #define DEF_FUNCTION_TYPE_5(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5) NAME,
647 #define DEF_FUNCTION_TYPE_6(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
648 ARG6) NAME,
649 #define DEF_FUNCTION_TYPE_7(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
650 ARG6, ARG7) NAME,
651 #define DEF_FUNCTION_TYPE_8(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
652 ARG6, ARG7, ARG8) NAME,
653 #define DEF_FUNCTION_TYPE_10(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
654 ARG6, ARG7, ARG8, ARG9, ARG10) NAME,
655 #define DEF_FUNCTION_TYPE_VAR_0(NAME, RETURN) NAME,
656 #define DEF_POINTER_TYPE(NAME, TYPE) NAME,
657 #include "types.def"
658 #undef DEF_PRIMITIVE_TYPE
659 #undef DEF_FUNCTION_TYPE_0
660 #undef DEF_FUNCTION_TYPE_1
661 #undef DEF_FUNCTION_TYPE_2
662 #undef DEF_FUNCTION_TYPE_3
663 #undef DEF_FUNCTION_TYPE_4
664 #undef DEF_FUNCTION_TYPE_5
665 #undef DEF_FUNCTION_TYPE_6
666 #undef DEF_FUNCTION_TYPE_7
667 #undef DEF_FUNCTION_TYPE_8
668 #undef DEF_FUNCTION_TYPE_10
669 #undef DEF_FUNCTION_TYPE_VAR_0
670 #undef DEF_POINTER_TYPE
671 BT_LAST
674 tree mfunc_float[6];
675 tree mfunc_double[6];
676 tree mfunc_longdouble[6];
677 tree mfunc_cfloat[6];
678 tree mfunc_cdouble[6];
679 tree mfunc_clongdouble[6];
680 tree func_cfloat_float, func_float_cfloat;
681 tree func_cdouble_double, func_double_cdouble;
682 tree func_clongdouble_longdouble, func_longdouble_clongdouble;
683 tree func_float_floatp_floatp;
684 tree func_double_doublep_doublep;
685 tree func_longdouble_longdoublep_longdoublep;
686 tree ftype, ptype;
687 tree builtin_types[(int) BT_LAST + 1];
689 build_builtin_fntypes (mfunc_float, float_type_node);
690 build_builtin_fntypes (mfunc_double, double_type_node);
691 build_builtin_fntypes (mfunc_longdouble, long_double_type_node);
692 build_builtin_fntypes (mfunc_cfloat, complex_float_type_node);
693 build_builtin_fntypes (mfunc_cdouble, complex_double_type_node);
694 build_builtin_fntypes (mfunc_clongdouble, complex_long_double_type_node);
696 func_cfloat_float = build_function_type_list (float_type_node,
697 complex_float_type_node,
698 NULL_TREE);
700 func_float_cfloat = build_function_type_list (complex_float_type_node,
701 float_type_node, NULL_TREE);
703 func_cdouble_double = build_function_type_list (double_type_node,
704 complex_double_type_node,
705 NULL_TREE);
707 func_double_cdouble = build_function_type_list (complex_double_type_node,
708 double_type_node, NULL_TREE);
710 func_clongdouble_longdouble =
711 build_function_type_list (long_double_type_node,
712 complex_long_double_type_node, NULL_TREE);
714 func_longdouble_clongdouble =
715 build_function_type_list (complex_long_double_type_node,
716 long_double_type_node, NULL_TREE);
718 ptype = build_pointer_type (float_type_node);
719 func_float_floatp_floatp =
720 build_function_type_list (void_type_node, ptype, ptype, NULL_TREE);
722 ptype = build_pointer_type (double_type_node);
723 func_double_doublep_doublep =
724 build_function_type_list (void_type_node, ptype, ptype, NULL_TREE);
726 ptype = build_pointer_type (long_double_type_node);
727 func_longdouble_longdoublep_longdoublep =
728 build_function_type_list (void_type_node, ptype, ptype, NULL_TREE);
730 /* Non-math builtins are defined manually, so they're not included here. */
731 #define OTHER_BUILTIN(ID,NAME,TYPE,CONST)
733 #include "mathbuiltins.def"
735 gfc_define_builtin ("__builtin_roundl", mfunc_longdouble[0],
736 BUILT_IN_ROUNDL, "roundl", ATTR_CONST_NOTHROW_LEAF_LIST);
737 gfc_define_builtin ("__builtin_round", mfunc_double[0],
738 BUILT_IN_ROUND, "round", ATTR_CONST_NOTHROW_LEAF_LIST);
739 gfc_define_builtin ("__builtin_roundf", mfunc_float[0],
740 BUILT_IN_ROUNDF, "roundf", ATTR_CONST_NOTHROW_LEAF_LIST);
742 gfc_define_builtin ("__builtin_truncl", mfunc_longdouble[0],
743 BUILT_IN_TRUNCL, "truncl", ATTR_CONST_NOTHROW_LEAF_LIST);
744 gfc_define_builtin ("__builtin_trunc", mfunc_double[0],
745 BUILT_IN_TRUNC, "trunc", ATTR_CONST_NOTHROW_LEAF_LIST);
746 gfc_define_builtin ("__builtin_truncf", mfunc_float[0],
747 BUILT_IN_TRUNCF, "truncf", ATTR_CONST_NOTHROW_LEAF_LIST);
749 gfc_define_builtin ("__builtin_cabsl", func_clongdouble_longdouble,
750 BUILT_IN_CABSL, "cabsl", ATTR_CONST_NOTHROW_LEAF_LIST);
751 gfc_define_builtin ("__builtin_cabs", func_cdouble_double,
752 BUILT_IN_CABS, "cabs", ATTR_CONST_NOTHROW_LEAF_LIST);
753 gfc_define_builtin ("__builtin_cabsf", func_cfloat_float,
754 BUILT_IN_CABSF, "cabsf", ATTR_CONST_NOTHROW_LEAF_LIST);
756 gfc_define_builtin ("__builtin_copysignl", mfunc_longdouble[1],
757 BUILT_IN_COPYSIGNL, "copysignl",
758 ATTR_CONST_NOTHROW_LEAF_LIST);
759 gfc_define_builtin ("__builtin_copysign", mfunc_double[1],
760 BUILT_IN_COPYSIGN, "copysign",
761 ATTR_CONST_NOTHROW_LEAF_LIST);
762 gfc_define_builtin ("__builtin_copysignf", mfunc_float[1],
763 BUILT_IN_COPYSIGNF, "copysignf",
764 ATTR_CONST_NOTHROW_LEAF_LIST);
766 gfc_define_builtin ("__builtin_nextafterl", mfunc_longdouble[1],
767 BUILT_IN_NEXTAFTERL, "nextafterl",
768 ATTR_CONST_NOTHROW_LEAF_LIST);
769 gfc_define_builtin ("__builtin_nextafter", mfunc_double[1],
770 BUILT_IN_NEXTAFTER, "nextafter",
771 ATTR_CONST_NOTHROW_LEAF_LIST);
772 gfc_define_builtin ("__builtin_nextafterf", mfunc_float[1],
773 BUILT_IN_NEXTAFTERF, "nextafterf",
774 ATTR_CONST_NOTHROW_LEAF_LIST);
776 gfc_define_builtin ("__builtin_frexpl", mfunc_longdouble[4],
777 BUILT_IN_FREXPL, "frexpl", ATTR_NOTHROW_LEAF_LIST);
778 gfc_define_builtin ("__builtin_frexp", mfunc_double[4],
779 BUILT_IN_FREXP, "frexp", ATTR_NOTHROW_LEAF_LIST);
780 gfc_define_builtin ("__builtin_frexpf", mfunc_float[4],
781 BUILT_IN_FREXPF, "frexpf", ATTR_NOTHROW_LEAF_LIST);
783 gfc_define_builtin ("__builtin_fabsl", mfunc_longdouble[0],
784 BUILT_IN_FABSL, "fabsl", ATTR_CONST_NOTHROW_LEAF_LIST);
785 gfc_define_builtin ("__builtin_fabs", mfunc_double[0],
786 BUILT_IN_FABS, "fabs", ATTR_CONST_NOTHROW_LEAF_LIST);
787 gfc_define_builtin ("__builtin_fabsf", mfunc_float[0],
788 BUILT_IN_FABSF, "fabsf", ATTR_CONST_NOTHROW_LEAF_LIST);
790 gfc_define_builtin ("__builtin_scalbnl", mfunc_longdouble[5],
791 BUILT_IN_SCALBNL, "scalbnl", ATTR_CONST_NOTHROW_LEAF_LIST);
792 gfc_define_builtin ("__builtin_scalbn", mfunc_double[5],
793 BUILT_IN_SCALBN, "scalbn", ATTR_CONST_NOTHROW_LEAF_LIST);
794 gfc_define_builtin ("__builtin_scalbnf", mfunc_float[5],
795 BUILT_IN_SCALBNF, "scalbnf", ATTR_CONST_NOTHROW_LEAF_LIST);
797 gfc_define_builtin ("__builtin_fmodl", mfunc_longdouble[1],
798 BUILT_IN_FMODL, "fmodl", ATTR_CONST_NOTHROW_LEAF_LIST);
799 gfc_define_builtin ("__builtin_fmod", mfunc_double[1],
800 BUILT_IN_FMOD, "fmod", ATTR_CONST_NOTHROW_LEAF_LIST);
801 gfc_define_builtin ("__builtin_fmodf", mfunc_float[1],
802 BUILT_IN_FMODF, "fmodf", ATTR_CONST_NOTHROW_LEAF_LIST);
804 /* iround{f,,l}, lround{f,,l} and llround{f,,l} */
805 ftype = build_function_type_list (integer_type_node,
806 float_type_node, NULL_TREE);
807 gfc_define_builtin("__builtin_iroundf", ftype, BUILT_IN_IROUNDF,
808 "iroundf", ATTR_CONST_NOTHROW_LEAF_LIST);
809 ftype = build_function_type_list (long_integer_type_node,
810 float_type_node, NULL_TREE);
811 gfc_define_builtin ("__builtin_lroundf", ftype, BUILT_IN_LROUNDF,
812 "lroundf", ATTR_CONST_NOTHROW_LEAF_LIST);
813 ftype = build_function_type_list (long_long_integer_type_node,
814 float_type_node, NULL_TREE);
815 gfc_define_builtin ("__builtin_llroundf", ftype, BUILT_IN_LLROUNDF,
816 "llroundf", ATTR_CONST_NOTHROW_LEAF_LIST);
818 ftype = build_function_type_list (integer_type_node,
819 double_type_node, NULL_TREE);
820 gfc_define_builtin("__builtin_iround", ftype, BUILT_IN_IROUND,
821 "iround", ATTR_CONST_NOTHROW_LEAF_LIST);
822 ftype = build_function_type_list (long_integer_type_node,
823 double_type_node, NULL_TREE);
824 gfc_define_builtin ("__builtin_lround", ftype, BUILT_IN_LROUND,
825 "lround", ATTR_CONST_NOTHROW_LEAF_LIST);
826 ftype = build_function_type_list (long_long_integer_type_node,
827 double_type_node, NULL_TREE);
828 gfc_define_builtin ("__builtin_llround", ftype, BUILT_IN_LLROUND,
829 "llround", ATTR_CONST_NOTHROW_LEAF_LIST);
831 ftype = build_function_type_list (integer_type_node,
832 long_double_type_node, NULL_TREE);
833 gfc_define_builtin("__builtin_iroundl", ftype, BUILT_IN_IROUNDL,
834 "iroundl", ATTR_CONST_NOTHROW_LEAF_LIST);
835 ftype = build_function_type_list (long_integer_type_node,
836 long_double_type_node, NULL_TREE);
837 gfc_define_builtin ("__builtin_lroundl", ftype, BUILT_IN_LROUNDL,
838 "lroundl", ATTR_CONST_NOTHROW_LEAF_LIST);
839 ftype = build_function_type_list (long_long_integer_type_node,
840 long_double_type_node, NULL_TREE);
841 gfc_define_builtin ("__builtin_llroundl", ftype, BUILT_IN_LLROUNDL,
842 "llroundl", ATTR_CONST_NOTHROW_LEAF_LIST);
844 /* These are used to implement the ** operator. */
845 gfc_define_builtin ("__builtin_powl", mfunc_longdouble[1],
846 BUILT_IN_POWL, "powl", ATTR_CONST_NOTHROW_LEAF_LIST);
847 gfc_define_builtin ("__builtin_pow", mfunc_double[1],
848 BUILT_IN_POW, "pow", ATTR_CONST_NOTHROW_LEAF_LIST);
849 gfc_define_builtin ("__builtin_powf", mfunc_float[1],
850 BUILT_IN_POWF, "powf", ATTR_CONST_NOTHROW_LEAF_LIST);
851 gfc_define_builtin ("__builtin_cpowl", mfunc_clongdouble[1],
852 BUILT_IN_CPOWL, "cpowl", ATTR_CONST_NOTHROW_LEAF_LIST);
853 gfc_define_builtin ("__builtin_cpow", mfunc_cdouble[1],
854 BUILT_IN_CPOW, "cpow", ATTR_CONST_NOTHROW_LEAF_LIST);
855 gfc_define_builtin ("__builtin_cpowf", mfunc_cfloat[1],
856 BUILT_IN_CPOWF, "cpowf", ATTR_CONST_NOTHROW_LEAF_LIST);
857 gfc_define_builtin ("__builtin_powil", mfunc_longdouble[2],
858 BUILT_IN_POWIL, "powil", ATTR_CONST_NOTHROW_LEAF_LIST);
859 gfc_define_builtin ("__builtin_powi", mfunc_double[2],
860 BUILT_IN_POWI, "powi", ATTR_CONST_NOTHROW_LEAF_LIST);
861 gfc_define_builtin ("__builtin_powif", mfunc_float[2],
862 BUILT_IN_POWIF, "powif", ATTR_CONST_NOTHROW_LEAF_LIST);
865 if (targetm.libc_has_function (function_c99_math_complex))
867 gfc_define_builtin ("__builtin_cbrtl", mfunc_longdouble[0],
868 BUILT_IN_CBRTL, "cbrtl",
869 ATTR_CONST_NOTHROW_LEAF_LIST);
870 gfc_define_builtin ("__builtin_cbrt", mfunc_double[0],
871 BUILT_IN_CBRT, "cbrt",
872 ATTR_CONST_NOTHROW_LEAF_LIST);
873 gfc_define_builtin ("__builtin_cbrtf", mfunc_float[0],
874 BUILT_IN_CBRTF, "cbrtf",
875 ATTR_CONST_NOTHROW_LEAF_LIST);
876 gfc_define_builtin ("__builtin_cexpil", func_longdouble_clongdouble,
877 BUILT_IN_CEXPIL, "cexpil",
878 ATTR_CONST_NOTHROW_LEAF_LIST);
879 gfc_define_builtin ("__builtin_cexpi", func_double_cdouble,
880 BUILT_IN_CEXPI, "cexpi",
881 ATTR_CONST_NOTHROW_LEAF_LIST);
882 gfc_define_builtin ("__builtin_cexpif", func_float_cfloat,
883 BUILT_IN_CEXPIF, "cexpif",
884 ATTR_CONST_NOTHROW_LEAF_LIST);
887 if (targetm.libc_has_function (function_sincos))
889 gfc_define_builtin ("__builtin_sincosl",
890 func_longdouble_longdoublep_longdoublep,
891 BUILT_IN_SINCOSL, "sincosl", ATTR_NOTHROW_LEAF_LIST);
892 gfc_define_builtin ("__builtin_sincos", func_double_doublep_doublep,
893 BUILT_IN_SINCOS, "sincos", ATTR_NOTHROW_LEAF_LIST);
894 gfc_define_builtin ("__builtin_sincosf", func_float_floatp_floatp,
895 BUILT_IN_SINCOSF, "sincosf", ATTR_NOTHROW_LEAF_LIST);
898 /* For LEADZ, TRAILZ, POPCNT and POPPAR. */
899 ftype = build_function_type_list (integer_type_node,
900 unsigned_type_node, NULL_TREE);
901 gfc_define_builtin ("__builtin_clz", ftype, BUILT_IN_CLZ,
902 "__builtin_clz", ATTR_CONST_NOTHROW_LEAF_LIST);
903 gfc_define_builtin ("__builtin_ctz", ftype, BUILT_IN_CTZ,
904 "__builtin_ctz", ATTR_CONST_NOTHROW_LEAF_LIST);
905 gfc_define_builtin ("__builtin_parity", ftype, BUILT_IN_PARITY,
906 "__builtin_parity", ATTR_CONST_NOTHROW_LEAF_LIST);
907 gfc_define_builtin ("__builtin_popcount", ftype, BUILT_IN_POPCOUNT,
908 "__builtin_popcount", ATTR_CONST_NOTHROW_LEAF_LIST);
910 ftype = build_function_type_list (integer_type_node,
911 long_unsigned_type_node, NULL_TREE);
912 gfc_define_builtin ("__builtin_clzl", ftype, BUILT_IN_CLZL,
913 "__builtin_clzl", ATTR_CONST_NOTHROW_LEAF_LIST);
914 gfc_define_builtin ("__builtin_ctzl", ftype, BUILT_IN_CTZL,
915 "__builtin_ctzl", ATTR_CONST_NOTHROW_LEAF_LIST);
916 gfc_define_builtin ("__builtin_parityl", ftype, BUILT_IN_PARITYL,
917 "__builtin_parityl", ATTR_CONST_NOTHROW_LEAF_LIST);
918 gfc_define_builtin ("__builtin_popcountl", ftype, BUILT_IN_POPCOUNTL,
919 "__builtin_popcountl", ATTR_CONST_NOTHROW_LEAF_LIST);
921 ftype = build_function_type_list (integer_type_node,
922 long_long_unsigned_type_node, NULL_TREE);
923 gfc_define_builtin ("__builtin_clzll", ftype, BUILT_IN_CLZLL,
924 "__builtin_clzll", ATTR_CONST_NOTHROW_LEAF_LIST);
925 gfc_define_builtin ("__builtin_ctzll", ftype, BUILT_IN_CTZLL,
926 "__builtin_ctzll", ATTR_CONST_NOTHROW_LEAF_LIST);
927 gfc_define_builtin ("__builtin_parityll", ftype, BUILT_IN_PARITYLL,
928 "__builtin_parityll", ATTR_CONST_NOTHROW_LEAF_LIST);
929 gfc_define_builtin ("__builtin_popcountll", ftype, BUILT_IN_POPCOUNTLL,
930 "__builtin_popcountll", ATTR_CONST_NOTHROW_LEAF_LIST);
932 /* Other builtin functions we use. */
934 ftype = build_function_type_list (long_integer_type_node,
935 long_integer_type_node,
936 long_integer_type_node, NULL_TREE);
937 gfc_define_builtin ("__builtin_expect", ftype, BUILT_IN_EXPECT,
938 "__builtin_expect", ATTR_CONST_NOTHROW_LEAF_LIST);
940 ftype = build_function_type_list (void_type_node,
941 pvoid_type_node, NULL_TREE);
942 gfc_define_builtin ("__builtin_free", ftype, BUILT_IN_FREE,
943 "free", ATTR_NOTHROW_LEAF_LIST);
945 ftype = build_function_type_list (pvoid_type_node,
946 size_type_node, NULL_TREE);
947 gfc_define_builtin ("__builtin_malloc", ftype, BUILT_IN_MALLOC,
948 "malloc", ATTR_NOTHROW_LEAF_MALLOC_LIST);
950 ftype = build_function_type_list (pvoid_type_node, size_type_node,
951 size_type_node, NULL_TREE);
952 gfc_define_builtin ("__builtin_calloc", ftype, BUILT_IN_CALLOC,
953 "calloc", ATTR_NOTHROW_LEAF_MALLOC_LIST);
954 DECL_IS_MALLOC (builtin_decl_explicit (BUILT_IN_CALLOC)) = 1;
956 ftype = build_function_type_list (pvoid_type_node,
957 size_type_node, pvoid_type_node,
958 NULL_TREE);
959 gfc_define_builtin ("__builtin_realloc", ftype, BUILT_IN_REALLOC,
960 "realloc", ATTR_NOTHROW_LEAF_LIST);
962 ftype = build_function_type_list (integer_type_node,
963 void_type_node, NULL_TREE);
964 gfc_define_builtin ("__builtin_isnan", ftype, BUILT_IN_ISNAN,
965 "__builtin_isnan", ATTR_CONST_NOTHROW_LEAF_LIST);
967 #define DEF_PRIMITIVE_TYPE(ENUM, VALUE) \
968 builtin_types[(int) ENUM] = VALUE;
969 #define DEF_FUNCTION_TYPE_0(ENUM, RETURN) \
970 builtin_types[(int) ENUM] \
971 = build_function_type_list (builtin_types[(int) RETURN], \
972 NULL_TREE);
973 #define DEF_FUNCTION_TYPE_1(ENUM, RETURN, ARG1) \
974 builtin_types[(int) ENUM] \
975 = build_function_type_list (builtin_types[(int) RETURN], \
976 builtin_types[(int) ARG1], \
977 NULL_TREE);
978 #define DEF_FUNCTION_TYPE_2(ENUM, RETURN, ARG1, ARG2) \
979 builtin_types[(int) ENUM] \
980 = build_function_type_list (builtin_types[(int) RETURN], \
981 builtin_types[(int) ARG1], \
982 builtin_types[(int) ARG2], \
983 NULL_TREE);
984 #define DEF_FUNCTION_TYPE_3(ENUM, RETURN, ARG1, ARG2, ARG3) \
985 builtin_types[(int) ENUM] \
986 = build_function_type_list (builtin_types[(int) RETURN], \
987 builtin_types[(int) ARG1], \
988 builtin_types[(int) ARG2], \
989 builtin_types[(int) ARG3], \
990 NULL_TREE);
991 #define DEF_FUNCTION_TYPE_4(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4) \
992 builtin_types[(int) ENUM] \
993 = build_function_type_list (builtin_types[(int) RETURN], \
994 builtin_types[(int) ARG1], \
995 builtin_types[(int) ARG2], \
996 builtin_types[(int) ARG3], \
997 builtin_types[(int) ARG4], \
998 NULL_TREE);
999 #define DEF_FUNCTION_TYPE_5(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5) \
1000 builtin_types[(int) ENUM] \
1001 = build_function_type_list (builtin_types[(int) RETURN], \
1002 builtin_types[(int) ARG1], \
1003 builtin_types[(int) ARG2], \
1004 builtin_types[(int) ARG3], \
1005 builtin_types[(int) ARG4], \
1006 builtin_types[(int) ARG5], \
1007 NULL_TREE);
1008 #define DEF_FUNCTION_TYPE_6(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
1009 ARG6) \
1010 builtin_types[(int) ENUM] \
1011 = build_function_type_list (builtin_types[(int) RETURN], \
1012 builtin_types[(int) ARG1], \
1013 builtin_types[(int) ARG2], \
1014 builtin_types[(int) ARG3], \
1015 builtin_types[(int) ARG4], \
1016 builtin_types[(int) ARG5], \
1017 builtin_types[(int) ARG6], \
1018 NULL_TREE);
1019 #define DEF_FUNCTION_TYPE_7(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
1020 ARG6, ARG7) \
1021 builtin_types[(int) ENUM] \
1022 = build_function_type_list (builtin_types[(int) RETURN], \
1023 builtin_types[(int) ARG1], \
1024 builtin_types[(int) ARG2], \
1025 builtin_types[(int) ARG3], \
1026 builtin_types[(int) ARG4], \
1027 builtin_types[(int) ARG5], \
1028 builtin_types[(int) ARG6], \
1029 builtin_types[(int) ARG7], \
1030 NULL_TREE);
1031 #define DEF_FUNCTION_TYPE_8(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
1032 ARG6, ARG7, ARG8) \
1033 builtin_types[(int) ENUM] \
1034 = build_function_type_list (builtin_types[(int) RETURN], \
1035 builtin_types[(int) ARG1], \
1036 builtin_types[(int) ARG2], \
1037 builtin_types[(int) ARG3], \
1038 builtin_types[(int) ARG4], \
1039 builtin_types[(int) ARG5], \
1040 builtin_types[(int) ARG6], \
1041 builtin_types[(int) ARG7], \
1042 builtin_types[(int) ARG8], \
1043 NULL_TREE);
1044 #define DEF_FUNCTION_TYPE_10(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
1045 ARG6, ARG7, ARG8, ARG9, ARG10) \
1046 builtin_types[(int) ENUM] \
1047 = build_function_type_list (builtin_types[(int) RETURN], \
1048 builtin_types[(int) ARG1], \
1049 builtin_types[(int) ARG2], \
1050 builtin_types[(int) ARG3], \
1051 builtin_types[(int) ARG4], \
1052 builtin_types[(int) ARG5], \
1053 builtin_types[(int) ARG6], \
1054 builtin_types[(int) ARG7], \
1055 builtin_types[(int) ARG8], \
1056 builtin_types[(int) ARG9], \
1057 builtin_types[(int) ARG10], \
1058 NULL_TREE);
1059 #define DEF_FUNCTION_TYPE_VAR_0(ENUM, RETURN) \
1060 builtin_types[(int) ENUM] \
1061 = build_varargs_function_type_list (builtin_types[(int) RETURN], \
1062 NULL_TREE);
1063 #define DEF_POINTER_TYPE(ENUM, TYPE) \
1064 builtin_types[(int) ENUM] \
1065 = build_pointer_type (builtin_types[(int) TYPE]);
1066 #include "types.def"
1067 #undef DEF_PRIMITIVE_TYPE
1068 #undef DEF_FUNCTION_TYPE_0
1069 #undef DEF_FUNCTION_TYPE_1
1070 #undef DEF_FUNCTION_TYPE_2
1071 #undef DEF_FUNCTION_TYPE_3
1072 #undef DEF_FUNCTION_TYPE_4
1073 #undef DEF_FUNCTION_TYPE_5
1074 #undef DEF_FUNCTION_TYPE_6
1075 #undef DEF_FUNCTION_TYPE_7
1076 #undef DEF_FUNCTION_TYPE_8
1077 #undef DEF_FUNCTION_TYPE_10
1078 #undef DEF_FUNCTION_TYPE_VAR_0
1079 #undef DEF_POINTER_TYPE
1080 builtin_types[(int) BT_LAST] = NULL_TREE;
1082 /* Initialize synchronization builtins. */
1083 #undef DEF_SYNC_BUILTIN
1084 #define DEF_SYNC_BUILTIN(code, name, type, attr) \
1085 gfc_define_builtin (name, builtin_types[type], code, name, \
1086 attr);
1087 #include "../sync-builtins.def"
1088 #undef DEF_SYNC_BUILTIN
1090 if (gfc_option.gfc_flag_openacc)
1092 #undef DEF_GOACC_BUILTIN
1093 #define DEF_GOACC_BUILTIN(code, name, type, attr) \
1094 gfc_define_builtin ("__builtin_" name, builtin_types[type], \
1095 code, name, attr);
1096 #undef DEF_GOACC_BUILTIN_COMPILER
1097 /* TODO: this is not doing the right thing. */
1098 #define DEF_GOACC_BUILTIN_COMPILER(code, name, type, attr) \
1099 gfc_define_builtin (name, builtin_types[type], code, name, attr);
1100 #include "../oacc-builtins.def"
1101 #undef DEF_GOACC_BUILTIN_COMPILER
1102 #undef DEF_GOACC_BUILTIN
1105 if (gfc_option.gfc_flag_openmp
1106 || gfc_option.gfc_flag_openmp_simd
1107 || flag_tree_parallelize_loops)
1109 #undef DEF_GOMP_BUILTIN
1110 #define DEF_GOMP_BUILTIN(code, name, type, attr) \
1111 gfc_define_builtin ("__builtin_" name, builtin_types[type], \
1112 code, name, attr);
1113 #include "../omp-builtins.def"
1114 #undef DEF_GOMP_BUILTIN
1117 gfc_define_builtin ("__builtin_trap", builtin_types[BT_FN_VOID],
1118 BUILT_IN_TRAP, NULL, ATTR_NOTHROW_LEAF_LIST);
1119 TREE_THIS_VOLATILE (builtin_decl_explicit (BUILT_IN_TRAP)) = 1;
1121 ftype = build_varargs_function_type_list (ptr_type_node, const_ptr_type_node,
1122 size_type_node, NULL_TREE);
1123 gfc_define_builtin ("__builtin_assume_aligned", ftype,
1124 BUILT_IN_ASSUME_ALIGNED,
1125 "__builtin_assume_aligned",
1126 ATTR_CONST_NOTHROW_LEAF_LIST);
1128 gfc_define_builtin ("__emutls_get_address",
1129 builtin_types[BT_FN_PTR_PTR],
1130 BUILT_IN_EMUTLS_GET_ADDRESS,
1131 "__emutls_get_address", ATTR_CONST_NOTHROW_LEAF_LIST);
1132 gfc_define_builtin ("__emutls_register_common",
1133 builtin_types[BT_FN_VOID_PTR_WORD_WORD_PTR],
1134 BUILT_IN_EMUTLS_REGISTER_COMMON,
1135 "__emutls_register_common", ATTR_NOTHROW_LEAF_LIST);
1137 build_common_builtin_nodes ();
1138 targetm.init_builtins ();
1141 #undef DEFINE_MATH_BUILTIN_C
1142 #undef DEFINE_MATH_BUILTIN
1144 static void
1145 gfc_init_ts (void)
1147 tree_contains_struct[NAMESPACE_DECL][TS_DECL_NON_COMMON] = 1;
1148 tree_contains_struct[NAMESPACE_DECL][TS_DECL_WITH_VIS] = 1;
1149 tree_contains_struct[NAMESPACE_DECL][TS_DECL_WRTL] = 1;
1150 tree_contains_struct[NAMESPACE_DECL][TS_DECL_COMMON] = 1;
1151 tree_contains_struct[NAMESPACE_DECL][TS_DECL_MINIMAL] = 1;
1154 void
1155 gfc_maybe_initialize_eh (void)
1157 if (!flag_exceptions || gfc_eh_initialized_p)
1158 return;
1160 gfc_eh_initialized_p = true;
1161 using_eh_for_cleanups ();
1165 #include "gt-fortran-f95-lang.h"
1166 #include "gtype-fortran.h"