300 lines · cpp
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-exception6//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, and21/// verify. These are the descriptor based implementations that take four22/// 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 fir::CallOp::create(builder, 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 operations57//===----------------------------------------------------------------------===//58 59/// Generate a call to the `ADJUST[L|R]` runtime.60///61/// \p resultBox must be an unallocated allocatable used for the temporary62/// result. \p StringBox must be a fir.box describing the adjustr string63/// argument. The \p adjustFunc should be a mlir::func::FuncOp for the64/// 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 fir::CallOp::create(builder, 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::Value93fir::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 int lhsKind = discoverKind(lhsBuff.getType());98 int rhsKind = discoverKind(rhsBuff.getType());99 if (lhsKind != rhsKind) {100 fir::emitFatalError(loc, "runtime does not support comparison of different "101 "CHARACTER kind values");102 }103 mlir::func::FuncOp func;104 switch (lhsKind) {105 case 1:106 func = fir::runtime::getRuntimeFunc<mkRTKey(CharacterCompareScalar1)>(107 loc, builder);108 break;109 case 2:110 func = fir::runtime::getRuntimeFunc<mkRTKey(CharacterCompareScalar2)>(111 loc, builder);112 break;113 case 4:114 func = fir::runtime::getRuntimeFunc<mkRTKey(CharacterCompareScalar4)>(115 loc, builder);116 break;117 default:118 fir::emitFatalError(119 loc, "unsupported CHARACTER kind value. Runtime expects 1, 2, or 4.");120 }121 auto fTy = func.getFunctionType();122 auto args = fir::runtime::createArguments(builder, loc, fTy, lhsBuff, rhsBuff,123 lhsLen, rhsLen);124 auto tri = fir::CallOp::create(builder, loc, func, args).getResult(0);125 auto zero = builder.createIntegerConstant(loc, tri.getType(), 0);126 return mlir::arith::CmpIOp::create(builder, loc, cmp, tri, zero);127}128 129static mlir::Value allocateIfNotInMemory(fir::FirOpBuilder &builder,130 mlir::Location loc, mlir::Value base) {131 if (fir::isa_ref_type(base.getType()))132 return base;133 auto mem =134 fir::AllocaOp::create(builder, loc, base.getType(), /*pinned=*/false);135 fir::StoreOp::create(builder, loc, base, mem);136 return mem;137}138 139mlir::Value fir::runtime::genCharCompare(fir::FirOpBuilder &builder,140 mlir::Location loc,141 mlir::arith::CmpIPredicate cmp,142 const fir::ExtendedValue &lhs,143 const fir::ExtendedValue &rhs) {144 auto lhsBuffer = allocateIfNotInMemory(builder, loc, fir::getBase(lhs));145 auto rhsBuffer = allocateIfNotInMemory(builder, loc, fir::getBase(rhs));146 return genCharCompare(builder, loc, cmp, lhsBuffer, fir::getLen(lhs),147 rhsBuffer, fir::getLen(rhs));148}149 150mlir::Value fir::runtime::genIndex(fir::FirOpBuilder &builder,151 mlir::Location loc, int kind,152 mlir::Value stringBase,153 mlir::Value stringLen,154 mlir::Value substringBase,155 mlir::Value substringLen, mlir::Value back) {156 mlir::func::FuncOp indexFunc;157 switch (kind) {158 case 1:159 indexFunc = fir::runtime::getRuntimeFunc<mkRTKey(Index1)>(loc, builder);160 break;161 case 2:162 indexFunc = fir::runtime::getRuntimeFunc<mkRTKey(Index2)>(loc, builder);163 break;164 case 4:165 indexFunc = fir::runtime::getRuntimeFunc<mkRTKey(Index4)>(loc, builder);166 break;167 default:168 fir::emitFatalError(169 loc, "unsupported CHARACTER kind value. Runtime expects 1, 2, or 4.");170 }171 auto fTy = indexFunc.getFunctionType();172 auto args =173 fir::runtime::createArguments(builder, loc, fTy, stringBase, stringLen,174 substringBase, substringLen, back);175 return fir::CallOp::create(builder, loc, indexFunc, args).getResult(0);176}177 178mlir::Value fir::runtime::genIndex(fir::FirOpBuilder &builder,179 mlir::Location loc,180 const fir::ExtendedValue &str,181 const fir::ExtendedValue &substr,182 mlir::Value back) {183 assert(!substr.getBoxOf<fir::BoxValue>() && !str.getBoxOf<fir::BoxValue>() &&184 "shall use genIndexDescriptor version");185 auto strBuffer = allocateIfNotInMemory(builder, loc, fir::getBase(str));186 auto substrBuffer = allocateIfNotInMemory(builder, loc, fir::getBase(substr));187 int kind = discoverKind(strBuffer.getType());188 return genIndex(builder, loc, kind, strBuffer, fir::getLen(str), substrBuffer,189 fir::getLen(substr), back);190}191 192void fir::runtime::genIndexDescriptor(fir::FirOpBuilder &builder,193 mlir::Location loc, mlir::Value resultBox,194 mlir::Value stringBox,195 mlir::Value substringBox,196 mlir::Value backOpt, mlir::Value kind) {197 auto indexFunc = fir::runtime::getRuntimeFunc<mkRTKey(Index)>(loc, builder);198 genCharacterSearch(indexFunc, builder, loc, resultBox, stringBox,199 substringBox, backOpt, kind);200}201 202void fir::runtime::genRepeat(fir::FirOpBuilder &builder, mlir::Location loc,203 mlir::Value resultBox, mlir::Value stringBox,204 mlir::Value ncopies) {205 auto repeatFunc = fir::runtime::getRuntimeFunc<mkRTKey(Repeat)>(loc, builder);206 auto fTy = repeatFunc.getFunctionType();207 auto sourceFile = fir::factory::locationToFilename(builder, loc);208 auto sourceLine =209 fir::factory::locationToLineNo(builder, loc, fTy.getInput(4));210 211 auto args = fir::runtime::createArguments(212 builder, loc, fTy, resultBox, stringBox, ncopies, sourceFile, sourceLine);213 fir::CallOp::create(builder, loc, repeatFunc, args);214}215 216void fir::runtime::genTrim(fir::FirOpBuilder &builder, mlir::Location loc,217 mlir::Value resultBox, mlir::Value stringBox) {218 auto trimFunc = fir::runtime::getRuntimeFunc<mkRTKey(Trim)>(loc, builder);219 auto fTy = trimFunc.getFunctionType();220 auto sourceFile = fir::factory::locationToFilename(builder, loc);221 auto sourceLine =222 fir::factory::locationToLineNo(builder, loc, fTy.getInput(3));223 224 auto args = fir::runtime::createArguments(builder, loc, fTy, resultBox,225 stringBox, sourceFile, sourceLine);226 fir::CallOp::create(builder, loc, trimFunc, args);227}228 229void fir::runtime::genScanDescriptor(fir::FirOpBuilder &builder,230 mlir::Location loc, mlir::Value resultBox,231 mlir::Value stringBox, mlir::Value setBox,232 mlir::Value backBox, mlir::Value kind) {233 auto func = fir::runtime::getRuntimeFunc<mkRTKey(Scan)>(loc, builder);234 genCharacterSearch(func, builder, loc, resultBox, stringBox, setBox, backBox,235 kind);236}237 238mlir::Value fir::runtime::genScan(fir::FirOpBuilder &builder,239 mlir::Location loc, int kind,240 mlir::Value stringBase, mlir::Value stringLen,241 mlir::Value setBase, mlir::Value setLen,242 mlir::Value back) {243 mlir::func::FuncOp func;244 switch (kind) {245 case 1:246 func = fir::runtime::getRuntimeFunc<mkRTKey(Scan1)>(loc, builder);247 break;248 case 2:249 func = fir::runtime::getRuntimeFunc<mkRTKey(Scan2)>(loc, builder);250 break;251 case 4:252 func = fir::runtime::getRuntimeFunc<mkRTKey(Scan4)>(loc, builder);253 break;254 default:255 fir::emitFatalError(256 loc, "unsupported CHARACTER kind value. Runtime expects 1, 2, or 4.");257 }258 auto fTy = func.getFunctionType();259 auto args = fir::runtime::createArguments(builder, loc, fTy, stringBase,260 stringLen, setBase, setLen, back);261 return fir::CallOp::create(builder, loc, func, args).getResult(0);262}263 264void fir::runtime::genVerifyDescriptor(fir::FirOpBuilder &builder,265 mlir::Location loc,266 mlir::Value resultBox,267 mlir::Value stringBox,268 mlir::Value setBox, mlir::Value backBox,269 mlir::Value kind) {270 auto func = fir::runtime::getRuntimeFunc<mkRTKey(Verify)>(loc, builder);271 genCharacterSearch(func, builder, loc, resultBox, stringBox, setBox, backBox,272 kind);273}274 275mlir::Value fir::runtime::genVerify(fir::FirOpBuilder &builder,276 mlir::Location loc, int kind,277 mlir::Value stringBase,278 mlir::Value stringLen, mlir::Value setBase,279 mlir::Value setLen, mlir::Value back) {280 mlir::func::FuncOp func;281 switch (kind) {282 case 1:283 func = fir::runtime::getRuntimeFunc<mkRTKey(Verify1)>(loc, builder);284 break;285 case 2:286 func = fir::runtime::getRuntimeFunc<mkRTKey(Verify2)>(loc, builder);287 break;288 case 4:289 func = fir::runtime::getRuntimeFunc<mkRTKey(Verify4)>(loc, builder);290 break;291 default:292 fir::emitFatalError(293 loc, "unsupported CHARACTER kind value. Runtime expects 1, 2, or 4.");294 }295 auto fTy = func.getFunctionType();296 auto args = fir::runtime::createArguments(builder, loc, fTy, stringBase,297 stringLen, setBase, setLen, back);298 return fir::CallOp::create(builder, loc, func, args).getResult(0);299}300