From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 104425 invoked by alias); 16 May 2016 16:30:26 -0000 Mailing-List: contact fortran-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Subscribe: List-Post: List-Help: , Sender: fortran-owner@gcc.gnu.org Received: (qmail 100095 invoked by uid 89); 16 May 2016 16:30:21 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-0.5 required=5.0 tests=BAYES_00,RP_MATCHES_RCVD,SPF_HELO_PASS,T_FILL_THIS_FORM_SHORT,UNWANTED_LANGUAGE_BODY autolearn=ham version=3.3.2 spammy=rank, tweaks, gang, make_node 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; Mon, 16 May 2016 16:30:16 +0000 Received: from int-mx09.intmail.prod.int.phx2.redhat.com (int-mx09.intmail.prod.int.phx2.redhat.com [10.5.11.22]) (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 3A7DE81127; Mon, 16 May 2016 16:30:15 +0000 (UTC) Received: from tucnak.zalov.cz (ovpn-116-17.ams2.redhat.com [10.36.116.17]) by int-mx09.intmail.prod.int.phx2.redhat.com (8.14.4/8.14.4) with ESMTP id u4GGUCKc020213 (version=TLSv1/SSLv3 cipher=DHE-RSA-AES256-GCM-SHA384 bits=256 verify=NO); Mon, 16 May 2016 12:30:14 -0400 Received: from tucnak.zalov.cz (localhost [127.0.0.1]) by tucnak.zalov.cz (8.15.2/8.15.2) with ESMTP id u4GGUB7u008086; Mon, 16 May 2016 18:30:12 +0200 Received: (from jakub@localhost) by tucnak.zalov.cz (8.15.2/8.15.2/Submit) id u4GGU2UE008085; Mon, 16 May 2016 18:30:02 +0200 Date: Mon, 16 May 2016 16:30:00 -0000 From: Jakub Jelinek To: gcc-patches@gcc.gnu.org, fortran@gcc.gnu.org Subject: [gomp4.5] Some OpenMP 4.5 resolving and translation changes Message-ID: <20160516163002.GD28550@tucnak.redhat.com> Reply-To: Jakub Jelinek MIME-Version: 1.0 Content-Type: text/plain; charset=us-ascii Content-Disposition: inline User-Agent: Mutt/1.5.24 (2015-08-30) X-SW-Source: 2016-05/txt/msg00036.txt.bz2 Hi! This patch tweaks various spots, including being able to compile taskloop construct. I'll be adding more testcases and tweaking the code further later on. 2016-05-16 Jakub Jelinek * trans.c (trans_code): Handle new OpenMP 4.5 constructs. * resolve.c (gfc_resolve_blocks): Likewise. (gfc_resolve_code): Likewise. * trans-openmp.c (gfc_trans_omp_clauses): Handle new OpenMP 4.5 clauses and new clause modifiers. (gfc_trans_omp_do): Handle EXEC_OMP_TASKLOOP. (GFC_OMP_SPLIT_TASKLOOP, GFC_OMP_MASK_TASKLOOP): New enum constants. (gfc_split_omp_clauses): Handle EXEC_OMP_TARGET_PARALLEL{,_DO,_DO_SIMD} and EXEC_OMP_TASKLOOP{,_SIMD}. Add handling for new OpenMP 4.5 clauses and clause modifiers and handle if clause without/with modifiers. (gfc_trans_omp_target): Handle EXEC_OMP_TARGET_PARALLEL{,_DO,_DO_SIMD} and EXEC_OMP_TARGET_SIMD. (gfc_trans_omp_taskloop): New function. (gfc_trans_omp_directive): Handle EXEC_OMP_TASKLOOP{,_SIMD}, EXEC_OMP_TARGET_PARALLEL{,_DO,_DO_SIMD} and EXEC_OMP_TARGET_SIMD. * openmp.c (resolve_oacc_scalar_int_expr): Renamed to ... (resolve_scalar_int_expr): ... this. Fix up formatting. (resolve_oacc_positive_int_expr): Renamed to ... (resolve_positive_int_expr): ... this. Fix up formatting. (resolve_nonnegative_int_expr): New function. (resolve_omp_clauses): Adjust callers, use the above functions even for OpenMP clauses, add handling of new OpenMP 4.5 clauses. (gfc_resolve_omp_parallel_blocks): Handle new OpenMP 4.5 constructs, replace underscores with spaces in a few construct names. (resolve_omp_do): Handle new OpenMP 4.5 constructs. (resolve_oacc_loop_blocks): Call resolve_positive_int_expr instead of resolve_oacc_positive_int_expr. (gfc_resolve_omp_directive): Handle new OpenMP 4.5 constructs. * testsuite/libgomp.fortran/taskloop-1.f90: New test. --- gcc/fortran/trans.c.jj 2016-05-04 18:37:30.000000000 +0200 +++ gcc/fortran/trans.c 2016-05-16 15:48:07.489838631 +0200 @@ -1916,6 +1916,12 @@ trans_code (gfc_code * code, tree cond) case EXEC_OMP_SINGLE: case EXEC_OMP_TARGET: case EXEC_OMP_TARGET_DATA: + case EXEC_OMP_TARGET_ENTER_DATA: + case EXEC_OMP_TARGET_EXIT_DATA: + case EXEC_OMP_TARGET_PARALLEL: + case EXEC_OMP_TARGET_PARALLEL_DO: + case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_SIMD: case EXEC_OMP_TARGET_TEAMS: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: @@ -1924,6 +1930,8 @@ trans_code (gfc_code * code, tree cond) case EXEC_OMP_TARGET_UPDATE: case EXEC_OMP_TASK: case EXEC_OMP_TASKGROUP: + case EXEC_OMP_TASKLOOP: + case EXEC_OMP_TASKLOOP_SIMD: case EXEC_OMP_TASKWAIT: case EXEC_OMP_TASKYIELD: case EXEC_OMP_TEAMS: --- gcc/fortran/resolve.c.jj 2016-05-04 18:37:32.000000000 +0200 +++ gcc/fortran/resolve.c 2016-05-16 15:35:33.220026681 +0200 @@ -9459,6 +9459,12 @@ gfc_resolve_blocks (gfc_code *b, gfc_nam case EXEC_OMP_SINGLE: case EXEC_OMP_TARGET: case EXEC_OMP_TARGET_DATA: + case EXEC_OMP_TARGET_ENTER_DATA: + case EXEC_OMP_TARGET_EXIT_DATA: + case EXEC_OMP_TARGET_PARALLEL: + case EXEC_OMP_TARGET_PARALLEL_DO: + case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_SIMD: case EXEC_OMP_TARGET_TEAMS: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: @@ -9467,6 +9473,8 @@ gfc_resolve_blocks (gfc_code *b, gfc_nam case EXEC_OMP_TARGET_UPDATE: case EXEC_OMP_TASK: case EXEC_OMP_TASKGROUP: + case EXEC_OMP_TASKLOOP: + case EXEC_OMP_TASKLOOP_SIMD: case EXEC_OMP_TASKWAIT: case EXEC_OMP_TASKYIELD: case EXEC_OMP_TEAMS: @@ -10384,6 +10392,9 @@ gfc_resolve_code (gfc_code *code, gfc_na case EXEC_OMP_PARALLEL_DO: case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_PARALLEL_SECTIONS: + case EXEC_OMP_TARGET_PARALLEL: + case EXEC_OMP_TARGET_PARALLEL_DO: + case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: case EXEC_OMP_TARGET_TEAMS: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: @@ -10404,6 +10415,9 @@ gfc_resolve_code (gfc_code *code, gfc_na case EXEC_OMP_DO: case EXEC_OMP_DO_SIMD: case EXEC_OMP_SIMD: + case EXEC_OMP_TARGET_SIMD: + case EXEC_OMP_TASKLOOP: + case EXEC_OMP_TASKLOOP_SIMD: gfc_resolve_omp_do_blocks (code, ns); break; case EXEC_SELECT_TYPE: @@ -10786,6 +10800,12 @@ start: case EXEC_OMP_SINGLE: case EXEC_OMP_TARGET: case EXEC_OMP_TARGET_DATA: + case EXEC_OMP_TARGET_ENTER_DATA: + case EXEC_OMP_TARGET_EXIT_DATA: + case EXEC_OMP_TARGET_PARALLEL: + case EXEC_OMP_TARGET_PARALLEL_DO: + case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_SIMD: case EXEC_OMP_TARGET_TEAMS: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: @@ -10794,6 +10814,8 @@ start: case EXEC_OMP_TARGET_UPDATE: case EXEC_OMP_TASK: case EXEC_OMP_TASKGROUP: + case EXEC_OMP_TASKLOOP: + case EXEC_OMP_TASKLOOP_SIMD: case EXEC_OMP_TASKWAIT: case EXEC_OMP_TASKYIELD: case EXEC_OMP_TEAMS: --- gcc/fortran/trans-openmp.c.jj 2016-05-13 11:49:47.000000000 +0200 +++ gcc/fortran/trans-openmp.c 2016-05-16 17:48:32.094488080 +0200 @@ -1731,7 +1731,7 @@ gfc_trans_omp_clauses (stmtblock_t *bloc locus where, bool declare_simd = false) { tree omp_clauses = NULL_TREE, chunk_size, c; - int list; + int list, ifc; enum omp_clause_code clause_code; gfc_se se; @@ -1771,11 +1771,15 @@ gfc_trans_omp_clauses (stmtblock_t *bloc clause_code = OMP_CLAUSE_UNIFORM; goto add_clause; case OMP_LIST_USE_DEVICE: + case OMP_LIST_USE_DEVICE_PTR: clause_code = OMP_CLAUSE_USE_DEVICE_PTR; goto add_clause; case OMP_LIST_DEVICE_RESIDENT: clause_code = OMP_CLAUSE_DEVICE_RESIDENT; goto add_clause; + case OMP_LIST_IS_DEVICE_PTR: + clause_code = OMP_CLAUSE_IS_DEVICE_PTR; + goto add_clause; add_clause: omp_clauses @@ -2119,6 +2123,18 @@ gfc_trans_omp_clauses (stmtblock_t *bloc case OMP_MAP_TOFROM: OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_TOFROM); break; + case OMP_MAP_ALWAYS_TO: + OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_ALWAYS_TO); + break; + case OMP_MAP_ALWAYS_FROM: + OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_ALWAYS_FROM); + break; + case OMP_MAP_ALWAYS_TOFROM: + OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_ALWAYS_TOFROM); + break; + case OMP_MAP_RELEASE: + OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_RELEASE); + break; case OMP_MAP_DELETE: OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_DELETE); break; @@ -2257,6 +2273,50 @@ gfc_trans_omp_clauses (stmtblock_t *bloc OMP_CLAUSE_IF_EXPR (c) = if_var; omp_clauses = gfc_trans_add_clause (c, omp_clauses); } + for (ifc = 0; ifc < OMP_IF_LAST; ifc++) + if (clauses->if_exprs[ifc]) + { + tree if_var; + + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, clauses->if_exprs[ifc]); + 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); + switch (ifc) + { + case OMP_IF_PARALLEL: + OMP_CLAUSE_IF_MODIFIER (c) = OMP_PARALLEL; + break; + case OMP_IF_TASK: + OMP_CLAUSE_IF_MODIFIER (c) = OMP_TASK; + break; + case OMP_IF_TASKLOOP: + OMP_CLAUSE_IF_MODIFIER (c) = OMP_TASKLOOP; + break; + case OMP_IF_TARGET: + OMP_CLAUSE_IF_MODIFIER (c) = OMP_TARGET; + break; + case OMP_IF_TARGET_DATA: + OMP_CLAUSE_IF_MODIFIER (c) = OMP_TARGET_DATA; + break; + case OMP_IF_TARGET_UPDATE: + OMP_CLAUSE_IF_MODIFIER (c) = OMP_TARGET_UPDATE; + break; + case OMP_IF_TARGET_ENTER_DATA: + OMP_CLAUSE_IF_MODIFIER (c) = OMP_TARGET_ENTER_DATA; + break; + case OMP_IF_TARGET_EXIT_DATA: + OMP_CLAUSE_IF_MODIFIER (c) = OMP_TARGET_EXIT_DATA; + break; + default: + gcc_unreachable (); + } + OMP_CLAUSE_IF_EXPR (c) = if_var; + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } if (clauses->final_expr) { @@ -2322,6 +2382,16 @@ gfc_trans_omp_clauses (stmtblock_t *bloc default: gcc_unreachable (); } + if (clauses->sched_monotonic) + OMP_CLAUSE_SCHEDULE_KIND (c) + = (omp_clause_schedule_kind) (OMP_CLAUSE_SCHEDULE_KIND (c) + | OMP_CLAUSE_SCHEDULE_MONOTONIC); + else if (clauses->sched_nonmonotonic) + OMP_CLAUSE_SCHEDULE_KIND (c) + = (omp_clause_schedule_kind) (OMP_CLAUSE_SCHEDULE_KIND (c) + | OMP_CLAUSE_SCHEDULE_NONMONOTONIC); + if (clauses->sched_simd) + OMP_CLAUSE_SCHEDULE_SIMD (c) = 1; omp_clauses = gfc_trans_add_clause (c, omp_clauses); } @@ -2452,10 +2522,27 @@ gfc_trans_omp_clauses (stmtblock_t *bloc 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); + if (declare_simd) + { + 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); + } + else + { + tree simdlen_var; + + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, clauses->simdlen_expr); + gfc_add_block_to_block (block, &se.pre); + simdlen_var = gfc_evaluate_now (se.expr, block); + gfc_add_block_to_block (block, &se.post); + + c = build_omp_clause (where.lb->location, OMP_CLAUSE_SIMDLEN); + OMP_CLAUSE_SIMDLEN_EXPR (c) = simdlen_var; + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } } if (clauses->num_teams) @@ -2520,6 +2607,87 @@ gfc_trans_omp_clauses (stmtblock_t *bloc omp_clauses = gfc_trans_add_clause (c, omp_clauses); } + if (clauses->grainsize) + { + tree grainsize; + + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, clauses->grainsize); + gfc_add_block_to_block (block, &se.pre); + grainsize = gfc_evaluate_now (se.expr, block); + gfc_add_block_to_block (block, &se.post); + + c = build_omp_clause (where.lb->location, OMP_CLAUSE_GRAINSIZE); + OMP_CLAUSE_GRAINSIZE_EXPR (c) = grainsize; + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + + if (clauses->num_tasks) + { + tree num_tasks; + + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, clauses->num_tasks); + gfc_add_block_to_block (block, &se.pre); + num_tasks = gfc_evaluate_now (se.expr, block); + gfc_add_block_to_block (block, &se.post); + + c = build_omp_clause (where.lb->location, OMP_CLAUSE_NUM_TASKS); + OMP_CLAUSE_NUM_TASKS_EXPR (c) = num_tasks; + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + + if (clauses->priority) + { + tree priority; + + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, clauses->priority); + gfc_add_block_to_block (block, &se.pre); + priority = gfc_evaluate_now (se.expr, block); + gfc_add_block_to_block (block, &se.post); + + c = build_omp_clause (where.lb->location, OMP_CLAUSE_PRIORITY); + OMP_CLAUSE_PRIORITY_EXPR (c) = priority; + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + + if (clauses->hint) + { + tree hint; + + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, clauses->hint); + gfc_add_block_to_block (block, &se.pre); + hint = gfc_evaluate_now (se.expr, block); + gfc_add_block_to_block (block, &se.post); + + c = build_omp_clause (where.lb->location, OMP_CLAUSE_HINT); + OMP_CLAUSE_HINT_EXPR (c) = hint; + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + + if (clauses->simd) + { + c = build_omp_clause (where.lb->location, OMP_CLAUSE_SIMD); + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + if (clauses->threads) + { + c = build_omp_clause (where.lb->location, OMP_CLAUSE_THREADS); + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + if (clauses->nogroup) + { + c = build_omp_clause (where.lb->location, OMP_CLAUSE_NOGROUP); + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + if (clauses->defaultmap) + { + c = build_omp_clause (where.lb->location, OMP_CLAUSE_DEFAULTMAP); + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + if (clauses->async) { c = build_omp_clause (where.lb->location, OMP_CLAUSE_ASYNC); @@ -3423,6 +3591,7 @@ gfc_trans_omp_do (gfc_code *code, gfc_ex case EXEC_OMP_SIMD: stmt = make_node (OMP_SIMD); break; case EXEC_OMP_DO: stmt = make_node (OMP_FOR); break; case EXEC_OMP_DISTRIBUTE: stmt = make_node (OMP_DISTRIBUTE); break; + case EXEC_OMP_TASKLOOP: stmt = make_node (OMP_TASKLOOP); break; case EXEC_OACC_LOOP: stmt = make_node (OACC_LOOP); break; default: gcc_unreachable (); } @@ -3564,6 +3733,7 @@ enum GFC_OMP_SPLIT_DISTRIBUTE, GFC_OMP_SPLIT_TEAMS, GFC_OMP_SPLIT_TARGET, + GFC_OMP_SPLIT_TASKLOOP, GFC_OMP_SPLIT_NUM }; @@ -3574,7 +3744,8 @@ enum GFC_OMP_MASK_PARALLEL = (1 << GFC_OMP_SPLIT_PARALLEL), GFC_OMP_MASK_DISTRIBUTE = (1 << GFC_OMP_SPLIT_DISTRIBUTE), GFC_OMP_MASK_TEAMS = (1 << GFC_OMP_SPLIT_TEAMS), - GFC_OMP_MASK_TARGET = (1 << GFC_OMP_SPLIT_TARGET) + GFC_OMP_MASK_TARGET = (1 << GFC_OMP_SPLIT_TARGET), + GFC_OMP_MASK_TASKLOOP = (1 << GFC_OMP_SPLIT_TASKLOOP) }; static void @@ -3625,6 +3796,19 @@ gfc_split_omp_clauses (gfc_code *code, case EXEC_OMP_TARGET: innermost = GFC_OMP_SPLIT_TARGET; break; + case EXEC_OMP_TARGET_PARALLEL: + mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_PARALLEL; + innermost = GFC_OMP_SPLIT_PARALLEL; + break; + case EXEC_OMP_TARGET_PARALLEL_DO: + mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO; + innermost = GFC_OMP_SPLIT_DO; + break; + case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: + mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO + | GFC_OMP_MASK_SIMD; + innermost = GFC_OMP_SPLIT_SIMD; + break; case EXEC_OMP_TARGET_TEAMS: mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_TEAMS; innermost = GFC_OMP_SPLIT_TEAMS; @@ -3649,6 +3833,13 @@ gfc_split_omp_clauses (gfc_code *code, | GFC_OMP_MASK_DISTRIBUTE | GFC_OMP_MASK_SIMD; innermost = GFC_OMP_SPLIT_SIMD; break; + case EXEC_OMP_TASKLOOP: + innermost = GFC_OMP_SPLIT_TASKLOOP; + break; + case EXEC_OMP_TASKLOOP_SIMD: + mask = GFC_OMP_MASK_TASKLOOP | GFC_OMP_MASK_SIMD; + innermost = GFC_OMP_SPLIT_SIMD; + break; case EXEC_OMP_TEAMS: innermost = GFC_OMP_SPLIT_TEAMS; break; @@ -3685,8 +3876,17 @@ gfc_split_omp_clauses (gfc_code *code, /* First the clauses that are unique to some constructs. */ clausesa[GFC_OMP_SPLIT_TARGET].lists[OMP_LIST_MAP] = code->ext.omp_clauses->lists[OMP_LIST_MAP]; + clausesa[GFC_OMP_SPLIT_TARGET].lists[OMP_LIST_IS_DEVICE_PTR] + = code->ext.omp_clauses->lists[OMP_LIST_IS_DEVICE_PTR]; clausesa[GFC_OMP_SPLIT_TARGET].device = code->ext.omp_clauses->device; + clausesa[GFC_OMP_SPLIT_TARGET].defaultmap + = code->ext.omp_clauses->defaultmap; + clausesa[GFC_OMP_SPLIT_TARGET].if_exprs[OMP_IF_TARGET] + = code->ext.omp_clauses->if_exprs[OMP_IF_TARGET]; + /* And this is copied to all. */ + clausesa[GFC_OMP_SPLIT_PARALLEL].if_expr + = code->ext.omp_clauses->if_expr; } if (mask & GFC_OMP_MASK_TEAMS) { @@ -3695,7 +3895,8 @@ gfc_split_omp_clauses (gfc_code *code, = code->ext.omp_clauses->num_teams; clausesa[GFC_OMP_SPLIT_TEAMS].thread_limit = code->ext.omp_clauses->thread_limit; - /* Shared and default clauses are allowed on parallel and teams. */ + /* Shared and default clauses are allowed on parallel, teams + and taskloop. */ clausesa[GFC_OMP_SPLIT_TEAMS].lists[OMP_LIST_SHARED] = code->ext.omp_clauses->lists[OMP_LIST_SHARED]; clausesa[GFC_OMP_SPLIT_TEAMS].default_sharing @@ -3721,11 +3922,17 @@ gfc_split_omp_clauses (gfc_code *code, = 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. */ + /* Shared and default clauses are allowed on parallel, teams + and taskloop. */ 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; + clausesa[GFC_OMP_SPLIT_PARALLEL].if_exprs[OMP_IF_PARALLEL] + = code->ext.omp_clauses->if_exprs[OMP_IF_PARALLEL]; + /* And this is copied to all. */ + clausesa[GFC_OMP_SPLIT_PARALLEL].if_expr + = code->ext.omp_clauses->if_expr; } if (mask & GFC_OMP_MASK_DO) { @@ -3734,6 +3941,13 @@ gfc_split_omp_clauses (gfc_code *code, = code->ext.omp_clauses->ordered; clausesa[GFC_OMP_SPLIT_DO].sched_kind = code->ext.omp_clauses->sched_kind; + if (innermost == GFC_OMP_SPLIT_SIMD) + clausesa[GFC_OMP_SPLIT_DO].sched_simd + = code->ext.omp_clauses->sched_simd; + clausesa[GFC_OMP_SPLIT_DO].sched_monotonic + = code->ext.omp_clauses->sched_monotonic; + clausesa[GFC_OMP_SPLIT_DO].sched_nonmonotonic + = code->ext.omp_clauses->sched_nonmonotonic; clausesa[GFC_OMP_SPLIT_DO].chunk_size = code->ext.omp_clauses->chunk_size; clausesa[GFC_OMP_SPLIT_DO].nowait @@ -3746,15 +3960,47 @@ gfc_split_omp_clauses (gfc_code *code, { 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].simdlen_expr + = code->ext.omp_clauses->simdlen_expr; 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, + if (mask & GFC_OMP_MASK_TASKLOOP) + { + /* First the clauses that are unique to some constructs. */ + clausesa[GFC_OMP_SPLIT_TASKLOOP].nogroup + = code->ext.omp_clauses->nogroup; + clausesa[GFC_OMP_SPLIT_TASKLOOP].grainsize + = code->ext.omp_clauses->grainsize; + clausesa[GFC_OMP_SPLIT_TASKLOOP].num_tasks + = code->ext.omp_clauses->num_tasks; + clausesa[GFC_OMP_SPLIT_TASKLOOP].priority + = code->ext.omp_clauses->priority; + clausesa[GFC_OMP_SPLIT_TASKLOOP].final_expr + = code->ext.omp_clauses->final_expr; + clausesa[GFC_OMP_SPLIT_TASKLOOP].untied + = code->ext.omp_clauses->untied; + clausesa[GFC_OMP_SPLIT_TASKLOOP].mergeable + = code->ext.omp_clauses->mergeable; + clausesa[GFC_OMP_SPLIT_TASKLOOP].if_exprs[OMP_IF_TASKLOOP] + = code->ext.omp_clauses->if_exprs[OMP_IF_TASKLOOP]; + /* And this is copied to all. */ + clausesa[GFC_OMP_SPLIT_TASKLOOP].if_expr + = code->ext.omp_clauses->if_expr; + /* Shared and default clauses are allowed on parallel, teams + and taskloop. */ + clausesa[GFC_OMP_SPLIT_TASKLOOP].lists[OMP_LIST_SHARED] + = code->ext.omp_clauses->lists[OMP_LIST_SHARED]; + clausesa[GFC_OMP_SPLIT_TASKLOOP].default_sharing + = code->ext.omp_clauses->default_sharing; + /* Duplicate collapse. */ + clausesa[GFC_OMP_SPLIT_TASKLOOP].collapse + = code->ext.omp_clauses->collapse; + } + /* Private clause is supported on all constructs, 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. */ @@ -3763,8 +4009,8 @@ gfc_split_omp_clauses (gfc_code *code, : 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. */ + simd. Put it on the outermost of those and duplicate + on parallel. */ if (mask & GFC_OMP_MASK_TEAMS) clausesa[GFC_OMP_SPLIT_TEAMS].lists[OMP_LIST_FIRSTPRIVATE] = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE]; @@ -3804,13 +4050,10 @@ gfc_split_omp_clauses (gfc_code *code, if (mask & GFC_OMP_MASK_SIMD) clausesa[GFC_OMP_SPLIT_SIMD].lists[OMP_LIST_REDUCTION] = code->ext.omp_clauses->lists[OMP_LIST_REDUCTION]; - /* FIXME: This is currently being discussed. */ - if (mask & GFC_OMP_MASK_PARALLEL) - clausesa[GFC_OMP_SPLIT_PARALLEL].if_expr - = code->ext.omp_clauses->if_expr; - else - clausesa[GFC_OMP_SPLIT_TARGET].if_expr - = code->ext.omp_clauses->if_expr; + /* Linear clause is supported on do and simd, + put it on the innermost one. */ + clausesa[innermost].lists[OMP_LIST_LINEAR] + = code->ext.omp_clauses->lists[OMP_LIST_LINEAR]; } if ((mask & (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO)) == (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO)) @@ -4209,16 +4452,54 @@ gfc_trans_omp_target (gfc_code *code) omp_clauses = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_TARGET], code->loc); - if (code->op == EXEC_OMP_TARGET) - stmt = gfc_trans_omp_code (code->block->next, true); - else + switch (code->op) { + case EXEC_OMP_TARGET: + stmt = gfc_trans_omp_code (code->block->next, true); + break; + case EXEC_OMP_TARGET_PARALLEL: + { + stmtblock_t iblock; + + gfc_start_block (&iblock); + tree inner_clauses + = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_PARALLEL], + code->loc); + stmt = gfc_trans_omp_code (code->block->next, true); + stmt = build2_loc (input_location, OMP_PARALLEL, void_type_node, stmt, + inner_clauses); + gfc_add_expr_to_block (&iblock, stmt); + stmt = gfc_finish_block (&iblock); + if (TREE_CODE (stmt) != BIND_EXPR) + stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); + else + poplevel (0, 0); + } + break; + case EXEC_OMP_TARGET_PARALLEL_DO: + case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: + stmt = gfc_trans_omp_parallel_do (code, &block, clausesa); + if (TREE_CODE (stmt) != BIND_EXPR) + stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); + else + poplevel (0, 0); + break; + case EXEC_OMP_TARGET_SIMD: + stmt = gfc_trans_omp_do (code, EXEC_OMP_SIMD, &block, + &clausesa[GFC_OMP_SPLIT_SIMD], NULL_TREE); + if (TREE_CODE (stmt) != BIND_EXPR) + stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); + else + poplevel (0, 0); + break; + default: pushlevel (); stmt = gfc_trans_omp_teams (code, clausesa); if (TREE_CODE (stmt) != BIND_EXPR) stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); else poplevel (0, 0); + break; } if (flag_openmp) stmt = build2_loc (input_location, OMP_TARGET, void_type_node, stmt, @@ -4228,6 +4509,48 @@ gfc_trans_omp_target (gfc_code *code) } static tree +gfc_trans_omp_taskloop (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); + if (flag_openmp) + omp_clauses + = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_TASKLOOP], + code->loc); + switch (code->op) + { + case EXEC_OMP_TASKLOOP: + /* This is handled in gfc_trans_omp_do. */ + gcc_unreachable (); + break; + case EXEC_OMP_TASKLOOP_SIMD: + stmt = gfc_trans_omp_do (code, EXEC_OMP_SIMD, &block, + &clausesa[GFC_OMP_SPLIT_SIMD], NULL_TREE); + if (TREE_CODE (stmt) != BIND_EXPR) + stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); + else + poplevel (0, 0); + break; + default: + gcc_unreachable (); + } + if (flag_openmp) + { + tree taskloop = make_node (OMP_TASKLOOP); + TREE_TYPE (taskloop) = void_type_node; + OMP_FOR_BODY (taskloop) = stmt; + OMP_FOR_CLAUSES (taskloop) = omp_clauses; + stmt = taskloop; + } + gfc_add_expr_to_block (&block, stmt); + return gfc_finish_block (&block); +} + +static tree gfc_trans_omp_target_data (gfc_code *code) { stmtblock_t block; @@ -4487,6 +4810,7 @@ gfc_trans_omp_directive (gfc_code *code) case EXEC_OMP_DISTRIBUTE: case EXEC_OMP_DO: case EXEC_OMP_SIMD: + case EXEC_OMP_TASKLOOP: return gfc_trans_omp_do (code, code->op, NULL, code->ext.omp_clauses, NULL); case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: @@ -4516,6 +4840,10 @@ gfc_trans_omp_directive (gfc_code *code) case EXEC_OMP_SINGLE: return gfc_trans_omp_single (code, code->ext.omp_clauses); case EXEC_OMP_TARGET: + case EXEC_OMP_TARGET_PARALLEL: + case EXEC_OMP_TARGET_PARALLEL_DO: + case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_SIMD: case EXEC_OMP_TARGET_TEAMS: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: @@ -4530,6 +4858,8 @@ gfc_trans_omp_directive (gfc_code *code) return gfc_trans_omp_task (code); case EXEC_OMP_TASKGROUP: return gfc_trans_omp_taskgroup (code); + case EXEC_OMP_TASKLOOP_SIMD: + return gfc_trans_omp_taskloop (code); case EXEC_OMP_TASKWAIT: return gfc_trans_omp_taskwait (); case EXEC_OMP_TASKYIELD: --- gcc/fortran/openmp.c.jj 2016-05-13 11:49:47.000000000 +0200 +++ gcc/fortran/openmp.c 2016-05-16 15:43:59.884186162 +0200 @@ -3407,23 +3407,35 @@ oacc_is_loop (gfc_code *code) } static void -resolve_oacc_scalar_int_expr (gfc_expr *expr, const char *clause) +resolve_scalar_int_expr (gfc_expr *expr, const char *clause) { if (!gfc_resolve_expr (expr) - || expr->ts.type != BT_INTEGER || expr->rank != 0) + || expr->ts.type != BT_INTEGER + || expr->rank != 0) gfc_error ("%s clause at %L requires a scalar INTEGER expression", - clause, &expr->where); + clause, &expr->where); } - static void -resolve_oacc_positive_int_expr (gfc_expr *expr, const char *clause) +resolve_positive_int_expr (gfc_expr *expr, const char *clause) { - resolve_oacc_scalar_int_expr (expr, clause); - if (expr->expr_type == EXPR_CONSTANT && expr->ts.type == BT_INTEGER - && mpz_sgn(expr->value.integer) <= 0) + resolve_scalar_int_expr (expr, clause); + if (expr->expr_type == EXPR_CONSTANT + && expr->ts.type == BT_INTEGER + && mpz_sgn (expr->value.integer) <= 0) gfc_warning (0, "INTEGER expression of %s clause at %L must be positive", - clause, &expr->where); + clause, &expr->where); +} + +static void +resolve_nonnegative_int_expr (gfc_expr *expr, const char *clause) +{ + resolve_scalar_int_expr (expr, clause); + if (expr->expr_type == EXPR_CONSTANT + && expr->ts.type == BT_INTEGER + && mpz_sgn (expr->value.integer) < 0) + gfc_warning (0, "INTEGER expression of %s clause at %L must be " + "non-negative", clause, &expr->where); } /* Emits error when symbol is pointer, cray pointer or cray pointee @@ -3627,11 +3639,13 @@ resolve_omp_clauses (gfc_code *code, gfc gfc_omp_namelist *n; gfc_expr_list *el; int list; + int ifc; + bool if_without_mod = false; static const char *clause_names[] = { "PRIVATE", "FIRSTPRIVATE", "LASTPRIVATE", "COPYPRIVATE", "SHARED", "COPYIN", "UNIFORM", "ALIGNED", "LINEAR", "DEPEND", "MAP", "TO", "FROM", "REDUCTION", "DEVICE_RESIDENT", "LINK", "USE_DEVICE", - "CACHE" }; + "CACHE", "IS_DEVICE_PTR", "USE_DEVICE_PTR" }; if (omp_clauses == NULL) return; @@ -3643,7 +3657,101 @@ resolve_omp_clauses (gfc_code *code, gfc || expr->ts.type != BT_LOGICAL || expr->rank != 0) gfc_error ("IF clause at %L requires a scalar LOGICAL expression", &expr->where); + if_without_mod = true; } + for (ifc = 0; ifc < OMP_IF_LAST; ifc++) + if (omp_clauses->if_exprs[ifc]) + { + gfc_expr *expr = omp_clauses->if_exprs[ifc]; + bool ok = true; + if (!gfc_resolve_expr (expr) + || expr->ts.type != BT_LOGICAL || expr->rank != 0) + gfc_error ("IF clause at %L requires a scalar LOGICAL expression", + &expr->where); + else if (if_without_mod) + { + gfc_error ("IF clause without modifier at %L used together with" + "IF clauses with modifiers", + &omp_clauses->if_expr->where); + if_without_mod = false; + } + else + switch (code->op) + { + case EXEC_OMP_PARALLEL: + case EXEC_OMP_PARALLEL_DO: + case EXEC_OMP_PARALLEL_SECTIONS: + case EXEC_OMP_PARALLEL_WORKSHARE: + case EXEC_OMP_PARALLEL_DO_SIMD: + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + ok = ifc == OMP_IF_PARALLEL; + break; + + case EXEC_OMP_TASK: + ok = ifc == OMP_IF_TASK; + break; + + case EXEC_OMP_TASKLOOP: + case EXEC_OMP_TASKLOOP_SIMD: + ok = ifc == OMP_IF_TASKLOOP; + break; + + case EXEC_OMP_TARGET: + case EXEC_OMP_TARGET_TEAMS: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + case EXEC_OMP_TARGET_SIMD: + ok = ifc == OMP_IF_TARGET; + break; + + case EXEC_OMP_TARGET_DATA: + ok = ifc == OMP_IF_TARGET_DATA; + break; + + case EXEC_OMP_TARGET_UPDATE: + ok = ifc == OMP_IF_TARGET_UPDATE; + break; + + case EXEC_OMP_TARGET_ENTER_DATA: + ok = ifc == OMP_IF_TARGET_ENTER_DATA; + break; + + case EXEC_OMP_TARGET_EXIT_DATA: + ok = ifc == OMP_IF_TARGET_EXIT_DATA; + break; + + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_PARALLEL: + case EXEC_OMP_TARGET_PARALLEL_DO: + case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: + ok = ifc == OMP_IF_TARGET || ifc == OMP_IF_PARALLEL; + break; + + default: + ok = false; + break; + } + if (!ok) + { + static const char *ifs[] = { + "PARALLEL", + "TASK", + "TASKLOOP", + "TARGET", + "TARGET DATA", + "TARGET UPDATE", + "TARGET ENTER DATA", + "TARGET EXIT DATA" + }; + gfc_error ("IF clause modifier %s at %L not appropriate for " + "the current OpenMP construct", ifs[ifc], &expr->where); + } + } + if (omp_clauses->final_expr) { gfc_expr *expr = omp_clauses->final_expr; @@ -3653,13 +3761,7 @@ resolve_omp_clauses (gfc_code *code, gfc &expr->where); } if (omp_clauses->num_threads) - { - gfc_expr *expr = omp_clauses->num_threads; - if (!gfc_resolve_expr (expr) - || expr->ts.type != BT_INTEGER || expr->rank != 0) - gfc_error ("NUM_THREADS clause at %L requires a scalar " - "INTEGER expression", &expr->where); - } + resolve_positive_int_expr (omp_clauses->num_threads, "NUM_THREADS"); if (omp_clauses->chunk_size) { gfc_expr *expr = omp_clauses->chunk_size; @@ -4179,37 +4281,17 @@ resolve_omp_clauses (gfc_code *code, gfc } } if (omp_clauses->safelen_expr) - { - gfc_expr *expr = omp_clauses->safelen_expr; - if (!gfc_resolve_expr (expr) - || expr->ts.type != BT_INTEGER || expr->rank != 0) - gfc_error ("SAFELEN clause at %L requires a scalar " - "INTEGER expression", &expr->where); - } + resolve_positive_int_expr (omp_clauses->safelen_expr, "SAFELEN"); if (omp_clauses->simdlen_expr) - { - gfc_expr *expr = omp_clauses->simdlen_expr; - if (!gfc_resolve_expr (expr) - || expr->ts.type != BT_INTEGER || expr->rank != 0) - gfc_error ("SIMDLEN clause at %L requires a scalar " - "INTEGER expression", &expr->where); - } + resolve_positive_int_expr (omp_clauses->simdlen_expr, "SIMDLEN"); if (omp_clauses->num_teams) - { - gfc_expr *expr = omp_clauses->num_teams; - if (!gfc_resolve_expr (expr) - || expr->ts.type != BT_INTEGER || expr->rank != 0) - gfc_error ("NUM_TEAMS clause at %L requires a scalar " - "INTEGER expression", &expr->where); - } + resolve_positive_int_expr (omp_clauses->num_teams, "NUM_TEAMS"); if (omp_clauses->device) - { - gfc_expr *expr = omp_clauses->device; - if (!gfc_resolve_expr (expr) - || expr->ts.type != BT_INTEGER || expr->rank != 0) - gfc_error ("DEVICE clause at %L requires a scalar " - "INTEGER expression", &expr->where); - } + resolve_nonnegative_int_expr (omp_clauses->device, "DEVICE"); + if (omp_clauses->hint) + resolve_scalar_int_expr (omp_clauses->hint, "HINT"); + if (omp_clauses->priority) + resolve_nonnegative_int_expr (omp_clauses->priority, "PRIORITY"); if (omp_clauses->dist_chunk_size) { gfc_expr *expr = omp_clauses->dist_chunk_size; @@ -4219,36 +4301,33 @@ resolve_omp_clauses (gfc_code *code, gfc "a scalar INTEGER expression", &expr->where); } if (omp_clauses->thread_limit) - { - gfc_expr *expr = omp_clauses->thread_limit; - if (!gfc_resolve_expr (expr) - || expr->ts.type != BT_INTEGER || expr->rank != 0) - gfc_error ("THREAD_LIMIT clause at %L requires a scalar " - "INTEGER expression", &expr->where); - } + resolve_positive_int_expr (omp_clauses->thread_limit, "THREAD_LIMIT"); + if (omp_clauses->grainsize) + resolve_positive_int_expr (omp_clauses->grainsize, "GRAINSIZE"); + if (omp_clauses->num_tasks) + resolve_positive_int_expr (omp_clauses->num_tasks, "NUM_TASKS"); if (omp_clauses->async) if (omp_clauses->async_expr) - resolve_oacc_scalar_int_expr (omp_clauses->async_expr, "ASYNC"); + resolve_scalar_int_expr (omp_clauses->async_expr, "ASYNC"); if (omp_clauses->num_gangs_expr) - resolve_oacc_positive_int_expr (omp_clauses->num_gangs_expr, "NUM_GANGS"); + resolve_positive_int_expr (omp_clauses->num_gangs_expr, "NUM_GANGS"); if (omp_clauses->num_workers_expr) - resolve_oacc_positive_int_expr (omp_clauses->num_workers_expr, - "NUM_WORKERS"); + resolve_positive_int_expr (omp_clauses->num_workers_expr, "NUM_WORKERS"); if (omp_clauses->vector_length_expr) - resolve_oacc_positive_int_expr (omp_clauses->vector_length_expr, - "VECTOR_LENGTH"); + resolve_positive_int_expr (omp_clauses->vector_length_expr, + "VECTOR_LENGTH"); if (omp_clauses->gang_num_expr) - resolve_oacc_positive_int_expr (omp_clauses->gang_num_expr, "GANG"); + resolve_positive_int_expr (omp_clauses->gang_num_expr, "GANG"); if (omp_clauses->gang_static_expr) - resolve_oacc_positive_int_expr (omp_clauses->gang_static_expr, "GANG"); + resolve_positive_int_expr (omp_clauses->gang_static_expr, "GANG"); if (omp_clauses->worker_expr) - resolve_oacc_positive_int_expr (omp_clauses->worker_expr, "WORKER"); + resolve_positive_int_expr (omp_clauses->worker_expr, "WORKER"); if (omp_clauses->vector_expr) - resolve_oacc_positive_int_expr (omp_clauses->vector_expr, "VECTOR"); + resolve_positive_int_expr (omp_clauses->vector_expr, "VECTOR"); if (omp_clauses->wait) if (omp_clauses->wait_list) for (el = omp_clauses->wait_list; el; el = el->next) - resolve_oacc_scalar_int_expr (el->expr, "WAIT"); + resolve_scalar_int_expr (el->expr, "WAIT"); } @@ -4784,6 +4863,8 @@ gfc_resolve_omp_parallel_blocks (gfc_cod { case EXEC_OMP_PARALLEL_DO: case EXEC_OMP_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_PARALLEL_DO: + case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: @@ -4909,8 +4990,17 @@ resolve_omp_do (gfc_code *code) is_simd = true; break; case EXEC_OMP_SIMD: name = "!$OMP SIMD"; is_simd = true; break; + case EXEC_OMP_TARGET_PARALLEL_DO: name = "!$OMP TARGET PARALLEL DO"; break; + case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: + name = "!$OMP TARGET PARALLEL DO SIMD"; + is_simd = true; + break; + case EXEC_OMP_TARGET_SIMD: + name = "!$OMP TARGET SIMD"; + is_simd = true; + break; case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: - name = "!$OMP TARGET TEAMS_DISTRIBUTE"; + name = "!$OMP TARGET TEAMS DISTRIBUTE"; break; case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: name = "!$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO"; @@ -4923,7 +5013,12 @@ resolve_omp_do (gfc_code *code) name = "!$OMP TARGET TEAMS DISTRIBUTE SIMD"; is_simd = true; break; - case EXEC_OMP_TEAMS_DISTRIBUTE: name = "!$OMP TEAMS_DISTRIBUTE"; break; + case EXEC_OMP_TASKLOOP: name = "!$OMP TASKLOOP"; break; + case EXEC_OMP_TASKLOOP_SIMD: + name = "!$OMP TASKLOOP SIMD"; + is_simd = true; + break; + case EXEC_OMP_TEAMS_DISTRIBUTE: name = "!$OMP TEAMS DISTRIBUTE"; break; case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: name = "!$OMP TEAMS DISTRIBUTE PARALLEL DO"; break; @@ -5341,7 +5436,7 @@ resolve_oacc_loop_blocks (gfc_code *code } else { - resolve_oacc_positive_int_expr (el->expr, "TILE"); + resolve_positive_int_expr (el->expr, "TILE"); if (el->expr->expr_type != EXPR_CONSTANT) gfc_error ("TILE requires constant expression at %L", &code->loc); @@ -5503,10 +5598,15 @@ gfc_resolve_omp_directive (gfc_code *cod case EXEC_OMP_PARALLEL_DO: case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_SIMD: + case EXEC_OMP_TARGET_PARALLEL_DO: + case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_SIMD: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + case EXEC_OMP_TASKLOOP: + case EXEC_OMP_TASKLOOP_SIMD: case EXEC_OMP_TEAMS_DISTRIBUTE: case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: @@ -5521,6 +5621,9 @@ gfc_resolve_omp_directive (gfc_code *cod case EXEC_OMP_SINGLE: case EXEC_OMP_TARGET: case EXEC_OMP_TARGET_DATA: + case EXEC_OMP_TARGET_ENTER_DATA: + case EXEC_OMP_TARGET_EXIT_DATA: + case EXEC_OMP_TARGET_PARALLEL: case EXEC_OMP_TARGET_TEAMS: case EXEC_OMP_TASK: case EXEC_OMP_TEAMS: --- libgomp/testsuite/libgomp.fortran/taskloop-1.f90.jj 2016-05-16 16:35:57.744114768 +0200 +++ libgomp/testsuite/libgomp.fortran/taskloop-1.f90 2016-05-16 16:38:49.100807474 +0200 @@ -0,0 +1,44 @@ + common /blk/ q, e + integer :: q, r + logical :: e +!$omp parallel +!$omp single + call foo (2, 7) + r = bar (12, 18) +!$omp end single +!$omp end parallel + if (q .ne. 6 .or. r .ne. 17 .or. e) call abort +contains + subroutine foo (a, b) + integer, intent (in) :: a, b + common /blk/ q, e + integer :: q, r, d + logical :: e +!$omp taskloop lastprivate (q) nogroup + do d = a, b, 2 + q = d + if (d < 2 .or. d > 6 .or. iand (d, 1) .ne. 0) then +!$omp atomic write + e = .true. + end if + end do + end subroutine foo + function bar (a, b) + integer, intent (in) :: a, b + integer :: bar + common /blk/ q, e + integer :: q, r, d, s + logical :: e + s = 7 +!$omp taskloop lastprivate (s) + do d = a, b - 1 + if (d < 12 .or. d > 17) then +!$omp atomic write + e = .true. + end if + s = d + end do +!$omp end taskloop + bar = s + end function bar +end Jakub