static tree gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock, gfc_omp_clauses *do_clauses) { gfc_se se; tree dovar, stmt, from, to, step, type, init, cond, incr; tree count = NULL_TREE, cycle_label, tmp, omp_clauses; stmtblock_t block; 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); if (pblock == NULL) { gfc_start_block (&block); pblock = █ } omp_clauses = gfc_trans_omp_clauses (pblock, do_clauses, code->loc); if (clauses) { gfc_namelist *n; for (n = clauses->lists[OMP_LIST_LASTPRIVATE]; n != NULL; n = n->next) if (code->ext.iterator->var->symtree->n.sym == n->sym) break; if (n == NULL) for (n = clauses->lists[OMP_LIST_PRIVATE]; n != NULL; n = n->next) if (code->ext.iterator->var->symtree->n.sym == n->sym) break; if (n != NULL) dovar_found = true; } /* Evaluate all the expressions in the iterator. */ gfc_init_se (&se, NULL); gfc_conv_expr_lhs (&se, code->ext.iterator->var); gfc_add_block_to_block (pblock, &se.pre); dovar = se.expr; type = TREE_TYPE (dovar); gcc_assert (TREE_CODE (type) == INTEGER_TYPE); gfc_init_se (&se, NULL); gfc_conv_expr_val (&se, code->ext.iterator->start); gfc_add_block_to_block (pblock, &se.pre); from = gfc_evaluate_now (se.expr, pblock); gfc_init_se (&se, NULL); gfc_conv_expr_val (&se, code->ext.iterator->end); gfc_add_block_to_block (pblock, &se.pre); to = gfc_evaluate_now (se.expr, pblock); gfc_init_se (&se, NULL); gfc_conv_expr_val (&se, code->ext.iterator->step); gfc_add_block_to_block (pblock, &se.pre); step = gfc_evaluate_now (se.expr, pblock); /* Special case simple loops. */ if (integer_onep (step)) simple = 1; else if (tree_int_cst_equal (step, integer_minus_one_node)) simple = -1; /* Loop body. */ if (simple) { init = build2_v (MODIFY_EXPR, 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); if (pblock != &block) { pushlevel (0); gfc_start_block (&block); } gfc_start_block (&body); } else { /* STEP is not 1 or -1. Use: for (count = 0; count < (to + step - from) / step; count++) { dovar = from + count * step; body; cycle_label:; } */ tmp = fold_build2 (MINUS_EXPR, type, step, from); tmp = fold_build2 (PLUS_EXPR, type, to, tmp); 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)); 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); if (pblock != &block) { pushlevel (0); gfc_start_block (&block); } gfc_start_block (&body); /* Initialize DOVAR. */ tmp = fold_build2 (MULT_EXPR, type, count, step); tmp = build2 (PLUS_EXPR, type, from, tmp); gfc_add_modify_expr (&body, dovar, tmp); } if (!dovar_found) { tmp = build_omp_clause (OMP_CLAUSE_PRIVATE); OMP_CLAUSE_DECL (tmp) = dovar; omp_clauses = gfc_trans_add_clause (tmp, omp_clauses); } if (!simple) { tmp = build_omp_clause (OMP_CLAUSE_PRIVATE); OMP_CLAUSE_DECL (tmp) = count; omp_clauses = gfc_trans_add_clause (tmp, omp_clauses); } /* Cycle statement is implemented with a goto. Exit statement must not be present for this loop. */ cycle_label = gfc_build_label_decl (NULL_TREE); /* Put these labels where they can be found later. We put the labels in a TREE_LIST node (because TREE_CHAIN is already used). cycle_label goes in TREE_PURPOSE (backend_decl), exit label in TREE_VALUE (backend_decl). */ code->block->backend_decl = tree_cons (cycle_label, NULL, NULL); /* Main loop body. */ tmp = gfc_trans_omp_code (code->block->next, true); gfc_add_expr_to_block (&body, tmp); /* Label for cycle statements (if needed). */ if (TREE_USED (cycle_label)) { tmp = build1_v (LABEL_EXPR, cycle_label); gfc_add_expr_to_block (&body, tmp); } /* End of loop body. */ stmt = make_node (OMP_FOR); TREE_TYPE (stmt) = void_type_node; OMP_FOR_BODY (stmt) = gfc_finish_block (&body); OMP_FOR_CLAUSES (stmt) = omp_clauses; OMP_FOR_INIT (stmt) = init; OMP_FOR_COND (stmt) = cond; OMP_FOR_INCR (stmt) = incr; gfc_add_expr_to_block (&block, stmt); return gfc_finish_block (&block); }
static tree gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock, gfc_omp_clauses *do_clauses, tree par_clauses) { gfc_se se; tree dovar, stmt, from, to, step, type, init, cond, incr; tree count = NULL_TREE, cycle_label, tmp, omp_clauses; stmtblock_t block; stmtblock_t body; gfc_omp_clauses *clauses = code->ext.omp_clauses; int i, collapse = clauses->collapse; tree dovar_init = NULL_TREE; if (collapse <= 0) collapse = 1; code = code->block->next; gcc_assert (code->op == EXEC_DO); init = make_tree_vec (collapse); cond = make_tree_vec (collapse); incr = make_tree_vec (collapse); if (pblock == NULL) { gfc_start_block (&block); pblock = █ } omp_clauses = gfc_trans_omp_clauses (pblock, do_clauses, code->loc); for (i = 0; i < collapse; i++) { int simple = 0; int dovar_found = 0; tree dovar_decl; if (clauses) { gfc_namelist *n; for (n = clauses->lists[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) for (n = clauses->lists[OMP_LIST_PRIVATE]; n != NULL; n = n->next) if (code->ext.iterator->var->symtree->n.sym == n->sym) break; if (n != NULL) dovar_found++; } /* Evaluate all the expressions in the iterator. */ gfc_init_se (&se, NULL); gfc_conv_expr_lhs (&se, code->ext.iterator->var); gfc_add_block_to_block (pblock, &se.pre); dovar = se.expr; type = TREE_TYPE (dovar); gcc_assert (TREE_CODE (type) == INTEGER_TYPE); gfc_init_se (&se, NULL); gfc_conv_expr_val (&se, code->ext.iterator->start); gfc_add_block_to_block (pblock, &se.pre); from = gfc_evaluate_now (se.expr, pblock); gfc_init_se (&se, NULL); gfc_conv_expr_val (&se, code->ext.iterator->end); gfc_add_block_to_block (pblock, &se.pre); to = gfc_evaluate_now (se.expr, pblock); gfc_init_se (&se, NULL); gfc_conv_expr_val (&se, code->ext.iterator->step); gfc_add_block_to_block (pblock, &se.pre); step = gfc_evaluate_now (se.expr, pblock); dovar_decl = dovar; /* Special case simple loops. */ if (TREE_CODE (dovar) == VAR_DECL) { if (integer_onep (step)) simple = 1; else if (tree_int_cst_equal (step, integer_minus_one_node)) simple = -1; } else dovar_decl = gfc_trans_omp_variable (code->ext.iterator->var->symtree->n.sym); /* Loop body. */ if (simple) { TREE_VEC_ELT (init, i) = build2_v (MODIFY_EXPR, dovar, from); TREE_VEC_ELT (cond, i) = fold_build2 (simple > 0 ? LE_EXPR : GE_EXPR, boolean_type_node, dovar, to); TREE_VEC_ELT (incr, i) = fold_build2 (PLUS_EXPR, type, dovar, step); TREE_VEC_ELT (incr, i) = fold_build2 (MODIFY_EXPR, type, dovar, TREE_VEC_ELT (incr, i)); } else { /* STEP is not 1 or -1. Use: for (count = 0; count < (to + step - from) / step; count++) { dovar = from + count * step; body; cycle_label:; } */ tmp = fold_build2 (MINUS_EXPR, type, step, from); tmp = fold_build2 (PLUS_EXPR, type, to, tmp); tmp = fold_build2 (TRUNC_DIV_EXPR, type, tmp, step); tmp = gfc_evaluate_now (tmp, pblock); count = gfc_create_var (type, "count"); TREE_VEC_ELT (init, i) = build2_v (MODIFY_EXPR, count, build_int_cst (type, 0)); TREE_VEC_ELT (cond, i) = fold_build2 (LT_EXPR, boolean_type_node, count, tmp); TREE_VEC_ELT (incr, i) = fold_build2 (PLUS_EXPR, type, count, build_int_cst (type, 1)); TREE_VEC_ELT (incr, i) = fold_build2 (MODIFY_EXPR, type, count, TREE_VEC_ELT (incr, i)); /* Initialize DOVAR. */ tmp = fold_build2 (MULT_EXPR, type, count, step); tmp = fold_build2 (PLUS_EXPR, type, from, tmp); dovar_init = tree_cons (dovar, tmp, dovar_init); } if (!dovar_found) { 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) { tree c = NULL; tmp = NULL; if (!simple) { /* If dovar is lastprivate, but different counter is used, dovar += step needs to be added to OMP_CLAUSE_LASTPRIVATE_STMT, otherwise the copied dovar will have the value on entry of the last loop, rather than value after iterator increment. */ tmp = gfc_evaluate_now (step, pblock); tmp = fold_build2 (PLUS_EXPR, type, dovar, tmp); tmp = fold_build2 (MODIFY_EXPR, type, dovar, tmp); for (c = omp_clauses; c ; c = OMP_CLAUSE_CHAIN (c)) if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LASTPRIVATE && OMP_CLAUSE_DECL (c) == dovar_decl) { OMP_CLAUSE_LASTPRIVATE_STMT (c) = tmp; break; } } if (c == NULL && par_clauses != NULL) { for (c = par_clauses; c ; c = OMP_CLAUSE_CHAIN (c)) if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LASTPRIVATE && OMP_CLAUSE_DECL (c) == dovar_decl) { tree l = build_omp_clause (input_location, OMP_CLAUSE_LASTPRIVATE); OMP_CLAUSE_DECL (l) = dovar_decl; OMP_CLAUSE_CHAIN (l) = omp_clauses; OMP_CLAUSE_LASTPRIVATE_STMT (l) = tmp; omp_clauses = l; OMP_CLAUSE_SET_CODE (c, OMP_CLAUSE_SHARED); break; } } gcc_assert (simple || c != NULL); } if (!simple) { tmp = build_omp_clause (input_location, OMP_CLAUSE_PRIVATE); OMP_CLAUSE_DECL (tmp) = count; omp_clauses = gfc_trans_add_clause (tmp, omp_clauses); } if (i + 1 < collapse) code = code->block->next; } if (pblock != &block) { pushlevel (0); gfc_start_block (&block); } gfc_start_block (&body); dovar_init = nreverse (dovar_init); while (dovar_init) { gfc_add_modify (&body, TREE_PURPOSE (dovar_init), TREE_VALUE (dovar_init)); dovar_init = TREE_CHAIN (dovar_init); } /* Cycle statement is implemented with a goto. Exit statement must not be present for this loop. */ cycle_label = gfc_build_label_decl (NULL_TREE); /* Put these labels where they can be found later. We put the labels in a TREE_LIST node (because TREE_CHAIN is already used). cycle_label goes in TREE_PURPOSE (backend_decl), exit label in TREE_VALUE (backend_decl). */ code->block->backend_decl = tree_cons (cycle_label, NULL, NULL); /* Main loop body. */ tmp = gfc_trans_omp_code (code->block->next, true); gfc_add_expr_to_block (&body, tmp); /* Label for cycle statements (if needed). */ if (TREE_USED (cycle_label)) { tmp = build1_v (LABEL_EXPR, cycle_label); gfc_add_expr_to_block (&body, tmp); } /* End of loop body. */ stmt = make_node (OMP_FOR); TREE_TYPE (stmt) = void_type_node; OMP_FOR_BODY (stmt) = gfc_finish_block (&body); OMP_FOR_CLAUSES (stmt) = omp_clauses; OMP_FOR_INIT (stmt) = init; OMP_FOR_COND (stmt) = cond; OMP_FOR_INCR (stmt) = incr; gfc_add_expr_to_block (&block, stmt); return gfc_finish_block (&block); }