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