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
18using 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).
23template <typename FN>
24static 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.
41static 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.
65static 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
78void 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
85void 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
92mlir::Value
93fir::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
122mlir::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
143mlir::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
171void 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
181void 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
195void 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
208void 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
217mlir::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
243void 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
254mlir::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

source code of flang/lib/Optimizer/Builder/Runtime/Character.cpp