From e2a228438919d846995bf2c839c9b657442224b2 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Wed, 5 Oct 2022 19:25:27 +0200 Subject: Fortran: Add OpenMP's assume(s) directives libgomp/ChangeLog: * libgomp.texi (OpenMP 5.1 Impl. Status): Mark 'assume' as 'Y'. gcc/fortran/ChangeLog: * dump-parse-tree.cc (show_omp_assumes): New. (show_omp_clauses, show_namespace): Call it. (show_omp_node, show_code_node): Handle OpenMP ASSUME. * gfortran.h (enum gfc_statement): Add ST_OMP_ASSUME, ST_OMP_END_ASSUME, ST_OMP_ASSUMES and ST_NOTHING. (gfc_exec_op): Add EXEC_OMP_ASSUME. (gfc_omp_assumptions): New struct. (gfc_get_omp_assumptions): New XCNEW #define. (gfc_omp_clauses, gfc_namespace): Add assume member. (gfc_resolve_omp_assumptions): New prototype. * match.h (gfc_match_omp_assume, gfc_match_omp_assumes): New. * openmp.cc (omp_code_to_statement): Forward declare. (enum gfc_omp_directive_kind, struct gfc_omp_directive): New. (gfc_free_omp_clauses): Free assume member and its struct data. (enum omp_mask2): Add OMP_CLAUSE_ASSUMPTIONS. (gfc_omp_absent_contains_clause): New. (gfc_match_omp_clauses): Call it; optionally use passed omp_clauses argument. (omp_verify_merge_absent_contains, gfc_match_omp_assume, gfc_match_omp_assumes, gfc_resolve_omp_assumptions): New. (resolve_omp_clauses): Call the latter. (gfc_resolve_omp_directive, omp_code_to_statement): Handle EXEC_OMP_ASSUME. * parse.cc (decode_omp_directive): Parse OpenMP ASSUME(S). (next_statement, parse_executable, parse_omp_structured_block): Handle ST_OMP_ASSUME. (case_omp_decl): Add ST_OMP_ASSUMES. (gfc_ascii_statement): Handle Assumes, optional return string without '!$OMP '/'!$ACC ' prefix. * parse.h (gfc_ascii_statement): Add optional bool arg to prototype. * resolve.cc (gfc_resolve_blocks, gfc_resolve_code): Add EXEC_OMP_ASSUME. (gfc_resolve): Resolve ASSUMES directive. * symbol.cc (gfc_free_namespace): Free omp_assumes member. * st.cc (gfc_free_statement): Handle EXEC_OMP_ASSUME. * trans-openmp.cc (gfc_trans_omp_directive): Likewise. * trans.cc (trans_code): Likewise. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/assume-1.f90: New test. * gfortran.dg/gomp/assume-2.f90: New test. * gfortran.dg/gomp/assumes-1.f90: New test. * gfortran.dg/gomp/assumes-2.f90: New test. --- gcc/fortran/dump-parse-tree.cc | 41 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 41 insertions(+) (limited to 'gcc/fortran/dump-parse-tree.cc') diff --git a/gcc/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc index 40c690c..2f042ab 100644 --- a/gcc/fortran/dump-parse-tree.cc +++ b/gcc/fortran/dump-parse-tree.cc @@ -36,6 +36,7 @@ along with GCC; see the file COPYING3. If not see #include "gfortran.h" #include "constructor.h" #include "version.h" +#include "parse.h" /* For gfc_ascii_statement. */ /* Keep track of indentation for symbol tree dumps. */ static int show_level = 0; @@ -1458,6 +1459,34 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n) gfc_current_ns = ns_curr; } +static void +show_omp_assumes (gfc_omp_assumptions *assume) +{ + for (int i = 0; i < assume->n_absent; i++) + { + fputs (" ABSENT (", dumpfile); + fputs (gfc_ascii_statement (assume->absent[i], true), dumpfile); + fputc (')', dumpfile); + } + for (int i = 0; i < assume->n_contains; i++) + { + fputs (" CONTAINS (", dumpfile); + fputs (gfc_ascii_statement (assume->contains[i], true), dumpfile); + fputc (')', dumpfile); + } + for (gfc_expr_list *el = assume->holds; el; el = el->next) + { + fputs (" HOLDS (", dumpfile); + show_expr (el->expr); + fputc (')', dumpfile); + } + if (assume->no_openmp) + fputs (" NO_OPENMP", dumpfile); + if (assume->no_openmp_routines) + fputs (" NO_OPENMP_ROUTINES", dumpfile); + if (assume->no_parallelism) + fputs (" NO_PARALLELISM", dumpfile); +} /* Show OpenMP or OpenACC clauses. */ @@ -1998,6 +2027,8 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses) show_expr (omp_clauses->message); fputc (')', dumpfile); } + if (omp_clauses->assume) + show_omp_assumes (omp_clauses->assume); } /* Show a single OpenMP or OpenACC directive node and everything underneath it @@ -2027,6 +2058,7 @@ show_omp_node (int level, gfc_code *c) case EXEC_OACC_CACHE: name = "CACHE"; is_oacc = true; break; case EXEC_OACC_ENTER_DATA: name = "ENTER DATA"; is_oacc = true; break; case EXEC_OACC_EXIT_DATA: name = "EXIT DATA"; is_oacc = true; break; + case EXEC_OMP_ASSUME: name = "ASSUME"; break; case EXEC_OMP_ATOMIC: name = "ATOMIC"; break; case EXEC_OMP_BARRIER: name = "BARRIER"; break; case EXEC_OMP_CANCEL: name = "CANCEL"; break; @@ -2128,6 +2160,7 @@ show_omp_node (int level, gfc_code *c) case EXEC_OACC_CACHE: case EXEC_OACC_ENTER_DATA: case EXEC_OACC_EXIT_DATA: + case EXEC_OMP_ASSUME: case EXEC_OMP_CANCEL: case EXEC_OMP_CANCELLATION_POINT: case EXEC_OMP_DISTRIBUTE: @@ -3353,6 +3386,7 @@ show_code_node (int level, gfc_code *c) case EXEC_OACC_CACHE: case EXEC_OACC_ENTER_DATA: case EXEC_OACC_EXIT_DATA: + case EXEC_OMP_ASSUME: case EXEC_OMP_ATOMIC: case EXEC_OMP_CANCEL: case EXEC_OMP_CANCELLATION_POINT: @@ -3531,6 +3565,13 @@ show_namespace (gfc_namespace *ns) } } + if (ns->omp_assumes) + { + show_indent (); + fprintf (dumpfile, "!$OMP ASSUMES"); + show_omp_assumes (ns->omp_assumes); + } + fputc ('\n', dumpfile); show_indent (); fputs ("code:", dumpfile); -- cgit v1.1