From patchwork Fri May 27 15:21:59 2016 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Jakub Jelinek X-Patchwork-Id: 627266 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 3rGVB343TNz9sf9 for ; Sat, 28 May 2016 01:22:19 +1000 (AEST) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b=atuJFgtJ; dkim-atps=neutral DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:subject:message-id:reply-to:mime-version:content-type; q=dns; s=default; b=yYD8ZDLZJmLG+859ovwTuOjikErBuiYk56oVjE1dArX i0AiD3JVFUJZv6242sGc2RtmOVHoS6ffM8x7cr/uy04ROQJzt/OQ8C2OEp9s4Vsj ee0vqKTD0YSuEVZhSTVwoT6FkgkznoLJyrAshlwuB7HqQwb7CjuZE+zt4VZkQhoc = DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:subject:message-id:reply-to:mime-version:content-type; s=default; bh=oW/+yOT/61GpYfC7iBkyCjJLfFs=; b=atuJFgtJ/5ATySEx7 uBz5vITF/ezIU4yi2w+jIlR1o9X3+3oJbbCre8VistRVEQTDnuB7gkBqYmV1xtxs vn88X8uoAYHgAch3VALv2VIpgV5M/EsVNjhVHJSZN92jh0GuJRFEJzB663c5jzOC fyPjutEyf7mPCiTtLhuTR/Qsdc= Received: (qmail 60040 invoked by alias); 27 May 2016 15:22:09 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 60021 invoked by uid 89); 27 May 2016 15:22:08 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-3.3 required=5.0 tests=BAYES_00, RP_MATCHES_RCVD, SPF_HELO_PASS autolearn=ham version=3.3.2 spammy=underneath, stc, neg, 47000000000 X-Spam-User: qpsmtpd, 2 recipients X-HELO: mx1.redhat.com Received: from mx1.redhat.com (HELO mx1.redhat.com) (209.132.183.28) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES256-GCM-SHA384 encrypted) ESMTPS; Fri, 27 May 2016 15:22:06 +0000 Received: from int-mx14.intmail.prod.int.phx2.redhat.com (int-mx14.intmail.prod.int.phx2.redhat.com [10.5.11.27]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by mx1.redhat.com (Postfix) with ESMTPS id C8C7B7AE82; Fri, 27 May 2016 15:22:04 +0000 (UTC) Received: from tucnak.zalov.cz (ovpn-116-51.ams2.redhat.com [10.36.116.51]) by int-mx14.intmail.prod.int.phx2.redhat.com (8.14.4/8.14.4) with ESMTP id u4RFM2Cr024744 (version=TLSv1/SSLv3 cipher=DHE-RSA-AES256-GCM-SHA384 bits=256 verify=NO); Fri, 27 May 2016 11:22:04 -0400 Received: from tucnak.zalov.cz (localhost [127.0.0.1]) by tucnak.zalov.cz (8.15.2/8.15.2) with ESMTP id u4RFM1Q8023539; Fri, 27 May 2016 17:22:01 +0200 Received: (from jakub@localhost) by tucnak.zalov.cz (8.15.2/8.15.2/Submit) id u4RFLxdm023538; Fri, 27 May 2016 17:21:59 +0200 Date: Fri, 27 May 2016 17:21:59 +0200 From: Jakub Jelinek To: gcc-patches@gcc.gnu.org, fortran@gcc.gnu.org Subject: [gomp4.5] Partial support for Fortran OpenMP doacross loops Message-ID: <20160527152159.GH28550@tucnak.redhat.com> Reply-To: Jakub Jelinek MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.24 (2015-08-30) X-IsSubscribed: yes Hi! I've committed the following patch to gomp-4_5-branch, which contains initial version of doacross Fortran support. No testcase yet, as only simple loops (ones with constant 1 or -1 step) work right now, for non-simple ones (variable step or non-1/-1 step) I'll need to add some middle-end support, because for those we emit to the middle-end a loop starting at 0 and with step 1 and thus need to adjust the depend(sink:) expansion. 2016-05-27 Jakub Jelinek * gfortran.h (enum gfc_statement): Add ST_OMP_ORDERED_DEPEND. (enum gfc_omp_depend_op): Add OMP_DEPEND_SINK_FIRST and OMP_DEPEND_SINK. (struct gfc_omp_clauses): Add depend_source field. * parse.c (decode_omp_directive): If ordered directive has depend clause as the first of the clauses, use gfc_match_omp_ordered_depend and ST_OMP_ORDERED_DEPEND instead of gfc_match_omp_ordered and ST_OMP_ORDERED. (case_executable): Add ST_OMP_ORDERED_DEPEND case. (gfc_ascii_statement): Handle ST_OMP_ORDERED_DEPEND. * st.c (gfc_free_statement): Free omp clauses even for EXEC_OMP_ORDERED. * dump-parse-tree.c (show_omp_namelist): Handle OMP_DEPEND_SINK_FIRST depend_op. (show_omp_clauses): Handle depend_source. (show_omp_node): Print clauses for EXEC_OMP_ORDERED. Allow NULL c->block for EXEC_OMP_ORDERED. * trans-openmp.c (gfc_trans_omp_clauses): Handle OMP_DEPEND_SINK_FIRST depend_op. Handle orderedc and depend_source. (gfc_trans_omp_do): Set collapse to orderedc if non-zero. Fill in OMP_FOR_ORIG_DECLS for doacross loops. (gfc_trans_omp_ordered): Translate omp clauses, allow NULL code->block. (gfc_split_omp_clauses): Copy orderedc together with ordered. * frontend-passes.c (gfc_code_walker): Handle EXEC_OMP_ORDERED. * openmp.c (gfc_match_omp_depend_sink): New function. (gfc_match_omp_clauses): Parse depend(source) and depend(sink: ...). (OMP_ORDERED_CLAUSES): Define. (gfc_match_omp_ordered): Parse clauses. (gfc_match_omp_ordered_depend): New function. (resolve_omp_clauses): Require orderedc >= collapse if specified. Handle depend(sink:) and depend(source) restrictions. Disallow linear clause when orderedc is non-zero. (gfc_resolve_omp_do_blocks): Set omp_current_do_collapse to orderedc if non-zero. (resolve_omp_do): Set collapse to orderedc if non-zero. * match.h (gfc_match_omp_ordered_depend): New prototype. * match.c (match_exit_cycle): Rename collapse variable to count, set it to orderedc if non-zero, instead of collapse. Jakub --- gcc/fortran/gfortran.h.jj 2016-05-23 17:20:09.000000000 +0200 +++ gcc/fortran/gfortran.h 2016-05-25 18:23:54.740764529 +0200 @@ -246,7 +246,7 @@ enum gfc_statement ST_OMP_TARGET_ENTER_DATA, ST_OMP_TARGET_EXIT_DATA, ST_OMP_TARGET_SIMD, ST_OMP_END_TARGET_SIMD, ST_OMP_TASKLOOP, ST_OMP_END_TASKLOOP, - ST_OMP_TASKLOOP_SIMD, ST_OMP_END_TASKLOOP_SIMD, + ST_OMP_TASKLOOP_SIMD, ST_OMP_END_TASKLOOP_SIMD, ST_OMP_ORDERED_DEPEND, ST_PROCEDURE, ST_GENERIC, ST_CRITICAL, ST_END_CRITICAL, ST_GET_FCN_CHARACTERISTICS, ST_LOCK, ST_UNLOCK, ST_EVENT_POST, ST_EVENT_WAIT,ST_NONE @@ -1110,7 +1110,9 @@ enum gfc_omp_depend_op { OMP_DEPEND_IN, OMP_DEPEND_OUT, - OMP_DEPEND_INOUT + OMP_DEPEND_INOUT, + OMP_DEPEND_SINK_FIRST, + OMP_DEPEND_SINK }; enum gfc_omp_map_op @@ -1255,7 +1257,7 @@ typedef struct gfc_omp_clauses bool nowait, ordered, untied, mergeable; bool inbranch, notinbranch, defaultmap, nogroup; bool sched_simd, sched_monotonic, sched_nonmonotonic; - bool simd, threads; + bool simd, threads, depend_source; enum gfc_omp_cancel_kind cancel; enum gfc_omp_proc_bind_kind proc_bind; struct gfc_expr *safelen_expr; --- gcc/fortran/parse.c.jj 2016-05-13 11:49:47.000000000 +0200 +++ gcc/fortran/parse.c 2016-05-25 16:06:33.694148119 +0200 @@ -831,7 +831,14 @@ decode_omp_directive (void) matcho ("master", gfc_match_omp_master, ST_OMP_MASTER); break; case 'o': - matcho ("ordered", gfc_match_omp_ordered, ST_OMP_ORDERED); + if (flag_openmp && gfc_match ("ordered depend (") == MATCH_YES) + { + gfc_current_locus = old_locus; + matcho ("ordered", gfc_match_omp_ordered_depend, + ST_OMP_ORDERED_DEPEND); + } + else + matcho ("ordered", gfc_match_omp_ordered, ST_OMP_ORDERED); break; case 'p': matchs ("parallel do simd", gfc_match_omp_parallel_do_simd, @@ -1373,7 +1380,8 @@ next_statement (void) case ST_OMP_BARRIER: case ST_OMP_TASKWAIT: case ST_OMP_TASKYIELD: \ case ST_OMP_CANCEL: case ST_OMP_CANCELLATION_POINT: \ case ST_OMP_TARGET_UPDATE: case ST_OMP_TARGET_ENTER_DATA: \ - case ST_OMP_TARGET_EXIT_DATA: case ST_ERROR_STOP: case ST_SYNC_ALL: \ + case ST_OMP_TARGET_EXIT_DATA: case ST_OMP_ORDERED_DEPEND: \ + case ST_ERROR_STOP: case ST_SYNC_ALL: \ case ST_SYNC_IMAGES: case ST_SYNC_MEMORY: case ST_LOCK: case ST_UNLOCK: \ case ST_EVENT_POST: case ST_EVENT_WAIT: \ case ST_OACC_UPDATE: case ST_OACC_WAIT: case ST_OACC_CACHE: \ @@ -2149,6 +2157,7 @@ gfc_ascii_statement (gfc_statement st) p = "!$OMP MASTER"; break; case ST_OMP_ORDERED: + case ST_OMP_ORDERED_DEPEND: p = "!$OMP ORDERED"; break; case ST_OMP_PARALLEL: --- gcc/fortran/st.c.jj 2016-05-13 11:58:31.000000000 +0200 +++ gcc/fortran/st.c 2016-05-25 18:25:56.446163720 +0200 @@ -215,6 +215,7 @@ gfc_free_statement (gfc_code *p) case EXEC_OMP_DO: case EXEC_OMP_DO_SIMD: case EXEC_OMP_END_SINGLE: + case EXEC_OMP_ORDERED: case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_DO: case EXEC_OMP_PARALLEL_DO_SIMD: @@ -261,7 +262,6 @@ gfc_free_statement (gfc_code *p) case EXEC_OMP_ATOMIC: case EXEC_OMP_BARRIER: case EXEC_OMP_MASTER: - case EXEC_OMP_ORDERED: case EXEC_OMP_END_NOWAIT: case EXEC_OMP_TASKGROUP: case EXEC_OMP_TASKWAIT: --- gcc/fortran/dump-parse-tree.c.jj 2016-05-23 17:57:14.000000000 +0200 +++ gcc/fortran/dump-parse-tree.c 2016-05-27 11:14:20.507763580 +0200 @@ -1050,6 +1050,27 @@ show_omp_namelist (int list_type, gfc_om case OMP_DEPEND_IN: fputs ("in:", dumpfile); break; case OMP_DEPEND_OUT: fputs ("out:", dumpfile); break; case OMP_DEPEND_INOUT: fputs ("inout:", dumpfile); break; + case OMP_DEPEND_SINK_FIRST: + fputs ("sink:", dumpfile); + while (1) + { + fprintf (dumpfile, "%s", n->sym->name); + if (n->expr) + { + fputc ('+', dumpfile); + show_expr (n->expr); + } + if (n->next == NULL) + break; + else if (n->next->u.depend_op != OMP_DEPEND_SINK) + { + fputs (") DEPEND(", dumpfile); + break; + } + fputc (',', dumpfile); + n = n->next; + } + continue; default: break; } else if (list_type == OMP_LIST_MAP) @@ -1423,6 +1444,8 @@ show_omp_clauses (gfc_omp_clauses *omp_c show_expr (omp_clauses->if_exprs[i]); fputc (')', dumpfile); } + if (omp_clauses->depend_source) + fputs (" DEPEND(source)", dumpfile); } /* Show a single OpenMP or OpenACC directive node and everything underneath it @@ -1533,6 +1556,7 @@ show_omp_node (int level, gfc_code *c) case EXEC_OMP_DISTRIBUTE_SIMD: case EXEC_OMP_DO: case EXEC_OMP_DO_SIMD: + case EXEC_OMP_ORDERED: case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_DO: case EXEC_OMP_PARALLEL_DO_SIMD: @@ -1594,7 +1618,8 @@ show_omp_node (int level, gfc_code *c) if (c->op == EXEC_OACC_CACHE || c->op == EXEC_OACC_UPDATE || c->op == EXEC_OACC_ENTER_DATA || c->op == EXEC_OACC_EXIT_DATA || c->op == EXEC_OMP_TARGET_UPDATE || c->op == EXEC_OMP_TARGET_ENTER_DATA - || c->op == EXEC_OMP_TARGET_EXIT_DATA) + || c->op == EXEC_OMP_TARGET_EXIT_DATA + || (c->op == EXEC_OMP_ORDERED && c->block == NULL)) return; if (c->op == EXEC_OMP_SECTIONS || c->op == EXEC_OMP_PARALLEL_SECTIONS) { --- gcc/fortran/trans-openmp.c.jj 2016-05-24 19:07:23.000000000 +0200 +++ gcc/fortran/trans-openmp.c 2016-05-27 11:45:55.654240826 +0200 @@ -1927,6 +1927,47 @@ gfc_trans_omp_clauses (stmtblock_t *bloc case OMP_LIST_DEPEND: for (; n != NULL; n = n->next) { + if (n->u.depend_op == OMP_DEPEND_SINK_FIRST) + { + tree vec = NULL_TREE; + while (1) + { + tree addend = integer_zero_node, t; + bool neg = false; + if (n->expr) + { + addend = gfc_conv_constant_to_tree (n->expr); + if (TREE_CODE (addend) == INTEGER_CST + && tree_int_cst_sgn (addend) == -1) + { + neg = true; + addend = const_unop (NEGATE_EXPR, + TREE_TYPE (addend), addend); + } + } + t = gfc_trans_omp_variable (n->sym, false); + if (t != error_mark_node) + { + vec = tree_cons (addend, t, vec); + if (neg) + OMP_CLAUSE_DEPEND_SINK_NEGATIVE (vec) = 1; + } + if (n->next == NULL + || n->next->u.depend_op != OMP_DEPEND_SINK) + break; + n = n->next; + } + if (vec == NULL_TREE) + continue; + + tree node = build_omp_clause (input_location, + OMP_CLAUSE_DEPEND); + OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_SINK; + OMP_CLAUSE_DECL (node) = nreverse (vec); + omp_clauses = gfc_trans_add_clause (node, omp_clauses); + continue; + } + if (!n->sym->attr.referenced) continue; @@ -2490,7 +2531,9 @@ gfc_trans_omp_clauses (stmtblock_t *bloc if (clauses->ordered) { c = build_omp_clause (where.lb->location, OMP_CLAUSE_ORDERED); - OMP_CLAUSE_ORDERED_EXPR (c) = NULL_TREE; + OMP_CLAUSE_ORDERED_EXPR (c) + = clauses->orderedc ? build_int_cst (integer_type_node, + clauses->orderedc) : NULL_TREE; omp_clauses = gfc_trans_add_clause (c, omp_clauses); } @@ -2750,6 +2793,12 @@ gfc_trans_omp_clauses (stmtblock_t *bloc c = build_omp_clause (where.lb->location, OMP_CLAUSE_DEFAULTMAP); omp_clauses = gfc_trans_add_clause (c, omp_clauses); } + if (clauses->depend_source) + { + c = build_omp_clause (where.lb->location, OMP_CLAUSE_DEPEND); + OMP_CLAUSE_DEPEND_KIND (c) = OMP_CLAUSE_DEPEND_SOURCE; + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } if (clauses->async) { @@ -3373,7 +3422,7 @@ gfc_trans_omp_do (gfc_code *code, gfc_ex gfc_omp_clauses *do_clauses, tree par_clauses) { gfc_se se; - tree dovar, stmt, from, to, step, type, init, cond, incr; + tree dovar, stmt, from, to, step, type, init, cond, incr, orig_decls; tree count = NULL_TREE, cycle_label, tmp, omp_clauses; stmtblock_t block; stmtblock_t body; @@ -3383,6 +3432,8 @@ gfc_trans_omp_do (gfc_code *code, gfc_ex dovar_init *di; unsigned ix; + if (clauses->orderedc) + collapse = clauses->orderedc; if (collapse <= 0) collapse = 1; @@ -3392,6 +3443,7 @@ gfc_trans_omp_do (gfc_code *code, gfc_ex init = make_tree_vec (collapse); cond = make_tree_vec (collapse); incr = make_tree_vec (collapse); + orig_decls = clauses->orderedc ? make_tree_vec (collapse) : NULL_TREE; if (pblock == NULL) { @@ -3517,6 +3569,8 @@ gfc_trans_omp_do (gfc_code *code, gfc_ex dovar_init e = {dovar, tmp}; inits.safe_push (e); } + if (orig_decls) + TREE_VEC_ELT (orig_decls, i) = dovar_decl; if (dovar_found == 2 && op == EXEC_OMP_SIMD @@ -3670,6 +3724,8 @@ gfc_trans_omp_do (gfc_code *code, gfc_ex OMP_FOR_INIT (stmt) = init; OMP_FOR_COND (stmt) = cond; OMP_FOR_INCR (stmt) = incr; + if (orig_decls) + OMP_FOR_ORIG_DECLS (stmt) = orig_decls; gfc_add_expr_to_block (&block, stmt); return gfc_finish_block (&block); @@ -3773,8 +3829,11 @@ gfc_trans_omp_master (gfc_code *code) static tree gfc_trans_omp_ordered (gfc_code *code) { + tree omp_clauses = gfc_trans_omp_clauses (NULL, code->ext.omp_clauses, + code->loc); return build2_loc (input_location, OMP_ORDERED, void_type_node, - gfc_trans_code (code->block->next), NULL_TREE); + code->block ? gfc_trans_code (code->block->next) + : NULL_TREE, omp_clauses); } static tree @@ -4011,6 +4070,8 @@ gfc_split_omp_clauses (gfc_code *code, /* 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].orderedc + = code->ext.omp_clauses->orderedc; clausesa[GFC_OMP_SPLIT_DO].sched_kind = code->ext.omp_clauses->sched_kind; if (innermost == GFC_OMP_SPLIT_SIMD) --- gcc/fortran/frontend-passes.c.jj 2016-05-13 11:51:54.000000000 +0200 +++ gcc/fortran/frontend-passes.c 2016-05-25 18:23:36.081009964 +0200 @@ -3593,6 +3593,7 @@ gfc_code_walker (gfc_code **c, walk_code case EXEC_OMP_DISTRIBUTE_SIMD: case EXEC_OMP_DO: case EXEC_OMP_DO_SIMD: + case EXEC_OMP_ORDERED: case EXEC_OMP_SECTIONS: case EXEC_OMP_SINGLE: case EXEC_OMP_END_SINGLE: --- gcc/fortran/openmp.c.jj 2016-05-24 17:40:34.000000000 +0200 +++ gcc/fortran/openmp.c 2016-05-26 10:53:06.598921074 +0200 @@ -340,6 +340,80 @@ cleanup: return MATCH_ERROR; } +/* Match depend(sink : ...) construct a namelist from it. */ + +static match +gfc_match_omp_depend_sink (gfc_omp_namelist **list) +{ + gfc_omp_namelist *head, *tail, *p; + locus old_loc, cur_loc; + gfc_symbol *sym; + + head = tail = NULL; + + old_loc = gfc_current_locus; + + for (;;) + { + cur_loc = gfc_current_locus; + switch (gfc_match_symbol (&sym, 1)) + { + case MATCH_YES: + gfc_set_sym_referenced (sym); + p = gfc_get_omp_namelist (); + if (head == NULL) + { + head = tail = p; + head->u.depend_op = OMP_DEPEND_SINK_FIRST; + } + else + { + tail->next = p; + tail = tail->next; + tail->u.depend_op = OMP_DEPEND_SINK; + } + tail->sym = sym; + tail->expr = NULL; + tail->where = cur_loc; + if (gfc_match_char ('+') == MATCH_YES) + { + if (gfc_match_literal_constant (&tail->expr, 0) != MATCH_YES) + goto syntax; + } + else if (gfc_match_char ('-') == MATCH_YES) + { + if (gfc_match_literal_constant (&tail->expr, 0) != MATCH_YES) + goto syntax; + tail->expr = gfc_uminus (tail->expr); + } + break; + case MATCH_NO: + goto syntax; + case MATCH_ERROR: + goto cleanup; + } + + if (gfc_match_char (')') == MATCH_YES) + break; + if (gfc_match_char (',') != MATCH_YES) + goto syntax; + } + + while (*list) + list = &(*list)->next; + + *list = head; + return MATCH_YES; + +syntax: + gfc_error ("Syntax error in OpenMP DEPEND SINK list at %C"); + +cleanup: + gfc_free_omp_namelist (head); + gfc_current_locus = old_loc; + return MATCH_ERROR; +} + static match match_oacc_expr_list (const char *str, gfc_expr_list **list, bool allow_asterisk) @@ -923,6 +997,19 @@ gfc_match_omp_clauses (gfc_omp_clauses * depend_op = OMP_DEPEND_IN; else if (gfc_match ("out") == MATCH_YES) depend_op = OMP_DEPEND_OUT; + else if (!c->depend_source + && gfc_match ("source )") == MATCH_YES) + { + c->depend_source = true; + continue; + } + else if (gfc_match ("sink : ") == MATCH_YES) + { + if (gfc_match_omp_depend_sink (&c->lists[OMP_LIST_DEPEND]) + == MATCH_YES) + continue; + m = MATCH_NO; + } else m = MATCH_NO; head = NULL; @@ -2235,6 +2322,8 @@ cleanup: | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_DIST_SCHEDULE) #define OMP_SINGLE_CLAUSES \ (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE) +#define OMP_ORDERED_CLAUSES \ + (omp_mask (OMP_CLAUSE_THREADS) | OMP_CLAUSE_SIMD) static match @@ -3252,14 +3341,14 @@ gfc_match_omp_master (void) match gfc_match_omp_ordered (void) { - if (gfc_match_omp_eos () != MATCH_YES) - { - gfc_error ("Unexpected junk after $OMP ORDERED statement at %C"); - return MATCH_ERROR; - } - new_st.op = EXEC_OMP_ORDERED; - new_st.ext.omp_clauses = NULL; - return MATCH_YES; + return match_omp (EXEC_OMP_ORDERED, OMP_ORDERED_CLAUSES); +} + + +match +gfc_match_omp_ordered_depend (void) +{ + return match_omp (EXEC_OMP_ORDERED, omp_mask (OMP_CLAUSE_DEPEND)); } @@ -3691,6 +3780,10 @@ resolve_omp_clauses (gfc_code *code, gfc if (omp_clauses == NULL) return; + if (omp_clauses->orderedc && omp_clauses->orderedc < omp_clauses->collapse) + gfc_error ("ORDERED clause parameter is less than COLLAPSE at %L", + &code->loc); + if (omp_clauses->if_expr) { gfc_expr *expr = omp_clauses->if_expr; @@ -4035,6 +4128,36 @@ resolve_omp_clauses (gfc_code *code, gfc case OMP_LIST_CACHE: for (; n != NULL; n = n->next) { + if (list == OMP_LIST_DEPEND) + { + if (n->u.depend_op == OMP_DEPEND_SINK_FIRST + || n->u.depend_op == OMP_DEPEND_SINK) + { + if (code->op != EXEC_OMP_ORDERED) + gfc_error ("SINK dependence type only allowed " + "on ORDERED directive at %L", &n->where); + else if (omp_clauses->depend_source) + { + gfc_error ("DEPEND SINK used together with " + "DEPEND SOURCE on the same construct " + "at %L", &n->where); + omp_clauses->depend_source = false; + } + else if (n->expr) + { + if (!gfc_resolve_expr (n->expr) + || n->expr->ts.type != BT_INTEGER + || n->expr->rank != 0) + gfc_error ("SINK addend not a constant integer" + "at %L", &n->where); + } + continue; + } + else if (code->op == EXEC_OMP_ORDERED) + gfc_error ("Only SOURCE or SINK dependence types " + "are allowed on ORDERED directive at %L", + &n->where); + } if (n->expr) { if (!gfc_resolve_expr (n->expr) @@ -4274,6 +4397,10 @@ resolve_omp_clauses (gfc_code *code, gfc " construct at %L", &n->where); linear_op = n->u.linear_op; } + else if (omp_clauses->orderedc) + gfc_error ("LINEAR clause specified together with" + "ORDERED clause with argument at %L", + &n->where); else if (n->u.linear_op != OMP_LINEAR_REF && n->sym->ts.type != BT_INTEGER) gfc_error ("LINEAR variable %qs must be INTEGER " @@ -4399,6 +4526,9 @@ resolve_omp_clauses (gfc_code *code, gfc if (omp_clauses->wait_list) for (el = omp_clauses->wait_list; el; el = el->next) resolve_scalar_int_expr (el->expr, "WAIT"); + if (omp_clauses->depend_source && code->op != EXEC_OMP_ORDERED) + gfc_error ("SOURCE dependence type only allowed " + "on ORDERED directive at %L", &code->loc); } @@ -4880,7 +5010,10 @@ gfc_resolve_omp_do_blocks (gfc_code *cod gfc_code *c; omp_current_do_code = code->block->next; - omp_current_do_collapse = code->ext.omp_clauses->collapse; + if (code->ext.omp_clauses->orderedc) + omp_current_do_collapse = code->ext.omp_clauses->orderedc; + else + omp_current_do_collapse = code->ext.omp_clauses->collapse; for (i = 1, c = omp_current_do_code; i < omp_current_do_collapse; i++) { c = c->block; @@ -5108,9 +5241,14 @@ resolve_omp_do (gfc_code *code) resolve_omp_clauses (code, code->ext.omp_clauses, NULL); do_code = code->block->next; - collapse = code->ext.omp_clauses->collapse; - if (collapse <= 0) - collapse = 1; + if (code->ext.omp_clauses->orderedc) + collapse = code->ext.omp_clauses->orderedc; + else + { + collapse = code->ext.omp_clauses->collapse; + if (collapse <= 0) + collapse = 1; + } for (i = 1; i <= collapse; i++) { if (do_code->op == EXEC_DO_WHILE) --- gcc/fortran/match.h.jj 2016-05-13 10:56:57.000000000 +0200 +++ gcc/fortran/match.h 2016-05-25 18:25:31.697489243 +0200 @@ -161,6 +161,7 @@ match gfc_match_omp_do_simd (void); match gfc_match_omp_flush (void); match gfc_match_omp_master (void); match gfc_match_omp_ordered (void); +match gfc_match_omp_ordered_depend (void); match gfc_match_omp_parallel (void); match gfc_match_omp_parallel_do (void); match gfc_match_omp_parallel_do_simd (void); --- gcc/fortran/match.c.jj 2016-05-04 18:37:34.000000000 +0200 +++ gcc/fortran/match.c 2016-05-25 17:46:29.413643217 +0200 @@ -2554,21 +2554,25 @@ match_exit_cycle (gfc_statement st, gfc_ || o->head->op == EXEC_OMP_DO_SIMD || o->head->op == EXEC_OMP_PARALLEL_DO_SIMD)) { - int collapse = 1; + int count = 1; gcc_assert (o->head->next != NULL && (o->head->next->op == EXEC_DO || o->head->next->op == EXEC_DO_WHILE) && o->previous != NULL && o->previous->tail->op == o->head->op); - if (o->previous->tail->ext.omp_clauses != NULL - && o->previous->tail->ext.omp_clauses->collapse > 1) - collapse = o->previous->tail->ext.omp_clauses->collapse; - if (st == ST_EXIT && cnt <= collapse) + if (o->previous->tail->ext.omp_clauses != NULL) + { + if (o->previous->tail->ext.omp_clauses->collapse > 1) + count = o->previous->tail->ext.omp_clauses->collapse; + if (o->previous->tail->ext.omp_clauses->orderedc) + count = o->previous->tail->ext.omp_clauses->orderedc; + } + if (st == ST_EXIT && cnt <= count) { gfc_error ("EXIT statement at %C terminating !$OMP DO loop"); return MATCH_ERROR; } - if (st == ST_CYCLE && cnt < collapse) + if (st == ST_CYCLE && cnt < count) { gfc_error ("CYCLE statement at %C to non-innermost collapsed" " !$OMP DO loop");