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