diff options
Diffstat (limited to 'gcc/fortran/trans-openmp.c')
| -rw-r--r-- | gcc/fortran/trans-openmp.c | 627 |
1 files changed, 581 insertions, 46 deletions
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index 41020a83..101dfe5 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -427,8 +427,33 @@ gfc_trans_add_clause (tree node, tree tail) } static tree -gfc_trans_omp_variable (gfc_symbol *sym) +gfc_trans_omp_variable (gfc_symbol *sym, bool declare_simd) { + if (declare_simd) + { + int cnt = 0; + gfc_symbol *proc_sym; + gfc_formal_arglist *f; + + gcc_assert (sym->attr.dummy); + proc_sym = sym->ns->proc_name; + if (proc_sym->attr.entry_master) + ++cnt; + if (gfc_return_by_reference (proc_sym)) + { + ++cnt; + if (proc_sym->ts.type == BT_CHARACTER) + ++cnt; + } + for (f = gfc_sym_get_dummy_args (proc_sym); f; f = f->next) + if (f->sym == sym) + break; + else if (f->sym) + ++cnt; + gcc_assert (f); + return build_int_cst (integer_type_node, cnt); + } + tree t = gfc_get_symbol_decl (sym); tree parent_decl; int parent_flag; @@ -442,7 +467,8 @@ gfc_trans_omp_variable (gfc_symbol *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); + parent_decl = current_function_decl + ? DECL_CONTEXT (current_function_decl) : NULL_TREE; if ((t == parent_decl && return_value) || (sym->ns && sym->ns->proc_name @@ -481,13 +507,14 @@ gfc_trans_omp_variable (gfc_symbol *sym) } static tree -gfc_trans_omp_variable_list (enum omp_clause_code code, gfc_namelist *namelist, - tree list) +gfc_trans_omp_variable_list (enum omp_clause_code code, + gfc_omp_namelist *namelist, tree list, + bool declare_simd) { for (; namelist != NULL; namelist = namelist->next) - if (namelist->sym->attr.referenced) + if (namelist->sym->attr.referenced || declare_simd) { - tree t = gfc_trans_omp_variable (namelist->sym); + tree t = gfc_trans_omp_variable (namelist->sym, declare_simd); if (t != error_mark_node) { tree node = build_omp_clause (input_location, code); @@ -745,13 +772,13 @@ gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where) } static tree -gfc_trans_omp_reduction_list (gfc_namelist *namelist, tree list, +gfc_trans_omp_reduction_list (gfc_omp_namelist *namelist, tree list, enum tree_code reduction_code, locus where) { for (; namelist != NULL; namelist = namelist->next) if (namelist->sym->attr.referenced) { - tree t = gfc_trans_omp_variable (namelist->sym); + tree t = gfc_trans_omp_variable (namelist->sym, false); if (t != error_mark_node) { tree node = build_omp_clause (where.lb->location, @@ -768,7 +795,7 @@ gfc_trans_omp_reduction_list (gfc_namelist *namelist, tree list, static tree gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, - locus where) + locus where, bool declare_simd = false) { tree omp_clauses = NULL_TREE, chunk_size, c; int list; @@ -780,7 +807,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, for (list = 0; list < OMP_LIST_NUM; list++) { - gfc_namelist *n = clauses->lists[list]; + gfc_omp_namelist *n = clauses->lists[list]; if (n == NULL) continue; @@ -853,10 +880,125 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, goto add_clause; case OMP_LIST_COPYPRIVATE: clause_code = OMP_CLAUSE_COPYPRIVATE; + goto add_clause; + case OMP_LIST_UNIFORM: + clause_code = OMP_CLAUSE_UNIFORM; /* FALLTHROUGH */ add_clause: omp_clauses - = gfc_trans_omp_variable_list (clause_code, n, omp_clauses); + = gfc_trans_omp_variable_list (clause_code, n, omp_clauses, + declare_simd); + break; + case OMP_LIST_ALIGNED: + for (; n != NULL; n = n->next) + if (n->sym->attr.referenced || declare_simd) + { + tree t = gfc_trans_omp_variable (n->sym, declare_simd); + if (t != error_mark_node) + { + tree node = build_omp_clause (input_location, + OMP_CLAUSE_ALIGNED); + OMP_CLAUSE_DECL (node) = t; + if (n->expr) + { + tree alignment_var; + + if (block == NULL) + alignment_var = gfc_conv_constant_to_tree (n->expr); + else + { + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, n->expr); + gfc_add_block_to_block (block, &se.pre); + alignment_var = gfc_evaluate_now (se.expr, block); + gfc_add_block_to_block (block, &se.post); + } + OMP_CLAUSE_ALIGNED_ALIGNMENT (node) = alignment_var; + } + omp_clauses = gfc_trans_add_clause (node, omp_clauses); + } + } + break; + case OMP_LIST_LINEAR: + { + gfc_expr *last_step_expr = NULL; + tree last_step = NULL_TREE; + + for (; n != NULL; n = n->next) + { + if (n->expr) + { + last_step_expr = n->expr; + last_step = NULL_TREE; + } + if (n->sym->attr.referenced || declare_simd) + { + tree t = gfc_trans_omp_variable (n->sym, declare_simd); + if (t != error_mark_node) + { + tree node = build_omp_clause (input_location, + OMP_CLAUSE_LINEAR); + OMP_CLAUSE_DECL (node) = t; + if (last_step_expr && last_step == NULL_TREE) + { + if (block == NULL) + last_step + = gfc_conv_constant_to_tree (last_step_expr); + else + { + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, last_step_expr); + gfc_add_block_to_block (block, &se.pre); + last_step = gfc_evaluate_now (se.expr, block); + gfc_add_block_to_block (block, &se.post); + } + } + OMP_CLAUSE_LINEAR_STEP (node) = last_step; + omp_clauses = gfc_trans_add_clause (node, omp_clauses); + } + } + } + } + break; + case OMP_LIST_DEPEND_IN: + case OMP_LIST_DEPEND_OUT: + for (; n != NULL; n = n->next) + { + if (!n->sym->attr.referenced) + continue; + + tree node = build_omp_clause (input_location, OMP_CLAUSE_DEPEND); + if (n->expr == NULL || n->expr->ref->u.ar.type == AR_FULL) + { + OMP_CLAUSE_DECL (node) = gfc_get_symbol_decl (n->sym); + if (DECL_P (OMP_CLAUSE_DECL (node))) + TREE_ADDRESSABLE (OMP_CLAUSE_DECL (node)) = 1; + } + else + { + tree ptr; + gfc_init_se (&se, NULL); + if (n->expr->ref->u.ar.type == AR_ELEMENT) + { + gfc_conv_expr_reference (&se, n->expr); + ptr = se.expr; + } + else + { + gfc_conv_expr_descriptor (&se, n->expr); + ptr = gfc_conv_array_data (se.expr); + } + gfc_add_block_to_block (block, &se.pre); + gfc_add_block_to_block (block, &se.post); + OMP_CLAUSE_DECL (node) + = fold_build1_loc (input_location, INDIRECT_REF, + TREE_TYPE (TREE_TYPE (ptr)), ptr); + } + OMP_CLAUSE_DEPEND_KIND (node) + = ((list == OMP_LIST_DEPEND_IN) + ? OMP_CLAUSE_DEPEND_IN : OMP_CLAUSE_DEPEND_OUT); + omp_clauses = gfc_trans_add_clause (node, omp_clauses); + } break; default: break; @@ -1000,6 +1142,83 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, omp_clauses = gfc_trans_add_clause (c, omp_clauses); } + if (clauses->inbranch) + { + c = build_omp_clause (where.lb->location, OMP_CLAUSE_INBRANCH); + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + + if (clauses->notinbranch) + { + c = build_omp_clause (where.lb->location, OMP_CLAUSE_NOTINBRANCH); + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + + switch (clauses->cancel) + { + case OMP_CANCEL_UNKNOWN: + break; + case OMP_CANCEL_PARALLEL: + c = build_omp_clause (where.lb->location, OMP_CLAUSE_PARALLEL); + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + break; + case OMP_CANCEL_SECTIONS: + c = build_omp_clause (where.lb->location, OMP_CLAUSE_SECTIONS); + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + break; + case OMP_CANCEL_DO: + c = build_omp_clause (where.lb->location, OMP_CLAUSE_FOR); + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + break; + case OMP_CANCEL_TASKGROUP: + c = build_omp_clause (where.lb->location, OMP_CLAUSE_TASKGROUP); + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + break; + } + + if (clauses->proc_bind != OMP_PROC_BIND_UNKNOWN) + { + c = build_omp_clause (where.lb->location, OMP_CLAUSE_PROC_BIND); + switch (clauses->proc_bind) + { + case OMP_PROC_BIND_MASTER: + OMP_CLAUSE_PROC_BIND_KIND (c) = OMP_CLAUSE_PROC_BIND_MASTER; + break; + case OMP_PROC_BIND_SPREAD: + OMP_CLAUSE_PROC_BIND_KIND (c) = OMP_CLAUSE_PROC_BIND_SPREAD; + break; + case OMP_PROC_BIND_CLOSE: + OMP_CLAUSE_PROC_BIND_KIND (c) = OMP_CLAUSE_PROC_BIND_CLOSE; + break; + default: + gcc_unreachable (); + } + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + + if (clauses->safelen_expr) + { + tree safelen_var; + + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, clauses->safelen_expr); + gfc_add_block_to_block (block, &se.pre); + safelen_var = gfc_evaluate_now (se.expr, block); + gfc_add_block_to_block (block, &se.post); + + c = build_omp_clause (where.lb->location, OMP_CLAUSE_SAFELEN); + OMP_CLAUSE_SAFELEN_EXPR (c) = safelen_var; + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + + if (clauses->simdlen_expr) + { + c = build_omp_clause (where.lb->location, OMP_CLAUSE_SIMDLEN); + OMP_CLAUSE_SIMDLEN_EXPR (c) + = gfc_conv_constant_to_tree (clauses->simdlen_expr); + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + return omp_clauses; } @@ -1045,6 +1264,7 @@ gfc_trans_omp_atomic (gfc_code *code) enum tree_code op = ERROR_MARK; enum tree_code aop = OMP_ATOMIC; bool var_on_left = false; + bool seq_cst = (atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_SEQ_CST) != 0; code = code->block->next; gcc_assert (code->op == EXEC_ASSIGN); @@ -1060,7 +1280,7 @@ gfc_trans_omp_atomic (gfc_code *code) && expr2->value.function.isym->id == GFC_ISYM_CONVERSION) expr2 = expr2->value.function.actual->expr; - switch (atomic_code->ext.omp_atomic) + switch (atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_MASK) { case GFC_OMP_ATOMIC_READ: gfc_conv_expr (&vse, code->expr1); @@ -1072,6 +1292,7 @@ gfc_trans_omp_atomic (gfc_code *code) lhsaddr = gfc_build_addr_expr (NULL, lse.expr); x = build1 (OMP_ATOMIC_READ, type, lhsaddr); + OMP_ATOMIC_SEQ_CST (x) = seq_cst; x = convert (TREE_TYPE (vse.expr), x); gfc_add_modify (&block, vse.expr, x); @@ -1107,7 +1328,9 @@ gfc_trans_omp_atomic (gfc_code *code) type = TREE_TYPE (lse.expr); lhsaddr = gfc_build_addr_expr (NULL, lse.expr); - if (atomic_code->ext.omp_atomic == GFC_OMP_ATOMIC_WRITE) + if (((atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_MASK) + == GFC_OMP_ATOMIC_WRITE) + || (atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_SWAP)) { gfc_conv_expr (&rse, expr2); gfc_add_block_to_block (&block, &rse.pre); @@ -1229,7 +1452,9 @@ gfc_trans_omp_atomic (gfc_code *code) lhsaddr = save_expr (lhsaddr); rhs = gfc_evaluate_now (rse.expr, &block); - if (atomic_code->ext.omp_atomic == GFC_OMP_ATOMIC_WRITE) + if (((atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_MASK) + == GFC_OMP_ATOMIC_WRITE) + || (atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_SWAP)) x = rhs; else { @@ -1252,6 +1477,7 @@ gfc_trans_omp_atomic (gfc_code *code) if (aop == OMP_ATOMIC) { x = build2_v (OMP_ATOMIC, lhsaddr, convert (type, x)); + OMP_ATOMIC_SEQ_CST (x) = seq_cst; gfc_add_expr_to_block (&block, x); } else @@ -1273,6 +1499,7 @@ gfc_trans_omp_atomic (gfc_code *code) gfc_add_block_to_block (&block, &lse.pre); } x = build2 (aop, type, lhsaddr, convert (type, x)); + OMP_ATOMIC_SEQ_CST (x) = seq_cst; x = convert (TREE_TYPE (vse.expr), x); gfc_add_modify (&block, vse.expr, x); } @@ -1288,6 +1515,63 @@ gfc_trans_omp_barrier (void) } static tree +gfc_trans_omp_cancel (gfc_code *code) +{ + int mask = 0; + tree ifc = boolean_true_node; + stmtblock_t block; + switch (code->ext.omp_clauses->cancel) + { + case OMP_CANCEL_PARALLEL: mask = 1; break; + case OMP_CANCEL_DO: mask = 2; break; + case OMP_CANCEL_SECTIONS: mask = 4; break; + case OMP_CANCEL_TASKGROUP: mask = 8; break; + default: gcc_unreachable (); + } + gfc_start_block (&block); + if (code->ext.omp_clauses->if_expr) + { + gfc_se se; + tree if_var; + + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, code->ext.omp_clauses->if_expr); + gfc_add_block_to_block (&block, &se.pre); + if_var = gfc_evaluate_now (se.expr, &block); + gfc_add_block_to_block (&block, &se.post); + tree type = TREE_TYPE (if_var); + ifc = fold_build2_loc (input_location, NE_EXPR, + boolean_type_node, if_var, + build_zero_cst (type)); + } + tree decl = builtin_decl_explicit (BUILT_IN_GOMP_CANCEL); + tree c_bool_type = TREE_TYPE (TREE_TYPE (decl)); + ifc = fold_convert (c_bool_type, ifc); + gfc_add_expr_to_block (&block, + build_call_expr_loc (input_location, decl, 2, + build_int_cst (integer_type_node, + mask), ifc)); + return gfc_finish_block (&block); +} + +static tree +gfc_trans_omp_cancellation_point (gfc_code *code) +{ + int mask = 0; + switch (code->ext.omp_clauses->cancel) + { + case OMP_CANCEL_PARALLEL: mask = 1; break; + case OMP_CANCEL_DO: mask = 2; break; + case OMP_CANCEL_SECTIONS: mask = 4; break; + case OMP_CANCEL_TASKGROUP: mask = 8; break; + default: gcc_unreachable (); + } + tree decl = builtin_decl_explicit (BUILT_IN_GOMP_CANCELLATION_POINT); + return build_call_expr_loc (input_location, decl, 1, + build_int_cst (integer_type_node, mask)); +} + +static tree gfc_trans_omp_critical (gfc_code *code) { tree name = NULL_TREE, stmt; @@ -1304,7 +1588,7 @@ typedef struct dovar_init_d { static tree -gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock, +gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock, gfc_omp_clauses *do_clauses, tree par_clauses) { gfc_se se; @@ -1344,14 +1628,15 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock, if (clauses) { - gfc_namelist *n; - for (n = clauses->lists[OMP_LIST_LASTPRIVATE]; n != NULL; - n = n->next) + gfc_omp_namelist *n; + for (n = clauses->lists[(op == EXEC_OMP_SIMD && collapse == 1) + ? OMP_LIST_LINEAR : OMP_LIST_LASTPRIVATE]; + n != NULL; n = n->next) if (code->ext.iterator->var->symtree->n.sym == n->sym) break; if (n != NULL) dovar_found = 1; - else if (n == NULL) + else if (n == NULL && op != EXEC_OMP_SIMD) for (n = clauses->lists[OMP_LIST_PRIVATE]; n != NULL; n = n->next) if (code->ext.iterator->var->symtree->n.sym == n->sym) break; @@ -1393,7 +1678,8 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock, } else dovar_decl - = gfc_trans_omp_variable (code->ext.iterator->var->symtree->n.sym); + = gfc_trans_omp_variable (code->ext.iterator->var->symtree->n.sym, + false); /* Loop body. */ if (simple) @@ -1447,11 +1733,24 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock, if (!dovar_found) { - tmp = build_omp_clause (input_location, OMP_CLAUSE_PRIVATE); + if (op == EXEC_OMP_SIMD) + { + if (collapse == 1) + { + tmp = build_omp_clause (input_location, OMP_CLAUSE_LINEAR); + OMP_CLAUSE_LINEAR_STEP (tmp) = step; + } + else + tmp = build_omp_clause (input_location, OMP_CLAUSE_LASTPRIVATE); + if (!simple) + dovar_found = 2; + } + else + tmp = build_omp_clause (input_location, OMP_CLAUSE_PRIVATE); OMP_CLAUSE_DECL (tmp) = dovar_decl; omp_clauses = gfc_trans_add_clause (tmp, omp_clauses); } - else if (dovar_found == 2) + if (dovar_found == 2) { tree c = NULL; @@ -1475,8 +1774,14 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock, OMP_CLAUSE_LASTPRIVATE_STMT (c) = tmp; break; } + else if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LINEAR + && OMP_CLAUSE_DECL (c) == dovar_decl) + { + OMP_CLAUSE_LINEAR_STMT (c) = tmp; + break; + } } - if (c == NULL && par_clauses != NULL) + if (c == NULL && op == EXEC_OMP_DO && par_clauses != NULL) { for (c = par_clauses; c ; c = OMP_CLAUSE_CHAIN (c)) if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LASTPRIVATE @@ -1496,7 +1801,17 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock, } if (!simple) { - tmp = build_omp_clause (input_location, OMP_CLAUSE_PRIVATE); + if (op != EXEC_OMP_SIMD) + tmp = build_omp_clause (input_location, OMP_CLAUSE_PRIVATE); + else if (collapse == 1) + { + tmp = build_omp_clause (input_location, OMP_CLAUSE_LINEAR); + OMP_CLAUSE_LINEAR_STEP (tmp) = step; + OMP_CLAUSE_LINEAR_NO_COPYIN (tmp) = 1; + OMP_CLAUSE_LINEAR_NO_COPYOUT (tmp) = 1; + } + else + tmp = build_omp_clause (input_location, OMP_CLAUSE_LASTPRIVATE); OMP_CLAUSE_DECL (tmp) = count; omp_clauses = gfc_trans_add_clause (tmp, omp_clauses); } @@ -1538,7 +1853,7 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock, } /* End of loop body. */ - stmt = make_node (OMP_FOR); + stmt = make_node (op == EXEC_OMP_SIMD ? OMP_SIMD : OMP_FOR); TREE_TYPE (stmt) = void_type_node; OMP_FOR_BODY (stmt) = gfc_finish_block (&body); @@ -1589,37 +1904,219 @@ gfc_trans_omp_parallel (gfc_code *code) return gfc_finish_block (&block); } +enum +{ + GFC_OMP_SPLIT_SIMD, + GFC_OMP_SPLIT_DO, + GFC_OMP_SPLIT_PARALLEL, + GFC_OMP_SPLIT_NUM +}; + +enum +{ + GFC_OMP_MASK_SIMD = (1 << GFC_OMP_SPLIT_SIMD), + GFC_OMP_MASK_DO = (1 << GFC_OMP_SPLIT_DO), + GFC_OMP_MASK_PARALLEL = (1 << GFC_OMP_SPLIT_PARALLEL) +}; + +static void +gfc_split_omp_clauses (gfc_code *code, + gfc_omp_clauses clausesa[GFC_OMP_SPLIT_NUM]) +{ + int mask = 0, innermost = 0, i; + memset (clausesa, 0, GFC_OMP_SPLIT_NUM * sizeof (gfc_omp_clauses)); + switch (code->op) + { + case EXEC_OMP_DO_SIMD: + mask = GFC_OMP_MASK_DO | GFC_OMP_MASK_SIMD; + innermost = GFC_OMP_SPLIT_SIMD; + break; + case EXEC_OMP_PARALLEL_DO: + mask = GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO; + innermost = GFC_OMP_SPLIT_DO; + break; + case EXEC_OMP_PARALLEL_DO_SIMD: + mask = GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO | GFC_OMP_MASK_SIMD; + innermost = GFC_OMP_SPLIT_SIMD; + break; + default: + gcc_unreachable (); + } + if (code->ext.omp_clauses != NULL) + { + if (mask & GFC_OMP_MASK_PARALLEL) + { + /* First the clauses that are unique to some constructs. */ + clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_COPYIN] + = code->ext.omp_clauses->lists[OMP_LIST_COPYIN]; + clausesa[GFC_OMP_SPLIT_PARALLEL].num_threads + = code->ext.omp_clauses->num_threads; + clausesa[GFC_OMP_SPLIT_PARALLEL].proc_bind + = code->ext.omp_clauses->proc_bind; + /* Shared and default clauses are allowed on parallel and teams. */ + clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_SHARED] + = code->ext.omp_clauses->lists[OMP_LIST_SHARED]; + clausesa[GFC_OMP_SPLIT_PARALLEL].default_sharing + = code->ext.omp_clauses->default_sharing; + /* FIXME: This is currently being discussed. */ + clausesa[GFC_OMP_SPLIT_PARALLEL].if_expr + = code->ext.omp_clauses->if_expr; + } + if (mask & GFC_OMP_MASK_DO) + { + /* First the clauses that are unique to some constructs. */ + clausesa[GFC_OMP_SPLIT_DO].ordered + = code->ext.omp_clauses->ordered; + clausesa[GFC_OMP_SPLIT_DO].sched_kind + = code->ext.omp_clauses->sched_kind; + clausesa[GFC_OMP_SPLIT_DO].chunk_size + = code->ext.omp_clauses->chunk_size; + clausesa[GFC_OMP_SPLIT_DO].nowait + = code->ext.omp_clauses->nowait; + /* Duplicate collapse. */ + clausesa[GFC_OMP_SPLIT_DO].collapse + = code->ext.omp_clauses->collapse; + } + if (mask & GFC_OMP_MASK_SIMD) + { + clausesa[GFC_OMP_SPLIT_SIMD].safelen_expr + = code->ext.omp_clauses->safelen_expr; + clausesa[GFC_OMP_SPLIT_SIMD].lists[OMP_LIST_LINEAR] + = code->ext.omp_clauses->lists[OMP_LIST_LINEAR]; + clausesa[GFC_OMP_SPLIT_SIMD].lists[OMP_LIST_ALIGNED] + = code->ext.omp_clauses->lists[OMP_LIST_ALIGNED]; + /* Duplicate collapse. */ + clausesa[GFC_OMP_SPLIT_SIMD].collapse + = code->ext.omp_clauses->collapse; + } + /* Private clause is supported on all constructs but target, + it is enough to put it on the innermost one. For + !$ omp do put it on parallel though, + as that's what we did for OpenMP 3.1. */ + clausesa[innermost == GFC_OMP_SPLIT_DO + ? (int) GFC_OMP_SPLIT_PARALLEL + : innermost].lists[OMP_LIST_PRIVATE] + = code->ext.omp_clauses->lists[OMP_LIST_PRIVATE]; + /* Firstprivate clause is supported on all constructs but + target and simd. Put it on the outermost of those and + duplicate on parallel. */ + if (mask & GFC_OMP_MASK_PARALLEL) + clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_FIRSTPRIVATE] + = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE]; + else if (mask & GFC_OMP_MASK_DO) + clausesa[GFC_OMP_SPLIT_DO].lists[OMP_LIST_FIRSTPRIVATE] + = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE]; + /* Lastprivate is allowed on do and simd. In + parallel do{, simd} we actually want to put it on + parallel rather than do. */ + if (mask & GFC_OMP_MASK_PARALLEL) + clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_LASTPRIVATE] + = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE]; + else if (mask & GFC_OMP_MASK_DO) + clausesa[GFC_OMP_SPLIT_DO].lists[OMP_LIST_LASTPRIVATE] + = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE]; + if (mask & GFC_OMP_MASK_SIMD) + clausesa[GFC_OMP_SPLIT_SIMD].lists[OMP_LIST_LASTPRIVATE] + = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE]; + /* Reduction is allowed on simd, do, parallel and teams. + Duplicate it on all of them, but omit on do if + parallel is present. */ + for (i = OMP_LIST_REDUCTION_FIRST; i <= OMP_LIST_REDUCTION_LAST; i++) + { + if (mask & GFC_OMP_MASK_PARALLEL) + clausesa[GFC_OMP_SPLIT_PARALLEL].lists[i] + = code->ext.omp_clauses->lists[i]; + else if (mask & GFC_OMP_MASK_DO) + clausesa[GFC_OMP_SPLIT_DO].lists[i] + = code->ext.omp_clauses->lists[i]; + if (mask & GFC_OMP_MASK_SIMD) + clausesa[GFC_OMP_SPLIT_SIMD].lists[i] + = code->ext.omp_clauses->lists[i]; + } + } + if ((mask & (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO)) + == (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO)) + clausesa[GFC_OMP_SPLIT_DO].nowait = true; +} + static tree -gfc_trans_omp_parallel_do (gfc_code *code) +gfc_trans_omp_do_simd (gfc_code *code, gfc_omp_clauses *clausesa, + tree omp_clauses) { stmtblock_t block, *pblock = NULL; - gfc_omp_clauses parallel_clauses, do_clauses; - tree stmt, omp_clauses = NULL_TREE; + gfc_omp_clauses clausesa_buf[GFC_OMP_SPLIT_NUM]; + tree stmt, body, omp_do_clauses = NULL_TREE; gfc_start_block (&block); - memset (&do_clauses, 0, sizeof (do_clauses)); - if (code->ext.omp_clauses != NULL) + if (clausesa == NULL) { - memcpy (¶llel_clauses, code->ext.omp_clauses, - sizeof (parallel_clauses)); - do_clauses.sched_kind = parallel_clauses.sched_kind; - do_clauses.chunk_size = parallel_clauses.chunk_size; - do_clauses.ordered = parallel_clauses.ordered; - do_clauses.collapse = parallel_clauses.collapse; - parallel_clauses.sched_kind = OMP_SCHED_NONE; - parallel_clauses.chunk_size = NULL; - parallel_clauses.ordered = false; - parallel_clauses.collapse = 0; - omp_clauses = gfc_trans_omp_clauses (&block, ¶llel_clauses, - code->loc); + clausesa = clausesa_buf; + gfc_split_omp_clauses (code, clausesa); } - do_clauses.nowait = true; - if (!do_clauses.ordered && do_clauses.sched_kind != OMP_SCHED_STATIC) + omp_do_clauses + = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_DO], code->loc); + pblock = █ + body = gfc_trans_omp_do (code, EXEC_OMP_SIMD, pblock, + &clausesa[GFC_OMP_SPLIT_SIMD], omp_clauses); + if (TREE_CODE (body) != BIND_EXPR) + body = build3_v (BIND_EXPR, NULL, body, poplevel (1, 0)); + else + poplevel (0, 0); + stmt = make_node (OMP_FOR); + TREE_TYPE (stmt) = void_type_node; + OMP_FOR_BODY (stmt) = body; + OMP_FOR_CLAUSES (stmt) = omp_do_clauses; + gfc_add_expr_to_block (&block, stmt); + return gfc_finish_block (&block); +} + +static tree +gfc_trans_omp_parallel_do (gfc_code *code) +{ + stmtblock_t block, *pblock = NULL; + gfc_omp_clauses clausesa[GFC_OMP_SPLIT_NUM]; + tree stmt, omp_clauses = NULL_TREE; + + gfc_start_block (&block); + + gfc_split_omp_clauses (code, clausesa); + omp_clauses + = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_PARALLEL], + code->loc); + if (!clausesa[GFC_OMP_SPLIT_DO].ordered + && clausesa[GFC_OMP_SPLIT_DO].sched_kind != OMP_SCHED_STATIC) pblock = █ else pushlevel (); - stmt = gfc_trans_omp_do (code, pblock, &do_clauses, omp_clauses); + stmt = gfc_trans_omp_do (code, EXEC_OMP_DO, pblock, + &clausesa[GFC_OMP_SPLIT_DO], omp_clauses); + if (TREE_CODE (stmt) != BIND_EXPR) + stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); + else + poplevel (0, 0); + stmt = build2_loc (input_location, OMP_PARALLEL, void_type_node, stmt, + omp_clauses); + OMP_PARALLEL_COMBINED (stmt) = 1; + gfc_add_expr_to_block (&block, stmt); + return gfc_finish_block (&block); +} + +static tree +gfc_trans_omp_parallel_do_simd (gfc_code *code) +{ + stmtblock_t block; + gfc_omp_clauses clausesa[GFC_OMP_SPLIT_NUM]; + tree stmt, omp_clauses = NULL_TREE; + + gfc_start_block (&block); + + gfc_split_omp_clauses (code, clausesa); + omp_clauses + = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_PARALLEL], + code->loc); + pushlevel (); + stmt = gfc_trans_omp_do_simd (code, clausesa, omp_clauses); if (TREE_CODE (stmt) != BIND_EXPR) stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); else @@ -1743,6 +2240,13 @@ gfc_trans_omp_task (gfc_code *code) } static tree +gfc_trans_omp_taskgroup (gfc_code *code) +{ + tree stmt = gfc_trans_code (code->block->next); + return build1_loc (input_location, OMP_TASKGROUP, void_type_node, stmt); +} + +static tree gfc_trans_omp_taskwait (void) { tree decl = builtin_decl_explicit (BUILT_IN_GOMP_TASKWAIT); @@ -1923,10 +2427,18 @@ gfc_trans_omp_directive (gfc_code *code) return gfc_trans_omp_atomic (code); case EXEC_OMP_BARRIER: return gfc_trans_omp_barrier (); + case EXEC_OMP_CANCEL: + return gfc_trans_omp_cancel (code); + case EXEC_OMP_CANCELLATION_POINT: + return gfc_trans_omp_cancellation_point (code); case EXEC_OMP_CRITICAL: return gfc_trans_omp_critical (code); case EXEC_OMP_DO: - return gfc_trans_omp_do (code, NULL, code->ext.omp_clauses, NULL); + case EXEC_OMP_SIMD: + return gfc_trans_omp_do (code, code->op, NULL, code->ext.omp_clauses, + NULL); + case EXEC_OMP_DO_SIMD: + return gfc_trans_omp_do_simd (code, NULL, NULL_TREE); case EXEC_OMP_FLUSH: return gfc_trans_omp_flush (); case EXEC_OMP_MASTER: @@ -1937,6 +2449,8 @@ gfc_trans_omp_directive (gfc_code *code) return gfc_trans_omp_parallel (code); case EXEC_OMP_PARALLEL_DO: return gfc_trans_omp_parallel_do (code); + case EXEC_OMP_PARALLEL_DO_SIMD: + return gfc_trans_omp_parallel_do_simd (code); case EXEC_OMP_PARALLEL_SECTIONS: return gfc_trans_omp_parallel_sections (code); case EXEC_OMP_PARALLEL_WORKSHARE: @@ -1947,6 +2461,8 @@ gfc_trans_omp_directive (gfc_code *code) return gfc_trans_omp_single (code, code->ext.omp_clauses); case EXEC_OMP_TASK: return gfc_trans_omp_task (code); + case EXEC_OMP_TASKGROUP: + return gfc_trans_omp_taskgroup (code); case EXEC_OMP_TASKWAIT: return gfc_trans_omp_taskwait (); case EXEC_OMP_TASKYIELD: @@ -1957,3 +2473,22 @@ gfc_trans_omp_directive (gfc_code *code) gcc_unreachable (); } } + +void +gfc_trans_omp_declare_simd (gfc_namespace *ns) +{ + if (ns->entries) + return; + + gfc_omp_declare_simd *ods; + for (ods = ns->omp_declare_simd; ods; ods = ods->next) + { + tree c = gfc_trans_omp_clauses (NULL, ods->clauses, ods->where, true); + tree fndecl = ns->proc_name->backend_decl; + if (c != NULL_TREE) + c = tree_cons (NULL_TREE, c, NULL_TREE); + c = build_tree_list (get_identifier ("omp declare simd"), c); + TREE_CHAIN (c) = DECL_ATTRIBUTES (fndecl); + DECL_ATTRIBUTES (fndecl) = c; + } +} |