procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/44709 (BLOCK and GOTO/EXIT/CYCLE)

Browse source 
2010-07-15  Daniel Kraft  <d@domob.eu>

	PR fortran/44709
	* trans.h (struct gfc_wrapped_block): New struct.
	(gfc_start_wrapped_block), (gfc_add_init_cleanup): New methods.
	(gfc_finish_wrapped_block): New method.
	(gfc_init_default_dt): Add new init code to block rather than
	returning it.
	* trans-array.h (gfc_trans_auto_array_allocation): Use gfc_wrapped_block
	(gfc_trans_dummy_array_bias): Ditto.
	(gfc_trans_g77_array): Ditto.
	(gfc_trans_deferred_array): Ditto.
	* trans.c (gfc_add_expr_to_block): Call add_expr_to_chain.
	(add_expr_to_chain): New method based on old gfc_add_expr_to_block.
	(gfc_start_wrapped_block), (gfc_add_init_cleanup): New methods.
	(gfc_finish_wrapped_block): New method.
	* trans-array.c (gfc_trans_auto_array_allocation): use gfc_wrapped_block
	(gfc_trans_g77_array), (gfc_trans_dummy_array_bias): Ditto.
	(gfc_trans_deferred_array): Ditto.
	* trans-decl.c (gfc_trans_dummy_character): Ditto.
	(gfc_trans_auto_character_variable), (gfc_trans_assign_aux_var): Ditto.
	(init_intent_out_dt): Ditto.
	(gfc_init_default_dt): Add new init code to block rather than
	returning it.
	(gfc_trans_deferred_vars): Use gfc_wrapped_block to collect all init
	and cleanup code and put it all together.

From-SVN: r162219
This commit is contained in:
Daniel Kraft 2010-07-15 14:23:47 +02:00 • committed by Daniel Kraft
parent f644b3d1af
commit 0019d49828
6 changed files with 366 additions and 255 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

27
gcc/fortran/ChangeLog
View file

@ -1,3 +1,30 @@
2010-07-15 Daniel Kraft <d@domob.eu>
PR fortran/44709
* trans.h (struct gfc_wrapped_block): New struct.
(gfc_start_wrapped_block), (gfc_add_init_cleanup): New methods.
(gfc_finish_wrapped_block): New method.
(gfc_init_default_dt): Add new init code to block rather than
returning it.
* trans-array.h (gfc_trans_auto_array_allocation): Use gfc_wrapped_block
(gfc_trans_dummy_array_bias): Ditto.
(gfc_trans_g77_array): Ditto.
(gfc_trans_deferred_array): Ditto.
* trans.c (gfc_add_expr_to_block): Call add_expr_to_chain.
(add_expr_to_chain): New method based on old gfc_add_expr_to_block.
(gfc_start_wrapped_block), (gfc_add_init_cleanup): New methods.
(gfc_finish_wrapped_block): New method.
* trans-array.c (gfc_trans_auto_array_allocation): use gfc_wrapped_block
(gfc_trans_g77_array), (gfc_trans_dummy_array_bias): Ditto.
(gfc_trans_deferred_array): Ditto.
* trans-decl.c (gfc_trans_dummy_character): Ditto.
(gfc_trans_auto_character_variable), (gfc_trans_assign_aux_var): Ditto.
(init_intent_out_dt): Ditto.
(gfc_init_default_dt): Add new init code to block rather than
returning it.
(gfc_trans_deferred_vars): Use gfc_wrapped_block to collect all init
and cleanup code and put it all together.
2010-07-15 Jakub Jelinek <jakub@redhat.com>
* trans.h (gfc_build_compare_string): Add CODE argument.

297
gcc/fortran/trans-array.c
View file

@ -4265,10 +4265,11 @@ gfc_trans_array_bounds (tree type, gfc_symbol * sym, tree * poffset,
/* Generate code to initialize/allocate an array variable. */
tree
gfc_trans_auto_array_allocation (tree decl, gfc_symbol * sym, tree fnbody)
void
gfc_trans_auto_array_allocation (tree decl, gfc_symbol * sym,
gfc_wrapped_block * block)
{
stmtblock_t block;
stmtblock_t init;
tree type;
tree tmp;
tree size;
@ -4279,32 +4280,32 @@ gfc_trans_auto_array_allocation (tree decl, gfc_symbol * sym, tree fnbody)
/* Do nothing for USEd variables. */
if (sym->attr.use_assoc)
return fnbody;
return;
type = TREE_TYPE (decl);
gcc_assert (GFC_ARRAY_TYPE_P (type));
onstack = TREE_CODE (type) != POINTER_TYPE;
gfc_start_block (&block);
gfc_start_block (&init);
/* Evaluate character string length. */
if (sym->ts.type == BT_CHARACTER
&& onstack && !INTEGER_CST_P (sym->ts.u.cl->backend_decl))
{
gfc_conv_string_length (sym->ts.u.cl, NULL, &block);
gfc_conv_string_length (sym->ts.u.cl, NULL, &init);
gfc_trans_vla_type_sizes (sym, &block);
gfc_trans_vla_type_sizes (sym, &init);
/* Emit a DECL_EXPR for this variable, which will cause the
gimplifier to allocate storage, and all that good stuff. */
tmp = fold_build1 (DECL_EXPR, TREE_TYPE (decl), decl);
gfc_add_expr_to_block (&block, tmp);
gfc_add_expr_to_block (&init, tmp);
}
if (onstack)
{
gfc_add_expr_to_block (&block, fnbody);
return gfc_finish_block (&block);
gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE);
return;
}
type = TREE_TYPE (type);
@ -4315,17 +4316,18 @@ gfc_trans_auto_array_allocation (tree decl, gfc_symbol * sym, tree fnbody)
if (sym->ts.type == BT_CHARACTER
&& !INTEGER_CST_P (sym->ts.u.cl->backend_decl))
gfc_conv_string_length (sym->ts.u.cl, NULL, &block);
gfc_conv_string_length (sym->ts.u.cl, NULL, &init);
size = gfc_trans_array_bounds (type, sym, &offset, &block);
size = gfc_trans_array_bounds (type, sym, &offset, &init);
/* Don't actually allocate space for Cray Pointees. */
if (sym->attr.cray_pointee)
{
if (TREE_CODE (GFC_TYPE_ARRAY_OFFSET (type)) == VAR_DECL)
gfc_add_modify (&block, GFC_TYPE_ARRAY_OFFSET (type), offset);
gfc_add_expr_to_block (&block, fnbody);
return gfc_finish_block (&block);
gfc_add_modify (&init, GFC_TYPE_ARRAY_OFFSET (type), offset);
gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE);
return;
}
/* The size is the number of elements in the array, so multiply by the
@ -4335,31 +4337,27 @@ gfc_trans_auto_array_allocation (tree decl, gfc_symbol * sym, tree fnbody)
fold_convert (gfc_array_index_type, tmp));
/* Allocate memory to hold the data. */
tmp = gfc_call_malloc (&block, TREE_TYPE (decl), size);
gfc_add_modify (&block, decl, tmp);
tmp = gfc_call_malloc (&init, TREE_TYPE (decl), size);
gfc_add_modify (&init, decl, tmp);
/* Set offset of the array. */
if (TREE_CODE (GFC_TYPE_ARRAY_OFFSET (type)) == VAR_DECL)
gfc_add_modify (&block, GFC_TYPE_ARRAY_OFFSET (type), offset);
gfc_add_modify (&init, GFC_TYPE_ARRAY_OFFSET (type), offset);
/* Automatic arrays should not have initializers. */
gcc_assert (!sym->value);
gfc_add_expr_to_block (&block, fnbody);
/* Free the temporary. */
tmp = gfc_call_free (convert (pvoid_type_node, decl));
gfc_add_expr_to_block (&block, tmp);
return gfc_finish_block (&block);
gfc_add_init_cleanup (block, gfc_finish_block (&init), tmp);
}
/* Generate entry and exit code for g77 calling convention arrays. */
tree
gfc_trans_g77_array (gfc_symbol * sym, tree body)
void
gfc_trans_g77_array (gfc_symbol * sym, gfc_wrapped_block * block)
{
tree parm;
tree type;
@ -4367,7 +4365,7 @@ gfc_trans_g77_array (gfc_symbol * sym, tree body)
tree offset;
tree tmp;
tree stmt;
stmtblock_t block;
stmtblock_t init;
gfc_get_backend_locus (&loc);
gfc_set_backend_locus (&sym->declared_at);
@ -4377,31 +4375,29 @@ gfc_trans_g77_array (gfc_symbol * sym, tree body)
type = TREE_TYPE (parm);
gcc_assert (GFC_ARRAY_TYPE_P (type));
gfc_start_block (&block);
gfc_start_block (&init);
if (sym->ts.type == BT_CHARACTER
&& TREE_CODE (sym->ts.u.cl->backend_decl) == VAR_DECL)
gfc_conv_string_length (sym->ts.u.cl, NULL, &block);
gfc_conv_string_length (sym->ts.u.cl, NULL, &init);
/* Evaluate the bounds of the array. */
gfc_trans_array_bounds (type, sym, &offset, &block);
gfc_trans_array_bounds (type, sym, &offset, &init);
/* Set the offset. */
if (TREE_CODE (GFC_TYPE_ARRAY_OFFSET (type)) == VAR_DECL)
gfc_add_modify (&block, GFC_TYPE_ARRAY_OFFSET (type), offset);
gfc_add_modify (&init, GFC_TYPE_ARRAY_OFFSET (type), offset);
/* Set the pointer itself if we aren't using the parameter directly. */
if (TREE_CODE (parm) != PARM_DECL)
{
tmp = convert (TREE_TYPE (parm), GFC_DECL_SAVED_DESCRIPTOR (parm));
gfc_add_modify (&block, parm, tmp);
gfc_add_modify (&init, parm, tmp);
}
stmt = gfc_finish_block (&block);
stmt = gfc_finish_block (&init);
gfc_set_backend_locus (&loc);
gfc_start_block (&block);
/* Add the initialization code to the start of the function. */
if (sym->attr.optional || sym->attr.not_always_present)
@ -4410,10 +4406,7 @@ gfc_trans_g77_array (gfc_symbol * sym, tree body)
stmt = build3_v (COND_EXPR, tmp, stmt, build_empty_stmt (input_location));
}
gfc_add_expr_to_block (&block, stmt);
gfc_add_expr_to_block (&block, body);
return gfc_finish_block (&block);
gfc_add_init_cleanup (block, stmt, NULL_TREE);
}
@ -4428,22 +4421,22 @@ gfc_trans_g77_array (gfc_symbol * sym, tree body)
Code is also added to copy the data back at the end of the function.
*/
tree
gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body)
void
gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc,
gfc_wrapped_block * block)
{
tree size;
tree type;
tree offset;
locus loc;
stmtblock_t block;
stmtblock_t cleanup;
stmtblock_t init;
tree stmtInit, stmtCleanup;
tree lbound;
tree ubound;
tree dubound;
tree dlbound;
tree dumdesc;
tree tmp;
tree stmt;
tree stride, stride2;
tree stmt_packed;
tree stmt_unpacked;
@ -4456,10 +4449,13 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body)
/* Do nothing for pointer and allocatable arrays. */
if (sym->attr.pointer || sym->attr.allocatable)
return body;
return;
if (sym->attr.dummy && gfc_is_nodesc_array (sym))
return gfc_trans_g77_array (sym, body);
{
gfc_trans_g77_array (sym, block);
return;
}
gfc_get_backend_locus (&loc);
gfc_set_backend_locus (&sym->declared_at);
@ -4468,35 +4464,32 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body)
type = TREE_TYPE (tmpdesc);
gcc_assert (GFC_ARRAY_TYPE_P (type));
dumdesc = GFC_DECL_SAVED_DESCRIPTOR (tmpdesc);
dumdesc = build_fold_indirect_ref_loc (input_location,
dumdesc);
gfc_start_block (&block);
dumdesc = build_fold_indirect_ref_loc (input_location, dumdesc);
gfc_start_block (&init);
if (sym->ts.type == BT_CHARACTER
&& TREE_CODE (sym->ts.u.cl->backend_decl) == VAR_DECL)
gfc_conv_string_length (sym->ts.u.cl, NULL, &block);
gfc_conv_string_length (sym->ts.u.cl, NULL, &init);
checkparm = (sym->as->type == AS_EXPLICIT
&& (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS));
no_repack = !(GFC_DECL_PACKED_ARRAY (tmpdesc)
|| GFC_DECL_PARTIAL_PACKED_ARRAY (tmpdesc));
|| GFC_DECL_PARTIAL_PACKED_ARRAY (tmpdesc));
if (GFC_DECL_PARTIAL_PACKED_ARRAY (tmpdesc))
{
/* For non-constant shape arrays we only check if the first dimension
is contiguous. Repacking higher dimensions wouldn't gain us
anything as we still don't know the array stride. */
is contiguous. Repacking higher dimensions wouldn't gain us
anything as we still don't know the array stride. */
partial = gfc_create_var (boolean_type_node, "partial");
TREE_USED (partial) = 1;
tmp = gfc_conv_descriptor_stride_get (dumdesc, gfc_rank_cst[0]);
tmp = fold_build2 (EQ_EXPR, boolean_type_node, tmp, gfc_index_one_node);
gfc_add_modify (&block, partial, tmp);
gfc_add_modify (&init, partial, tmp);
}
else
{
partial = NULL_TREE;
}
partial = NULL_TREE;
/* The naming of stmt_unpacked and stmt_packed may be counter-intuitive
here, however I think it does the right thing. */
@ -4504,14 +4497,14 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body)
{
/* Set the first stride. */
stride = gfc_conv_descriptor_stride_get (dumdesc, gfc_rank_cst[0]);
stride = gfc_evaluate_now (stride, &block);
stride = gfc_evaluate_now (stride, &init);
tmp = fold_build2 (EQ_EXPR, boolean_type_node,
stride, gfc_index_zero_node);
tmp = fold_build3 (COND_EXPR, gfc_array_index_type, tmp,
gfc_index_one_node, stride);
stride = GFC_TYPE_ARRAY_STRIDE (type, 0);
gfc_add_modify (&block, stride, tmp);
gfc_add_modify (&init, stride, tmp);
/* Allow the user to disable array repacking. */
stmt_unpacked = NULL_TREE;
@ -4546,7 +4539,7 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body)
}
else
tmp = stmt_packed != NULL_TREE ? stmt_packed : stmt_unpacked;
gfc_add_modify (&block, tmpdesc, fold_convert (type, tmp));
gfc_add_modify (&init, tmpdesc, fold_convert (type, tmp));
offset = gfc_index_zero_node;
size = gfc_index_one_node;
@ -4561,34 +4554,34 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body)
dlbound = gfc_conv_descriptor_lbound_get (dumdesc, gfc_rank_cst[n]);
}
else
{
{
dubound = NULL_TREE;
dlbound = NULL_TREE;
}
}
lbound = GFC_TYPE_ARRAY_LBOUND (type, n);
if (!INTEGER_CST_P (lbound))
{
gfc_init_se (&se, NULL);
gfc_conv_expr_type (&se, sym->as->lower[n],
gfc_array_index_type);
gfc_add_block_to_block (&block, &se.pre);
gfc_add_modify (&block, lbound, se.expr);
}
{
gfc_init_se (&se, NULL);
gfc_conv_expr_type (&se, sym->as->lower[n],
gfc_array_index_type);
gfc_add_block_to_block (&init, &se.pre);
gfc_add_modify (&init, lbound, se.expr);
}
ubound = GFC_TYPE_ARRAY_UBOUND (type, n);
/* Set the desired upper bound. */
if (sym->as->upper[n])
{
/* We know what we want the upper bound to be. */
if (!INTEGER_CST_P (ubound))
{
if (!INTEGER_CST_P (ubound))
{
gfc_init_se (&se, NULL);
gfc_conv_expr_type (&se, sym->as->upper[n],
gfc_array_index_type);
gfc_add_block_to_block (&block, &se.pre);
gfc_add_modify (&block, ubound, se.expr);
}
gfc_array_index_type);
gfc_add_block_to_block (&init, &se.pre);
gfc_add_modify (&init, ubound, se.expr);
}
/* Check the sizes match. */
if (checkparm)
@ -4607,11 +4600,11 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body)
stride2 = fold_build2 (PLUS_EXPR, gfc_array_index_type,
gfc_index_one_node, stride2);
tmp = fold_build2 (NE_EXPR, gfc_array_index_type, temp, stride2);
tmp = fold_build2 (NE_EXPR, gfc_array_index_type, temp, stride2);
asprintf (&msg, "Dimension %d of array '%s' has extent "
"%%ld instead of %%ld", n+1, sym->name);
"%%ld instead of %%ld", n+1, sym->name);
gfc_trans_runtime_check (true, false, tmp, &block, &loc, msg,
gfc_trans_runtime_check (true, false, tmp, &init, &loc, msg,
fold_convert (long_integer_type_node, temp),
fold_convert (long_integer_type_node, stride2));
@ -4622,10 +4615,10 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body)
{
/* For assumed shape arrays move the upper bound by the same amount
as the lower bound. */
tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type,
tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type,
dubound, dlbound);
tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, tmp, lbound);
gfc_add_modify (&block, ubound, tmp);
tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, tmp, lbound);
gfc_add_modify (&init, ubound, tmp);
}
/* The offset of this dimension. offset = offset - lbound * stride. */
tmp = fold_build2 (MULT_EXPR, gfc_array_index_type, lbound, stride);
@ -4633,41 +4626,39 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body)
/* The size of this dimension, and the stride of the next. */
if (n + 1 < sym->as->rank)
{
stride = GFC_TYPE_ARRAY_STRIDE (type, n + 1);
{
stride = GFC_TYPE_ARRAY_STRIDE (type, n + 1);
if (no_repack || partial != NULL_TREE)
{
stmt_unpacked =
gfc_conv_descriptor_stride_get (dumdesc, gfc_rank_cst[n+1]);
}
if (no_repack || partial != NULL_TREE)
stmt_unpacked =
gfc_conv_descriptor_stride_get (dumdesc, gfc_rank_cst[n+1]);
/* Figure out the stride if not a known constant. */
if (!INTEGER_CST_P (stride))
{
if (no_repack)
stmt_packed = NULL_TREE;
else
{
/* Calculate stride = size * (ubound + 1 - lbound). */
tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type,
/* Figure out the stride if not a known constant. */
if (!INTEGER_CST_P (stride))
{
if (no_repack)
stmt_packed = NULL_TREE;
else
{
/* Calculate stride = size * (ubound + 1 - lbound). */
tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type,
gfc_index_one_node, lbound);
tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type,
tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type,
ubound, tmp);
size = fold_build2 (MULT_EXPR, gfc_array_index_type,
size = fold_build2 (MULT_EXPR, gfc_array_index_type,
size, tmp);
stmt_packed = size;
}
stmt_packed = size;
}
/* Assign the stride. */
if (stmt_packed != NULL_TREE && stmt_unpacked != NULL_TREE)
/* Assign the stride. */
if (stmt_packed != NULL_TREE && stmt_unpacked != NULL_TREE)
tmp = fold_build3 (COND_EXPR, gfc_array_index_type, partial,
stmt_unpacked, stmt_packed);
else
tmp = (stmt_packed != NULL_TREE) ? stmt_packed : stmt_unpacked;
gfc_add_modify (&block, stride, tmp);
}
}
else
tmp = (stmt_packed != NULL_TREE) ? stmt_packed : stmt_unpacked;
gfc_add_modify (&init, stride, tmp);
}
}
else
{
stride = GFC_TYPE_ARRAY_SIZE (type);
@ -4681,20 +4672,18 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body)
ubound, tmp);
tmp = fold_build2 (MULT_EXPR, gfc_array_index_type,
GFC_TYPE_ARRAY_STRIDE (type, n), tmp);
gfc_add_modify (&block, stride, tmp);
gfc_add_modify (&init, stride, tmp);
}
}
}
/* Set the offset. */
if (TREE_CODE (GFC_TYPE_ARRAY_OFFSET (type)) == VAR_DECL)
gfc_add_modify (&block, GFC_TYPE_ARRAY_OFFSET (type), offset);
gfc_add_modify (&init, GFC_TYPE_ARRAY_OFFSET (type), offset);
gfc_trans_vla_type_sizes (sym, &block);
gfc_trans_vla_type_sizes (sym, &init);
stmt = gfc_finish_block (&block);
gfc_start_block (&block);
stmtInit = gfc_finish_block (&init);
/* Only do the entry/initialization code if the arg is present. */
dumdesc = GFC_DECL_SAVED_DESCRIPTOR (tmpdesc);
@ -4704,18 +4693,18 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body)
if (optional_arg)
{
tmp = gfc_conv_expr_present (sym);
stmt = build3_v (COND_EXPR, tmp, stmt, build_empty_stmt (input_location));
stmtInit = build3_v (COND_EXPR, tmp, stmtInit,
build_empty_stmt (input_location));
}
gfc_add_expr_to_block (&block, stmt);
/* Add the main function body. */
gfc_add_expr_to_block (&block, body);
/* Cleanup code. */
if (!no_repack)
if (no_repack)
stmtCleanup = NULL_TREE;
else
{
stmtblock_t cleanup;
gfc_start_block (&cleanup);
if (sym->attr.intent != INTENT_IN)
{
/* Copy the data back. */
@ -4728,26 +4717,26 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body)
tmp = gfc_call_free (tmpdesc);
gfc_add_expr_to_block (&cleanup, tmp);
stmt = gfc_finish_block (&cleanup);
stmtCleanup = gfc_finish_block (&cleanup);
/* Only do the cleanup if the array was repacked. */
tmp = build_fold_indirect_ref_loc (input_location,
dumdesc);
tmp = build_fold_indirect_ref_loc (input_location, dumdesc);
tmp = gfc_conv_descriptor_data_get (tmp);
tmp = fold_build2 (NE_EXPR, boolean_type_node, tmp, tmpdesc);
stmt = build3_v (COND_EXPR, tmp, stmt, build_empty_stmt (input_location));
stmtCleanup = build3_v (COND_EXPR, tmp, stmtCleanup,
build_empty_stmt (input_location));
if (optional_arg)
{
tmp = gfc_conv_expr_present (sym);
stmt = build3_v (COND_EXPR, tmp, stmt,
build_empty_stmt (input_location));
}
gfc_add_expr_to_block (&block, stmt);
{
tmp = gfc_conv_expr_present (sym);
stmtCleanup = build3_v (COND_EXPR, tmp, stmtCleanup,
build_empty_stmt (input_location));
}
}
/* We don't need to free any memory allocated by internal_pack as it will
be freed at the end of the function by pop_context. */
return gfc_finish_block (&block);
gfc_add_init_cleanup (block, stmtInit, stmtCleanup);
}
@ -6217,13 +6206,14 @@ gfc_copy_only_alloc_comp (gfc_symbol * der_type, tree decl, tree dest, int rank)
Do likewise, recursively if necessary, with the allocatable components of
derived types. */
tree
gfc_trans_deferred_array (gfc_symbol * sym, tree body)
void
gfc_trans_deferred_array (gfc_symbol * sym, gfc_wrapped_block * block)
{
tree type;
tree tmp;
tree descriptor;
stmtblock_t fnblock;
stmtblock_t init;
stmtblock_t cleanup;
locus loc;
int rank;
bool sym_has_alloc_comp;
@ -6237,7 +6227,7 @@ gfc_trans_deferred_array (gfc_symbol * sym, tree body)
"allocatable attribute or derived type without allocatable "
"components.");
gfc_init_block (&fnblock);
gfc_init_block (&init);
gcc_assert (TREE_CODE (sym->backend_decl) == VAR_DECL
|| TREE_CODE (sym->backend_decl) == PARM_DECL);
@ -6245,16 +6235,15 @@ gfc_trans_deferred_array (gfc_symbol * sym, tree body)
if (sym->ts.type == BT_CHARACTER
&& !INTEGER_CST_P (sym->ts.u.cl->backend_decl))
{
gfc_conv_string_length (sym->ts.u.cl, NULL, &fnblock);
gfc_trans_vla_type_sizes (sym, &fnblock);
gfc_conv_string_length (sym->ts.u.cl, NULL, &init);
gfc_trans_vla_type_sizes (sym, &init);
}
/* Dummy, use associated and result variables don't need anything special. */
if (sym->attr.dummy || sym->attr.use_assoc || sym->attr.result)
{
gfc_add_expr_to_block (&fnblock, body);
return gfc_finish_block (&fnblock);
gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE);
return;
}
gfc_get_backend_locus (&loc);
@ -6268,7 +6257,9 @@ gfc_trans_deferred_array (gfc_symbol * sym, tree body)
{
/* SAVEd variables are not freed on exit. */
gfc_trans_static_array_pointer (sym);
return body;
gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE);
return;
}
/* Get the descriptor type. */
@ -6283,14 +6274,12 @@ gfc_trans_deferred_array (gfc_symbol * sym, tree body)
|| !gfc_has_default_initializer (sym->ts.u.derived))
{
rank = sym->as ? sym->as->rank : 0;
tmp = gfc_nullify_alloc_comp (sym->ts.u.derived, descriptor, rank);
gfc_add_expr_to_block (&fnblock, tmp);
tmp = gfc_nullify_alloc_comp (sym->ts.u.derived,
descriptor, rank);
gfc_add_expr_to_block (&init, tmp);
}
else
{
tmp = gfc_init_default_dt (sym, NULL, false);
gfc_add_expr_to_block (&fnblock, tmp);
}
gfc_init_default_dt (sym, &init, false);
}
}
else if (!GFC_DESCRIPTOR_TYPE_P (type))
@ -6298,16 +6287,15 @@ gfc_trans_deferred_array (gfc_symbol * sym, tree body)
/* If the backend_decl is not a descriptor, we must have a pointer
to one. */
descriptor = build_fold_indirect_ref_loc (input_location,
sym->backend_decl);
sym->backend_decl);
type = TREE_TYPE (descriptor);
}
/* NULLIFY the data pointer. */
if (GFC_DESCRIPTOR_TYPE_P (type) && !sym->attr.save)
gfc_conv_descriptor_data_set (&fnblock, descriptor, null_pointer_node);
gfc_add_expr_to_block (&fnblock, body);
gfc_conv_descriptor_data_set (&init, descriptor, null_pointer_node);
gfc_init_block (&cleanup);
gfc_set_backend_locus (&loc);
/* Allocatable arrays need to be freed when they go out of scope.
@ -6318,17 +6306,18 @@ gfc_trans_deferred_array (gfc_symbol * sym, tree body)
int rank;
rank = sym->as ? sym->as->rank : 0;
tmp = gfc_deallocate_alloc_comp (sym->ts.u.derived, descriptor, rank);
gfc_add_expr_to_block (&fnblock, tmp);
gfc_add_expr_to_block (&cleanup, tmp);
}
if (sym->attr.allocatable && sym->attr.dimension
&& !sym->attr.save && !sym->attr.result)
{
tmp = gfc_trans_dealloc_allocated (sym->backend_decl);
gfc_add_expr_to_block (&fnblock, tmp);
gfc_add_expr_to_block (&cleanup, tmp);
}
return gfc_finish_block (&fnblock);
gfc_add_init_cleanup (block, gfc_finish_block (&init),
gfc_finish_block (&cleanup));
}
/************ Expression Walking Functions ******************/

8
gcc/fortran/trans-array.h
View file

@ -37,11 +37,11 @@ tree gfc_trans_create_temp_array (stmtblock_t *, stmtblock_t *, gfc_loopinfo *,
/* Generate function entry code for allocation of compiler allocated array
variables. */
tree gfc_trans_auto_array_allocation (tree, gfc_symbol *, tree);
void gfc_trans_auto_array_allocation (tree, gfc_symbol *, gfc_wrapped_block *);
/* Generate entry and exit code for dummy array parameters. */
tree gfc_trans_dummy_array_bias (gfc_symbol *, tree, tree);
void gfc_trans_dummy_array_bias (gfc_symbol *, tree, gfc_wrapped_block *);
/* Generate entry and exit code for g77 calling convention arrays. */
tree gfc_trans_g77_array (gfc_symbol *, tree);
void gfc_trans_g77_array (gfc_symbol *, gfc_wrapped_block *);
/* Generate code to deallocate an array, if it is allocated. */
tree gfc_trans_dealloc_allocated (tree);
@ -58,7 +58,7 @@ tree gfc_copy_alloc_comp (gfc_symbol *, tree, tree, int);
tree gfc_copy_only_alloc_comp (gfc_symbol *, tree, tree, int);
/* Add initialization for deferred arrays. */
tree gfc_trans_deferred_array (gfc_symbol *, tree);
void gfc_trans_deferred_array (gfc_symbol *, gfc_wrapped_block *);
/* Generate an initializer for a static pointer or allocatable array. */
void gfc_trans_static_array_pointer (gfc_symbol *);

158
gcc/fortran/trans-decl.c
View file

@ -2838,72 +2838,70 @@ gfc_build_builtin_function_decls (void)
/* Evaluate the length of dummy character variables. */
static tree
gfc_trans_dummy_character (gfc_symbol *sym, gfc_charlen *cl, tree fnbody)
static void
gfc_trans_dummy_character (gfc_symbol *sym, gfc_charlen *cl,
gfc_wrapped_block *block)
{
stmtblock_t body;
stmtblock_t init;
gfc_finish_decl (cl->backend_decl);
gfc_start_block (&body);
gfc_start_block (&init);
/* Evaluate the string length expression. */
gfc_conv_string_length (cl, NULL, &body);
gfc_conv_string_length (cl, NULL, &init);
gfc_trans_vla_type_sizes (sym, &body);
gfc_trans_vla_type_sizes (sym, &init);
gfc_add_expr_to_block (&body, fnbody);
return gfc_finish_block (&body);
gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE);
}
/* Allocate and cleanup an automatic character variable. */
static tree
gfc_trans_auto_character_variable (gfc_symbol * sym, tree fnbody)
static void
gfc_trans_auto_character_variable (gfc_symbol * sym, gfc_wrapped_block * block)
{
stmtblock_t body;
stmtblock_t init;
tree decl;
tree tmp;
gcc_assert (sym->backend_decl);
gcc_assert (sym->ts.u.cl && sym->ts.u.cl->length);
gfc_start_block (&body);
gfc_start_block (&init);
/* Evaluate the string length expression. */
gfc_conv_string_length (sym->ts.u.cl, NULL, &body);
gfc_conv_string_length (sym->ts.u.cl, NULL, &init);
gfc_trans_vla_type_sizes (sym, &body);
gfc_trans_vla_type_sizes (sym, &init);
decl = sym->backend_decl;
/* Emit a DECL_EXPR for this variable, which will cause the
gimplifier to allocate storage, and all that good stuff. */
tmp = fold_build1 (DECL_EXPR, TREE_TYPE (decl), decl);
gfc_add_expr_to_block (&body, tmp);
gfc_add_expr_to_block (&init, tmp);
gfc_add_expr_to_block (&body, fnbody);
return gfc_finish_block (&body);
gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE);
}
/* Set the initial value of ASSIGN statement auxiliary variable explicitly. */
static tree
gfc_trans_assign_aux_var (gfc_symbol * sym, tree fnbody)
static void
gfc_trans_assign_aux_var (gfc_symbol * sym, gfc_wrapped_block * block)
{
stmtblock_t body;
stmtblock_t init;
gcc_assert (sym->backend_decl);
gfc_start_block (&body);
gfc_start_block (&init);
/* Set the initial value to length. See the comments in
function gfc_add_assign_aux_vars in this file. */
gfc_add_modify (&body, GFC_DECL_STRING_LEN (sym->backend_decl),
build_int_cst (NULL_TREE, -2));
gfc_add_modify (&init, GFC_DECL_STRING_LEN (sym->backend_decl),
build_int_cst (NULL_TREE, -2));
gfc_add_expr_to_block (&body, fnbody);
return gfc_finish_block (&body);
gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE);
}
static void
@ -3016,15 +3014,15 @@ gfc_trans_vla_type_sizes (gfc_symbol *sym, stmtblock_t *body)
/* Initialize a derived type by building an lvalue from the symbol
and using trans_assignment to do the work. Set dealloc to false
if no deallocation prior the assignment is needed. */
tree
gfc_init_default_dt (gfc_symbol * sym, tree body, bool dealloc)
void
gfc_init_default_dt (gfc_symbol * sym, stmtblock_t * block, bool dealloc)
{
stmtblock_t fnblock;
gfc_expr *e;
tree tmp;
tree present;
gfc_init_block (&fnblock);
gcc_assert (block);
gcc_assert (!sym->attr.allocatable);
gfc_set_sym_referenced (sym);
e = gfc_lval_expr_from_sym (sym);
@ -3036,11 +3034,8 @@ gfc_init_default_dt (gfc_symbol * sym, tree body, bool dealloc)
tmp = build3 (COND_EXPR, TREE_TYPE (tmp), present,
tmp, build_empty_stmt (input_location));
}
gfc_add_expr_to_block (&fnblock, tmp);
gfc_add_expr_to_block (block, tmp);
gfc_free_expr (e);
if (body)
gfc_add_expr_to_block (&fnblock, body);
return gfc_finish_block (&fnblock);
}
@ -3048,15 +3043,15 @@ gfc_init_default_dt (gfc_symbol * sym, tree body, bool dealloc)
them their default initializer, if they do not have allocatable
components, they have their allocatable components deallocated. */
static tree
init_intent_out_dt (gfc_symbol * proc_sym, tree body)
static void
init_intent_out_dt (gfc_symbol * proc_sym, gfc_wrapped_block * block)
{
stmtblock_t fnblock;
stmtblock_t init;
gfc_formal_arglist *f;
tree tmp;
tree present;
gfc_init_block (&fnblock);
gfc_init_block (&init);
for (f = proc_sym->formal; f; f = f->next)
if (f->sym && f->sym->attr.intent == INTENT_OUT
&& !f->sym->attr.pointer
@ -3076,14 +3071,13 @@ init_intent_out_dt (gfc_symbol * proc_sym, tree body)
tmp, build_empty_stmt (input_location));
}
gfc_add_expr_to_block (&fnblock, tmp);
gfc_add_expr_to_block (&init, tmp);
}
else if (f->sym->value)
body = gfc_init_default_dt (f->sym, body, true);
gfc_init_default_dt (f->sym, &init, true);
}
gfc_add_expr_to_block (&fnblock, body);
return gfc_finish_block (&fnblock);
gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE);
}
@ -3101,9 +3095,12 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
locus loc;
gfc_symbol *sym;
gfc_formal_arglist *f;
stmtblock_t body;
stmtblock_t tmpblock;
gfc_wrapped_block try_block;
bool seen_trans_deferred_array = false;
gfc_start_wrapped_block (&try_block, fnbody);
/* Deal with implicit return variables. Explicit return variables will
already have been added. */
if (gfc_return_by_reference (proc_sym) && proc_sym->result == proc_sym)
@ -3125,19 +3122,17 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
else if (proc_sym->as)
{
tree result = TREE_VALUE (current_fake_result_decl);
fnbody = gfc_trans_dummy_array_bias (proc_sym, result, fnbody);
gfc_trans_dummy_array_bias (proc_sym, result, &try_block);
/* An automatic character length, pointer array result. */
if (proc_sym->ts.type == BT_CHARACTER
&& TREE_CODE (proc_sym->ts.u.cl->backend_decl) == VAR_DECL)
fnbody = gfc_trans_dummy_character (proc_sym, proc_sym->ts.u.cl,
fnbody);
gfc_trans_dummy_character (proc_sym, proc_sym->ts.u.cl, &try_block);
}
else if (proc_sym->ts.type == BT_CHARACTER)
{
if (TREE_CODE (proc_sym->ts.u.cl->backend_decl) == VAR_DECL)
fnbody = gfc_trans_dummy_character (proc_sym, proc_sym->ts.u.cl,
fnbody);
gfc_trans_dummy_character (proc_sym, proc_sym->ts.u.cl, &try_block);
}
else
gcc_assert (gfc_option.flag_f2c
@ -3147,7 +3142,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
/* Initialize the INTENT(OUT) derived type dummy arguments. This
should be done here so that the offsets and lbounds of arrays
are available. */
fnbody = init_intent_out_dt (proc_sym, fnbody);
init_intent_out_dt (proc_sym, &try_block);
for (sym = proc_sym->tlink; sym != proc_sym; sym = sym->tlink)
{
@ -3159,8 +3154,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
{
case AS_EXPLICIT:
if (sym->attr.dummy || sym->attr.result)
fnbody =
gfc_trans_dummy_array_bias (sym, sym->backend_decl, fnbody);
gfc_trans_dummy_array_bias (sym, sym->backend_decl, &try_block);
else if (sym->attr.pointer || sym->attr.allocatable)
{
if (TREE_STATIC (sym->backend_decl))
@ -3168,7 +3162,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
else
{
seen_trans_deferred_array = true;
fnbody = gfc_trans_deferred_array (sym, fnbody);
gfc_trans_deferred_array (sym, &try_block);
}
}
else
@ -3176,18 +3170,24 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
if (sym_has_alloc_comp)
{
seen_trans_deferred_array = true;
fnbody = gfc_trans_deferred_array (sym, fnbody);
gfc_trans_deferred_array (sym, &try_block);
}
else if (sym->ts.type == BT_DERIVED
&& sym->value
&& !sym->attr.data
&& sym->attr.save == SAVE_NONE)
fnbody = gfc_init_default_dt (sym, fnbody, false);
{
gfc_start_block (&tmpblock);
gfc_init_default_dt (sym, &tmpblock, false);
gfc_add_init_cleanup (&try_block,
gfc_finish_block (&tmpblock),
NULL_TREE);
}
gfc_get_backend_locus (&loc);
gfc_set_backend_locus (&sym->declared_at);
fnbody = gfc_trans_auto_array_allocation (sym->backend_decl,
sym, fnbody);
gfc_trans_auto_array_allocation (sym->backend_decl,
sym, &try_block);
gfc_set_backend_locus (&loc);
}
break;
@ -3198,27 +3198,26 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
/* We should always pass assumed size arrays the g77 way. */
if (sym->attr.dummy)
fnbody = gfc_trans_g77_array (sym, fnbody);
break;
gfc_trans_g77_array (sym, &try_block);
break;
case AS_ASSUMED_SHAPE:
/* Must be a dummy parameter. */
gcc_assert (sym->attr.dummy);
fnbody = gfc_trans_dummy_array_bias (sym, sym->backend_decl,
fnbody);
gfc_trans_dummy_array_bias (sym, sym->backend_decl, &try_block);
break;
case AS_DEFERRED:
seen_trans_deferred_array = true;
fnbody = gfc_trans_deferred_array (sym, fnbody);
gfc_trans_deferred_array (sym, &try_block);
break;
default:
gcc_unreachable ();
}
if (sym_has_alloc_comp && !seen_trans_deferred_array)
fnbody = gfc_trans_deferred_array (sym, fnbody);
gfc_trans_deferred_array (sym, &try_block);
}
else if (sym->attr.allocatable
|| (sym->ts.type == BT_CLASS
@ -3231,7 +3230,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
tree tmp;
gfc_expr *e;
gfc_se se;
stmtblock_t block;
stmtblock_t init;
e = gfc_lval_expr_from_sym (sym);
if (sym->ts.type == BT_CLASS)
@ -3243,49 +3242,53 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
gfc_free_expr (e);
/* Nullify when entering the scope. */
gfc_start_block (&block);
gfc_add_modify (&block, se.expr,
gfc_start_block (&init);
gfc_add_modify (&init, se.expr,
fold_convert (TREE_TYPE (se.expr),
null_pointer_node));
gfc_add_expr_to_block (&block, fnbody);
/* Deallocate when leaving the scope. Nullifying is not
needed. */
tmp = gfc_deallocate_with_status (se.expr, NULL_TREE, true,
NULL);
gfc_add_expr_to_block (&block, tmp);
fnbody = gfc_finish_block (&block);
gfc_add_init_cleanup (&try_block, gfc_finish_block (&init), tmp);
}
}
else if (sym_has_alloc_comp)
fnbody = gfc_trans_deferred_array (sym, fnbody);
gfc_trans_deferred_array (sym, &try_block);
else if (sym->ts.type == BT_CHARACTER)
{
gfc_get_backend_locus (&loc);
gfc_set_backend_locus (&sym->declared_at);
if (sym->attr.dummy || sym->attr.result)
fnbody = gfc_trans_dummy_character (sym, sym->ts.u.cl, fnbody);
gfc_trans_dummy_character (sym, sym->ts.u.cl, &try_block);
else
fnbody = gfc_trans_auto_character_variable (sym, fnbody);
gfc_trans_auto_character_variable (sym, &try_block);
gfc_set_backend_locus (&loc);
}
else if (sym->attr.assign)
{
gfc_get_backend_locus (&loc);
gfc_set_backend_locus (&sym->declared_at);
fnbody = gfc_trans_assign_aux_var (sym, fnbody);
gfc_trans_assign_aux_var (sym, &try_block);
gfc_set_backend_locus (&loc);
}
else if (sym->ts.type == BT_DERIVED
&& sym->value
&& !sym->attr.data
&& sym->attr.save == SAVE_NONE)
fnbody = gfc_init_default_dt (sym, fnbody, false);
{
gfc_start_block (&tmpblock);
gfc_init_default_dt (sym, &tmpblock, false);
gfc_add_init_cleanup (&try_block, gfc_finish_block (&tmpblock),
NULL_TREE);
}
else
gcc_unreachable ();
}
gfc_init_block (&body);
gfc_init_block (&tmpblock);
for (f = proc_sym->formal; f; f = f->next)
{
@ -3293,7 +3296,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
{
gcc_assert (f->sym->ts.u.cl->backend_decl != NULL);
if (TREE_CODE (f->sym->ts.u.cl->backend_decl) == PARM_DECL)
gfc_trans_vla_type_sizes (f->sym, &body);
gfc_trans_vla_type_sizes (f->sym, &tmpblock);
}
}
@ -3302,11 +3305,12 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
{
gcc_assert (proc_sym->ts.u.cl->backend_decl != NULL);
if (TREE_CODE (proc_sym->ts.u.cl->backend_decl) == PARM_DECL)
gfc_trans_vla_type_sizes (proc_sym, &body);
gfc_trans_vla_type_sizes (proc_sym, &tmpblock);
}
gfc_add_expr_to_block (&body, fnbody);
return gfc_finish_block (&body);
gfc_add_init_cleanup (&try_block, gfc_finish_block (&tmpblock), NULL_TREE);
return gfc_finish_wrapped_block (&try_block);
}
static GTY ((param_is (struct module_htab_entry))) htab_t module_htab;

106
gcc/fortran/trans.c
View file

@ -977,31 +977,47 @@ gfc_call_realloc (stmtblock_t * block, tree mem, tree size)
return res;
}
/* Add an expression to another one, either at the front or the back. */
static void
add_expr_to_chain (tree* chain, tree expr, bool front)
{
if (expr == NULL_TREE || IS_EMPTY_STMT (expr))
return;
if (*chain)
{
if (TREE_CODE (*chain) != STATEMENT_LIST)
{
tree tmp;
tmp = *chain;
*chain = NULL_TREE;
append_to_statement_list (tmp, chain);
}
if (front)
{
tree_stmt_iterator i;
i = tsi_start (*chain);
tsi_link_before (&i, expr, TSI_CONTINUE_LINKING);
}
else
append_to_statement_list (expr, chain);
}
else
*chain = expr;
}
/* Add a statement to a block. */
void
gfc_add_expr_to_block (stmtblock_t * block, tree expr)
{
gcc_assert (block);
if (expr == NULL_TREE || IS_EMPTY_STMT (expr))
return;
if (block->head)
{
if (TREE_CODE (block->head) != STATEMENT_LIST)
{
tree tmp;
tmp = block->head;
block->head = NULL_TREE;
append_to_statement_list (tmp, &block->head);
}
append_to_statement_list (expr, &block->head);
}
else
/* Don't bother creating a list if we only have a single statement. */
block->head = expr;
add_expr_to_chain (&block->head, expr, false);
}
@ -1393,3 +1409,55 @@ gfc_generate_module_code (gfc_namespace * ns)
}
}
/* Initialize an init/cleanup block with existing code. */
void
gfc_start_wrapped_block (gfc_wrapped_block* block, tree code)
{
gcc_assert (block);
block->init = NULL_TREE;
block->code = code;
block->cleanup = NULL_TREE;
}
/* Add a new pair of initializers/clean-up code. */
void
gfc_add_init_cleanup (gfc_wrapped_block* block, tree init, tree cleanup)
{
gcc_assert (block);
/* The new pair of init/cleanup should be "wrapped around" the existing
block of code, thus the initialization is added to the front and the
cleanup to the back. */
add_expr_to_chain (&block->init, init, true);
add_expr_to_chain (&block->cleanup, cleanup, false);
}
/* Finish up a wrapped block by building a corresponding try-finally expr. */
tree
gfc_finish_wrapped_block (gfc_wrapped_block* block)
{
tree result;
gcc_assert (block);
/* Build the final expression. For this, just add init and body together,
and put clean-up with that into a TRY_FINALLY_EXPR. */
result = block->init;
add_expr_to_chain (&result, block->code, false);
if (block->cleanup)
result = build2 (TRY_FINALLY_EXPR, void_type_node, result, block->cleanup);
/* Clear the block. */
block->init = NULL_TREE;
block->code = NULL_TREE;
block->cleanup = NULL_TREE;
return result;
}

25
gcc/fortran/trans.h
View file

@ -258,6 +258,29 @@ typedef struct
gfc_saved_var;
/* Store information about a block of code together with special
initialization and clean-up code. This can be used to incrementally add
init and cleanup, and in the end put everything together to a
try-finally expression. */
typedef struct
{
tree init;
tree cleanup;
tree code;
}
gfc_wrapped_block;
/* Initialize an init/cleanup block. */
void gfc_start_wrapped_block (gfc_wrapped_block* block, tree code);
/* Add a pair of init/cleanup code to the block. Each one might be a
NULL_TREE if not required. */
void gfc_add_init_cleanup (gfc_wrapped_block* block, tree init, tree cleanup);
/* Finalize the block, that is, create a single expression encapsulating the
original code together with init and clean-up code. */
tree gfc_finish_wrapped_block (gfc_wrapped_block* block);
/* Advance the SS chain to the next term. */
void gfc_advance_se_ss_chain (gfc_se *);
@ -403,7 +426,7 @@ tree gfc_get_symbol_decl (gfc_symbol *);
tree gfc_conv_initializer (gfc_expr *, gfc_typespec *, tree, bool, bool);
/* Assign a default initializer to a derived type. */
tree gfc_init_default_dt (gfc_symbol *, tree, bool);
void gfc_init_default_dt (gfc_symbol *, stmtblock_t *, bool);
/* Substitute a temporary variable in place of the real one. */
void gfc_shadow_sym (gfc_symbol *, tree, gfc_saved_var *);