900 lines · cpp
1//===-- Character.cpp -----------------------------------------------------===//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// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/10//11//===----------------------------------------------------------------------===//12 13#include "flang/Optimizer/Builder/Character.h"14#include "flang/Optimizer/Builder/DoLoopHelper.h"15#include "flang/Optimizer/Builder/FIRBuilder.h"16#include "flang/Optimizer/Builder/Todo.h"17#include "flang/Optimizer/Dialect/FIROpsSupport.h"18#include "mlir/Dialect/LLVMIR/LLVMDialect.h"19#include "llvm/Support/Debug.h"20#include <optional>21 22#define DEBUG_TYPE "flang-lower-character"23 24//===----------------------------------------------------------------------===//25// CharacterExprHelper implementation26//===----------------------------------------------------------------------===//27 28/// Unwrap all the ref and box types and return the inner element type.29static mlir::Type unwrapBoxAndRef(mlir::Type type) {30 if (auto boxType = mlir::dyn_cast<fir::BoxCharType>(type))31 return boxType.getEleTy();32 while (true) {33 type = fir::unwrapRefType(type);34 if (auto boxTy = mlir::dyn_cast<fir::BoxType>(type))35 type = boxTy.getEleTy();36 else37 break;38 }39 return type;40}41 42/// Unwrap base fir.char<kind,len> type.43static fir::CharacterType recoverCharacterType(mlir::Type type) {44 type = fir::unwrapSequenceType(unwrapBoxAndRef(type));45 if (auto charTy = mlir::dyn_cast<fir::CharacterType>(type))46 return charTy;47 llvm::report_fatal_error("expected a character type");48}49 50bool fir::factory::CharacterExprHelper::isCharacterScalar(mlir::Type type) {51 type = unwrapBoxAndRef(type);52 return !mlir::isa<fir::SequenceType>(type) && fir::isa_char(type);53}54 55bool fir::factory::CharacterExprHelper::isArray(mlir::Type type) {56 type = unwrapBoxAndRef(type);57 if (auto seqTy = mlir::dyn_cast<fir::SequenceType>(type))58 return fir::isa_char(seqTy.getEleTy());59 return false;60}61 62fir::CharacterType63fir::factory::CharacterExprHelper::getCharacterType(mlir::Type type) {64 assert(isCharacterScalar(type) && "expected scalar character");65 return recoverCharacterType(type);66}67 68fir::CharacterType69fir::factory::CharacterExprHelper::getCharType(mlir::Type type) {70 return recoverCharacterType(type);71}72 73fir::CharacterType fir::factory::CharacterExprHelper::getCharacterType(74 const fir::CharBoxValue &box) {75 return getCharacterType(box.getBuffer().getType());76}77 78fir::CharacterType79fir::factory::CharacterExprHelper::getCharacterType(mlir::Value str) {80 return getCharacterType(str.getType());81}82 83/// Determine the static size of the character. Returns the computed size, not84/// an IR Value.85static std::optional<fir::CharacterType::LenType>86getCompileTimeLength(const fir::CharBoxValue &box) {87 auto len = recoverCharacterType(box.getBuffer().getType()).getLen();88 if (len == fir::CharacterType::unknownLen())89 return {};90 return len;91}92 93/// Detect the precondition that the value `str` does not reside in memory. Such94/// values will have a type `!fir.array<...x!fir.char<N>>` or `!fir.char<N>`.95[[maybe_unused]] static bool needToMaterialize(mlir::Value str) {96 return mlir::isa<fir::SequenceType>(str.getType()) ||97 fir::isa_char(str.getType());98}99 100/// This is called only if `str` does not reside in memory. Such a bare string101/// value will be converted into a memory-based temporary and an extended102/// boxchar value returned.103fir::CharBoxValue104fir::factory::CharacterExprHelper::materializeValue(mlir::Value str) {105 assert(needToMaterialize(str));106 auto ty = str.getType();107 assert(isCharacterScalar(ty) && "expected scalar character");108 auto charTy = mlir::dyn_cast<fir::CharacterType>(ty);109 if (!charTy || charTy.getLen() == fir::CharacterType::unknownLen()) {110 LLVM_DEBUG(llvm::dbgs() << "cannot materialize: " << str << '\n');111 llvm_unreachable("must be a !fir.char<N> type");112 }113 auto len = builder.createIntegerConstant(114 loc, builder.getCharacterLengthType(), charTy.getLen());115 auto temp = fir::AllocaOp::create(builder, loc, charTy);116 fir::StoreOp::create(builder, loc, str, temp);117 LLVM_DEBUG(llvm::dbgs() << "materialized as local: " << str << " -> (" << temp118 << ", " << len << ")\n");119 return {temp, len};120}121 122fir::ExtendedValue123fir::factory::CharacterExprHelper::toExtendedValue(mlir::Value character,124 mlir::Value len) {125 auto lenType = builder.getCharacterLengthType();126 auto type = character.getType();127 auto base = fir::isa_passbyref_type(type) ? character : mlir::Value{};128 auto resultLen = len;129 llvm::SmallVector<mlir::Value> extents;130 131 if (auto eleType = fir::dyn_cast_ptrEleTy(type))132 type = eleType;133 134 if (auto arrayType = mlir::dyn_cast<fir::SequenceType>(type)) {135 type = arrayType.getEleTy();136 auto indexType = builder.getIndexType();137 for (auto extent : arrayType.getShape()) {138 if (extent == fir::SequenceType::getUnknownExtent())139 break;140 extents.emplace_back(141 builder.createIntegerConstant(loc, indexType, extent));142 }143 // Last extent might be missing in case of assumed-size. If more extents144 // could not be deduced from type, that's an error (a fir.box should145 // have been used in the interface).146 if (extents.size() + 1 < arrayType.getShape().size())147 mlir::emitError(loc, "cannot retrieve array extents from type");148 }149 150 if (auto charTy = mlir::dyn_cast<fir::CharacterType>(type)) {151 if (!resultLen && charTy.getLen() != fir::CharacterType::unknownLen())152 resultLen = builder.createIntegerConstant(loc, lenType, charTy.getLen());153 } else if (auto boxCharType = mlir::dyn_cast<fir::BoxCharType>(type)) {154 auto refType = builder.getRefType(boxCharType.getEleTy());155 // If the embox is accessible, use its operand to avoid filling156 // the generated fir with embox/unbox.157 mlir::Value boxCharLen;158 if (auto definingOp = character.getDefiningOp()) {159 if (auto box = mlir::dyn_cast<fir::EmboxCharOp>(definingOp)) {160 base = box.getMemref();161 boxCharLen = box.getLen();162 }163 }164 if (!boxCharLen) {165 auto unboxed =166 fir::UnboxCharOp::create(builder, loc, refType, lenType, character);167 base = builder.createConvert(loc, refType, unboxed.getResult(0));168 boxCharLen = unboxed.getResult(1);169 }170 if (!resultLen) {171 resultLen = boxCharLen;172 }173 } else if (mlir::isa<fir::BoxType>(type)) {174 mlir::emitError(loc, "descriptor or derived type not yet handled");175 } else {176 llvm_unreachable("Cannot translate mlir::Value to character ExtendedValue");177 }178 179 if (!base) {180 if (auto load =181 mlir::dyn_cast_or_null<fir::LoadOp>(character.getDefiningOp())) {182 base = load.getOperand();183 } else {184 return materializeValue(fir::getBase(character));185 }186 }187 if (!resultLen)188 llvm::report_fatal_error("no dynamic length found for character");189 if (!extents.empty())190 return fir::CharArrayBoxValue{base, resultLen, extents};191 return fir::CharBoxValue{base, resultLen};192}193 194static mlir::Type getSingletonCharType(mlir::MLIRContext *ctxt, int kind) {195 return fir::CharacterType::getSingleton(ctxt, kind);196}197 198mlir::Value199fir::factory::CharacterExprHelper::createEmbox(const fir::CharBoxValue &box) {200 // Base CharBoxValue of CharArrayBoxValue are ok here (do not require a scalar201 // type)202 auto charTy = recoverCharacterType(box.getBuffer().getType());203 auto boxCharType =204 fir::BoxCharType::get(builder.getContext(), charTy.getFKind());205 auto refType = fir::ReferenceType::get(boxCharType.getEleTy());206 mlir::Value buff = box.getBuffer();207 // fir.boxchar requires a memory reference. Allocate temp if the character is208 // not in memory.209 if (!fir::isa_ref_type(buff.getType())) {210 auto temp = builder.createTemporary(loc, buff.getType());211 fir::StoreOp::create(builder, loc, buff, temp);212 buff = temp;213 }214 // fir.emboxchar only accepts scalar, cast array buffer to a scalar buffer.215 if (mlir::isa<fir::SequenceType>(fir::dyn_cast_ptrEleTy(buff.getType())))216 buff = builder.createConvert(loc, refType, buff);217 // Convert in case the provided length is not of the integer type that must218 // be used in boxchar.219 auto len = builder.createConvert(loc, builder.getCharacterLengthType(),220 box.getLen());221 return fir::EmboxCharOp::create(builder, loc, boxCharType, buff, len);222}223 224fir::CharBoxValue fir::factory::CharacterExprHelper::toScalarCharacter(225 const fir::CharArrayBoxValue &box) {226 if (mlir::isa<fir::PointerType>(box.getBuffer().getType()))227 TODO(loc, "concatenating non contiguous character array into a scalar");228 229 // TODO: add a fast path multiplying new length at compile time if the info is230 // in the array type.231 auto lenType = builder.getCharacterLengthType();232 auto len = builder.createConvert(loc, lenType, box.getLen());233 for (auto extent : box.getExtents())234 len = mlir::arith::MulIOp::create(235 builder, loc, len, builder.createConvert(loc, lenType, extent));236 237 // TODO: typeLen can be improved in compiled constant cases238 // TODO: allow bare fir.array<> (no ref) conversion here ?239 auto typeLen = fir::CharacterType::unknownLen();240 auto kind = recoverCharacterType(box.getBuffer().getType()).getFKind();241 auto charTy = fir::CharacterType::get(builder.getContext(), kind, typeLen);242 auto type = fir::ReferenceType::get(charTy);243 auto buffer = builder.createConvert(loc, type, box.getBuffer());244 return {buffer, len};245}246 247mlir::Value fir::factory::CharacterExprHelper::createEmbox(248 const fir::CharArrayBoxValue &box) {249 // Use same embox as for scalar. It's losing the actual data size information250 // (We do not multiply the length by the array size), but that is what Fortran251 // call interfaces using boxchar expect.252 return createEmbox(static_cast<const fir::CharBoxValue &>(box));253}254 255/// Get the address of the element at position \p index of the scalar character256/// \p buffer.257/// \p buffer must be of type !fir.ref<fir.char<k, len>>. The length may be258/// unknown. \p index must have any integer type, and is zero based. The return259/// value is a singleton address (!fir.ref<!fir.char<kind>>)260mlir::Value261fir::factory::CharacterExprHelper::createElementAddr(mlir::Value buffer,262 mlir::Value index) {263 // The only way to address an element of a fir.ref<char<kind, len>> is to cast264 // it to a fir.array<len x fir.char<kind>> and use fir.coordinate_of.265 auto bufferType = buffer.getType();266 assert(fir::isa_ref_type(bufferType));267 assert(isCharacterScalar(bufferType));268 auto charTy = recoverCharacterType(bufferType);269 auto singleTy = getSingletonCharType(builder.getContext(), charTy.getFKind());270 auto singleRefTy = builder.getRefType(singleTy);271 auto extent = fir::SequenceType::getUnknownExtent();272 if (charTy.getLen() != fir::CharacterType::unknownLen())273 extent = charTy.getLen();274 const bool isVolatile = fir::isa_volatile_type(buffer.getType());275 auto sequenceType = fir::SequenceType::get({extent}, singleTy);276 auto coorTy = builder.getRefType(sequenceType, isVolatile);277 278 auto coor = builder.createConvert(loc, coorTy, buffer);279 auto i = builder.createConvert(loc, builder.getIndexType(), index);280 return fir::CoordinateOp::create(builder, loc, singleRefTy, coor, i);281}282 283/// Load a character out of `buff` from offset `index`.284/// `buff` must be a reference to memory.285mlir::Value286fir::factory::CharacterExprHelper::createLoadCharAt(mlir::Value buff,287 mlir::Value index) {288 LLVM_DEBUG(llvm::dbgs() << "load a char: " << buff << " type: "289 << buff.getType() << " at: " << index << '\n');290 return fir::LoadOp::create(builder, loc, createElementAddr(buff, index));291}292 293/// Store the singleton character `c` to `str` at offset `index`.294/// `str` must be a reference to memory.295void fir::factory::CharacterExprHelper::createStoreCharAt(mlir::Value str,296 mlir::Value index,297 mlir::Value c) {298 LLVM_DEBUG(llvm::dbgs() << "store the char: " << c << " into: " << str299 << " type: " << str.getType() << " at: " << index300 << '\n');301 auto addr = createElementAddr(str, index);302 fir::StoreOp::create(builder, loc, c, addr);303}304 305// FIXME: this temp is useless... either fir.coordinate_of needs to306// work on "loaded" characters (!fir.array<len x fir.char<kind>>) or307// character should never be loaded.308// If this is a fir.array<>, allocate and store the value so that309// fir.cooridnate_of can be use on the value.310mlir::Value fir::factory::CharacterExprHelper::getCharBoxBuffer(311 const fir::CharBoxValue &box) {312 auto buff = box.getBuffer();313 if (fir::isa_char(buff.getType())) {314 auto newBuff = fir::AllocaOp::create(builder, loc, buff.getType());315 fir::StoreOp::create(builder, loc, buff, newBuff);316 return newBuff;317 }318 return buff;319}320 321/// Create a loop to copy `count` characters from `src` to `dest`. Note that the322/// KIND indicates the number of bits in a code point. (ASCII, UCS-2, or UCS-4.)323void fir::factory::CharacterExprHelper::createCopy(324 const fir::CharBoxValue &dest, const fir::CharBoxValue &src,325 mlir::Value count) {326 auto fromBuff = getCharBoxBuffer(src);327 auto toBuff = getCharBoxBuffer(dest);328 LLVM_DEBUG(llvm::dbgs() << "create char copy from: "; src.dump();329 llvm::dbgs() << " to: "; dest.dump();330 llvm::dbgs() << " count: " << count << '\n');331 auto kind = getCharacterKind(src.getBuffer().getType());332 // If the src and dest are the same KIND, then use memmove to move the bits.333 // We don't have to worry about overlapping ranges with memmove.334 if (getCharacterKind(dest.getBuffer().getType()) == kind) {335 const bool isVolatile = fir::isa_volatile_type(fromBuff.getType()) ||336 fir::isa_volatile_type(toBuff.getType());337 auto bytes = builder.getKindMap().getCharacterBitsize(kind) / 8;338 auto i64Ty = builder.getI64Type();339 auto kindBytes = builder.createIntegerConstant(loc, i64Ty, bytes);340 auto castCount = builder.createConvert(loc, i64Ty, count);341 auto totalBytes =342 mlir::arith::MulIOp::create(builder, loc, kindBytes, castCount);343 auto llvmPointerType =344 mlir::LLVM::LLVMPointerType::get(builder.getContext());345 auto toPtr = builder.createConvert(loc, llvmPointerType, toBuff);346 auto fromPtr = builder.createConvert(loc, llvmPointerType, fromBuff);347 mlir::LLVM::MemmoveOp::create(builder, loc, toPtr, fromPtr, totalBytes,348 isVolatile);349 return;350 }351 352 // Convert a CHARACTER of one KIND into a CHARACTER of another KIND.353 fir::CharConvertOp::create(builder, loc, src.getBuffer(), count,354 dest.getBuffer());355}356 357void fir::factory::CharacterExprHelper::createPadding(358 const fir::CharBoxValue &str, mlir::Value lower, mlir::Value upper) {359 auto blank = createBlankConstant(getCharacterType(str));360 // Always create the loop, if upper < lower, no iteration will be361 // executed.362 auto toBuff = getCharBoxBuffer(str);363 fir::factory::DoLoopHelper{builder, loc}.createLoop(364 lower, upper, [&](fir::FirOpBuilder &, mlir::Value index) {365 createStoreCharAt(toBuff, index, blank);366 });367}368 369fir::CharBoxValue370fir::factory::CharacterExprHelper::createCharacterTemp(mlir::Type type,371 mlir::Value len) {372 auto kind = recoverCharacterType(type).getFKind();373 auto typeLen = fir::CharacterType::unknownLen();374 // If len is a constant, reflect the length in the type.375 if (auto cstLen = getIntIfConstant(len))376 typeLen = *cstLen;377 auto *ctxt = builder.getContext();378 auto charTy = fir::CharacterType::get(ctxt, kind, typeLen);379 llvm::SmallVector<mlir::Value> lenParams;380 if (typeLen == fir::CharacterType::unknownLen())381 lenParams.push_back(len);382 auto ref = builder.allocateLocal(loc, charTy, "", ".chrtmp",383 /*shape=*/{}, lenParams);384 return {ref, len};385}386 387fir::CharBoxValue fir::factory::CharacterExprHelper::createTempFrom(388 const fir::ExtendedValue &source) {389 const auto *charBox = source.getCharBox();390 if (!charBox)391 fir::emitFatalError(loc, "source must be a fir::CharBoxValue");392 auto len = charBox->getLen();393 auto sourceTy = charBox->getBuffer().getType();394 auto temp = createCharacterTemp(sourceTy, len);395 if (fir::isa_ref_type(sourceTy)) {396 createCopy(temp, *charBox, len);397 } else {398 auto ref = builder.createConvert(loc, builder.getRefType(sourceTy),399 temp.getBuffer());400 fir::StoreOp::create(builder, loc, charBox->getBuffer(), ref);401 }402 return temp;403}404 405// Simple length one character assignment without loops.406void fir::factory::CharacterExprHelper::createLengthOneAssign(407 const fir::CharBoxValue &lhs, const fir::CharBoxValue &rhs) {408 auto addr = lhs.getBuffer();409 auto toTy = fir::unwrapRefType(addr.getType());410 mlir::Value val = rhs.getBuffer();411 if (fir::isa_ref_type(val.getType())) {412 auto fromCharLen1RefTy = builder.getRefType(getSingletonCharType(413 builder.getContext(),414 getCharacterKind(fir::unwrapRefType(val.getType()))));415 val = fir::LoadOp::create(416 builder, loc, builder.createConvert(loc, fromCharLen1RefTy, val));417 }418 auto toCharLen1Ty =419 getSingletonCharType(builder.getContext(), getCharacterKind(toTy));420 val = builder.createConvert(loc, toCharLen1Ty, val);421 fir::StoreOp::create(422 builder, loc, val,423 builder.createConvert(loc, builder.getRefType(toCharLen1Ty), addr));424}425 426/// Returns the minimum of integer mlir::Value \p a and \b.427mlir::Value genMin(fir::FirOpBuilder &builder, mlir::Location loc,428 mlir::Value a, mlir::Value b) {429 auto cmp = mlir::arith::CmpIOp::create(builder, loc,430 mlir::arith::CmpIPredicate::slt, a, b);431 return mlir::arith::SelectOp::create(builder, loc, cmp, a, b);432}433 434void fir::factory::CharacterExprHelper::createAssign(435 const fir::CharBoxValue &lhs, const fir::CharBoxValue &rhs) {436 auto rhsCstLen = getCompileTimeLength(rhs);437 auto lhsCstLen = getCompileTimeLength(lhs);438 bool compileTimeSameLength = false;439 bool isLengthOneAssign = false;440 441 if (lhsCstLen && rhsCstLen && *lhsCstLen == *rhsCstLen) {442 compileTimeSameLength = true;443 if (*lhsCstLen == 1)444 isLengthOneAssign = true;445 } else if (rhs.getLen() == lhs.getLen()) {446 compileTimeSameLength = true;447 448 // If the length values are the same for LHS and RHS,449 // then we can rely on the constant length deduced from450 // any of the two types.451 if (lhsCstLen && *lhsCstLen == 1)452 isLengthOneAssign = true;453 if (rhsCstLen && *rhsCstLen == 1)454 isLengthOneAssign = true;455 456 // We could have recognized constant operations here (e.g.457 // two different arith.constant ops may produce the same value),458 // but for now leave it to CSE to get rid of the duplicates.459 }460 if (isLengthOneAssign) {461 createLengthOneAssign(lhs, rhs);462 return;463 }464 465 // Copy the minimum of the lhs and rhs lengths and pad the lhs remainder466 // if needed.467 auto copyCount = lhs.getLen();468 auto idxTy = builder.getIndexType();469 if (!compileTimeSameLength) {470 auto lhsLen = builder.createConvert(loc, idxTy, lhs.getLen());471 auto rhsLen = builder.createConvert(loc, idxTy, rhs.getLen());472 copyCount = genMin(builder, loc, lhsLen, rhsLen);473 }474 475 // Actual copy476 createCopy(lhs, rhs, copyCount);477 478 // Pad if needed.479 if (!compileTimeSameLength) {480 auto one = builder.createIntegerConstant(loc, lhs.getLen().getType(), 1);481 auto maxPadding =482 mlir::arith::SubIOp::create(builder, loc, lhs.getLen(), one);483 createPadding(lhs, copyCount, maxPadding);484 }485}486 487fir::CharBoxValue fir::factory::CharacterExprHelper::createConcatenate(488 const fir::CharBoxValue &lhs, const fir::CharBoxValue &rhs) {489 auto lhsLen = builder.createConvert(loc, builder.getCharacterLengthType(),490 lhs.getLen());491 auto rhsLen = builder.createConvert(loc, builder.getCharacterLengthType(),492 rhs.getLen());493 mlir::Value len = mlir::arith::AddIOp::create(builder, loc, lhsLen, rhsLen);494 auto temp = createCharacterTemp(getCharacterType(rhs), len);495 createCopy(temp, lhs, lhsLen);496 auto one = builder.createIntegerConstant(loc, len.getType(), 1);497 auto upperBound = mlir::arith::SubIOp::create(builder, loc, len, one);498 auto lhsLenIdx = builder.createConvert(loc, builder.getIndexType(), lhsLen);499 auto fromBuff = getCharBoxBuffer(rhs);500 auto toBuff = getCharBoxBuffer(temp);501 fir::factory::DoLoopHelper{builder, loc}.createLoop(502 lhsLenIdx, upperBound, one,503 [&](fir::FirOpBuilder &bldr, mlir::Value index) {504 auto rhsIndex =505 mlir::arith::SubIOp::create(bldr, loc, index, lhsLenIdx);506 auto charVal = createLoadCharAt(fromBuff, rhsIndex);507 createStoreCharAt(toBuff, index, charVal);508 });509 return temp;510}511 512mlir::Value fir::factory::CharacterExprHelper::genSubstringBase(513 mlir::Value stringRawAddr, mlir::Value lowerBound,514 mlir::Type substringAddrType, mlir::Value one) {515 if (!one)516 one = builder.createIntegerConstant(loc, lowerBound.getType(), 1);517 auto offset =518 mlir::arith::SubIOp::create(builder, loc, lowerBound, one).getResult();519 auto addr = createElementAddr(stringRawAddr, offset);520 return builder.createConvert(loc, substringAddrType, addr);521}522 523fir::CharBoxValue fir::factory::CharacterExprHelper::createSubstring(524 const fir::CharBoxValue &box, llvm::ArrayRef<mlir::Value> bounds) {525 // Constant need to be materialize in memory to use fir.coordinate_of.526 auto nbounds = bounds.size();527 if (nbounds < 1 || nbounds > 2) {528 mlir::emitError(loc, "Incorrect number of bounds in substring");529 return {mlir::Value{}, mlir::Value{}};530 }531 mlir::SmallVector<mlir::Value> castBounds;532 // Convert bounds to length type to do safe arithmetic on it.533 for (auto bound : bounds)534 castBounds.push_back(535 builder.createConvert(loc, builder.getCharacterLengthType(), bound));536 auto lowerBound = castBounds[0];537 // FIR CoordinateOp is zero based but Fortran substring are one based.538 auto kind = getCharacterKind(box.getBuffer().getType());539 auto charTy = fir::CharacterType::getUnknownLen(builder.getContext(), kind);540 auto resultType = builder.getRefType(charTy);541 auto one = builder.createIntegerConstant(loc, lowerBound.getType(), 1);542 auto substringRef =543 genSubstringBase(box.getBuffer(), lowerBound, resultType, one);544 545 // Compute the length.546 mlir::Value substringLen;547 if (nbounds < 2) {548 substringLen =549 mlir::arith::SubIOp::create(builder, loc, box.getLen(), castBounds[0]);550 } else {551 substringLen =552 mlir::arith::SubIOp::create(builder, loc, castBounds[1], castBounds[0]);553 }554 substringLen = mlir::arith::AddIOp::create(builder, loc, substringLen, one);555 556 // Set length to zero if bounds were reversed (Fortran 2018 9.4.1)557 auto zero = builder.createIntegerConstant(loc, substringLen.getType(), 0);558 auto cdt = mlir::arith::CmpIOp::create(559 builder, loc, mlir::arith::CmpIPredicate::slt, substringLen, zero);560 substringLen =561 mlir::arith::SelectOp::create(builder, loc, cdt, zero, substringLen);562 563 return {substringRef, substringLen};564}565 566mlir::Value567fir::factory::CharacterExprHelper::createLenTrim(const fir::CharBoxValue &str) {568 // Note: Runtime for LEN_TRIM should also be available at some569 // point. For now use an inlined implementation.570 auto indexType = builder.getIndexType();571 auto len = builder.createConvert(loc, indexType, str.getLen());572 auto one = builder.createIntegerConstant(loc, indexType, 1);573 auto minusOne = builder.createIntegerConstant(loc, indexType, -1);574 auto zero = builder.createIntegerConstant(loc, indexType, 0);575 auto trueVal = builder.createIntegerConstant(loc, builder.getI1Type(), 1);576 auto blank = createBlankConstantCode(getCharacterType(str));577 mlir::Value lastChar = mlir::arith::SubIOp::create(builder, loc, len, one);578 579 auto iterWhile =580 fir::IterWhileOp::create(builder, loc, lastChar, zero, minusOne, trueVal,581 /*returnFinalCount=*/false, lastChar);582 auto insPt = builder.saveInsertionPoint();583 builder.setInsertionPointToStart(iterWhile.getBody());584 auto index = iterWhile.getInductionVar();585 // Look for first non-blank from the right of the character.586 auto fromBuff = getCharBoxBuffer(str);587 auto elemAddr = createElementAddr(fromBuff, index);588 auto codeAddr =589 builder.createConvert(loc, builder.getRefType(blank.getType()), elemAddr);590 auto c = fir::LoadOp::create(builder, loc, codeAddr);591 auto isBlank = mlir::arith::CmpIOp::create(592 builder, loc, mlir::arith::CmpIPredicate::eq, blank, c);593 llvm::SmallVector<mlir::Value> results = {isBlank, index};594 fir::ResultOp::create(builder, loc, results);595 builder.restoreInsertionPoint(insPt);596 // Compute length after iteration (zero if all blanks)597 mlir::Value newLen =598 mlir::arith::AddIOp::create(builder, loc, iterWhile.getResult(1), one);599 auto result = mlir::arith::SelectOp::create(600 builder, loc, iterWhile.getResult(0), zero, newLen);601 return builder.createConvert(loc, builder.getCharacterLengthType(), result);602}603 604fir::CharBoxValue605fir::factory::CharacterExprHelper::createCharacterTemp(mlir::Type type,606 int len) {607 assert(len >= 0 && "expected positive length");608 auto kind = recoverCharacterType(type).getFKind();609 auto charType = fir::CharacterType::get(builder.getContext(), kind, len);610 auto addr = fir::AllocaOp::create(builder, loc, charType);611 auto mlirLen =612 builder.createIntegerConstant(loc, builder.getCharacterLengthType(), len);613 return {addr, mlirLen};614}615 616// Returns integer with code for blank. The integer has the same617// size as the character. Blank has ascii space code for all kinds.618mlir::Value fir::factory::CharacterExprHelper::createBlankConstantCode(619 fir::CharacterType type) {620 auto bits = builder.getKindMap().getCharacterBitsize(type.getFKind());621 auto intType = builder.getIntegerType(bits);622 return builder.createIntegerConstant(loc, intType, ' ');623}624 625mlir::Value fir::factory::CharacterExprHelper::createBlankConstant(626 fir::CharacterType type) {627 return createSingletonFromCode(createBlankConstantCode(type),628 type.getFKind());629}630 631void fir::factory::CharacterExprHelper::createAssign(632 const fir::ExtendedValue &lhs, const fir::ExtendedValue &rhs) {633 if (auto *str = rhs.getBoxOf<fir::CharBoxValue>()) {634 if (auto *to = lhs.getBoxOf<fir::CharBoxValue>()) {635 createAssign(*to, *str);636 return;637 }638 }639 TODO(loc, "character array assignment");640 // Note that it is not sure the array aspect should be handled641 // by this utility.642}643 644mlir::Value645fir::factory::CharacterExprHelper::createEmboxChar(mlir::Value addr,646 mlir::Value len) {647 return createEmbox(fir::CharBoxValue{addr, len});648}649 650std::pair<mlir::Value, mlir::Value>651fir::factory::CharacterExprHelper::createUnboxChar(mlir::Value boxChar) {652 using T = std::pair<mlir::Value, mlir::Value>;653 return toExtendedValue(boxChar).match(654 [](const fir::CharBoxValue &b) -> T {655 return {b.getBuffer(), b.getLen()};656 },657 [](const fir::CharArrayBoxValue &b) -> T {658 return {b.getBuffer(), b.getLen()};659 },660 [](const auto &) -> T { llvm::report_fatal_error("not a character"); });661}662 663bool fir::factory::CharacterExprHelper::isCharacterLiteral(mlir::Type type) {664 if (auto seqType = mlir::dyn_cast<fir::SequenceType>(type))665 return (seqType.getShape().size() == 1) &&666 fir::isa_char(seqType.getEleTy());667 return false;668}669 670fir::KindTy671fir::factory::CharacterExprHelper::getCharacterKind(mlir::Type type) {672 assert(isCharacterScalar(type) && "expected scalar character");673 return recoverCharacterType(type).getFKind();674}675 676fir::KindTy677fir::factory::CharacterExprHelper::getCharacterOrSequenceKind(mlir::Type type) {678 return recoverCharacterType(type).getFKind();679}680 681bool fir::factory::CharacterExprHelper::hasConstantLengthInType(682 const fir::ExtendedValue &exv) {683 auto charTy = recoverCharacterType(fir::getBase(exv).getType());684 return charTy.hasConstantLen();685}686 687mlir::Value688fir::factory::CharacterExprHelper::createSingletonFromCode(mlir::Value code,689 int kind) {690 auto charType = fir::CharacterType::get(builder.getContext(), kind, 1);691 auto bits = builder.getKindMap().getCharacterBitsize(kind);692 auto intType = builder.getIntegerType(bits);693 auto cast = builder.createConvert(loc, intType, code);694 auto undef = fir::UndefOp::create(builder, loc, charType);695 auto zero = builder.getIntegerAttr(builder.getIndexType(), 0);696 return fir::InsertValueOp::create(builder, loc, charType, undef, cast,697 builder.getArrayAttr(zero));698}699 700mlir::Value fir::factory::CharacterExprHelper::extractCodeFromSingleton(701 mlir::Value singleton) {702 auto type = getCharacterType(singleton);703 assert(type.getLen() == 1);704 auto bits = builder.getKindMap().getCharacterBitsize(type.getFKind());705 auto intType = builder.getIntegerType(bits);706 auto zero = builder.getIntegerAttr(builder.getIndexType(), 0);707 return fir::ExtractValueOp::create(builder, loc, intType, singleton,708 builder.getArrayAttr(zero));709}710 711mlir::Value712fir::factory::CharacterExprHelper::readLengthFromBox(mlir::Value box) {713 auto charTy = recoverCharacterType(box.getType());714 return readLengthFromBox(box, charTy);715}716 717mlir::Value fir::factory::CharacterExprHelper::readLengthFromBox(718 mlir::Value box, fir::CharacterType charTy) {719 auto lenTy = builder.getCharacterLengthType();720 auto size = fir::BoxEleSizeOp::create(builder, loc, lenTy, box);721 auto bits = builder.getKindMap().getCharacterBitsize(charTy.getFKind());722 auto width = bits / 8;723 if (width > 1) {724 auto widthVal = builder.createIntegerConstant(loc, lenTy, width);725 return mlir::arith::DivSIOp::create(builder, loc, size, widthVal);726 }727 return size;728}729 730mlir::Value fir::factory::CharacterExprHelper::getLength(mlir::Value memref) {731 auto memrefType = memref.getType();732 auto charType = recoverCharacterType(memrefType);733 assert(charType && "must be a character type");734 if (charType.hasConstantLen())735 return builder.createIntegerConstant(loc, builder.getCharacterLengthType(),736 charType.getLen());737 if (mlir::isa<fir::BoxType>(memrefType))738 return readLengthFromBox(memref);739 if (mlir::isa<fir::BoxCharType>(memrefType))740 return createUnboxChar(memref).second;741 742 // Length cannot be deduced from memref.743 return {};744}745 746std::pair<mlir::Value, mlir::Value>747fir::factory::extractCharacterProcedureTuple(fir::FirOpBuilder &builder,748 mlir::Location loc,749 mlir::Value tuple,750 bool openBoxProc) {751 mlir::TupleType tupleType = mlir::cast<mlir::TupleType>(tuple.getType());752 mlir::Value addr = fir::ExtractValueOp::create(753 builder, loc, tupleType.getType(0), tuple,754 builder.getArrayAttr(755 {builder.getIntegerAttr(builder.getIndexType(), 0)}));756 mlir::Value proc = [&]() -> mlir::Value {757 if (openBoxProc)758 if (auto addrTy = mlir::dyn_cast<fir::BoxProcType>(addr.getType()))759 return fir::BoxAddrOp::create(builder, loc, addrTy.getEleTy(), addr);760 return addr;761 }();762 mlir::Value len = fir::ExtractValueOp::create(763 builder, loc, tupleType.getType(1), tuple,764 builder.getArrayAttr(765 {builder.getIntegerAttr(builder.getIndexType(), 1)}));766 return {proc, len};767}768 769mlir::Value fir::factory::createCharacterProcedureTuple(770 fir::FirOpBuilder &builder, mlir::Location loc, mlir::Type argTy,771 mlir::Value addr, mlir::Value len) {772 mlir::TupleType tupleType = mlir::cast<mlir::TupleType>(argTy);773 addr = builder.createConvert(loc, tupleType.getType(0), addr);774 if (len)775 len = builder.createConvert(loc, tupleType.getType(1), len);776 else777 len = fir::UndefOp::create(builder, loc, tupleType.getType(1));778 mlir::Value tuple = fir::UndefOp::create(builder, loc, tupleType);779 tuple = fir::InsertValueOp::create(780 builder, loc, tupleType, tuple, addr,781 builder.getArrayAttr(782 {builder.getIntegerAttr(builder.getIndexType(), 0)}));783 tuple = fir::InsertValueOp::create(784 builder, loc, tupleType, tuple, len,785 builder.getArrayAttr(786 {builder.getIntegerAttr(builder.getIndexType(), 1)}));787 return tuple;788}789 790mlir::Type791fir::factory::getCharacterProcedureTupleType(mlir::Type funcPointerType) {792 mlir::MLIRContext *context = funcPointerType.getContext();793 mlir::Type lenType = mlir::IntegerType::get(context, 64);794 return mlir::TupleType::get(context, {funcPointerType, lenType});795}796 797fir::CharBoxValue fir::factory::CharacterExprHelper::createCharExtremum(798 bool predIsMin, llvm::ArrayRef<fir::CharBoxValue> opCBVs) {799 // inputs: we are given a vector of all of the charboxes of the arguments800 // passed to hlfir.char_extremum, as well as the predicate for whether we801 // want llt or lgt802 //803 // note: we know that, regardless of whether we're looking at smallest or804 // largest char, the size of the output buffer will be the same size as the805 // largest character out of all of the operands. so, we find the biggest806 // length first. It's okay if these char lengths are not known at compile807 // time.808 809 fir::CharBoxValue firstCBV = opCBVs[0];810 mlir::Value firstBuf = getCharBoxBuffer(firstCBV);811 auto firstLen = builder.createConvert(loc, builder.getCharacterLengthType(),812 firstCBV.getLen());813 814 mlir::Value resultBuf = firstBuf;815 mlir::Value resultLen = firstLen;816 mlir::Value biggestLen = firstLen;817 818 // values for casting buf type and len type819 auto typeLen = fir::CharacterType::unknownLen();820 auto kind = recoverCharacterType(firstBuf.getType()).getFKind();821 auto charTy = fir::CharacterType::get(builder.getContext(), kind, typeLen);822 auto type = fir::ReferenceType::get(charTy);823 824 size_t numOperands = opCBVs.size();825 for (size_t cbv_idx = 1; cbv_idx < numOperands; ++cbv_idx) {826 auto currChar = opCBVs[cbv_idx];827 auto currBuf = getCharBoxBuffer(currChar);828 auto currLen = builder.createConvert(loc, builder.getCharacterLengthType(),829 currChar.getLen());830 // biggest len result831 mlir::Value lhsBigger = mlir::arith::CmpIOp::create(832 builder, loc, mlir::arith::CmpIPredicate::uge, biggestLen, currLen);833 biggestLen = mlir::arith::SelectOp::create(builder, loc, lhsBigger,834 biggestLen, currLen);835 836 auto cmp = predIsMin ? mlir::arith::CmpIPredicate::slt837 : mlir::arith::CmpIPredicate::sgt;838 839 // lexical compare result840 mlir::Value resultCmp = fir::runtime::genCharCompare(841 builder, loc, cmp, currBuf, currLen, resultBuf, resultLen);842 843 // it's casting (to unknown size) time!844 resultBuf = builder.createConvert(loc, type, resultBuf);845 currBuf = builder.createConvert(loc, type, currBuf);846 847 resultBuf = mlir::arith::SelectOp::create(builder, loc, resultCmp, currBuf,848 resultBuf);849 resultLen = mlir::arith::SelectOp::create(builder, loc, resultCmp, currLen,850 resultLen);851 }852 853 // now that we know the lexicographically biggest/smallest char and which char854 // had the biggest len, we can populate a temp CBV and return it855 fir::CharBoxValue temp = createCharacterTemp(resultBuf.getType(), biggestLen);856 auto toBuf = temp;857 fir::CharBoxValue fromBuf{resultBuf, resultLen};858 createAssign(toBuf, fromBuf);859 return temp;860}861 862fir::CharBoxValue863fir::factory::convertCharacterKind(fir::FirOpBuilder &builder,864 mlir::Location loc,865 fir::CharBoxValue srcBoxChar, int toKind) {866 // Use char_convert. Each code point is translated from a867 // narrower/wider encoding to the target encoding. For example, 'A'868 // may be translated from 0x41 : i8 to 0x0041 : i16. The symbol869 // for euro (0x20AC : i16) may be translated from a wide character870 // to "0xE2 0x82 0xAC" : UTF-8.871 mlir::Value bufferSize = srcBoxChar.getLen();872 auto kindMap = builder.getKindMap();873 mlir::Value boxCharAddr = srcBoxChar.getAddr();874 auto fromTy = boxCharAddr.getType();875 if (auto charTy = mlir::dyn_cast<fir::CharacterType>(fromTy)) {876 // boxchar is a value, not a variable. Turn it into a temporary.877 // As a value, it ought to have a constant LEN value.878 assert(charTy.hasConstantLen() && "must have constant length");879 mlir::Value tmp = builder.createTemporary(loc, charTy);880 fir::StoreOp::create(builder, loc, boxCharAddr, tmp);881 boxCharAddr = tmp;882 }883 auto fromBits = kindMap.getCharacterBitsize(884 mlir::cast<fir::CharacterType>(fir::unwrapRefType(fromTy)).getFKind());885 auto toBits = kindMap.getCharacterBitsize(toKind);886 if (toBits < fromBits) {887 // Scale by relative ratio to give a buffer of the same length.888 auto ratio = builder.createIntegerConstant(loc, bufferSize.getType(),889 fromBits / toBits);890 bufferSize = mlir::arith::MulIOp::create(builder, loc, bufferSize, ratio);891 }892 mlir::Type toType =893 fir::CharacterType::getUnknownLen(builder.getContext(), toKind);894 auto dest = builder.createTemporary(loc, toType, /*name=*/{}, /*shape=*/{},895 mlir::ValueRange{bufferSize});896 fir::CharConvertOp::create(builder, loc, boxCharAddr, srcBoxChar.getLen(),897 dest);898 return fir::CharBoxValue{dest, srcBoxChar.getLen()};899}900