diff options
author | Tobias Burnus <tobias@codesourcery.com> | 2021-11-11 17:27:00 +0100 |
---|---|---|
committer | Tobias Burnus <tobias@codesourcery.com> | 2021-11-11 17:27:00 +0100 |
commit | 407eaad25f45ccba6e45e6f07d6c69c51cc567f3 (patch) | |
tree | d47e4ef29dbdf0ad836c7a4b48e989c1520fee35 /gcc | |
parent | e1b218d1748136d02c99a5e5f3f664e9c5a563ed (diff) | |
download | gcc-407eaad25f45ccba6e45e6f07d6c69c51cc567f3.zip gcc-407eaad25f45ccba6e45e6f07d6c69c51cc567f3.tar.gz gcc-407eaad25f45ccba6e45e6f07d6c69c51cc567f3.tar.bz2 |
Fortran/openmp: Add support for 2 argument num_teams clause
Fortran part to commit r12-5146-g48d7327f2aaf65
gcc/fortran/ChangeLog:
* gfortran.h (struct gfc_omp_clauses): Rename num_teams to
num_teams_upper, add num_teams_upper.
* dump-parse-tree.c (show_omp_clauses): Update to handle
lower-bound num_teams clause.
* frontend-passes.c (gfc_code_walker): Likewise
* openmp.c (gfc_free_omp_clauses, gfc_match_omp_clauses,
resolve_omp_clauses): Likewise.
* trans-openmp.c (gfc_trans_omp_clauses, gfc_split_omp_clauses,
gfc_trans_omp_target): Likewise.
libgomp/ChangeLog:
* testsuite/libgomp.fortran/teams-1.f90: New test.
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/fortran/dump-parse-tree.c | 9 | ||||
-rw-r--r-- | gcc/fortran/frontend-passes.c | 3 | ||||
-rw-r--r-- | gcc/fortran/gfortran.h | 3 | ||||
-rw-r--r-- | gcc/fortran/openmp.c | 32 | ||||
-rw-r--r-- | gcc/fortran/trans-openmp.c | 35 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/gomp/num-teams-1.f90 | 53 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/gomp/num-teams-2.f90 | 37 |
7 files changed, 153 insertions, 19 deletions
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c index 14a3078..04660d5 100644 --- a/gcc/fortran/dump-parse-tree.c +++ b/gcc/fortran/dump-parse-tree.c @@ -1741,10 +1741,15 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses) } fprintf (dumpfile, " BIND(%s)", type); } - if (omp_clauses->num_teams) + if (omp_clauses->num_teams_upper) { fputs (" NUM_TEAMS(", dumpfile); - show_expr (omp_clauses->num_teams); + if (omp_clauses->num_teams_lower) + { + show_expr (omp_clauses->num_teams_lower); + fputc (':', dumpfile); + } + show_expr (omp_clauses->num_teams_upper); fputc (')', dumpfile); } if (omp_clauses->device) diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c index 145bff5..f5ba7ce 100644 --- a/gcc/fortran/frontend-passes.c +++ b/gcc/fortran/frontend-passes.c @@ -5634,7 +5634,8 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn, WALK_SUBEXPR (co->ext.omp_clauses->chunk_size); WALK_SUBEXPR (co->ext.omp_clauses->safelen_expr); WALK_SUBEXPR (co->ext.omp_clauses->simdlen_expr); - WALK_SUBEXPR (co->ext.omp_clauses->num_teams); + WALK_SUBEXPR (co->ext.omp_clauses->num_teams_lower); + WALK_SUBEXPR (co->ext.omp_clauses->num_teams_upper); WALK_SUBEXPR (co->ext.omp_clauses->device); WALK_SUBEXPR (co->ext.omp_clauses->thread_limit); WALK_SUBEXPR (co->ext.omp_clauses->dist_chunk_size); diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 9378b4b8..1ad2f0d 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1502,7 +1502,8 @@ typedef struct gfc_omp_clauses struct gfc_expr *chunk_size; struct gfc_expr *safelen_expr; struct gfc_expr *simdlen_expr; - struct gfc_expr *num_teams; + struct gfc_expr *num_teams_lower; + struct gfc_expr *num_teams_upper; struct gfc_expr *device; struct gfc_expr *thread_limit; struct gfc_expr *grainsize; diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index dcf22ac..7b2df0d 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -85,7 +85,8 @@ gfc_free_omp_clauses (gfc_omp_clauses *c) gfc_free_expr (c->chunk_size); gfc_free_expr (c->safelen_expr); gfc_free_expr (c->simdlen_expr); - gfc_free_expr (c->num_teams); + gfc_free_expr (c->num_teams_lower); + gfc_free_expr (c->num_teams_upper); gfc_free_expr (c->device); gfc_free_expr (c->thread_limit); gfc_free_expr (c->dist_chunk_size); @@ -2420,11 +2421,22 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, continue; } if ((mask & OMP_CLAUSE_NUM_TEAMS) - && (m = gfc_match_dupl_check (!c->num_teams, "num_teams", true, - &c->num_teams)) != MATCH_NO) + && (m = gfc_match_dupl_check (!c->num_teams_upper, "num_teams", + true)) != MATCH_NO) { if (m == MATCH_ERROR) goto error; + if (gfc_match ("%e ", &c->num_teams_upper) != MATCH_YES) + goto error; + if (gfc_peek_ascii_char () == ':') + { + c->num_teams_lower = c->num_teams_upper; + c->num_teams_upper = NULL; + if (gfc_match (": %e ", &c->num_teams_upper) != MATCH_YES) + goto error; + } + if (gfc_match (") ") != MATCH_YES) + goto error; continue; } if ((mask & OMP_CLAUSE_NUM_THREADS) @@ -7293,8 +7305,18 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, resolve_positive_int_expr (omp_clauses->safelen_expr, "SAFELEN"); if (omp_clauses->simdlen_expr) resolve_positive_int_expr (omp_clauses->simdlen_expr, "SIMDLEN"); - if (omp_clauses->num_teams) - resolve_positive_int_expr (omp_clauses->num_teams, "NUM_TEAMS"); + if (omp_clauses->num_teams_lower) + resolve_positive_int_expr (omp_clauses->num_teams_lower, "NUM_TEAMS"); + if (omp_clauses->num_teams_upper) + resolve_positive_int_expr (omp_clauses->num_teams_upper, "NUM_TEAMS"); + if (omp_clauses->num_teams_lower + && omp_clauses->num_teams_lower->expr_type == EXPR_CONSTANT + && omp_clauses->num_teams_upper->expr_type == EXPR_CONSTANT + && mpz_cmp (omp_clauses->num_teams_lower->value.integer, + omp_clauses->num_teams_upper->value.integer) > 0) + gfc_warning (0, "NUM_TEAMS lower bound at %L larger than upper bound at %L", + &omp_clauses->num_teams_lower->where, + &omp_clauses->num_teams_upper->where); if (omp_clauses->device) resolve_nonnegative_int_expr (omp_clauses->device, "DEVICE"); if (omp_clauses->filter) diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index 22d6662..6bc7e9a 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -3927,18 +3927,27 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, } } - if (clauses->num_teams) + if (clauses->num_teams_upper) { - tree num_teams; + tree num_teams_lower = NULL_TREE, num_teams_upper; gfc_init_se (&se, NULL); - gfc_conv_expr (&se, clauses->num_teams); + gfc_conv_expr (&se, clauses->num_teams_upper); gfc_add_block_to_block (block, &se.pre); - num_teams = gfc_evaluate_now (se.expr, block); + num_teams_upper = gfc_evaluate_now (se.expr, block); gfc_add_block_to_block (block, &se.post); + if (clauses->num_teams_lower) + { + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, clauses->num_teams_lower); + gfc_add_block_to_block (block, &se.pre); + num_teams_lower = gfc_evaluate_now (se.expr, block); + gfc_add_block_to_block (block, &se.post); + } c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NUM_TEAMS); - OMP_CLAUSE_NUM_TEAMS_UPPER_EXPR (c) = num_teams; + OMP_CLAUSE_NUM_TEAMS_LOWER_EXPR (c) = num_teams_lower; + OMP_CLAUSE_NUM_TEAMS_UPPER_EXPR (c) = num_teams_upper; omp_clauses = gfc_trans_add_clause (c, omp_clauses); } @@ -5873,8 +5882,10 @@ gfc_split_omp_clauses (gfc_code *code, if (mask & GFC_OMP_MASK_TEAMS) { /* First the clauses that are unique to some constructs. */ - clausesa[GFC_OMP_SPLIT_TEAMS].num_teams - = code->ext.omp_clauses->num_teams; + clausesa[GFC_OMP_SPLIT_TEAMS].num_teams_lower + = code->ext.omp_clauses->num_teams_lower; + clausesa[GFC_OMP_SPLIT_TEAMS].num_teams_upper + = code->ext.omp_clauses->num_teams_upper; clausesa[GFC_OMP_SPLIT_TEAMS].thread_limit = code->ext.omp_clauses->thread_limit; /* Shared and default clauses are allowed on parallel, teams @@ -6649,7 +6660,7 @@ gfc_trans_omp_target (gfc_code *code) break; default: if (flag_openmp - && (clausesa[GFC_OMP_SPLIT_TEAMS].num_teams + && (clausesa[GFC_OMP_SPLIT_TEAMS].num_teams_upper || clausesa[GFC_OMP_SPLIT_TEAMS].thread_limit)) { gfc_omp_clauses clausesb; @@ -6658,9 +6669,13 @@ gfc_trans_omp_target (gfc_code *code) thread_limit clauses are evaluated before entering the target construct. */ memset (&clausesb, '\0', sizeof (clausesb)); - clausesb.num_teams = clausesa[GFC_OMP_SPLIT_TEAMS].num_teams; + clausesb.num_teams_lower + = clausesa[GFC_OMP_SPLIT_TEAMS].num_teams_lower; + clausesb.num_teams_upper + = clausesa[GFC_OMP_SPLIT_TEAMS].num_teams_upper; clausesb.thread_limit = clausesa[GFC_OMP_SPLIT_TEAMS].thread_limit; - clausesa[GFC_OMP_SPLIT_TEAMS].num_teams = NULL; + clausesa[GFC_OMP_SPLIT_TEAMS].num_teams_lower = NULL; + clausesa[GFC_OMP_SPLIT_TEAMS].num_teams_upper = NULL; clausesa[GFC_OMP_SPLIT_TEAMS].thread_limit = NULL; teams_clauses = gfc_trans_omp_clauses (&block, &clausesb, code->loc); diff --git a/gcc/testsuite/gfortran.dg/gomp/num-teams-1.f90 b/gcc/testsuite/gfortran.dg/gomp/num-teams-1.f90 new file mode 100644 index 0000000..df31cc7 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/num-teams-1.f90 @@ -0,0 +1,53 @@ +module m + implicit none (type, external) + + interface + integer function fn(i); integer :: i; end + end interface + +contains + +subroutine foo + !$omp teams num_teams (4 : 6) + !$omp end teams + + !$omp teams num_teams (7) + !$omp end teams +end + +subroutine bar + !$omp target teams num_teams (5 : 19) + !$omp end target teams + + !$omp target teams num_teams (21) + !$omp end target teams +end + +subroutine baz + !$omp teams num_teams (fn (1) : fn (2)) + !$omp end teams + + !$omp teams num_teams (fn (3)) + !$omp end teams +end + +subroutine qux + !$omp target teams num_teams (fn (4) : fn (5)) + !$omp end target teams + + !$omp target teams num_teams (fn (6)) + !$omp end target teams +end + +subroutine corge + !$omp target + !$omp teams num_teams (fn (7) : fn (8)) + !$omp end teams + !$omp end target + + !$omp target + !$omp teams num_teams (fn (9)) + !$omp end teams + !$omp end target +end +end module m diff --git a/gcc/testsuite/gfortran.dg/gomp/num-teams-2.f90 b/gcc/testsuite/gfortran.dg/gomp/num-teams-2.f90 new file mode 100644 index 0000000..e7814a1 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/num-teams-2.f90 @@ -0,0 +1,37 @@ +module m + implicit none (type, external) + +contains + +subroutine foo (i) + integer :: i + + !$omp teams num_teams (6 : 4) ! { dg-warning "NUM_TEAMS lower bound at .1. larger than upper bound at .2." } + !$omp end teams + + !$omp teams num_teams (-7) ! { dg-warning "INTEGER expression of NUM_TEAMS clause at .1. must be positive" } + !$omp end teams + + !$omp teams num_teams (i : -7) ! { dg-warning "INTEGER expression of NUM_TEAMS clause at .1. must be positive" } + !$omp end teams + + !$omp teams num_teams (-7 : 8) ! { dg-warning "INTEGER expression of NUM_TEAMS clause at .1. must be positive" } + !$omp end teams +end + +subroutine bar (i) + integer :: i + + !$omp target teams num_teams (6 : 4) ! { dg-warning "NUM_TEAMS lower bound at .1. larger than upper bound at .2." } + !$omp end target teams + + !$omp target teams num_teams (-7) ! { dg-warning "INTEGER expression of NUM_TEAMS clause at .1. must be positive" } + !$omp end target teams + + !$omp target teams num_teams (i : -7) ! { dg-warning "INTEGER expression of NUM_TEAMS clause at .1. must be positive" } + !$omp end target teams + + !$omp target teams num_teams (-7 : 8) ! { dg-warning "INTEGER expression of NUM_TEAMS clause at .1. must be positive" } + !$omp end target teams +end +end module |