Skip to content

Commit 5bbb63b

Browse files
klauslerklausler
authored
[flang] Parse REDUCE clauses in !$CUF KERNEL DO (llvm#92154)
A !$CUF KERNEL DO directive is allowed to have advisory REDUCE clauses similar to those in OpenACC and DO CONCURRENT. Parse and represent them. Semantic validation will follow.
1 parent 463f58a commit 5bbb63b

File tree

11 files changed

+199
-18
lines changed

11 files changed

+199
-18
lines changed

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

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -236,6 +236,7 @@ class ParseTreeDumper {
236236
NODE(parser, CUFKernelDoConstruct)
237237
NODE(CUFKernelDoConstruct, StarOrExpr)
238238
NODE(CUFKernelDoConstruct, Directive)
239+
NODE(parser, CUFReduction)
239240
NODE(parser, CycleStmt)
240241
NODE(parser, DataComponentDefStmt)
241242
NODE(parser, DataIDoObject)

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

Lines changed: 15 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -4303,20 +4303,32 @@ struct OpenACCConstruct {
43034303
};
43044304

43054305
// CUF-kernel-do-construct ->
4306-
// !$CUF KERNEL DO [ (scalar-int-constant-expr) ] <<< grid, block [, stream]
4307-
// >>> do-construct
4306+
// !$CUF KERNEL DO [ (scalar-int-constant-expr) ]
4307+
// <<< grid, block [, stream] >>>
4308+
// [ cuf-reduction... ]
4309+
// do-construct
43084310
// star-or-expr -> * | scalar-int-expr
43094311
// grid -> * | scalar-int-expr | ( star-or-expr-list )
43104312
// block -> * | scalar-int-expr | ( star-or-expr-list )
43114313
// stream -> 0, scalar-int-expr | STREAM = scalar-int-expr
4314+
// cuf-reduction -> [ REDUCE | REDUCTION ] (
4315+
// acc-reduction-op : scalar-variable-list )
4316+
4317+
struct CUFReduction {
4318+
TUPLE_CLASS_BOILERPLATE(CUFReduction);
4319+
using Operator = AccReductionOperator;
4320+
std::tuple<Operator, std::list<Scalar<Variable>>> t;
4321+
};
4322+
43124323
struct CUFKernelDoConstruct {
43134324
TUPLE_CLASS_BOILERPLATE(CUFKernelDoConstruct);
43144325
WRAPPER_CLASS(StarOrExpr, std::optional<ScalarIntExpr>);
43154326
struct Directive {
43164327
TUPLE_CLASS_BOILERPLATE(Directive);
43174328
CharBlock source;
43184329
std::tuple<std::optional<ScalarIntConstantExpr>, std::list<StarOrExpr>,
4319-
std::list<StarOrExpr>, std::optional<ScalarIntExpr>>
4330+
std::list<StarOrExpr>, std::optional<ScalarIntExpr>,
4331+
std::list<CUFReduction>>
43204332
t;
43214333
};
43224334
std::tuple<Directive, std::optional<DoConstruct>> t;

‎flang/lib/Parser/executable-parsers.cpp

Lines changed: 16 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -538,25 +538,34 @@ TYPE_CONTEXT_PARSER("UNLOCK statement"_en_US,
538538
construct<UnlockStmt>("UNLOCK (" >> lockVariable,
539539
defaulted("," >> nonemptyList(statOrErrmsg)) / ")"))
540540

541-
// CUF-kernel-do-construct -> CUF-kernel-do-directive do-construct
542-
// CUF-kernel-do-directive ->
543-
// !$CUF KERNEL DO [ (scalar-int-constant-expr) ] <<< grid, block [, stream]
544-
// >>> do-construct
541+
// CUF-kernel-do-construct ->
542+
// !$CUF KERNEL DO [ (scalar-int-constant-expr) ]
543+
// <<< grid, block [, stream] >>>
544+
// [ cuf-reduction... ]
545+
// do-construct
545546
// star-or-expr -> * | scalar-int-expr
546547
// grid -> * | scalar-int-expr | ( star-or-expr-list )
547548
// block -> * | scalar-int-expr | ( star-or-expr-list )
548-
// stream -> ( 0, | STREAM = ) scalar-int-expr
549+
// stream -> 0, scalar-int-expr | STREAM = scalar-int-expr
550+
// cuf-reduction -> [ REDUCTION | REDUCE ] (
551+
// acc-reduction-op : scalar-variable-list )
552+
549553
constexpr auto starOrExpr{construct<CUFKernelDoConstruct::StarOrExpr>(
550554
"*" >> pure<std::optional<ScalarIntExpr>>() ||
551555
applyFunction(presentOptional<ScalarIntExpr>, scalarIntExpr))};
552556
constexpr auto gridOrBlock{parenthesized(nonemptyList(starOrExpr)) ||
553557
applyFunction(singletonList<CUFKernelDoConstruct::StarOrExpr>, starOrExpr)};
558+
559+
TYPE_PARSER(("REDUCTION"_tok || "REDUCE"_tok) >>
560+
parenthesized(construct<CUFReduction>(Parser<CUFReduction::Operator>{},
561+
":" >> nonemptyList(scalar(variable)))))
562+
554563
TYPE_PARSER(sourced(beginDirective >> "$CUF KERNEL DO"_tok >>
555564
construct<CUFKernelDoConstruct::Directive>(
556565
maybe(parenthesized(scalarIntConstantExpr)), "<<<" >> gridOrBlock,
557566
"," >> gridOrBlock,
558-
maybe((", 0 ,"_tok || ", STREAM ="_tok) >> scalarIntExpr) / ">>>" /
559-
endDirective)))
567+
maybe((", 0 ,"_tok || ", STREAM ="_tok) >> scalarIntExpr) / ">>>",
568+
many(Parser<CUFReduction>{}) / endDirective)))
560569
TYPE_CONTEXT_PARSER("!$CUF KERNEL DO construct"_en_US,
561570
extension<LanguageFeature::CUDA>(construct<CUFKernelDoConstruct>(
562571
Parser<CUFKernelDoConstruct::Directive>{},

‎flang/lib/Parser/openacc-parsers.cpp

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -19,9 +19,9 @@
1919
// OpenACC Directives and Clauses
2020
namespace Fortran::parser {
2121

22-
constexpr auto startAccLine = skipStuffBeforeStatement >>
23-
("!$ACC "_sptok || "C$ACC "_sptok || "*$ACC "_sptok);
24-
constexpr auto endAccLine = space >> endOfLine;
22+
constexpr auto startAccLine{skipStuffBeforeStatement >>
23+
("!$ACC "_sptok || "C$ACC "_sptok || "*$ACC "_sptok)};
24+
constexpr auto endAccLine{space >> endOfLine};
2525

2626
// Autogenerated clauses parser. Information is taken from ACC.td and the
2727
// parser is generated by tablegen.

‎flang/lib/Parser/unparse.cpp

Lines changed: 33 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -2705,7 +2705,6 @@ class UnparseVisitor {
27052705
void Unparse(const CLASS::ENUM &x) { Word(CLASS::EnumToString(x)); }
27062706
WALK_NESTED_ENUM(AccDataModifier, Modifier)
27072707
WALK_NESTED_ENUM(AccessSpec, Kind) // R807
2708-
WALK_NESTED_ENUM(AccReductionOperator, Operator)
27092708
WALK_NESTED_ENUM(common, TypeParamAttr) // R734
27102709
WALK_NESTED_ENUM(common, CUDADataAttr) // CUDA
27112710
WALK_NESTED_ENUM(common, CUDASubprogramAttrs) // CUDA
@@ -2736,6 +2735,31 @@ class UnparseVisitor {
27362735
WALK_NESTED_ENUM(OmpOrderClause, Type) // OMP order-type
27372736
WALK_NESTED_ENUM(OmpOrderModifier, Kind) // OMP order-modifier
27382737
#undef WALK_NESTED_ENUM
2738+
void Unparse(const AccReductionOperator::Operator x) {
2739+
switch (x) {
2740+
case AccReductionOperator::Operator::Plus:
2741+
Word("+");
2742+
break;
2743+
case AccReductionOperator::Operator::Multiply:
2744+
Word("*");
2745+
break;
2746+
case AccReductionOperator::Operator::And:
2747+
Word(".AND.");
2748+
break;
2749+
case AccReductionOperator::Operator::Or:
2750+
Word(".OR.");
2751+
break;
2752+
case AccReductionOperator::Operator::Eqv:
2753+
Word(".EQV.");
2754+
break;
2755+
case AccReductionOperator::Operator::Neqv:
2756+
Word(".NEQV.");
2757+
break;
2758+
default:
2759+
Word(AccReductionOperator::EnumToString(x));
2760+
break;
2761+
}
2762+
}
27392763

27402764
void Unparse(const CUFKernelDoConstruct::StarOrExpr &x) {
27412765
if (x.v) {
@@ -2768,13 +2792,19 @@ class UnparseVisitor {
27682792
if (const auto &stream{std::get<3>(x.t)}) {
27692793
Word(",STREAM="), Walk(*stream);
27702794
}
2771-
Word(">>>\n");
2795+
Word(">>>");
2796+
Walk(" ", std::get<std::list<CUFReduction>>(x.t), " ");
2797+
Word("\n");
27722798
}
2773-
27742799
void Unparse(const CUFKernelDoConstruct &x) {
27752800
Walk(std::get<CUFKernelDoConstruct::Directive>(x.t));
27762801
Walk(std::get<std::optional<DoConstruct>>(x.t));
27772802
}
2803+
void Unparse(const CUFReduction &x) {
2804+
Word("REDUCE(");
2805+
Walk(std::get<CUFReduction::Operator>(x.t));
2806+
Walk(":", std::get<std::list<Scalar<Variable>>>(x.t), ",", ")");
2807+
}
27782808

27792809
void Done() const { CHECK(indent_ == 0); }
27802810

‎flang/lib/Semantics/check-cuda.cpp

Lines changed: 44 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -463,6 +463,46 @@ static int DoConstructTightNesting(
463463
return 1;
464464
}
465465

466+
static void CheckReduce(
467+
SemanticsContext &context, const parser::CUFReduction &reduce) {
468+
auto op{std::get<parser::CUFReduction::Operator>(reduce.t).v};
469+
for (const auto &var :
470+
std::get<std::list<parser::Scalar<parser::Variable>>>(reduce.t)) {
471+
if (const auto &typedExprPtr{var.thing.typedExpr};
472+
typedExprPtr && typedExprPtr->v) {
473+
const auto &expr{*typedExprPtr->v};
474+
if (auto type{expr.GetType()}) {
475+
auto cat{type->category()};
476+
bool isOk{false};
477+
switch (op) {
478+
case parser::AccReductionOperator::Operator::Plus:
479+
case parser::AccReductionOperator::Operator::Multiply:
480+
case parser::AccReductionOperator::Operator::Max:
481+
case parser::AccReductionOperator::Operator::Min:
482+
isOk = cat == TypeCategory::Integer || cat == TypeCategory::Real;
483+
break;
484+
case parser::AccReductionOperator::Operator::Iand:
485+
case parser::AccReductionOperator::Operator::Ior:
486+
case parser::AccReductionOperator::Operator::Ieor:
487+
isOk = cat == TypeCategory::Integer;
488+
break;
489+
case parser::AccReductionOperator::Operator::And:
490+
case parser::AccReductionOperator::Operator::Or:
491+
case parser::AccReductionOperator::Operator::Eqv:
492+
case parser::AccReductionOperator::Operator::Neqv:
493+
isOk = cat == TypeCategory::Logical;
494+
break;
495+
}
496+
if (!isOk) {
497+
context.Say(var.thing.GetSource(),
498+
"!$CUF KERNEL DO REDUCE operation is not acceptable for a variable with type %s"_err_en_US,
499+
type->AsFortran());
500+
}
501+
}
502+
}
503+
}
504+
}
505+
466506
void CUDAChecker::Enter(const parser::CUFKernelDoConstruct &x) {
467507
auto source{std::get<parser::CUFKernelDoConstruct::Directive>(x.t).source};
468508
const auto &directive{std::get<parser::CUFKernelDoConstruct::Directive>(x.t)};
@@ -489,6 +529,10 @@ void CUDAChecker::Enter(const parser::CUFKernelDoConstruct &x) {
489529
if (innerBlock) {
490530
DeviceContextChecker<true>{context_}.Check(*innerBlock);
491531
}
532+
for (const auto &reduce :
533+
std::get<std::list<parser::CUFReduction>>(directive.t)) {
534+
CheckReduce(context_, reduce);
535+
}
492536
}
493537

494538
void CUDAChecker::Enter(const parser::AssignmentStmt &x) {

‎flang/lib/Semantics/resolve-directives.h

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -21,7 +21,7 @@ class SemanticsContext;
2121

2222
// Name resolution for OpenACC and OpenMP directives
2323
void ResolveAccParts(
24-
SemanticsContext &, const parser::ProgramUnit &, Scope *topScope = {});
24+
SemanticsContext &, const parser::ProgramUnit &, Scope *topScope);
2525
void ResolveOmpParts(SemanticsContext &, const parser::ProgramUnit &);
2626
void ResolveOmpTopLevelParts(SemanticsContext &, const parser::Program &);
2727

‎flang/lib/Semantics/resolve-names.cpp

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -8940,7 +8940,7 @@ bool ResolveNamesVisitor::Pre(const parser::ProgramUnit &x) {
89408940
FinishSpecificationParts(root);
89418941
ResolveExecutionParts(root);
89428942
FinishExecutionParts(root);
8943-
ResolveAccParts(context(), x);
8943+
ResolveAccParts(context(), x, /*topScope=*/nullptr);
89448944
ResolveOmpParts(context(), x);
89458945
return false;
89468946
}

‎flang/test/Parser/cuf-sanity-common

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -23,12 +23,19 @@ module m
2323
end subroutine
2424
subroutine test
2525
logical isPinned
26+
real a(10), x, y, z
2627
!$cuf kernel do(1) <<<*, *, stream = 1>>>
2728
do j = 1, 10
2829
end do
2930
!$cuf kernel do <<<1, (2, 3), stream = 1>>>
3031
do j = 1, 10
3132
end do
33+
!$cuf kernel do <<<*, *>>> reduce(+:x,y) reduce(*:z)
34+
do j = 1, 10
35+
x = x + a(j)
36+
y = y + a(j)
37+
z = z * a(j)
38+
end do
3239
call globalsub<<<1, 2>>>
3340
call globalsub<<<1, 2, 3>>>
3441
call globalsub<<<1, 2, 3, 4>>>

‎flang/test/Parser/cuf-sanity-unparse.CUF

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -34,6 +34,12 @@ include "cuf-sanity-common"
3434
!CHECK: !$CUF KERNEL DO <<<1_4,(2_4,3_4),STREAM=1_4>>>
3535
!CHECK: DO j=1_4,10_4
3636
!CHECK: END DO
37+
!CHECK: !$CUF KERNEL DO <<<*,*>>> REDUCE(+:x,y) REDUCE(*:z)
38+
!CHECK: DO j=1_4,10_4
39+
!CHECK: x=x+a(int(j,kind=8))
40+
!CHECK: y=y+a(int(j,kind=8))
41+
!CHECK: z=z*a(int(j,kind=8))
42+
!CHECK: END DO
3743
!CHECK: CALL globalsub<<<1_4,2_4>>>()
3844
!CHECK: CALL globalsub<<<1_4,2_4,3_4>>>()
3945
!CHECK: CALL globalsub<<<1_4,2_4,3_4,4_4>>>()

‎flang/test/Semantics/reduce.cuf

Lines changed: 72 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,72 @@
1+
! RUN: %python %S/test_errors.py %s %flang_fc1
2+
subroutine s(n,m,a,l)
3+
integer, intent(in) :: n
4+
integer, intent(in) :: m(n)
5+
real, intent(in) :: a(n)
6+
logical, intent(in) :: l(n)
7+
integer j, mr
8+
real ar
9+
logical lr
10+
!$cuf kernel do <<<*,*>>> reduce (+:mr,ar)
11+
do j=1,n; mr = mr + m(j); ar = ar + a(j); end do
12+
!ERROR: !$CUF KERNEL DO REDUCE operation is not acceptable for a variable with type LOGICAL(4)
13+
!$cuf kernel do <<<*,*>>> reduce (+:lr)
14+
do j=1,n; end do
15+
!$cuf kernel do <<<*,*>>> reduce (*:mr,ar)
16+
do j=1,n; mr = mr * m(j); ar = ar * a(j); end do
17+
!ERROR: !$CUF KERNEL DO REDUCE operation is not acceptable for a variable with type LOGICAL(4)
18+
!$cuf kernel do <<<*,*>>> reduce (*:lr)
19+
do j=1,n; end do
20+
!$cuf kernel do <<<*,*>>> reduce (max:mr,ar)
21+
do j=1,n; mr = max(mr,m(j)); ar = max(ar,a(j)); end do
22+
!ERROR: !$CUF KERNEL DO REDUCE operation is not acceptable for a variable with type LOGICAL(4)
23+
!$cuf kernel do <<<*,*>>> reduce (max:lr)
24+
do j=1,n; end do
25+
!$cuf kernel do <<<*,*>>> reduce (min:mr,ar)
26+
do j=1,n; mr = min(mr,m(j)); ar = min(ar,a(j)); end do
27+
!ERROR: !$CUF KERNEL DO REDUCE operation is not acceptable for a variable with type LOGICAL(4)
28+
!$cuf kernel do <<<*,*>>> reduce (min:lr)
29+
do j=1,n; end do
30+
!$cuf kernel do <<<*,*>>> reduce (iand:mr)
31+
do j=1,n; mr = iand(mr,m(j)); end do
32+
!ERROR: !$CUF KERNEL DO REDUCE operation is not acceptable for a variable with type REAL(4)
33+
!ERROR: !$CUF KERNEL DO REDUCE operation is not acceptable for a variable with type LOGICAL(4)
34+
!$cuf kernel do <<<*,*>>> reduce (iand:ar,lr)
35+
do j=1,n; end do
36+
!$cuf kernel do <<<*,*>>> reduce (ieor:mr)
37+
do j=1,n; mr = ieor(mr,m(j)); end do
38+
!ERROR: !$CUF KERNEL DO REDUCE operation is not acceptable for a variable with type REAL(4)
39+
!ERROR: !$CUF KERNEL DO REDUCE operation is not acceptable for a variable with type LOGICAL(4)
40+
!$cuf kernel do <<<*,*>>> reduce (ieor:ar,lr)
41+
do j=1,n; end do
42+
!$cuf kernel do <<<*,*>>> reduce (ior:mr)
43+
do j=1,n; mr = ior(mr,m(j)); end do
44+
!ERROR: !$CUF KERNEL DO REDUCE operation is not acceptable for a variable with type REAL(4)
45+
!ERROR: !$CUF KERNEL DO REDUCE operation is not acceptable for a variable with type LOGICAL(4)
46+
!$cuf kernel do <<<*,*>>> reduce (ior:ar,lr)
47+
do j=1,n; end do
48+
!$cuf kernel do <<<*,*>>> reduce (.and.:lr)
49+
do j=1,n; lr = lr .and. l(j); end do
50+
!ERROR: !$CUF KERNEL DO REDUCE operation is not acceptable for a variable with type INTEGER(4)
51+
!ERROR: !$CUF KERNEL DO REDUCE operation is not acceptable for a variable with type REAL(4)
52+
!$cuf kernel do <<<*,*>>> reduce (.and.:mr,ar)
53+
do j=1,n; end do
54+
!$cuf kernel do <<<*,*>>> reduce (.eqv.:lr)
55+
do j=1,n; lr = lr .eqv. l(j); end do
56+
!ERROR: !$CUF KERNEL DO REDUCE operation is not acceptable for a variable with type INTEGER(4)
57+
!ERROR: !$CUF KERNEL DO REDUCE operation is not acceptable for a variable with type REAL(4)
58+
!$cuf kernel do <<<*,*>>> reduce (.eqv.:mr,ar)
59+
do j=1,n; end do
60+
!$cuf kernel do <<<*,*>>> reduce (.neqv.:lr)
61+
do j=1,n; lr = lr .neqv. l(j); end do
62+
!ERROR: !$CUF KERNEL DO REDUCE operation is not acceptable for a variable with type INTEGER(4)
63+
!ERROR: !$CUF KERNEL DO REDUCE operation is not acceptable for a variable with type REAL(4)
64+
!$cuf kernel do <<<*,*>>> reduce (.neqv.:mr,ar)
65+
do j=1,n; end do
66+
!$cuf kernel do <<<*,*>>> reduce (.or.:lr)
67+
do j=1,n; lr = lr .or. l(j); end do
68+
!ERROR: !$CUF KERNEL DO REDUCE operation is not acceptable for a variable with type INTEGER(4)
69+
!ERROR: !$CUF KERNEL DO REDUCE operation is not acceptable for a variable with type REAL(4)
70+
!$cuf kernel do <<<*,*>>> reduce (.or.:mr,ar)
71+
do j=1,n; end do
72+
end

0 commit comments

Comments
 (0)