14
14
using namespace Fortran ::runtime;
15
15
using namespace Fortran ::semantics;
16
16
17
+ // Most PRIF functions take `errmsg` and `errmsg_alloc` as two optional
18
+ // arguments of intent (out). One is allocatable, the other is not.
19
+ // It is the responsibility of the compiler to ensure that the appropriate
20
+ // optional argument is passed, and at most one must be provided in a given
21
+ // call.
22
+ // Depending on the type of `errmsg`, this function will return the pair
23
+ // corresponding to (`errmsg`, `errmsg_alloc`).
24
+ static std::pair<mlir::Value, mlir::Value>
25
+ genErrmsgPRIF (fir::FirOpBuilder &builder, mlir::Location loc,
26
+ mlir::Value errmsg) {
27
+ bool isAllocatableErrmsg = fir::isAllocatableType (errmsg.getType ());
28
+
29
+ mlir::Value absent = fir::AbsentOp::create (builder, loc, PRIF_ERRMSG_TYPE);
30
+ mlir::Value errMsg = isAllocatableErrmsg ? absent : errmsg;
31
+ mlir::Value errMsgAlloc = isAllocatableErrmsg ? errmsg : absent;
32
+ return {errMsg, errMsgAlloc};
33
+ }
34
+
17
35
// / Generate Call to runtime prif_init
18
36
mlir::Value fir::runtime::genInitCoarray (fir::FirOpBuilder &builder,
19
37
mlir::Location loc) {
@@ -24,8 +42,8 @@ mlir::Value fir::runtime::genInitCoarray(fir::FirOpBuilder &builder,
24
42
builder.createFunction (loc, PRIFNAME_SUB (" init" ), ftype);
25
43
llvm::SmallVector<mlir::Value> args =
26
44
fir::runtime::createArguments (builder, loc, ftype, result);
27
- builder. create < fir::CallOp>( loc, funcOp, args);
28
- return builder. create < fir::LoadOp>( loc, result);
45
+ fir::CallOp::create (builder, loc, funcOp, args);
46
+ return fir::LoadOp::create (builder, loc, result);
29
47
}
30
48
31
49
// / Generate Call to runtime prif_num_images
@@ -38,8 +56,8 @@ mlir::Value fir::runtime::getNumImages(fir::FirOpBuilder &builder,
38
56
builder.createFunction (loc, PRIFNAME_SUB (" num_images" ), ftype);
39
57
llvm::SmallVector<mlir::Value> args =
40
58
fir::runtime::createArguments (builder, loc, ftype, result);
41
- builder. create < fir::CallOp>( loc, funcOp, args);
42
- return builder. create < fir::LoadOp>( loc, result);
59
+ fir::CallOp::create (builder, loc, funcOp, args);
60
+ return fir::LoadOp::create (builder, loc, result);
43
61
}
44
62
45
63
// / Generate Call to runtime prif_num_images_with_{team|team_number}
@@ -63,8 +81,8 @@ mlir::Value fir::runtime::getNumImagesWithTeam(fir::FirOpBuilder &builder,
63
81
team = builder.createBox (loc, team);
64
82
llvm::SmallVector<mlir::Value> args =
65
83
fir::runtime::createArguments (builder, loc, ftype, team, result);
66
- builder. create < fir::CallOp>( loc, funcOp, args);
67
- return builder. create < fir::LoadOp>( loc, result);
84
+ fir::CallOp::create (builder, loc, funcOp, args);
85
+ return fir::LoadOp::create (builder, loc, result);
68
86
}
69
87
70
88
// / Generate Call to runtime prif_this_image_no_coarray
@@ -78,9 +96,72 @@ mlir::Value fir::runtime::getThisImage(fir::FirOpBuilder &builder,
78
96
79
97
mlir::Value result = builder.createTemporary (loc, builder.getI32Type ());
80
98
mlir::Value teamArg =
81
- !team ? builder. create < fir::AbsentOp>( loc, boxTy) : team;
99
+ !team ? fir::AbsentOp::create (builder, loc, boxTy) : team;
82
100
llvm::SmallVector<mlir::Value> args =
83
101
fir::runtime::createArguments (builder, loc, ftype, teamArg, result);
84
- builder.create <fir::CallOp>(loc, funcOp, args);
85
- return builder.create <fir::LoadOp>(loc, result);
102
+ fir::CallOp::create (builder, loc, funcOp, args);
103
+ return fir::LoadOp::create (builder, loc, result);
104
+ }
105
+
106
+ // / Generate call to collective subroutines except co_reduce
107
+ // / A must be lowered as a box
108
+ void genCollectiveSubroutine (fir::FirOpBuilder &builder, mlir::Location loc,
109
+ mlir::Value A, mlir::Value rootImage,
110
+ mlir::Value stat, mlir::Value errmsg,
111
+ std::string coName) {
112
+ mlir::Type boxTy = fir::BoxType::get (builder.getNoneType ());
113
+ mlir::FunctionType ftype =
114
+ PRIF_FUNCTYPE (boxTy, builder.getRefType (builder.getI32Type ()),
115
+ PRIF_STAT_TYPE, PRIF_ERRMSG_TYPE, PRIF_ERRMSG_TYPE);
116
+ mlir::func::FuncOp funcOp = builder.createFunction (loc, coName, ftype);
117
+
118
+ auto [errmsgArg, errmsgAllocArg] = genErrmsgPRIF (builder, loc, errmsg);
119
+ llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments (
120
+ builder, loc, ftype, A, rootImage, stat, errmsgArg, errmsgAllocArg);
121
+ fir::CallOp::create (builder, loc, funcOp, args);
122
+ }
123
+
124
+ // / Generate call to runtime subroutine prif_co_broadcast
125
+ void fir::runtime::genCoBroadcast (fir::FirOpBuilder &builder,
126
+ mlir::Location loc, mlir::Value A,
127
+ mlir::Value sourceImage, mlir::Value stat,
128
+ mlir::Value errmsg) {
129
+ genCollectiveSubroutine (builder, loc, A, sourceImage, stat, errmsg,
130
+ PRIFNAME_SUB (" co_broadcast" ));
131
+ }
132
+
133
+ // / Generate call to runtime subroutine prif_co_max or prif_co_max_character
134
+ void fir::runtime::genCoMax (fir::FirOpBuilder &builder, mlir::Location loc,
135
+ mlir::Value A, mlir::Value resultImage,
136
+ mlir::Value stat, mlir::Value errmsg) {
137
+ mlir::Type argTy =
138
+ fir::unwrapSequenceType (fir::unwrapPassByRefType (A.getType ()));
139
+ if (mlir::isa<fir::CharacterType>(argTy))
140
+ genCollectiveSubroutine (builder, loc, A, resultImage, stat, errmsg,
141
+ PRIFNAME_SUB (" co_max_character" ));
142
+ else
143
+ genCollectiveSubroutine (builder, loc, A, resultImage, stat, errmsg,
144
+ PRIFNAME_SUB (" co_max" ));
145
+ }
146
+
147
+ // / Generate call to runtime subroutine prif_co_min or prif_co_min_character
148
+ void fir::runtime::genCoMin (fir::FirOpBuilder &builder, mlir::Location loc,
149
+ mlir::Value A, mlir::Value resultImage,
150
+ mlir::Value stat, mlir::Value errmsg) {
151
+ mlir::Type argTy =
152
+ fir::unwrapSequenceType (fir::unwrapPassByRefType (A.getType ()));
153
+ if (mlir::isa<fir::CharacterType>(argTy))
154
+ genCollectiveSubroutine (builder, loc, A, resultImage, stat, errmsg,
155
+ PRIFNAME_SUB (" co_min_character" ));
156
+ else
157
+ genCollectiveSubroutine (builder, loc, A, resultImage, stat, errmsg,
158
+ PRIFNAME_SUB (" co_min" ));
159
+ }
160
+
161
+ // / Generate call to runtime subroutine prif_co_sum
162
+ void fir::runtime::genCoSum (fir::FirOpBuilder &builder, mlir::Location loc,
163
+ mlir::Value A, mlir::Value resultImage,
164
+ mlir::Value stat, mlir::Value errmsg) {
165
+ genCollectiveSubroutine (builder, loc, A, resultImage, stat, errmsg,
166
+ PRIFNAME_SUB (" co_sum" ));
86
167
}
0 commit comments