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