1 //===-- Character.cpp -- runtime for CHARACTER type entities --------------===//
2 //
3 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
4 // See https://llvm.org/LICENSE.txt for license information.
5 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
6 //
7 //===----------------------------------------------------------------------===//
8
9 #include "flang/Optimizer/Builder/Runtime/Character.h"
10 #include "flang/Optimizer/Builder/BoxValue.h"
11 #include "flang/Optimizer/Builder/Character.h"
12 #include "flang/Optimizer/Builder/FIRBuilder.h"
13 #include "flang/Optimizer/Builder/Runtime/RTBuilder.h"
14 #include "flang/Optimizer/Builder/Todo.h"
15 #include "flang/Runtime/character.h"
16 #include "mlir/Dialect/Func/IR/FuncOps.h"
17
18 using namespace Fortran::runtime;
19
20 /// Generate calls to string handling intrinsics such as index, scan, and
21 /// verify. These are the descriptor based implementations that take four
22 /// arguments (string1, string2, back, kind).
23 template <typename FN>
genCharacterSearch(FN func,fir::FirOpBuilder & builder,mlir::Location loc,mlir::Value resultBox,mlir::Value string1Box,mlir::Value string2Box,mlir::Value backBox,mlir::Value kind)24 static void genCharacterSearch(FN func, fir::FirOpBuilder &builder,
25 mlir::Location loc, mlir::Value resultBox,
26 mlir::Value string1Box, mlir::Value string2Box,
27 mlir::Value backBox, mlir::Value kind) {
28
29 auto fTy = func.getFunctionType();
30 auto sourceFile = fir::factory::locationToFilename(builder, loc);
31 auto sourceLine =
32 fir::factory::locationToLineNo(builder, loc, fTy.getInput(6));
33
34 auto args = fir::runtime::createArguments(builder, loc, fTy, resultBox,
35 string1Box, string2Box, backBox,
36 kind, sourceFile, sourceLine);
37 builder.create<fir::CallOp>(loc, func, args);
38 }
39
40 /// Helper function to recover the KIND from the FIR type.
discoverKind(mlir::Type ty)41 static int discoverKind(mlir::Type ty) {
42 if (auto charTy = mlir::dyn_cast<fir::CharacterType>(ty))
43 return charTy.getFKind();
44 if (auto eleTy = fir::dyn_cast_ptrEleTy(ty))
45 return discoverKind(eleTy);
46 if (auto arrTy = mlir::dyn_cast<fir::SequenceType>(ty))
47 return discoverKind(arrTy.getEleTy());
48 if (auto boxTy = mlir::dyn_cast<fir::BoxCharType>(ty))
49 return discoverKind(boxTy.getEleTy());
50 if (auto boxTy = mlir::dyn_cast<fir::BoxType>(ty))
51 return discoverKind(boxTy.getEleTy());
52 llvm_unreachable("unexpected character type");
53 }
54
55 //===----------------------------------------------------------------------===//
56 // Lower character operations
57 //===----------------------------------------------------------------------===//
58
59 /// Generate a call to the `ADJUST[L|R]` runtime.
60 ///
61 /// \p resultBox must be an unallocated allocatable used for the temporary
62 /// result. \p StringBox must be a fir.box describing the adjustr string
63 /// argument. The \p adjustFunc should be a mlir::func::FuncOp for the
64 /// appropriate runtime entry function.
genAdjust(fir::FirOpBuilder & builder,mlir::Location loc,mlir::Value resultBox,mlir::Value stringBox,mlir::func::FuncOp & adjustFunc)65 static void genAdjust(fir::FirOpBuilder &builder, mlir::Location loc,
66 mlir::Value resultBox, mlir::Value stringBox,
67 mlir::func::FuncOp &adjustFunc) {
68
69 auto fTy = adjustFunc.getFunctionType();
70 auto sourceLine =
71 fir::factory::locationToLineNo(builder, loc, fTy.getInput(3));
72 auto sourceFile = fir::factory::locationToFilename(builder, loc);
73 auto args = fir::runtime::createArguments(builder, loc, fTy, resultBox,
74 stringBox, sourceFile, sourceLine);
75 builder.create<fir::CallOp>(loc, adjustFunc, args);
76 }
77
genAdjustL(fir::FirOpBuilder & builder,mlir::Location loc,mlir::Value resultBox,mlir::Value stringBox)78 void fir::runtime::genAdjustL(fir::FirOpBuilder &builder, mlir::Location loc,
79 mlir::Value resultBox, mlir::Value stringBox) {
80 auto adjustFunc =
81 fir::runtime::getRuntimeFunc<mkRTKey(Adjustl)>(loc, builder);
82 genAdjust(builder, loc, resultBox, stringBox, adjustFunc);
83 }
84
genAdjustR(fir::FirOpBuilder & builder,mlir::Location loc,mlir::Value resultBox,mlir::Value stringBox)85 void fir::runtime::genAdjustR(fir::FirOpBuilder &builder, mlir::Location loc,
86 mlir::Value resultBox, mlir::Value stringBox) {
87 auto adjustFunc =
88 fir::runtime::getRuntimeFunc<mkRTKey(Adjustr)>(loc, builder);
89 genAdjust(builder, loc, resultBox, stringBox, adjustFunc);
90 }
91
92 mlir::Value
genCharCompare(fir::FirOpBuilder & builder,mlir::Location loc,mlir::arith::CmpIPredicate cmp,mlir::Value lhsBuff,mlir::Value lhsLen,mlir::Value rhsBuff,mlir::Value rhsLen)93 fir::runtime::genCharCompare(fir::FirOpBuilder &builder, mlir::Location loc,
94 mlir::arith::CmpIPredicate cmp,
95 mlir::Value lhsBuff, mlir::Value lhsLen,
96 mlir::Value rhsBuff, mlir::Value rhsLen) {
97 mlir::func::FuncOp beginFunc;
98 switch (discoverKind(lhsBuff.getType())) {
99 case 1:
100 beginFunc = fir::runtime::getRuntimeFunc<mkRTKey(CharacterCompareScalar1)>(
101 loc, builder);
102 break;
103 case 2:
104 beginFunc = fir::runtime::getRuntimeFunc<mkRTKey(CharacterCompareScalar2)>(
105 loc, builder);
106 break;
107 case 4:
108 beginFunc = fir::runtime::getRuntimeFunc<mkRTKey(CharacterCompareScalar4)>(
109 loc, builder);
110 break;
111 default:
112 llvm_unreachable("runtime does not support CHARACTER KIND");
113 }
114 auto fTy = beginFunc.getFunctionType();
115 auto args = fir::runtime::createArguments(builder, loc, fTy, lhsBuff, rhsBuff,
116 lhsLen, rhsLen);
117 auto tri = builder.create<fir::CallOp>(loc, beginFunc, args).getResult(0);
118 auto zero = builder.createIntegerConstant(loc, tri.getType(), 0);
119 return builder.create<mlir::arith::CmpIOp>(loc, cmp, tri, zero);
120 }
121
genCharCompare(fir::FirOpBuilder & builder,mlir::Location loc,mlir::arith::CmpIPredicate cmp,const fir::ExtendedValue & lhs,const fir::ExtendedValue & rhs)122 mlir::Value fir::runtime::genCharCompare(fir::FirOpBuilder &builder,
123 mlir::Location loc,
124 mlir::arith::CmpIPredicate cmp,
125 const fir::ExtendedValue &lhs,
126 const fir::ExtendedValue &rhs) {
127 if (lhs.getBoxOf<fir::BoxValue>() || rhs.getBoxOf<fir::BoxValue>())
128 TODO(loc, "character compare from descriptors");
129 auto allocateIfNotInMemory = [&](mlir::Value base) -> mlir::Value {
130 if (fir::isa_ref_type(base.getType()))
131 return base;
132 auto mem =
133 builder.create<fir::AllocaOp>(loc, base.getType(), /*pinned=*/false);
134 builder.create<fir::StoreOp>(loc, base, mem);
135 return mem;
136 };
137 auto lhsBuffer = allocateIfNotInMemory(fir::getBase(lhs));
138 auto rhsBuffer = allocateIfNotInMemory(fir::getBase(rhs));
139 return genCharCompare(builder, loc, cmp, lhsBuffer, fir::getLen(lhs),
140 rhsBuffer, fir::getLen(rhs));
141 }
142
genIndex(fir::FirOpBuilder & builder,mlir::Location loc,int kind,mlir::Value stringBase,mlir::Value stringLen,mlir::Value substringBase,mlir::Value substringLen,mlir::Value back)143 mlir::Value fir::runtime::genIndex(fir::FirOpBuilder &builder,
144 mlir::Location loc, int kind,
145 mlir::Value stringBase,
146 mlir::Value stringLen,
147 mlir::Value substringBase,
148 mlir::Value substringLen, mlir::Value back) {
149 mlir::func::FuncOp indexFunc;
150 switch (kind) {
151 case 1:
152 indexFunc = fir::runtime::getRuntimeFunc<mkRTKey(Index1)>(loc, builder);
153 break;
154 case 2:
155 indexFunc = fir::runtime::getRuntimeFunc<mkRTKey(Index2)>(loc, builder);
156 break;
157 case 4:
158 indexFunc = fir::runtime::getRuntimeFunc<mkRTKey(Index4)>(loc, builder);
159 break;
160 default:
161 fir::emitFatalError(
162 loc, "unsupported CHARACTER kind value. Runtime expects 1, 2, or 4.");
163 }
164 auto fTy = indexFunc.getFunctionType();
165 auto args =
166 fir::runtime::createArguments(builder, loc, fTy, stringBase, stringLen,
167 substringBase, substringLen, back);
168 return builder.create<fir::CallOp>(loc, indexFunc, args).getResult(0);
169 }
170
genIndexDescriptor(fir::FirOpBuilder & builder,mlir::Location loc,mlir::Value resultBox,mlir::Value stringBox,mlir::Value substringBox,mlir::Value backOpt,mlir::Value kind)171 void fir::runtime::genIndexDescriptor(fir::FirOpBuilder &builder,
172 mlir::Location loc, mlir::Value resultBox,
173 mlir::Value stringBox,
174 mlir::Value substringBox,
175 mlir::Value backOpt, mlir::Value kind) {
176 auto indexFunc = fir::runtime::getRuntimeFunc<mkRTKey(Index)>(loc, builder);
177 genCharacterSearch(indexFunc, builder, loc, resultBox, stringBox,
178 substringBox, backOpt, kind);
179 }
180
genRepeat(fir::FirOpBuilder & builder,mlir::Location loc,mlir::Value resultBox,mlir::Value stringBox,mlir::Value ncopies)181 void fir::runtime::genRepeat(fir::FirOpBuilder &builder, mlir::Location loc,
182 mlir::Value resultBox, mlir::Value stringBox,
183 mlir::Value ncopies) {
184 auto repeatFunc = fir::runtime::getRuntimeFunc<mkRTKey(Repeat)>(loc, builder);
185 auto fTy = repeatFunc.getFunctionType();
186 auto sourceFile = fir::factory::locationToFilename(builder, loc);
187 auto sourceLine =
188 fir::factory::locationToLineNo(builder, loc, fTy.getInput(4));
189
190 auto args = fir::runtime::createArguments(
191 builder, loc, fTy, resultBox, stringBox, ncopies, sourceFile, sourceLine);
192 builder.create<fir::CallOp>(loc, repeatFunc, args);
193 }
194
genTrim(fir::FirOpBuilder & builder,mlir::Location loc,mlir::Value resultBox,mlir::Value stringBox)195 void fir::runtime::genTrim(fir::FirOpBuilder &builder, mlir::Location loc,
196 mlir::Value resultBox, mlir::Value stringBox) {
197 auto trimFunc = fir::runtime::getRuntimeFunc<mkRTKey(Trim)>(loc, builder);
198 auto fTy = trimFunc.getFunctionType();
199 auto sourceFile = fir::factory::locationToFilename(builder, loc);
200 auto sourceLine =
201 fir::factory::locationToLineNo(builder, loc, fTy.getInput(3));
202
203 auto args = fir::runtime::createArguments(builder, loc, fTy, resultBox,
204 stringBox, sourceFile, sourceLine);
205 builder.create<fir::CallOp>(loc, trimFunc, args);
206 }
207
genScanDescriptor(fir::FirOpBuilder & builder,mlir::Location loc,mlir::Value resultBox,mlir::Value stringBox,mlir::Value setBox,mlir::Value backBox,mlir::Value kind)208 void fir::runtime::genScanDescriptor(fir::FirOpBuilder &builder,
209 mlir::Location loc, mlir::Value resultBox,
210 mlir::Value stringBox, mlir::Value setBox,
211 mlir::Value backBox, mlir::Value kind) {
212 auto func = fir::runtime::getRuntimeFunc<mkRTKey(Scan)>(loc, builder);
213 genCharacterSearch(func, builder, loc, resultBox, stringBox, setBox, backBox,
214 kind);
215 }
216
genScan(fir::FirOpBuilder & builder,mlir::Location loc,int kind,mlir::Value stringBase,mlir::Value stringLen,mlir::Value setBase,mlir::Value setLen,mlir::Value back)217 mlir::Value fir::runtime::genScan(fir::FirOpBuilder &builder,
218 mlir::Location loc, int kind,
219 mlir::Value stringBase, mlir::Value stringLen,
220 mlir::Value setBase, mlir::Value setLen,
221 mlir::Value back) {
222 mlir::func::FuncOp func;
223 switch (kind) {
224 case 1:
225 func = fir::runtime::getRuntimeFunc<mkRTKey(Scan1)>(loc, builder);
226 break;
227 case 2:
228 func = fir::runtime::getRuntimeFunc<mkRTKey(Scan2)>(loc, builder);
229 break;
230 case 4:
231 func = fir::runtime::getRuntimeFunc<mkRTKey(Scan4)>(loc, builder);
232 break;
233 default:
234 fir::emitFatalError(
235 loc, "unsupported CHARACTER kind value. Runtime expects 1, 2, or 4.");
236 }
237 auto fTy = func.getFunctionType();
238 auto args = fir::runtime::createArguments(builder, loc, fTy, stringBase,
239 stringLen, setBase, setLen, back);
240 return builder.create<fir::CallOp>(loc, func, args).getResult(0);
241 }
242
genVerifyDescriptor(fir::FirOpBuilder & builder,mlir::Location loc,mlir::Value resultBox,mlir::Value stringBox,mlir::Value setBox,mlir::Value backBox,mlir::Value kind)243 void fir::runtime::genVerifyDescriptor(fir::FirOpBuilder &builder,
244 mlir::Location loc,
245 mlir::Value resultBox,
246 mlir::Value stringBox,
247 mlir::Value setBox, mlir::Value backBox,
248 mlir::Value kind) {
249 auto func = fir::runtime::getRuntimeFunc<mkRTKey(Verify)>(loc, builder);
250 genCharacterSearch(func, builder, loc, resultBox, stringBox, setBox, backBox,
251 kind);
252 }
253
genVerify(fir::FirOpBuilder & builder,mlir::Location loc,int kind,mlir::Value stringBase,mlir::Value stringLen,mlir::Value setBase,mlir::Value setLen,mlir::Value back)254 mlir::Value fir::runtime::genVerify(fir::FirOpBuilder &builder,
255 mlir::Location loc, int kind,
256 mlir::Value stringBase,
257 mlir::Value stringLen, mlir::Value setBase,
258 mlir::Value setLen, mlir::Value back) {
259 mlir::func::FuncOp func;
260 switch (kind) {
261 case 1:
262 func = fir::runtime::getRuntimeFunc<mkRTKey(Verify1)>(loc, builder);
263 break;
264 case 2:
265 func = fir::runtime::getRuntimeFunc<mkRTKey(Verify2)>(loc, builder);
266 break;
267 case 4:
268 func = fir::runtime::getRuntimeFunc<mkRTKey(Verify4)>(loc, builder);
269 break;
270 default:
271 fir::emitFatalError(
272 loc, "unsupported CHARACTER kind value. Runtime expects 1, 2, or 4.");
273 }
274 auto fTy = func.getFunctionType();
275 auto args = fir::runtime::createArguments(builder, loc, fTy, stringBase,
276 stringLen, setBase, setLen, back);
277 return builder.create<fir::CallOp>(loc, func, args).getResult(0);
278 }
279