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