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