gfc_loopinfo tmp_loop;
gfc_se parmse;
gfc_ss *ss;
- gfc_ss_info *info;
+ gfc_array_info *info;
gfc_symbol *fsym;
gfc_ref *ref;
int n;
info = NULL;
for (ss = loopse->ss; ss && ss != gfc_ss_terminator; ss = ss->next)
{
- if (ss->expr != e)
+ if (ss->info->expr != e)
continue;
- info = &ss->data.info;
+ info = &ss->info->data.array;
break;
}
/* Make a local loopinfo for the temporary creation, so that
none of the other ss->info's have to be renormalized. */
gfc_init_loopinfo (&tmp_loop);
- tmp_loop.dimen = info->dimen;
- for (n = 0; n < info->dimen; n++)
+ tmp_loop.dimen = ss->dimen;
+ for (n = 0; n < ss->dimen; n++)
{
tmp_loop.to[n] = loopse->loop->to[n];
tmp_loop.from[n] = loopse->loop->from[n];
size = gfc_create_var (gfc_array_index_type, NULL);
data = gfc_create_var (pvoid_type_node, NULL);
gfc_init_block (&temp_post);
- tmp = gfc_trans_create_temp_array (&se->pre, &temp_post,
- &tmp_loop, info, temptype,
- initial,
- false, true, false,
- &arg->expr->where);
+ ss->loop = &tmp_loop;
+ tmp = gfc_trans_create_temp_array (&se->pre, &temp_post, ss,
+ temptype, initial, false, true,
+ false, &arg->expr->where);
gfc_add_modify (&se->pre, size, tmp);
tmp = fold_convert (pvoid_type_node, info->data);
gfc_add_modify (&se->pre, data, tmp);
/* Calculate the offset for the temporary. */
offset = gfc_index_zero_node;
- for (n = 0; n < info->dimen; n++)
+ for (n = 0; n < ss->dimen; n++)
{
tmp = gfc_conv_descriptor_stride_get (info->descriptor,
gfc_rank_cst[n]);
if (gfc_option.coarray == GFC_FCOARRAY_LIB && !error_stop)
{
/* Per F2008, 8.5.1 STOP implies a SYNC MEMORY. */
- tmp = built_in_decls [BUILT_IN_SYNC_SYNCHRONIZE];
+ tmp = builtin_decl_explicit (BUILT_IN_SYNC_SYNCHRONIZE);
tmp = build_call_expr_loc (input_location, tmp, 0);
gfc_add_expr_to_block (&se.pre, tmp);
image control statements SYNC IMAGES and SYNC ALL. */
if (gfc_option.coarray == GFC_FCOARRAY_LIB)
{
- tmp = built_in_decls [BUILT_IN_SYNC_SYNCHRONIZE];
+ tmp = builtin_decl_explicit (BUILT_IN_SYNC_SYNCHRONIZE);
tmp = build_call_expr_loc (input_location, tmp, 0);
gfc_add_expr_to_block (&se.pre, tmp);
}
/* Walk the RHS of the expression. */
*rss = gfc_walk_expr (expr2);
if (*rss == gfc_ss_terminator)
- {
- /* The rhs is scalar. Add a ss for the expression. */
- *rss = gfc_get_ss ();
- (*rss)->next = gfc_ss_terminator;
- (*rss)->type = GFC_SS_SCALAR;
- (*rss)->expr = expr2;
- }
+ /* The rhs is scalar. Add a ss for the expression. */
+ *rss = gfc_get_scalar_ss (gfc_ss_terminator, expr2);
/* Associate the SS with the loop. */
gfc_add_ss_to_loop (&loop, *lss);
gfc_ss *lss, *rss;
gfc_se lse;
gfc_se rse;
- gfc_ss_info *info;
+ gfc_array_info *info;
gfc_loopinfo loop;
tree desc;
tree parm;
gfc_conv_loop_setup (&loop, &expr2->where);
- info = &rss->data.info;
+ info = &rss->info->data.array;
desc = info->descriptor;
/* Make a new descriptor. */
tree maskindex;
tree mask;
tree pmask;
+ tree cycle_label = NULL_TREE;
int n;
int nvar;
int need_temp;
gfc_add_expr_to_block (&block, tmp);
}
+ if (code->op == EXEC_DO_CONCURRENT)
+ {
+ gfc_init_block (&body);
+ cycle_label = gfc_build_label_decl (NULL_TREE);
+ code->cycle_label = cycle_label;
+ tmp = gfc_trans_code (code->block->next);
+ gfc_add_expr_to_block (&body, tmp);
+
+ if (TREE_USED (cycle_label))
+ {
+ tmp = build1_v (LABEL_EXPR, cycle_label);
+ gfc_add_expr_to_block (&body, tmp);
+ }
+
+ tmp = gfc_finish_block (&body);
+ tmp = gfc_trans_nested_forall_loop (nested_forall_info, tmp, 1);
+ gfc_add_expr_to_block (&block, tmp);
+ goto done;
+ }
+
c = code->block->next;
/* TODO: loop merging in FORALL statements. */
c = c->next;
}
+done:
/* Restore the original index variables. */
for (fa = code->ext.forall_iterator, n = 0; fa; fa = fa->next, n++)
gfc_restore_sym (fa->var->symtree->n.sym, &saved_vars[n]);
}
+/* Translate the DO CONCURRENT construct. */
+
+tree gfc_trans_do_concurrent (gfc_code * code)
+{
+ return gfc_trans_forall_1 (code, NULL);
+}
+
+
/* Evaluate the WHERE mask expression, copy its value to a temporary.
If the WHERE construct is nested in FORALL, compute the overall temporary
needed by the WHERE mask expression multiplied by the iterator number of
/* Find a non-scalar SS from the lhs. */
while (lss_section != gfc_ss_terminator
- && lss_section->type != GFC_SS_SECTION)
+ && lss_section->info->type != GFC_SS_SECTION)
lss_section = lss_section->next;
gcc_assert (lss_section != gfc_ss_terminator);
/* Walk the rhs. */
rss = gfc_walk_expr (expr2);
if (rss == gfc_ss_terminator)
- {
- /* The rhs is scalar. Add a ss for the expression. */
- rss = gfc_get_ss ();
- rss->where = 1;
- rss->next = gfc_ss_terminator;
- rss->type = GFC_SS_SCALAR;
- rss->expr = expr2;
+ {
+ /* The rhs is scalar. Add a ss for the expression. */
+ rss = gfc_get_scalar_ss (gfc_ss_terminator, expr2);
+ rss->info->where = 1;
}
/* Associate the SS with the loop. */
tsss = gfc_walk_expr (tsrc);
if (tsss == gfc_ss_terminator)
{
- tsss = gfc_get_ss ();
- tsss->where = 1;
- tsss->next = gfc_ss_terminator;
- tsss->type = GFC_SS_SCALAR;
- tsss->expr = tsrc;
+ tsss = gfc_get_scalar_ss (gfc_ss_terminator, tsrc);
+ tsss->info->where = 1;
}
gfc_add_ss_to_loop (&loop, tdss);
gfc_add_ss_to_loop (&loop, tsss);
esss = gfc_walk_expr (esrc);
if (esss == gfc_ss_terminator)
{
- esss = gfc_get_ss ();
- esss->where = 1;
- esss->next = gfc_ss_terminator;
- esss->type = GFC_SS_SCALAR;
- esss->expr = esrc;
+ esss = gfc_get_scalar_ss (gfc_ss_terminator, esrc);
+ esss->info->where = 1;
}
gfc_add_ss_to_loop (&loop, edss);
gfc_add_ss_to_loop (&loop, esss);
|| code->expr3->expr_type == EXPR_CONSTANT)
{
gfc_conv_expr (&se_sz, code->expr3);
+ gfc_add_block_to_block (&se.pre, &se_sz.pre);
+ se_sz.string_length
+ = gfc_evaluate_now (se_sz.string_length, &se.pre);
+ gfc_add_block_to_block (&se.pre, &se_sz.post);
memsz = se_sz.string_length;
}
else if (code->expr3->mold
/* Allocate - for non-pointers with re-alloc checking. */
if (gfc_expr_attr (expr).allocatable)
- tmp = gfc_allocate_allocatable (&se.pre, se.expr, memsz,
- stat, errmsg, errlen, expr);
+ gfc_allocate_allocatable (&se.pre, se.expr, memsz, NULL_TREE,
+ stat, errmsg, errlen, expr);
else
- tmp = gfc_allocate_using_malloc (&se.pre, memsz, stat);
-
- tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node,
- se.expr,
- fold_convert (TREE_TYPE (se.expr), tmp));
- gfc_add_expr_to_block (&se.pre, tmp);
+ gfc_allocate_using_malloc (&se.pre, se.expr, memsz, stat);
if (expr->ts.type == BT_DERIVED && expr->ts.u.derived->attr.alloc_comp)
{
boolean_type_node, stat,
build_int_cst (TREE_TYPE (stat), 0));
tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
- parm, tmp,
+ gfc_unlikely(parm), tmp,
build_empty_stmt (input_location));
gfc_add_expr_to_block (&block, tmp);
}
slen);
dlen = build_call_expr_loc (input_location,
- built_in_decls[BUILT_IN_MEMCPY], 3,
+ builtin_decl_explicit (BUILT_IN_MEMCPY), 3,
gfc_build_addr_expr (pvoid_type_node, se.expr), errmsg, slen);
tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, stat,
slen);
dlen = build_call_expr_loc (input_location,
- built_in_decls[BUILT_IN_MEMCPY], 3,
+ builtin_decl_explicit (BUILT_IN_MEMCPY), 3,
gfc_build_addr_expr (pvoid_type_node, se.expr), errmsg, slen);
tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, astat,
OSDN Git Service
