[Flang][OpenMP]Add parsing support for DISPATCH construct

This allows the Flang parser to accept the !$OMP DISPATCH and
related clauses.

Lowering is currently not implemented. Tests for unparse and
parse-tree dump is provided, and one for checking that the
lowering ends in a "not yet implemented"

Author: Leporacanthicus

flang/include/flang/Parser/dump-parse-tree.h

@@ -662,6 +662,9 @@ class ParseTreeDumper {
   NODE(parser, OmpAtomicDefaultMemOrderClause)
   NODE_ENUM(common, OmpAtomicDefaultMemOrderType)
   NODE(parser, OpenMPDepobjConstruct)
+  NODE(parser, OpenMPDispatchConstruct)
+  NODE(parser, OmpDispatchDirective)
+  NODE(parser, OmpEndDispatchDirective)
   NODE(parser, OpenMPErrorConstruct)
   NODE(parser, OpenMPFlushConstruct)
   NODE(parser, OpenMPLoopConstruct)

flang/include/flang/Parser/parse-tree.h

@@ -4506,6 +4506,31 @@ struct OpenMPDepobjConstruct {
   std::tuple<Verbatim, OmpObject, OmpClause> t;
 };
 
+// Ref: [5.2: 200-201]
+//
+// dispatch-construct -> DISPATCH dispatch-clause
+// dispatch-clause -> depend-clause |
+//                    device-clause |
+//                    is_device_ptr-clause |
+//                    nocontext-clause |
+//                    novariants-clause |
+//                    nowait-clause
+struct OmpDispatchDirective {
+  TUPLE_CLASS_BOILERPLATE(OmpDispatchDirective);
+  CharBlock source;
+  std::tuple<Verbatim, OmpClauseList> t;
+};
+
+EMPTY_CLASS(OmpEndDispatchDirective);
+
+struct OpenMPDispatchConstruct {
+  TUPLE_CLASS_BOILERPLATE(OpenMPDispatchConstruct);
+  CharBlock source;
+  std::tuple<OmpDispatchDirective, Block,
+      std::optional<OmpEndDispatchDirective>>
+      t;
+};
+
 // Ref: OpenMP [5.2:216-218]
 // ERROR AT(compilation|execution) SEVERITY(fatal|warning) MESSAGE("msg-str)
 struct OpenMPErrorConstruct {
@@ -4586,8 +4611,8 @@ struct OpenMPConstruct {
   UNION_CLASS_BOILERPLATE(OpenMPConstruct);
   std::variant<OpenMPStandaloneConstruct, OpenMPSectionsConstruct,
       OpenMPSectionConstruct, OpenMPLoopConstruct, OpenMPBlockConstruct,
-      OpenMPAtomicConstruct, OpenMPDeclarativeAllocate, OpenMPErrorConstruct,
-      OpenMPExecutableAllocate, OpenMPAllocatorsConstruct,
+      OpenMPAtomicConstruct, OpenMPDeclarativeAllocate, OpenMPDispatchConstruct,
+      OpenMPErrorConstruct, OpenMPExecutableAllocate, OpenMPAllocatorsConstruct,
       OpenMPCriticalConstruct>
       u;
 };

flang/lib/Lower/OpenMP/OpenMP.cpp

@@ -2904,6 +2904,13 @@ static void genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable,
                 queue.begin(), name);
 }
 
+static void genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable,
+                   semantics::SemanticsContext &semaCtx,
+                   lower::pft::Evaluation &eval,
+                   const parser::OpenMPDispatchConstruct &) {
+  TODO(converter.getCurrentLocation(), "OpenMPDispatchConstruct");
+}
+
 static void genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable,
                    semantics::SemanticsContext &semaCtx,
                    lower::pft::Evaluation &eval,

flang/lib/Parser/openmp-parsers.cpp

@@ -659,11 +659,15 @@ TYPE_PARSER(
     "MERGEABLE" >> construct<OmpClause>(construct<OmpClause::Mergeable>()) ||
     "MESSAGE" >> construct<OmpClause>(construct<OmpClause::Message>(
                      parenthesized(Parser<OmpMessageClause>{}))) ||
+    "NOCONTEXT" >> construct<OmpClause>(construct<OmpClause::Nocontext>(
+                       parenthesized(scalarLogicalExpr))) ||
     "NOGROUP" >> construct<OmpClause>(construct<OmpClause::Nogroup>()) ||
     "NONTEMPORAL" >> construct<OmpClause>(construct<OmpClause::Nontemporal>(
                          parenthesized(nonemptyList(name)))) ||
     "NOTINBRANCH" >>
         construct<OmpClause>(construct<OmpClause::Notinbranch>()) ||
+    "NOVARIANTS" >> construct<OmpClause>(construct<OmpClause::Novariants>(
+                        parenthesized(scalarLogicalExpr))) ||
     "NOWAIT" >> construct<OmpClause>(construct<OmpClause::Nowait>()) ||
     "NUM_TASKS" >> construct<OmpClause>(construct<OmpClause::NumTasks>(
                        parenthesized(Parser<OmpNumTasksClause>{}))) ||
@@ -1027,6 +1031,16 @@ TYPE_PARSER(sourced(construct<OmpCriticalDirective>(verbatim("CRITICAL"_tok),
 TYPE_PARSER(construct<OpenMPCriticalConstruct>(
     Parser<OmpCriticalDirective>{}, block, Parser<OmpEndCriticalDirective>{}))
 
+TYPE_PARSER(sourced(construct<OmpDispatchDirective>(
+    verbatim("DISPATCH"_tok), Parser<OmpClauseList>{})))
+
+TYPE_PARSER(
+    construct<OmpEndDispatchDirective>(startOmpLine >> "END DISPATCH"_tok))
+
+TYPE_PARSER(sourced(construct<OpenMPDispatchConstruct>(
+    Parser<OmpDispatchDirective>{} / endOmpLine, block,
+    maybe(Parser<OmpEndDispatchDirective>{} / endOmpLine))))
+
 TYPE_PARSER(sourced(construct<OpenMPErrorConstruct>(
     verbatim("ERROR"_tok), Parser<OmpClauseList>{})))
 
@@ -1127,6 +1141,7 @@ TYPE_CONTEXT_PARSER("OpenMP construct"_en_US,
                 // OpenMPStandaloneConstruct to resolve !$OMP ORDERED
                 construct<OpenMPConstruct>(Parser<OpenMPStandaloneConstruct>{}),
                 construct<OpenMPConstruct>(Parser<OpenMPAtomicConstruct>{}),
+                construct<OpenMPConstruct>(Parser<OpenMPDispatchConstruct>{}),
                 construct<OpenMPConstruct>(Parser<OpenMPErrorConstruct>{}),
                 construct<OpenMPConstruct>(Parser<OpenMPExecutableAllocate>{}),
                 construct<OpenMPConstruct>(Parser<OpenMPAllocatorsConstruct>{}),

flang/lib/Parser/unparse.cpp

@@ -2710,6 +2710,15 @@ class UnparseVisitor {
     Walk(x.v);
     return false;
   }
+  void Unparse(const OmpDispatchDirective &x) {
+    Word("!$OMP DISPATCH");
+    Walk(x.t);
+    Put("\n");
+  }
+  void Unparse(const OmpEndDispatchDirective &) {
+    Word("!$OMP END DISPATCH");
+    Put("\n");
+  }
   void Unparse(const OpenMPErrorConstruct &x) {
     Word("!$OMP ERROR ");
     Walk(x.t);

flang/lib/Semantics/check-omp-structure.cpp

@@ -1688,6 +1688,14 @@ void OmpStructureChecker::Leave(const parser::OpenMPDeclareTargetConstruct &x) {
   dirContext_.pop_back();
 }
 
+void OmpStructureChecker::Enter(const parser::OpenMPDispatchConstruct &x) {
+  PushContextAndClauseSets(x.source, llvm::omp::Directive::OMPD_dispatch);
+}
+
+void OmpStructureChecker::Leave(const parser::OpenMPDispatchConstruct &x) {
+  dirContext_.pop_back();
+}
+
 void OmpStructureChecker::Enter(const parser::OpenMPErrorConstruct &x) {
   const auto &dir{std::get<parser::Verbatim>(x.t)};
   PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_error);

flang/lib/Semantics/check-omp-structure.h

@@ -102,6 +102,8 @@ class OmpStructureChecker
   void Enter(const parser::OmpDeclareTargetWithList &);
   void Enter(const parser::OmpDeclareTargetWithClause &);
   void Leave(const parser::OmpDeclareTargetWithClause &);
+  void Enter(const parser::OpenMPDispatchConstruct &);
+  void Leave(const parser::OpenMPDispatchConstruct &);
   void Enter(const parser::OpenMPErrorConstruct &);
   void Leave(const parser::OpenMPErrorConstruct &);
   void Enter(const parser::OpenMPExecutableAllocate &);

flang/lib/Semantics/resolve-directives.cpp

@@ -441,6 +441,9 @@ class OmpAttributeVisitor : DirectiveAttributeVisitor<llvm::omp::Directive> {
   bool Pre(const parser::OpenMPDeclarativeAllocate &);
   void Post(const parser::OpenMPDeclarativeAllocate &) { PopContext(); }
 
+  bool Pre(const parser::OpenMPDispatchConstruct &);
+  void Post(const parser::OpenMPDispatchConstruct &) { PopContext(); }
+
   bool Pre(const parser::OpenMPExecutableAllocate &);
   void Post(const parser::OpenMPExecutableAllocate &);
 
@@ -1994,6 +1997,11 @@ bool OmpAttributeVisitor::Pre(const parser::OpenMPDeclarativeAllocate &x) {
   return false;
 }
 
+bool OmpAttributeVisitor::Pre(const parser::OpenMPDispatchConstruct &x) {
+  PushContext(x.source, llvm::omp::Directive::OMPD_dispatch);
+  return true;
+}
+
 bool OmpAttributeVisitor::Pre(const parser::OpenMPExecutableAllocate &x) {
   PushContext(x.source, llvm::omp::Directive::OMPD_allocate);
   const auto &list{std::get<std::optional<parser::OmpObjectList>>(x.t)};

flang/test/Lower/OpenMP/Todo/dispatch.f90

@@ -0,0 +1,9 @@
+! RUN: %not_todo_cmd %flang_fc1 -emit-fir -fopenmp -fopenmp-version=51 -o - %s 2>&1 | FileCheck %s
+
+! CHECK: not yet implemented: OpenMPDispatchConstruct
+program p
+  integer r
+  r = 1
+!$omp dispatch nowait
+  print *,r
+end program p

flang/test/Parser/OpenMP/dispatch.f90

@@ -0,0 +1,51 @@
+! RUN: %flang_fc1 %openmp_flags -fdebug-dump-parse-tree %s | FileCheck %s
+! RUN: %flang_fc1 %openmp_flags -fdebug-unparse %s | FileCheck %s --check-prefix="UNPARSE"
+
+integer function func(a, b, c)
+  integer  :: a, b, c
+  func = a + b + c
+end function func
+
+subroutine sub(x)
+  use iso_c_binding
+  integer :: func
+  integer :: r
+  type(c_ptr) :: x
+  integer :: a = 14, b = 7, c = 21
+!UNPARSE: !$OMP DISPATCH DEVICE(3_4) NOWAIT NOCONTEXT(.false._4) NOVARIANTS(.true._4)
+!CHECK: | | ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPDispatchConstruct
+!CHECK-NEXT: | | | OmpDispatchDirective
+!CHECK: | | | | OmpClauseList -> OmpClause -> Device -> OmpDeviceClause
+!CHECK-NEXT: | | | | | Scalar -> Integer -> Expr = '3_4'
+!CHECK-NEXT: | | | | | | LiteralConstant -> IntLiteralConstant = '3'
+!CHECK-NEXT: | | | | OmpClause -> Nowait
+!CHECK-NEXT: | | | | OmpClause -> Nocontext -> Scalar -> Logical -> Expr = '.false._4'
+!CHECK-NEXT: | | | | | LiteralConstant -> LogicalLiteralConstant
+!CHECK-NEXT: | | | | | | bool = 'false'
+!CHECK-NEXT: | | | | OmpClause -> Novariants -> Scalar -> Logical -> Expr = '.true._4'
+!CHECK-NEXT: | | | | | EQ
+!CHECK-NEXT: | | | | | | Expr = '1_4'
+!CHECK-NEXT: | | | | | | | LiteralConstant -> IntLiteralConstant = '1'
+!CHECK-NEXT: | | | | | | Expr = '1_4'
+!CHECK-NEXT: | | | | | | | LiteralConstant -> IntLiteralConstant = '1'
+!CHECK-NEXT: | | | Block
+ 
+  !$omp dispatch device(3) nowait nocontext(.false.) novariants(1.eq.1)
+  r = func(a, b, c)
+!UNPARSE: !$OMP END DISPATCH
+!CHECK: | | | OmpEndDispatchDirective
+  !$omp end dispatch
+
+!! Test the "no end dispatch" option.
+!UNPARSE: !$OMP DISPATCH  DEVICE(3_4) IS_DEVICE_PTR(x)
+!CHECK: | | ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPDispatchConstruct
+!CHECK-NEXT: | | | OmpDispatchDirective
+!CHECK: | | | | OmpClause -> IsDevicePtr ->  OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'x'  
+  !$omp dispatch device(3) is_device_ptr(x)
+  r = func(a+1, b+2, c+3)
+!CHECK-NOT: | | | OmpEndDispatchDirective
+
+end subroutine sub
+
+
+

llvm/include/llvm/Frontend/OpenMP/OMP.td

@@ -320,6 +320,7 @@ def OMPC_Novariants : Clause<"novariants"> {
 }
 def OMPC_NoWait : Clause<"nowait"> {
   let clangClass = "OMPNowaitClause";
+  let clangClass = "OmpNowaitClause";
 }
 def OMP_NUMTASKS_Strict : ClauseVal<"strict", 1, 1> {}
 def OMP_NUMTASKS_Unknown : ClauseVal<"unknown", 2, 0> { let isDefault = 1; }