return OMP_CLAUSE_DEFAULT_UNSPECIFIED;
}
+
+/* Return code to initialize DECL with its default constructor, or
+ NULL if there's nothing to do. */
+
+tree
+gfc_omp_clause_default_ctor (tree clause ATTRIBUTE_UNUSED, tree decl)
+{
+ tree type = TREE_TYPE (decl);
+ stmtblock_t block;
+
+ if (! GFC_DESCRIPTOR_TYPE_P (type))
+ return NULL;
+
+ /* Allocatable arrays in PRIVATE clauses need to be set to
+ "not currently allocated" allocation status. */
+ gfc_init_block (&block);
+
+ gfc_conv_descriptor_data_set_tuples (&block, decl, null_pointer_node);
+
+ return gfc_finish_block (&block);
+}
+
+
/* Return true if DECL's DECL_VALUE_EXPR (if any) should be
disregarded in OpenMP construct, because it is going to be
remapped during OpenMP lowering. SHARED is true if DECL
return node;
}
-/* TODO make references to parent function results, as done in
- gfc_conv_variable. */
-
static tree
gfc_trans_omp_variable (gfc_symbol *sym)
{
tree t = gfc_get_symbol_decl (sym);
+ tree parent_decl;
+ int parent_flag;
+ bool return_value;
+ bool alternate_entry;
+ bool entry_master;
+
+ return_value = sym->attr.function && sym->result == sym;
+ alternate_entry = sym->attr.function && sym->attr.entry
+ && sym->result == sym;
+ entry_master = sym->attr.result
+ && sym->ns->proc_name->attr.entry_master
+ && !gfc_return_by_reference (sym->ns->proc_name);
+ parent_decl = DECL_CONTEXT (current_function_decl);
+
+ if ((t == parent_decl && return_value)
+ || (sym->ns && sym->ns->proc_name
+ && sym->ns->proc_name->backend_decl == parent_decl
+ && (alternate_entry || entry_master)))
+ parent_flag = 1;
+ else
+ parent_flag = 0;
/* Special case for assigning the return value of a function.
Self recursive functions must have an explicit return value. */
- if (t == current_function_decl && sym->attr.function
- && (sym->result == sym))
- t = gfc_get_fake_result_decl (sym, 0);
+ if (return_value && (t == current_function_decl || parent_flag))
+ t = gfc_get_fake_result_decl (sym, parent_flag);
/* Similarly for alternate entry points. */
- else if (sym->attr.function && sym->attr.entry
- && (sym->result == sym)
- && sym->ns->proc_name->backend_decl == current_function_decl)
+ else if (alternate_entry
+ && (sym->ns->proc_name->backend_decl == current_function_decl
+ || parent_flag))
{
gfc_entry_list *el = NULL;
for (el = sym->ns->entries; el; el = el->next)
if (sym == el->sym)
{
- t = gfc_get_fake_result_decl (sym, 0);
+ t = gfc_get_fake_result_decl (sym, parent_flag);
break;
}
}
- else if (sym->attr.result
- && sym->ns->proc_name->backend_decl == current_function_decl
- && sym->ns->proc_name->attr.entry_master
- && !gfc_return_by_reference (sym->ns->proc_name))
- t = gfc_get_fake_result_decl (sym, 0);
+ else if (entry_master
+ && (sym->ns->proc_name->backend_decl == current_function_decl
+ || parent_flag))
+ t = gfc_get_fake_result_decl (sym, parent_flag);
return t;
}
gfc_symbol init_val_sym, outer_sym, intrinsic_sym;
gfc_expr *e1, *e2, *e3, *e4;
gfc_ref *ref;
- tree decl, backend_decl;
+ tree decl, backend_decl, stmt;
locus old_loc = gfc_current_locus;
const char *iname;
try t;
init_val_sym.ts = sym->ts;
init_val_sym.attr.referenced = 1;
init_val_sym.declared_at = where;
+ init_val_sym.attr.flavor = FL_VARIABLE;
backend_decl = omp_reduction_init (c, gfc_sym_type (&init_val_sym));
init_val_sym.backend_decl = backend_decl;
outer_sym.as = gfc_copy_array_spec (sym->as);
outer_sym.attr.dummy = 0;
outer_sym.attr.result = 0;
+ outer_sym.attr.flavor = FL_VARIABLE;
outer_sym.backend_decl = create_tmp_var_raw (TREE_TYPE (decl), NULL);
/* Create fake symtrees for it. */
gcc_assert (t == SUCCESS);
/* Create the init statement list. */
- OMP_CLAUSE_REDUCTION_INIT (c) = gfc_trans_assignment (e1, e2);
+ pushlevel (0);
+ stmt = gfc_trans_assignment (e1, e2, false);
+ if (TREE_CODE (stmt) != BIND_EXPR)
+ stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0));
+ else
+ poplevel (0, 0, 0);
+ OMP_CLAUSE_REDUCTION_INIT (c) = stmt;
/* Create the merge statement list. */
- OMP_CLAUSE_REDUCTION_MERGE (c) = gfc_trans_assignment (e3, e4);
+ pushlevel (0);
+ stmt = gfc_trans_assignment (e3, e4, false);
+ if (TREE_CODE (stmt) != BIND_EXPR)
+ stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0));
+ else
+ poplevel (0, 0, 0);
+ OMP_CLAUSE_REDUCTION_MERGE (c) = stmt;
/* And stick the placeholder VAR_DECL into the clause as well. */
OMP_CLAUSE_REDUCTION_PLACEHOLDER (c) = outer_sym.backend_decl;
static tree
gfc_trans_omp_reduction_list (gfc_namelist *namelist, tree list,
- enum tree_code reduction_code, locus where)
+ enum tree_code reduction_code, locus where)
{
for (; namelist != NULL; namelist = namelist->next)
if (namelist->sym->attr.referenced)
tree accum = gfc_create_var (TREE_TYPE (rse.expr), NULL);
gfc_actual_arglist *arg;
- gfc_add_modify_expr (&block, accum, rse.expr);
+ gfc_add_modify_stmt (&block, accum, rse.expr);
for (arg = expr2->value.function.actual->next->next; arg;
arg = arg->next)
{
gfc_conv_expr (&rse, arg->expr);
gfc_add_block_to_block (&block, &rse.pre);
x = fold_build2 (op, TREE_TYPE (accum), accum, rse.expr);
- gfc_add_modify_expr (&block, accum, x);
+ gfc_add_modify_stmt (&block, accum, x);
}
rse.expr = accum;
gfc_trans_omp_barrier (void)
{
tree decl = built_in_decls [BUILT_IN_GOMP_BARRIER];
- return build_function_call_expr (decl, NULL);
+ return build_call_expr (decl, 0);
}
static tree
static tree
gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock,
- gfc_omp_clauses *clauses)
+ gfc_omp_clauses *do_clauses)
{
gfc_se se;
tree dovar, stmt, from, to, step, type, init, cond, incr;
stmtblock_t body;
int simple = 0;
bool dovar_found = false;
+ gfc_omp_clauses *clauses = code->ext.omp_clauses;
code = code->block->next;
gcc_assert (code->op == EXEC_DO);
pblock = █
}
- omp_clauses = gfc_trans_omp_clauses (pblock, clauses, code->loc);
+ omp_clauses = gfc_trans_omp_clauses (pblock, do_clauses, code->loc);
if (clauses)
{
gfc_namelist *n;
/* Loop body. */
if (simple)
{
- init = build2_v (MODIFY_EXPR, dovar, from);
+ init = build2_v (GIMPLE_MODIFY_STMT, dovar, from);
cond = build2 (simple > 0 ? LE_EXPR : GE_EXPR, boolean_type_node,
dovar, to);
incr = fold_build2 (PLUS_EXPR, type, dovar, step);
- incr = fold_build2 (MODIFY_EXPR, type, dovar, incr);
+ incr = fold_build2 (GIMPLE_MODIFY_STMT, type, dovar, incr);
if (pblock != &block)
{
pushlevel (0);
tmp = fold_build2 (TRUNC_DIV_EXPR, type, tmp, step);
tmp = gfc_evaluate_now (tmp, pblock);
count = gfc_create_var (type, "count");
- init = build2_v (MODIFY_EXPR, count, build_int_cst (type, 0));
+ init = build2_v (GIMPLE_MODIFY_STMT, count, build_int_cst (type, 0));
cond = build2 (LT_EXPR, boolean_type_node, count, tmp);
incr = fold_build2 (PLUS_EXPR, type, count, build_int_cst (type, 1));
- incr = fold_build2 (MODIFY_EXPR, type, count, incr);
+ incr = fold_build2 (GIMPLE_MODIFY_STMT, type, count, incr);
if (pblock != &block)
{
/* Initialize DOVAR. */
tmp = fold_build2 (MULT_EXPR, type, count, step);
tmp = build2 (PLUS_EXPR, type, from, tmp);
- gfc_add_modify_expr (&body, dovar, tmp);
+ gfc_add_modify_stmt (&body, dovar, tmp);
}
if (!dovar_found)
gfc_trans_omp_flush (void)
{
tree decl = built_in_decls [BUILT_IN_SYNCHRONIZE];
- return build_function_call_expr (decl, NULL);
+ return build_call_expr (decl, 0);
}
static tree
else
poplevel (0, 0, 0);
stmt = build4_v (OMP_PARALLEL, stmt, omp_clauses, NULL, NULL);
+ OMP_PARALLEL_COMBINED (stmt) = 1;
gfc_add_expr_to_block (&block, stmt);
return gfc_finish_block (&block);
}
else
poplevel (0, 0, 0);
stmt = build4_v (OMP_PARALLEL, stmt, omp_clauses, NULL, NULL);
+ OMP_PARALLEL_COMBINED (stmt) = 1;
gfc_add_expr_to_block (&block, stmt);
return gfc_finish_block (&block);
}
else
poplevel (0, 0, 0);
stmt = build4_v (OMP_PARALLEL, stmt, omp_clauses, NULL, NULL);
+ OMP_PARALLEL_COMBINED (stmt) = 1;
gfc_add_expr_to_block (&block, stmt);
return gfc_finish_block (&block);
}
}
stmt = gfc_finish_block (&body);
- stmt = build3_v (OMP_SECTIONS, stmt, omp_clauses, NULL);
+ stmt = build2_v (OMP_SECTIONS, stmt, omp_clauses);
gfc_add_expr_to_block (&block, stmt);
return gfc_finish_block (&block);
OSDN Git Service
