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                      gfc_symbol * = nullptr);
 456 void gfc_class_set_vptr (stmtblock_t *, tree, tree);
 457 void gfc_reset_len (stmtblock_t *, gfc_expr *);
 458 tree gfc_get_class_from_gfc_expr (gfc_expr *);
 459 tree gfc_get_class_from_expr (tree);
 460 tree gfc_get_vptr_from_expr (tree);
 461 tree gfc_copy_class_to_class (tree, tree, tree, bool);
 462 bool gfc_add_finalizer_call (stmtblock_t *, gfc_expr *, tree = NULL_TREE);
 463 bool gfc_add_comp_finalizer_call (stmtblock_t *, tree, gfc_component *, bool);
 464 void gfc_finalize_tree_expr (gfc_se *, gfc_symbol *, symbol_attribute, int);
 465 bool gfc_assignment_finalizer_call (gfc_se *, gfc_expr *, bool);
 466
 467 void gfc_class_array_data_assign (stmtblock_t *, tree, tree, bool);
 468 void gfc_conv_derived_to_class (gfc_se *, gfc_expr *, gfc_symbol *fsym, tree,
 469                                 bool, bool, const char *, tree * = nullptr);
 470 void gfc_conv_class_to_class (gfc_se *, gfc_expr *, gfc_typespec, bool, bool,
 471                               bool, bool);
 472
 473 /* Initialize an init/cleanup block.  */
 474 void gfc_start_wrapped_block (gfc_wrapped_block* block, tree code);
 475 /* Add a pair of init/cleanup code to the block.  Each one might be a
 476    NULL_TREE if not required.  */
 477 void gfc_add_init_cleanup (gfc_wrapped_block* block, tree init, tree cleanup,
 478                            bool back = false);
 479 /* Finalize the block, that is, create a single expression encapsulating the
 480    original code together with init and clean-up code.  */
 481 tree gfc_finish_wrapped_block (gfc_wrapped_block* block);
 482
 483
 484 /* Advance the SS chain to the next term.  */
 485 void gfc_advance_se_ss_chain (gfc_se *);
 486
 487 /* Call this to initialize a gfc_se structure before use
 488    first parameter is structure to initialize, second is
 489    parent to get scalarization data from, or NULL.  */
 490 void gfc_init_se (gfc_se *, gfc_se *);
 491
 492 /* Create an artificial variable decl and add it to the current scope.  */
 493 tree gfc_create_var (tree, const char *);
 494 /* Like above but doesn't add it to the current scope.  */
 495 tree gfc_create_var_np (tree, const char *);
 496
 497 /* Store the result of an expression in a temp variable so it can be used
 498    repeatedly even if the original changes */
 499 void gfc_make_safe_expr (gfc_se * se);
 500
 501 /* Makes sure se is suitable for passing as a function string parameter.  */
 502 void gfc_conv_string_parameter (gfc_se * se);
 503
 504 /* Compare two strings.  */
 505 tree gfc_build_compare_string (tree, tree, tree, tree, int, enum tree_code);
 506
 507 /* When using the gfc_conv_* make sure you understand what they do, i.e.
 508    when a POST chain may be created, and what the returned expression may be
 509    used for.  Note that character strings have special handling.  This
 510    should not be a problem as most statements/operations only deal with
 511    numeric/logical types.  See the implementations in trans-expr.cc
 512    for details of the individual functions.  */
 513
 514 void gfc_conv_expr (gfc_se * se, gfc_expr * expr);
 515 void gfc_conv_expr_val (gfc_se * se, gfc_expr * expr);
 516 void gfc_conv_expr_lhs (gfc_se * se, gfc_expr * expr);
 517 void gfc_conv_expr_reference (gfc_se * se, gfc_expr * expr);
 518 void gfc_conv_expr_type (gfc_se * se, gfc_expr *, tree);
 519
 520
 521 /* trans-expr.cc */
 522 tree gfc_get_character_len_in_bytes (tree);
 523 tree gfc_conv_scalar_to_descriptor (gfc_se *, tree, symbol_attribute);
 524 tree gfc_get_ultimate_alloc_ptr_comps_caf_token (gfc_se *, gfc_expr *);
 525 tree gfc_string_to_single_character (tree len, tree str, int kind);
 526 tree gfc_get_tree_for_caf_expr (gfc_expr *);
 527 void gfc_get_caf_token_offset (gfc_se*, tree *, tree *, tree, tree, gfc_expr *);
 528 tree gfc_caf_get_image_index (stmtblock_t *, gfc_expr *, tree);
 529 void gfc_simple_for_loop (stmtblock_t *, tree, tree, tree, enum tree_code, tree,
 530                           tree);
 531
 532 /* Find the decl containing the auxiliary variables for assigned variables.  */
 533 void gfc_conv_label_variable (gfc_se * se, gfc_expr * expr);
 534 /* If the value is not constant, Create a temporary and copy the value.  */
 535 tree gfc_evaluate_now_loc (location_t, tree, stmtblock_t *);
 536 tree gfc_evaluate_now (tree, stmtblock_t *);
 537 tree gfc_evaluate_data_ref_now (tree, stmtblock_t *);
 538 tree gfc_evaluate_now_function_scope (tree, stmtblock_t *);
 539
 540 /* Find the appropriate variant of a math intrinsic.  */
 541 tree gfc_builtin_decl_for_float_kind (enum built_in_function, int);
 542
 543 tree size_of_string_in_bytes (int, tree);
 544
 545 /* Intrinsic procedure handling.  */
 546 tree gfc_conv_intrinsic_subroutine (gfc_code *);
 547 void gfc_conv_intrinsic_function (gfc_se *, gfc_expr *);
 548 bool gfc_conv_ieee_arithmetic_function (gfc_se *, gfc_expr *);
 549 tree gfc_save_fp_state (stmtblock_t *);
 550 void gfc_restore_fp_state (stmtblock_t *, tree);
 551
 552 bool gfc_expr_is_variable (gfc_expr *);
 553
 554 /* Does an intrinsic map directly to an external library call
 555    This is true for array-returning intrinsics, unless
 556    gfc_inline_intrinsic_function_p returns true.  */
 557 int gfc_is_intrinsic_libcall (gfc_expr *);
 558
 559 /* Used to call ordinary functions/subroutines
 560    and procedure pointer components.  */
 561 int gfc_conv_procedure_call (gfc_se *, gfc_symbol *, gfc_actual_arglist *,
 562                              gfc_expr *, vec<tree, va_gc> *);
 563
 564 void gfc_conv_subref_array_arg (gfc_se *, gfc_expr *, int, sym_intent, bool,
 565                                 const gfc_symbol *fsym = NULL,
 566                                 const char *proc_name = NULL,
 567                                 gfc_symbol *sym = NULL,
 568                                 bool check_contiguous = false);
 569
 570 void gfc_conv_is_contiguous_expr (gfc_se *, gfc_expr *);
 571
 572 /* Generate code for a scalar assignment.  */
 573 tree
 574 gfc_trans_scalar_assign (gfc_se *, gfc_se *, gfc_typespec, bool, bool,
 575                          bool = false, bool = false);
 576
 577 /* Translate COMMON blocks.  */
 578 void gfc_trans_common (gfc_namespace *);
 579
 580 /* Translate a derived type constructor.  */
 581 void gfc_conv_structure (gfc_se *, gfc_expr *, int);
 582
 583 /* Return an expression which determines if a dummy parameter is present.  */
 584 tree gfc_conv_expr_present (gfc_symbol *, bool use_saved_decl = false);
 585 /* Convert a missing, dummy argument into a null or zero.  */
 586 void gfc_conv_missing_dummy (gfc_se *, gfc_expr *, gfc_typespec, int);
 587
 588 /* Lowering of component references.  */
 589 void gfc_conv_component_ref (gfc_se * se, gfc_ref * ref);
 590 void conv_parent_component_references (gfc_se * se, gfc_ref * ref);
 591
 592 /* Automatically dereference var.  */
 593 tree gfc_maybe_dereference_var (gfc_symbol *, tree, bool desc_only = false,
 594                                 bool is_classarray = false);
 595
 596 /* Generate code to allocate a string temporary.  */
 597 tree gfc_conv_string_tmp (gfc_se *, tree, tree);
 598 /* Get the string length variable belonging to an expression.  */
 599 tree gfc_get_expr_charlen (gfc_expr *);
 600 /* Initialize a string length variable.  */
 601 void gfc_conv_string_length (gfc_charlen *, gfc_expr *, stmtblock_t *);
 602 /* Ensure type sizes can be gimplified.  */
 603 void gfc_trans_vla_type_sizes (gfc_symbol *, stmtblock_t *);
 604
 605 /* Add an expression to the end of a block.  */
 606 void gfc_add_expr_to_block (stmtblock_t *, tree);
 607 /* Add an expression to the beginning of a block.  */
 608 void gfc_prepend_expr_to_block (stmtblock_t *, tree);
 609 /* Add a block to the end of a block.  */
 610 void gfc_add_block_to_block (stmtblock_t *, stmtblock_t *);
 611 /* Add a MODIFY_EXPR to a block.  */
 612 void gfc_add_modify_loc (location_t, stmtblock_t *, tree, tree);
 613 void gfc_add_modify (stmtblock_t *, tree, tree);
 614
 615 /* Initialize a statement block.  */
 616 void gfc_init_block (stmtblock_t *);
 617 /* Start a new statement block.  Like gfc_init_block but also starts a new
 618    variable scope.  */
 619 void gfc_start_block (stmtblock_t *);
 620 /* Finish a statement block.  Also closes the scope if the block was created
 621    with gfc_start_block.  */
 622 tree gfc_finish_block (stmtblock_t *);
 623 /* Merge the scope of a block with its parent.  */
 624 void gfc_merge_block_scope (stmtblock_t * block);
 625
 626 /* Return the backend label decl.  */
 627 tree gfc_get_label_decl (gfc_st_label *);
 628
 629 /* Return the decl for an external function.  */
 630 tree gfc_get_extern_function_decl (gfc_symbol *,
 631                                    gfc_actual_arglist *args = NULL,
 632                                    const char *fnspec = NULL);
 633
 634 /* Build an ADDR_EXPR.  */
 635 tree gfc_build_addr_expr (tree, tree);
 636
 637 /* Build an ARRAY_REF.  */
 638 tree gfc_build_array_ref (tree, tree, tree,
 639                           bool non_negative_offset = false,
 640                           tree vptr = NULL_TREE);
 641
 642 /* Build an array ref using pointer arithmetic.  */
 643 tree gfc_build_spanned_array_ref (tree base, tree offset, tree span);
 644
 645 /* Creates a label.  Decl is artificial if label_id == NULL_TREE.  */
 646 tree gfc_build_label_decl (tree);
 647
 648 /* Return the decl used to hold the function return value.
 649    Do not use if the function has an explicit result variable.  */
 650 tree gfc_get_fake_result_decl (gfc_symbol *, int);
 651
 652 /* Add a decl to the binding level for the current function.  */
 653 void gfc_add_decl_to_function (tree);
 654
 655 /* Make prototypes for runtime library functions.  */
 656 void gfc_build_builtin_function_decls (void);
 657
 658 /* Set the backend source location of a decl.  */
 659 void gfc_set_decl_location (tree, locus *);
 660
 661 /* Get a module symbol backend_decl if possible.  */
 662 bool gfc_get_module_backend_decl (gfc_symbol *);
 663
 664 /* Return the variable decl for a symbol.  */
 665 tree gfc_get_symbol_decl (gfc_symbol *);
 666
 667 /* Build a static initializer.  */
 668 tree gfc_conv_initializer (gfc_expr *, gfc_typespec *, tree, bool, bool, bool);
 669
 670 /* Assign a default initializer to a derived type.  */
 671 void gfc_init_default_dt (gfc_symbol *, stmtblock_t *, bool);
 672
 673 /* Substitute a temporary variable in place of the real one.  */
 674 void gfc_shadow_sym (gfc_symbol *, tree, gfc_saved_var *);
 675
 676 /* Restore the original variable.  */
 677 void gfc_restore_sym (gfc_symbol *, gfc_saved_var *);
 678
 679 /* Setting a decl assembler name, mangling it according to target rules
 680    (like Windows @NN decorations).  */
 681 void gfc_set_decl_assembler_name (tree, tree);
 682
 683 /* Returns true if a variable of specified size should go on the stack.  */
 684 bool gfc_can_put_var_on_stack (tree);
 685
 686 /* Set GFC_DECL_SCALAR_* on decl from sym if needed.  */
 687 void gfc_finish_decl_attrs (tree, symbol_attribute *);
 688
 689 /* Allocate the lang-specific part of a decl node.  */
 690 void gfc_allocate_lang_decl (tree);
 691
 692 /* Get the location suitable for the ME from a gfortran locus; required to get
 693    the column number right.  */
 694 location_t gfc_get_location (locus *);
 695
 696 /* Advance along a TREE_CHAIN.  */
 697 tree gfc_advance_chain (tree, int);
 698
 699 /* Create a decl for a function.  */
 700 void gfc_create_function_decl (gfc_namespace *, bool);
 701 /* Generate the code for a function.  */
 702 void gfc_generate_function_code (gfc_namespace *);
 703 /* Output a BLOCK DATA program unit.  */
 704 void gfc_generate_block_data (gfc_namespace *);
 705 /* Output a decl for a module variable.  */
 706 void gfc_generate_module_vars (gfc_namespace *);
 707 /* Get the appropriate return statement for a procedure.  */
 708 tree gfc_generate_return (void);
 709
 710 struct module_decl_hasher : ggc_ptr_hash<tree_node>
 711 {
 712   typedef const char *compare_type;
 713
 714   static hashval_t hash (tree);
 715   static bool equal (tree, const char *);
 716 };
 717
 718 struct GTY((for_user)) module_htab_entry {
 719   const char *name;
 720   tree namespace_decl;
 721   hash_table<module_decl_hasher> *GTY (()) decls;
 722 };
 723
 724 struct module_htab_entry *gfc_find_module (const char *);
 725 void gfc_module_add_decl (struct module_htab_entry *, tree);
 726
 727 /* Get and set the current location.  */
 728 void gfc_save_backend_locus (locus *);
 729 void gfc_set_backend_locus (locus *);
 730 void gfc_restore_backend_locus (locus *);
 731
 732 /* Handle static constructor functions.  */
 733 extern GTY(()) tree gfc_static_ctors;
 734 void gfc_generate_constructors (void);
 735
 736 /* Get the string length of an array constructor.  */
 737 bool get_array_ctor_strlen (stmtblock_t *, gfc_constructor_base, tree *);
 738
 739 /* Mark a condition as likely or unlikely.  */
 740 tree gfc_likely (tree, enum br_predictor);
 741 tree gfc_unlikely (tree, enum br_predictor);
 742
 743 /* Return the string length of a deferred character length component.  */
 744 bool gfc_deferred_strlen (gfc_component *, tree *);
 745
 746 /* Generate a runtime error call.  */
 747 tree gfc_trans_runtime_error (bool, locus*, const char*, ...);
 748
 749 /* Generate a runtime warning/error check.  */
 750 void gfc_trans_runtime_check (bool, bool, tree, stmtblock_t *, locus *,
 751                               const char *, ...);
 752
 753 /* Generate a runtime check for same string length.  */
 754 void gfc_trans_same_strlen_check (const char*, locus*, tree, tree,
 755                                   stmtblock_t*);
 756
 757 /* Generate a call to free().  */
 758 tree gfc_call_free (tree);
 759
 760 /* Allocate memory after performing a few checks.  */
 761 tree gfc_call_malloc (stmtblock_t *, tree, tree);
 762
 763 /* Build a memcpy call.  */
 764 tree gfc_build_memcpy_call (tree, tree, tree);
 765
 766 /* Register memory with the coarray library.  */
 767 void gfc_allocate_using_caf_lib (stmtblock_t *, tree, tree, tree, tree, tree,
 768                                  tree, gfc_coarray_regtype);
 769
 770 /* Allocate memory for allocatable variables, with optional status variable.  */
 771 void gfc_allocate_allocatable (stmtblock_t*, tree, tree, tree, tree,
 772                                tree, tree, tree, gfc_expr*, int,
 773                                tree = NULL_TREE, tree = NULL_TREE,
 774                                tree = NULL_TREE);
 775
 776 /* Allocate memory, with optional status variable.  */
 777 void gfc_allocate_using_malloc (stmtblock_t *, tree, tree, tree,
 778                                 tree = NULL_TREE, tree = NULL_TREE,
 779                                 tree = NULL_TREE);
 780
 781 /* Generate code to deallocate an array.  */
 782 tree gfc_deallocate_with_status (tree, tree, tree, tree, tree, bool,
 783                                  gfc_expr *, int, tree = NULL_TREE,
 784                                  tree a = NULL_TREE, tree c = NULL_TREE);
 785 tree gfc_deallocate_scalar_with_status (tree, tree, tree, bool, gfc_expr*,
 786                                         gfc_typespec, tree = NULL_TREE,
 787                                         bool c = false);
 788
 789 /* Generate code to call realloc().  */
 790 tree gfc_call_realloc (stmtblock_t *, tree, tree);
 791
 792 /* Assign a derived type constructor to a variable.  */
 793 tree gfc_trans_structure_assign (tree, gfc_expr *, bool, bool c = false);
 794
 795 /* Generate code for an assignment, includes scalarization.  */
 796 tree gfc_trans_assignment (gfc_expr *, gfc_expr *, bool, bool, bool p = false,
 797                            bool a = true);
 798
 799 /* Generate code for a pointer assignment.  */
 800 tree gfc_trans_pointer_assignment (gfc_expr *, gfc_expr *);
 801
 802 /* Initialize function decls for library functions.  */
 803 void gfc_build_intrinsic_lib_fndecls (void);
 804 /* Create function decls for IO library functions.  */
 805 void gfc_build_io_library_fndecls (void);
 806 /* Build a function decl for a library function.  */
 807 tree gfc_build_library_function_decl (tree, tree, int, ...);
 808 tree gfc_build_library_function_decl_with_spec (tree name, const char *spec,
 809                                                 tree rettype, int nargs, ...);
 810
 811 /* Process the local variable decls of a block construct.  */
 812 void gfc_process_block_locals (gfc_namespace*);
 813
 814 /* Output initialization/clean-up code that was deferred.  */
 815 void gfc_trans_deferred_vars (gfc_symbol*, gfc_wrapped_block *);
 816
 817 /* In f95-lang.cc.  */
 818 tree pushdecl (tree);
 819 tree pushdecl_top_level (tree);
 820 void pushlevel (void);
 821 tree poplevel (int, int);
 822 tree getdecls (void);
 823
 824 /* In trans-types.cc.  */
 825 struct array_descr_info;
 826 bool gfc_get_array_descr_info (const_tree, struct array_descr_info *);
 827
 828 /* In trans-openmp.cc */
 829 tree gfc_omp_call_add_alloc (tree);
 830 tree gfc_omp_call_is_alloc (tree);
 831 bool gfc_omp_is_allocatable_or_ptr (const_tree);
 832 tree gfc_omp_check_optional_argument (tree, bool);
 833 tree gfc_omp_array_data (tree, bool);
 834 tree gfc_omp_array_size (tree, gimple_seq *);
 835 bool gfc_omp_privatize_by_reference (const_tree);
 836 enum omp_clause_default_kind gfc_omp_predetermined_sharing (tree);
 837 enum omp_clause_defaultmap_kind gfc_omp_predetermined_mapping (tree);
 838 tree gfc_omp_report_decl (tree);
 839 tree gfc_omp_clause_default_ctor (tree, tree, tree);
 840 tree gfc_omp_clause_copy_ctor (tree, tree, tree);
 841 tree gfc_omp_clause_assign_op (tree, tree, tree);
 842 tree gfc_omp_clause_linear_ctor (tree, tree, tree, tree);
 843 tree gfc_omp_clause_dtor (tree, tree);
 844 void gfc_omp_finish_clause (tree, gimple_seq *, bool);
 845 bool gfc_omp_allocatable_p (tree);
 846 bool gfc_omp_scalar_p (tree, bool);
 847 bool gfc_omp_scalar_target_p (tree);
 848 bool gfc_omp_disregard_value_expr (tree, bool);
 849 bool gfc_omp_private_debug_clause (tree, bool);
 850 bool gfc_omp_private_outer_ref (tree);
 851 struct gimplify_omp_ctx;
 852 void gfc_omp_firstprivatize_type_sizes (struct gimplify_omp_ctx *, tree);
 853
 854 /* In trans-intrinsic.cc.  */
 855 void gfc_conv_intrinsic_mvbits (gfc_se *, gfc_actual_arglist *,
 856                                 gfc_loopinfo *);
 857
 858 /* Runtime library function decls.  */
 859 extern GTY(()) tree gfor_fndecl_pause_numeric;
 860 extern GTY(()) tree gfor_fndecl_pause_string;
 861 extern GTY(()) tree gfor_fndecl_stop_numeric;
 862 extern GTY(()) tree gfor_fndecl_stop_string;
 863 extern GTY(()) tree gfor_fndecl_error_stop_numeric;
 864 extern GTY(()) tree gfor_fndecl_error_stop_string;
 865 extern GTY(()) tree gfor_fndecl_runtime_error;
 866 extern GTY(()) tree gfor_fndecl_runtime_error_at;
 867 extern GTY(()) tree gfor_fndecl_runtime_warning_at;
 868 extern GTY(()) tree gfor_fndecl_os_error_at;
 869 extern GTY(()) tree gfor_fndecl_generate_error;
 870 extern GTY(()) tree gfor_fndecl_set_fpe;
 871 extern GTY(()) tree gfor_fndecl_set_options;
 872 extern GTY(()) tree gfor_fndecl_ttynam;
 873 extern GTY(()) tree gfor_fndecl_ctime;
 874 extern GTY(()) tree gfor_fndecl_fdate;
 875 extern GTY(()) tree gfor_fndecl_in_pack;
 876 extern GTY(()) tree gfor_fndecl_in_unpack;
 877 extern GTY(()) tree gfor_fndecl_in_pack_class;
 878 extern GTY(()) tree gfor_fndecl_in_unpack_class;
 879 extern GTY(()) tree gfor_fndecl_associated;
 880 extern GTY(()) tree gfor_fndecl_system_clock4;
 881 extern GTY(()) tree gfor_fndecl_system_clock8;
 882
 883
 884 /* Coarray run-time library function decls.  */
 885 extern GTY(()) tree gfor_fndecl_caf_init;
 886 extern GTY(()) tree gfor_fndecl_caf_finalize;
 887 extern GTY(()) tree gfor_fndecl_caf_this_image;
 888 extern GTY(()) tree gfor_fndecl_caf_num_images;
 889 extern GTY(()) tree gfor_fndecl_caf_register;
 890 extern GTY(()) tree gfor_fndecl_caf_deregister;
 891 extern GTY(()) tree gfor_fndecl_caf_get;
 892 extern GTY(()) tree gfor_fndecl_caf_send;
 893 extern GTY(()) tree gfor_fndecl_caf_sendget;
 894 extern GTY(()) tree gfor_fndecl_caf_get_by_ref;
 895 extern GTY(()) tree gfor_fndecl_caf_send_by_ref;
 896 extern GTY(()) tree gfor_fndecl_caf_sendget_by_ref;
 897 extern GTY(()) tree gfor_fndecl_caf_sync_all;
 898 extern GTY(()) tree gfor_fndecl_caf_sync_memory;
 899 extern GTY(()) tree gfor_fndecl_caf_sync_images;
 900 extern GTY(()) tree gfor_fndecl_caf_stop_numeric;
 901 extern GTY(()) tree gfor_fndecl_caf_stop_str;
 902 extern GTY(()) tree gfor_fndecl_caf_error_stop;
 903 extern GTY(()) tree gfor_fndecl_caf_error_stop_str;
 904 extern GTY(()) tree gfor_fndecl_caf_atomic_def;
 905 extern GTY(()) tree gfor_fndecl_caf_atomic_ref;
 906 extern GTY(()) tree gfor_fndecl_caf_atomic_cas;
 907 extern GTY(()) tree gfor_fndecl_caf_atomic_op;
 908 extern GTY(()) tree gfor_fndecl_caf_lock;
 909 extern GTY(()) tree gfor_fndecl_caf_unlock;
 910 extern GTY(()) tree gfor_fndecl_caf_event_post;
 911 extern GTY(()) tree gfor_fndecl_caf_event_wait;
 912 extern GTY(()) tree gfor_fndecl_caf_event_query;
 913 extern GTY(()) tree gfor_fndecl_caf_fail_image;
 914 extern GTY(()) tree gfor_fndecl_caf_failed_images;
 915 extern GTY(()) tree gfor_fndecl_caf_image_status;
 916 extern GTY(()) tree gfor_fndecl_caf_stopped_images;
 917 extern GTY(()) tree gfor_fndecl_caf_form_team;
 918 extern GTY(()) tree gfor_fndecl_caf_change_team;
 919 extern GTY(()) tree gfor_fndecl_caf_end_team;
 920 extern GTY(()) tree gfor_fndecl_caf_get_team;
 921 extern GTY(()) tree gfor_fndecl_caf_sync_team;
 922 extern GTY(()) tree gfor_fndecl_caf_team_number;
 923 extern GTY(()) tree gfor_fndecl_co_broadcast;
 924 extern GTY(()) tree gfor_fndecl_co_max;
 925 extern GTY(()) tree gfor_fndecl_co_min;
 926 extern GTY(()) tree gfor_fndecl_co_reduce;
 927 extern GTY(()) tree gfor_fndecl_co_sum;
 928 extern GTY(()) tree gfor_fndecl_caf_is_present;
 929
 930 /* Math functions.  Many other math functions are handled in
 931    trans-intrinsic.cc.  */
 932
 933 typedef struct GTY(()) gfc_powdecl_list {
 934   tree integer;
 935   tree real;
 936   tree cmplx;
 937 }
 938 gfc_powdecl_list;
 939
 940 extern GTY(()) gfc_powdecl_list gfor_fndecl_math_powi[4][3];
 941 extern GTY(()) tree gfor_fndecl_math_ishftc4;
 942 extern GTY(()) tree gfor_fndecl_math_ishftc8;
 943 extern GTY(()) tree gfor_fndecl_math_ishftc16;
 944
 945 /* BLAS functions.  */
 946 extern GTY(()) tree gfor_fndecl_sgemm;
 947 extern GTY(()) tree gfor_fndecl_dgemm;
 948 extern GTY(()) tree gfor_fndecl_cgemm;
 949 extern GTY(()) tree gfor_fndecl_zgemm;
 950
 951 /* String functions.  */
 952 extern GTY(()) tree gfor_fndecl_compare_string;
 953 extern GTY(()) tree gfor_fndecl_concat_string;
 954 extern GTY(()) tree gfor_fndecl_string_len_trim;
 955 extern GTY(()) tree gfor_fndecl_string_index;
 956 extern GTY(()) tree gfor_fndecl_string_scan;
 957 extern GTY(()) tree gfor_fndecl_string_verify;
 958 extern GTY(()) tree gfor_fndecl_string_trim;
 959 extern GTY(()) tree gfor_fndecl_string_minmax;
 960 extern GTY(()) tree gfor_fndecl_adjustl;
 961 extern GTY(()) tree gfor_fndecl_adjustr;
 962 extern GTY(()) tree gfor_fndecl_select_string;
 963 extern GTY(()) tree gfor_fndecl_compare_string_char4;
 964 extern GTY(()) tree gfor_fndecl_concat_string_char4;
 965 extern GTY(()) tree gfor_fndecl_string_len_trim_char4;
 966 extern GTY(()) tree gfor_fndecl_string_index_char4;
 967 extern GTY(()) tree gfor_fndecl_string_scan_char4;
 968 extern GTY(()) tree gfor_fndecl_string_verify_char4;
 969 extern GTY(()) tree gfor_fndecl_string_trim_char4;
 970 extern GTY(()) tree gfor_fndecl_string_minmax_char4;
 971 extern GTY(()) tree gfor_fndecl_adjustl_char4;
 972 extern GTY(()) tree gfor_fndecl_adjustr_char4;
 973 extern GTY(()) tree gfor_fndecl_select_string_char4;
 974
 975 /* Conversion between character kinds.  */
 976 extern GTY(()) tree gfor_fndecl_convert_char1_to_char4;
 977 extern GTY(()) tree gfor_fndecl_convert_char4_to_char1;
 978
 979 /* Other misc. runtime library functions.  */
 980 extern GTY(()) tree gfor_fndecl_iargc;
 981 extern GTY(()) tree gfor_fndecl_kill;
 982 extern GTY(()) tree gfor_fndecl_kill_sub;
 983 extern GTY(()) tree gfor_fndecl_is_contiguous0;
 984
 985 /* Implemented in Fortran.  */
 986 extern GTY(()) tree gfor_fndecl_sc_kind;
 987 extern GTY(()) tree gfor_fndecl_si_kind;
 988 extern GTY(()) tree gfor_fndecl_sl_kind;
 989 extern GTY(()) tree gfor_fndecl_sr_kind;
 990
 991 /* IEEE-related.  */
 992 extern GTY(()) tree gfor_fndecl_ieee_procedure_entry;
 993 extern GTY(()) tree gfor_fndecl_ieee_procedure_exit;
 994
 995 /* RANDOM_INIT.  */
 996 extern GTY(()) tree gfor_fndecl_random_init;
 997 extern GTY(()) tree gfor_fndecl_caf_random_init;
 998
 999 /* True if node is an integer constant.  */
1000 #define INTEGER_CST_P(node) (TREE_CODE(node) == INTEGER_CST)
1001
1002 /* gfortran-specific declaration information, the _CONT versions denote
1003    arrays with CONTIGUOUS attribute.  */
1004
1005 #define GFC_DTYPE_ELEM_LEN 0
1006 #define GFC_DTYPE_VERSION 1
1007 #define GFC_DTYPE_RANK 2
1008 #define GFC_DTYPE_TYPE 3
1009 #define GFC_DTYPE_ATTRIBUTE 4
1010
1011 enum gfc_array_kind
1012 {
1013   GFC_ARRAY_UNKNOWN,
1014   GFC_ARRAY_ASSUMED_SHAPE,
1015   GFC_ARRAY_ASSUMED_SHAPE_CONT,
1016   GFC_ARRAY_ASSUMED_RANK,
1017   GFC_ARRAY_ASSUMED_RANK_CONT,
1018   GFC_ARRAY_ALLOCATABLE,
1019   GFC_ARRAY_POINTER,
1020   GFC_ARRAY_POINTER_CONT
1021 };
1022
1023 /* Array types only.  */
1024 struct GTY(())  lang_type        {
1025   int rank, corank;
1026   enum gfc_array_kind akind;
1027   tree lbound[GFC_MAX_DIMENSIONS];
1028   tree ubound[GFC_MAX_DIMENSIONS];
1029   tree stride[GFC_MAX_DIMENSIONS];
1030   tree size;
1031   tree offset;
1032   tree dtype;
1033   tree dataptr_type;
1034   tree base_decl[2];
1035   tree nonrestricted_type;
1036   tree caf_token;
1037   tree caf_offset;
1038 };
1039
1040 struct GTY(()) lang_decl {
1041   /* Dummy variables.  */
1042   tree saved_descriptor;
1043   /* Assigned integer nodes.  Stringlength is the IO format string's length.
1044      Addr is the address of the string or the target label. Stringlength is
1045      initialized to -2 and assigned to -1 when addr is assigned to the
1046      address of target label.  */
1047   tree stringlen;
1048   tree addr;
1049   /* For assumed-shape coarrays.  */
1050   tree token, caf_offset;
1051   unsigned int scalar_allocatable : 1;
1052   unsigned int scalar_pointer : 1;
1053   unsigned int scalar_target : 1;
1054   unsigned int optional_arg : 1;
1055 };
1056
1057
1058 #define GFC_DECL_ASSIGN_ADDR(node) DECL_LANG_SPECIFIC(node)->addr
1059 #define GFC_DECL_STRING_LEN(node) DECL_LANG_SPECIFIC(node)->stringlen
1060 #define GFC_DECL_TOKEN(node) DECL_LANG_SPECIFIC(node)->token
1061 #define GFC_DECL_CAF_OFFSET(node) DECL_LANG_SPECIFIC(node)->caf_offset
1062 #define GFC_DECL_SAVED_DESCRIPTOR(node) \
1063   (DECL_LANG_SPECIFIC(node)->saved_descriptor)
1064 #define GFC_DECL_SCALAR_ALLOCATABLE(node) \
1065   (DECL_LANG_SPECIFIC (node)->scalar_allocatable)
1066 #define GFC_DECL_SCALAR_POINTER(node) \
1067   (DECL_LANG_SPECIFIC (node)->scalar_pointer)
1068 #define GFC_DECL_SCALAR_TARGET(node) \
1069   (DECL_LANG_SPECIFIC (node)->scalar_target)
1070 #define GFC_DECL_OPTIONAL_ARGUMENT(node) \
1071   (DECL_LANG_SPECIFIC (node)->optional_arg)
1072 #define GFC_DECL_GET_SCALAR_ALLOCATABLE(node) \
1073   (DECL_LANG_SPECIFIC (node) ? GFC_DECL_SCALAR_ALLOCATABLE (node) : 0)
1074 #define GFC_DECL_GET_SCALAR_POINTER(node) \
1075   (DECL_LANG_SPECIFIC (node) ? GFC_DECL_SCALAR_POINTER (node) : 0)
1076 #define GFC_DECL_GET_SCALAR_TARGET(node) \
1077   (DECL_LANG_SPECIFIC (node) ? GFC_DECL_SCALAR_TARGET (node) : 0)
1078 #define GFC_DECL_PACKED_ARRAY(node) DECL_LANG_FLAG_0(node)
1079 #define GFC_DECL_PARTIAL_PACKED_ARRAY(node) DECL_LANG_FLAG_1(node)
1080 #define GFC_DECL_ASSIGN(node) DECL_LANG_FLAG_2(node)
1081 #define GFC_DECL_COMMON_OR_EQUIV(node) DECL_LANG_FLAG_3(node)
1082 #define GFC_DECL_CRAY_POINTEE(node) DECL_LANG_FLAG_4(node)
1083 #define GFC_DECL_RESULT(node) DECL_LANG_FLAG_5(node)
1084 #define GFC_DECL_PTR_ARRAY_P(node) DECL_LANG_FLAG_6(node)
1085 #define GFC_DECL_ASSOCIATE_VAR_P(node) DECL_LANG_FLAG_7(node)
1086 #define GFC_DECL_CLASS(node) DECL_LANG_FLAG_8(node)
1087
1088 /* An array descriptor.  */
1089 #define GFC_DESCRIPTOR_TYPE_P(node) TYPE_LANG_FLAG_1(node)
1090 /* An array without a descriptor.  */
1091 #define GFC_ARRAY_TYPE_P(node) TYPE_LANG_FLAG_2(node)
1092 /* Fortran CLASS type.  */
1093 #define GFC_CLASS_TYPE_P(node) TYPE_LANG_FLAG_4(node)
1094 /* The GFC_TYPE_ARRAY_* members are present in both descriptor and
1095    descriptorless array types.  */
1096 #define GFC_TYPE_ARRAY_LBOUND(node, dim) \
1097   (TYPE_LANG_SPECIFIC(node)->lbound[dim])
1098 #define GFC_TYPE_ARRAY_UBOUND(node, dim) \
1099   (TYPE_LANG_SPECIFIC(node)->ubound[dim])
1100 #define GFC_TYPE_ARRAY_STRIDE(node, dim) \
1101   (TYPE_LANG_SPECIFIC(node)->stride[dim])
1102 #define GFC_TYPE_ARRAY_RANK(node) (TYPE_LANG_SPECIFIC(node)->rank)
1103 #define GFC_TYPE_ARRAY_CORANK(node) (TYPE_LANG_SPECIFIC(node)->corank)
1104 #define GFC_TYPE_ARRAY_CAF_TOKEN(node) (TYPE_LANG_SPECIFIC(node)->caf_token)
1105 #define GFC_TYPE_ARRAY_CAF_OFFSET(node) (TYPE_LANG_SPECIFIC(node)->caf_offset)
1106 #define GFC_TYPE_ARRAY_SIZE(node) (TYPE_LANG_SPECIFIC(node)->size)
1107 #define GFC_TYPE_ARRAY_OFFSET(node) (TYPE_LANG_SPECIFIC(node)->offset)
1108 #define GFC_TYPE_ARRAY_AKIND(node) (TYPE_LANG_SPECIFIC(node)->akind)
1109 /* Code should use gfc_get_dtype instead of accessing this directly.  It may
1110    not be known when the type is created.  */
1111 #define GFC_TYPE_ARRAY_DTYPE(node) (TYPE_LANG_SPECIFIC(node)->dtype)
1112 #define GFC_TYPE_ARRAY_DATAPTR_TYPE(node) \
1113   (TYPE_LANG_SPECIFIC(node)->dataptr_type)
1114 #define GFC_TYPE_ARRAY_BASE_DECL(node, internal) \
1115   (TYPE_LANG_SPECIFIC(node)->base_decl[(internal)])
1116
1117
1118 /* Build an expression with void type.  */
1119 #define build1_v(code, arg) \
1120         fold_build1_loc (input_location, code, void_type_node, arg)
1121 #define build2_v(code, arg1, arg2) \
1122         fold_build2_loc (input_location, code, void_type_node, arg1, arg2)
1123 #define build3_v(code, arg1, arg2, arg3) \
1124         fold_build3_loc (input_location, code, void_type_node, arg1, arg2, arg3)
1125 #define build4_v(code, arg1, arg2, arg3, arg4) \
1126         build4_loc (input_location, code, void_type_node, arg1, arg2, \
1127                     arg3, arg4)
1128
1129 /* This group of functions allows a caller to evaluate an expression from
1130    the callee's interface.  It establishes a mapping between the interface's
1131    dummy arguments and the caller's actual arguments, then applies that
1132    mapping to a given gfc_expr.
1133
1134    You can initialize a mapping structure like so:
1135
1136        gfc_interface_mapping mapping;
1137        ...
1138        gfc_init_interface_mapping (&mapping);
1139
1140    You should then evaluate each actual argument into a temporary
1141    gfc_se structure, here called "se", and map the result to the
1142    dummy argument's symbol, here called "sym":
1143
1144        gfc_add_interface_mapping (&mapping, sym, &se);
1145
1146    After adding all mappings, you should call:
1147
1148        gfc_finish_interface_mapping (&mapping, pre, post);
1149
1150    where "pre" and "post" are statement blocks for initialization
1151    and finalization code respectively.  You can then evaluate an
1152    interface expression "expr" as follows:
1153
1154        gfc_apply_interface_mapping (&mapping, se, expr);
1155
1156    Once you've evaluated all expressions, you should free
1157    the mapping structure with:
1158
1159        gfc_free_interface_mapping (&mapping); */
1160
1161
1162 /* This structure represents a mapping from OLD to NEW, where OLD is a
1163    dummy argument symbol and NEW is a symbol that represents the value
1164    of an actual argument.  Mappings are linked together using NEXT
1165    (in no particular order).  */
1166 typedef struct gfc_interface_sym_mapping
1167 {
1168   struct gfc_interface_sym_mapping *next;
1169   gfc_symbol *old;
1170   gfc_symtree *new_sym;
1171   gfc_expr *expr;
1172 }
1173 gfc_interface_sym_mapping;
1174
1175
1176 /* This structure is used by callers to evaluate an expression from
1177    a callee's interface.  */
1178 typedef struct gfc_interface_mapping
1179 {
1180   /* Maps the interface's dummy arguments to the values that the caller
1181      is passing.  The whole list is owned by this gfc_interface_mapping.  */
1182   gfc_interface_sym_mapping *syms;
1183
1184   /* A list of gfc_charlens that were needed when creating copies of
1185      expressions.  The whole list is owned by this gfc_interface_mapping.  */
1186   gfc_charlen *charlens;
1187 }
1188 gfc_interface_mapping;
1189
1190 void gfc_init_interface_mapping (gfc_interface_mapping *);
1191 void gfc_free_interface_mapping (gfc_interface_mapping *);
1192 void gfc_add_interface_mapping (gfc_interface_mapping *,
1193                                 gfc_symbol *, gfc_se *, gfc_expr *);
1194 void gfc_apply_interface_mapping (gfc_interface_mapping *,
1195                                   gfc_se *, gfc_expr *);
1196
1197
1198 /* Standard error messages used in all the trans-*.c files.  */
1199 extern const char gfc_msg_fault[];
1200
1201 #define OMPWS_WORKSHARE_FLAG    1       /* Set if in a workshare construct.  */
1202 #define OMPWS_CURR_SINGLEUNIT   2       /* Set if current gfc_code in workshare
1203                                            construct is not workshared.  */
1204 #define OMPWS_SCALARIZER_WS     4       /* Set if scalarizer should attempt
1205                                            to create parallel loops.  */
1206 #define OMPWS_SCALARIZER_BODY   8       /* Set if handling body of potential
1207                                            parallel loop.  */
1208 #define OMPWS_NOWAIT            16      /* Use NOWAIT on OMP_FOR.  */
1209 extern int ompws_flags;
1210
1211 #endif /* GFC_TRANS_H */