gcc/fortran/trans.h

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