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