+/* Helper for gimplify_omp_loop, called through walk_tree. */
+
+static tree
+replace_reduction_placeholders (tree *tp, int *walk_subtrees, void *data)
+{
+ if (DECL_P (*tp))
+ {
+ tree *d = (tree *) data;
+ if (*tp == OMP_CLAUSE_REDUCTION_PLACEHOLDER (d[0]))
+ {
+ *tp = OMP_CLAUSE_REDUCTION_PLACEHOLDER (d[1]);
+ *walk_subtrees = 0;
+ }
+ else if (*tp == OMP_CLAUSE_REDUCTION_DECL_PLACEHOLDER (d[0]))
+ {
+ *tp = OMP_CLAUSE_REDUCTION_DECL_PLACEHOLDER (d[1]);
+ *walk_subtrees = 0;
+ }
+ }
+ return NULL_TREE;
+}
+
+/* Gimplify the gross structure of an OMP_LOOP statement. */
+
+static enum gimplify_status
+gimplify_omp_loop (tree *expr_p, gimple_seq *pre_p)
+{
+ tree for_stmt = *expr_p;
+ tree clauses = OMP_FOR_CLAUSES (for_stmt);
+ struct gimplify_omp_ctx *octx = gimplify_omp_ctxp;
+ enum omp_clause_bind_kind kind = OMP_CLAUSE_BIND_THREAD;
+ int i;
+
+ /* If order is not present, the behavior is as if order(concurrent)
+ appeared. */
+ tree order = omp_find_clause (clauses, OMP_CLAUSE_ORDER);
+ if (order == NULL_TREE)
+ {
+ order = build_omp_clause (UNKNOWN_LOCATION, OMP_CLAUSE_ORDER);
+ OMP_CLAUSE_CHAIN (order) = clauses;
+ OMP_FOR_CLAUSES (for_stmt) = clauses = order;
+ }
+
+ tree bind = omp_find_clause (clauses, OMP_CLAUSE_BIND);
+ if (bind == NULL_TREE)
+ {
+ if (!flag_openmp) /* flag_openmp_simd */
+ ;
+ else if (octx && (octx->region_type & ORT_TEAMS) != 0)
+ kind = OMP_CLAUSE_BIND_TEAMS;
+ else if (octx && (octx->region_type & ORT_PARALLEL) != 0)
+ kind = OMP_CLAUSE_BIND_PARALLEL;
+ else
+ {
+ for (; octx; octx = octx->outer_context)
+ {
+ if ((octx->region_type & ORT_ACC) != 0
+ || octx->region_type == ORT_NONE
+ || octx->region_type == ORT_IMPLICIT_TARGET)
+ continue;
+ break;
+ }
+ if (octx == NULL && !in_omp_construct)
+ error_at (EXPR_LOCATION (for_stmt),
+ "%<bind%> clause not specified on a %<loop%> "
+ "construct not nested inside another OpenMP construct");
+ }
+ bind = build_omp_clause (UNKNOWN_LOCATION, OMP_CLAUSE_BIND);
+ OMP_CLAUSE_CHAIN (bind) = clauses;
+ OMP_CLAUSE_BIND_KIND (bind) = kind;
+ OMP_FOR_CLAUSES (for_stmt) = bind;
+ }
+ else
+ switch (OMP_CLAUSE_BIND_KIND (bind))
+ {
+ case OMP_CLAUSE_BIND_THREAD:
+ break;
+ case OMP_CLAUSE_BIND_PARALLEL:
+ if (!flag_openmp) /* flag_openmp_simd */
+ {
+ OMP_CLAUSE_BIND_KIND (bind) = OMP_CLAUSE_BIND_THREAD;
+ break;
+ }
+ for (; octx; octx = octx->outer_context)
+ if (octx->region_type == ORT_SIMD
+ && omp_find_clause (octx->clauses, OMP_CLAUSE_BIND) == NULL_TREE)
+ {
+ error_at (EXPR_LOCATION (for_stmt),
+ "%<bind(parallel)%> on a %<loop%> construct nested "
+ "inside %<simd%> construct");
+ OMP_CLAUSE_BIND_KIND (bind) = OMP_CLAUSE_BIND_THREAD;
+ break;
+ }
+ kind = OMP_CLAUSE_BIND_PARALLEL;
+ break;
+ case OMP_CLAUSE_BIND_TEAMS:
+ if (!flag_openmp) /* flag_openmp_simd */
+ {
+ OMP_CLAUSE_BIND_KIND (bind) = OMP_CLAUSE_BIND_THREAD;
+ break;
+ }
+ if ((octx
+ && octx->region_type != ORT_IMPLICIT_TARGET
+ && octx->region_type != ORT_NONE
+ && (octx->region_type & ORT_TEAMS) == 0)
+ || in_omp_construct)
+ {
+ error_at (EXPR_LOCATION (for_stmt),
+ "%<bind(teams)%> on a %<loop%> region not strictly "
+ "nested inside of a %<teams%> region");
+ OMP_CLAUSE_BIND_KIND (bind) = OMP_CLAUSE_BIND_THREAD;
+ break;
+ }
+ kind = OMP_CLAUSE_BIND_TEAMS;
+ break;
+ default:
+ gcc_unreachable ();
+ }
+
+ for (tree *pc = &OMP_FOR_CLAUSES (for_stmt); *pc; )
+ switch (OMP_CLAUSE_CODE (*pc))
+ {
+ case OMP_CLAUSE_REDUCTION:
+ if (OMP_CLAUSE_REDUCTION_INSCAN (*pc))
+ {
+ error_at (OMP_CLAUSE_LOCATION (*pc),
+ "%<inscan%> %<reduction%> clause on "
+ "%qs construct", "loop");
+ OMP_CLAUSE_REDUCTION_INSCAN (*pc) = 0;
+ }
+ if (OMP_CLAUSE_REDUCTION_TASK (*pc))
+ {
+ error_at (OMP_CLAUSE_LOCATION (*pc),
+ "invalid %<task%> reduction modifier on construct "
+ "other than %<parallel%>, %<for%> or %<sections%>");
+ OMP_CLAUSE_REDUCTION_TASK (*pc) = 0;
+ }
+ pc = &OMP_CLAUSE_CHAIN (*pc);
+ break;
+ case OMP_CLAUSE_LASTPRIVATE:
+ for (i = 0; i < TREE_VEC_LENGTH (OMP_FOR_INIT (for_stmt)); i++)
+ {
+ tree t = TREE_VEC_ELT (OMP_FOR_INIT (for_stmt), i);
+ gcc_assert (TREE_CODE (t) == MODIFY_EXPR);
+ if (OMP_CLAUSE_DECL (*pc) == TREE_OPERAND (t, 0))
+ break;
+ if (OMP_FOR_ORIG_DECLS (for_stmt)
+ && TREE_CODE (TREE_VEC_ELT (OMP_FOR_ORIG_DECLS (for_stmt),
+ i)) == TREE_LIST
+ && TREE_PURPOSE (TREE_VEC_ELT (OMP_FOR_ORIG_DECLS (for_stmt),
+ i)))
+ {
+ tree orig = TREE_VEC_ELT (OMP_FOR_ORIG_DECLS (for_stmt), i);
+ if (OMP_CLAUSE_DECL (*pc) == TREE_PURPOSE (orig))
+ break;
+ }
+ }
+ if (i == TREE_VEC_LENGTH (OMP_FOR_INIT (for_stmt)))
+ {
+ error_at (OMP_CLAUSE_LOCATION (*pc),
+ "%<lastprivate%> clause on a %<loop%> construct refers "
+ "to a variable %qD which is not the loop iterator",
+ OMP_CLAUSE_DECL (*pc));
+ *pc = OMP_CLAUSE_CHAIN (*pc);
+ break;
+ }
+ pc = &OMP_CLAUSE_CHAIN (*pc);
+ break;
+ default:
+ pc = &OMP_CLAUSE_CHAIN (*pc);
+ break;
+ }
+
+ TREE_SET_CODE (for_stmt, OMP_SIMD);
+
+ int last;
+ switch (kind)
+ {
+ case OMP_CLAUSE_BIND_THREAD: last = 0; break;
+ case OMP_CLAUSE_BIND_PARALLEL: last = 1; break;
+ case OMP_CLAUSE_BIND_TEAMS: last = 2; break;
+ }
+ for (int pass = 1; pass <= last; pass++)
+ {
+ if (pass == 2)
+ {
+ tree bind = build3 (BIND_EXPR, void_type_node, NULL, NULL, NULL);
+ append_to_statement_list (*expr_p, &BIND_EXPR_BODY (bind));
+ *expr_p = make_node (OMP_PARALLEL);
+ TREE_TYPE (*expr_p) = void_type_node;
+ OMP_PARALLEL_BODY (*expr_p) = bind;
+ OMP_PARALLEL_COMBINED (*expr_p) = 1;
+ SET_EXPR_LOCATION (*expr_p, EXPR_LOCATION (for_stmt));
+ tree *pc = &OMP_PARALLEL_CLAUSES (*expr_p);
+ for (i = 0; i < TREE_VEC_LENGTH (OMP_FOR_INIT (for_stmt)); i++)
+ if (OMP_FOR_ORIG_DECLS (for_stmt)
+ && (TREE_CODE (TREE_VEC_ELT (OMP_FOR_ORIG_DECLS (for_stmt), i))
+ == TREE_LIST))
+ {
+ tree elt = TREE_VEC_ELT (OMP_FOR_ORIG_DECLS (for_stmt), i);
+ if (TREE_PURPOSE (elt) && TREE_VALUE (elt))
+ {
+ *pc = build_omp_clause (UNKNOWN_LOCATION,
+ OMP_CLAUSE_FIRSTPRIVATE);
+ OMP_CLAUSE_DECL (*pc) = TREE_VALUE (elt);
+ pc = &OMP_CLAUSE_CHAIN (*pc);
+ }
+ }
+ }
+ tree t = make_node (pass == 2 ? OMP_DISTRIBUTE : OMP_FOR);
+ tree *pc = &OMP_FOR_CLAUSES (t);
+ TREE_TYPE (t) = void_type_node;
+ OMP_FOR_BODY (t) = *expr_p;
+ SET_EXPR_LOCATION (t, EXPR_LOCATION (for_stmt));
+ for (tree c = OMP_FOR_CLAUSES (for_stmt); c; c = OMP_CLAUSE_CHAIN (c))
+ switch (OMP_CLAUSE_CODE (c))
+ {
+ case OMP_CLAUSE_BIND:
+ case OMP_CLAUSE_ORDER:
+ case OMP_CLAUSE_COLLAPSE:
+ *pc = copy_node (c);
+ pc = &OMP_CLAUSE_CHAIN (*pc);
+ break;
+ case OMP_CLAUSE_PRIVATE:
+ case OMP_CLAUSE_FIRSTPRIVATE:
+ /* Only needed on innermost. */
+ break;
+ case OMP_CLAUSE_LASTPRIVATE:
+ if (OMP_CLAUSE_LASTPRIVATE_LOOP_IV (c) && pass != last)
+ {
+ *pc = build_omp_clause (OMP_CLAUSE_LOCATION (c),
+ OMP_CLAUSE_FIRSTPRIVATE);
+ OMP_CLAUSE_DECL (*pc) = OMP_CLAUSE_DECL (c);
+ lang_hooks.decls.omp_finish_clause (*pc, NULL);
+ pc = &OMP_CLAUSE_CHAIN (*pc);
+ }
+ *pc = copy_node (c);
+ OMP_CLAUSE_LASTPRIVATE_STMT (*pc) = NULL_TREE;
+ TREE_TYPE (*pc) = unshare_expr (TREE_TYPE (c));
+ if (OMP_CLAUSE_LASTPRIVATE_LOOP_IV (c))
+ {
+ if (pass != last)
+ OMP_CLAUSE_LASTPRIVATE_FIRSTPRIVATE (*pc) = 1;
+ else
+ lang_hooks.decls.omp_finish_clause (*pc, NULL);
+ OMP_CLAUSE_LASTPRIVATE_LOOP_IV (*pc) = 0;
+ }
+ pc = &OMP_CLAUSE_CHAIN (*pc);
+ break;
+ case OMP_CLAUSE_REDUCTION:
+ *pc = copy_node (c);
+ OMP_CLAUSE_DECL (*pc) = unshare_expr (OMP_CLAUSE_DECL (c));
+ TREE_TYPE (*pc) = unshare_expr (TREE_TYPE (c));
+ OMP_CLAUSE_REDUCTION_INIT (*pc)
+ = unshare_expr (OMP_CLAUSE_REDUCTION_INIT (c));
+ OMP_CLAUSE_REDUCTION_MERGE (*pc)
+ = unshare_expr (OMP_CLAUSE_REDUCTION_MERGE (c));
+ if (OMP_CLAUSE_REDUCTION_PLACEHOLDER (*pc))
+ {
+ OMP_CLAUSE_REDUCTION_PLACEHOLDER (*pc)
+ = copy_node (OMP_CLAUSE_REDUCTION_PLACEHOLDER (c));
+ if (OMP_CLAUSE_REDUCTION_DECL_PLACEHOLDER (*pc))
+ OMP_CLAUSE_REDUCTION_DECL_PLACEHOLDER (*pc)
+ = copy_node (OMP_CLAUSE_REDUCTION_DECL_PLACEHOLDER (c));
+ tree nc = *pc;
+ tree data[2] = { c, nc };
+ walk_tree_without_duplicates (&OMP_CLAUSE_REDUCTION_INIT (nc),
+ replace_reduction_placeholders,
+ data);
+ walk_tree_without_duplicates (&OMP_CLAUSE_REDUCTION_MERGE (nc),
+ replace_reduction_placeholders,
+ data);
+ }
+ pc = &OMP_CLAUSE_CHAIN (*pc);
+ break;
+ default:
+ gcc_unreachable ();
+ }
+ *pc = NULL_TREE;
+ *expr_p = t;
+ }
+ return gimplify_omp_for (expr_p, pre_p);
+}
+
+