]> git.ipfire.org Git - thirdparty/gcc.git/blob - gcc/fortran/f95-lang.c
trans-expr.c (gfc_reset_vptr): Fix comment whitespace.
[thirdparty/gcc.git] / gcc / fortran / f95-lang.c
1 /* gfortran backend interface
2 Copyright (C) 2000-2014 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 "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"
49
50 /* Language-dependent contents of an identifier. */
51
52 struct GTY(())
53 lang_identifier {
54 struct tree_identifier common;
55 };
56
57 /* The resulting tree type. */
58
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;
65 };
66
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. */
70
71 struct GTY(())
72 language_function {
73 /* struct gfc_language_function base; */
74 struct binding_level *binding_level;
75 };
76
77 static void gfc_init_decl_processing (void);
78 static void gfc_init_builtin_functions (void);
79 static bool global_bindings_p (void);
80
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);
89
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 *)
94 {
95 return NULL_TREE;
96 }
97
98 /* Table of valid Fortran attributes. */
99 static const struct attribute_spec gfc_attribute_table[] =
100 {
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 }
106 };
107
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
140
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
173
174 struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
175
176 #define NULL_BINDING_LEVEL (struct binding_level *) NULL
177
178 /* A chain of binding_level structures awaiting reuse. */
179
180 static GTY(()) struct binding_level *free_binding_level;
181
182 /* True means we've initialized exception handling. */
183 static bool gfc_eh_initialized_p;
184
185 /* The current translation unit. */
186 static GTY(()) tree current_translation_unit;
187
188
189 static void
190 gfc_create_decls (void)
191 {
192 /* GCC builtins. */
193 gfc_init_builtin_functions ();
194
195 /* Runtime/IO library functions. */
196 gfc_build_builtin_function_decls ();
197
198 gfc_init_constants ();
199
200 /* Build our translation-unit decl. */
201 current_translation_unit = build_translation_unit_decl (NULL_TREE);
202 }
203
204
205 static void
206 gfc_be_parse_file (void)
207 {
208 int errors;
209 int warnings;
210
211 gfc_create_decls ();
212 gfc_parse_file ();
213 gfc_generate_constructors ();
214
215 /* Tell the frontend about any errors. */
216 gfc_get_errors (&warnings, &errors);
217 errorcount += errors;
218 warningcount += warnings;
219
220 /* Clear the binding level stack. */
221 while (!global_bindings_p ())
222 poplevel (0, 0);
223 }
224
225
226 /* Initialize everything. */
227
228 static bool
229 gfc_init (void)
230 {
231 if (!gfc_cpp_enabled ())
232 {
233 linemap_add (line_table, LC_ENTER, false, gfc_source_file, 1);
234 linemap_add (line_table, LC_RENAME, false, "<built-in>", 0);
235 }
236 else
237 gfc_cpp_init_0 ();
238
239 gfc_init_decl_processing ();
240 gfc_static_ctors = NULL_TREE;
241
242 if (gfc_cpp_enabled ())
243 gfc_cpp_init ();
244
245 gfc_init_1 ();
246
247 if (!gfc_new_file ())
248 fatal_error ("can't open input file: %s", gfc_source_file);
249
250 if (flag_preprocess_only)
251 return false;
252
253 return true;
254 }
255
256
257 static void
258 gfc_finish (void)
259 {
260 gfc_cpp_done ();
261 gfc_done_1 ();
262 gfc_release_include_path ();
263 return;
264 }
265
266 /* ??? This is something of a hack.
267
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.
272
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. */
279
280 static void
281 gfc_write_global_declarations (void)
282 {
283 tree decl;
284
285 /* Finalize all of the globals. */
286 for (decl = getdecls(); decl ; decl = DECL_CHAIN (decl))
287 rest_of_decl_compilation (decl, true, true);
288
289 write_global_declarations ();
290 }
291
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. */
296
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:
300
301 the global one
302 one for each subprogram definition
303 one for each compound statement (declare block)
304
305 Binding contours are used to create GCC tree BLOCK nodes. */
306
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;
318 };
319
320 /* The binding level currently in effect. */
321 static GTY(()) struct binding_level *current_binding_level = NULL;
322
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;
326
327 /* Binding level structures are initialized by copying this one. */
328 static struct binding_level clear_binding_level = { NULL, NULL, NULL };
329
330
331 /* Return true if we are in the global binding level. */
332
333 bool
334 global_bindings_p (void)
335 {
336 return current_binding_level == global_binding_level;
337 }
338
339 tree
340 getdecls (void)
341 {
342 return current_binding_level->names;
343 }
344
345 /* Enter a new binding level. */
346
347 void
348 pushlevel (void)
349 {
350 struct binding_level *newlevel = ggc_alloc<binding_level> ();
351
352 *newlevel = clear_binding_level;
353
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;
358 }
359
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.
363
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.
367
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. */
371
372 tree
373 poplevel (int keep, int functionbody)
374 {
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;
382
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);
388
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;
393
394 /* Clear out the meanings of the local variables of this level. */
395
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))
402 {
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;
407 }
408
409 /* Pop the current level. */
410 current_binding_level = current_binding_level->level_chain;
411
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. */
418 ;
419 else if (block_node)
420 {
421 current_binding_level->blocks
422 = block_chainon (current_binding_level->blocks, block_node);
423 }
424
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;
434
435 return block_node;
436 }
437
438
439 /* Records a ..._DECL node DECL as belonging to the current lexical scope.
440 Returns the ..._DECL node. */
441
442 tree
443 pushdecl (tree decl)
444 {
445 if (global_bindings_p ())
446 DECL_CONTEXT (decl) = current_translation_unit;
447 else
448 {
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))
452 {
453 tree orig = decl;
454 decl = copy_node (decl);
455 DECL_CONTEXT (orig) = NULL_TREE;
456 }
457 DECL_CONTEXT (decl) = current_function_decl;
458 }
459
460 /* Put the declaration on the list. */
461 DECL_CHAIN (decl) = current_binding_level->names;
462 current_binding_level->names = decl;
463
464 /* For the declaration of a type, set its name if it is not already set. */
465
466 if (TREE_CODE (decl) == TYPE_DECL && TYPE_NAME (TREE_TYPE (decl)) == 0)
467 {
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);
472 }
473
474 return decl;
475 }
476
477
478 /* Like pushdecl, only it places X in GLOBAL_BINDING_LEVEL. */
479
480 tree
481 pushdecl_top_level (tree x)
482 {
483 tree t;
484 struct binding_level *b = current_binding_level;
485
486 current_binding_level = global_binding_level;
487 t = pushdecl (x);
488 current_binding_level = b;
489 return t;
490 }
491
492 #ifndef CHAR_TYPE_SIZE
493 #define CHAR_TYPE_SIZE BITS_PER_UNIT
494 #endif
495
496 #ifndef INT_TYPE_SIZE
497 #define INT_TYPE_SIZE BITS_PER_WORD
498 #endif
499
500 #undef SIZE_TYPE
501 #define SIZE_TYPE "long unsigned int"
502
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)
509 {
510 current_function_decl = NULL;
511 current_binding_level = NULL_BINDING_LEVEL;
512 free_binding_level = NULL_BINDING_LEVEL;
513
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;
518
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);
523
524 void_list_node = build_tree_list (NULL_TREE, void_type_node);
525
526 /* Set up F95 type nodes. */
527 gfc_init_kinds ();
528 gfc_init_types ();
529 gfc_init_c_interop_kinds ();
530 }
531
532
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. */
535
536 static alias_set_type
537 gfc_get_alias_set (tree t)
538 {
539 tree u;
540
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;
547
548 return -1;
549 }
550
551 /* Builtin function initialization. */
552
553 static tree
554 gfc_builtin_function (tree decl)
555 {
556 pushdecl (decl);
557 return decl;
558 }
559
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)
568
569 static void
570 gfc_define_builtin (const char *name, tree type, enum built_in_function code,
571 const char *library_name, int attr)
572 {
573 tree decl;
574
575 decl = add_builtin_function (name, type, code, BUILT_IN_NORMAL,
576 library_name, NULL_TREE);
577 set_call_expr_flags (decl, attr);
578
579 set_builtin_decl (code, decl, true);
580 }
581
582
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);
593
594 #define DEFINE_MATH_BUILTIN(code, name, argtype) \
595 DO_DEFINE_MATH_BUILTIN (code, name, argtype, mfunc_)
596
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)
600
601
602 /* Create function types for builtin functions. */
603
604 static void
605 build_builtin_fntypes (tree *fntype, tree type)
606 {
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);
623 }
624
625
626 static tree
627 builtin_type_for_size (int size, bool unsignedp)
628 {
629 tree type = gfc_type_for_size (size, unsignedp);
630 return type ? type : error_mark_node;
631 }
632
633 /* Initialization of builtin function nodes. */
634
635 static void
636 gfc_init_builtin_functions (void)
637 {
638 enum builtin_type
639 {
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_VAR_0(NAME, RETURN) NAME,
654 #define DEF_POINTER_TYPE(NAME, TYPE) NAME,
655 #include "types.def"
656 #undef DEF_PRIMITIVE_TYPE
657 #undef DEF_FUNCTION_TYPE_0
658 #undef DEF_FUNCTION_TYPE_1
659 #undef DEF_FUNCTION_TYPE_2
660 #undef DEF_FUNCTION_TYPE_3
661 #undef DEF_FUNCTION_TYPE_4
662 #undef DEF_FUNCTION_TYPE_5
663 #undef DEF_FUNCTION_TYPE_6
664 #undef DEF_FUNCTION_TYPE_7
665 #undef DEF_FUNCTION_TYPE_8
666 #undef DEF_FUNCTION_TYPE_VAR_0
667 #undef DEF_POINTER_TYPE
668 BT_LAST
669 };
670
671 tree mfunc_float[6];
672 tree mfunc_double[6];
673 tree mfunc_longdouble[6];
674 tree mfunc_cfloat[6];
675 tree mfunc_cdouble[6];
676 tree mfunc_clongdouble[6];
677 tree func_cfloat_float, func_float_cfloat;
678 tree func_cdouble_double, func_double_cdouble;
679 tree func_clongdouble_longdouble, func_longdouble_clongdouble;
680 tree func_float_floatp_floatp;
681 tree func_double_doublep_doublep;
682 tree func_longdouble_longdoublep_longdoublep;
683 tree ftype, ptype;
684 tree builtin_types[(int) BT_LAST + 1];
685
686 build_builtin_fntypes (mfunc_float, float_type_node);
687 build_builtin_fntypes (mfunc_double, double_type_node);
688 build_builtin_fntypes (mfunc_longdouble, long_double_type_node);
689 build_builtin_fntypes (mfunc_cfloat, complex_float_type_node);
690 build_builtin_fntypes (mfunc_cdouble, complex_double_type_node);
691 build_builtin_fntypes (mfunc_clongdouble, complex_long_double_type_node);
692
693 func_cfloat_float = build_function_type_list (float_type_node,
694 complex_float_type_node,
695 NULL_TREE);
696
697 func_float_cfloat = build_function_type_list (complex_float_type_node,
698 float_type_node, NULL_TREE);
699
700 func_cdouble_double = build_function_type_list (double_type_node,
701 complex_double_type_node,
702 NULL_TREE);
703
704 func_double_cdouble = build_function_type_list (complex_double_type_node,
705 double_type_node, NULL_TREE);
706
707 func_clongdouble_longdouble =
708 build_function_type_list (long_double_type_node,
709 complex_long_double_type_node, NULL_TREE);
710
711 func_longdouble_clongdouble =
712 build_function_type_list (complex_long_double_type_node,
713 long_double_type_node, NULL_TREE);
714
715 ptype = build_pointer_type (float_type_node);
716 func_float_floatp_floatp =
717 build_function_type_list (void_type_node, ptype, ptype, NULL_TREE);
718
719 ptype = build_pointer_type (double_type_node);
720 func_double_doublep_doublep =
721 build_function_type_list (void_type_node, ptype, ptype, NULL_TREE);
722
723 ptype = build_pointer_type (long_double_type_node);
724 func_longdouble_longdoublep_longdoublep =
725 build_function_type_list (void_type_node, ptype, ptype, NULL_TREE);
726
727 /* Non-math builtins are defined manually, so they're not included here. */
728 #define OTHER_BUILTIN(ID,NAME,TYPE,CONST)
729
730 #include "mathbuiltins.def"
731
732 gfc_define_builtin ("__builtin_roundl", mfunc_longdouble[0],
733 BUILT_IN_ROUNDL, "roundl", ATTR_CONST_NOTHROW_LEAF_LIST);
734 gfc_define_builtin ("__builtin_round", mfunc_double[0],
735 BUILT_IN_ROUND, "round", ATTR_CONST_NOTHROW_LEAF_LIST);
736 gfc_define_builtin ("__builtin_roundf", mfunc_float[0],
737 BUILT_IN_ROUNDF, "roundf", ATTR_CONST_NOTHROW_LEAF_LIST);
738
739 gfc_define_builtin ("__builtin_truncl", mfunc_longdouble[0],
740 BUILT_IN_TRUNCL, "truncl", ATTR_CONST_NOTHROW_LEAF_LIST);
741 gfc_define_builtin ("__builtin_trunc", mfunc_double[0],
742 BUILT_IN_TRUNC, "trunc", ATTR_CONST_NOTHROW_LEAF_LIST);
743 gfc_define_builtin ("__builtin_truncf", mfunc_float[0],
744 BUILT_IN_TRUNCF, "truncf", ATTR_CONST_NOTHROW_LEAF_LIST);
745
746 gfc_define_builtin ("__builtin_cabsl", func_clongdouble_longdouble,
747 BUILT_IN_CABSL, "cabsl", ATTR_CONST_NOTHROW_LEAF_LIST);
748 gfc_define_builtin ("__builtin_cabs", func_cdouble_double,
749 BUILT_IN_CABS, "cabs", ATTR_CONST_NOTHROW_LEAF_LIST);
750 gfc_define_builtin ("__builtin_cabsf", func_cfloat_float,
751 BUILT_IN_CABSF, "cabsf", ATTR_CONST_NOTHROW_LEAF_LIST);
752
753 gfc_define_builtin ("__builtin_copysignl", mfunc_longdouble[1],
754 BUILT_IN_COPYSIGNL, "copysignl",
755 ATTR_CONST_NOTHROW_LEAF_LIST);
756 gfc_define_builtin ("__builtin_copysign", mfunc_double[1],
757 BUILT_IN_COPYSIGN, "copysign",
758 ATTR_CONST_NOTHROW_LEAF_LIST);
759 gfc_define_builtin ("__builtin_copysignf", mfunc_float[1],
760 BUILT_IN_COPYSIGNF, "copysignf",
761 ATTR_CONST_NOTHROW_LEAF_LIST);
762
763 gfc_define_builtin ("__builtin_nextafterl", mfunc_longdouble[1],
764 BUILT_IN_NEXTAFTERL, "nextafterl",
765 ATTR_CONST_NOTHROW_LEAF_LIST);
766 gfc_define_builtin ("__builtin_nextafter", mfunc_double[1],
767 BUILT_IN_NEXTAFTER, "nextafter",
768 ATTR_CONST_NOTHROW_LEAF_LIST);
769 gfc_define_builtin ("__builtin_nextafterf", mfunc_float[1],
770 BUILT_IN_NEXTAFTERF, "nextafterf",
771 ATTR_CONST_NOTHROW_LEAF_LIST);
772
773 gfc_define_builtin ("__builtin_frexpl", mfunc_longdouble[4],
774 BUILT_IN_FREXPL, "frexpl", ATTR_NOTHROW_LEAF_LIST);
775 gfc_define_builtin ("__builtin_frexp", mfunc_double[4],
776 BUILT_IN_FREXP, "frexp", ATTR_NOTHROW_LEAF_LIST);
777 gfc_define_builtin ("__builtin_frexpf", mfunc_float[4],
778 BUILT_IN_FREXPF, "frexpf", ATTR_NOTHROW_LEAF_LIST);
779
780 gfc_define_builtin ("__builtin_fabsl", mfunc_longdouble[0],
781 BUILT_IN_FABSL, "fabsl", ATTR_CONST_NOTHROW_LEAF_LIST);
782 gfc_define_builtin ("__builtin_fabs", mfunc_double[0],
783 BUILT_IN_FABS, "fabs", ATTR_CONST_NOTHROW_LEAF_LIST);
784 gfc_define_builtin ("__builtin_fabsf", mfunc_float[0],
785 BUILT_IN_FABSF, "fabsf", ATTR_CONST_NOTHROW_LEAF_LIST);
786
787 gfc_define_builtin ("__builtin_scalbnl", mfunc_longdouble[5],
788 BUILT_IN_SCALBNL, "scalbnl", ATTR_CONST_NOTHROW_LEAF_LIST);
789 gfc_define_builtin ("__builtin_scalbn", mfunc_double[5],
790 BUILT_IN_SCALBN, "scalbn", ATTR_CONST_NOTHROW_LEAF_LIST);
791 gfc_define_builtin ("__builtin_scalbnf", mfunc_float[5],
792 BUILT_IN_SCALBNF, "scalbnf", ATTR_CONST_NOTHROW_LEAF_LIST);
793
794 gfc_define_builtin ("__builtin_fmodl", mfunc_longdouble[1],
795 BUILT_IN_FMODL, "fmodl", ATTR_CONST_NOTHROW_LEAF_LIST);
796 gfc_define_builtin ("__builtin_fmod", mfunc_double[1],
797 BUILT_IN_FMOD, "fmod", ATTR_CONST_NOTHROW_LEAF_LIST);
798 gfc_define_builtin ("__builtin_fmodf", mfunc_float[1],
799 BUILT_IN_FMODF, "fmodf", ATTR_CONST_NOTHROW_LEAF_LIST);
800
801 /* iround{f,,l}, lround{f,,l} and llround{f,,l} */
802 ftype = build_function_type_list (integer_type_node,
803 float_type_node, NULL_TREE);
804 gfc_define_builtin("__builtin_iroundf", ftype, BUILT_IN_IROUNDF,
805 "iroundf", ATTR_CONST_NOTHROW_LEAF_LIST);
806 ftype = build_function_type_list (long_integer_type_node,
807 float_type_node, NULL_TREE);
808 gfc_define_builtin ("__builtin_lroundf", ftype, BUILT_IN_LROUNDF,
809 "lroundf", ATTR_CONST_NOTHROW_LEAF_LIST);
810 ftype = build_function_type_list (long_long_integer_type_node,
811 float_type_node, NULL_TREE);
812 gfc_define_builtin ("__builtin_llroundf", ftype, BUILT_IN_LLROUNDF,
813 "llroundf", ATTR_CONST_NOTHROW_LEAF_LIST);
814
815 ftype = build_function_type_list (integer_type_node,
816 double_type_node, NULL_TREE);
817 gfc_define_builtin("__builtin_iround", ftype, BUILT_IN_IROUND,
818 "iround", ATTR_CONST_NOTHROW_LEAF_LIST);
819 ftype = build_function_type_list (long_integer_type_node,
820 double_type_node, NULL_TREE);
821 gfc_define_builtin ("__builtin_lround", ftype, BUILT_IN_LROUND,
822 "lround", ATTR_CONST_NOTHROW_LEAF_LIST);
823 ftype = build_function_type_list (long_long_integer_type_node,
824 double_type_node, NULL_TREE);
825 gfc_define_builtin ("__builtin_llround", ftype, BUILT_IN_LLROUND,
826 "llround", ATTR_CONST_NOTHROW_LEAF_LIST);
827
828 ftype = build_function_type_list (integer_type_node,
829 long_double_type_node, NULL_TREE);
830 gfc_define_builtin("__builtin_iroundl", ftype, BUILT_IN_IROUNDL,
831 "iroundl", ATTR_CONST_NOTHROW_LEAF_LIST);
832 ftype = build_function_type_list (long_integer_type_node,
833 long_double_type_node, NULL_TREE);
834 gfc_define_builtin ("__builtin_lroundl", ftype, BUILT_IN_LROUNDL,
835 "lroundl", ATTR_CONST_NOTHROW_LEAF_LIST);
836 ftype = build_function_type_list (long_long_integer_type_node,
837 long_double_type_node, NULL_TREE);
838 gfc_define_builtin ("__builtin_llroundl", ftype, BUILT_IN_LLROUNDL,
839 "llroundl", ATTR_CONST_NOTHROW_LEAF_LIST);
840
841 /* These are used to implement the ** operator. */
842 gfc_define_builtin ("__builtin_powl", mfunc_longdouble[1],
843 BUILT_IN_POWL, "powl", ATTR_CONST_NOTHROW_LEAF_LIST);
844 gfc_define_builtin ("__builtin_pow", mfunc_double[1],
845 BUILT_IN_POW, "pow", ATTR_CONST_NOTHROW_LEAF_LIST);
846 gfc_define_builtin ("__builtin_powf", mfunc_float[1],
847 BUILT_IN_POWF, "powf", ATTR_CONST_NOTHROW_LEAF_LIST);
848 gfc_define_builtin ("__builtin_cpowl", mfunc_clongdouble[1],
849 BUILT_IN_CPOWL, "cpowl", ATTR_CONST_NOTHROW_LEAF_LIST);
850 gfc_define_builtin ("__builtin_cpow", mfunc_cdouble[1],
851 BUILT_IN_CPOW, "cpow", ATTR_CONST_NOTHROW_LEAF_LIST);
852 gfc_define_builtin ("__builtin_cpowf", mfunc_cfloat[1],
853 BUILT_IN_CPOWF, "cpowf", ATTR_CONST_NOTHROW_LEAF_LIST);
854 gfc_define_builtin ("__builtin_powil", mfunc_longdouble[2],
855 BUILT_IN_POWIL, "powil", ATTR_CONST_NOTHROW_LEAF_LIST);
856 gfc_define_builtin ("__builtin_powi", mfunc_double[2],
857 BUILT_IN_POWI, "powi", ATTR_CONST_NOTHROW_LEAF_LIST);
858 gfc_define_builtin ("__builtin_powif", mfunc_float[2],
859 BUILT_IN_POWIF, "powif", ATTR_CONST_NOTHROW_LEAF_LIST);
860
861
862 if (targetm.libc_has_function (function_c99_math_complex))
863 {
864 gfc_define_builtin ("__builtin_cbrtl", mfunc_longdouble[0],
865 BUILT_IN_CBRTL, "cbrtl",
866 ATTR_CONST_NOTHROW_LEAF_LIST);
867 gfc_define_builtin ("__builtin_cbrt", mfunc_double[0],
868 BUILT_IN_CBRT, "cbrt",
869 ATTR_CONST_NOTHROW_LEAF_LIST);
870 gfc_define_builtin ("__builtin_cbrtf", mfunc_float[0],
871 BUILT_IN_CBRTF, "cbrtf",
872 ATTR_CONST_NOTHROW_LEAF_LIST);
873 gfc_define_builtin ("__builtin_cexpil", func_longdouble_clongdouble,
874 BUILT_IN_CEXPIL, "cexpil",
875 ATTR_CONST_NOTHROW_LEAF_LIST);
876 gfc_define_builtin ("__builtin_cexpi", func_double_cdouble,
877 BUILT_IN_CEXPI, "cexpi",
878 ATTR_CONST_NOTHROW_LEAF_LIST);
879 gfc_define_builtin ("__builtin_cexpif", func_float_cfloat,
880 BUILT_IN_CEXPIF, "cexpif",
881 ATTR_CONST_NOTHROW_LEAF_LIST);
882 }
883
884 if (targetm.libc_has_function (function_sincos))
885 {
886 gfc_define_builtin ("__builtin_sincosl",
887 func_longdouble_longdoublep_longdoublep,
888 BUILT_IN_SINCOSL, "sincosl", ATTR_NOTHROW_LEAF_LIST);
889 gfc_define_builtin ("__builtin_sincos", func_double_doublep_doublep,
890 BUILT_IN_SINCOS, "sincos", ATTR_NOTHROW_LEAF_LIST);
891 gfc_define_builtin ("__builtin_sincosf", func_float_floatp_floatp,
892 BUILT_IN_SINCOSF, "sincosf", ATTR_NOTHROW_LEAF_LIST);
893 }
894
895 /* For LEADZ, TRAILZ, POPCNT and POPPAR. */
896 ftype = build_function_type_list (integer_type_node,
897 unsigned_type_node, NULL_TREE);
898 gfc_define_builtin ("__builtin_clz", ftype, BUILT_IN_CLZ,
899 "__builtin_clz", ATTR_CONST_NOTHROW_LEAF_LIST);
900 gfc_define_builtin ("__builtin_ctz", ftype, BUILT_IN_CTZ,
901 "__builtin_ctz", ATTR_CONST_NOTHROW_LEAF_LIST);
902 gfc_define_builtin ("__builtin_parity", ftype, BUILT_IN_PARITY,
903 "__builtin_parity", ATTR_CONST_NOTHROW_LEAF_LIST);
904 gfc_define_builtin ("__builtin_popcount", ftype, BUILT_IN_POPCOUNT,
905 "__builtin_popcount", ATTR_CONST_NOTHROW_LEAF_LIST);
906
907 ftype = build_function_type_list (integer_type_node,
908 long_unsigned_type_node, NULL_TREE);
909 gfc_define_builtin ("__builtin_clzl", ftype, BUILT_IN_CLZL,
910 "__builtin_clzl", ATTR_CONST_NOTHROW_LEAF_LIST);
911 gfc_define_builtin ("__builtin_ctzl", ftype, BUILT_IN_CTZL,
912 "__builtin_ctzl", ATTR_CONST_NOTHROW_LEAF_LIST);
913 gfc_define_builtin ("__builtin_parityl", ftype, BUILT_IN_PARITYL,
914 "__builtin_parityl", ATTR_CONST_NOTHROW_LEAF_LIST);
915 gfc_define_builtin ("__builtin_popcountl", ftype, BUILT_IN_POPCOUNTL,
916 "__builtin_popcountl", ATTR_CONST_NOTHROW_LEAF_LIST);
917
918 ftype = build_function_type_list (integer_type_node,
919 long_long_unsigned_type_node, NULL_TREE);
920 gfc_define_builtin ("__builtin_clzll", ftype, BUILT_IN_CLZLL,
921 "__builtin_clzll", ATTR_CONST_NOTHROW_LEAF_LIST);
922 gfc_define_builtin ("__builtin_ctzll", ftype, BUILT_IN_CTZLL,
923 "__builtin_ctzll", ATTR_CONST_NOTHROW_LEAF_LIST);
924 gfc_define_builtin ("__builtin_parityll", ftype, BUILT_IN_PARITYLL,
925 "__builtin_parityll", ATTR_CONST_NOTHROW_LEAF_LIST);
926 gfc_define_builtin ("__builtin_popcountll", ftype, BUILT_IN_POPCOUNTLL,
927 "__builtin_popcountll", ATTR_CONST_NOTHROW_LEAF_LIST);
928
929 /* Other builtin functions we use. */
930
931 ftype = build_function_type_list (long_integer_type_node,
932 long_integer_type_node,
933 long_integer_type_node, NULL_TREE);
934 gfc_define_builtin ("__builtin_expect", ftype, BUILT_IN_EXPECT,
935 "__builtin_expect", ATTR_CONST_NOTHROW_LEAF_LIST);
936
937 ftype = build_function_type_list (void_type_node,
938 pvoid_type_node, NULL_TREE);
939 gfc_define_builtin ("__builtin_free", ftype, BUILT_IN_FREE,
940 "free", ATTR_NOTHROW_LEAF_LIST);
941
942 ftype = build_function_type_list (pvoid_type_node,
943 size_type_node, NULL_TREE);
944 gfc_define_builtin ("__builtin_malloc", ftype, BUILT_IN_MALLOC,
945 "malloc", ATTR_NOTHROW_LEAF_MALLOC_LIST);
946
947 ftype = build_function_type_list (pvoid_type_node, size_type_node,
948 size_type_node, NULL_TREE);
949 gfc_define_builtin ("__builtin_calloc", ftype, BUILT_IN_CALLOC,
950 "calloc", ATTR_NOTHROW_LEAF_MALLOC_LIST);
951 DECL_IS_MALLOC (builtin_decl_explicit (BUILT_IN_CALLOC)) = 1;
952
953 ftype = build_function_type_list (pvoid_type_node,
954 size_type_node, pvoid_type_node,
955 NULL_TREE);
956 gfc_define_builtin ("__builtin_realloc", ftype, BUILT_IN_REALLOC,
957 "realloc", ATTR_NOTHROW_LEAF_LIST);
958
959 ftype = build_function_type_list (integer_type_node,
960 void_type_node, NULL_TREE);
961 gfc_define_builtin ("__builtin_isnan", ftype, BUILT_IN_ISNAN,
962 "__builtin_isnan", ATTR_CONST_NOTHROW_LEAF_LIST);
963
964 #define DEF_PRIMITIVE_TYPE(ENUM, VALUE) \
965 builtin_types[(int) ENUM] = VALUE;
966 #define DEF_FUNCTION_TYPE_0(ENUM, RETURN) \
967 builtin_types[(int) ENUM] \
968 = build_function_type_list (builtin_types[(int) RETURN], \
969 NULL_TREE);
970 #define DEF_FUNCTION_TYPE_1(ENUM, RETURN, ARG1) \
971 builtin_types[(int) ENUM] \
972 = build_function_type_list (builtin_types[(int) RETURN], \
973 builtin_types[(int) ARG1], \
974 NULL_TREE);
975 #define DEF_FUNCTION_TYPE_2(ENUM, RETURN, ARG1, ARG2) \
976 builtin_types[(int) ENUM] \
977 = build_function_type_list (builtin_types[(int) RETURN], \
978 builtin_types[(int) ARG1], \
979 builtin_types[(int) ARG2], \
980 NULL_TREE);
981 #define DEF_FUNCTION_TYPE_3(ENUM, RETURN, ARG1, ARG2, ARG3) \
982 builtin_types[(int) ENUM] \
983 = build_function_type_list (builtin_types[(int) RETURN], \
984 builtin_types[(int) ARG1], \
985 builtin_types[(int) ARG2], \
986 builtin_types[(int) ARG3], \
987 NULL_TREE);
988 #define DEF_FUNCTION_TYPE_4(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4) \
989 builtin_types[(int) ENUM] \
990 = build_function_type_list (builtin_types[(int) RETURN], \
991 builtin_types[(int) ARG1], \
992 builtin_types[(int) ARG2], \
993 builtin_types[(int) ARG3], \
994 builtin_types[(int) ARG4], \
995 NULL_TREE);
996 #define DEF_FUNCTION_TYPE_5(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5) \
997 builtin_types[(int) ENUM] \
998 = build_function_type_list (builtin_types[(int) RETURN], \
999 builtin_types[(int) ARG1], \
1000 builtin_types[(int) ARG2], \
1001 builtin_types[(int) ARG3], \
1002 builtin_types[(int) ARG4], \
1003 builtin_types[(int) ARG5], \
1004 NULL_TREE);
1005 #define DEF_FUNCTION_TYPE_6(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
1006 ARG6) \
1007 builtin_types[(int) ENUM] \
1008 = build_function_type_list (builtin_types[(int) RETURN], \
1009 builtin_types[(int) ARG1], \
1010 builtin_types[(int) ARG2], \
1011 builtin_types[(int) ARG3], \
1012 builtin_types[(int) ARG4], \
1013 builtin_types[(int) ARG5], \
1014 builtin_types[(int) ARG6], \
1015 NULL_TREE);
1016 #define DEF_FUNCTION_TYPE_7(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
1017 ARG6, ARG7) \
1018 builtin_types[(int) ENUM] \
1019 = build_function_type_list (builtin_types[(int) RETURN], \
1020 builtin_types[(int) ARG1], \
1021 builtin_types[(int) ARG2], \
1022 builtin_types[(int) ARG3], \
1023 builtin_types[(int) ARG4], \
1024 builtin_types[(int) ARG5], \
1025 builtin_types[(int) ARG6], \
1026 builtin_types[(int) ARG7], \
1027 NULL_TREE);
1028 #define DEF_FUNCTION_TYPE_8(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
1029 ARG6, ARG7, ARG8) \
1030 builtin_types[(int) ENUM] \
1031 = build_function_type_list (builtin_types[(int) RETURN], \
1032 builtin_types[(int) ARG1], \
1033 builtin_types[(int) ARG2], \
1034 builtin_types[(int) ARG3], \
1035 builtin_types[(int) ARG4], \
1036 builtin_types[(int) ARG5], \
1037 builtin_types[(int) ARG6], \
1038 builtin_types[(int) ARG7], \
1039 builtin_types[(int) ARG8], \
1040 NULL_TREE);
1041 #define DEF_FUNCTION_TYPE_VAR_0(ENUM, RETURN) \
1042 builtin_types[(int) ENUM] \
1043 = build_varargs_function_type_list (builtin_types[(int) RETURN], \
1044 NULL_TREE);
1045 #define DEF_POINTER_TYPE(ENUM, TYPE) \
1046 builtin_types[(int) ENUM] \
1047 = build_pointer_type (builtin_types[(int) TYPE]);
1048 #include "types.def"
1049 #undef DEF_PRIMITIVE_TYPE
1050 #undef DEF_FUNCTION_TYPE_0
1051 #undef DEF_FUNCTION_TYPE_1
1052 #undef DEF_FUNCTION_TYPE_2
1053 #undef DEF_FUNCTION_TYPE_3
1054 #undef DEF_FUNCTION_TYPE_4
1055 #undef DEF_FUNCTION_TYPE_5
1056 #undef DEF_FUNCTION_TYPE_6
1057 #undef DEF_FUNCTION_TYPE_7
1058 #undef DEF_FUNCTION_TYPE_8
1059 #undef DEF_FUNCTION_TYPE_VAR_0
1060 #undef DEF_POINTER_TYPE
1061 builtin_types[(int) BT_LAST] = NULL_TREE;
1062
1063 /* Initialize synchronization builtins. */
1064 #undef DEF_SYNC_BUILTIN
1065 #define DEF_SYNC_BUILTIN(code, name, type, attr) \
1066 gfc_define_builtin (name, builtin_types[type], code, name, \
1067 attr);
1068 #include "../sync-builtins.def"
1069 #undef DEF_SYNC_BUILTIN
1070
1071 if (gfc_option.gfc_flag_openmp
1072 || gfc_option.gfc_flag_openmp_simd
1073 || flag_tree_parallelize_loops)
1074 {
1075 #undef DEF_GOMP_BUILTIN
1076 #define DEF_GOMP_BUILTIN(code, name, type, attr) \
1077 gfc_define_builtin ("__builtin_" name, builtin_types[type], \
1078 code, name, attr);
1079 #include "../omp-builtins.def"
1080 #undef DEF_GOMP_BUILTIN
1081 }
1082
1083 gfc_define_builtin ("__builtin_trap", builtin_types[BT_FN_VOID],
1084 BUILT_IN_TRAP, NULL, ATTR_NOTHROW_LEAF_LIST);
1085 TREE_THIS_VOLATILE (builtin_decl_explicit (BUILT_IN_TRAP)) = 1;
1086
1087 ftype = build_varargs_function_type_list (ptr_type_node, const_ptr_type_node,
1088 size_type_node, NULL_TREE);
1089 gfc_define_builtin ("__builtin_assume_aligned", ftype,
1090 BUILT_IN_ASSUME_ALIGNED,
1091 "__builtin_assume_aligned",
1092 ATTR_CONST_NOTHROW_LEAF_LIST);
1093
1094 gfc_define_builtin ("__emutls_get_address",
1095 builtin_types[BT_FN_PTR_PTR],
1096 BUILT_IN_EMUTLS_GET_ADDRESS,
1097 "__emutls_get_address", ATTR_CONST_NOTHROW_LEAF_LIST);
1098 gfc_define_builtin ("__emutls_register_common",
1099 builtin_types[BT_FN_VOID_PTR_WORD_WORD_PTR],
1100 BUILT_IN_EMUTLS_REGISTER_COMMON,
1101 "__emutls_register_common", ATTR_NOTHROW_LEAF_LIST);
1102
1103 build_common_builtin_nodes ();
1104 targetm.init_builtins ();
1105 }
1106
1107 #undef DEFINE_MATH_BUILTIN_C
1108 #undef DEFINE_MATH_BUILTIN
1109
1110 static void
1111 gfc_init_ts (void)
1112 {
1113 tree_contains_struct[NAMESPACE_DECL][TS_DECL_NON_COMMON] = 1;
1114 tree_contains_struct[NAMESPACE_DECL][TS_DECL_WITH_VIS] = 1;
1115 tree_contains_struct[NAMESPACE_DECL][TS_DECL_WRTL] = 1;
1116 tree_contains_struct[NAMESPACE_DECL][TS_DECL_COMMON] = 1;
1117 tree_contains_struct[NAMESPACE_DECL][TS_DECL_MINIMAL] = 1;
1118 }
1119
1120 void
1121 gfc_maybe_initialize_eh (void)
1122 {
1123 if (!flag_exceptions || gfc_eh_initialized_p)
1124 return;
1125
1126 gfc_eh_initialized_p = true;
1127 using_eh_for_cleanups ();
1128 }
1129
1130
1131 #include "gt-fortran-f95-lang.h"
1132 #include "gtype-fortran.h"