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>
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.
41 static int discoverKind(mlir::Type ty) {
42   if (auto charTy = ty.dyn_cast<fir::CharacterType>())
43     return charTy.getFKind();
44   if (auto eleTy = fir::dyn_cast_ptrEleTy(ty))
45     return discoverKind(eleTy);
46   if (auto arrTy = ty.dyn_cast<fir::SequenceType>())
47     return discoverKind(arrTy.getEleTy());
48   if (auto boxTy = ty.dyn_cast<fir::BoxCharType>())
49     return discoverKind(boxTy.getEleTy());
50   if (auto boxTy = ty.dyn_cast<fir::BoxType>())
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.
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 
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 
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
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 
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 
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 
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 
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 
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 
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 
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 
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 
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