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