gcc/fortran/trans.h

   1 /* Header for code translation functions
   2    Copyright (C) 2002-2023 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
 769 /* Allocate memory, with optional status variable.  */
 770 void gfc_allocate_using_malloc (stmtblock_t *, tree, tree, tree);
 771
 772 /* Generate code to deallocate an array.  */
 773 tree gfc_deallocate_with_status (tree, tree, tree, tree, tree, bool,
 774                                  gfc_expr *, int, tree = NULL_TREE,
 775                                  tree a = NULL_TREE, tree c = NULL_TREE);
 776 tree gfc_deallocate_scalar_with_status (tree, tree, tree, bool, gfc_expr*,
 777                                         gfc_typespec, tree = NULL_TREE,
 778                                         bool c = false);
 779
 780 /* Generate code to call realloc().  */
 781 tree gfc_call_realloc (stmtblock_t *, tree, tree);
 782
 783 /* Assign a derived type constructor to a variable.  */
 784 tree gfc_trans_structure_assign (tree, gfc_expr *, bool, bool c = false);
 785
 786 /* Generate code for an assignment, includes scalarization.  */
 787 tree gfc_trans_assignment (gfc_expr *, gfc_expr *, bool, bool, bool p = false,
 788                            bool a = true);
 789
 790 /* Generate code for a pointer assignment.  */
 791 tree gfc_trans_pointer_assignment (gfc_expr *, gfc_expr *);
 792
 793 /* Initialize function decls for library functions.  */
 794 void gfc_build_intrinsic_lib_fndecls (void);
 795 /* Create function decls for IO library functions.  */
 796 void gfc_build_io_library_fndecls (void);
 797 /* Build a function decl for a library function.  */
 798 tree gfc_build_library_function_decl (tree, tree, int, ...);
 799 tree gfc_build_library_function_decl_with_spec (tree name, const char *spec,
 800                                                 tree rettype, int nargs, ...);
 801
 802 /* Process the local variable decls of a block construct.  */
 803 void gfc_process_block_locals (gfc_namespace*);
 804
 805 /* Output initialization/clean-up code that was deferred.  */
 806 void gfc_trans_deferred_vars (gfc_symbol*, gfc_wrapped_block *);
 807
 808 /* In f95-lang.cc.  */
 809 tree pushdecl (tree);
 810 tree pushdecl_top_level (tree);
 811 void pushlevel (void);
 812 tree poplevel (int, int);
 813 tree getdecls (void);
 814
 815 /* In trans-types.cc.  */
 816 struct array_descr_info;
 817 bool gfc_get_array_descr_info (const_tree, struct array_descr_info *);
 818
 819 /* In trans-openmp.cc */
 820 bool gfc_omp_is_allocatable_or_ptr (const_tree);
 821 tree gfc_omp_check_optional_argument (tree, bool);
 822 tree gfc_omp_array_data (tree, bool);
 823 tree gfc_omp_array_size (tree, gimple_seq *);
 824 bool gfc_omp_privatize_by_reference (const_tree);
 825 enum omp_clause_default_kind gfc_omp_predetermined_sharing (tree);
 826 enum omp_clause_defaultmap_kind gfc_omp_predetermined_mapping (tree);
 827 tree gfc_omp_report_decl (tree);
 828 tree gfc_omp_clause_default_ctor (tree, tree, tree);
 829 tree gfc_omp_clause_copy_ctor (tree, tree, tree);
 830 tree gfc_omp_clause_assign_op (tree, tree, tree);
 831 tree gfc_omp_clause_linear_ctor (tree, tree, tree, tree);
 832 tree gfc_omp_clause_dtor (tree, tree);
 833 void gfc_omp_finish_clause (tree, gimple_seq *, bool);
 834 bool gfc_omp_allocatable_p (tree);
 835 bool gfc_omp_scalar_p (tree, bool);
 836 bool gfc_omp_scalar_target_p (tree);
 837 bool gfc_omp_disregard_value_expr (tree, bool);
 838 bool gfc_omp_private_debug_clause (tree, bool);
 839 bool gfc_omp_private_outer_ref (tree);
 840 struct gimplify_omp_ctx;
 841 void gfc_omp_firstprivatize_type_sizes (struct gimplify_omp_ctx *, tree);
 842
 843 /* In trans-intrinsic.cc.  */
 844 void gfc_conv_intrinsic_mvbits (gfc_se *, gfc_actual_arglist *,
 845                                 gfc_loopinfo *);
 846
 847 /* Runtime library function decls.  */
 848 extern GTY(()) tree gfor_fndecl_pause_numeric;
 849 extern GTY(()) tree gfor_fndecl_pause_string;
 850 extern GTY(()) tree gfor_fndecl_stop_numeric;
 851 extern GTY(()) tree gfor_fndecl_stop_string;
 852 extern GTY(()) tree gfor_fndecl_error_stop_numeric;
 853 extern GTY(()) tree gfor_fndecl_error_stop_string;
 854 extern GTY(()) tree gfor_fndecl_runtime_error;
 855 extern GTY(()) tree gfor_fndecl_runtime_error_at;
 856 extern GTY(()) tree gfor_fndecl_runtime_warning_at;
 857 extern GTY(()) tree gfor_fndecl_os_error_at;
 858 extern GTY(()) tree gfor_fndecl_generate_error;
 859 extern GTY(()) tree gfor_fndecl_set_fpe;
 860 extern GTY(()) tree gfor_fndecl_set_options;
 861 extern GTY(()) tree gfor_fndecl_ttynam;
 862 extern GTY(()) tree gfor_fndecl_ctime;
 863 extern GTY(()) tree gfor_fndecl_fdate;
 864 extern GTY(()) tree gfor_fndecl_in_pack;
 865 extern GTY(()) tree gfor_fndecl_in_unpack;
 866 extern GTY(()) tree gfor_fndecl_associated;
 867 extern GTY(()) tree gfor_fndecl_system_clock4;
 868 extern GTY(()) tree gfor_fndecl_system_clock8;
 869
 870
 871 /* Coarray run-time library function decls.  */
 872 extern GTY(()) tree gfor_fndecl_caf_init;
 873 extern GTY(()) tree gfor_fndecl_caf_finalize;
 874 extern GTY(()) tree gfor_fndecl_caf_this_image;
 875 extern GTY(()) tree gfor_fndecl_caf_num_images;
 876 extern GTY(()) tree gfor_fndecl_caf_register;
 877 extern GTY(()) tree gfor_fndecl_caf_deregister;
 878 extern GTY(()) tree gfor_fndecl_caf_get;
 879 extern GTY(()) tree gfor_fndecl_caf_send;
 880 extern GTY(()) tree gfor_fndecl_caf_sendget;
 881 extern GTY(()) tree gfor_fndecl_caf_get_by_ref;
 882 extern GTY(()) tree gfor_fndecl_caf_send_by_ref;
 883 extern GTY(()) tree gfor_fndecl_caf_sendget_by_ref;
 884 extern GTY(()) tree gfor_fndecl_caf_sync_all;
 885 extern GTY(()) tree gfor_fndecl_caf_sync_memory;
 886 extern GTY(()) tree gfor_fndecl_caf_sync_images;
 887 extern GTY(()) tree gfor_fndecl_caf_stop_numeric;
 888 extern GTY(()) tree gfor_fndecl_caf_stop_str;
 889 extern GTY(()) tree gfor_fndecl_caf_error_stop;
 890 extern GTY(()) tree gfor_fndecl_caf_error_stop_str;
 891 extern GTY(()) tree gfor_fndecl_caf_atomic_def;
 892 extern GTY(()) tree gfor_fndecl_caf_atomic_ref;
 893 extern GTY(()) tree gfor_fndecl_caf_atomic_cas;
 894 extern GTY(()) tree gfor_fndecl_caf_atomic_op;
 895 extern GTY(()) tree gfor_fndecl_caf_lock;
 896 extern GTY(()) tree gfor_fndecl_caf_unlock;
 897 extern GTY(()) tree gfor_fndecl_caf_event_post;
 898 extern GTY(()) tree gfor_fndecl_caf_event_wait;
 899 extern GTY(()) tree gfor_fndecl_caf_event_query;
 900 extern GTY(()) tree gfor_fndecl_caf_fail_image;
 901 extern GTY(()) tree gfor_fndecl_caf_failed_images;
 902 extern GTY(()) tree gfor_fndecl_caf_image_status;
 903 extern GTY(()) tree gfor_fndecl_caf_stopped_images;
 904 extern GTY(()) tree gfor_fndecl_caf_form_team;
 905 extern GTY(()) tree gfor_fndecl_caf_change_team;
 906 extern GTY(()) tree gfor_fndecl_caf_end_team;
 907 extern GTY(()) tree gfor_fndecl_caf_get_team;
 908 extern GTY(()) tree gfor_fndecl_caf_sync_team;
 909 extern GTY(()) tree gfor_fndecl_caf_team_number;
 910 extern GTY(()) tree gfor_fndecl_co_broadcast;
 911 extern GTY(()) tree gfor_fndecl_co_max;
 912 extern GTY(()) tree gfor_fndecl_co_min;
 913 extern GTY(()) tree gfor_fndecl_co_reduce;
 914 extern GTY(()) tree gfor_fndecl_co_sum;
 915 extern GTY(()) tree gfor_fndecl_caf_is_present;
 916
 917 /* Math functions.  Many other math functions are handled in
 918    trans-intrinsic.cc.  */
 919
 920 typedef struct GTY(()) gfc_powdecl_list {
 921   tree integer;
 922   tree real;
 923   tree cmplx;
 924 }
 925 gfc_powdecl_list;
 926
 927 extern GTY(()) gfc_powdecl_list gfor_fndecl_math_powi[4][3];
 928 extern GTY(()) tree gfor_fndecl_math_ishftc4;
 929 extern GTY(()) tree gfor_fndecl_math_ishftc8;
 930 extern GTY(()) tree gfor_fndecl_math_ishftc16;
 931
 932 /* BLAS functions.  */
 933 extern GTY(()) tree gfor_fndecl_sgemm;
 934 extern GTY(()) tree gfor_fndecl_dgemm;
 935 extern GTY(()) tree gfor_fndecl_cgemm;
 936 extern GTY(()) tree gfor_fndecl_zgemm;
 937
 938 /* String functions.  */
 939 extern GTY(()) tree gfor_fndecl_compare_string;
 940 extern GTY(()) tree gfor_fndecl_concat_string;
 941 extern GTY(()) tree gfor_fndecl_string_len_trim;
 942 extern GTY(()) tree gfor_fndecl_string_index;
 943 extern GTY(()) tree gfor_fndecl_string_scan;
 944 extern GTY(()) tree gfor_fndecl_string_verify;
 945 extern GTY(()) tree gfor_fndecl_string_trim;
 946 extern GTY(()) tree gfor_fndecl_string_minmax;
 947 extern GTY(()) tree gfor_fndecl_adjustl;
 948 extern GTY(()) tree gfor_fndecl_adjustr;
 949 extern GTY(()) tree gfor_fndecl_select_string;
 950 extern GTY(()) tree gfor_fndecl_compare_string_char4;
 951 extern GTY(()) tree gfor_fndecl_concat_string_char4;
 952 extern GTY(()) tree gfor_fndecl_string_len_trim_char4;
 953 extern GTY(()) tree gfor_fndecl_string_index_char4;
 954 extern GTY(()) tree gfor_fndecl_string_scan_char4;
 955 extern GTY(()) tree gfor_fndecl_string_verify_char4;
 956 extern GTY(()) tree gfor_fndecl_string_trim_char4;
 957 extern GTY(()) tree gfor_fndecl_string_minmax_char4;
 958 extern GTY(()) tree gfor_fndecl_adjustl_char4;
 959 extern GTY(()) tree gfor_fndecl_adjustr_char4;
 960 extern GTY(()) tree gfor_fndecl_select_string_char4;
 961
 962 /* Conversion between character kinds.  */
 963 extern GTY(()) tree gfor_fndecl_convert_char1_to_char4;
 964 extern GTY(()) tree gfor_fndecl_convert_char4_to_char1;
 965
 966 /* Other misc. runtime library functions.  */
 967 extern GTY(()) tree gfor_fndecl_iargc;
 968 extern GTY(()) tree gfor_fndecl_kill;
 969 extern GTY(()) tree gfor_fndecl_kill_sub;
 970 extern GTY(()) tree gfor_fndecl_is_contiguous0;
 971
 972 /* Implemented in Fortran.  */
 973 extern GTY(()) tree gfor_fndecl_sc_kind;
 974 extern GTY(()) tree gfor_fndecl_si_kind;
 975 extern GTY(()) tree gfor_fndecl_sr_kind;
 976
 977 /* IEEE-related.  */
 978 extern GTY(()) tree gfor_fndecl_ieee_procedure_entry;
 979 extern GTY(()) tree gfor_fndecl_ieee_procedure_exit;
 980
 981 /* RANDOM_INIT.  */
 982 extern GTY(()) tree gfor_fndecl_random_init;
 983 extern GTY(()) tree gfor_fndecl_caf_random_init;
 984
 985 /* True if node is an integer constant.  */
 986 #define INTEGER_CST_P(node) (TREE_CODE(node) == INTEGER_CST)
 987
 988 /* gfortran-specific declaration information, the _CONT versions denote
 989    arrays with CONTIGUOUS attribute.  */
 990
 991 #define GFC_DTYPE_ELEM_LEN 0
 992 #define GFC_DTYPE_VERSION 1
 993 #define GFC_DTYPE_RANK 2
 994 #define GFC_DTYPE_TYPE 3
 995 #define GFC_DTYPE_ATTRIBUTE 4
 996
 997 enum gfc_array_kind
 998 {
 999   GFC_ARRAY_UNKNOWN,
1000   GFC_ARRAY_ASSUMED_SHAPE,
1001   GFC_ARRAY_ASSUMED_SHAPE_CONT,
1002   GFC_ARRAY_ASSUMED_RANK,
1003   GFC_ARRAY_ASSUMED_RANK_CONT,
1004   GFC_ARRAY_ALLOCATABLE,
1005   GFC_ARRAY_POINTER,
1006   GFC_ARRAY_POINTER_CONT
1007 };
1008
1009 /* Array types only.  */
1010 struct GTY(())  lang_type        {
1011   int rank, corank;
1012   enum gfc_array_kind akind;
1013   tree lbound[GFC_MAX_DIMENSIONS];
1014   tree ubound[GFC_MAX_DIMENSIONS];
1015   tree stride[GFC_MAX_DIMENSIONS];
1016   tree size;
1017   tree offset;
1018   tree dtype;
1019   tree dataptr_type;
1020   tree base_decl[2];
1021   tree nonrestricted_type;
1022   tree caf_token;
1023   tree caf_offset;
1024 };
1025
1026 struct GTY(()) lang_decl {
1027   /* Dummy variables.  */
1028   tree saved_descriptor;
1029   /* Assigned integer nodes.  Stringlength is the IO format string's length.
1030      Addr is the address of the string or the target label. Stringlength is
1031      initialized to -2 and assigned to -1 when addr is assigned to the
1032      address of target label.  */
1033   tree stringlen;
1034   tree addr;
1035   /* For assumed-shape coarrays.  */
1036   tree token, caf_offset;
1037   unsigned int scalar_allocatable : 1;
1038   unsigned int scalar_pointer : 1;
1039   unsigned int scalar_target : 1;
1040   unsigned int optional_arg : 1;
1041 };
1042
1043
1044 #define GFC_DECL_ASSIGN_ADDR(node) DECL_LANG_SPECIFIC(node)->addr
1045 #define GFC_DECL_STRING_LEN(node) DECL_LANG_SPECIFIC(node)->stringlen
1046 #define GFC_DECL_TOKEN(node) DECL_LANG_SPECIFIC(node)->token
1047 #define GFC_DECL_CAF_OFFSET(node) DECL_LANG_SPECIFIC(node)->caf_offset
1048 #define GFC_DECL_SAVED_DESCRIPTOR(node) \
1049   (DECL_LANG_SPECIFIC(node)->saved_descriptor)
1050 #define GFC_DECL_SCALAR_ALLOCATABLE(node) \
1051   (DECL_LANG_SPECIFIC (node)->scalar_allocatable)
1052 #define GFC_DECL_SCALAR_POINTER(node) \
1053   (DECL_LANG_SPECIFIC (node)->scalar_pointer)
1054 #define GFC_DECL_SCALAR_TARGET(node) \
1055   (DECL_LANG_SPECIFIC (node)->scalar_target)
1056 #define GFC_DECL_OPTIONAL_ARGUMENT(node) \
1057   (DECL_LANG_SPECIFIC (node)->optional_arg)
1058 #define GFC_DECL_GET_SCALAR_ALLOCATABLE(node) \
1059   (DECL_LANG_SPECIFIC (node) ? GFC_DECL_SCALAR_ALLOCATABLE (node) : 0)
1060 #define GFC_DECL_GET_SCALAR_POINTER(node) \
1061   (DECL_LANG_SPECIFIC (node) ? GFC_DECL_SCALAR_POINTER (node) : 0)
1062 #define GFC_DECL_GET_SCALAR_TARGET(node) \
1063   (DECL_LANG_SPECIFIC (node) ? GFC_DECL_SCALAR_TARGET (node) : 0)
1064 #define GFC_DECL_PACKED_ARRAY(node) DECL_LANG_FLAG_0(node)
1065 #define GFC_DECL_PARTIAL_PACKED_ARRAY(node) DECL_LANG_FLAG_1(node)
1066 #define GFC_DECL_ASSIGN(node) DECL_LANG_FLAG_2(node)
1067 #define GFC_DECL_COMMON_OR_EQUIV(node) DECL_LANG_FLAG_3(node)
1068 #define GFC_DECL_CRAY_POINTEE(node) DECL_LANG_FLAG_4(node)
1069 #define GFC_DECL_RESULT(node) DECL_LANG_FLAG_5(node)
1070 #define GFC_DECL_PTR_ARRAY_P(node) DECL_LANG_FLAG_6(node)
1071 #define GFC_DECL_ASSOCIATE_VAR_P(node) DECL_LANG_FLAG_7(node)
1072 #define GFC_DECL_CLASS(node) DECL_LANG_FLAG_8(node)
1073
1074 /* An array descriptor.  */
1075 #define GFC_DESCRIPTOR_TYPE_P(node) TYPE_LANG_FLAG_1(node)
1076 /* An array without a descriptor.  */
1077 #define GFC_ARRAY_TYPE_P(node) TYPE_LANG_FLAG_2(node)
1078 /* Fortran CLASS type.  */
1079 #define GFC_CLASS_TYPE_P(node) TYPE_LANG_FLAG_4(node)
1080 /* The GFC_TYPE_ARRAY_* members are present in both descriptor and
1081    descriptorless array types.  */
1082 #define GFC_TYPE_ARRAY_LBOUND(node, dim) \
1083   (TYPE_LANG_SPECIFIC(node)->lbound[dim])
1084 #define GFC_TYPE_ARRAY_UBOUND(node, dim) \
1085   (TYPE_LANG_SPECIFIC(node)->ubound[dim])
1086 #define GFC_TYPE_ARRAY_STRIDE(node, dim) \
1087   (TYPE_LANG_SPECIFIC(node)->stride[dim])
1088 #define GFC_TYPE_ARRAY_RANK(node) (TYPE_LANG_SPECIFIC(node)->rank)
1089 #define GFC_TYPE_ARRAY_CORANK(node) (TYPE_LANG_SPECIFIC(node)->corank)
1090 #define GFC_TYPE_ARRAY_CAF_TOKEN(node) (TYPE_LANG_SPECIFIC(node)->caf_token)
1091 #define GFC_TYPE_ARRAY_CAF_OFFSET(node) (TYPE_LANG_SPECIFIC(node)->caf_offset)
1092 #define GFC_TYPE_ARRAY_SIZE(node) (TYPE_LANG_SPECIFIC(node)->size)
1093 #define GFC_TYPE_ARRAY_OFFSET(node) (TYPE_LANG_SPECIFIC(node)->offset)
1094 #define GFC_TYPE_ARRAY_AKIND(node) (TYPE_LANG_SPECIFIC(node)->akind)
1095 /* Code should use gfc_get_dtype instead of accessing this directly.  It may
1096    not be known when the type is created.  */
1097 #define GFC_TYPE_ARRAY_DTYPE(node) (TYPE_LANG_SPECIFIC(node)->dtype)
1098 #define GFC_TYPE_ARRAY_DATAPTR_TYPE(node) \
1099   (TYPE_LANG_SPECIFIC(node)->dataptr_type)
1100 #define GFC_TYPE_ARRAY_BASE_DECL(node, internal) \
1101   (TYPE_LANG_SPECIFIC(node)->base_decl[(internal)])
1102
1103
1104 /* Build an expression with void type.  */
1105 #define build1_v(code, arg) \
1106         fold_build1_loc (input_location, code, void_type_node, arg)
1107 #define build2_v(code, arg1, arg2) \
1108         fold_build2_loc (input_location, code, void_type_node, arg1, arg2)
1109 #define build3_v(code, arg1, arg2, arg3) \
1110         fold_build3_loc (input_location, code, void_type_node, arg1, arg2, arg3)
1111 #define build4_v(code, arg1, arg2, arg3, arg4) \
1112         build4_loc (input_location, code, void_type_node, arg1, arg2, \
1113                     arg3, arg4)
1114
1115 /* This group of functions allows a caller to evaluate an expression from
1116    the callee's interface.  It establishes a mapping between the interface's
1117    dummy arguments and the caller's actual arguments, then applies that
1118    mapping to a given gfc_expr.
1119
1120    You can initialize a mapping structure like so:
1121
1122        gfc_interface_mapping mapping;
1123        ...
1124        gfc_init_interface_mapping (&mapping);
1125
1126    You should then evaluate each actual argument into a temporary
1127    gfc_se structure, here called "se", and map the result to the
1128    dummy argument's symbol, here called "sym":
1129
1130        gfc_add_interface_mapping (&mapping, sym, &se);
1131
1132    After adding all mappings, you should call:
1133
1134        gfc_finish_interface_mapping (&mapping, pre, post);
1135
1136    where "pre" and "post" are statement blocks for initialization
1137    and finalization code respectively.  You can then evaluate an
1138    interface expression "expr" as follows:
1139
1140        gfc_apply_interface_mapping (&mapping, se, expr);
1141
1142    Once you've evaluated all expressions, you should free
1143    the mapping structure with:
1144
1145        gfc_free_interface_mapping (&mapping); */
1146
1147
1148 /* This structure represents a mapping from OLD to NEW, where OLD is a
1149    dummy argument symbol and NEW is a symbol that represents the value
1150    of an actual argument.  Mappings are linked together using NEXT
1151    (in no particular order).  */
1152 typedef struct gfc_interface_sym_mapping
1153 {
1154   struct gfc_interface_sym_mapping *next;
1155   gfc_symbol *old;
1156   gfc_symtree *new_sym;
1157   gfc_expr *expr;
1158 }
1159 gfc_interface_sym_mapping;
1160
1161
1162 /* This structure is used by callers to evaluate an expression from
1163    a callee's interface.  */
1164 typedef struct gfc_interface_mapping
1165 {
1166   /* Maps the interface's dummy arguments to the values that the caller
1167      is passing.  The whole list is owned by this gfc_interface_mapping.  */
1168   gfc_interface_sym_mapping *syms;
1169
1170   /* A list of gfc_charlens that were needed when creating copies of
1171      expressions.  The whole list is owned by this gfc_interface_mapping.  */
1172   gfc_charlen *charlens;
1173 }
1174 gfc_interface_mapping;
1175
1176 void gfc_init_interface_mapping (gfc_interface_mapping *);
1177 void gfc_free_interface_mapping (gfc_interface_mapping *);
1178 void gfc_add_interface_mapping (gfc_interface_mapping *,
1179                                 gfc_symbol *, gfc_se *, gfc_expr *);
1180 void gfc_apply_interface_mapping (gfc_interface_mapping *,
1181                                   gfc_se *, gfc_expr *);
1182
1183
1184 /* Standard error messages used in all the trans-*.c files.  */
1185 extern const char gfc_msg_fault[];
1186
1187 #define OMPWS_WORKSHARE_FLAG    1       /* Set if in a workshare construct.  */
1188 #define OMPWS_CURR_SINGLEUNIT   2       /* Set if current gfc_code in workshare
1189                                            construct is not workshared.  */
1190 #define OMPWS_SCALARIZER_WS     4       /* Set if scalarizer should attempt
1191                                            to create parallel loops.  */
1192 #define OMPWS_SCALARIZER_BODY   8       /* Set if handling body of potential
1193                                            parallel loop.  */
1194 #define OMPWS_NOWAIT            16      /* Use NOWAIT on OMP_FOR.  */
1195 extern int ompws_flags;
1196
1197 #endif /* GFC_TRANS_H */