1//===-- FIRBuilder.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-exception
6//
7//===----------------------------------------------------------------------===//
8
9#include "flang/Optimizer/Builder/FIRBuilder.h"
10#include "flang/Optimizer/Builder/BoxValue.h"
11#include "flang/Optimizer/Builder/Character.h"
12#include "flang/Optimizer/Builder/Complex.h"
13#include "flang/Optimizer/Builder/MutableBox.h"
14#include "flang/Optimizer/Builder/Runtime/Allocatable.h"
15#include "flang/Optimizer/Builder/Runtime/Assign.h"
16#include "flang/Optimizer/Builder/Runtime/Derived.h"
17#include "flang/Optimizer/Builder/Todo.h"
18#include "flang/Optimizer/Dialect/CUF/CUFOps.h"
19#include "flang/Optimizer/Dialect/FIRAttr.h"
20#include "flang/Optimizer/Dialect/FIRDialect.h"
21#include "flang/Optimizer/Dialect/FIROpsSupport.h"
22#include "flang/Optimizer/Dialect/FIRType.h"
23#include "flang/Optimizer/Support/DataLayout.h"
24#include "flang/Optimizer/Support/FatalError.h"
25#include "flang/Optimizer/Support/InternalNames.h"
26#include "flang/Optimizer/Support/Utils.h"
27#include "mlir/Dialect/LLVMIR/LLVMDialect.h"
28#include "mlir/Dialect/OpenACC/OpenACC.h"
29#include "mlir/Dialect/OpenMP/OpenMPDialect.h"
30#include "llvm/ADT/ArrayRef.h"
31#include "llvm/ADT/StringExtras.h"
32#include "llvm/Support/CommandLine.h"
33#include "llvm/Support/ErrorHandling.h"
34#include "llvm/Support/MD5.h"
35#include <optional>
36
37static llvm::cl::opt<std::size_t>
38 nameLengthHashSize("length-to-hash-string-literal",
39 llvm::cl::desc("string literals that exceed this length"
40 " will use a hash value as their symbol "
41 "name"),
42 llvm::cl::init(Val: 32));
43
44mlir::func::FuncOp
45fir::FirOpBuilder::createFunction(mlir::Location loc, mlir::ModuleOp module,
46 llvm::StringRef name, mlir::FunctionType ty,
47 mlir::SymbolTable *symbolTable) {
48 return fir::createFuncOp(loc, module, name, ty, /*attrs*/ {}, symbolTable);
49}
50
51mlir::func::FuncOp
52fir::FirOpBuilder::createRuntimeFunction(mlir::Location loc,
53 llvm::StringRef name,
54 mlir::FunctionType ty, bool isIO) {
55 mlir::func::FuncOp func = createFunction(loc, name, ty);
56 func->setAttr(fir::FIROpsDialect::getFirRuntimeAttrName(), getUnitAttr());
57 if (isIO)
58 func->setAttr("fir.io", getUnitAttr());
59 return func;
60}
61
62mlir::func::FuncOp
63fir::FirOpBuilder::getNamedFunction(mlir::ModuleOp modOp,
64 const mlir::SymbolTable *symbolTable,
65 llvm::StringRef name) {
66 if (symbolTable)
67 if (auto func = symbolTable->lookup<mlir::func::FuncOp>(name)) {
68#ifdef EXPENSIVE_CHECKS
69 assert(func == modOp.lookupSymbol<mlir::func::FuncOp>(name) &&
70 "symbolTable and module out of sync");
71#endif
72 return func;
73 }
74 return modOp.lookupSymbol<mlir::func::FuncOp>(name);
75}
76
77mlir::func::FuncOp
78fir::FirOpBuilder::getNamedFunction(mlir::ModuleOp modOp,
79 const mlir::SymbolTable *symbolTable,
80 mlir::SymbolRefAttr symbol) {
81 if (symbolTable)
82 if (auto func = symbolTable->lookup<mlir::func::FuncOp>(
83 symbol.getLeafReference())) {
84#ifdef EXPENSIVE_CHECKS
85 assert(func == modOp.lookupSymbol<mlir::func::FuncOp>(symbol) &&
86 "symbolTable and module out of sync");
87#endif
88 return func;
89 }
90 return modOp.lookupSymbol<mlir::func::FuncOp>(symbol);
91}
92
93fir::GlobalOp
94fir::FirOpBuilder::getNamedGlobal(mlir::ModuleOp modOp,
95 const mlir::SymbolTable *symbolTable,
96 llvm::StringRef name) {
97 if (symbolTable)
98 if (auto global = symbolTable->lookup<fir::GlobalOp>(name)) {
99#ifdef EXPENSIVE_CHECKS
100 assert(global == modOp.lookupSymbol<fir::GlobalOp>(name) &&
101 "symbolTable and module out of sync");
102#endif
103 return global;
104 }
105 return modOp.lookupSymbol<fir::GlobalOp>(name);
106}
107
108mlir::Type fir::FirOpBuilder::getRefType(mlir::Type eleTy, bool isVolatile) {
109 assert(!mlir::isa<fir::ReferenceType>(eleTy) && "cannot be a reference type");
110 return fir::ReferenceType::get(eleTy, isVolatile);
111}
112
113mlir::Type fir::FirOpBuilder::getVarLenSeqTy(mlir::Type eleTy, unsigned rank) {
114 fir::SequenceType::Shape shape(rank, fir::SequenceType::getUnknownExtent());
115 return fir::SequenceType::get(shape, eleTy);
116}
117
118mlir::Type fir::FirOpBuilder::getRealType(int kind) {
119 switch (kindMap.getRealTypeID(kind)) {
120 case llvm::Type::TypeID::HalfTyID:
121 return mlir::Float16Type::get(getContext());
122 case llvm::Type::TypeID::BFloatTyID:
123 return mlir::BFloat16Type::get(getContext());
124 case llvm::Type::TypeID::FloatTyID:
125 return mlir::Float32Type::get(getContext());
126 case llvm::Type::TypeID::DoubleTyID:
127 return mlir::Float64Type::get(getContext());
128 case llvm::Type::TypeID::X86_FP80TyID:
129 return mlir::Float80Type::get(getContext());
130 case llvm::Type::TypeID::FP128TyID:
131 return mlir::Float128Type::get(getContext());
132 default:
133 fir::emitFatalError(mlir::UnknownLoc::get(getContext()),
134 "unsupported type !fir.real<kind>");
135 }
136}
137
138mlir::Value fir::FirOpBuilder::createNullConstant(mlir::Location loc,
139 mlir::Type ptrType) {
140 auto ty = ptrType ? ptrType : getRefType(getNoneType());
141 return create<fir::ZeroOp>(loc, ty);
142}
143
144mlir::Value fir::FirOpBuilder::createIntegerConstant(mlir::Location loc,
145 mlir::Type ty,
146 std::int64_t cst) {
147 assert((cst >= 0 || mlir::isa<mlir::IndexType>(ty) ||
148 mlir::cast<mlir::IntegerType>(ty).getWidth() <= 64) &&
149 "must use APint");
150 return create<mlir::arith::ConstantOp>(loc, ty, getIntegerAttr(ty, cst));
151}
152
153mlir::Value fir::FirOpBuilder::createAllOnesInteger(mlir::Location loc,
154 mlir::Type ty) {
155 if (mlir::isa<mlir::IndexType>(ty))
156 return createIntegerConstant(loc, ty, -1);
157 llvm::APInt allOnes =
158 llvm::APInt::getAllOnes(mlir::cast<mlir::IntegerType>(ty).getWidth());
159 return create<mlir::arith::ConstantOp>(loc, ty, getIntegerAttr(ty, allOnes));
160}
161
162mlir::Value
163fir::FirOpBuilder::createRealConstant(mlir::Location loc, mlir::Type fltTy,
164 llvm::APFloat::integerPart val) {
165 auto apf = [&]() -> llvm::APFloat {
166 if (fltTy.isF16())
167 return llvm::APFloat(llvm::APFloat::IEEEhalf(), val);
168 if (fltTy.isBF16())
169 return llvm::APFloat(llvm::APFloat::BFloat(), val);
170 if (fltTy.isF32())
171 return llvm::APFloat(llvm::APFloat::IEEEsingle(), val);
172 if (fltTy.isF64())
173 return llvm::APFloat(llvm::APFloat::IEEEdouble(), val);
174 if (fltTy.isF80())
175 return llvm::APFloat(llvm::APFloat::x87DoubleExtended(), val);
176 if (fltTy.isF128())
177 return llvm::APFloat(llvm::APFloat::IEEEquad(), val);
178 llvm_unreachable("unhandled MLIR floating-point type");
179 };
180 return createRealConstant(loc, fltTy, apf());
181}
182
183mlir::Value fir::FirOpBuilder::createRealConstant(mlir::Location loc,
184 mlir::Type fltTy,
185 const llvm::APFloat &value) {
186 if (mlir::isa<mlir::FloatType>(fltTy)) {
187 auto attr = getFloatAttr(fltTy, value);
188 return create<mlir::arith::ConstantOp>(loc, fltTy, attr);
189 }
190 llvm_unreachable("should use builtin floating-point type");
191}
192
193llvm::SmallVector<mlir::Value>
194fir::factory::elideExtentsAlreadyInType(mlir::Type type,
195 mlir::ValueRange shape) {
196 auto arrTy = mlir::dyn_cast<fir::SequenceType>(type);
197 if (shape.empty() || !arrTy)
198 return {};
199 // elide the constant dimensions before construction
200 assert(shape.size() == arrTy.getDimension());
201 llvm::SmallVector<mlir::Value> dynamicShape;
202 auto typeShape = arrTy.getShape();
203 for (unsigned i = 0, end = arrTy.getDimension(); i < end; ++i)
204 if (typeShape[i] == fir::SequenceType::getUnknownExtent())
205 dynamicShape.push_back(shape[i]);
206 return dynamicShape;
207}
208
209llvm::SmallVector<mlir::Value>
210fir::factory::elideLengthsAlreadyInType(mlir::Type type,
211 mlir::ValueRange lenParams) {
212 if (lenParams.empty())
213 return {};
214 if (auto arrTy = mlir::dyn_cast<fir::SequenceType>(type))
215 type = arrTy.getEleTy();
216 if (fir::hasDynamicSize(type))
217 return lenParams;
218 return {};
219}
220
221/// Allocate a local variable.
222/// A local variable ought to have a name in the source code.
223mlir::Value fir::FirOpBuilder::allocateLocal(
224 mlir::Location loc, mlir::Type ty, llvm::StringRef uniqName,
225 llvm::StringRef name, bool pinned, llvm::ArrayRef<mlir::Value> shape,
226 llvm::ArrayRef<mlir::Value> lenParams, bool asTarget) {
227 // Convert the shape extents to `index`, as needed.
228 llvm::SmallVector<mlir::Value> indices;
229 llvm::SmallVector<mlir::Value> elidedShape =
230 fir::factory::elideExtentsAlreadyInType(ty, shape);
231 llvm::SmallVector<mlir::Value> elidedLenParams =
232 fir::factory::elideLengthsAlreadyInType(ty, lenParams);
233 auto idxTy = getIndexType();
234 for (mlir::Value sh : elidedShape)
235 indices.push_back(createConvert(loc, idxTy, sh));
236 // Add a target attribute, if needed.
237 llvm::SmallVector<mlir::NamedAttribute> attrs;
238 if (asTarget)
239 attrs.emplace_back(
240 mlir::StringAttr::get(getContext(), fir::getTargetAttrName()),
241 getUnitAttr());
242 // Create the local variable.
243 if (name.empty()) {
244 if (uniqName.empty())
245 return create<fir::AllocaOp>(loc, ty, pinned, elidedLenParams, indices,
246 attrs);
247 return create<fir::AllocaOp>(loc, ty, uniqName, pinned, elidedLenParams,
248 indices, attrs);
249 }
250 return create<fir::AllocaOp>(loc, ty, uniqName, name, pinned, elidedLenParams,
251 indices, attrs);
252}
253
254mlir::Value fir::FirOpBuilder::allocateLocal(
255 mlir::Location loc, mlir::Type ty, llvm::StringRef uniqName,
256 llvm::StringRef name, llvm::ArrayRef<mlir::Value> shape,
257 llvm::ArrayRef<mlir::Value> lenParams, bool asTarget) {
258 return allocateLocal(loc, ty, uniqName, name, /*pinned=*/false, shape,
259 lenParams, asTarget);
260}
261
262/// Get the block for adding Allocas.
263mlir::Block *fir::FirOpBuilder::getAllocaBlock() {
264 if (auto accComputeRegionIface =
265 getRegion().getParentOfType<mlir::acc::ComputeRegionOpInterface>()) {
266 return accComputeRegionIface.getAllocaBlock();
267 }
268
269 if (auto ompOutlineableIface =
270 getRegion()
271 .getParentOfType<mlir::omp::OutlineableOpenMPOpInterface>()) {
272 return ompOutlineableIface.getAllocaBlock();
273 }
274
275 if (auto recipeIface =
276 getRegion().getParentOfType<mlir::accomp::RecipeInterface>()) {
277 return recipeIface.getAllocaBlock(getRegion());
278 }
279
280 if (auto cufKernelOp = getRegion().getParentOfType<cuf::KernelOp>())
281 return &cufKernelOp.getRegion().front();
282
283 if (auto doConcurentOp = getRegion().getParentOfType<fir::DoConcurrentOp>())
284 return doConcurentOp.getBody();
285
286 if (auto firLocalOp = getRegion().getParentOfType<fir::LocalitySpecifierOp>())
287 return &getRegion().front();
288
289 if (auto firLocalOp = getRegion().getParentOfType<fir::DeclareReductionOp>())
290 return &getRegion().front();
291
292 return getEntryBlock();
293}
294
295static mlir::ArrayAttr makeI64ArrayAttr(llvm::ArrayRef<int64_t> values,
296 mlir::MLIRContext *context) {
297 llvm::SmallVector<mlir::Attribute, 4> attrs;
298 attrs.reserve(N: values.size());
299 for (auto &v : values)
300 attrs.push_back(Elt: mlir::IntegerAttr::get(type: mlir::IntegerType::get(context, width: 64),
301 value: mlir::APInt(64, v)));
302 return mlir::ArrayAttr::get(context, value: attrs);
303}
304
305mlir::ArrayAttr fir::FirOpBuilder::create2DI64ArrayAttr(
306 llvm::SmallVectorImpl<llvm::SmallVector<int64_t>> &intData) {
307 llvm::SmallVector<mlir::Attribute> arrayAttr;
308 arrayAttr.reserve(intData.size());
309 mlir::MLIRContext *context = getContext();
310 for (auto &v : intData)
311 arrayAttr.push_back(makeI64ArrayAttr(v, context));
312 return mlir::ArrayAttr::get(context, arrayAttr);
313}
314
315mlir::Value fir::FirOpBuilder::createTemporaryAlloc(
316 mlir::Location loc, mlir::Type type, llvm::StringRef name,
317 mlir::ValueRange lenParams, mlir::ValueRange shape,
318 llvm::ArrayRef<mlir::NamedAttribute> attrs,
319 std::optional<Fortran::common::CUDADataAttr> cudaAttr) {
320 assert(!mlir::isa<fir::ReferenceType>(type) && "cannot be a reference");
321 // If the alloca is inside an OpenMP Op which will be outlined then pin
322 // the alloca here.
323 const bool pinned =
324 getRegion().getParentOfType<mlir::omp::OutlineableOpenMPOpInterface>();
325 if (cudaAttr) {
326 cuf::DataAttributeAttr attr = cuf::getDataAttribute(getContext(), cudaAttr);
327 return create<cuf::AllocOp>(loc, type, /*unique_name=*/llvm::StringRef{},
328 name, attr, lenParams, shape, attrs);
329 } else {
330 return create<fir::AllocaOp>(loc, type, /*unique_name=*/llvm::StringRef{},
331 name, pinned, lenParams, shape, attrs);
332 }
333}
334
335/// Create a temporary variable on the stack. Anonymous temporaries have no
336/// `name` value. Temporaries do not require a uniqued name.
337mlir::Value fir::FirOpBuilder::createTemporary(
338 mlir::Location loc, mlir::Type type, llvm::StringRef name,
339 mlir::ValueRange shape, mlir::ValueRange lenParams,
340 llvm::ArrayRef<mlir::NamedAttribute> attrs,
341 std::optional<Fortran::common::CUDADataAttr> cudaAttr) {
342 llvm::SmallVector<mlir::Value> dynamicShape =
343 fir::factory::elideExtentsAlreadyInType(type, shape);
344 llvm::SmallVector<mlir::Value> dynamicLength =
345 fir::factory::elideLengthsAlreadyInType(type, lenParams);
346 InsertPoint insPt;
347 const bool hoistAlloc = dynamicShape.empty() && dynamicLength.empty();
348 if (hoistAlloc) {
349 insPt = saveInsertionPoint();
350 setInsertionPointToStart(getAllocaBlock());
351 }
352
353 mlir::Value ae = createTemporaryAlloc(loc, type, name, dynamicLength,
354 dynamicShape, attrs, cudaAttr);
355
356 if (hoistAlloc)
357 restoreInsertionPoint(insPt);
358 return ae;
359}
360
361mlir::Value fir::FirOpBuilder::createHeapTemporary(
362 mlir::Location loc, mlir::Type type, llvm::StringRef name,
363 mlir::ValueRange shape, mlir::ValueRange lenParams,
364 llvm::ArrayRef<mlir::NamedAttribute> attrs) {
365 llvm::SmallVector<mlir::Value> dynamicShape =
366 fir::factory::elideExtentsAlreadyInType(type, shape);
367 llvm::SmallVector<mlir::Value> dynamicLength =
368 fir::factory::elideLengthsAlreadyInType(type, lenParams);
369
370 assert(!mlir::isa<fir::ReferenceType>(type) && "cannot be a reference");
371 return create<fir::AllocMemOp>(loc, type, /*unique_name=*/llvm::StringRef{},
372 name, dynamicLength, dynamicShape, attrs);
373}
374
375std::pair<mlir::Value, bool> fir::FirOpBuilder::createAndDeclareTemp(
376 mlir::Location loc, mlir::Type baseType, mlir::Value shape,
377 llvm::ArrayRef<mlir::Value> extents, llvm::ArrayRef<mlir::Value> typeParams,
378 const std::function<decltype(FirOpBuilder::genTempDeclareOp)> &genDeclare,
379 mlir::Value polymorphicMold, bool useStack, llvm::StringRef tmpName) {
380 if (polymorphicMold) {
381 // Create *allocated* polymorphic temporary using the dynamic type
382 // of the mold and the provided shape/extents.
383 auto boxType = fir::ClassType::get(fir::HeapType::get(baseType));
384 mlir::Value boxAddress = fir::factory::getAndEstablishBoxStorage(
385 *this, loc, boxType, shape, typeParams, polymorphicMold);
386 fir::runtime::genAllocatableAllocate(*this, loc, boxAddress);
387 mlir::Value box = create<fir::LoadOp>(loc, boxAddress);
388 mlir::Value base =
389 genDeclare(*this, loc, box, tmpName, /*shape=*/mlir::Value{},
390 typeParams, fir::FortranVariableFlagsAttr{});
391 return {base, /*isHeapAllocation=*/true};
392 }
393 mlir::Value allocmem;
394 if (useStack)
395 allocmem = createTemporary(loc, baseType, tmpName, extents, typeParams);
396 else
397 allocmem = createHeapTemporary(loc, baseType, tmpName, extents, typeParams);
398 mlir::Value base = genDeclare(*this, loc, allocmem, tmpName, shape,
399 typeParams, fir::FortranVariableFlagsAttr{});
400 return {base, !useStack};
401}
402
403mlir::Value fir::FirOpBuilder::genTempDeclareOp(
404 fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value memref,
405 llvm::StringRef name, mlir::Value shape,
406 llvm::ArrayRef<mlir::Value> typeParams,
407 fir::FortranVariableFlagsAttr fortranAttrs) {
408 auto nameAttr = mlir::StringAttr::get(builder.getContext(), name);
409 return builder.create<fir::DeclareOp>(loc, memref.getType(), memref, shape,
410 typeParams,
411 /*dummy_scope=*/nullptr, nameAttr,
412 fortranAttrs, cuf::DataAttributeAttr{});
413}
414
415mlir::Value fir::FirOpBuilder::genStackSave(mlir::Location loc) {
416 mlir::Type voidPtr = mlir::LLVM::LLVMPointerType::get(
417 getContext(), fir::factory::getAllocaAddressSpace(&getDataLayout()));
418 return create<mlir::LLVM::StackSaveOp>(loc, voidPtr);
419}
420
421void fir::FirOpBuilder::genStackRestore(mlir::Location loc,
422 mlir::Value stackPointer) {
423 create<mlir::LLVM::StackRestoreOp>(loc, stackPointer);
424}
425
426/// Create a global variable in the (read-only) data section. A global variable
427/// must have a unique name to identify and reference it.
428fir::GlobalOp fir::FirOpBuilder::createGlobal(
429 mlir::Location loc, mlir::Type type, llvm::StringRef name,
430 mlir::StringAttr linkage, mlir::Attribute value, bool isConst,
431 bool isTarget, cuf::DataAttributeAttr dataAttr) {
432 if (auto global = getNamedGlobal(name))
433 return global;
434 auto module = getModule();
435 auto insertPt = saveInsertionPoint();
436 setInsertionPoint(module.getBody(), module.getBody()->end());
437 llvm::SmallVector<mlir::NamedAttribute> attrs;
438 if (dataAttr) {
439 auto globalOpName = mlir::OperationName(fir::GlobalOp::getOperationName(),
440 module.getContext());
441 attrs.push_back(mlir::NamedAttribute(
442 fir::GlobalOp::getDataAttrAttrName(globalOpName), dataAttr));
443 }
444 auto glob = create<fir::GlobalOp>(loc, name, isConst, isTarget, type, value,
445 linkage, attrs);
446 restoreInsertionPoint(insertPt);
447 if (symbolTable)
448 symbolTable->insert(glob);
449 return glob;
450}
451
452fir::GlobalOp fir::FirOpBuilder::createGlobal(
453 mlir::Location loc, mlir::Type type, llvm::StringRef name, bool isConst,
454 bool isTarget, std::function<void(FirOpBuilder &)> bodyBuilder,
455 mlir::StringAttr linkage, cuf::DataAttributeAttr dataAttr) {
456 if (auto global = getNamedGlobal(name))
457 return global;
458 auto module = getModule();
459 auto insertPt = saveInsertionPoint();
460 setInsertionPoint(module.getBody(), module.getBody()->end());
461 auto glob = create<fir::GlobalOp>(loc, name, isConst, isTarget, type,
462 mlir::Attribute{}, linkage);
463 auto &region = glob.getRegion();
464 region.push_back(new mlir::Block);
465 auto &block = glob.getRegion().back();
466 setInsertionPointToStart(&block);
467 bodyBuilder(*this);
468 restoreInsertionPoint(insertPt);
469 if (symbolTable)
470 symbolTable->insert(glob);
471 return glob;
472}
473
474std::pair<fir::TypeInfoOp, mlir::OpBuilder::InsertPoint>
475fir::FirOpBuilder::createTypeInfoOp(mlir::Location loc,
476 fir::RecordType recordType,
477 fir::RecordType parentType) {
478 mlir::ModuleOp module = getModule();
479 if (fir::TypeInfoOp typeInfo =
480 fir::lookupTypeInfoOp(recordType.getName(), module, symbolTable))
481 return {typeInfo, InsertPoint{}};
482 InsertPoint insertPoint = saveInsertionPoint();
483 setInsertionPoint(module.getBody(), module.getBody()->end());
484 auto typeInfo = create<fir::TypeInfoOp>(loc, recordType, parentType);
485 if (symbolTable)
486 symbolTable->insert(typeInfo);
487 return {typeInfo, insertPoint};
488}
489
490mlir::Value fir::FirOpBuilder::convertWithSemantics(
491 mlir::Location loc, mlir::Type toTy, mlir::Value val,
492 bool allowCharacterConversion, bool allowRebox) {
493 assert(toTy && "store location must be typed");
494 auto fromTy = val.getType();
495 if (fromTy == toTy)
496 return val;
497 fir::factory::Complex helper{*this, loc};
498 if ((fir::isa_real(fromTy) || fir::isa_integer(fromTy)) &&
499 fir::isa_complex(toTy)) {
500 // imaginary part is zero
501 auto eleTy = helper.getComplexPartType(toTy);
502 auto cast = createConvert(loc, eleTy, val);
503 auto imag = createRealZeroConstant(loc, eleTy);
504 return helper.createComplex(toTy, cast, imag);
505 }
506 if (fir::isa_complex(fromTy) &&
507 (fir::isa_integer(toTy) || fir::isa_real(toTy))) {
508 // drop the imaginary part
509 auto rp = helper.extractComplexPart(val, /*isImagPart=*/false);
510 return createConvert(loc, toTy, rp);
511 }
512 if (allowCharacterConversion) {
513 if (mlir::isa<fir::BoxCharType>(fromTy)) {
514 // Extract the address of the character string and pass it
515 fir::factory::CharacterExprHelper charHelper{*this, loc};
516 std::pair<mlir::Value, mlir::Value> unboxchar =
517 charHelper.createUnboxChar(val);
518 return createConvert(loc, toTy, unboxchar.first);
519 }
520 if (auto boxType = mlir::dyn_cast<fir::BoxCharType>(toTy)) {
521 // Extract the address of the actual argument and create a boxed
522 // character value with an undefined length
523 // TODO: We should really calculate the total size of the actual
524 // argument in characters and use it as the length of the string
525 auto refType = getRefType(boxType.getEleTy());
526 mlir::Value charBase = createConvert(loc, refType, val);
527 // Do not use fir.undef since llvm optimizer is too harsh when it
528 // sees such values (may just delete code).
529 mlir::Value unknownLen = createIntegerConstant(loc, getIndexType(), 0);
530 fir::factory::CharacterExprHelper charHelper{*this, loc};
531 return charHelper.createEmboxChar(charBase, unknownLen);
532 }
533 }
534 if (fir::isa_ref_type(toTy) && fir::isa_box_type(fromTy)) {
535 // Call is expecting a raw data pointer, not a box. Get the data pointer out
536 // of the box and pass that.
537 assert((fir::unwrapRefType(toTy) ==
538 fir::unwrapRefType(fir::unwrapPassByRefType(fromTy)) &&
539 "element types expected to match"));
540 return create<fir::BoxAddrOp>(loc, toTy, val);
541 }
542 if (fir::isa_ref_type(fromTy) && mlir::isa<fir::BoxProcType>(toTy)) {
543 // Call is expecting a boxed procedure, not a reference to other data type.
544 // Convert the reference to a procedure and embox it.
545 mlir::Type procTy = mlir::cast<fir::BoxProcType>(toTy).getEleTy();
546 mlir::Value proc = createConvert(loc, procTy, val);
547 return create<fir::EmboxProcOp>(loc, toTy, proc);
548 }
549
550 // Legacy: remove when removing non HLFIR lowering path.
551 if (allowRebox)
552 if (((fir::isPolymorphicType(fromTy) &&
553 (fir::isAllocatableType(fromTy) || fir::isPointerType(fromTy)) &&
554 fir::isPolymorphicType(toTy)) ||
555 (fir::isPolymorphicType(fromTy) && mlir::isa<fir::BoxType>(toTy))) &&
556 !(fir::isUnlimitedPolymorphicType(fromTy) && fir::isAssumedType(toTy)))
557 return create<fir::ReboxOp>(loc, toTy, val, mlir::Value{},
558 /*slice=*/mlir::Value{});
559
560 return createConvert(loc, toTy, val);
561}
562
563mlir::Value fir::FirOpBuilder::createVolatileCast(mlir::Location loc,
564 bool isVolatile,
565 mlir::Value val) {
566 mlir::Type volatileAdjustedType =
567 fir::updateTypeWithVolatility(val.getType(), isVolatile);
568 if (volatileAdjustedType == val.getType())
569 return val;
570 return create<fir::VolatileCastOp>(loc, volatileAdjustedType, val);
571}
572
573mlir::Value fir::FirOpBuilder::createConvertWithVolatileCast(mlir::Location loc,
574 mlir::Type toTy,
575 mlir::Value val) {
576 val = createVolatileCast(loc, fir::isa_volatile_type(toTy), val);
577 return createConvert(loc, toTy, val);
578}
579
580mlir::Value fir::factory::createConvert(mlir::OpBuilder &builder,
581 mlir::Location loc, mlir::Type toTy,
582 mlir::Value val) {
583 if (val.getType() != toTy) {
584 assert((!fir::isa_derived(toTy) ||
585 mlir::cast<fir::RecordType>(val.getType()).getTypeList() ==
586 mlir::cast<fir::RecordType>(toTy).getTypeList()) &&
587 "incompatible record types");
588 return builder.create<fir::ConvertOp>(loc, toTy, val);
589 }
590 return val;
591}
592
593mlir::Value fir::FirOpBuilder::createConvert(mlir::Location loc,
594 mlir::Type toTy, mlir::Value val) {
595 return fir::factory::createConvert(*this, loc, toTy, val);
596}
597
598void fir::FirOpBuilder::createStoreWithConvert(mlir::Location loc,
599 mlir::Value val,
600 mlir::Value addr) {
601 mlir::Type unwrapedRefType = fir::unwrapRefType(addr.getType());
602 val = createVolatileCast(loc, fir::isa_volatile_type(unwrapedRefType), val);
603 mlir::Value cast = createConvert(loc, unwrapedRefType, val);
604 create<fir::StoreOp>(loc, cast, addr);
605}
606
607mlir::Value fir::FirOpBuilder::loadIfRef(mlir::Location loc, mlir::Value val) {
608 if (fir::isa_ref_type(val.getType()))
609 return create<fir::LoadOp>(loc, val);
610 return val;
611}
612
613fir::StringLitOp fir::FirOpBuilder::createStringLitOp(mlir::Location loc,
614 llvm::StringRef data) {
615 auto type = fir::CharacterType::get(getContext(), 1, data.size());
616 auto strAttr = mlir::StringAttr::get(getContext(), data);
617 auto valTag = mlir::StringAttr::get(getContext(), fir::StringLitOp::value());
618 mlir::NamedAttribute dataAttr(valTag, strAttr);
619 auto sizeTag = mlir::StringAttr::get(getContext(), fir::StringLitOp::size());
620 mlir::NamedAttribute sizeAttr(sizeTag, getI64IntegerAttr(data.size()));
621 llvm::SmallVector<mlir::NamedAttribute> attrs{dataAttr, sizeAttr};
622 return create<fir::StringLitOp>(loc, llvm::ArrayRef<mlir::Type>{type},
623 std::nullopt, attrs);
624}
625
626mlir::Value fir::FirOpBuilder::genShape(mlir::Location loc,
627 llvm::ArrayRef<mlir::Value> exts) {
628 return create<fir::ShapeOp>(loc, exts);
629}
630
631mlir::Value fir::FirOpBuilder::genShape(mlir::Location loc,
632 llvm::ArrayRef<mlir::Value> shift,
633 llvm::ArrayRef<mlir::Value> exts) {
634 auto shapeType = fir::ShapeShiftType::get(getContext(), exts.size());
635 llvm::SmallVector<mlir::Value> shapeArgs;
636 auto idxTy = getIndexType();
637 for (auto [lbnd, ext] : llvm::zip(shift, exts)) {
638 auto lb = createConvert(loc, idxTy, lbnd);
639 shapeArgs.push_back(lb);
640 shapeArgs.push_back(ext);
641 }
642 return create<fir::ShapeShiftOp>(loc, shapeType, shapeArgs);
643}
644
645mlir::Value fir::FirOpBuilder::genShape(mlir::Location loc,
646 const fir::AbstractArrayBox &arr) {
647 if (arr.lboundsAllOne())
648 return genShape(loc, arr.getExtents());
649 return genShape(loc, arr.getLBounds(), arr.getExtents());
650}
651
652mlir::Value fir::FirOpBuilder::genShift(mlir::Location loc,
653 llvm::ArrayRef<mlir::Value> shift) {
654 auto shiftType = fir::ShiftType::get(getContext(), shift.size());
655 return create<fir::ShiftOp>(loc, shiftType, shift);
656}
657
658mlir::Value fir::FirOpBuilder::createShape(mlir::Location loc,
659 const fir::ExtendedValue &exv) {
660 return exv.match(
661 [&](const fir::ArrayBoxValue &box) { return genShape(loc, box); },
662 [&](const fir::CharArrayBoxValue &box) { return genShape(loc, box); },
663 [&](const fir::BoxValue &box) -> mlir::Value {
664 if (!box.getLBounds().empty()) {
665 auto shiftType =
666 fir::ShiftType::get(getContext(), box.getLBounds().size());
667 return create<fir::ShiftOp>(loc, shiftType, box.getLBounds());
668 }
669 return {};
670 },
671 [&](const fir::MutableBoxValue &) -> mlir::Value {
672 // MutableBoxValue must be read into another category to work with them
673 // outside of allocation/assignment contexts.
674 fir::emitFatalError(loc, "createShape on MutableBoxValue");
675 },
676 [&](auto) -> mlir::Value { fir::emitFatalError(loc, "not an array"); });
677}
678
679mlir::Value fir::FirOpBuilder::createSlice(mlir::Location loc,
680 const fir::ExtendedValue &exv,
681 mlir::ValueRange triples,
682 mlir::ValueRange path) {
683 if (triples.empty()) {
684 // If there is no slicing by triple notation, then take the whole array.
685 auto fullShape = [&](const llvm::ArrayRef<mlir::Value> lbounds,
686 llvm::ArrayRef<mlir::Value> extents) -> mlir::Value {
687 llvm::SmallVector<mlir::Value> trips;
688 auto idxTy = getIndexType();
689 auto one = createIntegerConstant(loc, idxTy, 1);
690 if (lbounds.empty()) {
691 for (auto v : extents) {
692 trips.push_back(one);
693 trips.push_back(v);
694 trips.push_back(one);
695 }
696 return create<fir::SliceOp>(loc, trips, path);
697 }
698 for (auto [lbnd, extent] : llvm::zip(lbounds, extents)) {
699 auto lb = createConvert(loc, idxTy, lbnd);
700 auto ext = createConvert(loc, idxTy, extent);
701 auto shift = create<mlir::arith::SubIOp>(loc, lb, one);
702 auto ub = create<mlir::arith::AddIOp>(loc, ext, shift);
703 trips.push_back(lb);
704 trips.push_back(ub);
705 trips.push_back(one);
706 }
707 return create<fir::SliceOp>(loc, trips, path);
708 };
709 return exv.match(
710 [&](const fir::ArrayBoxValue &box) {
711 return fullShape(box.getLBounds(), box.getExtents());
712 },
713 [&](const fir::CharArrayBoxValue &box) {
714 return fullShape(box.getLBounds(), box.getExtents());
715 },
716 [&](const fir::BoxValue &box) {
717 auto extents = fir::factory::readExtents(*this, loc, box);
718 return fullShape(box.getLBounds(), extents);
719 },
720 [&](const fir::MutableBoxValue &) -> mlir::Value {
721 // MutableBoxValue must be read into another category to work with
722 // them outside of allocation/assignment contexts.
723 fir::emitFatalError(loc, "createSlice on MutableBoxValue");
724 },
725 [&](auto) -> mlir::Value { fir::emitFatalError(loc, "not an array"); });
726 }
727 return create<fir::SliceOp>(loc, triples, path);
728}
729
730mlir::Value fir::FirOpBuilder::createBox(mlir::Location loc,
731 const fir::ExtendedValue &exv,
732 bool isPolymorphic,
733 bool isAssumedType) {
734 mlir::Value itemAddr = fir::getBase(exv);
735 if (mlir::isa<fir::BaseBoxType>(itemAddr.getType()))
736 return itemAddr;
737 auto elementType = fir::dyn_cast_ptrEleTy(itemAddr.getType());
738 if (!elementType) {
739 mlir::emitError(loc, "internal: expected a memory reference type ")
740 << itemAddr.getType();
741 llvm_unreachable("not a memory reference type");
742 }
743 const bool isVolatile = fir::isa_volatile_type(itemAddr.getType());
744 mlir::Type boxTy;
745 mlir::Value tdesc;
746 // Avoid to wrap a box/class with box/class.
747 if (mlir::isa<fir::BaseBoxType>(elementType)) {
748 boxTy = elementType;
749 } else {
750 boxTy = fir::BoxType::get(elementType, isVolatile);
751 if (isPolymorphic) {
752 elementType = fir::updateTypeForUnlimitedPolymorphic(elementType);
753 if (isAssumedType)
754 boxTy = fir::BoxType::get(elementType, isVolatile);
755 else
756 boxTy = fir::ClassType::get(elementType, isVolatile);
757 }
758 }
759
760 return exv.match(
761 [&](const fir::ArrayBoxValue &box) -> mlir::Value {
762 mlir::Value empty;
763 mlir::ValueRange emptyRange;
764 mlir::Value s = createShape(loc, exv);
765 return create<fir::EmboxOp>(loc, boxTy, itemAddr, s, /*slice=*/empty,
766 /*typeparams=*/emptyRange,
767 isPolymorphic ? box.getSourceBox() : tdesc);
768 },
769 [&](const fir::CharArrayBoxValue &box) -> mlir::Value {
770 mlir::Value s = createShape(loc, exv);
771 if (fir::factory::CharacterExprHelper::hasConstantLengthInType(exv))
772 return create<fir::EmboxOp>(loc, boxTy, itemAddr, s);
773
774 mlir::Value emptySlice;
775 llvm::SmallVector<mlir::Value> lenParams{box.getLen()};
776 return create<fir::EmboxOp>(loc, boxTy, itemAddr, s, emptySlice,
777 lenParams);
778 },
779 [&](const fir::CharBoxValue &box) -> mlir::Value {
780 if (fir::factory::CharacterExprHelper::hasConstantLengthInType(exv))
781 return create<fir::EmboxOp>(loc, boxTy, itemAddr);
782 mlir::Value emptyShape, emptySlice;
783 llvm::SmallVector<mlir::Value> lenParams{box.getLen()};
784 return create<fir::EmboxOp>(loc, boxTy, itemAddr, emptyShape,
785 emptySlice, lenParams);
786 },
787 [&](const fir::MutableBoxValue &x) -> mlir::Value {
788 return create<fir::LoadOp>(
789 loc, fir::factory::getMutableIRBox(*this, loc, x));
790 },
791 [&](const fir::PolymorphicValue &p) -> mlir::Value {
792 mlir::Value empty;
793 mlir::ValueRange emptyRange;
794 return create<fir::EmboxOp>(loc, boxTy, itemAddr, empty, empty,
795 emptyRange,
796 isPolymorphic ? p.getSourceBox() : tdesc);
797 },
798 [&](const auto &) -> mlir::Value {
799 mlir::Value empty;
800 mlir::ValueRange emptyRange;
801 return create<fir::EmboxOp>(loc, boxTy, itemAddr, empty, empty,
802 emptyRange, tdesc);
803 });
804}
805
806mlir::Value fir::FirOpBuilder::createBox(mlir::Location loc, mlir::Type boxType,
807 mlir::Value addr, mlir::Value shape,
808 mlir::Value slice,
809 llvm::ArrayRef<mlir::Value> lengths,
810 mlir::Value tdesc) {
811 mlir::Type valueOrSequenceType = fir::unwrapPassByRefType(boxType);
812 return create<fir::EmboxOp>(
813 loc, boxType, addr, shape, slice,
814 fir::factory::elideLengthsAlreadyInType(valueOrSequenceType, lengths),
815 tdesc);
816}
817
818void fir::FirOpBuilder::dumpFunc() { getFunction().dump(); }
819
820static mlir::Value
821genNullPointerComparison(fir::FirOpBuilder &builder, mlir::Location loc,
822 mlir::Value addr,
823 mlir::arith::CmpIPredicate condition) {
824 auto intPtrTy = builder.getIntPtrType();
825 auto ptrToInt = builder.createConvert(loc, intPtrTy, addr);
826 auto c0 = builder.createIntegerConstant(loc, intPtrTy, 0);
827 return builder.create<mlir::arith::CmpIOp>(loc, condition, ptrToInt, c0);
828}
829
830mlir::Value fir::FirOpBuilder::genIsNotNullAddr(mlir::Location loc,
831 mlir::Value addr) {
832 return genNullPointerComparison(*this, loc, addr,
833 mlir::arith::CmpIPredicate::ne);
834}
835
836mlir::Value fir::FirOpBuilder::genIsNullAddr(mlir::Location loc,
837 mlir::Value addr) {
838 return genNullPointerComparison(*this, loc, addr,
839 mlir::arith::CmpIPredicate::eq);
840}
841
842mlir::Value fir::FirOpBuilder::genExtentFromTriplet(mlir::Location loc,
843 mlir::Value lb,
844 mlir::Value ub,
845 mlir::Value step,
846 mlir::Type type) {
847 auto zero = createIntegerConstant(loc, type, 0);
848 lb = createConvert(loc, type, lb);
849 ub = createConvert(loc, type, ub);
850 step = createConvert(loc, type, step);
851 auto diff = create<mlir::arith::SubIOp>(loc, ub, lb);
852 auto add = create<mlir::arith::AddIOp>(loc, diff, step);
853 auto div = create<mlir::arith::DivSIOp>(loc, add, step);
854 auto cmp = create<mlir::arith::CmpIOp>(loc, mlir::arith::CmpIPredicate::sgt,
855 div, zero);
856 return create<mlir::arith::SelectOp>(loc, cmp, div, zero);
857}
858
859mlir::Value fir::FirOpBuilder::genAbsentOp(mlir::Location loc,
860 mlir::Type argTy) {
861 if (!fir::isCharacterProcedureTuple(argTy))
862 return create<fir::AbsentOp>(loc, argTy);
863
864 auto boxProc =
865 create<fir::AbsentOp>(loc, mlir::cast<mlir::TupleType>(argTy).getType(0));
866 mlir::Value charLen = create<fir::UndefOp>(loc, getCharacterLengthType());
867 return fir::factory::createCharacterProcedureTuple(*this, loc, argTy, boxProc,
868 charLen);
869}
870
871void fir::FirOpBuilder::setCommonAttributes(mlir::Operation *op) const {
872 auto fmi = mlir::dyn_cast<mlir::arith::ArithFastMathInterface>(*op);
873 if (fmi) {
874 // TODO: use fmi.setFastMathFlagsAttr() after D137114 is merged.
875 // For now set the attribute by the name.
876 llvm::StringRef arithFMFAttrName = fmi.getFastMathAttrName();
877 if (fastMathFlags != mlir::arith::FastMathFlags::none)
878 op->setAttr(arithFMFAttrName, mlir::arith::FastMathFlagsAttr::get(
879 op->getContext(), fastMathFlags));
880 }
881 auto iofi =
882 mlir::dyn_cast<mlir::arith::ArithIntegerOverflowFlagsInterface>(*op);
883 if (iofi) {
884 llvm::StringRef arithIOFAttrName = iofi.getIntegerOverflowAttrName();
885 if (integerOverflowFlags != mlir::arith::IntegerOverflowFlags::none)
886 op->setAttr(arithIOFAttrName,
887 mlir::arith::IntegerOverflowFlagsAttr::get(
888 op->getContext(), integerOverflowFlags));
889 }
890}
891
892void fir::FirOpBuilder::setFastMathFlags(
893 Fortran::common::MathOptionsBase options) {
894 mlir::arith::FastMathFlags arithFMF{};
895 if (options.getFPContractEnabled()) {
896 arithFMF = arithFMF | mlir::arith::FastMathFlags::contract;
897 }
898 if (options.getNoHonorInfs()) {
899 arithFMF = arithFMF | mlir::arith::FastMathFlags::ninf;
900 }
901 if (options.getNoHonorNaNs()) {
902 arithFMF = arithFMF | mlir::arith::FastMathFlags::nnan;
903 }
904 if (options.getApproxFunc()) {
905 arithFMF = arithFMF | mlir::arith::FastMathFlags::afn;
906 }
907 if (options.getNoSignedZeros()) {
908 arithFMF = arithFMF | mlir::arith::FastMathFlags::nsz;
909 }
910 if (options.getAssociativeMath()) {
911 arithFMF = arithFMF | mlir::arith::FastMathFlags::reassoc;
912 }
913 if (options.getReciprocalMath()) {
914 arithFMF = arithFMF | mlir::arith::FastMathFlags::arcp;
915 }
916 setFastMathFlags(arithFMF);
917}
918
919// Construction of an mlir::DataLayout is expensive so only do it on demand and
920// memoise it in the builder instance
921mlir::DataLayout &fir::FirOpBuilder::getDataLayout() {
922 if (dataLayout)
923 return *dataLayout;
924 dataLayout = std::make_unique<mlir::DataLayout>(getModule());
925 return *dataLayout;
926}
927
928//===--------------------------------------------------------------------===//
929// ExtendedValue inquiry helper implementation
930//===--------------------------------------------------------------------===//
931
932mlir::Value fir::factory::readCharLen(fir::FirOpBuilder &builder,
933 mlir::Location loc,
934 const fir::ExtendedValue &box) {
935 return box.match(
936 [&](const fir::CharBoxValue &x) -> mlir::Value { return x.getLen(); },
937 [&](const fir::CharArrayBoxValue &x) -> mlir::Value {
938 return x.getLen();
939 },
940 [&](const fir::BoxValue &x) -> mlir::Value {
941 assert(x.isCharacter());
942 if (!x.getExplicitParameters().empty())
943 return x.getExplicitParameters()[0];
944 return fir::factory::CharacterExprHelper{builder, loc}
945 .readLengthFromBox(x.getAddr());
946 },
947 [&](const fir::MutableBoxValue &x) -> mlir::Value {
948 return readCharLen(builder, loc,
949 fir::factory::genMutableBoxRead(builder, loc, x));
950 },
951 [&](const auto &) -> mlir::Value {
952 fir::emitFatalError(
953 loc, "Character length inquiry on a non-character entity");
954 });
955}
956
957mlir::Value fir::factory::readExtent(fir::FirOpBuilder &builder,
958 mlir::Location loc,
959 const fir::ExtendedValue &box,
960 unsigned dim) {
961 assert(box.rank() > dim);
962 return box.match(
963 [&](const fir::ArrayBoxValue &x) -> mlir::Value {
964 return x.getExtents()[dim];
965 },
966 [&](const fir::CharArrayBoxValue &x) -> mlir::Value {
967 return x.getExtents()[dim];
968 },
969 [&](const fir::BoxValue &x) -> mlir::Value {
970 if (!x.getExplicitExtents().empty())
971 return x.getExplicitExtents()[dim];
972 auto idxTy = builder.getIndexType();
973 auto dimVal = builder.createIntegerConstant(loc, idxTy, dim);
974 return builder
975 .create<fir::BoxDimsOp>(loc, idxTy, idxTy, idxTy, x.getAddr(),
976 dimVal)
977 .getResult(1);
978 },
979 [&](const fir::MutableBoxValue &x) -> mlir::Value {
980 return readExtent(builder, loc,
981 fir::factory::genMutableBoxRead(builder, loc, x),
982 dim);
983 },
984 [&](const auto &) -> mlir::Value {
985 fir::emitFatalError(loc, "extent inquiry on scalar");
986 });
987}
988
989mlir::Value fir::factory::readLowerBound(fir::FirOpBuilder &builder,
990 mlir::Location loc,
991 const fir::ExtendedValue &box,
992 unsigned dim,
993 mlir::Value defaultValue) {
994 assert(box.rank() > dim);
995 auto lb = box.match(
996 [&](const fir::ArrayBoxValue &x) -> mlir::Value {
997 return x.getLBounds().empty() ? mlir::Value{} : x.getLBounds()[dim];
998 },
999 [&](const fir::CharArrayBoxValue &x) -> mlir::Value {
1000 return x.getLBounds().empty() ? mlir::Value{} : x.getLBounds()[dim];
1001 },
1002 [&](const fir::BoxValue &x) -> mlir::Value {
1003 return x.getLBounds().empty() ? mlir::Value{} : x.getLBounds()[dim];
1004 },
1005 [&](const fir::MutableBoxValue &x) -> mlir::Value {
1006 return readLowerBound(builder, loc,
1007 fir::factory::genMutableBoxRead(builder, loc, x),
1008 dim, defaultValue);
1009 },
1010 [&](const auto &) -> mlir::Value {
1011 fir::emitFatalError(loc, "lower bound inquiry on scalar");
1012 });
1013 if (lb)
1014 return lb;
1015 return defaultValue;
1016}
1017
1018llvm::SmallVector<mlir::Value>
1019fir::factory::readExtents(fir::FirOpBuilder &builder, mlir::Location loc,
1020 const fir::BoxValue &box) {
1021 llvm::SmallVector<mlir::Value> result;
1022 auto explicitExtents = box.getExplicitExtents();
1023 if (!explicitExtents.empty()) {
1024 result.append(explicitExtents.begin(), explicitExtents.end());
1025 return result;
1026 }
1027 auto rank = box.rank();
1028 auto idxTy = builder.getIndexType();
1029 for (decltype(rank) dim = 0; dim < rank; ++dim) {
1030 auto dimVal = builder.createIntegerConstant(loc, idxTy, dim);
1031 auto dimInfo = builder.create<fir::BoxDimsOp>(loc, idxTy, idxTy, idxTy,
1032 box.getAddr(), dimVal);
1033 result.emplace_back(dimInfo.getResult(1));
1034 }
1035 return result;
1036}
1037
1038llvm::SmallVector<mlir::Value>
1039fir::factory::getExtents(mlir::Location loc, fir::FirOpBuilder &builder,
1040 const fir::ExtendedValue &box) {
1041 return box.match(
1042 [&](const fir::ArrayBoxValue &x) -> llvm::SmallVector<mlir::Value> {
1043 return {x.getExtents().begin(), x.getExtents().end()};
1044 },
1045 [&](const fir::CharArrayBoxValue &x) -> llvm::SmallVector<mlir::Value> {
1046 return {x.getExtents().begin(), x.getExtents().end()};
1047 },
1048 [&](const fir::BoxValue &x) -> llvm::SmallVector<mlir::Value> {
1049 return fir::factory::readExtents(builder, loc, x);
1050 },
1051 [&](const fir::MutableBoxValue &x) -> llvm::SmallVector<mlir::Value> {
1052 auto load = fir::factory::genMutableBoxRead(builder, loc, x);
1053 return fir::factory::getExtents(loc, builder, load);
1054 },
1055 [&](const auto &) -> llvm::SmallVector<mlir::Value> { return {}; });
1056}
1057
1058fir::ExtendedValue fir::factory::readBoxValue(fir::FirOpBuilder &builder,
1059 mlir::Location loc,
1060 const fir::BoxValue &box) {
1061 assert(!box.hasAssumedRank() &&
1062 "cannot read unlimited polymorphic or assumed rank fir.box");
1063 auto addr =
1064 builder.create<fir::BoxAddrOp>(loc, box.getMemTy(), box.getAddr());
1065 if (box.isCharacter()) {
1066 auto len = fir::factory::readCharLen(builder, loc, box);
1067 if (box.rank() == 0)
1068 return fir::CharBoxValue(addr, len);
1069 return fir::CharArrayBoxValue(addr, len,
1070 fir::factory::readExtents(builder, loc, box),
1071 box.getLBounds());
1072 }
1073 if (box.isDerivedWithLenParameters())
1074 TODO(loc, "read fir.box with length parameters");
1075 mlir::Value sourceBox;
1076 if (box.isPolymorphic())
1077 sourceBox = box.getAddr();
1078 if (box.isPolymorphic() && box.rank() == 0)
1079 return fir::PolymorphicValue(addr, sourceBox);
1080 if (box.rank() == 0)
1081 return addr;
1082 return fir::ArrayBoxValue(addr, fir::factory::readExtents(builder, loc, box),
1083 box.getLBounds(), sourceBox);
1084}
1085
1086llvm::SmallVector<mlir::Value>
1087fir::factory::getNonDefaultLowerBounds(fir::FirOpBuilder &builder,
1088 mlir::Location loc,
1089 const fir::ExtendedValue &exv) {
1090 return exv.match(
1091 [&](const fir::ArrayBoxValue &array) -> llvm::SmallVector<mlir::Value> {
1092 return {array.getLBounds().begin(), array.getLBounds().end()};
1093 },
1094 [&](const fir::CharArrayBoxValue &array)
1095 -> llvm::SmallVector<mlir::Value> {
1096 return {array.getLBounds().begin(), array.getLBounds().end()};
1097 },
1098 [&](const fir::BoxValue &box) -> llvm::SmallVector<mlir::Value> {
1099 return {box.getLBounds().begin(), box.getLBounds().end()};
1100 },
1101 [&](const fir::MutableBoxValue &box) -> llvm::SmallVector<mlir::Value> {
1102 auto load = fir::factory::genMutableBoxRead(builder, loc, box);
1103 return fir::factory::getNonDefaultLowerBounds(builder, loc, load);
1104 },
1105 [&](const auto &) -> llvm::SmallVector<mlir::Value> { return {}; });
1106}
1107
1108llvm::SmallVector<mlir::Value>
1109fir::factory::getNonDeferredLenParams(const fir::ExtendedValue &exv) {
1110 return exv.match(
1111 [&](const fir::CharArrayBoxValue &character)
1112 -> llvm::SmallVector<mlir::Value> { return {character.getLen()}; },
1113 [&](const fir::CharBoxValue &character)
1114 -> llvm::SmallVector<mlir::Value> { return {character.getLen()}; },
1115 [&](const fir::MutableBoxValue &box) -> llvm::SmallVector<mlir::Value> {
1116 return {box.nonDeferredLenParams().begin(),
1117 box.nonDeferredLenParams().end()};
1118 },
1119 [&](const fir::BoxValue &box) -> llvm::SmallVector<mlir::Value> {
1120 return {box.getExplicitParameters().begin(),
1121 box.getExplicitParameters().end()};
1122 },
1123 [&](const auto &) -> llvm::SmallVector<mlir::Value> { return {}; });
1124}
1125
1126// If valTy is a box type, then we need to extract the type parameters from
1127// the box value.
1128static llvm::SmallVector<mlir::Value> getFromBox(mlir::Location loc,
1129 fir::FirOpBuilder &builder,
1130 mlir::Type valTy,
1131 mlir::Value boxVal) {
1132 if (auto boxTy = mlir::dyn_cast<fir::BaseBoxType>(valTy)) {
1133 auto eleTy = fir::unwrapAllRefAndSeqType(boxTy.getEleTy());
1134 if (auto recTy = mlir::dyn_cast<fir::RecordType>(eleTy)) {
1135 if (recTy.getNumLenParams() > 0) {
1136 // Walk each type parameter in the record and get the value.
1137 TODO(loc, "generate code to get LEN type parameters");
1138 }
1139 } else if (auto charTy = mlir::dyn_cast<fir::CharacterType>(eleTy)) {
1140 if (charTy.hasDynamicLen()) {
1141 auto idxTy = builder.getIndexType();
1142 auto eleSz = builder.create<fir::BoxEleSizeOp>(loc, idxTy, boxVal);
1143 auto kindBytes =
1144 builder.getKindMap().getCharacterBitsize(charTy.getFKind()) / 8;
1145 mlir::Value charSz =
1146 builder.createIntegerConstant(loc, idxTy, kindBytes);
1147 mlir::Value len =
1148 builder.create<mlir::arith::DivSIOp>(loc, eleSz, charSz);
1149 return {len};
1150 }
1151 }
1152 }
1153 return {};
1154}
1155
1156// fir::getTypeParams() will get the type parameters from the extended value.
1157// When the extended value is a BoxValue or MutableBoxValue, it may be necessary
1158// to generate code, so this factory function handles those cases.
1159// TODO: fix the inverted type tests, etc.
1160llvm::SmallVector<mlir::Value>
1161fir::factory::getTypeParams(mlir::Location loc, fir::FirOpBuilder &builder,
1162 const fir::ExtendedValue &exv) {
1163 auto handleBoxed = [&](const auto &box) -> llvm::SmallVector<mlir::Value> {
1164 if (box.isCharacter())
1165 return {fir::factory::readCharLen(builder, loc, exv)};
1166 if (box.isDerivedWithLenParameters()) {
1167 // This should generate code to read the type parameters from the box.
1168 // This requires some consideration however as MutableBoxValues need to be
1169 // in a sane state to be provide the correct values.
1170 TODO(loc, "derived type with type parameters");
1171 }
1172 return {};
1173 };
1174 // Intentionally reuse the original code path to get type parameters for the
1175 // cases that were supported rather than introduce a new path.
1176 return exv.match(
1177 [&](const fir::BoxValue &box) { return handleBoxed(box); },
1178 [&](const fir::MutableBoxValue &box) { return handleBoxed(box); },
1179 [&](const auto &) { return fir::getTypeParams(exv); });
1180}
1181
1182llvm::SmallVector<mlir::Value>
1183fir::factory::getTypeParams(mlir::Location loc, fir::FirOpBuilder &builder,
1184 fir::ArrayLoadOp load) {
1185 mlir::Type memTy = load.getMemref().getType();
1186 if (auto boxTy = mlir::dyn_cast<fir::BaseBoxType>(memTy))
1187 return getFromBox(loc, builder, boxTy, load.getMemref());
1188 return load.getTypeparams();
1189}
1190
1191std::string fir::factory::uniqueCGIdent(llvm::StringRef prefix,
1192 llvm::StringRef name) {
1193 // For "long" identifiers use a hash value
1194 if (name.size() > nameLengthHashSize) {
1195 llvm::MD5 hash;
1196 hash.update(name);
1197 llvm::MD5::MD5Result result;
1198 hash.final(result);
1199 llvm::SmallString<32> str;
1200 llvm::MD5::stringifyResult(result, str);
1201 std::string hashName = prefix.str();
1202 hashName.append("X").append(str.c_str());
1203 return fir::NameUniquer::doGenerated(hashName);
1204 }
1205 // "Short" identifiers use a reversible hex string
1206 std::string nm = prefix.str();
1207 return fir::NameUniquer::doGenerated(
1208 nm.append("X").append(llvm::toHex(name)));
1209}
1210
1211mlir::Value fir::factory::locationToFilename(fir::FirOpBuilder &builder,
1212 mlir::Location loc) {
1213 if (auto flc = mlir::dyn_cast<mlir::FileLineColLoc>(loc)) {
1214 // must be encoded as asciiz, C string
1215 auto fn = flc.getFilename().str() + '\0';
1216 return fir::getBase(createStringLiteral(builder, loc, fn));
1217 }
1218 return builder.createNullConstant(loc);
1219}
1220
1221mlir::Value fir::factory::locationToLineNo(fir::FirOpBuilder &builder,
1222 mlir::Location loc,
1223 mlir::Type type) {
1224 if (auto flc = mlir::dyn_cast<mlir::FileLineColLoc>(loc))
1225 return builder.createIntegerConstant(loc, type, flc.getLine());
1226 return builder.createIntegerConstant(loc, type, 0);
1227}
1228
1229fir::ExtendedValue fir::factory::createStringLiteral(fir::FirOpBuilder &builder,
1230 mlir::Location loc,
1231 llvm::StringRef str) {
1232 std::string globalName = fir::factory::uniqueCGIdent("cl", str);
1233 auto type = fir::CharacterType::get(builder.getContext(), 1, str.size());
1234 auto global = builder.getNamedGlobal(globalName);
1235 if (!global)
1236 global = builder.createGlobalConstant(
1237 loc, type, globalName,
1238 [&](fir::FirOpBuilder &builder) {
1239 auto stringLitOp = builder.createStringLitOp(loc, str);
1240 builder.create<fir::HasValueOp>(loc, stringLitOp);
1241 },
1242 builder.createLinkOnceLinkage());
1243 auto addr = builder.create<fir::AddrOfOp>(loc, global.resultType(),
1244 global.getSymbol());
1245 auto len = builder.createIntegerConstant(
1246 loc, builder.getCharacterLengthType(), str.size());
1247 return fir::CharBoxValue{addr, len};
1248}
1249
1250llvm::SmallVector<mlir::Value>
1251fir::factory::createExtents(fir::FirOpBuilder &builder, mlir::Location loc,
1252 fir::SequenceType seqTy) {
1253 llvm::SmallVector<mlir::Value> extents;
1254 auto idxTy = builder.getIndexType();
1255 for (auto ext : seqTy.getShape())
1256 extents.emplace_back(
1257 ext == fir::SequenceType::getUnknownExtent()
1258 ? builder.create<fir::UndefOp>(loc, idxTy).getResult()
1259 : builder.createIntegerConstant(loc, idxTy, ext));
1260 return extents;
1261}
1262
1263// FIXME: This needs some work. To correctly determine the extended value of a
1264// component, one needs the base object, its type, and its type parameters. (An
1265// alternative would be to provide an already computed address of the final
1266// component rather than the base object's address, the point being the result
1267// will require the address of the final component to create the extended
1268// value.) One further needs the full path of components being applied. One
1269// needs to apply type-based expressions to type parameters along this said
1270// path. (See applyPathToType for a type-only derivation.) Finally, one needs to
1271// compose the extended value of the terminal component, including all of its
1272// parameters: array lower bounds expressions, extents, type parameters, etc.
1273// Any of these properties may be deferred until runtime in Fortran. This
1274// operation may therefore generate a sizeable block of IR, including calls to
1275// type-based helper functions, so caching the result of this operation in the
1276// client would be advised as well.
1277fir::ExtendedValue fir::factory::componentToExtendedValue(
1278 fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value component) {
1279 auto fieldTy = component.getType();
1280 if (auto ty = fir::dyn_cast_ptrEleTy(fieldTy))
1281 fieldTy = ty;
1282 if (mlir::isa<fir::BaseBoxType>(fieldTy)) {
1283 llvm::SmallVector<mlir::Value> nonDeferredTypeParams;
1284 auto eleTy = fir::unwrapSequenceType(fir::dyn_cast_ptrOrBoxEleTy(fieldTy));
1285 if (auto charTy = mlir::dyn_cast<fir::CharacterType>(eleTy)) {
1286 auto lenTy = builder.getCharacterLengthType();
1287 if (charTy.hasConstantLen())
1288 nonDeferredTypeParams.emplace_back(
1289 builder.createIntegerConstant(loc, lenTy, charTy.getLen()));
1290 // TODO: Starting, F2003, the dynamic character length might be dependent
1291 // on a PDT length parameter. There is no way to make a difference with
1292 // deferred length here yet.
1293 }
1294 if (auto recTy = mlir::dyn_cast<fir::RecordType>(eleTy))
1295 if (recTy.getNumLenParams() > 0)
1296 TODO(loc, "allocatable and pointer components non deferred length "
1297 "parameters");
1298
1299 return fir::MutableBoxValue(component, nonDeferredTypeParams,
1300 /*mutableProperties=*/{});
1301 }
1302 llvm::SmallVector<mlir::Value> extents;
1303 if (auto seqTy = mlir::dyn_cast<fir::SequenceType>(fieldTy)) {
1304 fieldTy = seqTy.getEleTy();
1305 auto idxTy = builder.getIndexType();
1306 for (auto extent : seqTy.getShape()) {
1307 if (extent == fir::SequenceType::getUnknownExtent())
1308 TODO(loc, "array component shape depending on length parameters");
1309 extents.emplace_back(builder.createIntegerConstant(loc, idxTy, extent));
1310 }
1311 }
1312 if (auto charTy = mlir::dyn_cast<fir::CharacterType>(fieldTy)) {
1313 auto cstLen = charTy.getLen();
1314 if (cstLen == fir::CharacterType::unknownLen())
1315 TODO(loc, "get character component length from length type parameters");
1316 auto len = builder.createIntegerConstant(
1317 loc, builder.getCharacterLengthType(), cstLen);
1318 if (!extents.empty())
1319 return fir::CharArrayBoxValue{component, len, extents};
1320 return fir::CharBoxValue{component, len};
1321 }
1322 if (auto recordTy = mlir::dyn_cast<fir::RecordType>(fieldTy))
1323 if (recordTy.getNumLenParams() != 0)
1324 TODO(loc,
1325 "lower component ref that is a derived type with length parameter");
1326 if (!extents.empty())
1327 return fir::ArrayBoxValue{component, extents};
1328 return component;
1329}
1330
1331fir::ExtendedValue fir::factory::arrayElementToExtendedValue(
1332 fir::FirOpBuilder &builder, mlir::Location loc,
1333 const fir::ExtendedValue &array, mlir::Value element) {
1334 return array.match(
1335 [&](const fir::CharBoxValue &cb) -> fir::ExtendedValue {
1336 return cb.clone(element);
1337 },
1338 [&](const fir::CharArrayBoxValue &bv) -> fir::ExtendedValue {
1339 return bv.cloneElement(element);
1340 },
1341 [&](const fir::BoxValue &box) -> fir::ExtendedValue {
1342 if (box.isCharacter()) {
1343 auto len = fir::factory::readCharLen(builder, loc, box);
1344 return fir::CharBoxValue{element, len};
1345 }
1346 if (box.isDerivedWithLenParameters())
1347 TODO(loc, "get length parameters from derived type BoxValue");
1348 if (box.isPolymorphic()) {
1349 return fir::PolymorphicValue(element, fir::getBase(box));
1350 }
1351 return element;
1352 },
1353 [&](const fir::ArrayBoxValue &box) -> fir::ExtendedValue {
1354 if (box.getSourceBox())
1355 return fir::PolymorphicValue(element, box.getSourceBox());
1356 return element;
1357 },
1358 [&](const auto &) -> fir::ExtendedValue { return element; });
1359}
1360
1361fir::ExtendedValue fir::factory::arraySectionElementToExtendedValue(
1362 fir::FirOpBuilder &builder, mlir::Location loc,
1363 const fir::ExtendedValue &array, mlir::Value element, mlir::Value slice) {
1364 if (!slice)
1365 return arrayElementToExtendedValue(builder, loc, array, element);
1366 auto sliceOp = mlir::dyn_cast_or_null<fir::SliceOp>(slice.getDefiningOp());
1367 assert(sliceOp && "slice must be a sliceOp");
1368 if (sliceOp.getFields().empty())
1369 return arrayElementToExtendedValue(builder, loc, array, element);
1370 // For F95, using componentToExtendedValue will work, but when PDTs are
1371 // lowered. It will be required to go down the slice to propagate the length
1372 // parameters.
1373 return fir::factory::componentToExtendedValue(builder, loc, element);
1374}
1375
1376void fir::factory::genScalarAssignment(fir::FirOpBuilder &builder,
1377 mlir::Location loc,
1378 const fir::ExtendedValue &lhs,
1379 const fir::ExtendedValue &rhs,
1380 bool needFinalization,
1381 bool isTemporaryLHS) {
1382 assert(lhs.rank() == 0 && rhs.rank() == 0 && "must be scalars");
1383 auto type = fir::unwrapSequenceType(
1384 fir::unwrapPassByRefType(fir::getBase(lhs).getType()));
1385 if (mlir::isa<fir::CharacterType>(type)) {
1386 const fir::CharBoxValue *toChar = lhs.getCharBox();
1387 const fir::CharBoxValue *fromChar = rhs.getCharBox();
1388 assert(toChar && fromChar);
1389 fir::factory::CharacterExprHelper helper{builder, loc};
1390 helper.createAssign(fir::ExtendedValue{*toChar},
1391 fir::ExtendedValue{*fromChar});
1392 } else if (mlir::isa<fir::RecordType>(type)) {
1393 fir::factory::genRecordAssignment(builder, loc, lhs, rhs, needFinalization,
1394 isTemporaryLHS);
1395 } else {
1396 assert(!fir::hasDynamicSize(type));
1397 auto rhsVal = fir::getBase(rhs);
1398 if (fir::isa_ref_type(rhsVal.getType()))
1399 rhsVal = builder.create<fir::LoadOp>(loc, rhsVal);
1400 mlir::Value lhsAddr = fir::getBase(lhs);
1401 rhsVal = builder.createConvert(loc, fir::unwrapRefType(lhsAddr.getType()),
1402 rhsVal);
1403 builder.create<fir::StoreOp>(loc, rhsVal, lhsAddr);
1404 }
1405}
1406
1407static void genComponentByComponentAssignment(fir::FirOpBuilder &builder,
1408 mlir::Location loc,
1409 const fir::ExtendedValue &lhs,
1410 const fir::ExtendedValue &rhs,
1411 bool isTemporaryLHS) {
1412 auto lbaseType = fir::unwrapPassByRefType(fir::getBase(lhs).getType());
1413 auto lhsType = mlir::dyn_cast<fir::RecordType>(lbaseType);
1414 assert(lhsType && "lhs must be a scalar record type");
1415 auto rbaseType = fir::unwrapPassByRefType(fir::getBase(rhs).getType());
1416 auto rhsType = mlir::dyn_cast<fir::RecordType>(rbaseType);
1417 assert(rhsType && "rhs must be a scalar record type");
1418 auto fieldIndexType = fir::FieldType::get(lhsType.getContext());
1419 for (auto [lhsPair, rhsPair] :
1420 llvm::zip(lhsType.getTypeList(), rhsType.getTypeList())) {
1421 auto &[lFieldName, lFieldTy] = lhsPair;
1422 auto &[rFieldName, rFieldTy] = rhsPair;
1423 assert(!fir::hasDynamicSize(lFieldTy) && !fir::hasDynamicSize(rFieldTy));
1424 mlir::Value rField = builder.create<fir::FieldIndexOp>(
1425 loc, fieldIndexType, rFieldName, rhsType, fir::getTypeParams(rhs));
1426 auto rFieldRefType = builder.getRefType(rFieldTy);
1427 mlir::Value fromCoor = builder.create<fir::CoordinateOp>(
1428 loc, rFieldRefType, fir::getBase(rhs), rField);
1429 mlir::Value field = builder.create<fir::FieldIndexOp>(
1430 loc, fieldIndexType, lFieldName, lhsType, fir::getTypeParams(lhs));
1431 auto fieldRefType = builder.getRefType(lFieldTy);
1432 mlir::Value toCoor = builder.create<fir::CoordinateOp>(
1433 loc, fieldRefType, fir::getBase(lhs), field);
1434 std::optional<fir::DoLoopOp> outerLoop;
1435 if (auto sequenceType = mlir::dyn_cast<fir::SequenceType>(lFieldTy)) {
1436 // Create loops to assign array components elements by elements.
1437 // Note that, since these are components, they either do not overlap,
1438 // or are the same and exactly overlap. They also have compile time
1439 // constant shapes.
1440 mlir::Type idxTy = builder.getIndexType();
1441 llvm::SmallVector<mlir::Value> indices;
1442 mlir::Value zero = builder.createIntegerConstant(loc, idxTy, 0);
1443 mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
1444 for (auto extent : llvm::reverse(sequenceType.getShape())) {
1445 // TODO: add zero size test !
1446 mlir::Value ub = builder.createIntegerConstant(loc, idxTy, extent - 1);
1447 auto loop = builder.create<fir::DoLoopOp>(loc, zero, ub, one);
1448 if (!outerLoop)
1449 outerLoop = loop;
1450 indices.push_back(loop.getInductionVar());
1451 builder.setInsertionPointToStart(loop.getBody());
1452 }
1453 // Set indices in column-major order.
1454 std::reverse(indices.begin(), indices.end());
1455 auto elementRefType = builder.getRefType(sequenceType.getEleTy());
1456 toCoor = builder.create<fir::CoordinateOp>(loc, elementRefType, toCoor,
1457 indices);
1458 fromCoor = builder.create<fir::CoordinateOp>(loc, elementRefType,
1459 fromCoor, indices);
1460 }
1461 if (auto fieldEleTy = fir::unwrapSequenceType(lFieldTy);
1462 mlir::isa<fir::BaseBoxType>(fieldEleTy)) {
1463 assert(mlir::isa<fir::PointerType>(
1464 mlir::cast<fir::BaseBoxType>(fieldEleTy).getEleTy()) &&
1465 "allocatable members require deep copy");
1466 auto fromPointerValue = builder.create<fir::LoadOp>(loc, fromCoor);
1467 auto castTo = builder.createConvert(loc, fieldEleTy, fromPointerValue);
1468 builder.create<fir::StoreOp>(loc, castTo, toCoor);
1469 } else {
1470 auto from =
1471 fir::factory::componentToExtendedValue(builder, loc, fromCoor);
1472 auto to = fir::factory::componentToExtendedValue(builder, loc, toCoor);
1473 // If LHS finalization is needed it is expected to be done
1474 // for the parent record, so that component-by-component
1475 // assignments may avoid finalization calls.
1476 fir::factory::genScalarAssignment(builder, loc, to, from,
1477 /*needFinalization=*/false,
1478 isTemporaryLHS);
1479 }
1480 if (outerLoop)
1481 builder.setInsertionPointAfter(*outerLoop);
1482 }
1483}
1484
1485/// Can the assignment of this record type be implement with a simple memory
1486/// copy (it requires no deep copy or user defined assignment of components )?
1487static bool recordTypeCanBeMemCopied(fir::RecordType recordType) {
1488 // c_devptr type is a special case. It has a nested c_ptr field but we know it
1489 // can be copied directly.
1490 if (fir::isa_builtin_c_devptr_type(recordType))
1491 return true;
1492 if (fir::hasDynamicSize(recordType))
1493 return false;
1494 for (auto [_, fieldType] : recordType.getTypeList()) {
1495 // Derived type component may have user assignment (so far, we cannot tell
1496 // in FIR, so assume it is always the case, TODO: get the actual info).
1497 if (mlir::isa<fir::RecordType>(fir::unwrapSequenceType(fieldType)) &&
1498 !fir::isa_builtin_c_devptr_type(fir::unwrapSequenceType(fieldType)))
1499 return false;
1500 // Allocatable components need deep copy.
1501 if (auto boxType = mlir::dyn_cast<fir::BaseBoxType>(fieldType))
1502 if (mlir::isa<fir::HeapType>(boxType.getEleTy()))
1503 return false;
1504 }
1505 // Constant size components without user defined assignment and pointers can
1506 // be memcopied.
1507 return true;
1508}
1509
1510static bool mayHaveFinalizer(fir::RecordType recordType,
1511 fir::FirOpBuilder &builder) {
1512 if (auto typeInfo = builder.getModule().lookupSymbol<fir::TypeInfoOp>(
1513 recordType.getName()))
1514 return !typeInfo.getNoFinal();
1515 // No info, be pessimistic.
1516 return true;
1517}
1518
1519void fir::factory::genRecordAssignment(fir::FirOpBuilder &builder,
1520 mlir::Location loc,
1521 const fir::ExtendedValue &lhs,
1522 const fir::ExtendedValue &rhs,
1523 bool needFinalization,
1524 bool isTemporaryLHS) {
1525 assert(lhs.rank() == 0 && rhs.rank() == 0 && "assume scalar assignment");
1526 auto baseTy = fir::dyn_cast_ptrOrBoxEleTy(fir::getBase(lhs).getType());
1527 assert(baseTy && "must be a memory type");
1528 // Box operands may be polymorphic, it is not entirely clear from 10.2.1.3
1529 // if the assignment is performed on the dynamic of declared type. Use the
1530 // runtime assuming it is performed on the dynamic type.
1531 bool hasBoxOperands =
1532 mlir::isa<fir::BaseBoxType>(fir::getBase(lhs).getType()) ||
1533 mlir::isa<fir::BaseBoxType>(fir::getBase(rhs).getType());
1534 auto recTy = mlir::dyn_cast<fir::RecordType>(baseTy);
1535 assert(recTy && "must be a record type");
1536 if ((needFinalization && mayHaveFinalizer(recTy, builder)) ||
1537 hasBoxOperands || !recordTypeCanBeMemCopied(recTy)) {
1538 auto to = fir::getBase(builder.createBox(loc, lhs));
1539 auto from = fir::getBase(builder.createBox(loc, rhs));
1540 // The runtime entry point may modify the LHS descriptor if it is
1541 // an allocatable. Allocatable assignment is handle elsewhere in lowering,
1542 // so just create a fir.ref<fir.box<>> from the fir.box to comply with the
1543 // runtime interface, but assume the fir.box is unchanged.
1544 // TODO: does this holds true with polymorphic entities ?
1545 auto toMutableBox = builder.createTemporary(loc, to.getType());
1546 builder.create<fir::StoreOp>(loc, to, toMutableBox);
1547 if (isTemporaryLHS)
1548 fir::runtime::genAssignTemporary(builder, loc, toMutableBox, from);
1549 else
1550 fir::runtime::genAssign(builder, loc, toMutableBox, from);
1551 return;
1552 }
1553
1554 // Otherwise, the derived type has compile time constant size and for which
1555 // the component by component assignment can be replaced by a memory copy.
1556 // Since we do not know the size of the derived type in lowering, do a
1557 // component by component assignment. Note that a single fir.load/fir.store
1558 // could be used on "small" record types, but as the type size grows, this
1559 // leads to issues in LLVM (long compile times, long IR files, and even
1560 // asserts at some point). Since there is no good size boundary, just always
1561 // use component by component assignment here.
1562 genComponentByComponentAssignment(builder, loc, lhs, rhs, isTemporaryLHS);
1563}
1564
1565mlir::TupleType
1566fir::factory::getRaggedArrayHeaderType(fir::FirOpBuilder &builder) {
1567 mlir::IntegerType i64Ty = builder.getIntegerType(64);
1568 auto arrTy = fir::SequenceType::get(builder.getIntegerType(8), 1);
1569 auto buffTy = fir::HeapType::get(arrTy);
1570 auto extTy = fir::SequenceType::get(i64Ty, 1);
1571 auto shTy = fir::HeapType::get(extTy);
1572 return mlir::TupleType::get(builder.getContext(), {i64Ty, buffTy, shTy});
1573}
1574
1575mlir::Value fir::factory::genLenOfCharacter(
1576 fir::FirOpBuilder &builder, mlir::Location loc, fir::ArrayLoadOp arrLoad,
1577 llvm::ArrayRef<mlir::Value> path, llvm::ArrayRef<mlir::Value> substring) {
1578 llvm::SmallVector<mlir::Value> typeParams(arrLoad.getTypeparams());
1579 return genLenOfCharacter(builder, loc,
1580 mlir::cast<fir::SequenceType>(arrLoad.getType()),
1581 arrLoad.getMemref(), typeParams, path, substring);
1582}
1583
1584mlir::Value fir::factory::genLenOfCharacter(
1585 fir::FirOpBuilder &builder, mlir::Location loc, fir::SequenceType seqTy,
1586 mlir::Value memref, llvm::ArrayRef<mlir::Value> typeParams,
1587 llvm::ArrayRef<mlir::Value> path, llvm::ArrayRef<mlir::Value> substring) {
1588 auto idxTy = builder.getIndexType();
1589 auto zero = builder.createIntegerConstant(loc, idxTy, 0);
1590 auto saturatedDiff = [&](mlir::Value lower, mlir::Value upper) {
1591 auto diff = builder.create<mlir::arith::SubIOp>(loc, upper, lower);
1592 auto one = builder.createIntegerConstant(loc, idxTy, 1);
1593 auto size = builder.create<mlir::arith::AddIOp>(loc, diff, one);
1594 auto cmp = builder.create<mlir::arith::CmpIOp>(
1595 loc, mlir::arith::CmpIPredicate::sgt, size, zero);
1596 return builder.create<mlir::arith::SelectOp>(loc, cmp, size, zero);
1597 };
1598 if (substring.size() == 2) {
1599 auto upper = builder.createConvert(loc, idxTy, substring.back());
1600 auto lower = builder.createConvert(loc, idxTy, substring.front());
1601 return saturatedDiff(lower, upper);
1602 }
1603 auto lower = zero;
1604 if (substring.size() == 1)
1605 lower = builder.createConvert(loc, idxTy, substring.front());
1606 auto eleTy = fir::applyPathToType(seqTy, path);
1607 if (!fir::hasDynamicSize(eleTy)) {
1608 if (auto charTy = mlir::dyn_cast<fir::CharacterType>(eleTy)) {
1609 // Use LEN from the type.
1610 return builder.createIntegerConstant(loc, idxTy, charTy.getLen());
1611 }
1612 // Do we need to support !fir.array<!fir.char<k,n>>?
1613 fir::emitFatalError(loc,
1614 "application of path did not result in a !fir.char");
1615 }
1616 if (fir::isa_box_type(memref.getType())) {
1617 if (mlir::isa<fir::BoxCharType>(memref.getType()))
1618 return builder.create<fir::BoxCharLenOp>(loc, idxTy, memref);
1619 if (mlir::isa<fir::BoxType>(memref.getType()))
1620 return CharacterExprHelper(builder, loc).readLengthFromBox(memref);
1621 fir::emitFatalError(loc, "memref has wrong type");
1622 }
1623 if (typeParams.empty()) {
1624 fir::emitFatalError(loc, "array_load must have typeparams");
1625 }
1626 if (fir::isa_char(seqTy.getEleTy())) {
1627 assert(typeParams.size() == 1 && "too many typeparams");
1628 return typeParams.front();
1629 }
1630 TODO(loc, "LEN of character must be computed at runtime");
1631}
1632
1633mlir::Value fir::factory::createZeroValue(fir::FirOpBuilder &builder,
1634 mlir::Location loc, mlir::Type type) {
1635 mlir::Type i1 = builder.getIntegerType(1);
1636 if (mlir::isa<fir::LogicalType>(type) || type == i1)
1637 return builder.createConvert(loc, type, builder.createBool(loc, false));
1638 if (fir::isa_integer(type))
1639 return builder.createIntegerConstant(loc, type, 0);
1640 if (fir::isa_real(type))
1641 return builder.createRealZeroConstant(loc, type);
1642 if (fir::isa_complex(type)) {
1643 fir::factory::Complex complexHelper(builder, loc);
1644 mlir::Type partType = complexHelper.getComplexPartType(type);
1645 mlir::Value zeroPart = builder.createRealZeroConstant(loc, partType);
1646 return complexHelper.createComplex(type, zeroPart, zeroPart);
1647 }
1648 fir::emitFatalError(loc, "internal: trying to generate zero value of non "
1649 "numeric or logical type");
1650}
1651
1652std::optional<std::int64_t>
1653fir::factory::getExtentFromTriplet(mlir::Value lb, mlir::Value ub,
1654 mlir::Value stride) {
1655 std::function<std::optional<std::int64_t>(mlir::Value)> getConstantValue =
1656 [&](mlir::Value value) -> std::optional<std::int64_t> {
1657 if (auto valInt = fir::getIntIfConstant(value))
1658 return *valInt;
1659 auto *definingOp = value.getDefiningOp();
1660 if (mlir::isa_and_nonnull<fir::ConvertOp>(definingOp)) {
1661 auto valOp = mlir::dyn_cast<fir::ConvertOp>(definingOp);
1662 return getConstantValue(valOp.getValue());
1663 }
1664 return {};
1665 };
1666 if (auto lbInt = getConstantValue(lb)) {
1667 if (auto ubInt = getConstantValue(ub)) {
1668 if (auto strideInt = getConstantValue(stride)) {
1669 if (*strideInt != 0) {
1670 std::int64_t extent = 1 + (*ubInt - *lbInt) / *strideInt;
1671 if (extent > 0)
1672 return extent;
1673 }
1674 }
1675 }
1676 }
1677 return {};
1678}
1679
1680mlir::Value fir::factory::genMaxWithZero(fir::FirOpBuilder &builder,
1681 mlir::Location loc, mlir::Value value,
1682 mlir::Value zero) {
1683 if (mlir::Operation *definingOp = value.getDefiningOp())
1684 if (auto cst = mlir::dyn_cast<mlir::arith::ConstantOp>(definingOp))
1685 if (auto intAttr = mlir::dyn_cast<mlir::IntegerAttr>(cst.getValue()))
1686 return intAttr.getInt() > 0 ? value : zero;
1687 mlir::Value valueIsGreater = builder.create<mlir::arith::CmpIOp>(
1688 loc, mlir::arith::CmpIPredicate::sgt, value, zero);
1689 return builder.create<mlir::arith::SelectOp>(loc, valueIsGreater, value,
1690 zero);
1691}
1692
1693mlir::Value fir::factory::genMaxWithZero(fir::FirOpBuilder &builder,
1694 mlir::Location loc,
1695 mlir::Value value) {
1696 mlir::Value zero = builder.createIntegerConstant(loc, value.getType(), 0);
1697 return genMaxWithZero(builder, loc, value, zero);
1698}
1699
1700mlir::Value fir::factory::computeExtent(fir::FirOpBuilder &builder,
1701 mlir::Location loc, mlir::Value lb,
1702 mlir::Value ub, mlir::Value zero,
1703 mlir::Value one) {
1704 mlir::Type type = lb.getType();
1705 // Let the folder deal with the common `ub - <const> + 1` case.
1706 auto diff = builder.create<mlir::arith::SubIOp>(loc, type, ub, lb);
1707 auto rawExtent = builder.create<mlir::arith::AddIOp>(loc, type, diff, one);
1708 return fir::factory::genMaxWithZero(builder, loc, rawExtent, zero);
1709}
1710mlir::Value fir::factory::computeExtent(fir::FirOpBuilder &builder,
1711 mlir::Location loc, mlir::Value lb,
1712 mlir::Value ub) {
1713 mlir::Type type = lb.getType();
1714 mlir::Value one = builder.createIntegerConstant(loc, type, 1);
1715 mlir::Value zero = builder.createIntegerConstant(loc, type, 0);
1716 return computeExtent(builder, loc, lb, ub, zero, one);
1717}
1718
1719static std::pair<mlir::Value, mlir::Type>
1720genCPtrOrCFunptrFieldIndex(fir::FirOpBuilder &builder, mlir::Location loc,
1721 mlir::Type cptrTy) {
1722 auto recTy = mlir::cast<fir::RecordType>(cptrTy);
1723 assert(recTy.getTypeList().size() == 1);
1724 auto addrFieldName = recTy.getTypeList()[0].first;
1725 mlir::Type addrFieldTy = recTy.getTypeList()[0].second;
1726 auto fieldIndexType = fir::FieldType::get(cptrTy.getContext());
1727 mlir::Value addrFieldIndex = builder.create<fir::FieldIndexOp>(
1728 loc, fieldIndexType, addrFieldName, recTy,
1729 /*typeParams=*/mlir::ValueRange{});
1730 return {addrFieldIndex, addrFieldTy};
1731}
1732
1733mlir::Value fir::factory::genCPtrOrCFunptrAddr(fir::FirOpBuilder &builder,
1734 mlir::Location loc,
1735 mlir::Value cPtr,
1736 mlir::Type ty) {
1737 auto [addrFieldIndex, addrFieldTy] =
1738 genCPtrOrCFunptrFieldIndex(builder, loc, ty);
1739 return builder.create<fir::CoordinateOp>(loc, builder.getRefType(addrFieldTy),
1740 cPtr, addrFieldIndex);
1741}
1742
1743mlir::Value fir::factory::genCDevPtrAddr(fir::FirOpBuilder &builder,
1744 mlir::Location loc,
1745 mlir::Value cDevPtr, mlir::Type ty) {
1746 auto recTy = mlir::cast<fir::RecordType>(ty);
1747 assert(recTy.getTypeList().size() == 1);
1748 auto cptrFieldName = recTy.getTypeList()[0].first;
1749 mlir::Type cptrFieldTy = recTy.getTypeList()[0].second;
1750 auto fieldIndexType = fir::FieldType::get(ty.getContext());
1751 mlir::Value cptrFieldIndex = builder.create<fir::FieldIndexOp>(
1752 loc, fieldIndexType, cptrFieldName, recTy,
1753 /*typeParams=*/mlir::ValueRange{});
1754 auto cptrCoord = builder.create<fir::CoordinateOp>(
1755 loc, builder.getRefType(cptrFieldTy), cDevPtr, cptrFieldIndex);
1756 auto [addrFieldIndex, addrFieldTy] =
1757 genCPtrOrCFunptrFieldIndex(builder, loc, cptrFieldTy);
1758 return builder.create<fir::CoordinateOp>(loc, builder.getRefType(addrFieldTy),
1759 cptrCoord, addrFieldIndex);
1760}
1761
1762mlir::Value fir::factory::genCPtrOrCFunptrValue(fir::FirOpBuilder &builder,
1763 mlir::Location loc,
1764 mlir::Value cPtr) {
1765 mlir::Type cPtrTy = fir::unwrapRefType(cPtr.getType());
1766 if (fir::isa_builtin_cdevptr_type(cPtrTy)) {
1767 // Unwrap c_ptr from c_devptr.
1768 auto [addrFieldIndex, addrFieldTy] =
1769 genCPtrOrCFunptrFieldIndex(builder, loc, cPtrTy);
1770 mlir::Value cPtrCoor;
1771 if (fir::isa_ref_type(cPtr.getType())) {
1772 cPtrCoor = builder.create<fir::CoordinateOp>(
1773 loc, builder.getRefType(addrFieldTy), cPtr, addrFieldIndex);
1774 } else {
1775 auto arrayAttr = builder.getArrayAttr(
1776 {builder.getIntegerAttr(builder.getIndexType(), 0)});
1777 cPtrCoor = builder.create<fir::ExtractValueOp>(loc, addrFieldTy, cPtr,
1778 arrayAttr);
1779 }
1780 return genCPtrOrCFunptrValue(builder, loc, cPtrCoor);
1781 }
1782
1783 if (fir::isa_ref_type(cPtr.getType())) {
1784 mlir::Value cPtrAddr =
1785 fir::factory::genCPtrOrCFunptrAddr(builder, loc, cPtr, cPtrTy);
1786 return builder.create<fir::LoadOp>(loc, cPtrAddr);
1787 }
1788 auto [addrFieldIndex, addrFieldTy] =
1789 genCPtrOrCFunptrFieldIndex(builder, loc, cPtrTy);
1790 auto arrayAttr =
1791 builder.getArrayAttr({builder.getIntegerAttr(builder.getIndexType(), 0)});
1792 return builder.create<fir::ExtractValueOp>(loc, addrFieldTy, cPtr, arrayAttr);
1793}
1794
1795fir::BoxValue fir::factory::createBoxValue(fir::FirOpBuilder &builder,
1796 mlir::Location loc,
1797 const fir::ExtendedValue &exv) {
1798 if (auto *boxValue = exv.getBoxOf<fir::BoxValue>())
1799 return *boxValue;
1800 mlir::Value box = builder.createBox(loc, exv);
1801 llvm::SmallVector<mlir::Value> lbounds;
1802 llvm::SmallVector<mlir::Value> explicitTypeParams;
1803 exv.match(
1804 [&](const fir::ArrayBoxValue &box) {
1805 lbounds.append(box.getLBounds().begin(), box.getLBounds().end());
1806 },
1807 [&](const fir::CharArrayBoxValue &box) {
1808 lbounds.append(box.getLBounds().begin(), box.getLBounds().end());
1809 explicitTypeParams.emplace_back(box.getLen());
1810 },
1811 [&](const fir::CharBoxValue &box) {
1812 explicitTypeParams.emplace_back(box.getLen());
1813 },
1814 [&](const fir::MutableBoxValue &x) {
1815 if (x.rank() > 0) {
1816 // The resulting box lbounds must be coming from the mutable box.
1817 fir::ExtendedValue boxVal =
1818 fir::factory::genMutableBoxRead(builder, loc, x);
1819 // Make sure we do not recurse infinitely.
1820 if (boxVal.getBoxOf<fir::MutableBoxValue>())
1821 fir::emitFatalError(loc, "mutable box read cannot be mutable box");
1822 fir::BoxValue box =
1823 fir::factory::createBoxValue(builder, loc, boxVal);
1824 lbounds.append(box.getLBounds().begin(), box.getLBounds().end());
1825 }
1826 explicitTypeParams.append(x.nonDeferredLenParams().begin(),
1827 x.nonDeferredLenParams().end());
1828 },
1829 [](const auto &) {});
1830 return fir::BoxValue(box, lbounds, explicitTypeParams);
1831}
1832
1833mlir::Value fir::factory::createNullBoxProc(fir::FirOpBuilder &builder,
1834 mlir::Location loc,
1835 mlir::Type boxType) {
1836 auto boxTy{mlir::dyn_cast<fir::BoxProcType>(boxType)};
1837 if (!boxTy)
1838 fir::emitFatalError(loc, "Procedure pointer must be of BoxProcType");
1839 auto boxEleTy{fir::unwrapRefType(boxTy.getEleTy())};
1840 mlir::Value initVal{builder.create<fir::ZeroOp>(loc, boxEleTy)};
1841 return builder.create<fir::EmboxProcOp>(loc, boxTy, initVal);
1842}
1843
1844void fir::factory::setInternalLinkage(mlir::func::FuncOp func) {
1845 auto internalLinkage = mlir::LLVM::linkage::Linkage::Internal;
1846 auto linkage =
1847 mlir::LLVM::LinkageAttr::get(func->getContext(), internalLinkage);
1848 func->setAttr("llvm.linkage", linkage);
1849}
1850
1851uint64_t
1852fir::factory::getAllocaAddressSpace(const mlir::DataLayout *dataLayout) {
1853 if (dataLayout)
1854 if (mlir::Attribute addrSpace = dataLayout->getAllocaMemorySpace())
1855 return mlir::cast<mlir::IntegerAttr>(addrSpace).getUInt();
1856 return 0;
1857}
1858
1859llvm::SmallVector<mlir::Value>
1860fir::factory::deduceOptimalExtents(mlir::ValueRange extents1,
1861 mlir::ValueRange extents2) {
1862 llvm::SmallVector<mlir::Value> extents;
1863 extents.reserve(extents1.size());
1864 for (auto [extent1, extent2] : llvm::zip(extents1, extents2)) {
1865 if (!fir::getIntIfConstant(extent1) && fir::getIntIfConstant(extent2))
1866 extents.push_back(extent2);
1867 else
1868 extents.push_back(extent1);
1869 }
1870 return extents;
1871}
1872
1873uint64_t fir::factory::getGlobalAddressSpace(mlir::DataLayout *dataLayout) {
1874 if (dataLayout)
1875 if (mlir::Attribute addrSpace = dataLayout->getGlobalMemorySpace())
1876 return mlir::cast<mlir::IntegerAttr>(addrSpace).getUInt();
1877 return 0;
1878}
1879
1880uint64_t fir::factory::getProgramAddressSpace(mlir::DataLayout *dataLayout) {
1881 if (dataLayout)
1882 if (mlir::Attribute addrSpace = dataLayout->getProgramMemorySpace())
1883 return mlir::cast<mlir::IntegerAttr>(addrSpace).getUInt();
1884 return 0;
1885}
1886
1887llvm::SmallVector<mlir::Value> fir::factory::updateRuntimeExtentsForEmptyArrays(
1888 fir::FirOpBuilder &builder, mlir::Location loc, mlir::ValueRange extents) {
1889 if (extents.size() <= 1)
1890 return extents;
1891
1892 mlir::Type i1Type = builder.getI1Type();
1893 mlir::Value isEmpty = createZeroValue(builder, loc, i1Type);
1894
1895 llvm::SmallVector<mlir::Value, Fortran::common::maxRank> zeroes;
1896 for (mlir::Value extent : extents) {
1897 mlir::Type type = extent.getType();
1898 mlir::Value zero = createZeroValue(builder, loc, type);
1899 zeroes.push_back(zero);
1900 mlir::Value isZero = builder.create<mlir::arith::CmpIOp>(
1901 loc, mlir::arith::CmpIPredicate::eq, extent, zero);
1902 isEmpty = builder.create<mlir::arith::OrIOp>(loc, isEmpty, isZero);
1903 }
1904
1905 llvm::SmallVector<mlir::Value> newExtents;
1906 for (auto [zero, extent] : llvm::zip_equal(zeroes, extents)) {
1907 newExtents.push_back(
1908 builder.create<mlir::arith::SelectOp>(loc, isEmpty, zero, extent));
1909 }
1910 return newExtents;
1911}
1912
1913void fir::factory::genDimInfoFromBox(
1914 fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value box,
1915 llvm::SmallVectorImpl<mlir::Value> *lbounds,
1916 llvm::SmallVectorImpl<mlir::Value> *extents,
1917 llvm::SmallVectorImpl<mlir::Value> *strides) {
1918 auto boxType = mlir::dyn_cast<fir::BaseBoxType>(box.getType());
1919 assert(boxType && "must be a box");
1920 if (!lbounds && !extents && !strides)
1921 return;
1922
1923 unsigned rank = fir::getBoxRank(boxType);
1924 assert(rank != 0 && "must be an array of known rank");
1925 mlir::Type idxTy = builder.getIndexType();
1926 for (unsigned i = 0; i < rank; ++i) {
1927 mlir::Value dim = builder.createIntegerConstant(loc, idxTy, i);
1928 auto dimInfo =
1929 builder.create<fir::BoxDimsOp>(loc, idxTy, idxTy, idxTy, box, dim);
1930 if (lbounds)
1931 lbounds->push_back(dimInfo.getLowerBound());
1932 if (extents)
1933 extents->push_back(dimInfo.getExtent());
1934 if (strides)
1935 strides->push_back(dimInfo.getByteStride());
1936 }
1937}
1938
1939mlir::Value fir::factory::genLifetimeStart(mlir::OpBuilder &builder,
1940 mlir::Location loc,
1941 fir::AllocaOp alloc, int64_t size,
1942 const mlir::DataLayout *dl) {
1943 mlir::Type ptrTy = mlir::LLVM::LLVMPointerType::get(
1944 alloc.getContext(), getAllocaAddressSpace(dl));
1945 mlir::Value cast =
1946 builder.create<fir::ConvertOp>(loc, ptrTy, alloc.getResult());
1947 builder.create<mlir::LLVM::LifetimeStartOp>(loc, size, cast);
1948 return cast;
1949}
1950
1951void fir::factory::genLifetimeEnd(mlir::OpBuilder &builder, mlir::Location loc,
1952 mlir::Value cast, int64_t size) {
1953 builder.create<mlir::LLVM::LifetimeEndOp>(loc, size, cast);
1954}
1955

source code of flang/lib/Optimizer/Builder/FIRBuilder.cpp