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