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

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