static void gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where) { gfc_symtree *root1 = NULL, *root2 = NULL, *root3 = NULL, *root4 = NULL; gfc_symtree *symtree1, *symtree2, *symtree3, *symtree4 = NULL; gfc_symbol init_val_sym, outer_sym, intrinsic_sym; gfc_expr *e1, *e2, *e3, *e4; gfc_ref *ref; tree decl, backend_decl, stmt; locus old_loc = gfc_current_locus; const char *iname; try t; decl = OMP_CLAUSE_DECL (c); gfc_current_locus = where; /* Create a fake symbol for init value. */ memset (&init_val_sym, 0, sizeof (init_val_sym)); init_val_sym.ns = sym->ns; init_val_sym.name = sym->name; 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; /* Create a fake symbol for the outer array reference. */ outer_sym = *sym; 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. */ symtree1 = gfc_new_symtree (&root1, sym->name); symtree1->n.sym = sym; gcc_assert (symtree1 == root1); symtree2 = gfc_new_symtree (&root2, sym->name); symtree2->n.sym = &init_val_sym; gcc_assert (symtree2 == root2); symtree3 = gfc_new_symtree (&root3, sym->name); symtree3->n.sym = &outer_sym; gcc_assert (symtree3 == root3); /* Create expressions. */ e1 = gfc_get_expr (); e1->expr_type = EXPR_VARIABLE; e1->where = where; e1->symtree = symtree1; e1->ts = sym->ts; e1->ref = ref = gfc_get_ref (); ref->u.ar.where = where; ref->u.ar.as = sym->as; ref->u.ar.type = AR_FULL; ref->u.ar.dimen = 0; t = gfc_resolve_expr (e1); gcc_assert (t == SUCCESS); e2 = gfc_get_expr (); e2->expr_type = EXPR_VARIABLE; e2->where = where; e2->symtree = symtree2; e2->ts = sym->ts; t = gfc_resolve_expr (e2); gcc_assert (t == SUCCESS); e3 = gfc_copy_expr (e1); e3->symtree = symtree3; t = gfc_resolve_expr (e3); gcc_assert (t == SUCCESS); iname = NULL; switch (OMP_CLAUSE_REDUCTION_CODE (c)) { case PLUS_EXPR: case MINUS_EXPR: e4 = gfc_add (e3, e1); break; case MULT_EXPR: e4 = gfc_multiply (e3, e1); break; case TRUTH_ANDIF_EXPR: e4 = gfc_and (e3, e1); break; case TRUTH_ORIF_EXPR: e4 = gfc_or (e3, e1); break; case EQ_EXPR: e4 = gfc_eqv (e3, e1); break; case NE_EXPR: e4 = gfc_neqv (e3, e1); break; case MIN_EXPR: iname = "min"; break; case MAX_EXPR: iname = "max"; break; case BIT_AND_EXPR: iname = "iand"; break; case BIT_IOR_EXPR: iname = "ior"; break; case BIT_XOR_EXPR: iname = "ieor"; break; default: gcc_unreachable (); } if (iname != NULL) { memset (&intrinsic_sym, 0, sizeof (intrinsic_sym)); intrinsic_sym.ns = sym->ns; intrinsic_sym.name = iname; intrinsic_sym.ts = sym->ts; intrinsic_sym.attr.referenced = 1; intrinsic_sym.attr.intrinsic = 1; intrinsic_sym.attr.function = 1; intrinsic_sym.result = &intrinsic_sym; intrinsic_sym.declared_at = where; symtree4 = gfc_new_symtree (&root4, iname); symtree4->n.sym = &intrinsic_sym; gcc_assert (symtree4 == root4); e4 = gfc_get_expr (); e4->expr_type = EXPR_FUNCTION; e4->where = where; e4->symtree = symtree4; e4->value.function.isym = gfc_find_function (iname); e4->value.function.actual = gfc_get_actual_arglist (); e4->value.function.actual->expr = e3; e4->value.function.actual->next = gfc_get_actual_arglist (); e4->value.function.actual->next->expr = e1; } /* e1 and e3 have been stored as arguments of e4, avoid sharing. */ e1 = gfc_copy_expr (e1); e3 = gfc_copy_expr (e3); t = gfc_resolve_expr (e4); gcc_assert (t == SUCCESS); /* Create the init statement list. */ 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. */ 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; gfc_current_locus = old_loc; gfc_free_expr (e1); gfc_free_expr (e2); gfc_free_expr (e3); gfc_free_expr (e4); gfc_free (symtree1); gfc_free (symtree2); gfc_free (symtree3); if (symtree4) gfc_free (symtree4); gfc_free_array_spec (outer_sym.as); } static tree gfc_trans_omp_reduction_list (gfc_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); if (t != error_mark_node) { tree node = build_omp_clause (OMP_CLAUSE_REDUCTION); OMP_CLAUSE_DECL (node) = t; OMP_CLAUSE_REDUCTION_CODE (node) = reduction_code; if (namelist->sym->attr.dimension) gfc_trans_omp_array_reduction (node, namelist->sym, where); list = gfc_trans_add_clause (node, list); } } return list; } static tree gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, locus where) { tree omp_clauses = NULL_TREE, chunk_size, c, old_clauses; int list; enum omp_clause_code clause_code; gfc_se se; if (clauses == NULL) return NULL_TREE; for (list = 0; list < OMP_LIST_NUM; list++) { gfc_namelist *n = clauses->lists[list]; if (n == NULL) continue; if (list >= OMP_LIST_REDUCTION_FIRST && list <= OMP_LIST_REDUCTION_LAST) { enum tree_code reduction_code; switch (list) { case OMP_LIST_PLUS: reduction_code = PLUS_EXPR; break; case OMP_LIST_MULT: reduction_code = MULT_EXPR; break; case OMP_LIST_SUB: reduction_code = MINUS_EXPR; break; case OMP_LIST_AND: reduction_code = TRUTH_ANDIF_EXPR; break; case OMP_LIST_OR: reduction_code = TRUTH_ORIF_EXPR; break; case OMP_LIST_EQV: reduction_code = EQ_EXPR; break; case OMP_LIST_NEQV: reduction_code = NE_EXPR; break; case OMP_LIST_MAX: reduction_code = MAX_EXPR; break; case OMP_LIST_MIN: reduction_code = MIN_EXPR; break; case OMP_LIST_IAND: reduction_code = BIT_AND_EXPR; break; case OMP_LIST_IOR: reduction_code = BIT_IOR_EXPR; break; case OMP_LIST_IEOR: reduction_code = BIT_XOR_EXPR; break; default: gcc_unreachable (); } old_clauses = omp_clauses; omp_clauses = gfc_trans_omp_reduction_list (n, omp_clauses, reduction_code, where); continue; } switch (list) { case OMP_LIST_PRIVATE: clause_code = OMP_CLAUSE_PRIVATE; goto add_clause; case OMP_LIST_SHARED: clause_code = OMP_CLAUSE_SHARED; goto add_clause; case OMP_LIST_FIRSTPRIVATE: clause_code = OMP_CLAUSE_FIRSTPRIVATE; goto add_clause; case OMP_LIST_LASTPRIVATE: clause_code = OMP_CLAUSE_LASTPRIVATE; goto add_clause; case OMP_LIST_COPYIN: clause_code = OMP_CLAUSE_COPYIN; goto add_clause; case OMP_LIST_COPYPRIVATE: clause_code = OMP_CLAUSE_COPYPRIVATE; /* FALLTHROUGH */ add_clause: omp_clauses = gfc_trans_omp_variable_list (clause_code, n, omp_clauses); break; default: break; } } if (clauses->if_expr) { tree if_var; gfc_init_se (&se, NULL); gfc_conv_expr (&se, 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); c = build_omp_clause (OMP_CLAUSE_IF); OMP_CLAUSE_IF_EXPR (c) = if_var; omp_clauses = gfc_trans_add_clause (c, omp_clauses); } if (clauses->num_threads) { tree num_threads; gfc_init_se (&se, NULL); gfc_conv_expr (&se, clauses->num_threads); gfc_add_block_to_block (block, &se.pre); num_threads = gfc_evaluate_now (se.expr, block); gfc_add_block_to_block (block, &se.post); c = build_omp_clause (OMP_CLAUSE_NUM_THREADS); OMP_CLAUSE_NUM_THREADS_EXPR (c) = num_threads; omp_clauses = gfc_trans_add_clause (c, omp_clauses); } chunk_size = NULL_TREE; if (clauses->chunk_size) { gfc_init_se (&se, NULL); gfc_conv_expr (&se, clauses->chunk_size); gfc_add_block_to_block (block, &se.pre); chunk_size = gfc_evaluate_now (se.expr, block); gfc_add_block_to_block (block, &se.post); } if (clauses->sched_kind != OMP_SCHED_NONE) { c = build_omp_clause (OMP_CLAUSE_SCHEDULE); OMP_CLAUSE_SCHEDULE_CHUNK_EXPR (c) = chunk_size; switch (clauses->sched_kind) { case OMP_SCHED_STATIC: OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_STATIC; break; case OMP_SCHED_DYNAMIC: OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_DYNAMIC; break; case OMP_SCHED_GUIDED: OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_GUIDED; break; case OMP_SCHED_RUNTIME: OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_RUNTIME; break; default: gcc_unreachable (); } omp_clauses = gfc_trans_add_clause (c, omp_clauses); } if (clauses->default_sharing != OMP_DEFAULT_UNKNOWN) { c = build_omp_clause (OMP_CLAUSE_DEFAULT); switch (clauses->default_sharing) { case OMP_DEFAULT_NONE: OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_NONE; break; case OMP_DEFAULT_SHARED: OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_SHARED; break; case OMP_DEFAULT_PRIVATE: OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_PRIVATE; break; default: gcc_unreachable (); } omp_clauses = gfc_trans_add_clause (c, omp_clauses); } if (clauses->nowait) { c = build_omp_clause (OMP_CLAUSE_NOWAIT); omp_clauses = gfc_trans_add_clause (c, omp_clauses); } if (clauses->ordered) { c = build_omp_clause (OMP_CLAUSE_ORDERED); omp_clauses = gfc_trans_add_clause (c, omp_clauses); } return omp_clauses; }
void c_omp_split_clauses (location_t loc, enum tree_code code, omp_clause_mask mask, tree clauses, tree *cclauses) { tree next, c; enum c_omp_clause_split s; int i; for (i = 0; i < C_OMP_CLAUSE_SPLIT_COUNT; i++) cclauses[i] = NULL; /* Add implicit nowait clause on #pragma omp parallel {for,for simd,sections}. */ if ((mask & (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_NUM_THREADS)) != 0) switch (code) { case OMP_FOR: case OMP_SIMD: cclauses[C_OMP_CLAUSE_SPLIT_FOR] = build_omp_clause (loc, OMP_CLAUSE_NOWAIT); break; case OMP_SECTIONS: cclauses[C_OMP_CLAUSE_SPLIT_SECTIONS] = build_omp_clause (loc, OMP_CLAUSE_NOWAIT); break; default: break; } for (; clauses ; clauses = next) { next = OMP_CLAUSE_CHAIN (clauses); switch (OMP_CLAUSE_CODE (clauses)) { /* First the clauses that are unique to some constructs. */ case OMP_CLAUSE_DEVICE: case OMP_CLAUSE_MAP: case OMP_CLAUSE_IS_DEVICE_PTR: case OMP_CLAUSE_DEFAULTMAP: s = C_OMP_CLAUSE_SPLIT_TARGET; break; case OMP_CLAUSE_NUM_TEAMS: case OMP_CLAUSE_THREAD_LIMIT: s = C_OMP_CLAUSE_SPLIT_TEAMS; break; case OMP_CLAUSE_DIST_SCHEDULE: s = C_OMP_CLAUSE_SPLIT_DISTRIBUTE; break; case OMP_CLAUSE_COPYIN: case OMP_CLAUSE_NUM_THREADS: case OMP_CLAUSE_PROC_BIND: s = C_OMP_CLAUSE_SPLIT_PARALLEL; break; case OMP_CLAUSE_ORDERED: case OMP_CLAUSE_NOWAIT: s = C_OMP_CLAUSE_SPLIT_FOR; break; case OMP_CLAUSE_SCHEDULE: s = C_OMP_CLAUSE_SPLIT_FOR; if (code != OMP_SIMD) OMP_CLAUSE_SCHEDULE_SIMD (clauses) = 0; break; case OMP_CLAUSE_SAFELEN: case OMP_CLAUSE_SIMDLEN: case OMP_CLAUSE_ALIGNED: s = C_OMP_CLAUSE_SPLIT_SIMD; break; case OMP_CLAUSE_GRAINSIZE: case OMP_CLAUSE_NUM_TASKS: case OMP_CLAUSE_FINAL: case OMP_CLAUSE_UNTIED: case OMP_CLAUSE_MERGEABLE: case OMP_CLAUSE_NOGROUP: case OMP_CLAUSE_PRIORITY: s = C_OMP_CLAUSE_SPLIT_TASKLOOP; break; /* Duplicate this to all of taskloop, distribute, for and simd. */ case OMP_CLAUSE_COLLAPSE: if (code == OMP_SIMD) { if ((mask & ((OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_SCHEDULE) | (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_DIST_SCHEDULE) | (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_NOGROUP))) != 0) { c = build_omp_clause (OMP_CLAUSE_LOCATION (clauses), OMP_CLAUSE_COLLAPSE); OMP_CLAUSE_COLLAPSE_EXPR (c) = OMP_CLAUSE_COLLAPSE_EXPR (clauses); OMP_CLAUSE_CHAIN (c) = cclauses[C_OMP_CLAUSE_SPLIT_SIMD]; cclauses[C_OMP_CLAUSE_SPLIT_SIMD] = c; } else { /* This must be #pragma omp target simd */ s = C_OMP_CLAUSE_SPLIT_SIMD; break; } } if ((mask & (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_SCHEDULE)) != 0) { if ((mask & (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_DIST_SCHEDULE)) != 0) { c = build_omp_clause (OMP_CLAUSE_LOCATION (clauses), OMP_CLAUSE_COLLAPSE); OMP_CLAUSE_COLLAPSE_EXPR (c) = OMP_CLAUSE_COLLAPSE_EXPR (clauses); OMP_CLAUSE_CHAIN (c) = cclauses[C_OMP_CLAUSE_SPLIT_FOR]; cclauses[C_OMP_CLAUSE_SPLIT_FOR] = c; s = C_OMP_CLAUSE_SPLIT_DISTRIBUTE; } else s = C_OMP_CLAUSE_SPLIT_FOR; } else if ((mask & (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_NOGROUP)) != 0) s = C_OMP_CLAUSE_SPLIT_TASKLOOP; else s = C_OMP_CLAUSE_SPLIT_DISTRIBUTE; break; /* Private clause is supported on all constructs, it is enough to put it on the innermost one. For #pragma omp {for,sections} put it on parallel though, as that's what we did for OpenMP 3.1. */ case OMP_CLAUSE_PRIVATE: switch (code) { case OMP_SIMD: s = C_OMP_CLAUSE_SPLIT_SIMD; break; case OMP_FOR: case OMP_SECTIONS: case OMP_PARALLEL: s = C_OMP_CLAUSE_SPLIT_PARALLEL; break; case OMP_DISTRIBUTE: s = C_OMP_CLAUSE_SPLIT_DISTRIBUTE; break; case OMP_TEAMS: s = C_OMP_CLAUSE_SPLIT_TEAMS; break; default: gcc_unreachable (); } break; /* Firstprivate clause is supported on all constructs but simd. Put it on the outermost of those and duplicate on teams and parallel. */ case OMP_CLAUSE_FIRSTPRIVATE: if ((mask & (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_MAP)) != 0) { if (code == OMP_SIMD && (mask & ((OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_NUM_THREADS) | (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_NUM_TEAMS))) == 0) { /* This must be #pragma omp target simd. */ s = C_OMP_CLAUSE_SPLIT_TARGET; break; } c = build_omp_clause (OMP_CLAUSE_LOCATION (clauses), OMP_CLAUSE_FIRSTPRIVATE); OMP_CLAUSE_DECL (c) = OMP_CLAUSE_DECL (clauses); OMP_CLAUSE_CHAIN (c) = cclauses[C_OMP_CLAUSE_SPLIT_TARGET]; cclauses[C_OMP_CLAUSE_SPLIT_TARGET] = c; } if ((mask & (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_NUM_THREADS)) != 0) { if ((mask & ((OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_NUM_TEAMS) | (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_DIST_SCHEDULE))) != 0) { c = build_omp_clause (OMP_CLAUSE_LOCATION (clauses), OMP_CLAUSE_FIRSTPRIVATE); OMP_CLAUSE_DECL (c) = OMP_CLAUSE_DECL (clauses); OMP_CLAUSE_CHAIN (c) = cclauses[C_OMP_CLAUSE_SPLIT_PARALLEL]; cclauses[C_OMP_CLAUSE_SPLIT_PARALLEL] = c; if ((mask & (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_NUM_TEAMS)) != 0) s = C_OMP_CLAUSE_SPLIT_TEAMS; else s = C_OMP_CLAUSE_SPLIT_DISTRIBUTE; } else /* This must be #pragma omp parallel{, for{, simd}, sections} or #pragma omp target parallel. */ s = C_OMP_CLAUSE_SPLIT_PARALLEL; } else if ((mask & (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_NUM_TEAMS)) != 0) { /* This must be one of #pragma omp {,target }teams distribute #pragma omp target teams #pragma omp {,target }teams distribute simd. */ gcc_assert (code == OMP_DISTRIBUTE || code == OMP_TEAMS || code == OMP_SIMD); s = C_OMP_CLAUSE_SPLIT_TEAMS; } else if ((mask & (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_DIST_SCHEDULE)) != 0) { /* This must be #pragma omp distribute simd. */ gcc_assert (code == OMP_SIMD); s = C_OMP_CLAUSE_SPLIT_DISTRIBUTE; } else if ((mask & (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_NOGROUP)) != 0) { /* This must be #pragma omp taskloop simd. */ gcc_assert (code == OMP_SIMD); s = C_OMP_CLAUSE_SPLIT_TASKLOOP; } else { /* This must be #pragma omp for simd. */ gcc_assert (code == OMP_SIMD); s = C_OMP_CLAUSE_SPLIT_FOR; } break; /* Lastprivate is allowed on for, sections and simd. In parallel {for{, simd},sections} we actually want to put it on parallel rather than for or sections. */ case OMP_CLAUSE_LASTPRIVATE: if (code == OMP_FOR || code == OMP_SECTIONS) { if ((mask & (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_NUM_THREADS)) != 0) s = C_OMP_CLAUSE_SPLIT_PARALLEL; else s = C_OMP_CLAUSE_SPLIT_FOR; break; } gcc_assert (code == OMP_SIMD); if ((mask & (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_SCHEDULE)) != 0) { c = build_omp_clause (OMP_CLAUSE_LOCATION (clauses), OMP_CLAUSE_LASTPRIVATE); OMP_CLAUSE_DECL (c) = OMP_CLAUSE_DECL (clauses); if ((mask & (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_NUM_THREADS)) != 0) s = C_OMP_CLAUSE_SPLIT_PARALLEL; else s = C_OMP_CLAUSE_SPLIT_FOR; OMP_CLAUSE_CHAIN (c) = cclauses[s]; cclauses[s] = c; } s = C_OMP_CLAUSE_SPLIT_SIMD; break; /* Shared and default clauses are allowed on parallel, teams and taskloop. */ case OMP_CLAUSE_SHARED: case OMP_CLAUSE_DEFAULT: if ((mask & (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_NOGROUP)) != 0) { s = C_OMP_CLAUSE_SPLIT_TASKLOOP; break; } if ((mask & (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_NUM_TEAMS)) != 0) { if ((mask & (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_NUM_THREADS)) == 0) { s = C_OMP_CLAUSE_SPLIT_TEAMS; break; } c = build_omp_clause (OMP_CLAUSE_LOCATION (clauses), OMP_CLAUSE_CODE (clauses)); if (OMP_CLAUSE_CODE (clauses) == OMP_CLAUSE_SHARED) OMP_CLAUSE_DECL (c) = OMP_CLAUSE_DECL (clauses); else OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_KIND (clauses); OMP_CLAUSE_CHAIN (c) = cclauses[C_OMP_CLAUSE_SPLIT_TEAMS]; cclauses[C_OMP_CLAUSE_SPLIT_TEAMS] = c; } s = C_OMP_CLAUSE_SPLIT_PARALLEL; break; /* Reduction is allowed on simd, for, parallel, sections and teams. Duplicate it on all of them, but omit on for or sections if parallel is present. */ case OMP_CLAUSE_REDUCTION: if ((mask & (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_SCHEDULE)) != 0) { if (code == OMP_SIMD) { c = build_omp_clause (OMP_CLAUSE_LOCATION (clauses), OMP_CLAUSE_REDUCTION); OMP_CLAUSE_DECL (c) = OMP_CLAUSE_DECL (clauses); OMP_CLAUSE_REDUCTION_CODE (c) = OMP_CLAUSE_REDUCTION_CODE (clauses); OMP_CLAUSE_REDUCTION_PLACEHOLDER (c) = OMP_CLAUSE_REDUCTION_PLACEHOLDER (clauses); OMP_CLAUSE_REDUCTION_DECL_PLACEHOLDER (c) = OMP_CLAUSE_REDUCTION_DECL_PLACEHOLDER (clauses); OMP_CLAUSE_CHAIN (c) = cclauses[C_OMP_CLAUSE_SPLIT_SIMD]; cclauses[C_OMP_CLAUSE_SPLIT_SIMD] = c; } if ((mask & (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_NUM_TEAMS)) != 0) { c = build_omp_clause (OMP_CLAUSE_LOCATION (clauses), OMP_CLAUSE_REDUCTION); OMP_CLAUSE_DECL (c) = OMP_CLAUSE_DECL (clauses); OMP_CLAUSE_REDUCTION_CODE (c) = OMP_CLAUSE_REDUCTION_CODE (clauses); OMP_CLAUSE_REDUCTION_PLACEHOLDER (c) = OMP_CLAUSE_REDUCTION_PLACEHOLDER (clauses); OMP_CLAUSE_REDUCTION_DECL_PLACEHOLDER (c) = OMP_CLAUSE_REDUCTION_DECL_PLACEHOLDER (clauses); OMP_CLAUSE_CHAIN (c) = cclauses[C_OMP_CLAUSE_SPLIT_PARALLEL]; cclauses[C_OMP_CLAUSE_SPLIT_PARALLEL] = c; s = C_OMP_CLAUSE_SPLIT_TEAMS; } else if ((mask & (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_NUM_THREADS)) != 0) s = C_OMP_CLAUSE_SPLIT_PARALLEL; else s = C_OMP_CLAUSE_SPLIT_FOR; } else if (code == OMP_SECTIONS || code == OMP_PARALLEL) s = C_OMP_CLAUSE_SPLIT_PARALLEL; else if (code == OMP_SIMD) s = C_OMP_CLAUSE_SPLIT_SIMD; else s = C_OMP_CLAUSE_SPLIT_TEAMS; break; case OMP_CLAUSE_IF: if ((mask & (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_NOGROUP)) != 0) s = C_OMP_CLAUSE_SPLIT_TASKLOOP; else if ((mask & (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_NUM_THREADS)) != 0) { if ((mask & (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_MAP)) != 0) { if (OMP_CLAUSE_IF_MODIFIER (clauses) == OMP_PARALLEL) s = C_OMP_CLAUSE_SPLIT_PARALLEL; else if (OMP_CLAUSE_IF_MODIFIER (clauses) == OMP_TARGET) s = C_OMP_CLAUSE_SPLIT_TARGET; else if (OMP_CLAUSE_IF_MODIFIER (clauses) == ERROR_MARK) { c = build_omp_clause (OMP_CLAUSE_LOCATION (clauses), OMP_CLAUSE_IF); OMP_CLAUSE_IF_MODIFIER (c) = OMP_CLAUSE_IF_MODIFIER (clauses); OMP_CLAUSE_IF_EXPR (c) = OMP_CLAUSE_IF_EXPR (clauses); OMP_CLAUSE_CHAIN (c) = cclauses[C_OMP_CLAUSE_SPLIT_TARGET]; cclauses[C_OMP_CLAUSE_SPLIT_TARGET] = c; s = C_OMP_CLAUSE_SPLIT_PARALLEL; } else { error_at (OMP_CLAUSE_LOCATION (clauses), "expected %<parallel%> or %<target%> %<if%> " "clause modifier"); continue; } } else s = C_OMP_CLAUSE_SPLIT_PARALLEL; } else s = C_OMP_CLAUSE_SPLIT_TARGET; break; case OMP_CLAUSE_LINEAR: /* Linear clause is allowed on simd and for. Put it on the innermost construct. */ if (code == OMP_SIMD) s = C_OMP_CLAUSE_SPLIT_SIMD; else s = C_OMP_CLAUSE_SPLIT_FOR; break; default: gcc_unreachable (); } OMP_CLAUSE_CHAIN (clauses) = cclauses[s]; cclauses[s] = clauses; } #ifdef ENABLE_CHECKING if ((mask & (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_MAP)) == 0) gcc_assert (cclauses[C_OMP_CLAUSE_SPLIT_TARGET] == NULL_TREE); if ((mask & (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_NUM_TEAMS)) == 0) gcc_assert (cclauses[C_OMP_CLAUSE_SPLIT_TEAMS] == NULL_TREE); if ((mask & (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_DIST_SCHEDULE)) == 0) gcc_assert (cclauses[C_OMP_CLAUSE_SPLIT_DISTRIBUTE] == NULL_TREE); if ((mask & (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_NUM_THREADS)) == 0) gcc_assert (cclauses[C_OMP_CLAUSE_SPLIT_PARALLEL] == NULL_TREE); if ((mask & ((OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_SCHEDULE) | (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_NOGROUP))) == 0 && code != OMP_SECTIONS) gcc_assert (cclauses[C_OMP_CLAUSE_SPLIT_FOR] == NULL_TREE); if (code != OMP_SIMD) gcc_assert (cclauses[C_OMP_CLAUSE_SPLIT_SIMD] == NULL_TREE); #endif }
static tree gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, locus where) { tree omp_clauses = NULL_TREE, chunk_size, c; int list; enum omp_clause_code clause_code; gfc_se se; if (clauses == NULL) return NULL_TREE; for (list = 0; list < OMP_LIST_NUM; list++) { gfc_namelist *n = clauses->lists[list]; if (n == NULL) continue; if (list >= OMP_LIST_REDUCTION_FIRST && list <= OMP_LIST_REDUCTION_LAST) { enum tree_code reduction_code; switch (list) { case OMP_LIST_PLUS: reduction_code = PLUS_EXPR; break; case OMP_LIST_MULT: reduction_code = MULT_EXPR; break; case OMP_LIST_SUB: reduction_code = MINUS_EXPR; break; case OMP_LIST_AND: reduction_code = TRUTH_ANDIF_EXPR; break; case OMP_LIST_OR: reduction_code = TRUTH_ORIF_EXPR; break; case OMP_LIST_EQV: reduction_code = EQ_EXPR; break; case OMP_LIST_NEQV: reduction_code = NE_EXPR; break; case OMP_LIST_MAX: reduction_code = MAX_EXPR; break; case OMP_LIST_MIN: reduction_code = MIN_EXPR; break; case OMP_LIST_IAND: reduction_code = BIT_AND_EXPR; break; case OMP_LIST_IOR: reduction_code = BIT_IOR_EXPR; break; case OMP_LIST_IEOR: reduction_code = BIT_XOR_EXPR; break; default: gcc_unreachable (); } omp_clauses = gfc_trans_omp_reduction_list (n, omp_clauses, reduction_code, where); continue; } switch (list) { case OMP_LIST_PRIVATE: clause_code = OMP_CLAUSE_PRIVATE; goto add_clause; case OMP_LIST_SHARED: clause_code = OMP_CLAUSE_SHARED; goto add_clause; case OMP_LIST_FIRSTPRIVATE: clause_code = OMP_CLAUSE_FIRSTPRIVATE; goto add_clause; case OMP_LIST_LASTPRIVATE: clause_code = OMP_CLAUSE_LASTPRIVATE; goto add_clause; case OMP_LIST_COPYIN: clause_code = OMP_CLAUSE_COPYIN; goto add_clause; case OMP_LIST_COPYPRIVATE: clause_code = OMP_CLAUSE_COPYPRIVATE; /* FALLTHROUGH */ add_clause: omp_clauses = gfc_trans_omp_variable_list (clause_code, n, omp_clauses); break; default: break; } } if (clauses->if_expr) { tree if_var; gfc_init_se (&se, NULL); gfc_conv_expr (&se, 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); c = build_omp_clause (where.lb->location, OMP_CLAUSE_IF); OMP_CLAUSE_IF_EXPR (c) = if_var; omp_clauses = gfc_trans_add_clause (c, omp_clauses); } if (clauses->num_threads) { tree num_threads; gfc_init_se (&se, NULL); gfc_conv_expr (&se, clauses->num_threads); gfc_add_block_to_block (block, &se.pre); num_threads = gfc_evaluate_now (se.expr, block); gfc_add_block_to_block (block, &se.post); c = build_omp_clause (where.lb->location, OMP_CLAUSE_NUM_THREADS); OMP_CLAUSE_NUM_THREADS_EXPR (c) = num_threads; omp_clauses = gfc_trans_add_clause (c, omp_clauses); } chunk_size = NULL_TREE; if (clauses->chunk_size) { gfc_init_se (&se, NULL); gfc_conv_expr (&se, clauses->chunk_size); gfc_add_block_to_block (block, &se.pre); chunk_size = gfc_evaluate_now (se.expr, block); gfc_add_block_to_block (block, &se.post); } if (clauses->sched_kind != OMP_SCHED_NONE) { c = build_omp_clause (where.lb->location, OMP_CLAUSE_SCHEDULE); OMP_CLAUSE_SCHEDULE_CHUNK_EXPR (c) = chunk_size; switch (clauses->sched_kind) { case OMP_SCHED_STATIC: OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_STATIC; break; case OMP_SCHED_DYNAMIC: OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_DYNAMIC; break; case OMP_SCHED_GUIDED: OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_GUIDED; break; case OMP_SCHED_RUNTIME: OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_RUNTIME; break; case OMP_SCHED_AUTO: OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_AUTO; break; default: gcc_unreachable (); } omp_clauses = gfc_trans_add_clause (c, omp_clauses); } if (clauses->default_sharing != OMP_DEFAULT_UNKNOWN) { c = build_omp_clause (where.lb->location, OMP_CLAUSE_DEFAULT); switch (clauses->default_sharing) { case OMP_DEFAULT_NONE: OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_NONE; break; case OMP_DEFAULT_SHARED: OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_SHARED; break; case OMP_DEFAULT_PRIVATE: OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_PRIVATE; break; case OMP_DEFAULT_FIRSTPRIVATE: OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_FIRSTPRIVATE; break; default: gcc_unreachable (); } omp_clauses = gfc_trans_add_clause (c, omp_clauses); } if (clauses->nowait) { c = build_omp_clause (where.lb->location, OMP_CLAUSE_NOWAIT); omp_clauses = gfc_trans_add_clause (c, omp_clauses); } if (clauses->ordered) { c = build_omp_clause (where.lb->location, OMP_CLAUSE_ORDERED); omp_clauses = gfc_trans_add_clause (c, omp_clauses); } if (clauses->untied) { c = build_omp_clause (where.lb->location, OMP_CLAUSE_UNTIED); omp_clauses = gfc_trans_add_clause (c, omp_clauses); } if (clauses->collapse) { c = build_omp_clause (where.lb->location, OMP_CLAUSE_COLLAPSE); OMP_CLAUSE_COLLAPSE_EXPR (c) = build_int_cst (NULL, clauses->collapse); omp_clauses = gfc_trans_add_clause (c, omp_clauses); } return omp_clauses; }