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