1 //===-- ConvertVariable.cpp -- bridge to lower to MLIR --------------------===// 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 // Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ 10 // 11 //===----------------------------------------------------------------------===// 12 13 #include "flang/Lower/ConvertVariable.h" 14 #include "flang/Lower/AbstractConverter.h" 15 #include "flang/Lower/Allocatable.h" 16 #include "flang/Lower/BoxAnalyzer.h" 17 #include "flang/Lower/CallInterface.h" 18 #include "flang/Lower/ConvertExpr.h" 19 #include "flang/Lower/Mangler.h" 20 #include "flang/Lower/PFTBuilder.h" 21 #include "flang/Lower/StatementContext.h" 22 #include "flang/Lower/Support/Utils.h" 23 #include "flang/Lower/SymbolMap.h" 24 #include "flang/Lower/Todo.h" 25 #include "flang/Optimizer/Builder/Character.h" 26 #include "flang/Optimizer/Builder/FIRBuilder.h" 27 #include "flang/Optimizer/Builder/Runtime/Derived.h" 28 #include "flang/Optimizer/Dialect/FIRAttr.h" 29 #include "flang/Optimizer/Dialect/FIRDialect.h" 30 #include "flang/Optimizer/Dialect/FIROps.h" 31 #include "flang/Optimizer/Support/FIRContext.h" 32 #include "flang/Optimizer/Support/FatalError.h" 33 #include "flang/Semantics/tools.h" 34 #include "llvm/Support/Debug.h" 35 36 #define DEBUG_TYPE "flang-lower-variable" 37 38 /// Helper to retrieve a copy of a character literal string from a SomeExpr. 39 /// Required to build character global initializers. 40 template <int KIND> 41 static llvm::Optional<std::tuple<std::string, std::size_t>> 42 getCharacterLiteralCopy( 43 const Fortran::evaluate::Expr< 44 Fortran::evaluate::Type<Fortran::common::TypeCategory::Character, KIND>> 45 &x) { 46 if (const auto *con = 47 Fortran::evaluate::UnwrapConstantValue<Fortran::evaluate::Type< 48 Fortran::common::TypeCategory::Character, KIND>>(x)) 49 if (auto val = con->GetScalarValue()) 50 return std::tuple<std::string, std::size_t>{ 51 std::string{(const char *)val->c_str(), 52 KIND * (std::size_t)con->LEN()}, 53 (std::size_t)con->LEN()}; 54 return llvm::None; 55 } 56 static llvm::Optional<std::tuple<std::string, std::size_t>> 57 getCharacterLiteralCopy( 58 const Fortran::evaluate::Expr<Fortran::evaluate::SomeCharacter> &x) { 59 return std::visit([](const auto &e) { return getCharacterLiteralCopy(e); }, 60 x.u); 61 } 62 static llvm::Optional<std::tuple<std::string, std::size_t>> 63 getCharacterLiteralCopy(const Fortran::lower::SomeExpr &x) { 64 if (const auto *e = Fortran::evaluate::UnwrapExpr< 65 Fortran::evaluate::Expr<Fortran::evaluate::SomeCharacter>>(x)) 66 return getCharacterLiteralCopy(*e); 67 return llvm::None; 68 } 69 template <typename A> 70 static llvm::Optional<std::tuple<std::string, std::size_t>> 71 getCharacterLiteralCopy(const std::optional<A> &x) { 72 if (x) 73 return getCharacterLiteralCopy(*x); 74 return llvm::None; 75 } 76 77 /// Helper to lower a scalar expression using a specific symbol mapping. 78 static mlir::Value genScalarValue(Fortran::lower::AbstractConverter &converter, 79 mlir::Location loc, 80 const Fortran::lower::SomeExpr &expr, 81 Fortran::lower::SymMap &symMap, 82 Fortran::lower::StatementContext &context) { 83 // This does not use the AbstractConverter member function to override the 84 // symbol mapping to be used expression lowering. 85 return fir::getBase(Fortran::lower::createSomeExtendedExpression( 86 loc, converter, expr, symMap, context)); 87 } 88 89 /// Does this variable have a default initialization? 90 static bool hasDefaultInitialization(const Fortran::semantics::Symbol &sym) { 91 if (sym.has<Fortran::semantics::ObjectEntityDetails>() && sym.size()) 92 if (!Fortran::semantics::IsAllocatableOrPointer(sym)) 93 if (const Fortran::semantics::DeclTypeSpec *declTypeSpec = sym.GetType()) 94 if (const Fortran::semantics::DerivedTypeSpec *derivedTypeSpec = 95 declTypeSpec->AsDerived()) 96 return derivedTypeSpec->HasDefaultInitialization(); 97 return false; 98 } 99 100 //===----------------------------------------------------------------===// 101 // Global variables instantiation (not for alias and common) 102 //===----------------------------------------------------------------===// 103 104 /// Helper to generate expression value inside global initializer. 105 static fir::ExtendedValue 106 genInitializerExprValue(Fortran::lower::AbstractConverter &converter, 107 mlir::Location loc, 108 const Fortran::lower::SomeExpr &expr, 109 Fortran::lower::StatementContext &stmtCtx) { 110 // Data initializer are constant value and should not depend on other symbols 111 // given the front-end fold parameter references. In any case, the "current" 112 // map of the converter should not be used since it holds mapping to 113 // mlir::Value from another mlir region. If these value are used by accident 114 // in the initializer, this will lead to segfaults in mlir code. 115 Fortran::lower::SymMap emptyMap; 116 return Fortran::lower::createSomeInitializerExpression(loc, converter, expr, 117 emptyMap, stmtCtx); 118 } 119 120 /// Can this symbol constant be placed in read-only memory? 121 static bool isConstant(const Fortran::semantics::Symbol &sym) { 122 return sym.attrs().test(Fortran::semantics::Attr::PARAMETER) || 123 sym.test(Fortran::semantics::Symbol::Flag::ReadOnly); 124 } 125 126 /// Create the global op declaration without any initializer 127 static fir::GlobalOp declareGlobal(Fortran::lower::AbstractConverter &converter, 128 const Fortran::lower::pft::Variable &var, 129 llvm::StringRef globalName, 130 mlir::StringAttr linkage) { 131 fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 132 if (fir::GlobalOp global = builder.getNamedGlobal(globalName)) 133 return global; 134 const Fortran::semantics::Symbol &sym = var.getSymbol(); 135 mlir::Location loc = converter.genLocation(sym.name()); 136 // Resolve potential host and module association before checking that this 137 // symbol is an object of a function pointer. 138 const Fortran::semantics::Symbol &ultimate = sym.GetUltimate(); 139 if (!ultimate.has<Fortran::semantics::ObjectEntityDetails>() && 140 !ultimate.has<Fortran::semantics::ProcEntityDetails>()) 141 mlir::emitError(loc, "lowering global declaration: symbol '") 142 << toStringRef(sym.name()) << "' has unexpected details\n"; 143 return builder.createGlobal(loc, converter.genType(var), globalName, linkage, 144 mlir::Attribute{}, isConstant(ultimate)); 145 } 146 147 /// Temporary helper to catch todos in initial data target lowering. 148 static bool 149 hasDerivedTypeWithLengthParameters(const Fortran::semantics::Symbol &sym) { 150 if (const Fortran::semantics::DeclTypeSpec *declTy = sym.GetType()) 151 if (const Fortran::semantics::DerivedTypeSpec *derived = 152 declTy->AsDerived()) 153 return Fortran::semantics::CountLenParameters(*derived) > 0; 154 return false; 155 } 156 157 static mlir::Type unwrapElementType(mlir::Type type) { 158 if (mlir::Type ty = fir::dyn_cast_ptrOrBoxEleTy(type)) 159 type = ty; 160 if (auto seqType = type.dyn_cast<fir::SequenceType>()) 161 type = seqType.getEleTy(); 162 return type; 163 } 164 165 /// create initial-data-target fir.box in a global initializer region. 166 mlir::Value Fortran::lower::genInitialDataTarget( 167 Fortran::lower::AbstractConverter &converter, mlir::Location loc, 168 mlir::Type boxType, const Fortran::lower::SomeExpr &initialTarget) { 169 Fortran::lower::SymMap globalOpSymMap; 170 Fortran::lower::AggregateStoreMap storeMap; 171 Fortran::lower::StatementContext stmtCtx; 172 fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 173 if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>( 174 initialTarget)) 175 return fir::factory::createUnallocatedBox(builder, loc, boxType, 176 /*nonDeferredParams=*/llvm::None); 177 // Pointer initial data target, and NULL(mold). 178 if (const Fortran::semantics::Symbol *sym = 179 Fortran::evaluate::GetFirstSymbol(initialTarget)) { 180 // Length parameters processing will need care in global initializer 181 // context. 182 if (hasDerivedTypeWithLengthParameters(*sym)) 183 TODO(loc, "initial-data-target with derived type length parameters"); 184 185 auto var = Fortran::lower::pft::Variable(*sym, /*global=*/true); 186 Fortran::lower::instantiateVariable(converter, var, globalOpSymMap, 187 storeMap); 188 } 189 mlir::Value box; 190 if (initialTarget.Rank() > 0) { 191 box = fir::getBase(Fortran::lower::createSomeArrayBox( 192 converter, initialTarget, globalOpSymMap, stmtCtx)); 193 } else { 194 fir::ExtendedValue addr = Fortran::lower::createInitializerAddress( 195 loc, converter, initialTarget, globalOpSymMap, stmtCtx); 196 box = builder.createBox(loc, addr); 197 } 198 // box is a fir.box<T>, not a fir.box<fir.ptr<T>> as it should to be used 199 // for pointers. A fir.convert should not be used here, because it would 200 // not actually set the pointer attribute in the descriptor. 201 // In a normal context, fir.rebox would be used to set the pointer attribute 202 // while copying the projection from another fir.box. But fir.rebox cannot be 203 // used in initializer because its current codegen expects that the input 204 // fir.box is in memory, which is not the case in initializers. 205 // So, just replace the fir.embox that created addr with one with 206 // fir.box<fir.ptr<T>> result type. 207 // Note that the descriptor cannot have been created with fir.rebox because 208 // the initial-data-target cannot be a fir.box itself (it cannot be 209 // assumed-shape, deferred-shape, or polymorphic as per C765). However the 210 // case where the initial data target is a derived type with length parameters 211 // will most likely be a bit trickier, hence the TODO above. 212 213 mlir::Operation *op = box.getDefiningOp(); 214 if (!op || !mlir::isa<fir::EmboxOp>(*op)) 215 fir::emitFatalError( 216 loc, "fir.box must be created with embox in global initializers"); 217 mlir::Type targetEleTy = unwrapElementType(box.getType()); 218 if (!fir::isa_char(targetEleTy)) 219 return builder.create<fir::EmboxOp>(loc, boxType, op->getOperands(), 220 op->getAttrs()); 221 222 // Handle the character case length particularities: embox takes a length 223 // value argument when the result type has unknown length, but not when the 224 // result type has constant length. The type of the initial target must be 225 // constant length, but the one of the pointer may not be. In this case, a 226 // length operand must be added. 227 auto targetLen = targetEleTy.cast<fir::CharacterType>().getLen(); 228 auto ptrLen = unwrapElementType(boxType).cast<fir::CharacterType>().getLen(); 229 if (ptrLen == targetLen) 230 // Nothing to do 231 return builder.create<fir::EmboxOp>(loc, boxType, op->getOperands(), 232 op->getAttrs()); 233 auto embox = mlir::cast<fir::EmboxOp>(*op); 234 auto ptrType = boxType.cast<fir::BoxType>().getEleTy(); 235 mlir::Value memref = builder.createConvert(loc, ptrType, embox.getMemref()); 236 if (targetLen == fir::CharacterType::unknownLen()) 237 // Drop the length argument. 238 return builder.create<fir::EmboxOp>(loc, boxType, memref, embox.getShape(), 239 embox.getSlice()); 240 // targetLen is constant and ptrLen is unknown. Add a length argument. 241 mlir::Value targetLenValue = 242 builder.createIntegerConstant(loc, builder.getIndexType(), targetLen); 243 return builder.create<fir::EmboxOp>(loc, boxType, memref, embox.getShape(), 244 embox.getSlice(), 245 mlir::ValueRange{targetLenValue}); 246 } 247 248 static mlir::Value genDefaultInitializerValue( 249 Fortran::lower::AbstractConverter &converter, mlir::Location loc, 250 const Fortran::semantics::Symbol &sym, mlir::Type symTy, 251 Fortran::lower::StatementContext &stmtCtx) { 252 fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 253 mlir::Type scalarType = symTy; 254 fir::SequenceType sequenceType; 255 if (auto ty = symTy.dyn_cast<fir::SequenceType>()) { 256 sequenceType = ty; 257 scalarType = ty.getEleTy(); 258 } 259 // Build a scalar default value of the symbol type, looping through the 260 // components to build each component initial value. 261 auto recTy = scalarType.cast<fir::RecordType>(); 262 auto fieldTy = fir::FieldType::get(scalarType.getContext()); 263 mlir::Value initialValue = builder.create<fir::UndefOp>(loc, scalarType); 264 const Fortran::semantics::DeclTypeSpec *declTy = sym.GetType(); 265 assert(declTy && "var with default initialization must have a type"); 266 Fortran::semantics::OrderedComponentIterator components( 267 declTy->derivedTypeSpec()); 268 for (const auto &component : components) { 269 // Skip parent components, the sub-components of parent types are part of 270 // components and will be looped through right after. 271 if (component.test(Fortran::semantics::Symbol::Flag::ParentComp)) 272 continue; 273 mlir::Value componentValue; 274 llvm::StringRef name = toStringRef(component.name()); 275 mlir::Type componentTy = recTy.getType(name); 276 assert(componentTy && "component not found in type"); 277 if (const auto *object{ 278 component.detailsIf<Fortran::semantics::ObjectEntityDetails>()}) { 279 if (const auto &init = object->init()) { 280 // Component has explicit initialization. 281 if (Fortran::semantics::IsPointer(component)) 282 // Initial data target. 283 componentValue = 284 genInitialDataTarget(converter, loc, componentTy, *init); 285 else 286 // Initial value. 287 componentValue = fir::getBase( 288 genInitializerExprValue(converter, loc, *init, stmtCtx)); 289 } else if (Fortran::semantics::IsAllocatableOrPointer(component)) { 290 // Pointer or allocatable without initialization. 291 // Create deallocated/disassociated value. 292 // From a standard point of view, pointer without initialization do not 293 // need to be disassociated, but for sanity and simplicity, do it in 294 // global constructor since this has no runtime cost. 295 componentValue = fir::factory::createUnallocatedBox( 296 builder, loc, componentTy, llvm::None); 297 } else if (hasDefaultInitialization(component)) { 298 // Component type has default initialization. 299 componentValue = genDefaultInitializerValue(converter, loc, component, 300 componentTy, stmtCtx); 301 } else { 302 // Component has no initial value. 303 componentValue = builder.create<fir::UndefOp>(loc, componentTy); 304 } 305 } else if (const auto *proc{ 306 component 307 .detailsIf<Fortran::semantics::ProcEntityDetails>()}) { 308 if (proc->init().has_value()) 309 TODO(loc, "procedure pointer component default initialization"); 310 else 311 componentValue = builder.create<fir::UndefOp>(loc, componentTy); 312 } 313 assert(componentValue && "must have been computed"); 314 componentValue = builder.createConvert(loc, componentTy, componentValue); 315 // FIXME: type parameters must come from the derived-type-spec 316 auto field = builder.create<fir::FieldIndexOp>( 317 loc, fieldTy, name, scalarType, 318 /*typeParams=*/mlir::ValueRange{} /*TODO*/); 319 initialValue = builder.create<fir::InsertValueOp>( 320 loc, recTy, initialValue, componentValue, 321 builder.getArrayAttr(field.getAttributes())); 322 } 323 324 if (sequenceType) { 325 // For arrays, duplicate the scalar value to all elements with an 326 // fir.insert_range covering the whole array. 327 auto arrayInitialValue = builder.create<fir::UndefOp>(loc, sequenceType); 328 llvm::SmallVector<int64_t> rangeBounds; 329 for (int64_t extent : sequenceType.getShape()) { 330 if (extent == fir::SequenceType::getUnknownExtent()) 331 TODO(loc, 332 "default initial value of array component with length parameters"); 333 rangeBounds.push_back(0); 334 rangeBounds.push_back(extent - 1); 335 } 336 return builder.create<fir::InsertOnRangeOp>( 337 loc, sequenceType, arrayInitialValue, initialValue, 338 builder.getIndexVectorAttr(rangeBounds)); 339 } 340 return initialValue; 341 } 342 343 /// Does this global already have an initializer ? 344 static bool globalIsInitialized(fir::GlobalOp global) { 345 return !global.getRegion().empty() || global.getInitVal(); 346 } 347 348 /// Call \p genInit to generate code inside \p global initializer region. 349 static void 350 createGlobalInitialization(fir::FirOpBuilder &builder, fir::GlobalOp global, 351 std::function<void(fir::FirOpBuilder &)> genInit) { 352 mlir::Region ®ion = global.getRegion(); 353 region.push_back(new mlir::Block); 354 mlir::Block &block = region.back(); 355 auto insertPt = builder.saveInsertionPoint(); 356 builder.setInsertionPointToStart(&block); 357 genInit(builder); 358 builder.restoreInsertionPoint(insertPt); 359 } 360 361 /// Create the global op and its init if it has one 362 static fir::GlobalOp defineGlobal(Fortran::lower::AbstractConverter &converter, 363 const Fortran::lower::pft::Variable &var, 364 llvm::StringRef globalName, 365 mlir::StringAttr linkage) { 366 fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 367 const Fortran::semantics::Symbol &sym = var.getSymbol(); 368 mlir::Location loc = converter.genLocation(sym.name()); 369 bool isConst = isConstant(sym); 370 fir::GlobalOp global = builder.getNamedGlobal(globalName); 371 mlir::Type symTy = converter.genType(var); 372 373 if (global && globalIsInitialized(global)) 374 return global; 375 // If this is an array, check to see if we can use a dense attribute 376 // with a tensor mlir type. This optimization currently only supports 377 // rank-1 Fortran arrays of integer, real, or logical. The tensor 378 // type does not support nested structures which are needed for 379 // complex numbers. 380 // To get multidimensional arrays to work, we will have to use column major 381 // array ordering with the tensor type (so it matches column major ordering 382 // with the Fortran fir.array). By default, tensor types assume row major 383 // ordering. How to create this tensor type is to be determined. 384 if (symTy.isa<fir::SequenceType>() && sym.Rank() == 1 && 385 !Fortran::semantics::IsAllocatableOrPointer(sym)) { 386 mlir::Type eleTy = symTy.cast<fir::SequenceType>().getEleTy(); 387 if (eleTy.isa<mlir::IntegerType, mlir::FloatType, fir::LogicalType>()) { 388 const auto *details = 389 sym.detailsIf<Fortran::semantics::ObjectEntityDetails>(); 390 if (details->init()) { 391 global = Fortran::lower::createDenseGlobal( 392 loc, symTy, globalName, linkage, isConst, details->init().value(), 393 converter); 394 if (global) { 395 global.setVisibility(mlir::SymbolTable::Visibility::Public); 396 return global; 397 } 398 } 399 } 400 } 401 if (!global) 402 global = builder.createGlobal(loc, symTy, globalName, linkage, 403 mlir::Attribute{}, isConst); 404 if (Fortran::semantics::IsAllocatableOrPointer(sym)) { 405 const auto *details = 406 sym.detailsIf<Fortran::semantics::ObjectEntityDetails>(); 407 if (details && details->init()) { 408 auto expr = *details->init(); 409 createGlobalInitialization(builder, global, [&](fir::FirOpBuilder &b) { 410 mlir::Value box = 411 Fortran::lower::genInitialDataTarget(converter, loc, symTy, expr); 412 b.create<fir::HasValueOp>(loc, box); 413 }); 414 } else { 415 // Create unallocated/disassociated descriptor if no explicit init 416 createGlobalInitialization(builder, global, [&](fir::FirOpBuilder &b) { 417 mlir::Value box = 418 fir::factory::createUnallocatedBox(b, loc, symTy, llvm::None); 419 b.create<fir::HasValueOp>(loc, box); 420 }); 421 } 422 423 } else if (const auto *details = 424 sym.detailsIf<Fortran::semantics::ObjectEntityDetails>()) { 425 if (details->init()) { 426 if (fir::isa_char(symTy)) { 427 // CHARACTER literal 428 if (auto chLit = getCharacterLiteralCopy(details->init().value())) { 429 mlir::StringAttr init = 430 builder.getStringAttr(std::get<std::string>(*chLit)); 431 global->setAttr(global.getInitValAttrName(), init); 432 } else { 433 fir::emitFatalError(loc, "CHARACTER has unexpected initial value"); 434 } 435 } else { 436 createGlobalInitialization( 437 builder, global, [&](fir::FirOpBuilder &builder) { 438 Fortran::lower::StatementContext stmtCtx( 439 /*cleanupProhibited=*/true); 440 fir::ExtendedValue initVal = genInitializerExprValue( 441 converter, loc, details->init().value(), stmtCtx); 442 mlir::Value castTo = 443 builder.createConvert(loc, symTy, fir::getBase(initVal)); 444 builder.create<fir::HasValueOp>(loc, castTo); 445 }); 446 } 447 } else if (hasDefaultInitialization(sym)) { 448 createGlobalInitialization( 449 builder, global, [&](fir::FirOpBuilder &builder) { 450 Fortran::lower::StatementContext stmtCtx( 451 /*cleanupProhibited=*/true); 452 mlir::Value initVal = 453 genDefaultInitializerValue(converter, loc, sym, symTy, stmtCtx); 454 mlir::Value castTo = builder.createConvert(loc, symTy, initVal); 455 builder.create<fir::HasValueOp>(loc, castTo); 456 }); 457 } 458 } else if (sym.has<Fortran::semantics::CommonBlockDetails>()) { 459 mlir::emitError(loc, "COMMON symbol processed elsewhere"); 460 } else { 461 TODO(loc, "global"); // Procedure pointer or something else 462 } 463 // Creates undefined initializer for globals without initializers 464 if (!globalIsInitialized(global)) 465 createGlobalInitialization( 466 builder, global, [&](fir::FirOpBuilder &builder) { 467 builder.create<fir::HasValueOp>( 468 loc, builder.create<fir::UndefOp>(loc, symTy)); 469 }); 470 // Set public visibility to prevent global definition to be optimized out 471 // even if they have no initializer and are unused in this compilation unit. 472 global.setVisibility(mlir::SymbolTable::Visibility::Public); 473 return global; 474 } 475 476 /// Return linkage attribute for \p var. 477 static mlir::StringAttr 478 getLinkageAttribute(fir::FirOpBuilder &builder, 479 const Fortran::lower::pft::Variable &var) { 480 if (var.isModuleVariable()) 481 return {}; // external linkage 482 // Otherwise, the variable is owned by a procedure and must not be visible in 483 // other compilation units. 484 return builder.createInternalLinkage(); 485 } 486 487 /// Instantiate a global variable. If it hasn't already been processed, add 488 /// the global to the ModuleOp as a new uniqued symbol and initialize it with 489 /// the correct value. It will be referenced on demand using `fir.addr_of`. 490 static void instantiateGlobal(Fortran::lower::AbstractConverter &converter, 491 const Fortran::lower::pft::Variable &var, 492 Fortran::lower::SymMap &symMap) { 493 const Fortran::semantics::Symbol &sym = var.getSymbol(); 494 assert(!var.isAlias() && "must be handled in instantiateAlias"); 495 fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 496 std::string globalName = Fortran::lower::mangle::mangleName(sym); 497 mlir::Location loc = converter.genLocation(sym.name()); 498 fir::GlobalOp global = builder.getNamedGlobal(globalName); 499 mlir::StringAttr linkage = getLinkageAttribute(builder, var); 500 if (var.isModuleVariable()) { 501 // A module global was or will be defined when lowering the module. Emit 502 // only a declaration if the global does not exist at that point. 503 global = declareGlobal(converter, var, globalName, linkage); 504 } else { 505 global = defineGlobal(converter, var, globalName, linkage); 506 } 507 auto addrOf = builder.create<fir::AddrOfOp>(loc, global.resultType(), 508 global.getSymbol()); 509 Fortran::lower::StatementContext stmtCtx; 510 mapSymbolAttributes(converter, var, symMap, stmtCtx, addrOf); 511 } 512 513 //===----------------------------------------------------------------===// 514 // Local variables instantiation (not for alias) 515 //===----------------------------------------------------------------===// 516 517 /// Create a stack slot for a local variable. Precondition: the insertion 518 /// point of the builder must be in the entry block, which is currently being 519 /// constructed. 520 static mlir::Value createNewLocal(Fortran::lower::AbstractConverter &converter, 521 mlir::Location loc, 522 const Fortran::lower::pft::Variable &var, 523 mlir::Value preAlloc, 524 llvm::ArrayRef<mlir::Value> shape = {}, 525 llvm::ArrayRef<mlir::Value> lenParams = {}) { 526 if (preAlloc) 527 return preAlloc; 528 fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 529 std::string nm = Fortran::lower::mangle::mangleName(var.getSymbol()); 530 mlir::Type ty = converter.genType(var); 531 const Fortran::semantics::Symbol &ultimateSymbol = 532 var.getSymbol().GetUltimate(); 533 llvm::StringRef symNm = toStringRef(ultimateSymbol.name()); 534 bool isTarg = var.isTarget(); 535 // Let the builder do all the heavy lifting. 536 return builder.allocateLocal(loc, ty, nm, symNm, shape, lenParams, isTarg); 537 } 538 539 /// Instantiate a local variable. Precondition: Each variable will be visited 540 /// such that if its properties depend on other variables, the variables upon 541 /// which its properties depend will already have been visited. 542 static void instantiateLocal(Fortran::lower::AbstractConverter &converter, 543 const Fortran::lower::pft::Variable &var, 544 Fortran::lower::SymMap &symMap) { 545 assert(!var.isAlias()); 546 Fortran::lower::StatementContext stmtCtx; 547 mapSymbolAttributes(converter, var, symMap, stmtCtx); 548 } 549 550 /// Helper to decide if a dummy argument must be tracked in an BoxValue. 551 static bool lowerToBoxValue(const Fortran::semantics::Symbol &sym, 552 mlir::Value dummyArg) { 553 // Only dummy arguments coming as fir.box can be tracked in an BoxValue. 554 if (!dummyArg || !dummyArg.getType().isa<fir::BoxType>()) 555 return false; 556 // Non contiguous arrays must be tracked in an BoxValue. 557 if (sym.Rank() > 0 && !sym.attrs().test(Fortran::semantics::Attr::CONTIGUOUS)) 558 return true; 559 // Assumed rank and optional fir.box cannot yet be read while lowering the 560 // specifications. 561 if (Fortran::evaluate::IsAssumedRank(sym) || 562 Fortran::semantics::IsOptional(sym)) 563 return true; 564 // Polymorphic entity should be tracked through a fir.box that has the 565 // dynamic type info. 566 if (const Fortran::semantics::DeclTypeSpec *type = sym.GetType()) 567 if (type->IsPolymorphic()) 568 return true; 569 return false; 570 } 571 572 /// Compute extent from lower and upper bound. 573 static mlir::Value computeExtent(fir::FirOpBuilder &builder, mlir::Location loc, 574 mlir::Value lb, mlir::Value ub) { 575 mlir::IndexType idxTy = builder.getIndexType(); 576 // Let the folder deal with the common `ub - <const> + 1` case. 577 auto diff = builder.create<mlir::arith::SubIOp>(loc, idxTy, ub, lb); 578 mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1); 579 return builder.create<mlir::arith::AddIOp>(loc, idxTy, diff, one); 580 } 581 582 /// Lower explicit lower bounds into \p result. Does nothing if this is not an 583 /// array, or if the lower bounds are deferred, or all implicit or one. 584 static void lowerExplicitLowerBounds( 585 Fortran::lower::AbstractConverter &converter, mlir::Location loc, 586 const Fortran::lower::BoxAnalyzer &box, 587 llvm::SmallVectorImpl<mlir::Value> &result, Fortran::lower::SymMap &symMap, 588 Fortran::lower::StatementContext &stmtCtx) { 589 if (!box.isArray() || box.lboundIsAllOnes()) 590 return; 591 fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 592 mlir::IndexType idxTy = builder.getIndexType(); 593 if (box.isStaticArray()) { 594 for (int64_t lb : box.staticLBound()) 595 result.emplace_back(builder.createIntegerConstant(loc, idxTy, lb)); 596 return; 597 } 598 for (const Fortran::semantics::ShapeSpec *spec : box.dynamicBound()) { 599 if (auto low = spec->lbound().GetExplicit()) { 600 auto expr = Fortran::lower::SomeExpr{*low}; 601 mlir::Value lb = builder.createConvert( 602 loc, idxTy, genScalarValue(converter, loc, expr, symMap, stmtCtx)); 603 result.emplace_back(lb); 604 } else if (!spec->lbound().isColon()) { 605 // Implicit lower bound is 1 (Fortran 2018 section 8.5.8.3 point 3.) 606 result.emplace_back(builder.createIntegerConstant(loc, idxTy, 1)); 607 } 608 } 609 assert(result.empty() || result.size() == box.dynamicBound().size()); 610 } 611 612 /// Lower explicit extents into \p result if this is an explicit-shape or 613 /// assumed-size array. Does nothing if this is not an explicit-shape or 614 /// assumed-size array. 615 static void lowerExplicitExtents(Fortran::lower::AbstractConverter &converter, 616 mlir::Location loc, 617 const Fortran::lower::BoxAnalyzer &box, 618 llvm::ArrayRef<mlir::Value> lowerBounds, 619 llvm::SmallVectorImpl<mlir::Value> &result, 620 Fortran::lower::SymMap &symMap, 621 Fortran::lower::StatementContext &stmtCtx) { 622 if (!box.isArray()) 623 return; 624 fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 625 mlir::IndexType idxTy = builder.getIndexType(); 626 if (box.isStaticArray()) { 627 for (int64_t extent : box.staticShape()) 628 result.emplace_back(builder.createIntegerConstant(loc, idxTy, extent)); 629 return; 630 } 631 for (const auto &spec : llvm::enumerate(box.dynamicBound())) { 632 if (auto up = spec.value()->ubound().GetExplicit()) { 633 auto expr = Fortran::lower::SomeExpr{*up}; 634 mlir::Value ub = builder.createConvert( 635 loc, idxTy, genScalarValue(converter, loc, expr, symMap, stmtCtx)); 636 if (lowerBounds.empty()) 637 result.emplace_back(ub); 638 else 639 result.emplace_back( 640 computeExtent(builder, loc, lowerBounds[spec.index()], ub)); 641 } else if (spec.value()->ubound().isStar()) { 642 // Assumed extent is undefined. Must be provided by user's code. 643 result.emplace_back(builder.create<fir::UndefOp>(loc, idxTy)); 644 } 645 } 646 assert(result.empty() || result.size() == box.dynamicBound().size()); 647 } 648 649 /// Lower explicit character length if any. Return empty mlir::Value if no 650 /// explicit length. 651 static mlir::Value 652 lowerExplicitCharLen(Fortran::lower::AbstractConverter &converter, 653 mlir::Location loc, const Fortran::lower::BoxAnalyzer &box, 654 Fortran::lower::SymMap &symMap, 655 Fortran::lower::StatementContext &stmtCtx) { 656 if (!box.isChar()) 657 return mlir::Value{}; 658 fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 659 mlir::Type lenTy = builder.getCharacterLengthType(); 660 if (llvm::Optional<int64_t> len = box.getCharLenConst()) 661 return builder.createIntegerConstant(loc, lenTy, *len); 662 if (llvm::Optional<Fortran::lower::SomeExpr> lenExpr = box.getCharLenExpr()) 663 return genScalarValue(converter, loc, *lenExpr, symMap, stmtCtx); 664 return mlir::Value{}; 665 } 666 667 /// Treat negative values as undefined. Assumed size arrays will return -1 from 668 /// the front end for example. Using negative values can produce hard to find 669 /// bugs much further along in the compilation. 670 static mlir::Value genExtentValue(fir::FirOpBuilder &builder, 671 mlir::Location loc, mlir::Type idxTy, 672 long frontEndExtent) { 673 if (frontEndExtent >= 0) 674 return builder.createIntegerConstant(loc, idxTy, frontEndExtent); 675 return builder.create<fir::UndefOp>(loc, idxTy); 676 } 677 678 /// Lower specification expressions and attributes of variable \p var and 679 /// add it to the symbol map. 680 /// For global and aliases, the address must be pre-computed and provided 681 /// in \p preAlloc. 682 /// Dummy arguments must have already been mapped to mlir block arguments 683 /// their mapping may be updated here. 684 void Fortran::lower::mapSymbolAttributes( 685 AbstractConverter &converter, const Fortran::lower::pft::Variable &var, 686 Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx, 687 mlir::Value preAlloc) { 688 fir::FirOpBuilder &builder = converter.getFirOpBuilder(); 689 const Fortran::semantics::Symbol &sym = var.getSymbol(); 690 const mlir::Location loc = converter.genLocation(sym.name()); 691 mlir::IndexType idxTy = builder.getIndexType(); 692 const bool isDummy = Fortran::semantics::IsDummy(sym); 693 const bool isResult = Fortran::semantics::IsFunctionResult(sym); 694 const bool replace = isDummy || isResult; 695 fir::factory::CharacterExprHelper charHelp{builder, loc}; 696 Fortran::lower::BoxAnalyzer ba; 697 ba.analyze(sym); 698 699 // First deal with pointers an allocatables, because their handling here 700 // is the same regardless of their rank. 701 if (Fortran::semantics::IsAllocatableOrPointer(sym)) { 702 // Get address of fir.box describing the entity. 703 // global 704 mlir::Value boxAlloc = preAlloc; 705 // dummy or passed result 706 if (!boxAlloc) 707 if (Fortran::lower::SymbolBox symbox = symMap.lookupSymbol(sym)) 708 boxAlloc = symbox.getAddr(); 709 // local 710 if (!boxAlloc) 711 boxAlloc = createNewLocal(converter, loc, var, preAlloc); 712 // Lower non deferred parameters. 713 llvm::SmallVector<mlir::Value> nonDeferredLenParams; 714 if (ba.isChar()) { 715 if (mlir::Value len = 716 lowerExplicitCharLen(converter, loc, ba, symMap, stmtCtx)) 717 nonDeferredLenParams.push_back(len); 718 else if (Fortran::semantics::IsAssumedLengthCharacter(sym)) 719 TODO(loc, "assumed length character allocatable"); 720 } else if (const Fortran::semantics::DeclTypeSpec *declTy = sym.GetType()) { 721 if (const Fortran::semantics::DerivedTypeSpec *derived = 722 declTy->AsDerived()) 723 if (Fortran::semantics::CountLenParameters(*derived) != 0) 724 TODO(loc, 725 "derived type allocatable or pointer with length parameters"); 726 } 727 fir::MutableBoxValue box = Fortran::lower::createMutableBox( 728 converter, loc, var, boxAlloc, nonDeferredLenParams); 729 symMap.addAllocatableOrPointer(var.getSymbol(), box, replace); 730 return; 731 } 732 733 if (isDummy) { 734 mlir::Value dummyArg = symMap.lookupSymbol(sym).getAddr(); 735 if (lowerToBoxValue(sym, dummyArg)) { 736 llvm::SmallVector<mlir::Value> lbounds; 737 llvm::SmallVector<mlir::Value> extents; 738 llvm::SmallVector<mlir::Value> explicitParams; 739 // Lower lower bounds, explicit type parameters and explicit 740 // extents if any. 741 if (ba.isChar()) 742 TODO(loc, "lowerToBoxValue character"); 743 // TODO: derived type length parameters. 744 lowerExplicitLowerBounds(converter, loc, ba, lbounds, symMap, stmtCtx); 745 lowerExplicitExtents(converter, loc, ba, lbounds, extents, symMap, 746 stmtCtx); 747 symMap.addBoxSymbol(sym, dummyArg, lbounds, explicitParams, extents, 748 replace); 749 return; 750 } 751 } 752 753 // Helper to generate scalars for the symbol properties. 754 auto genValue = [&](const Fortran::lower::SomeExpr &expr) { 755 return genScalarValue(converter, loc, expr, symMap, stmtCtx); 756 }; 757 758 // For symbols reaching this point, all properties are constant and can be 759 // read/computed already into ssa values. 760 761 // The origin must be \vec{1}. 762 auto populateShape = [&](auto &shapes, const auto &bounds, mlir::Value box) { 763 for (auto iter : llvm::enumerate(bounds)) { 764 auto *spec = iter.value(); 765 assert(spec->lbound().GetExplicit() && 766 "lbound must be explicit with constant value 1"); 767 if (auto high = spec->ubound().GetExplicit()) { 768 Fortran::lower::SomeExpr highEx{*high}; 769 mlir::Value ub = genValue(highEx); 770 shapes.emplace_back(builder.createConvert(loc, idxTy, ub)); 771 } else if (spec->ubound().isColon()) { 772 assert(box && "assumed bounds require a descriptor"); 773 mlir::Value dim = 774 builder.createIntegerConstant(loc, idxTy, iter.index()); 775 auto dimInfo = 776 builder.create<fir::BoxDimsOp>(loc, idxTy, idxTy, idxTy, box, dim); 777 shapes.emplace_back(dimInfo.getResult(1)); 778 } else if (spec->ubound().isStar()) { 779 shapes.emplace_back(builder.create<fir::UndefOp>(loc, idxTy)); 780 } else { 781 llvm::report_fatal_error("unknown bound category"); 782 } 783 } 784 }; 785 786 // The origin is not \vec{1}. 787 auto populateLBoundsExtents = [&](auto &lbounds, auto &extents, 788 const auto &bounds, mlir::Value box) { 789 for (auto iter : llvm::enumerate(bounds)) { 790 auto *spec = iter.value(); 791 fir::BoxDimsOp dimInfo; 792 mlir::Value ub, lb; 793 if (spec->lbound().isColon() || spec->ubound().isColon()) { 794 // This is an assumed shape because allocatables and pointers extents 795 // are not constant in the scope and are not read here. 796 assert(box && "deferred bounds require a descriptor"); 797 mlir::Value dim = 798 builder.createIntegerConstant(loc, idxTy, iter.index()); 799 dimInfo = 800 builder.create<fir::BoxDimsOp>(loc, idxTy, idxTy, idxTy, box, dim); 801 extents.emplace_back(dimInfo.getResult(1)); 802 if (auto low = spec->lbound().GetExplicit()) { 803 auto expr = Fortran::lower::SomeExpr{*low}; 804 mlir::Value lb = builder.createConvert(loc, idxTy, genValue(expr)); 805 lbounds.emplace_back(lb); 806 } else { 807 // Implicit lower bound is 1 (Fortran 2018 section 8.5.8.3 point 3.) 808 lbounds.emplace_back(builder.createIntegerConstant(loc, idxTy, 1)); 809 } 810 } else { 811 if (auto low = spec->lbound().GetExplicit()) { 812 auto expr = Fortran::lower::SomeExpr{*low}; 813 lb = builder.createConvert(loc, idxTy, genValue(expr)); 814 } else { 815 TODO(loc, "assumed rank lowering"); 816 } 817 818 if (auto high = spec->ubound().GetExplicit()) { 819 auto expr = Fortran::lower::SomeExpr{*high}; 820 ub = builder.createConvert(loc, idxTy, genValue(expr)); 821 lbounds.emplace_back(lb); 822 extents.emplace_back(computeExtent(builder, loc, lb, ub)); 823 } else { 824 // An assumed size array. The extent is not computed. 825 assert(spec->ubound().isStar() && "expected assumed size"); 826 lbounds.emplace_back(lb); 827 extents.emplace_back(builder.create<fir::UndefOp>(loc, idxTy)); 828 } 829 } 830 } 831 }; 832 833 // Lower length expression for non deferred and non dummy assumed length 834 // characters. 835 auto genExplicitCharLen = 836 [&](llvm::Optional<Fortran::lower::SomeExpr> charLen) -> mlir::Value { 837 if (!charLen) 838 fir::emitFatalError(loc, "expected explicit character length"); 839 mlir::Value rawLen = genValue(*charLen); 840 // If the length expression is negative, the length is zero. See 841 // F2018 7.4.4.2 point 5. 842 return genMaxWithZero(builder, loc, rawLen); 843 }; 844 845 ba.match( 846 //===--------------------------------------------------------------===// 847 // Trivial case. 848 //===--------------------------------------------------------------===// 849 [&](const Fortran::lower::details::ScalarSym &) { 850 if (isDummy) { 851 // This is an argument. 852 if (!symMap.lookupSymbol(sym)) 853 mlir::emitError(loc, "symbol \"") 854 << toStringRef(sym.name()) << "\" must already be in map"; 855 return; 856 } else if (isResult) { 857 // Some Fortran results may be passed by argument (e.g. derived 858 // types) 859 if (symMap.lookupSymbol(sym)) 860 return; 861 } 862 // Otherwise, it's a local variable or function result. 863 mlir::Value local = createNewLocal(converter, loc, var, preAlloc); 864 symMap.addSymbol(sym, local); 865 }, 866 867 //===--------------------------------------------------------------===// 868 // The non-trivial cases are when we have an argument or local that has 869 // a repetition value. Arguments might be passed as simple pointers and 870 // need to be cast to a multi-dimensional array with constant bounds 871 // (possibly with a missing column), bounds computed in the callee 872 // (here), or with bounds from the caller (boxed somewhere else). Locals 873 // have the same properties except they are never boxed arguments from 874 // the caller and never having a missing column size. 875 //===--------------------------------------------------------------===// 876 877 [&](const Fortran::lower::details::ScalarStaticChar &x) { 878 // type is a CHARACTER, determine the LEN value 879 auto charLen = x.charLen(); 880 if (replace) { 881 Fortran::lower::SymbolBox symBox = symMap.lookupSymbol(sym); 882 std::pair<mlir::Value, mlir::Value> unboxchar = 883 charHelp.createUnboxChar(symBox.getAddr()); 884 mlir::Value boxAddr = unboxchar.first; 885 // Set/override LEN with a constant 886 mlir::Value len = builder.createIntegerConstant(loc, idxTy, charLen); 887 symMap.addCharSymbol(sym, boxAddr, len, true); 888 return; 889 } 890 mlir::Value len = builder.createIntegerConstant(loc, idxTy, charLen); 891 if (preAlloc) { 892 symMap.addCharSymbol(sym, preAlloc, len); 893 return; 894 } 895 mlir::Value local = createNewLocal(converter, loc, var, preAlloc); 896 symMap.addCharSymbol(sym, local, len); 897 }, 898 899 //===--------------------------------------------------------------===// 900 901 [&](const Fortran::lower::details::ScalarDynamicChar &x) { 902 TODO(loc, "ScalarDynamicChar variable lowering"); 903 }, 904 905 //===--------------------------------------------------------------===// 906 907 [&](const Fortran::lower::details::StaticArray &x) { 908 // object shape is constant, not a character 909 mlir::Type castTy = builder.getRefType(converter.genType(var)); 910 mlir::Value addr = symMap.lookupSymbol(sym).getAddr(); 911 if (addr) 912 addr = builder.createConvert(loc, castTy, addr); 913 if (x.lboundAllOnes()) { 914 // if lower bounds are all ones, build simple shaped object 915 llvm::SmallVector<mlir::Value> shape; 916 for (int64_t i : x.shapes) 917 shape.push_back(genExtentValue(builder, loc, idxTy, i)); 918 mlir::Value local = 919 isDummy ? addr : createNewLocal(converter, loc, var, preAlloc); 920 symMap.addSymbolWithShape(sym, local, shape, isDummy); 921 return; 922 } 923 // If object is an array process the lower bound and extent values by 924 // constructing constants and populating the lbounds and extents. 925 llvm::SmallVector<mlir::Value> extents; 926 llvm::SmallVector<mlir::Value> lbounds; 927 for (auto [fst, snd] : llvm::zip(x.lbounds, x.shapes)) { 928 lbounds.emplace_back(builder.createIntegerConstant(loc, idxTy, fst)); 929 extents.emplace_back(genExtentValue(builder, loc, idxTy, snd)); 930 } 931 mlir::Value local = 932 isDummy ? addr 933 : createNewLocal(converter, loc, var, preAlloc, extents); 934 assert(isDummy || Fortran::lower::isExplicitShape(sym)); 935 symMap.addSymbolWithBounds(sym, local, extents, lbounds, isDummy); 936 }, 937 938 //===--------------------------------------------------------------===// 939 940 [&](const Fortran::lower::details::DynamicArray &x) { 941 // cast to the known constant parts from the declaration 942 mlir::Type varType = converter.genType(var); 943 mlir::Value addr = symMap.lookupSymbol(sym).getAddr(); 944 mlir::Value argBox; 945 mlir::Type castTy = builder.getRefType(varType); 946 if (addr) { 947 if (auto boxTy = addr.getType().dyn_cast<fir::BoxType>()) { 948 argBox = addr; 949 mlir::Type refTy = builder.getRefType(boxTy.getEleTy()); 950 addr = builder.create<fir::BoxAddrOp>(loc, refTy, argBox); 951 } 952 addr = builder.createConvert(loc, castTy, addr); 953 } 954 if (x.lboundAllOnes()) { 955 // if lower bounds are all ones, build simple shaped object 956 llvm::SmallVector<mlir::Value> shapes; 957 populateShape(shapes, x.bounds, argBox); 958 if (isDummy) { 959 symMap.addSymbolWithShape(sym, addr, shapes, true); 960 return; 961 } 962 // local array with computed bounds 963 assert(Fortran::lower::isExplicitShape(sym) || 964 Fortran::semantics::IsAllocatableOrPointer(sym)); 965 mlir::Value local = 966 createNewLocal(converter, loc, var, preAlloc, shapes); 967 symMap.addSymbolWithShape(sym, local, shapes); 968 return; 969 } 970 // if object is an array process the lower bound and extent values 971 llvm::SmallVector<mlir::Value> extents; 972 llvm::SmallVector<mlir::Value> lbounds; 973 populateLBoundsExtents(lbounds, extents, x.bounds, argBox); 974 if (isDummy) { 975 symMap.addSymbolWithBounds(sym, addr, extents, lbounds, true); 976 return; 977 } 978 // local array with computed bounds 979 assert(Fortran::lower::isExplicitShape(sym)); 980 mlir::Value local = 981 createNewLocal(converter, loc, var, preAlloc, extents); 982 symMap.addSymbolWithBounds(sym, local, extents, lbounds); 983 }, 984 985 //===--------------------------------------------------------------===// 986 987 [&](const Fortran::lower::details::StaticArrayStaticChar &x) { 988 // if element type is a CHARACTER, determine the LEN value 989 auto charLen = x.charLen(); 990 mlir::Value addr; 991 mlir::Value len; 992 if (isDummy) { 993 Fortran::lower::SymbolBox symBox = symMap.lookupSymbol(sym); 994 std::pair<mlir::Value, mlir::Value> unboxchar = 995 charHelp.createUnboxChar(symBox.getAddr()); 996 addr = unboxchar.first; 997 // Set/override LEN with a constant 998 len = builder.createIntegerConstant(loc, idxTy, charLen); 999 } else { 1000 // local CHARACTER variable 1001 len = builder.createIntegerConstant(loc, idxTy, charLen); 1002 } 1003 1004 // object shape is constant 1005 mlir::Type castTy = builder.getRefType(converter.genType(var)); 1006 if (addr) 1007 addr = builder.createConvert(loc, castTy, addr); 1008 1009 if (x.lboundAllOnes()) { 1010 // if lower bounds are all ones, build simple shaped object 1011 llvm::SmallVector<mlir::Value> shape; 1012 for (int64_t i : x.shapes) 1013 shape.push_back(genExtentValue(builder, loc, idxTy, i)); 1014 mlir::Value local = 1015 isDummy ? addr : createNewLocal(converter, loc, var, preAlloc); 1016 symMap.addCharSymbolWithShape(sym, local, len, shape, isDummy); 1017 return; 1018 } 1019 1020 // if object is an array process the lower bound and extent values 1021 llvm::SmallVector<mlir::Value> extents; 1022 llvm::SmallVector<mlir::Value> lbounds; 1023 // construct constants and populate `bounds` 1024 for (auto [fst, snd] : llvm::zip(x.lbounds, x.shapes)) { 1025 lbounds.emplace_back(builder.createIntegerConstant(loc, idxTy, fst)); 1026 extents.emplace_back(genExtentValue(builder, loc, idxTy, snd)); 1027 } 1028 1029 if (isDummy) { 1030 symMap.addCharSymbolWithBounds(sym, addr, len, extents, lbounds, 1031 true); 1032 return; 1033 } 1034 // local CHARACTER array with computed bounds 1035 assert(Fortran::lower::isExplicitShape(sym)); 1036 mlir::Value local = 1037 createNewLocal(converter, loc, var, preAlloc, extents); 1038 symMap.addCharSymbolWithBounds(sym, local, len, extents, lbounds); 1039 }, 1040 1041 //===--------------------------------------------------------------===// 1042 1043 [&](const Fortran::lower::details::StaticArrayDynamicChar &x) { 1044 mlir::Value addr; 1045 mlir::Value len; 1046 [[maybe_unused]] bool mustBeDummy = false; 1047 auto charLen = x.charLen(); 1048 // if element type is a CHARACTER, determine the LEN value 1049 if (isDummy) { 1050 Fortran::lower::SymbolBox symBox = symMap.lookupSymbol(sym); 1051 std::pair<mlir::Value, mlir::Value> unboxchar = 1052 charHelp.createUnboxChar(symBox.getAddr()); 1053 addr = unboxchar.first; 1054 if (charLen) { 1055 // Set/override LEN with an expression 1056 len = genExplicitCharLen(charLen); 1057 } else { 1058 // LEN is from the boxchar 1059 len = unboxchar.second; 1060 mustBeDummy = true; 1061 } 1062 } else { 1063 // local CHARACTER variable 1064 len = genExplicitCharLen(charLen); 1065 } 1066 llvm::SmallVector<mlir::Value> lengths = {len}; 1067 1068 // cast to the known constant parts from the declaration 1069 mlir::Type castTy = builder.getRefType(converter.genType(var)); 1070 if (addr) 1071 addr = builder.createConvert(loc, castTy, addr); 1072 1073 if (x.lboundAllOnes()) { 1074 // if lower bounds are all ones, build simple shaped object 1075 llvm::SmallVector<mlir::Value> shape; 1076 for (int64_t i : x.shapes) 1077 shape.push_back(genExtentValue(builder, loc, idxTy, i)); 1078 if (isDummy) { 1079 symMap.addCharSymbolWithShape(sym, addr, len, shape, true); 1080 return; 1081 } 1082 // local CHARACTER array with constant size 1083 mlir::Value local = createNewLocal(converter, loc, var, preAlloc, 1084 llvm::None, lengths); 1085 symMap.addCharSymbolWithShape(sym, local, len, shape); 1086 return; 1087 } 1088 1089 // if object is an array process the lower bound and extent values 1090 llvm::SmallVector<mlir::Value> extents; 1091 llvm::SmallVector<mlir::Value> lbounds; 1092 1093 // construct constants and populate `bounds` 1094 for (auto [fst, snd] : llvm::zip(x.lbounds, x.shapes)) { 1095 lbounds.emplace_back(builder.createIntegerConstant(loc, idxTy, fst)); 1096 extents.emplace_back(genExtentValue(builder, loc, idxTy, snd)); 1097 } 1098 if (isDummy) { 1099 symMap.addCharSymbolWithBounds(sym, addr, len, extents, lbounds, 1100 true); 1101 return; 1102 } 1103 // local CHARACTER array with computed bounds 1104 assert((!mustBeDummy) && (Fortran::lower::isExplicitShape(sym))); 1105 mlir::Value local = 1106 createNewLocal(converter, loc, var, preAlloc, llvm::None, lengths); 1107 symMap.addCharSymbolWithBounds(sym, local, len, extents, lbounds); 1108 }, 1109 1110 //===--------------------------------------------------------------===// 1111 1112 [&](const Fortran::lower::details::DynamicArrayStaticChar &x) { 1113 TODO(loc, "DynamicArrayStaticChar variable lowering"); 1114 }, 1115 1116 //===--------------------------------------------------------------===// 1117 1118 [&](const Fortran::lower::details::DynamicArrayDynamicChar &x) { 1119 TODO(loc, "DynamicArrayDynamicChar variable lowering"); 1120 }, 1121 1122 //===--------------------------------------------------------------===// 1123 1124 [&](const Fortran::lower::BoxAnalyzer::None &) { 1125 mlir::emitError(loc, "symbol analysis failed on ") 1126 << toStringRef(sym.name()); 1127 }); 1128 } 1129 1130 void Fortran::lower::defineModuleVariable( 1131 AbstractConverter &converter, const Fortran::lower::pft::Variable &var) { 1132 // Use empty linkage for module variables, which makes them available 1133 // for use in another unit. 1134 mlir::StringAttr externalLinkage; 1135 if (!var.isGlobal()) 1136 fir::emitFatalError(converter.getCurrentLocation(), 1137 "attempting to lower module variable as local"); 1138 // Define aggregate storages for equivalenced objects. 1139 if (var.isAggregateStore()) { 1140 const mlir::Location loc = converter.genLocation(var.getSymbol().name()); 1141 TODO(loc, "defineModuleVariable aggregateStore"); 1142 } 1143 const Fortran::semantics::Symbol &sym = var.getSymbol(); 1144 if (Fortran::semantics::FindCommonBlockContaining(var.getSymbol())) { 1145 const mlir::Location loc = converter.genLocation(sym.name()); 1146 TODO(loc, "defineModuleVariable common block"); 1147 } else if (var.isAlias()) { 1148 // Do nothing. Mapping will be done on user side. 1149 } else { 1150 std::string globalName = Fortran::lower::mangle::mangleName(sym); 1151 defineGlobal(converter, var, globalName, externalLinkage); 1152 } 1153 } 1154 1155 void Fortran::lower::instantiateVariable(AbstractConverter &converter, 1156 const pft::Variable &var, 1157 SymMap &symMap, 1158 AggregateStoreMap &storeMap) { 1159 const Fortran::semantics::Symbol &sym = var.getSymbol(); 1160 const mlir::Location loc = converter.genLocation(sym.name()); 1161 if (var.isAggregateStore()) { 1162 TODO(loc, "instantiateVariable AggregateStore"); 1163 } else if (Fortran::semantics::FindCommonBlockContaining( 1164 var.getSymbol().GetUltimate())) { 1165 TODO(loc, "instantiateVariable Common"); 1166 } else if (var.isAlias()) { 1167 TODO(loc, "instantiateVariable Alias"); 1168 } else if (var.isGlobal()) { 1169 instantiateGlobal(converter, var, symMap); 1170 } else { 1171 instantiateLocal(converter, var, symMap); 1172 } 1173 } 1174 1175 void Fortran::lower::mapCallInterfaceSymbols( 1176 AbstractConverter &converter, const Fortran::lower::CallerInterface &caller, 1177 SymMap &symMap) { 1178 Fortran::lower::AggregateStoreMap storeMap; 1179 const Fortran::semantics::Symbol &result = caller.getResultSymbol(); 1180 for (Fortran::lower::pft::Variable var : 1181 Fortran::lower::pft::buildFuncResultDependencyList(result)) { 1182 if (var.isAggregateStore()) { 1183 instantiateVariable(converter, var, symMap, storeMap); 1184 } else { 1185 const Fortran::semantics::Symbol &sym = var.getSymbol(); 1186 const auto *hostDetails = 1187 sym.detailsIf<Fortran::semantics::HostAssocDetails>(); 1188 if (hostDetails && !var.isModuleVariable()) { 1189 // The callee is an internal procedure `A` whose result properties 1190 // depend on host variables. The caller may be the host, or another 1191 // internal procedure `B` contained in the same host. In the first 1192 // case, the host symbol is obviously mapped, in the second case, it 1193 // must also be mapped because 1194 // HostAssociations::internalProcedureBindings that was called when 1195 // lowering `B` will have mapped all host symbols of captured variables 1196 // to the tuple argument containing the composite of all host associated 1197 // variables, whether or not the host symbol is actually referred to in 1198 // `B`. Hence it is possible to simply lookup the variable associated to 1199 // the host symbol without having to go back to the tuple argument. 1200 Fortran::lower::SymbolBox hostValue = 1201 symMap.lookupSymbol(hostDetails->symbol()); 1202 assert(hostValue && "callee host symbol must be mapped on caller side"); 1203 symMap.addSymbol(sym, hostValue.toExtendedValue()); 1204 // The SymbolBox associated to the host symbols is complete, skip 1205 // instantiateVariable that would try to allocate a new storage. 1206 continue; 1207 } 1208 if (Fortran::semantics::IsDummy(sym) && sym.owner() == result.owner()) { 1209 // Get the argument for the dummy argument symbols of the current call. 1210 symMap.addSymbol(sym, caller.getArgumentValue(sym)); 1211 // All the properties of the dummy variable may not come from the actual 1212 // argument, let instantiateVariable handle this. 1213 } 1214 // If this is neither a host associated or dummy symbol, it must be a 1215 // module or common block variable to satisfy specification expression 1216 // requirements in 10.1.11, instantiateVariable will get its address and 1217 // properties. 1218 instantiateVariable(converter, var, symMap, storeMap); 1219 } 1220 } 1221 } 1222