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