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