1 /* Header for code translation functions 2 Copyright (C) 2002-2013 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 #ifndef GFC_TRANS_H 22 #define GFC_TRANS_H 23 24 /* Mangled symbols take the form __module__name. */ 25 #define GFC_MAX_MANGLED_SYMBOL_LEN (GFC_MAX_SYMBOL_LEN*2+4) 26 27 /* Struct for holding a block of statements. It should be treated as an 28 opaque entity and not modified directly. This allows us to change the 29 underlying representation of statement lists. */ 30 typedef struct 31 { 32 tree head; 33 unsigned int has_scope:1; 34 } 35 stmtblock_t; 36 37 /* a simplified expression */ 38 typedef struct gfc_se 39 { 40 /* Code blocks to be executed before and after using the value. */ 41 stmtblock_t pre; 42 stmtblock_t post; 43 44 /* the result of the expression */ 45 tree expr; 46 47 /* The length of a character string value. */ 48 tree string_length; 49 50 /* If set gfc_conv_variable will return an expression for the array 51 descriptor. When set, want_pointer should also be set. 52 If not set scalarizing variables will be substituted. */ 53 unsigned descriptor_only:1; 54 55 /* When this is set gfc_conv_expr returns the address of a variable. Only 56 applies to EXPR_VARIABLE nodes. 57 Also used by gfc_conv_array_parameter. When set this indicates a pointer 58 to the descriptor should be returned, rather than the descriptor itself. 59 */ 60 unsigned want_pointer:1; 61 62 /* An array function call returning without a temporary. Also used for array 63 pointer assignments. */ 64 unsigned direct_byref:1; 65 66 /* If direct_byref is set, do work out the descriptor as in that case but 67 do still create a new descriptor variable instead of using an 68 existing one. This is useful for special pointer assignments like 69 rank remapping where we have to process the descriptor before 70 assigning to final one. */ 71 unsigned byref_noassign:1; 72 73 /* Ignore absent optional arguments. Used for some intrinsics. */ 74 unsigned ignore_optional:1; 75 76 /* When this is set the data and offset fields of the returned descriptor 77 are NULL. Used by intrinsic size. */ 78 unsigned data_not_needed:1; 79 80 /* If set, gfc_conv_procedure_call does not put byref calls into se->pre. */ 81 unsigned no_function_call:1; 82 83 /* If set, we will force the creation of a temporary. Useful to disable 84 non-copying procedure argument passing optimizations, when some function 85 args alias. */ 86 unsigned force_tmp:1; 87 88 unsigned want_coarray:1; 89 90 /* Scalarization parameters. */ 91 struct gfc_se *parent; 92 struct gfc_ss *ss; 93 struct gfc_loopinfo *loop; 94 } 95 gfc_se; 96 97 98 /* Denotes different types of coarray. 99 Please keep in sync with libgfortran/caf/libcaf.h. */ 100 typedef enum 101 { 102 GFC_CAF_COARRAY_STATIC, 103 GFC_CAF_COARRAY_ALLOC, 104 GFC_CAF_LOCK, 105 GFC_CAF_LOCK_COMP 106 } 107 gfc_coarray_type; 108 109 110 /* The array-specific scalarization information. The array members of 111 this struct are indexed by actual array index, and thus can be sparse. */ 112 113 typedef struct gfc_array_info 114 { 115 mpz_t *shape; 116 117 /* The ref that holds information on this section. */ 118 gfc_ref *ref; 119 /* The descriptor of this array. */ 120 tree descriptor; 121 /* holds the pointer to the data array. */ 122 tree data; 123 /* To move some of the array index calculation out of the innermost loop. */ 124 tree offset; 125 tree saved_offset; 126 tree stride0; 127 /* Holds the SS for a subscript. Indexed by actual dimension. */ 128 struct gfc_ss *subscript[GFC_MAX_DIMENSIONS]; 129 130 /* stride and delta are used to access this inside a scalarization loop. 131 start is used in the calculation of these. Indexed by scalarizer 132 dimension. */ 133 tree start[GFC_MAX_DIMENSIONS]; 134 tree end[GFC_MAX_DIMENSIONS]; 135 tree stride[GFC_MAX_DIMENSIONS]; 136 tree delta[GFC_MAX_DIMENSIONS]; 137 } 138 gfc_array_info; 139 140 typedef enum 141 { 142 /* A scalar value. This will be evaluated before entering the 143 scalarization loop. */ 144 GFC_SS_SCALAR, 145 146 /* Like GFC_SS_SCALAR it evaluates the expression outside the 147 loop. Is always evaluated as a reference to the temporary, unless 148 temporary evaluation can result in a NULL pointer dereferencing (case of 149 optional arguments). Used for elemental function arguments. */ 150 GFC_SS_REFERENCE, 151 152 /* An array section. Scalarization indices will be substituted during 153 expression translation. */ 154 GFC_SS_SECTION, 155 156 /* A non-elemental function call returning an array. The call is executed 157 before entering the scalarization loop, storing the result in a 158 temporary. This temporary is then used inside the scalarization loop. 159 Simple assignments, e.g. a(:) = fn(), are handled without a temporary 160 as a special case. */ 161 GFC_SS_FUNCTION, 162 163 /* An array constructor. The current implementation is sub-optimal in 164 many cases. It allocated a temporary, assigns the values to it, then 165 uses this temporary inside the scalarization loop. */ 166 GFC_SS_CONSTRUCTOR, 167 168 /* A vector subscript. The vector's descriptor is cached in the 169 "descriptor" field of the associated gfc_ss_info. */ 170 GFC_SS_VECTOR, 171 172 /* A temporary array allocated by the scalarizer. Its rank can be less 173 than that of the assignment expression. */ 174 GFC_SS_TEMP, 175 176 /* An intrinsic function call. Many intrinsic functions which map directly 177 to library calls are created as GFC_SS_FUNCTION nodes. */ 178 GFC_SS_INTRINSIC, 179 180 /* A component of a derived type. */ 181 GFC_SS_COMPONENT 182 } 183 gfc_ss_type; 184 185 186 typedef struct gfc_ss_info 187 { 188 int refcount; 189 gfc_ss_type type; 190 gfc_expr *expr; 191 tree string_length; 192 193 union 194 { 195 /* If type is GFC_SS_SCALAR or GFC_SS_REFERENCE. */ 196 struct 197 { 198 tree value; 199 } 200 scalar; 201 202 /* GFC_SS_TEMP. */ 203 struct 204 { 205 tree type; 206 } 207 temp; 208 209 /* All other types. */ 210 gfc_array_info array; 211 } 212 data; 213 214 /* This is used by assignments requiring temporaries. The bits specify which 215 loops the terms appear in. This will be 1 for the RHS expressions, 216 2 for the LHS expressions, and 3(=1|2) for the temporary. */ 217 unsigned useflags:2; 218 219 /* Suppresses precalculation of scalars in WHERE assignments. */ 220 unsigned where:1; 221 222 /* Tells whether the SS is for an actual argument which can be a NULL 223 reference. In other words, the associated dummy argument is OPTIONAL. 224 Used to handle elemental procedures. */ 225 bool can_be_null_ref; 226 } 227 gfc_ss_info; 228 229 #define gfc_get_ss_info() XCNEW (gfc_ss_info) 230 231 232 /* Scalarization State chain. Created by walking an expression tree before 233 creating the scalarization loops. Then passed as part of a gfc_se structure 234 to translate the expression inside the loop. Note that these chains are 235 terminated by gfc_ss_terminator, not NULL. A NULL pointer in a gfc_se 236 indicates to gfc_conv_* that this is a scalar expression. 237 SS structures can only belong to a single loopinfo. They must be added 238 otherwise they will not get freed. */ 239 240 typedef struct gfc_ss 241 { 242 gfc_ss_info *info; 243 244 int dimen; 245 /* Translation from loop dimensions to actual array dimensions. 246 actual_dim = dim[loop_dim] */ 247 int dim[GFC_MAX_DIMENSIONS]; 248 249 /* All the SS in a loop and linked through loop_chain. The SS for an 250 expression are linked by the next pointer. */ 251 struct gfc_ss *loop_chain; 252 struct gfc_ss *next; 253 254 /* Non-null if the ss is part of a nested loop. */ 255 struct gfc_ss *parent; 256 257 /* If the evaluation of an expression requires a nested loop (for example 258 if the sum intrinsic is evaluated inline), this points to the nested 259 loop's gfc_ss. */ 260 struct gfc_ss *nested_ss; 261 262 /* The loop this gfc_ss is in. */ 263 struct gfc_loopinfo *loop; 264 265 unsigned is_alloc_lhs:1; 266 } 267 gfc_ss; 268 #define gfc_get_ss() XCNEW (gfc_ss) 269 270 /* The contents of this aren't actually used. A NULL SS chain indicates a 271 scalar expression, so this pointer is used to terminate SS chains. */ 272 extern gfc_ss * const gfc_ss_terminator; 273 274 /* Holds information about an expression while it is being scalarized. */ 275 typedef struct gfc_loopinfo 276 { 277 stmtblock_t pre; 278 stmtblock_t post; 279 280 int dimen; 281 282 /* All the SS involved with this loop. */ 283 gfc_ss *ss; 284 /* The SS describing the temporary used in an assignment. */ 285 gfc_ss *temp_ss; 286 287 /* Non-null if this loop is nested in another one. */ 288 struct gfc_loopinfo *parent; 289 290 /* Chain of nested loops. */ 291 struct gfc_loopinfo *nested, *next; 292 293 /* The scalarization loop index variables. */ 294 tree loopvar[GFC_MAX_DIMENSIONS]; 295 296 /* The bounds of the scalarization loops. */ 297 tree from[GFC_MAX_DIMENSIONS]; 298 tree to[GFC_MAX_DIMENSIONS]; 299 gfc_ss *specloop[GFC_MAX_DIMENSIONS]; 300 301 /* The code member contains the code for the body of the next outer loop. */ 302 stmtblock_t code[GFC_MAX_DIMENSIONS]; 303 304 /* Order in which the dimensions should be looped, innermost first. */ 305 int order[GFC_MAX_DIMENSIONS]; 306 307 /* Enum to control loop reversal. */ 308 gfc_reverse reverse[GFC_MAX_DIMENSIONS]; 309 310 /* The number of dimensions for which a temporary is used. */ 311 int temp_dim; 312 313 /* If set we don't need the loop variables. */ 314 unsigned array_parameter:1; 315 } 316 gfc_loopinfo; 317 318 #define gfc_get_loopinfo() XCNEW (gfc_loopinfo) 319 320 /* Information about a symbol that has been shadowed by a temporary. */ 321 typedef struct 322 { 323 symbol_attribute attr; 324 tree decl; 325 } 326 gfc_saved_var; 327 328 329 /* Store information about a block of code together with special 330 initialization and clean-up code. This can be used to incrementally add 331 init and cleanup, and in the end put everything together to a 332 try-finally expression. */ 333 typedef struct 334 { 335 tree init; 336 tree cleanup; 337 tree code; 338 } 339 gfc_wrapped_block; 340 341 /* Class API functions. */ 342 tree gfc_class_data_get (tree); 343 tree gfc_class_vptr_get (tree); 344 tree gfc_vtable_hash_get (tree); 345 tree gfc_vtable_size_get (tree); 346 tree gfc_vtable_extends_get (tree); 347 tree gfc_vtable_def_init_get (tree); 348 tree gfc_vtable_copy_get (tree); 349 tree gfc_vtable_final_get (tree); 350 tree gfc_get_vptr_from_expr (tree); 351 tree gfc_get_class_array_ref (tree, tree); 352 tree gfc_copy_class_to_class (tree, tree, tree); 353 tree gfc_build_final_call (gfc_typespec, gfc_expr *, gfc_expr *, bool, 354 gfc_expr *); 355 void gfc_conv_derived_to_class (gfc_se *, gfc_expr *, gfc_typespec, tree, bool, 356 bool); 357 void gfc_conv_class_to_class (gfc_se *, gfc_expr *, gfc_typespec, bool, bool, 358 bool, bool); 359 360 /* Initialize an init/cleanup block. */ 361 void gfc_start_wrapped_block (gfc_wrapped_block* block, tree code); 362 /* Add a pair of init/cleanup code to the block. Each one might be a 363 NULL_TREE if not required. */ 364 void gfc_add_init_cleanup (gfc_wrapped_block* block, tree init, tree cleanup); 365 /* Finalize the block, that is, create a single expression encapsulating the 366 original code together with init and clean-up code. */ 367 tree gfc_finish_wrapped_block (gfc_wrapped_block* block); 368 369 370 /* Advance the SS chain to the next term. */ 371 void gfc_advance_se_ss_chain (gfc_se *); 372 373 /* Call this to initialize a gfc_se structure before use 374 first parameter is structure to initialize, second is 375 parent to get scalarization data from, or NULL. */ 376 void gfc_init_se (gfc_se *, gfc_se *); 377 378 /* Create an artificial variable decl and add it to the current scope. */ 379 tree gfc_create_var (tree, const char *); 380 /* Like above but doesn't add it to the current scope. */ 381 tree gfc_create_var_np (tree, const char *); 382 383 /* Store the result of an expression in a temp variable so it can be used 384 repeatedly even if the original changes */ 385 void gfc_make_safe_expr (gfc_se * se); 386 387 /* Makes sure se is suitable for passing as a function string parameter. */ 388 void gfc_conv_string_parameter (gfc_se * se); 389 390 /* Compare two strings. */ 391 tree gfc_build_compare_string (tree, tree, tree, tree, int, enum tree_code); 392 393 /* When using the gfc_conv_* make sure you understand what they do, i.e. 394 when a POST chain may be created, and what the returned expression may be 395 used for. Note that character strings have special handling. This 396 should not be a problem as most statements/operations only deal with 397 numeric/logical types. See the implementations in trans-expr.c 398 for details of the individual functions. */ 399 400 void gfc_conv_expr (gfc_se * se, gfc_expr * expr); 401 void gfc_conv_expr_val (gfc_se * se, gfc_expr * expr); 402 void gfc_conv_expr_lhs (gfc_se * se, gfc_expr * expr); 403 void gfc_conv_expr_reference (gfc_se * se, gfc_expr *); 404 void gfc_conv_expr_type (gfc_se * se, gfc_expr *, tree); 405 406 tree gfc_conv_scalar_to_descriptor (gfc_se *, tree, symbol_attribute); 407 408 409 /* trans-expr.c */ 410 void gfc_conv_scalar_char_value (gfc_symbol *sym, gfc_se *se, gfc_expr **expr); 411 tree gfc_string_to_single_character (tree len, tree str, int kind); 412 413 /* Find the decl containing the auxiliary variables for assigned variables. */ 414 void gfc_conv_label_variable (gfc_se * se, gfc_expr * expr); 415 /* If the value is not constant, Create a temporary and copy the value. */ 416 tree gfc_evaluate_now_loc (location_t, tree, stmtblock_t *); 417 tree gfc_evaluate_now (tree, stmtblock_t *); 418 419 /* Find the appropriate variant of a math intrinsic. */ 420 tree gfc_builtin_decl_for_float_kind (enum built_in_function, int); 421 422 /* Intrinsic procedure handling. */ 423 tree gfc_conv_intrinsic_subroutine (gfc_code *); 424 void gfc_conv_intrinsic_function (gfc_se *, gfc_expr *); 425 426 /* Does an intrinsic map directly to an external library call 427 This is true for array-returning intrinsics, unless 428 gfc_inline_intrinsic_function_p returns true. */ 429 int gfc_is_intrinsic_libcall (gfc_expr *); 430 431 /* Used to call ordinary functions/subroutines 432 and procedure pointer components. */ 433 int gfc_conv_procedure_call (gfc_se *, gfc_symbol *, gfc_actual_arglist *, 434 gfc_expr *, vec<tree, va_gc> *); 435 436 void gfc_conv_subref_array_arg (gfc_se *, gfc_expr *, int, sym_intent, bool); 437 438 /* Generate code for a scalar assignment. */ 439 tree gfc_trans_scalar_assign (gfc_se *, gfc_se *, gfc_typespec, bool, bool, 440 bool); 441 442 /* Translate COMMON blocks. */ 443 void gfc_trans_common (gfc_namespace *); 444 445 /* Translate a derived type constructor. */ 446 void gfc_conv_structure (gfc_se *, gfc_expr *, int); 447 448 /* Return an expression which determines if a dummy parameter is present. */ 449 tree gfc_conv_expr_present (gfc_symbol *); 450 /* Convert a missing, dummy argument into a null or zero. */ 451 void gfc_conv_missing_dummy (gfc_se *, gfc_expr *, gfc_typespec, int); 452 453 /* Generate code to allocate a string temporary. */ 454 tree gfc_conv_string_tmp (gfc_se *, tree, tree); 455 /* Get the string length variable belonging to an expression. */ 456 tree gfc_get_expr_charlen (gfc_expr *); 457 /* Initialize a string length variable. */ 458 void gfc_conv_string_length (gfc_charlen *, gfc_expr *, stmtblock_t *); 459 /* Ensure type sizes can be gimplified. */ 460 void gfc_trans_vla_type_sizes (gfc_symbol *, stmtblock_t *); 461 462 /* Add an expression to the end of a block. */ 463 void gfc_add_expr_to_block (stmtblock_t *, tree); 464 /* Add an expression to the beginning of a block. */ 465 void gfc_prepend_expr_to_block (stmtblock_t *, tree); 466 /* Add a block to the end of a block. */ 467 void gfc_add_block_to_block (stmtblock_t *, stmtblock_t *); 468 /* Add a MODIFY_EXPR to a block. */ 469 void gfc_add_modify_loc (location_t, stmtblock_t *, tree, tree); 470 void gfc_add_modify (stmtblock_t *, tree, tree); 471 472 /* Initialize a statement block. */ 473 void gfc_init_block (stmtblock_t *); 474 /* Start a new statement block. Like gfc_init_block but also starts a new 475 variable scope. */ 476 void gfc_start_block (stmtblock_t *); 477 /* Finish a statement block. Also closes the scope if the block was created 478 with gfc_start_block. */ 479 tree gfc_finish_block (stmtblock_t *); 480 /* Merge the scope of a block with its parent. */ 481 void gfc_merge_block_scope (stmtblock_t * block); 482 483 /* Return the backend label decl. */ 484 tree gfc_get_label_decl (gfc_st_label *); 485 486 /* Return the decl for an external function. */ 487 tree gfc_get_extern_function_decl (gfc_symbol *); 488 489 /* Return the decl for a function. */ 490 tree gfc_get_function_decl (gfc_symbol *); 491 492 /* Build an ADDR_EXPR. */ 493 tree gfc_build_addr_expr (tree, tree); 494 495 /* Build an ARRAY_REF. */ 496 tree gfc_build_array_ref (tree, tree, tree); 497 498 /* Creates a label. Decl is artificial if label_id == NULL_TREE. */ 499 tree gfc_build_label_decl (tree); 500 501 /* Return the decl used to hold the function return value. 502 Do not use if the function has an explicit result variable. */ 503 tree gfc_get_fake_result_decl (gfc_symbol *, int); 504 505 /* Add a decl to the binding level for the current function. */ 506 void gfc_add_decl_to_function (tree); 507 508 /* Make prototypes for runtime library functions. */ 509 void gfc_build_builtin_function_decls (void); 510 511 /* Set the backend source location of a decl. */ 512 void gfc_set_decl_location (tree, locus *); 513 514 /* Get a module symbol backend_decl if possible. */ 515 bool gfc_get_module_backend_decl (gfc_symbol *); 516 517 /* Return the variable decl for a symbol. */ 518 tree gfc_get_symbol_decl (gfc_symbol *); 519 520 /* Build a static initializer. */ 521 tree gfc_conv_initializer (gfc_expr *, gfc_typespec *, tree, bool, bool, bool); 522 523 /* Assign a default initializer to a derived type. */ 524 void gfc_init_default_dt (gfc_symbol *, stmtblock_t *, bool); 525 526 /* Substitute a temporary variable in place of the real one. */ 527 void gfc_shadow_sym (gfc_symbol *, tree, gfc_saved_var *); 528 529 /* Restore the original variable. */ 530 void gfc_restore_sym (gfc_symbol *, gfc_saved_var *); 531 532 /* Setting a decl assembler name, mangling it according to target rules 533 (like Windows @NN decorations). */ 534 void gfc_set_decl_assembler_name (tree, tree); 535 536 /* Returns true if a variable of specified size should go on the stack. */ 537 int gfc_can_put_var_on_stack (tree); 538 539 /* Allocate the lang-specific part of a decl node. */ 540 void gfc_allocate_lang_decl (tree); 541 542 /* Advance along a TREE_CHAIN. */ 543 tree gfc_advance_chain (tree, int); 544 545 /* Create a decl for a function. */ 546 void gfc_create_function_decl (gfc_namespace *, bool); 547 /* Generate the code for a function. */ 548 void gfc_generate_function_code (gfc_namespace *); 549 /* Output a BLOCK DATA program unit. */ 550 void gfc_generate_block_data (gfc_namespace *); 551 /* Output a decl for a module variable. */ 552 void gfc_generate_module_vars (gfc_namespace *); 553 /* Get the appropriate return statement for a procedure. */ 554 tree gfc_generate_return (void); 555 556 struct GTY(()) module_htab_entry { 557 const char *name; 558 tree namespace_decl; 559 htab_t GTY ((param_is (union tree_node))) decls; 560 }; 561 562 struct module_htab_entry *gfc_find_module (const char *); 563 void gfc_module_add_decl (struct module_htab_entry *, tree); 564 565 /* Get and set the current location. */ 566 void gfc_save_backend_locus (locus *); 567 void gfc_set_backend_locus (locus *); 568 void gfc_restore_backend_locus (locus *); 569 570 /* Handle static constructor functions. */ 571 extern GTY(()) tree gfc_static_ctors; 572 void gfc_generate_constructors (void); 573 574 /* Get the string length of an array constructor. */ 575 bool get_array_ctor_strlen (stmtblock_t *, gfc_constructor_base, tree *); 576 577 /* Mark a condition as likely or unlikely. */ 578 tree gfc_likely (tree); 579 tree gfc_unlikely (tree); 580 581 /* Generate a runtime error call. */ 582 tree gfc_trans_runtime_error (bool, locus*, const char*, ...); 583 584 /* Generate a runtime warning/error check. */ 585 void gfc_trans_runtime_check (bool, bool, tree, stmtblock_t *, locus *, 586 const char *, ...); 587 588 /* Generate a runtime check for same string length. */ 589 void gfc_trans_same_strlen_check (const char*, locus*, tree, tree, 590 stmtblock_t*); 591 592 /* Generate a call to free() after checking that its arg is non-NULL. */ 593 tree gfc_call_free (tree); 594 595 /* Allocate memory after performing a few checks. */ 596 tree gfc_call_malloc (stmtblock_t *, tree, tree); 597 598 /* Build a memcpy call. */ 599 tree gfc_build_memcpy_call (tree, tree, tree); 600 601 /* Allocate memory for allocatable variables, with optional status variable. */ 602 void gfc_allocate_allocatable (stmtblock_t*, tree, tree, tree, tree, 603 tree, tree, tree, gfc_expr*); 604 605 /* Allocate memory, with optional status variable. */ 606 void gfc_allocate_using_malloc (stmtblock_t *, tree, tree, tree); 607 608 /* Generate code to deallocate an array. */ 609 tree gfc_deallocate_with_status (tree, tree, tree, tree, tree, bool, 610 gfc_expr *, bool); 611 tree gfc_deallocate_scalar_with_status (tree, tree, bool, gfc_expr*, gfc_typespec); 612 613 /* Generate code to call realloc(). */ 614 tree gfc_call_realloc (stmtblock_t *, tree, tree); 615 616 /* Generate code for an assignment, includes scalarization. */ 617 tree gfc_trans_assignment (gfc_expr *, gfc_expr *, bool, bool); 618 619 /* Generate code for a pointer assignment. */ 620 tree gfc_trans_pointer_assignment (gfc_expr *, gfc_expr *); 621 622 /* Initialize function decls for library functions. */ 623 void gfc_build_intrinsic_lib_fndecls (void); 624 /* Create function decls for IO library functions. */ 625 void gfc_trans_io_runtime_check (tree, tree, int, const char *, stmtblock_t *); 626 void gfc_build_io_library_fndecls (void); 627 /* Build a function decl for a library function. */ 628 tree gfc_build_library_function_decl (tree, tree, int, ...); 629 tree gfc_build_library_function_decl_with_spec (tree name, const char *spec, 630 tree rettype, int nargs, ...); 631 632 /* Process the local variable decls of a block construct. */ 633 void gfc_process_block_locals (gfc_namespace*); 634 635 /* Output initialization/clean-up code that was deferred. */ 636 void gfc_trans_deferred_vars (gfc_symbol*, gfc_wrapped_block *); 637 638 /* In f95-lang.c. */ 639 tree pushdecl (tree); 640 tree pushdecl_top_level (tree); 641 void pushlevel (void); 642 tree poplevel (int, int); 643 tree getdecls (void); 644 645 /* In trans-types.c. */ 646 struct array_descr_info; 647 bool gfc_get_array_descr_info (const_tree, struct array_descr_info *); 648 649 /* In trans-openmp.c */ 650 bool gfc_omp_privatize_by_reference (const_tree); 651 enum omp_clause_default_kind gfc_omp_predetermined_sharing (tree); 652 tree gfc_omp_report_decl (tree); 653 tree gfc_omp_clause_default_ctor (tree, tree, tree); 654 tree gfc_omp_clause_copy_ctor (tree, tree, tree); 655 tree gfc_omp_clause_assign_op (tree, tree, tree); 656 tree gfc_omp_clause_dtor (tree, tree); 657 bool gfc_omp_disregard_value_expr (tree, bool); 658 bool gfc_omp_private_debug_clause (tree, bool); 659 bool gfc_omp_private_outer_ref (tree); 660 struct gimplify_omp_ctx; 661 void gfc_omp_firstprivatize_type_sizes (struct gimplify_omp_ctx *, tree); 662 663 /* Runtime library function decls. */ 664 extern GTY(()) tree gfor_fndecl_pause_numeric; 665 extern GTY(()) tree gfor_fndecl_pause_string; 666 extern GTY(()) tree gfor_fndecl_stop_numeric; 667 extern GTY(()) tree gfor_fndecl_stop_numeric_f08; 668 extern GTY(()) tree gfor_fndecl_stop_string; 669 extern GTY(()) tree gfor_fndecl_error_stop_numeric; 670 extern GTY(()) tree gfor_fndecl_error_stop_string; 671 extern GTY(()) tree gfor_fndecl_runtime_error; 672 extern GTY(()) tree gfor_fndecl_runtime_error_at; 673 extern GTY(()) tree gfor_fndecl_runtime_warning_at; 674 extern GTY(()) tree gfor_fndecl_os_error; 675 extern GTY(()) tree gfor_fndecl_generate_error; 676 extern GTY(()) tree gfor_fndecl_set_fpe; 677 extern GTY(()) tree gfor_fndecl_set_options; 678 extern GTY(()) tree gfor_fndecl_ttynam; 679 extern GTY(()) tree gfor_fndecl_ctime; 680 extern GTY(()) tree gfor_fndecl_fdate; 681 extern GTY(()) tree gfor_fndecl_in_pack; 682 extern GTY(()) tree gfor_fndecl_in_unpack; 683 extern GTY(()) tree gfor_fndecl_associated; 684 685 686 /* Coarray run-time library function decls. */ 687 extern GTY(()) tree gfor_fndecl_caf_init; 688 extern GTY(()) tree gfor_fndecl_caf_finalize; 689 extern GTY(()) tree gfor_fndecl_caf_register; 690 extern GTY(()) tree gfor_fndecl_caf_deregister; 691 extern GTY(()) tree gfor_fndecl_caf_critical; 692 extern GTY(()) tree gfor_fndecl_caf_end_critical; 693 extern GTY(()) tree gfor_fndecl_caf_sync_all; 694 extern GTY(()) tree gfor_fndecl_caf_sync_images; 695 extern GTY(()) tree gfor_fndecl_caf_error_stop; 696 extern GTY(()) tree gfor_fndecl_caf_error_stop_str; 697 698 /* Coarray global variables for num_images/this_image. */ 699 extern GTY(()) tree gfort_gvar_caf_num_images; 700 extern GTY(()) tree gfort_gvar_caf_this_image; 701 702 703 /* Math functions. Many other math functions are handled in 704 trans-intrinsic.c. */ 705 706 typedef struct GTY(()) gfc_powdecl_list { 707 tree integer; 708 tree real; 709 tree cmplx; 710 } 711 gfc_powdecl_list; 712 713 extern GTY(()) gfc_powdecl_list gfor_fndecl_math_powi[4][3]; 714 extern GTY(()) tree gfor_fndecl_math_ishftc4; 715 extern GTY(()) tree gfor_fndecl_math_ishftc8; 716 extern GTY(()) tree gfor_fndecl_math_ishftc16; 717 718 /* BLAS functions. */ 719 extern GTY(()) tree gfor_fndecl_sgemm; 720 extern GTY(()) tree gfor_fndecl_dgemm; 721 extern GTY(()) tree gfor_fndecl_cgemm; 722 extern GTY(()) tree gfor_fndecl_zgemm; 723 724 /* String functions. */ 725 extern GTY(()) tree gfor_fndecl_compare_string; 726 extern GTY(()) tree gfor_fndecl_concat_string; 727 extern GTY(()) tree gfor_fndecl_string_len_trim; 728 extern GTY(()) tree gfor_fndecl_string_index; 729 extern GTY(()) tree gfor_fndecl_string_scan; 730 extern GTY(()) tree gfor_fndecl_string_verify; 731 extern GTY(()) tree gfor_fndecl_string_trim; 732 extern GTY(()) tree gfor_fndecl_string_minmax; 733 extern GTY(()) tree gfor_fndecl_adjustl; 734 extern GTY(()) tree gfor_fndecl_adjustr; 735 extern GTY(()) tree gfor_fndecl_select_string; 736 extern GTY(()) tree gfor_fndecl_compare_string_char4; 737 extern GTY(()) tree gfor_fndecl_concat_string_char4; 738 extern GTY(()) tree gfor_fndecl_string_len_trim_char4; 739 extern GTY(()) tree gfor_fndecl_string_index_char4; 740 extern GTY(()) tree gfor_fndecl_string_scan_char4; 741 extern GTY(()) tree gfor_fndecl_string_verify_char4; 742 extern GTY(()) tree gfor_fndecl_string_trim_char4; 743 extern GTY(()) tree gfor_fndecl_string_minmax_char4; 744 extern GTY(()) tree gfor_fndecl_adjustl_char4; 745 extern GTY(()) tree gfor_fndecl_adjustr_char4; 746 extern GTY(()) tree gfor_fndecl_select_string_char4; 747 748 /* Conversion between character kinds. */ 749 extern GTY(()) tree gfor_fndecl_convert_char1_to_char4; 750 extern GTY(()) tree gfor_fndecl_convert_char4_to_char1; 751 752 /* Other misc. runtime library functions. */ 753 extern GTY(()) tree gfor_fndecl_size0; 754 extern GTY(()) tree gfor_fndecl_size1; 755 extern GTY(()) tree gfor_fndecl_iargc; 756 757 /* Implemented in Fortran. */ 758 extern GTY(()) tree gfor_fndecl_sc_kind; 759 extern GTY(()) tree gfor_fndecl_si_kind; 760 extern GTY(()) tree gfor_fndecl_sr_kind; 761 762 763 /* True if node is an integer constant. */ 764 #define INTEGER_CST_P(node) (TREE_CODE(node) == INTEGER_CST) 765 766 /* gfortran-specific declaration information, the _CONT versions denote 767 arrays with CONTIGUOUS attribute. */ 768 769 enum gfc_array_kind 770 { 771 GFC_ARRAY_UNKNOWN, 772 GFC_ARRAY_ASSUMED_SHAPE, 773 GFC_ARRAY_ASSUMED_SHAPE_CONT, 774 GFC_ARRAY_ASSUMED_RANK, 775 GFC_ARRAY_ASSUMED_RANK_CONT, 776 GFC_ARRAY_ALLOCATABLE, 777 GFC_ARRAY_POINTER, 778 GFC_ARRAY_POINTER_CONT 779 }; 780 781 /* Array types only. */ 782 /* FIXME: the variable_size annotation here is needed because these types are 783 variable-sized in some other frontends. Due to gengtype deficiency the GTY 784 options of such types have to agree across all frontends. */ 785 struct GTY((variable_size)) lang_type { 786 int rank, corank; 787 enum gfc_array_kind akind; 788 tree lbound[GFC_MAX_DIMENSIONS]; 789 tree ubound[GFC_MAX_DIMENSIONS]; 790 tree stride[GFC_MAX_DIMENSIONS]; 791 tree size; 792 tree offset; 793 tree dtype; 794 tree dataptr_type; 795 tree span; 796 tree base_decl[2]; 797 tree nonrestricted_type; 798 tree caf_token; 799 tree caf_offset; 800 }; 801 802 struct GTY((variable_size)) lang_decl { 803 /* Dummy variables. */ 804 tree saved_descriptor; 805 /* Assigned integer nodes. Stringlength is the IO format string's length. 806 Addr is the address of the string or the target label. Stringlength is 807 initialized to -2 and assigned to -1 when addr is assigned to the 808 address of target label. */ 809 tree stringlen; 810 tree addr; 811 tree span; 812 /* For assumed-shape coarrays. */ 813 tree token, caf_offset; 814 }; 815 816 817 #define GFC_DECL_ASSIGN_ADDR(node) DECL_LANG_SPECIFIC(node)->addr 818 #define GFC_DECL_STRING_LEN(node) DECL_LANG_SPECIFIC(node)->stringlen 819 #define GFC_DECL_SPAN(node) DECL_LANG_SPECIFIC(node)->span 820 #define GFC_DECL_TOKEN(node) DECL_LANG_SPECIFIC(node)->token 821 #define GFC_DECL_CAF_OFFSET(node) DECL_LANG_SPECIFIC(node)->caf_offset 822 #define GFC_DECL_SAVED_DESCRIPTOR(node) \ 823 (DECL_LANG_SPECIFIC(node)->saved_descriptor) 824 #define GFC_DECL_PACKED_ARRAY(node) DECL_LANG_FLAG_0(node) 825 #define GFC_DECL_PARTIAL_PACKED_ARRAY(node) DECL_LANG_FLAG_1(node) 826 #define GFC_DECL_ASSIGN(node) DECL_LANG_FLAG_2(node) 827 #define GFC_DECL_COMMON_OR_EQUIV(node) DECL_LANG_FLAG_3(node) 828 #define GFC_DECL_CRAY_POINTEE(node) DECL_LANG_FLAG_4(node) 829 #define GFC_DECL_RESULT(node) DECL_LANG_FLAG_5(node) 830 #define GFC_DECL_SUBREF_ARRAY_P(node) DECL_LANG_FLAG_6(node) 831 #define GFC_DECL_CLASS(node) DECL_LANG_FLAG_8(node) 832 833 /* An array descriptor. */ 834 #define GFC_DESCRIPTOR_TYPE_P(node) TYPE_LANG_FLAG_1(node) 835 /* An array without a descriptor. */ 836 #define GFC_ARRAY_TYPE_P(node) TYPE_LANG_FLAG_2(node) 837 /* Fortran POINTER type. */ 838 #define GFC_POINTER_TYPE_P(node) TYPE_LANG_FLAG_3(node) 839 /* Fortran CLASS type. */ 840 #define GFC_CLASS_TYPE_P(node) TYPE_LANG_FLAG_4(node) 841 /* The GFC_TYPE_ARRAY_* members are present in both descriptor and 842 descriptorless array types. */ 843 #define GFC_TYPE_ARRAY_LBOUND(node, dim) \ 844 (TYPE_LANG_SPECIFIC(node)->lbound[dim]) 845 #define GFC_TYPE_ARRAY_UBOUND(node, dim) \ 846 (TYPE_LANG_SPECIFIC(node)->ubound[dim]) 847 #define GFC_TYPE_ARRAY_STRIDE(node, dim) \ 848 (TYPE_LANG_SPECIFIC(node)->stride[dim]) 849 #define GFC_TYPE_ARRAY_RANK(node) (TYPE_LANG_SPECIFIC(node)->rank) 850 #define GFC_TYPE_ARRAY_CORANK(node) (TYPE_LANG_SPECIFIC(node)->corank) 851 #define GFC_TYPE_ARRAY_CAF_TOKEN(node) (TYPE_LANG_SPECIFIC(node)->caf_token) 852 #define GFC_TYPE_ARRAY_CAF_OFFSET(node) (TYPE_LANG_SPECIFIC(node)->caf_offset) 853 #define GFC_TYPE_ARRAY_SIZE(node) (TYPE_LANG_SPECIFIC(node)->size) 854 #define GFC_TYPE_ARRAY_OFFSET(node) (TYPE_LANG_SPECIFIC(node)->offset) 855 #define GFC_TYPE_ARRAY_AKIND(node) (TYPE_LANG_SPECIFIC(node)->akind) 856 /* Code should use gfc_get_dtype instead of accessing this directly. It may 857 not be known when the type is created. */ 858 #define GFC_TYPE_ARRAY_DTYPE(node) (TYPE_LANG_SPECIFIC(node)->dtype) 859 #define GFC_TYPE_ARRAY_DATAPTR_TYPE(node) \ 860 (TYPE_LANG_SPECIFIC(node)->dataptr_type) 861 #define GFC_TYPE_ARRAY_SPAN(node) (TYPE_LANG_SPECIFIC(node)->span) 862 #define GFC_TYPE_ARRAY_BASE_DECL(node, internal) \ 863 (TYPE_LANG_SPECIFIC(node)->base_decl[(internal)]) 864 865 866 /* Build an expression with void type. */ 867 #define build1_v(code, arg) \ 868 fold_build1_loc (input_location, code, void_type_node, arg) 869 #define build2_v(code, arg1, arg2) \ 870 fold_build2_loc (input_location, code, void_type_node, arg1, arg2) 871 #define build3_v(code, arg1, arg2, arg3) \ 872 fold_build3_loc (input_location, code, void_type_node, arg1, arg2, arg3) 873 #define build4_v(code, arg1, arg2, arg3, arg4) \ 874 build4_loc (input_location, code, void_type_node, arg1, arg2, \ 875 arg3, arg4) 876 877 /* This group of functions allows a caller to evaluate an expression from 878 the callee's interface. It establishes a mapping between the interface's 879 dummy arguments and the caller's actual arguments, then applies that 880 mapping to a given gfc_expr. 881 882 You can initialize a mapping structure like so: 883 884 gfc_interface_mapping mapping; 885 ... 886 gfc_init_interface_mapping (&mapping); 887 888 You should then evaluate each actual argument into a temporary 889 gfc_se structure, here called "se", and map the result to the 890 dummy argument's symbol, here called "sym": 891 892 gfc_add_interface_mapping (&mapping, sym, &se); 893 894 After adding all mappings, you should call: 895 896 gfc_finish_interface_mapping (&mapping, pre, post); 897 898 where "pre" and "post" are statement blocks for initialization 899 and finalization code respectively. You can then evaluate an 900 interface expression "expr" as follows: 901 902 gfc_apply_interface_mapping (&mapping, se, expr); 903 904 Once you've evaluated all expressions, you should free 905 the mapping structure with: 906 907 gfc_free_interface_mapping (&mapping); */ 908 909 910 /* This structure represents a mapping from OLD to NEW, where OLD is a 911 dummy argument symbol and NEW is a symbol that represents the value 912 of an actual argument. Mappings are linked together using NEXT 913 (in no particular order). */ 914 typedef struct gfc_interface_sym_mapping 915 { 916 struct gfc_interface_sym_mapping *next; 917 gfc_symbol *old; 918 gfc_symtree *new_sym; 919 gfc_expr *expr; 920 } 921 gfc_interface_sym_mapping; 922 923 924 /* This structure is used by callers to evaluate an expression from 925 a callee's interface. */ 926 typedef struct gfc_interface_mapping 927 { 928 /* Maps the interface's dummy arguments to the values that the caller 929 is passing. The whole list is owned by this gfc_interface_mapping. */ 930 gfc_interface_sym_mapping *syms; 931 932 /* A list of gfc_charlens that were needed when creating copies of 933 expressions. The whole list is owned by this gfc_interface_mapping. */ 934 gfc_charlen *charlens; 935 } 936 gfc_interface_mapping; 937 938 void gfc_init_interface_mapping (gfc_interface_mapping *); 939 void gfc_free_interface_mapping (gfc_interface_mapping *); 940 void gfc_add_interface_mapping (gfc_interface_mapping *, 941 gfc_symbol *, gfc_se *, gfc_expr *); 942 void gfc_finish_interface_mapping (gfc_interface_mapping *, 943 stmtblock_t *, stmtblock_t *); 944 void gfc_apply_interface_mapping (gfc_interface_mapping *, 945 gfc_se *, gfc_expr *); 946 947 948 /* Standard error messages used in all the trans-*.c files. */ 949 extern const char gfc_msg_fault[]; 950 extern const char gfc_msg_wrong_return[]; 951 952 #define OMPWS_WORKSHARE_FLAG 1 /* Set if in a workshare construct. */ 953 #define OMPWS_CURR_SINGLEUNIT 2 /* Set if current gfc_code in workshare 954 construct is not workshared. */ 955 #define OMPWS_SCALARIZER_WS 4 /* Set if scalarizer should attempt 956 to create parallel loops. */ 957 #define OMPWS_NOWAIT 8 /* Use NOWAIT on OMP_FOR. */ 958 extern int ompws_flags; 959 960 #endif /* GFC_TRANS_H */ 961