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

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