gcc/fortran/trans.h

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