1/* gfortran backend interface
2 Copyright (C) 2000-2024 Free Software Foundation, Inc.
3 Contributed by Paul Brook.
4
5This file is part of GCC.
6
7GCC is free software; you can redistribute it and/or modify it under
8the terms of the GNU General Public License as published by the Free
9Software Foundation; either version 3, or (at your option) any later
10version.
11
12GCC is distributed in the hope that it will be useful, but WITHOUT ANY
13WARRANTY; without even the implied warranty of MERCHANTABILITY or
14FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
15for more details.
16
17You should have received a copy of the GNU General Public License
18along with GCC; see the file COPYING3. If not see
19<http://www.gnu.org/licenses/>. */
20
21/* f95-lang.cc-- GCC backend interface stuff */
22
23/* declare required prototypes: */
24
25#include "config.h"
26#include "system.h"
27#include "coretypes.h"
28#include "target.h"
29#include "function.h"
30#include "tree.h"
31#include "gfortran.h"
32#include "trans.h"
33#include "stringpool.h"
34#include "diagnostic.h" /* For errorcount/warningcount */
35#include "langhooks.h"
36#include "langhooks-def.h"
37#include "toplev.h"
38#include "debug.h"
39#include "cpp.h"
40#include "trans-types.h"
41#include "trans-const.h"
42#include "attribs.h"
43
44/* Language-dependent contents of an identifier. */
45
46struct GTY(())
47lang_identifier {
48 struct tree_identifier common;
49};
50
51/* The resulting tree type. */
52
53union GTY((desc ("TREE_CODE (&%h.generic) == IDENTIFIER_NODE"),
54 chain_next ("CODE_CONTAINS_STRUCT (TREE_CODE (&%h.generic), TS_COMMON) ? ((union lang_tree_node *) TREE_CHAIN (&%h.generic)) : NULL")))
55lang_tree_node {
56 union tree_node GTY((tag ("0"),
57 desc ("tree_node_structure (&%h)"))) generic;
58 struct lang_identifier GTY((tag ("1"))) identifier;
59};
60
61/* Save and restore the variables in this file and elsewhere
62 that keep track of the progress of compilation of the current function.
63 Used for nested functions. */
64
65struct GTY(())
66language_function {
67 /* struct gfc_language_function base; */
68 struct binding_level *binding_level;
69};
70
71static void gfc_init_decl_processing (void);
72static void gfc_init_builtin_functions (void);
73static bool global_bindings_p (void);
74
75/* Each front end provides its own. */
76static bool gfc_init (void);
77static void gfc_finish (void);
78static void gfc_be_parse_file (void);
79static void gfc_init_ts (void);
80static tree gfc_builtin_function (tree);
81
82/* Handle an "omp declare target" attribute; arguments as in
83 struct attribute_spec.handler. */
84static tree
85gfc_handle_omp_declare_target_attribute (tree *, tree, tree, int, bool *)
86{
87 return NULL_TREE;
88}
89
90/* Table of valid Fortran attributes. */
91static const attribute_spec gfc_gnu_attributes[] =
92{
93 /* { name, min_len, max_len, decl_req, type_req, fn_type_req,
94 affects_type_identity, handler, exclude } */
95 { .name: "omp declare target", .min_length: 0, .max_length: -1, .decl_required: true, .type_required: false, .function_type_required: false, .affects_type_identity: false,
96 .handler: gfc_handle_omp_declare_target_attribute, NULL },
97 { .name: "omp declare target link", .min_length: 0, .max_length: 0, .decl_required: true, .type_required: false, .function_type_required: false, .affects_type_identity: false,
98 .handler: gfc_handle_omp_declare_target_attribute, NULL },
99 { .name: "omp declare target indirect", .min_length: 0, .max_length: 0, .decl_required: true, .type_required: false, .function_type_required: false, .affects_type_identity: false,
100 .handler: gfc_handle_omp_declare_target_attribute, NULL },
101 { .name: "oacc function", .min_length: 0, .max_length: -1, .decl_required: true, .type_required: false, .function_type_required: false, .affects_type_identity: false,
102 .handler: gfc_handle_omp_declare_target_attribute, NULL },
103};
104
105static const scoped_attribute_specs gfc_gnu_attribute_table =
106{
107 .ns: "gnu", .attributes: { gfc_gnu_attributes }
108};
109
110static const scoped_attribute_specs *const gfc_attribute_table[] =
111{
112 &gfc_gnu_attribute_table
113};
114
115/* Get a value for the SARIF v2.1.0 "artifact.sourceLanguage" property,
116 based on the list in SARIF v2.1.0 Appendix J. */
117
118static const char *
119gfc_get_sarif_source_language (const char *)
120{
121 return "fortran";
122}
123
124#undef LANG_HOOKS_NAME
125#undef LANG_HOOKS_INIT
126#undef LANG_HOOKS_FINISH
127#undef LANG_HOOKS_OPTION_LANG_MASK
128#undef LANG_HOOKS_INIT_OPTIONS_STRUCT
129#undef LANG_HOOKS_INIT_OPTIONS
130#undef LANG_HOOKS_HANDLE_OPTION
131#undef LANG_HOOKS_POST_OPTIONS
132#undef LANG_HOOKS_PARSE_FILE
133#undef LANG_HOOKS_MARK_ADDRESSABLE
134#undef LANG_HOOKS_TYPE_FOR_MODE
135#undef LANG_HOOKS_TYPE_FOR_SIZE
136#undef LANG_HOOKS_INIT_TS
137#undef LANG_HOOKS_OMP_ARRAY_DATA
138#undef LANG_HOOKS_OMP_ARRAY_SIZE
139#undef LANG_HOOKS_OMP_IS_ALLOCATABLE_OR_PTR
140#undef LANG_HOOKS_OMP_CHECK_OPTIONAL_ARGUMENT
141#undef LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE
142#undef LANG_HOOKS_OMP_PREDETERMINED_SHARING
143#undef LANG_HOOKS_OMP_PREDETERMINED_MAPPING
144#undef LANG_HOOKS_OMP_REPORT_DECL
145#undef LANG_HOOKS_OMP_CLAUSE_DEFAULT_CTOR
146#undef LANG_HOOKS_OMP_CLAUSE_COPY_CTOR
147#undef LANG_HOOKS_OMP_CLAUSE_ASSIGN_OP
148#undef LANG_HOOKS_OMP_CLAUSE_LINEAR_CTOR
149#undef LANG_HOOKS_OMP_CLAUSE_DTOR
150#undef LANG_HOOKS_OMP_FINISH_CLAUSE
151#undef LANG_HOOKS_OMP_ALLOCATABLE_P
152#undef LANG_HOOKS_OMP_SCALAR_TARGET_P
153#undef LANG_HOOKS_OMP_SCALAR_P
154#undef LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR
155#undef LANG_HOOKS_OMP_PRIVATE_DEBUG_CLAUSE
156#undef LANG_HOOKS_OMP_PRIVATE_OUTER_REF
157#undef LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES
158#undef LANG_HOOKS_BUILTIN_FUNCTION
159#undef LANG_HOOKS_BUILTIN_FUNCTION
160#undef LANG_HOOKS_GET_ARRAY_DESCR_INFO
161#undef LANG_HOOKS_ATTRIBUTE_TABLE
162#undef LANG_HOOKS_GET_SARIF_SOURCE_LANGUAGE
163
164/* Define lang hooks. */
165#define LANG_HOOKS_NAME "GNU Fortran"
166#define LANG_HOOKS_INIT gfc_init
167#define LANG_HOOKS_FINISH gfc_finish
168#define LANG_HOOKS_OPTION_LANG_MASK gfc_option_lang_mask
169#define LANG_HOOKS_INIT_OPTIONS_STRUCT gfc_init_options_struct
170#define LANG_HOOKS_INIT_OPTIONS gfc_init_options
171#define LANG_HOOKS_HANDLE_OPTION gfc_handle_option
172#define LANG_HOOKS_POST_OPTIONS gfc_post_options
173#define LANG_HOOKS_PARSE_FILE gfc_be_parse_file
174#define LANG_HOOKS_TYPE_FOR_MODE gfc_type_for_mode
175#define LANG_HOOKS_TYPE_FOR_SIZE gfc_type_for_size
176#define LANG_HOOKS_INIT_TS gfc_init_ts
177#define LANG_HOOKS_OMP_ARRAY_DATA gfc_omp_array_data
178#define LANG_HOOKS_OMP_ARRAY_SIZE gfc_omp_array_size
179#define LANG_HOOKS_OMP_IS_ALLOCATABLE_OR_PTR gfc_omp_is_allocatable_or_ptr
180#define LANG_HOOKS_OMP_CHECK_OPTIONAL_ARGUMENT gfc_omp_check_optional_argument
181#define LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE gfc_omp_privatize_by_reference
182#define LANG_HOOKS_OMP_PREDETERMINED_SHARING gfc_omp_predetermined_sharing
183#define LANG_HOOKS_OMP_PREDETERMINED_MAPPING gfc_omp_predetermined_mapping
184#define LANG_HOOKS_OMP_REPORT_DECL gfc_omp_report_decl
185#define LANG_HOOKS_OMP_CLAUSE_DEFAULT_CTOR gfc_omp_clause_default_ctor
186#define LANG_HOOKS_OMP_CLAUSE_COPY_CTOR gfc_omp_clause_copy_ctor
187#define LANG_HOOKS_OMP_CLAUSE_ASSIGN_OP gfc_omp_clause_assign_op
188#define LANG_HOOKS_OMP_CLAUSE_LINEAR_CTOR gfc_omp_clause_linear_ctor
189#define LANG_HOOKS_OMP_CLAUSE_DTOR gfc_omp_clause_dtor
190#define LANG_HOOKS_OMP_FINISH_CLAUSE gfc_omp_finish_clause
191#define LANG_HOOKS_OMP_ALLOCATABLE_P gfc_omp_allocatable_p
192#define LANG_HOOKS_OMP_SCALAR_P gfc_omp_scalar_p
193#define LANG_HOOKS_OMP_SCALAR_TARGET_P gfc_omp_scalar_target_p
194#define LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR gfc_omp_disregard_value_expr
195#define LANG_HOOKS_OMP_PRIVATE_DEBUG_CLAUSE gfc_omp_private_debug_clause
196#define LANG_HOOKS_OMP_PRIVATE_OUTER_REF gfc_omp_private_outer_ref
197#define LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES \
198 gfc_omp_firstprivatize_type_sizes
199#define LANG_HOOKS_BUILTIN_FUNCTION gfc_builtin_function
200#define LANG_HOOKS_GET_ARRAY_DESCR_INFO gfc_get_array_descr_info
201#define LANG_HOOKS_ATTRIBUTE_TABLE gfc_attribute_table
202#define LANG_HOOKS_GET_SARIF_SOURCE_LANGUAGE gfc_get_sarif_source_language
203
204struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
205
206#define NULL_BINDING_LEVEL (struct binding_level *) NULL
207
208/* A chain of binding_level structures awaiting reuse. */
209
210static GTY(()) struct binding_level *free_binding_level;
211
212/* True means we've initialized exception handling. */
213static bool gfc_eh_initialized_p;
214
215/* The current translation unit. */
216static GTY(()) tree current_translation_unit;
217
218
219static void
220gfc_create_decls (void)
221{
222 /* GCC builtins. */
223 gfc_init_builtin_functions ();
224
225 /* Runtime/IO library functions. */
226 gfc_build_builtin_function_decls ();
227
228 gfc_init_constants ();
229
230 /* Build our translation-unit decl. */
231 current_translation_unit
232 = build_translation_unit_decl (get_identifier (main_input_filename));
233 debug_hooks->register_main_translation_unit (current_translation_unit);
234}
235
236
237static void
238gfc_be_parse_file (void)
239{
240 gfc_create_decls ();
241 gfc_parse_file ();
242 gfc_generate_constructors ();
243
244 /* Clear the binding level stack. */
245 while (!global_bindings_p ())
246 poplevel (0, 0);
247
248 /* Finalize all of the globals.
249
250 Emulated tls lowering needs to see all TLS variables before we
251 call finalize_compilation_unit. The C/C++ front ends manage this
252 by calling decl_rest_of_compilation on each global and static
253 variable as they are seen. The Fortran front end waits until
254 here. */
255 for (tree decl = getdecls (); decl ; decl = DECL_CHAIN (decl))
256 rest_of_decl_compilation (decl, true, true);
257
258 /* Switch to the default tree diagnostics here, because there may be
259 diagnostics before gfc_finish(). */
260 gfc_diagnostics_finish ();
261
262 global_decl_processing ();
263}
264
265
266/* Initialize everything. */
267
268static bool
269gfc_init (void)
270{
271 if (!gfc_cpp_enabled ())
272 {
273 linemap_add (line_table, LC_ENTER, sysp: false, to_file: gfc_source_file, to_line: 1);
274 linemap_add (line_table, LC_RENAME, sysp: false, to_file: special_fname_builtin (), to_line: 0);
275 }
276 else
277 gfc_cpp_init_0 ();
278
279 gfc_init_decl_processing ();
280 gfc_static_ctors = NULL_TREE;
281
282 if (gfc_cpp_enabled ())
283 gfc_cpp_init ();
284
285 gfc_init_1 ();
286
287 /* Calls exit in case of a fail. */
288 gfc_new_file ();
289
290 if (flag_preprocess_only)
291 return false;
292
293 return true;
294}
295
296
297static void
298gfc_finish (void)
299{
300 gfc_cpp_done ();
301 gfc_done_1 ();
302 gfc_release_include_path ();
303 return;
304}
305
306/* These functions and variables deal with binding contours. We only
307 need these functions for the list of PARM_DECLs, but we leave the
308 functions more general; these are a simplified version of the
309 functions from GNAT. */
310
311/* For each binding contour we allocate a binding_level structure which
312 records the entities defined or declared in that contour. Contours
313 include:
314
315 the global one
316 one for each subprogram definition
317 one for each compound statement (declare block)
318
319 Binding contours are used to create GCC tree BLOCK nodes. */
320
321struct GTY(())
322binding_level {
323 /* A chain of ..._DECL nodes for all variables, constants, functions,
324 parameters and type declarations. These ..._DECL nodes are chained
325 through the DECL_CHAIN field. */
326 tree names;
327 /* For each level (except the global one), a chain of BLOCK nodes for all
328 the levels that were entered and exited one level down from this one. */
329 tree blocks;
330 /* The binding level containing this one (the enclosing binding level). */
331 struct binding_level *level_chain;
332 /* True if nreverse has been already called on names; if false, names
333 are ordered from newest declaration to oldest one. */
334 bool reversed;
335};
336
337/* The binding level currently in effect. */
338static GTY(()) struct binding_level *current_binding_level = NULL;
339
340/* The outermost binding level. This binding level is created when the
341 compiler is started and it will exist through the entire compilation. */
342static GTY(()) struct binding_level *global_binding_level;
343
344/* Binding level structures are initialized by copying this one. */
345static struct binding_level clear_binding_level = { NULL, NULL, NULL, .reversed: false };
346
347
348/* Return true if we are in the global binding level. */
349
350bool
351global_bindings_p (void)
352{
353 return current_binding_level == global_binding_level;
354}
355
356tree
357getdecls (void)
358{
359 if (!current_binding_level->reversed)
360 {
361 current_binding_level->reversed = true;
362 current_binding_level->names = nreverse (current_binding_level->names);
363 }
364 return current_binding_level->names;
365}
366
367/* Enter a new binding level. */
368
369void
370pushlevel (void)
371{
372 struct binding_level *newlevel = ggc_alloc<binding_level> ();
373
374 *newlevel = clear_binding_level;
375
376 /* Add this level to the front of the chain (stack) of levels that are
377 active. */
378 newlevel->level_chain = current_binding_level;
379 current_binding_level = newlevel;
380}
381
382/* Exit a binding level.
383 Pop the level off, and restore the state of the identifier-decl mappings
384 that were in effect when this level was entered.
385
386 If KEEP is nonzero, this level had explicit declarations, so
387 and create a "block" (a BLOCK node) for the level
388 to record its declarations and subblocks for symbol table output.
389
390 If FUNCTIONBODY is nonzero, this level is the body of a function,
391 so create a block as if KEEP were set and also clear out all
392 label names. */
393
394tree
395poplevel (int keep, int functionbody)
396{
397 /* Points to a BLOCK tree node. This is the BLOCK node constructed for the
398 binding level that we are about to exit and which is returned by this
399 routine. */
400 tree block_node = NULL_TREE;
401 tree decl_chain = getdecls ();
402 tree subblock_chain = current_binding_level->blocks;
403 tree subblock_node;
404
405 /* If there were any declarations in the current binding level, or if this
406 binding level is a function body, or if there are any nested blocks then
407 create a BLOCK node to record them for the life of this function. */
408 if (keep || functionbody)
409 block_node = build_block (keep ? decl_chain : 0, subblock_chain, 0, 0);
410
411 /* Record the BLOCK node just built as the subblock its enclosing scope. */
412 for (subblock_node = subblock_chain; subblock_node;
413 subblock_node = BLOCK_CHAIN (subblock_node))
414 BLOCK_SUPERCONTEXT (subblock_node) = block_node;
415
416 /* Clear out the meanings of the local variables of this level. */
417
418 for (subblock_node = decl_chain; subblock_node;
419 subblock_node = DECL_CHAIN (subblock_node))
420 if (DECL_NAME (subblock_node) != 0)
421 /* If the identifier was used or addressed via a local extern decl,
422 don't forget that fact. */
423 if (DECL_EXTERNAL (subblock_node))
424 {
425 if (TREE_USED (subblock_node))
426 TREE_USED (DECL_NAME (subblock_node)) = 1;
427 if (TREE_ADDRESSABLE (subblock_node))
428 TREE_ADDRESSABLE (DECL_ASSEMBLER_NAME (subblock_node)) = 1;
429 }
430
431 /* Pop the current level. */
432 current_binding_level = current_binding_level->level_chain;
433
434 if (functionbody)
435 /* This is the top level block of a function. */
436 DECL_INITIAL (current_function_decl) = block_node;
437 else if (current_binding_level == global_binding_level)
438 /* When using gfc_start_block/gfc_finish_block from middle-end hooks,
439 don't add newly created BLOCKs as subblocks of global_binding_level. */
440 ;
441 else if (block_node)
442 {
443 current_binding_level->blocks
444 = block_chainon (current_binding_level->blocks, block_node);
445 }
446
447 /* If we did not make a block for the level just exited, any blocks made for
448 inner levels (since they cannot be recorded as subblocks in that level)
449 must be carried forward so they will later become subblocks of something
450 else. */
451 else if (subblock_chain)
452 current_binding_level->blocks
453 = block_chainon (current_binding_level->blocks, subblock_chain);
454 if (block_node)
455 TREE_USED (block_node) = 1;
456
457 return block_node;
458}
459
460
461/* Records a ..._DECL node DECL as belonging to the current lexical scope.
462 Returns the ..._DECL node. */
463
464tree
465pushdecl (tree decl)
466{
467 if (global_bindings_p ())
468 DECL_CONTEXT (decl) = current_translation_unit;
469 else
470 {
471 /* External objects aren't nested. For debug info insert a copy
472 of the decl into the binding level. */
473 if (DECL_EXTERNAL (decl))
474 {
475 tree orig = decl;
476 decl = copy_node (decl);
477 DECL_CONTEXT (orig) = NULL_TREE;
478 }
479 DECL_CONTEXT (decl) = current_function_decl;
480 }
481
482 /* Put the declaration on the list. */
483 DECL_CHAIN (decl) = current_binding_level->names;
484 current_binding_level->names = decl;
485
486 /* For the declaration of a type, set its name if it is not already set. */
487
488 if (TREE_CODE (decl) == TYPE_DECL && TYPE_NAME (TREE_TYPE (decl)) == 0)
489 {
490 if (DECL_SOURCE_LINE (decl) == 0)
491 TYPE_NAME (TREE_TYPE (decl)) = decl;
492 else
493 TYPE_NAME (TREE_TYPE (decl)) = DECL_NAME (decl);
494 }
495
496 return decl;
497}
498
499
500/* Like pushdecl, only it places X in GLOBAL_BINDING_LEVEL. */
501
502tree
503pushdecl_top_level (tree x)
504{
505 tree t;
506 struct binding_level *b = current_binding_level;
507
508 current_binding_level = global_binding_level;
509 t = pushdecl (decl: x);
510 current_binding_level = b;
511 return t;
512}
513
514#ifndef CHAR_TYPE_SIZE
515#define CHAR_TYPE_SIZE BITS_PER_UNIT
516#endif
517
518#ifndef INT_TYPE_SIZE
519#define INT_TYPE_SIZE BITS_PER_WORD
520#endif
521
522#undef SIZE_TYPE
523#define SIZE_TYPE "long unsigned int"
524
525/* Create tree nodes for the basic scalar types of Fortran 95,
526 and some nodes representing standard constants (0, 1, (void *) 0).
527 Initialize the global binding level.
528 Make definitions for built-in primitive functions. */
529static void
530gfc_init_decl_processing (void)
531{
532 current_function_decl = NULL;
533 current_binding_level = NULL_BINDING_LEVEL;
534 free_binding_level = NULL_BINDING_LEVEL;
535
536 /* Make the binding_level structure for global names. We move all
537 variables that are in a COMMON block to this binding level. */
538 pushlevel ();
539 global_binding_level = current_binding_level;
540
541 /* Build common tree nodes. char_type_node is unsigned because we
542 only use it for actual characters, not for INTEGER(1). */
543 build_common_tree_nodes (false);
544
545 /* Set up F95 type nodes. */
546 gfc_init_kinds ();
547 gfc_init_types ();
548 gfc_init_c_interop_kinds ();
549}
550
551
552/* Builtin function initialization. */
553
554static tree
555gfc_builtin_function (tree decl)
556{
557 pushdecl (decl);
558 return decl;
559}
560
561/* So far we need just these 10 attribute types. */
562#define ATTR_NULL 0
563#define ATTR_LEAF_LIST (ECF_LEAF)
564#define ATTR_NOTHROW_LEAF_LIST (ECF_NOTHROW | ECF_LEAF)
565#define ATTR_NOTHROW_LEAF_MALLOC_LIST (ECF_NOTHROW | ECF_LEAF | ECF_MALLOC)
566#define ATTR_CONST_NOTHROW_LEAF_LIST (ECF_NOTHROW | ECF_LEAF | ECF_CONST)
567#define ATTR_PURE_NOTHROW_LEAF_LIST (ECF_NOTHROW | ECF_LEAF | ECF_PURE)
568#define ATTR_NOTHROW_LIST (ECF_NOTHROW)
569#define ATTR_CONST_NOTHROW_LIST (ECF_NOTHROW | ECF_CONST)
570#define ATTR_ALLOC_WARN_UNUSED_RESULT_SIZE_2_NOTHROW_LIST \
571 (ECF_NOTHROW | ECF_LEAF | ECF_MALLOC)
572#define ATTR_ALLOC_WARN_UNUSED_RESULT_SIZE_2_NOTHROW_LEAF_LIST \
573 (ECF_NOTHROW | ECF_LEAF)
574#define ATTR_COLD_NORETURN_NOTHROW_LEAF_LIST \
575 (ECF_COLD | ECF_NORETURN | \
576 ECF_NOTHROW | ECF_LEAF)
577
578static void
579gfc_define_builtin (const char *name, tree type, enum built_in_function code,
580 const char *library_name, int attr)
581{
582 tree decl;
583
584 decl = add_builtin_function (name, type, function_code: code, cl: BUILT_IN_NORMAL,
585 library_name, NULL_TREE);
586 set_call_expr_flags (decl, attr);
587
588 set_builtin_decl (fncode: code, decl, implicit_p: true);
589}
590
591
592#define DO_DEFINE_MATH_BUILTIN(code, name, argtype, tbase) \
593 gfc_define_builtin ("__builtin_" name "l", tbase##longdouble[argtype], \
594 BUILT_IN_ ## code ## L, name "l", \
595 ATTR_CONST_NOTHROW_LEAF_LIST); \
596 gfc_define_builtin ("__builtin_" name, tbase##double[argtype], \
597 BUILT_IN_ ## code, name, \
598 ATTR_CONST_NOTHROW_LEAF_LIST); \
599 gfc_define_builtin ("__builtin_" name "f", tbase##float[argtype], \
600 BUILT_IN_ ## code ## F, name "f", \
601 ATTR_CONST_NOTHROW_LEAF_LIST);
602
603#define DEFINE_MATH_BUILTIN(code, name, argtype) \
604 DO_DEFINE_MATH_BUILTIN (code, name, argtype, mfunc_)
605
606#define DEFINE_MATH_BUILTIN_C(code, name, argtype) \
607 DO_DEFINE_MATH_BUILTIN (code, name, argtype, mfunc_) \
608 DO_DEFINE_MATH_BUILTIN (C##code, "c" name, argtype, mfunc_c)
609
610
611/* Create function types for builtin functions. */
612
613static void
614build_builtin_fntypes (tree *fntype, tree type)
615{
616 /* type (*) (type) */
617 fntype[0] = build_function_type_list (type, type, NULL_TREE);
618 /* type (*) (type, type) */
619 fntype[1] = build_function_type_list (type, type, type, NULL_TREE);
620 /* type (*) (type, int) */
621 fntype[2] = build_function_type_list (type,
622 type, integer_type_node, NULL_TREE);
623 /* type (*) (void) */
624 fntype[3] = build_function_type_list (type, NULL_TREE);
625 /* type (*) (type, &int) */
626 fntype[4] = build_function_type_list (type, type,
627 build_pointer_type (integer_type_node),
628 NULL_TREE);
629 /* type (*) (int, type) */
630 fntype[5] = build_function_type_list (type,
631 integer_type_node, type, NULL_TREE);
632}
633
634
635static tree
636builtin_type_for_size (int size, bool unsignedp)
637{
638 tree type = gfc_type_for_size (size, unsignedp);
639 return type ? type : error_mark_node;
640}
641
642/* Initialization of builtin function nodes. */
643
644static void
645gfc_init_builtin_functions (void)
646{
647 enum builtin_type
648 {
649#define DEF_PRIMITIVE_TYPE(NAME, VALUE) NAME,
650#define DEF_FUNCTION_TYPE_0(NAME, RETURN) NAME,
651#define DEF_FUNCTION_TYPE_1(NAME, RETURN, ARG1) NAME,
652#define DEF_FUNCTION_TYPE_2(NAME, RETURN, ARG1, ARG2) NAME,
653#define DEF_FUNCTION_TYPE_3(NAME, RETURN, ARG1, ARG2, ARG3) NAME,
654#define DEF_FUNCTION_TYPE_4(NAME, RETURN, ARG1, ARG2, ARG3, ARG4) NAME,
655#define DEF_FUNCTION_TYPE_5(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5) NAME,
656#define DEF_FUNCTION_TYPE_6(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
657 ARG6) NAME,
658#define DEF_FUNCTION_TYPE_7(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
659 ARG6, ARG7) NAME,
660#define DEF_FUNCTION_TYPE_8(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
661 ARG6, ARG7, ARG8) NAME,
662#define DEF_FUNCTION_TYPE_9(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
663 ARG6, ARG7, ARG8, ARG9) NAME,
664#define DEF_FUNCTION_TYPE_10(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
665 ARG6, ARG7, ARG8, ARG9, ARG10) NAME,
666#define DEF_FUNCTION_TYPE_11(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
667 ARG6, ARG7, ARG8, ARG9, ARG10, ARG11) NAME,
668#define DEF_FUNCTION_TYPE_VAR_0(NAME, RETURN) NAME,
669#define DEF_FUNCTION_TYPE_VAR_1(NAME, RETURN, ARG1) NAME,
670#define DEF_FUNCTION_TYPE_VAR_2(NAME, RETURN, ARG1, ARG2) NAME,
671#define DEF_FUNCTION_TYPE_VAR_6(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
672 ARG6) NAME,
673#define DEF_FUNCTION_TYPE_VAR_7(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
674 ARG6, ARG7) NAME,
675#define DEF_POINTER_TYPE(NAME, TYPE) NAME,
676#include "types.def"
677#undef DEF_PRIMITIVE_TYPE
678#undef DEF_FUNCTION_TYPE_0
679#undef DEF_FUNCTION_TYPE_1
680#undef DEF_FUNCTION_TYPE_2
681#undef DEF_FUNCTION_TYPE_3
682#undef DEF_FUNCTION_TYPE_4
683#undef DEF_FUNCTION_TYPE_5
684#undef DEF_FUNCTION_TYPE_6
685#undef DEF_FUNCTION_TYPE_7
686#undef DEF_FUNCTION_TYPE_8
687#undef DEF_FUNCTION_TYPE_9
688#undef DEF_FUNCTION_TYPE_10
689#undef DEF_FUNCTION_TYPE_11
690#undef DEF_FUNCTION_TYPE_VAR_0
691#undef DEF_FUNCTION_TYPE_VAR_1
692#undef DEF_FUNCTION_TYPE_VAR_2
693#undef DEF_FUNCTION_TYPE_VAR_6
694#undef DEF_FUNCTION_TYPE_VAR_7
695#undef DEF_POINTER_TYPE
696 BT_LAST
697 };
698
699 tree mfunc_float[6];
700 tree mfunc_double[6];
701 tree mfunc_longdouble[6];
702 tree mfunc_cfloat[6];
703 tree mfunc_cdouble[6];
704 tree mfunc_clongdouble[6];
705 tree func_cfloat_float, func_float_cfloat;
706 tree func_cdouble_double, func_double_cdouble;
707 tree func_clongdouble_longdouble, func_longdouble_clongdouble;
708 tree func_float_floatp_floatp;
709 tree func_double_doublep_doublep;
710 tree func_longdouble_longdoublep_longdoublep;
711 tree ftype, ptype;
712 tree builtin_types[(int) BT_LAST + 1];
713
714 int attr;
715
716 build_builtin_fntypes (fntype: mfunc_float, float_type_node);
717 build_builtin_fntypes (fntype: mfunc_double, double_type_node);
718 build_builtin_fntypes (fntype: mfunc_longdouble, long_double_type_node);
719 build_builtin_fntypes (fntype: mfunc_cfloat, complex_float_type_node);
720 build_builtin_fntypes (fntype: mfunc_cdouble, complex_double_type_node);
721 build_builtin_fntypes (fntype: mfunc_clongdouble, complex_long_double_type_node);
722
723 func_cfloat_float = build_function_type_list (float_type_node,
724 complex_float_type_node,
725 NULL_TREE);
726
727 func_float_cfloat = build_function_type_list (complex_float_type_node,
728 float_type_node, NULL_TREE);
729
730 func_cdouble_double = build_function_type_list (double_type_node,
731 complex_double_type_node,
732 NULL_TREE);
733
734 func_double_cdouble = build_function_type_list (complex_double_type_node,
735 double_type_node, NULL_TREE);
736
737 func_clongdouble_longdouble
738 = build_function_type_list (long_double_type_node,
739 complex_long_double_type_node, NULL_TREE);
740
741 func_longdouble_clongdouble
742 = build_function_type_list (complex_long_double_type_node,
743 long_double_type_node, NULL_TREE);
744
745 ptype = build_pointer_type (float_type_node);
746 func_float_floatp_floatp
747 = build_function_type_list (void_type_node, float_type_node, ptype, ptype,
748 NULL_TREE);
749
750 ptype = build_pointer_type (double_type_node);
751 func_double_doublep_doublep
752 = build_function_type_list (void_type_node, double_type_node, ptype,
753 ptype, NULL_TREE);
754
755 ptype = build_pointer_type (long_double_type_node);
756 func_longdouble_longdoublep_longdoublep
757 = build_function_type_list (void_type_node, long_double_type_node, ptype,
758 ptype, NULL_TREE);
759
760/* Non-math builtins are defined manually, so they're not included here. */
761#define OTHER_BUILTIN(ID,NAME,TYPE,CONST)
762
763#include "mathbuiltins.def"
764
765 gfc_define_builtin (name: "__builtin_roundl", type: mfunc_longdouble[0],
766 code: BUILT_IN_ROUNDL, library_name: "roundl", ATTR_CONST_NOTHROW_LEAF_LIST);
767 gfc_define_builtin (name: "__builtin_round", type: mfunc_double[0],
768 code: BUILT_IN_ROUND, library_name: "round", ATTR_CONST_NOTHROW_LEAF_LIST);
769 gfc_define_builtin (name: "__builtin_roundf", type: mfunc_float[0],
770 code: BUILT_IN_ROUNDF, library_name: "roundf", ATTR_CONST_NOTHROW_LEAF_LIST);
771
772 gfc_define_builtin (name: "__builtin_truncl", type: mfunc_longdouble[0],
773 code: BUILT_IN_TRUNCL, library_name: "truncl", ATTR_CONST_NOTHROW_LEAF_LIST);
774 gfc_define_builtin (name: "__builtin_trunc", type: mfunc_double[0],
775 code: BUILT_IN_TRUNC, library_name: "trunc", ATTR_CONST_NOTHROW_LEAF_LIST);
776 gfc_define_builtin (name: "__builtin_truncf", type: mfunc_float[0],
777 code: BUILT_IN_TRUNCF, library_name: "truncf", ATTR_CONST_NOTHROW_LEAF_LIST);
778
779 gfc_define_builtin (name: "__builtin_cabsl", type: func_clongdouble_longdouble,
780 code: BUILT_IN_CABSL, library_name: "cabsl", ATTR_CONST_NOTHROW_LEAF_LIST);
781 gfc_define_builtin (name: "__builtin_cabs", type: func_cdouble_double,
782 code: BUILT_IN_CABS, library_name: "cabs", ATTR_CONST_NOTHROW_LEAF_LIST);
783 gfc_define_builtin (name: "__builtin_cabsf", type: func_cfloat_float,
784 code: BUILT_IN_CABSF, library_name: "cabsf", ATTR_CONST_NOTHROW_LEAF_LIST);
785
786 gfc_define_builtin (name: "__builtin_copysignl", type: mfunc_longdouble[1],
787 code: BUILT_IN_COPYSIGNL, library_name: "copysignl",
788 ATTR_CONST_NOTHROW_LEAF_LIST);
789 gfc_define_builtin (name: "__builtin_copysign", type: mfunc_double[1],
790 code: BUILT_IN_COPYSIGN, library_name: "copysign",
791 ATTR_CONST_NOTHROW_LEAF_LIST);
792 gfc_define_builtin (name: "__builtin_copysignf", type: mfunc_float[1],
793 code: BUILT_IN_COPYSIGNF, library_name: "copysignf",
794 ATTR_CONST_NOTHROW_LEAF_LIST);
795
796 gfc_define_builtin (name: "__builtin_nextafterl", type: mfunc_longdouble[1],
797 code: BUILT_IN_NEXTAFTERL, library_name: "nextafterl",
798 ATTR_CONST_NOTHROW_LEAF_LIST);
799 gfc_define_builtin (name: "__builtin_nextafter", type: mfunc_double[1],
800 code: BUILT_IN_NEXTAFTER, library_name: "nextafter",
801 ATTR_CONST_NOTHROW_LEAF_LIST);
802 gfc_define_builtin (name: "__builtin_nextafterf", type: mfunc_float[1],
803 code: BUILT_IN_NEXTAFTERF, library_name: "nextafterf",
804 ATTR_CONST_NOTHROW_LEAF_LIST);
805
806 /* Some built-ins depend on rounding mode. Depending on compilation options, they
807 will be "pure" or "const". */
808 attr = flag_rounding_math ? ATTR_PURE_NOTHROW_LEAF_LIST : ATTR_CONST_NOTHROW_LEAF_LIST;
809
810 gfc_define_builtin (name: "__builtin_rintl", type: mfunc_longdouble[0],
811 code: BUILT_IN_RINTL, library_name: "rintl", attr);
812 gfc_define_builtin (name: "__builtin_rint", type: mfunc_double[0],
813 code: BUILT_IN_RINT, library_name: "rint", attr);
814 gfc_define_builtin (name: "__builtin_rintf", type: mfunc_float[0],
815 code: BUILT_IN_RINTF, library_name: "rintf", attr);
816
817 gfc_define_builtin (name: "__builtin_remainderl", type: mfunc_longdouble[1],
818 code: BUILT_IN_REMAINDERL, library_name: "remainderl", attr);
819 gfc_define_builtin (name: "__builtin_remainder", type: mfunc_double[1],
820 code: BUILT_IN_REMAINDER, library_name: "remainder", attr);
821 gfc_define_builtin (name: "__builtin_remainderf", type: mfunc_float[1],
822 code: BUILT_IN_REMAINDERF, library_name: "remainderf", attr);
823
824 gfc_define_builtin (name: "__builtin_logbl", type: mfunc_longdouble[0],
825 code: BUILT_IN_LOGBL, library_name: "logbl", ATTR_CONST_NOTHROW_LEAF_LIST);
826 gfc_define_builtin (name: "__builtin_logb", type: mfunc_double[0],
827 code: BUILT_IN_LOGB, library_name: "logb", ATTR_CONST_NOTHROW_LEAF_LIST);
828 gfc_define_builtin (name: "__builtin_logbf", type: mfunc_float[0],
829 code: BUILT_IN_LOGBF, library_name: "logbf", ATTR_CONST_NOTHROW_LEAF_LIST);
830
831
832 gfc_define_builtin (name: "__builtin_frexpl", type: mfunc_longdouble[4],
833 code: BUILT_IN_FREXPL, library_name: "frexpl", ATTR_NOTHROW_LEAF_LIST);
834 gfc_define_builtin (name: "__builtin_frexp", type: mfunc_double[4],
835 code: BUILT_IN_FREXP, library_name: "frexp", ATTR_NOTHROW_LEAF_LIST);
836 gfc_define_builtin (name: "__builtin_frexpf", type: mfunc_float[4],
837 code: BUILT_IN_FREXPF, library_name: "frexpf", ATTR_NOTHROW_LEAF_LIST);
838
839 gfc_define_builtin (name: "__builtin_fabsl", type: mfunc_longdouble[0],
840 code: BUILT_IN_FABSL, library_name: "fabsl", ATTR_CONST_NOTHROW_LEAF_LIST);
841 gfc_define_builtin (name: "__builtin_fabs", type: mfunc_double[0],
842 code: BUILT_IN_FABS, library_name: "fabs", ATTR_CONST_NOTHROW_LEAF_LIST);
843 gfc_define_builtin (name: "__builtin_fabsf", type: mfunc_float[0],
844 code: BUILT_IN_FABSF, library_name: "fabsf", ATTR_CONST_NOTHROW_LEAF_LIST);
845
846 gfc_define_builtin (name: "__builtin_scalbnl", type: mfunc_longdouble[2],
847 code: BUILT_IN_SCALBNL, library_name: "scalbnl", ATTR_CONST_NOTHROW_LEAF_LIST);
848 gfc_define_builtin (name: "__builtin_scalbn", type: mfunc_double[2],
849 code: BUILT_IN_SCALBN, library_name: "scalbn", ATTR_CONST_NOTHROW_LEAF_LIST);
850 gfc_define_builtin (name: "__builtin_scalbnf", type: mfunc_float[2],
851 code: BUILT_IN_SCALBNF, library_name: "scalbnf", ATTR_CONST_NOTHROW_LEAF_LIST);
852
853 gfc_define_builtin (name: "__builtin_fmaxl", type: mfunc_longdouble[1],
854 code: BUILT_IN_FMAXL, library_name: "fmaxl", ATTR_CONST_NOTHROW_LEAF_LIST);
855 gfc_define_builtin (name: "__builtin_fmax", type: mfunc_double[1],
856 code: BUILT_IN_FMAX, library_name: "fmax", ATTR_CONST_NOTHROW_LEAF_LIST);
857 gfc_define_builtin (name: "__builtin_fmaxf", type: mfunc_float[1],
858 code: BUILT_IN_FMAXF, library_name: "fmaxf", ATTR_CONST_NOTHROW_LEAF_LIST);
859
860 gfc_define_builtin (name: "__builtin_fminl", type: mfunc_longdouble[1],
861 code: BUILT_IN_FMINL, library_name: "fminl", ATTR_CONST_NOTHROW_LEAF_LIST);
862 gfc_define_builtin (name: "__builtin_fmin", type: mfunc_double[1],
863 code: BUILT_IN_FMIN, library_name: "fmin", ATTR_CONST_NOTHROW_LEAF_LIST);
864 gfc_define_builtin (name: "__builtin_fminf", type: mfunc_float[1],
865 code: BUILT_IN_FMINF, library_name: "fminf", ATTR_CONST_NOTHROW_LEAF_LIST);
866
867 gfc_define_builtin (name: "__builtin_fmodl", type: mfunc_longdouble[1],
868 code: BUILT_IN_FMODL, library_name: "fmodl", ATTR_CONST_NOTHROW_LEAF_LIST);
869 gfc_define_builtin (name: "__builtin_fmod", type: mfunc_double[1],
870 code: BUILT_IN_FMOD, library_name: "fmod", ATTR_CONST_NOTHROW_LEAF_LIST);
871 gfc_define_builtin (name: "__builtin_fmodf", type: mfunc_float[1],
872 code: BUILT_IN_FMODF, library_name: "fmodf", ATTR_CONST_NOTHROW_LEAF_LIST);
873
874 /* iround{f,,l}, lround{f,,l} and llround{f,,l} */
875 ftype = build_function_type_list (integer_type_node,
876 float_type_node, NULL_TREE);
877 gfc_define_builtin(name: "__builtin_iroundf", type: ftype, code: BUILT_IN_IROUNDF,
878 library_name: "iroundf", ATTR_CONST_NOTHROW_LEAF_LIST);
879 ftype = build_function_type_list (long_integer_type_node,
880 float_type_node, NULL_TREE);
881 gfc_define_builtin (name: "__builtin_lroundf", type: ftype, code: BUILT_IN_LROUNDF,
882 library_name: "lroundf", ATTR_CONST_NOTHROW_LEAF_LIST);
883 ftype = build_function_type_list (long_long_integer_type_node,
884 float_type_node, NULL_TREE);
885 gfc_define_builtin (name: "__builtin_llroundf", type: ftype, code: BUILT_IN_LLROUNDF,
886 library_name: "llroundf", ATTR_CONST_NOTHROW_LEAF_LIST);
887
888 ftype = build_function_type_list (integer_type_node,
889 double_type_node, NULL_TREE);
890 gfc_define_builtin(name: "__builtin_iround", type: ftype, code: BUILT_IN_IROUND,
891 library_name: "iround", ATTR_CONST_NOTHROW_LEAF_LIST);
892 ftype = build_function_type_list (long_integer_type_node,
893 double_type_node, NULL_TREE);
894 gfc_define_builtin (name: "__builtin_lround", type: ftype, code: BUILT_IN_LROUND,
895 library_name: "lround", ATTR_CONST_NOTHROW_LEAF_LIST);
896 ftype = build_function_type_list (long_long_integer_type_node,
897 double_type_node, NULL_TREE);
898 gfc_define_builtin (name: "__builtin_llround", type: ftype, code: BUILT_IN_LLROUND,
899 library_name: "llround", ATTR_CONST_NOTHROW_LEAF_LIST);
900
901 ftype = build_function_type_list (integer_type_node,
902 long_double_type_node, NULL_TREE);
903 gfc_define_builtin(name: "__builtin_iroundl", type: ftype, code: BUILT_IN_IROUNDL,
904 library_name: "iroundl", ATTR_CONST_NOTHROW_LEAF_LIST);
905 ftype = build_function_type_list (long_integer_type_node,
906 long_double_type_node, NULL_TREE);
907 gfc_define_builtin (name: "__builtin_lroundl", type: ftype, code: BUILT_IN_LROUNDL,
908 library_name: "lroundl", ATTR_CONST_NOTHROW_LEAF_LIST);
909 ftype = build_function_type_list (long_long_integer_type_node,
910 long_double_type_node, NULL_TREE);
911 gfc_define_builtin (name: "__builtin_llroundl", type: ftype, code: BUILT_IN_LLROUNDL,
912 library_name: "llroundl", ATTR_CONST_NOTHROW_LEAF_LIST);
913
914 /* These are used to implement the ** operator. */
915 gfc_define_builtin (name: "__builtin_powl", type: mfunc_longdouble[1],
916 code: BUILT_IN_POWL, library_name: "powl", ATTR_CONST_NOTHROW_LEAF_LIST);
917 gfc_define_builtin (name: "__builtin_pow", type: mfunc_double[1],
918 code: BUILT_IN_POW, library_name: "pow", ATTR_CONST_NOTHROW_LEAF_LIST);
919 gfc_define_builtin (name: "__builtin_powf", type: mfunc_float[1],
920 code: BUILT_IN_POWF, library_name: "powf", ATTR_CONST_NOTHROW_LEAF_LIST);
921 gfc_define_builtin (name: "__builtin_cpowl", type: mfunc_clongdouble[1],
922 code: BUILT_IN_CPOWL, library_name: "cpowl", ATTR_CONST_NOTHROW_LEAF_LIST);
923 gfc_define_builtin (name: "__builtin_cpow", type: mfunc_cdouble[1],
924 code: BUILT_IN_CPOW, library_name: "cpow", ATTR_CONST_NOTHROW_LEAF_LIST);
925 gfc_define_builtin (name: "__builtin_cpowf", type: mfunc_cfloat[1],
926 code: BUILT_IN_CPOWF, library_name: "cpowf", ATTR_CONST_NOTHROW_LEAF_LIST);
927 gfc_define_builtin (name: "__builtin_powil", type: mfunc_longdouble[2],
928 code: BUILT_IN_POWIL, library_name: "powil", ATTR_CONST_NOTHROW_LEAF_LIST);
929 gfc_define_builtin (name: "__builtin_powi", type: mfunc_double[2],
930 code: BUILT_IN_POWI, library_name: "powi", ATTR_CONST_NOTHROW_LEAF_LIST);
931 gfc_define_builtin (name: "__builtin_powif", type: mfunc_float[2],
932 code: BUILT_IN_POWIF, library_name: "powif", ATTR_CONST_NOTHROW_LEAF_LIST);
933
934
935 if (targetm.libc_has_function (function_c99_math_complex, NULL_TREE))
936 {
937 gfc_define_builtin (name: "__builtin_cbrtl", type: mfunc_longdouble[0],
938 code: BUILT_IN_CBRTL, library_name: "cbrtl",
939 ATTR_CONST_NOTHROW_LEAF_LIST);
940 gfc_define_builtin (name: "__builtin_cbrt", type: mfunc_double[0],
941 code: BUILT_IN_CBRT, library_name: "cbrt",
942 ATTR_CONST_NOTHROW_LEAF_LIST);
943 gfc_define_builtin (name: "__builtin_cbrtf", type: mfunc_float[0],
944 code: BUILT_IN_CBRTF, library_name: "cbrtf",
945 ATTR_CONST_NOTHROW_LEAF_LIST);
946 gfc_define_builtin (name: "__builtin_cexpil", type: func_longdouble_clongdouble,
947 code: BUILT_IN_CEXPIL, library_name: "cexpil",
948 ATTR_CONST_NOTHROW_LEAF_LIST);
949 gfc_define_builtin (name: "__builtin_cexpi", type: func_double_cdouble,
950 code: BUILT_IN_CEXPI, library_name: "cexpi",
951 ATTR_CONST_NOTHROW_LEAF_LIST);
952 gfc_define_builtin (name: "__builtin_cexpif", type: func_float_cfloat,
953 code: BUILT_IN_CEXPIF, library_name: "cexpif",
954 ATTR_CONST_NOTHROW_LEAF_LIST);
955 }
956
957 if (targetm.libc_has_function (function_sincos, NULL_TREE))
958 {
959 gfc_define_builtin (name: "__builtin_sincosl",
960 type: func_longdouble_longdoublep_longdoublep,
961 code: BUILT_IN_SINCOSL, library_name: "sincosl", ATTR_NOTHROW_LEAF_LIST);
962 gfc_define_builtin (name: "__builtin_sincos", type: func_double_doublep_doublep,
963 code: BUILT_IN_SINCOS, library_name: "sincos", ATTR_NOTHROW_LEAF_LIST);
964 gfc_define_builtin (name: "__builtin_sincosf", type: func_float_floatp_floatp,
965 code: BUILT_IN_SINCOSF, library_name: "sincosf", ATTR_NOTHROW_LEAF_LIST);
966 }
967
968 /* For LEADZ, TRAILZ, POPCNT and POPPAR. */
969 ftype = build_function_type_list (integer_type_node,
970 unsigned_type_node, NULL_TREE);
971 gfc_define_builtin (name: "__builtin_clz", type: ftype, code: BUILT_IN_CLZ,
972 library_name: "__builtin_clz", ATTR_CONST_NOTHROW_LEAF_LIST);
973 gfc_define_builtin (name: "__builtin_ctz", type: ftype, code: BUILT_IN_CTZ,
974 library_name: "__builtin_ctz", ATTR_CONST_NOTHROW_LEAF_LIST);
975 gfc_define_builtin (name: "__builtin_parity", type: ftype, code: BUILT_IN_PARITY,
976 library_name: "__builtin_parity", ATTR_CONST_NOTHROW_LEAF_LIST);
977 gfc_define_builtin (name: "__builtin_popcount", type: ftype, code: BUILT_IN_POPCOUNT,
978 library_name: "__builtin_popcount", ATTR_CONST_NOTHROW_LEAF_LIST);
979
980 ftype = build_function_type_list (integer_type_node,
981 long_unsigned_type_node, NULL_TREE);
982 gfc_define_builtin (name: "__builtin_clzl", type: ftype, code: BUILT_IN_CLZL,
983 library_name: "__builtin_clzl", ATTR_CONST_NOTHROW_LEAF_LIST);
984 gfc_define_builtin (name: "__builtin_ctzl", type: ftype, code: BUILT_IN_CTZL,
985 library_name: "__builtin_ctzl", ATTR_CONST_NOTHROW_LEAF_LIST);
986 gfc_define_builtin (name: "__builtin_parityl", type: ftype, code: BUILT_IN_PARITYL,
987 library_name: "__builtin_parityl", ATTR_CONST_NOTHROW_LEAF_LIST);
988 gfc_define_builtin (name: "__builtin_popcountl", type: ftype, code: BUILT_IN_POPCOUNTL,
989 library_name: "__builtin_popcountl", ATTR_CONST_NOTHROW_LEAF_LIST);
990
991 ftype = build_function_type_list (integer_type_node,
992 long_long_unsigned_type_node, NULL_TREE);
993 gfc_define_builtin (name: "__builtin_clzll", type: ftype, code: BUILT_IN_CLZLL,
994 library_name: "__builtin_clzll", ATTR_CONST_NOTHROW_LEAF_LIST);
995 gfc_define_builtin (name: "__builtin_ctzll", type: ftype, code: BUILT_IN_CTZLL,
996 library_name: "__builtin_ctzll", ATTR_CONST_NOTHROW_LEAF_LIST);
997 gfc_define_builtin (name: "__builtin_parityll", type: ftype, code: BUILT_IN_PARITYLL,
998 library_name: "__builtin_parityll", ATTR_CONST_NOTHROW_LEAF_LIST);
999 gfc_define_builtin (name: "__builtin_popcountll", type: ftype, code: BUILT_IN_POPCOUNTLL,
1000 library_name: "__builtin_popcountll", ATTR_CONST_NOTHROW_LEAF_LIST);
1001
1002 /* Other builtin functions we use. */
1003
1004 ftype = build_function_type_list (long_integer_type_node,
1005 long_integer_type_node,
1006 long_integer_type_node, NULL_TREE);
1007 gfc_define_builtin (name: "__builtin_expect", type: ftype, code: BUILT_IN_EXPECT,
1008 library_name: "__builtin_expect", ATTR_CONST_NOTHROW_LEAF_LIST);
1009
1010 ftype = build_function_type_list (void_type_node,
1011 pvoid_type_node, NULL_TREE);
1012 gfc_define_builtin (name: "__builtin_free", type: ftype, code: BUILT_IN_FREE,
1013 library_name: "free", ATTR_NOTHROW_LEAF_LIST);
1014
1015 ftype = build_function_type_list (pvoid_type_node,
1016 size_type_node, NULL_TREE);
1017 gfc_define_builtin (name: "__builtin_malloc", type: ftype, code: BUILT_IN_MALLOC,
1018 library_name: "malloc", ATTR_NOTHROW_LEAF_MALLOC_LIST);
1019
1020 ftype = build_function_type_list (pvoid_type_node, size_type_node,
1021 size_type_node, NULL_TREE);
1022 gfc_define_builtin (name: "__builtin_calloc", type: ftype, code: BUILT_IN_CALLOC,
1023 library_name: "calloc", ATTR_NOTHROW_LEAF_MALLOC_LIST);
1024 DECL_IS_MALLOC (builtin_decl_explicit (BUILT_IN_CALLOC)) = 1;
1025
1026 ftype = build_function_type_list (pvoid_type_node, pvoid_type_node,
1027 size_type_node, NULL_TREE);
1028 gfc_define_builtin (name: "__builtin_realloc", type: ftype, code: BUILT_IN_REALLOC,
1029 library_name: "realloc", ATTR_NOTHROW_LEAF_LIST);
1030
1031 /* Type-generic floating-point classification built-ins. */
1032
1033 ftype = build_function_type (integer_type_node, NULL_TREE);
1034 gfc_define_builtin (name: "__builtin_isfinite", type: ftype, code: BUILT_IN_ISFINITE,
1035 library_name: "__builtin_isfinite", ATTR_CONST_NOTHROW_LEAF_LIST);
1036 gfc_define_builtin (name: "__builtin_isinf", type: ftype, code: BUILT_IN_ISINF,
1037 library_name: "__builtin_isinf", ATTR_CONST_NOTHROW_LEAF_LIST);
1038 gfc_define_builtin (name: "__builtin_isinf_sign", type: ftype, code: BUILT_IN_ISINF_SIGN,
1039 library_name: "__builtin_isinf_sign", ATTR_CONST_NOTHROW_LEAF_LIST);
1040 gfc_define_builtin (name: "__builtin_isnan", type: ftype, code: BUILT_IN_ISNAN,
1041 library_name: "__builtin_isnan", ATTR_CONST_NOTHROW_LEAF_LIST);
1042 gfc_define_builtin (name: "__builtin_isnormal", type: ftype, code: BUILT_IN_ISNORMAL,
1043 library_name: "__builtin_isnormal", ATTR_CONST_NOTHROW_LEAF_LIST);
1044 gfc_define_builtin (name: "__builtin_issignaling", type: ftype, code: BUILT_IN_ISSIGNALING,
1045 library_name: "__builtin_issignaling", ATTR_CONST_NOTHROW_LEAF_LIST);
1046 gfc_define_builtin (name: "__builtin_signbit", type: ftype, code: BUILT_IN_SIGNBIT,
1047 library_name: "__builtin_signbit", ATTR_CONST_NOTHROW_LEAF_LIST);
1048 gfc_define_builtin (name: "__builtin_fpclassify", type: ftype, code: BUILT_IN_FPCLASSIFY,
1049 library_name: "__builtin_fpclassify", ATTR_CONST_NOTHROW_LEAF_LIST);
1050
1051 gfc_define_builtin (name: "__builtin_isless", type: ftype, code: BUILT_IN_ISLESS,
1052 library_name: "__builtin_isless", ATTR_CONST_NOTHROW_LEAF_LIST);
1053 gfc_define_builtin (name: "__builtin_islessequal", type: ftype, code: BUILT_IN_ISLESSEQUAL,
1054 library_name: "__builtin_islessequal", ATTR_CONST_NOTHROW_LEAF_LIST);
1055 gfc_define_builtin (name: "__builtin_islessgreater", type: ftype, code: BUILT_IN_ISLESSGREATER,
1056 library_name: "__builtin_islessgreater", ATTR_CONST_NOTHROW_LEAF_LIST);
1057 gfc_define_builtin (name: "__builtin_isgreater", type: ftype, code: BUILT_IN_ISGREATER,
1058 library_name: "__builtin_isgreater", ATTR_CONST_NOTHROW_LEAF_LIST);
1059 gfc_define_builtin (name: "__builtin_isgreaterequal", type: ftype,
1060 code: BUILT_IN_ISGREATEREQUAL, library_name: "__builtin_isgreaterequal",
1061 ATTR_CONST_NOTHROW_LEAF_LIST);
1062 gfc_define_builtin (name: "__builtin_isunordered", type: ftype, code: BUILT_IN_ISUNORDERED,
1063 library_name: "__builtin_isunordered", ATTR_CONST_NOTHROW_LEAF_LIST);
1064 gfc_define_builtin (name: "__builtin_iseqsig", type: ftype, code: BUILT_IN_ISEQSIG,
1065 library_name: "__builtin_iseqsig", ATTR_CONST_NOTHROW_LEAF_LIST);
1066
1067
1068#define DEF_PRIMITIVE_TYPE(ENUM, VALUE) \
1069 builtin_types[(int) ENUM] = VALUE;
1070#define DEF_FUNCTION_TYPE_0(ENUM, RETURN) \
1071 builtin_types[(int) ENUM] \
1072 = build_function_type_list (builtin_types[(int) RETURN], \
1073 NULL_TREE);
1074#define DEF_FUNCTION_TYPE_1(ENUM, RETURN, ARG1) \
1075 builtin_types[(int) ENUM] \
1076 = build_function_type_list (builtin_types[(int) RETURN], \
1077 builtin_types[(int) ARG1], \
1078 NULL_TREE);
1079#define DEF_FUNCTION_TYPE_2(ENUM, RETURN, ARG1, ARG2) \
1080 builtin_types[(int) ENUM] \
1081 = build_function_type_list (builtin_types[(int) RETURN], \
1082 builtin_types[(int) ARG1], \
1083 builtin_types[(int) ARG2], \
1084 NULL_TREE);
1085#define DEF_FUNCTION_TYPE_3(ENUM, RETURN, ARG1, ARG2, ARG3) \
1086 builtin_types[(int) ENUM] \
1087 = build_function_type_list (builtin_types[(int) RETURN], \
1088 builtin_types[(int) ARG1], \
1089 builtin_types[(int) ARG2], \
1090 builtin_types[(int) ARG3], \
1091 NULL_TREE);
1092#define DEF_FUNCTION_TYPE_4(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4) \
1093 builtin_types[(int) ENUM] \
1094 = build_function_type_list (builtin_types[(int) RETURN], \
1095 builtin_types[(int) ARG1], \
1096 builtin_types[(int) ARG2], \
1097 builtin_types[(int) ARG3], \
1098 builtin_types[(int) ARG4], \
1099 NULL_TREE);
1100#define DEF_FUNCTION_TYPE_5(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5) \
1101 builtin_types[(int) ENUM] \
1102 = build_function_type_list (builtin_types[(int) RETURN], \
1103 builtin_types[(int) ARG1], \
1104 builtin_types[(int) ARG2], \
1105 builtin_types[(int) ARG3], \
1106 builtin_types[(int) ARG4], \
1107 builtin_types[(int) ARG5], \
1108 NULL_TREE);
1109#define DEF_FUNCTION_TYPE_6(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
1110 ARG6) \
1111 builtin_types[(int) ENUM] \
1112 = build_function_type_list (builtin_types[(int) RETURN], \
1113 builtin_types[(int) ARG1], \
1114 builtin_types[(int) ARG2], \
1115 builtin_types[(int) ARG3], \
1116 builtin_types[(int) ARG4], \
1117 builtin_types[(int) ARG5], \
1118 builtin_types[(int) ARG6], \
1119 NULL_TREE);
1120#define DEF_FUNCTION_TYPE_7(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
1121 ARG6, ARG7) \
1122 builtin_types[(int) ENUM] \
1123 = build_function_type_list (builtin_types[(int) RETURN], \
1124 builtin_types[(int) ARG1], \
1125 builtin_types[(int) ARG2], \
1126 builtin_types[(int) ARG3], \
1127 builtin_types[(int) ARG4], \
1128 builtin_types[(int) ARG5], \
1129 builtin_types[(int) ARG6], \
1130 builtin_types[(int) ARG7], \
1131 NULL_TREE);
1132#define DEF_FUNCTION_TYPE_8(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
1133 ARG6, ARG7, ARG8) \
1134 builtin_types[(int) ENUM] \
1135 = build_function_type_list (builtin_types[(int) RETURN], \
1136 builtin_types[(int) ARG1], \
1137 builtin_types[(int) ARG2], \
1138 builtin_types[(int) ARG3], \
1139 builtin_types[(int) ARG4], \
1140 builtin_types[(int) ARG5], \
1141 builtin_types[(int) ARG6], \
1142 builtin_types[(int) ARG7], \
1143 builtin_types[(int) ARG8], \
1144 NULL_TREE);
1145#define DEF_FUNCTION_TYPE_9(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
1146 ARG6, ARG7, ARG8, ARG9) \
1147 builtin_types[(int) ENUM] \
1148 = build_function_type_list (builtin_types[(int) RETURN], \
1149 builtin_types[(int) ARG1], \
1150 builtin_types[(int) ARG2], \
1151 builtin_types[(int) ARG3], \
1152 builtin_types[(int) ARG4], \
1153 builtin_types[(int) ARG5], \
1154 builtin_types[(int) ARG6], \
1155 builtin_types[(int) ARG7], \
1156 builtin_types[(int) ARG8], \
1157 builtin_types[(int) ARG9], \
1158 NULL_TREE);
1159#define DEF_FUNCTION_TYPE_10(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, \
1160 ARG5, ARG6, ARG7, ARG8, ARG9, ARG10) \
1161 builtin_types[(int) ENUM] \
1162 = build_function_type_list (builtin_types[(int) RETURN], \
1163 builtin_types[(int) ARG1], \
1164 builtin_types[(int) ARG2], \
1165 builtin_types[(int) ARG3], \
1166 builtin_types[(int) ARG4], \
1167 builtin_types[(int) ARG5], \
1168 builtin_types[(int) ARG6], \
1169 builtin_types[(int) ARG7], \
1170 builtin_types[(int) ARG8], \
1171 builtin_types[(int) ARG9], \
1172 builtin_types[(int) ARG10], \
1173 NULL_TREE);
1174#define DEF_FUNCTION_TYPE_11(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, \
1175 ARG5, ARG6, ARG7, ARG8, ARG9, ARG10, ARG11)\
1176 builtin_types[(int) ENUM] \
1177 = build_function_type_list (builtin_types[(int) RETURN], \
1178 builtin_types[(int) ARG1], \
1179 builtin_types[(int) ARG2], \
1180 builtin_types[(int) ARG3], \
1181 builtin_types[(int) ARG4], \
1182 builtin_types[(int) ARG5], \
1183 builtin_types[(int) ARG6], \
1184 builtin_types[(int) ARG7], \
1185 builtin_types[(int) ARG8], \
1186 builtin_types[(int) ARG9], \
1187 builtin_types[(int) ARG10], \
1188 builtin_types[(int) ARG11], \
1189 NULL_TREE);
1190#define DEF_FUNCTION_TYPE_VAR_0(ENUM, RETURN) \
1191 builtin_types[(int) ENUM] \
1192 = build_varargs_function_type_list (builtin_types[(int) RETURN], \
1193 NULL_TREE);
1194#define DEF_FUNCTION_TYPE_VAR_1(ENUM, RETURN, ARG1) \
1195 builtin_types[(int) ENUM] \
1196 = build_varargs_function_type_list (builtin_types[(int) RETURN], \
1197 builtin_types[(int) ARG1], \
1198 NULL_TREE);
1199#define DEF_FUNCTION_TYPE_VAR_2(ENUM, RETURN, ARG1, ARG2) \
1200 builtin_types[(int) ENUM] \
1201 = build_varargs_function_type_list (builtin_types[(int) RETURN], \
1202 builtin_types[(int) ARG1], \
1203 builtin_types[(int) ARG2], \
1204 NULL_TREE);
1205#define DEF_FUNCTION_TYPE_VAR_6(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
1206 ARG6) \
1207 builtin_types[(int) ENUM] \
1208 = build_varargs_function_type_list (builtin_types[(int) RETURN], \
1209 builtin_types[(int) ARG1], \
1210 builtin_types[(int) ARG2], \
1211 builtin_types[(int) ARG3], \
1212 builtin_types[(int) ARG4], \
1213 builtin_types[(int) ARG5], \
1214 builtin_types[(int) ARG6], \
1215 NULL_TREE);
1216#define DEF_FUNCTION_TYPE_VAR_7(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
1217 ARG6, ARG7) \
1218 builtin_types[(int) ENUM] \
1219 = build_varargs_function_type_list (builtin_types[(int) RETURN], \
1220 builtin_types[(int) ARG1], \
1221 builtin_types[(int) ARG2], \
1222 builtin_types[(int) ARG3], \
1223 builtin_types[(int) ARG4], \
1224 builtin_types[(int) ARG5], \
1225 builtin_types[(int) ARG6], \
1226 builtin_types[(int) ARG7], \
1227 NULL_TREE);
1228#define DEF_POINTER_TYPE(ENUM, TYPE) \
1229 builtin_types[(int) ENUM] \
1230 = build_pointer_type (builtin_types[(int) TYPE]);
1231#include "types.def"
1232#undef DEF_PRIMITIVE_TYPE
1233#undef DEF_FUNCTION_TYPE_0
1234#undef DEF_FUNCTION_TYPE_1
1235#undef DEF_FUNCTION_TYPE_2
1236#undef DEF_FUNCTION_TYPE_3
1237#undef DEF_FUNCTION_TYPE_4
1238#undef DEF_FUNCTION_TYPE_5
1239#undef DEF_FUNCTION_TYPE_6
1240#undef DEF_FUNCTION_TYPE_7
1241#undef DEF_FUNCTION_TYPE_8
1242#undef DEF_FUNCTION_TYPE_10
1243#undef DEF_FUNCTION_TYPE_VAR_0
1244#undef DEF_FUNCTION_TYPE_VAR_1
1245#undef DEF_FUNCTION_TYPE_VAR_2
1246#undef DEF_FUNCTION_TYPE_VAR_6
1247#undef DEF_FUNCTION_TYPE_VAR_7
1248#undef DEF_POINTER_TYPE
1249 builtin_types[(int) BT_LAST] = NULL_TREE;
1250
1251 /* Initialize synchronization builtins. */
1252#undef DEF_SYNC_BUILTIN
1253#define DEF_SYNC_BUILTIN(code, name, type, attr) \
1254 gfc_define_builtin (name, builtin_types[type], code, name, \
1255 attr);
1256#include "../sync-builtins.def"
1257#undef DEF_SYNC_BUILTIN
1258
1259 if (flag_openacc)
1260 {
1261#undef DEF_GOACC_BUILTIN
1262#define DEF_GOACC_BUILTIN(code, name, type, attr) \
1263 gfc_define_builtin ("__builtin_" name, builtin_types[type], \
1264 code, name, attr);
1265#undef DEF_GOACC_BUILTIN_COMPILER
1266#define DEF_GOACC_BUILTIN_COMPILER(code, name, type, attr) \
1267 gfc_define_builtin (name, builtin_types[type], code, name, attr);
1268#undef DEF_GOACC_BUILTIN_ONLY
1269#define DEF_GOACC_BUILTIN_ONLY(code, name, type, attr) \
1270 gfc_define_builtin ("__builtin_" name, builtin_types[type], code, NULL, \
1271 attr);
1272#undef DEF_GOMP_BUILTIN
1273#define DEF_GOMP_BUILTIN(code, name, type, attr) /* ignore */
1274#include "../omp-builtins.def"
1275#undef DEF_GOACC_BUILTIN
1276#undef DEF_GOACC_BUILTIN_COMPILER
1277#undef DEF_GOMP_BUILTIN
1278 }
1279
1280 if (flag_openmp || flag_openmp_simd || flag_tree_parallelize_loops)
1281 {
1282#undef DEF_GOACC_BUILTIN
1283#define DEF_GOACC_BUILTIN(code, name, type, attr) /* ignore */
1284#undef DEF_GOACC_BUILTIN_COMPILER
1285#define DEF_GOACC_BUILTIN_COMPILER(code, name, type, attr) /* ignore */
1286#undef DEF_GOMP_BUILTIN
1287#define DEF_GOMP_BUILTIN(code, name, type, attr) \
1288 gfc_define_builtin ("__builtin_" name, builtin_types[type], \
1289 code, name, attr);
1290#include "../omp-builtins.def"
1291#undef DEF_GOACC_BUILTIN
1292#undef DEF_GOACC_BUILTIN_COMPILER
1293#undef DEF_GOMP_BUILTIN
1294 tree gomp_alloc = builtin_decl_explicit (fncode: BUILT_IN_GOMP_ALLOC);
1295 tree two = build_int_cst (integer_type_node, 2);
1296 DECL_ATTRIBUTES (gomp_alloc)
1297 = tree_cons (get_identifier ("warn_unused_result"), NULL_TREE,
1298 tree_cons (get_identifier ("alloc_size"),
1299 build_tree_list (NULL_TREE, two),
1300 DECL_ATTRIBUTES (gomp_alloc)));
1301 }
1302
1303 gfc_define_builtin (name: "__builtin_trap", type: builtin_types[BT_FN_VOID],
1304 code: BUILT_IN_TRAP, NULL, ATTR_NOTHROW_LEAF_LIST);
1305 TREE_THIS_VOLATILE (builtin_decl_explicit (BUILT_IN_TRAP)) = 1;
1306
1307 ftype = build_varargs_function_type_list (ptr_type_node, const_ptr_type_node,
1308 size_type_node, NULL_TREE);
1309 gfc_define_builtin (name: "__builtin_assume_aligned", type: ftype,
1310 code: BUILT_IN_ASSUME_ALIGNED,
1311 library_name: "__builtin_assume_aligned",
1312 ATTR_CONST_NOTHROW_LEAF_LIST);
1313
1314 ftype = build_function_type_list (long_double_type_node, long_double_type_node,
1315 long_double_type_node, long_double_type_node,
1316 NULL_TREE);
1317 gfc_define_builtin (name: "__builtin_fmal", type: ftype, code: BUILT_IN_FMAL,
1318 library_name: "fmal", ATTR_CONST_NOTHROW_LEAF_LIST);
1319 ftype = build_function_type_list (double_type_node, double_type_node,
1320 double_type_node, double_type_node,
1321 NULL_TREE);
1322 gfc_define_builtin (name: "__builtin_fma", type: ftype, code: BUILT_IN_FMA,
1323 library_name: "fma", ATTR_CONST_NOTHROW_LEAF_LIST);
1324 ftype = build_function_type_list (float_type_node, float_type_node,
1325 float_type_node, float_type_node,
1326 NULL_TREE);
1327 gfc_define_builtin (name: "__builtin_fmaf", type: ftype, code: BUILT_IN_FMAF,
1328 library_name: "fmaf", ATTR_CONST_NOTHROW_LEAF_LIST);
1329
1330 gfc_define_builtin (name: "__emutls_get_address",
1331 type: builtin_types[BT_FN_PTR_PTR],
1332 code: BUILT_IN_EMUTLS_GET_ADDRESS,
1333 library_name: "__emutls_get_address", ATTR_CONST_NOTHROW_LEAF_LIST);
1334 gfc_define_builtin (name: "__emutls_register_common",
1335 type: builtin_types[BT_FN_VOID_PTR_WORD_WORD_PTR],
1336 code: BUILT_IN_EMUTLS_REGISTER_COMMON,
1337 library_name: "__emutls_register_common", ATTR_NOTHROW_LEAF_LIST);
1338
1339 build_common_builtin_nodes ();
1340 targetm.init_builtins ();
1341}
1342
1343#undef DEFINE_MATH_BUILTIN_C
1344#undef DEFINE_MATH_BUILTIN
1345
1346static void
1347gfc_init_ts (void)
1348{
1349 tree_contains_struct[NAMESPACE_DECL][TS_DECL_NON_COMMON] = 1;
1350 tree_contains_struct[NAMESPACE_DECL][TS_DECL_WITH_VIS] = 1;
1351 tree_contains_struct[NAMESPACE_DECL][TS_DECL_WRTL] = 1;
1352 tree_contains_struct[NAMESPACE_DECL][TS_DECL_COMMON] = 1;
1353 tree_contains_struct[NAMESPACE_DECL][TS_DECL_MINIMAL] = 1;
1354}
1355
1356void
1357gfc_maybe_initialize_eh (void)
1358{
1359 if (!flag_exceptions || gfc_eh_initialized_p)
1360 return;
1361
1362 gfc_eh_initialized_p = true;
1363 using_eh_for_cleanups ();
1364}
1365
1366
1367#include "gt-fortran-f95-lang.h"
1368#include "gtype-fortran.h"
1369

source code of gcc/fortran/f95-lang.cc