1 //===-- CharacterRuntime.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/Lower/CharacterRuntime.h"
10 #include "../../runtime/character.h"
11 #include "RTBuilder.h"
12 #include "flang/Lower/Bridge.h"
13 #include "flang/Lower/CharacterExpr.h"
14 #include "flang/Lower/FIRBuilder.h"
15 #include "mlir/Dialect/StandardOps/IR/Ops.h"
16
17 using namespace Fortran::runtime;
18
19 #define NAMIFY_HELPER(X) #X
20 #define NAMIFY(X) NAMIFY_HELPER(IONAME(X))
21 #define mkRTKey(X) mkKey(RTNAME(X))
22
23 namespace Fortran::lower {
24 /// Static table of CHARACTER runtime calls
25 ///
26 /// This logical map contains the name and type builder function for each
27 /// runtime function listed in the tuple. This table is fully constructed at
28 /// compile-time. Use the `mkRTKey` macro to access the table.
29 static constexpr std::tuple<
30 mkRTKey(CharacterCompareScalar), mkRTKey(CharacterCompareScalar1),
31 mkRTKey(CharacterCompareScalar2), mkRTKey(CharacterCompareScalar4),
32 mkRTKey(CharacterCompare)>
33 newCharRTTable;
34 } // namespace Fortran::lower
35
36 using namespace Fortran::lower;
37
38 /// Helper function to retrieve the name of the IO function given the key `A`
39 template <typename A>
getName()40 static constexpr const char *getName() {
41 return std::get<A>(newCharRTTable).name;
42 }
43
44 /// Helper function to retrieve the type model signature builder of the IO
45 /// function as defined by the key `A`
46 template <typename A>
getTypeModel()47 static constexpr FuncTypeBuilderFunc getTypeModel() {
48 return std::get<A>(newCharRTTable).getTypeModel();
49 }
50
getLength(mlir::Type argTy)51 inline int64_t getLength(mlir::Type argTy) {
52 return argTy.cast<fir::SequenceType>().getShape()[0];
53 }
54
55 /// Get (or generate) the MLIR FuncOp for a given runtime function.
56 template <typename E>
getRuntimeFunc(mlir::Location loc,Fortran::lower::FirOpBuilder & builder)57 static mlir::FuncOp getRuntimeFunc(mlir::Location loc,
58 Fortran::lower::FirOpBuilder &builder) {
59 auto name = getName<E>();
60 auto func = builder.getNamedFunction(name);
61 if (func)
62 return func;
63 auto funTy = getTypeModel<E>()(builder.getContext());
64 func = builder.createFunction(loc, name, funTy);
65 func->setAttr("fir.runtime", builder.getUnitAttr());
66 return func;
67 }
68
69 /// Helper function to recover the KIND from the FIR type.
discoverKind(mlir::Type ty)70 static int discoverKind(mlir::Type ty) {
71 if (auto charTy = ty.dyn_cast<fir::CharacterType>())
72 return charTy.getFKind();
73 if (auto eleTy = fir::dyn_cast_ptrEleTy(ty))
74 return discoverKind(eleTy);
75 if (auto arrTy = ty.dyn_cast<fir::SequenceType>())
76 return discoverKind(arrTy.getEleTy());
77 if (auto boxTy = ty.dyn_cast<fir::BoxCharType>())
78 return discoverKind(boxTy.getEleTy());
79 if (auto boxTy = ty.dyn_cast<fir::BoxType>())
80 return discoverKind(boxTy.getEleTy());
81 llvm_unreachable("unexpected character type");
82 }
83
84 //===----------------------------------------------------------------------===//
85 // Lower character operations
86 //===----------------------------------------------------------------------===//
87
88 mlir::Value
genRawCharCompare(Fortran::lower::AbstractConverter & converter,mlir::Location loc,mlir::CmpIPredicate cmp,mlir::Value lhsBuff,mlir::Value lhsLen,mlir::Value rhsBuff,mlir::Value rhsLen)89 Fortran::lower::genRawCharCompare(Fortran::lower::AbstractConverter &converter,
90 mlir::Location loc, mlir::CmpIPredicate cmp,
91 mlir::Value lhsBuff, mlir::Value lhsLen,
92 mlir::Value rhsBuff, mlir::Value rhsLen) {
93 auto &builder = converter.getFirOpBuilder();
94 mlir::FuncOp beginFunc;
95 switch (discoverKind(lhsBuff.getType())) {
96 case 1:
97 beginFunc = getRuntimeFunc<mkRTKey(CharacterCompareScalar1)>(loc, builder);
98 break;
99 case 2:
100 beginFunc = getRuntimeFunc<mkRTKey(CharacterCompareScalar2)>(loc, builder);
101 break;
102 case 4:
103 beginFunc = getRuntimeFunc<mkRTKey(CharacterCompareScalar4)>(loc, builder);
104 break;
105 default:
106 llvm_unreachable("runtime does not support CHARACTER KIND");
107 }
108 auto fTy = beginFunc.getType();
109 auto lptr = builder.createConvert(loc, fTy.getInput(0), lhsBuff);
110 auto llen = builder.createConvert(loc, fTy.getInput(2), lhsLen);
111 auto rptr = builder.createConvert(loc, fTy.getInput(1), rhsBuff);
112 auto rlen = builder.createConvert(loc, fTy.getInput(3), rhsLen);
113 llvm::SmallVector<mlir::Value, 4> args = {lptr, rptr, llen, rlen};
114 auto tri = builder.create<mlir::CallOp>(loc, beginFunc, args).getResult(0);
115 auto zero = builder.createIntegerConstant(loc, tri.getType(), 0);
116 return builder.create<mlir::CmpIOp>(loc, cmp, tri, zero);
117 }
118
119 mlir::Value
genBoxCharCompare(Fortran::lower::AbstractConverter & converter,mlir::Location loc,mlir::CmpIPredicate cmp,mlir::Value lhs,mlir::Value rhs)120 Fortran::lower::genBoxCharCompare(Fortran::lower::AbstractConverter &converter,
121 mlir::Location loc, mlir::CmpIPredicate cmp,
122 mlir::Value lhs, mlir::Value rhs) {
123 auto &builder = converter.getFirOpBuilder();
124 Fortran::lower::CharacterExprHelper helper{builder, loc};
125 auto lhsPair = helper.materializeCharacter(lhs);
126 auto rhsPair = helper.materializeCharacter(rhs);
127 return genRawCharCompare(converter, loc, cmp, lhsPair.first, lhsPair.second,
128 rhsPair.first, rhsPair.second);
129 }
130