diff options
Diffstat (limited to 'flang/lib/Lower/ConvertVariable.cpp')
| -rw-r--r-- | flang/lib/Lower/ConvertVariable.cpp | 119 |
1 files changed, 36 insertions, 83 deletions
diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp index fd66592bc285..ccfde16ce2c3 100644 --- a/flang/lib/Lower/ConvertVariable.cpp +++ b/flang/lib/Lower/ConvertVariable.cpp @@ -786,62 +786,6 @@ static mlir::Value createNewLocal(Fortran::lower::AbstractConverter &converter, return res; } -/// Device allocatable components in a derived-type don't have the correct -/// allocator index in their descriptor when they are created. After -/// initialization, cuf.set_allocator_idx operations are inserted to set the -/// correct allocator index for each device component. -static void -initializeDeviceComponentAllocator(Fortran::lower::AbstractConverter &converter, - const Fortran::semantics::Symbol &symbol, - Fortran::lower::SymMap &symMap) { - if (const auto *details{ - symbol.GetUltimate() - .detailsIf<Fortran::semantics::ObjectEntityDetails>()}) { - const Fortran::semantics::DeclTypeSpec *type{details->type()}; - const Fortran::semantics::DerivedTypeSpec *derived{type ? type->AsDerived() - : nullptr}; - if (derived) { - if (!FindCUDADeviceAllocatableUltimateComponent(*derived)) - return; // No device components. - - fir::FirOpBuilder &builder = converter.getFirOpBuilder(); - mlir::Location loc = converter.getCurrentLocation(); - - fir::ExtendedValue exv = - converter.getSymbolExtendedValue(symbol.GetUltimate(), &symMap); - mlir::Type baseTy = fir::unwrapRefType(fir::getBase(exv).getType()); - if (auto boxTy = mlir::dyn_cast<fir::BaseBoxType>(baseTy)) - baseTy = boxTy.getEleTy(); - baseTy = fir::unwrapRefType(baseTy); - - if (fir::isAllocatableType(fir::getBase(exv).getType()) || - fir::isPointerType(fir::getBase(exv).getType())) - return; // Allocator index need to be set after allocation. - - auto recTy = - mlir::dyn_cast<fir::RecordType>(fir::unwrapSequenceType(baseTy)); - assert(recTy && "expected fir::RecordType"); - - Fortran::semantics::UltimateComponentIterator components{*derived}; - for (const auto &sym : components) { - if (Fortran::semantics::IsDeviceAllocatable(sym)) { - llvm::SmallVector<mlir::Value> coord; - mlir::Type fieldTy = - Fortran::lower::gatherDeviceComponentCoordinatesAndType( - builder, loc, sym, recTy, coord); - mlir::Value base = fir::getBase(exv); - mlir::Value comp = fir::CoordinateOp::create( - builder, loc, builder.getRefType(fieldTy), base, coord); - cuf::DataAttributeAttr dataAttr = - Fortran::lower::translateSymbolCUFDataAttribute( - builder.getContext(), sym); - cuf::SetAllocatorIndexOp::create(builder, loc, comp, dataAttr); - } - } - } - } -} - /// Must \p var be default initialized at runtime when entering its scope. static bool mustBeDefaultInitializedAtRuntime(const Fortran::lower::pft::Variable &var) { @@ -898,7 +842,8 @@ void Fortran::lower::defaultInitializeAtRuntime( Fortran::semantics::DeclTypeSpec::Category::TypeDerived && !mlir::isa<fir::SequenceType>(symTy) && !sym.test(Fortran::semantics::Symbol::Flag::OmpPrivate) && - !sym.test(Fortran::semantics::Symbol::Flag::OmpFirstPrivate)) { + !sym.test(Fortran::semantics::Symbol::Flag::OmpFirstPrivate) && + !Fortran::semantics::HasCUDAComponent(sym)) { std::string globalName = fir::NameUniquer::doGenerated( (converter.mangleName(*declTy->AsDerived()) + fir::kNameSeparator + fir::kDerivedTypeInitSuffix) @@ -1164,9 +1109,6 @@ static void instantiateLocal(Fortran::lower::AbstractConverter &converter, if (mustBeDefaultInitializedAtRuntime(var)) Fortran::lower::defaultInitializeAtRuntime(converter, var.getSymbol(), symMap); - if (converter.getFoldingContext().languageFeatures().IsEnabled( - Fortran::common::LanguageFeature::CUDA)) - initializeDeviceComponentAllocator(converter, var.getSymbol(), symMap); auto *builder = &converter.getFirOpBuilder(); if (needCUDAAlloc(var.getSymbol()) && !cuf::isCUDADeviceContext(builder->getRegion())) { @@ -1413,6 +1355,7 @@ static void instantiateAlias(Fortran::lower::AbstractConverter &converter, mlir::Value bytePtr = fir::CoordinateOp::create( builder, loc, i8Ptr, storeAddr, mlir::ValueRange{offset}); mlir::Value typedPtr = castAliasToPointer(builder, loc, symType, bytePtr); + converter.bindSymbolStorage(sym, {storeAddr, off}); Fortran::lower::StatementContext stmtCtx; mapSymbolAttributes(converter, var, symMap, stmtCtx, typedPtr); // Default initialization is possible for equivalence members: see @@ -1425,9 +1368,6 @@ static void instantiateAlias(Fortran::lower::AbstractConverter &converter, if (mustBeDefaultInitializedAtRuntime(var)) Fortran::lower::defaultInitializeAtRuntime(converter, var.getSymbol(), symMap); - if (converter.getFoldingContext().languageFeatures().IsEnabled( - Fortran::common::LanguageFeature::CUDA)) - initializeDeviceComponentAllocator(converter, var.getSymbol(), symMap); } //===--------------------------------------------------------------===// @@ -1655,13 +1595,15 @@ void Fortran::lower::defineCommonBlocks( mlir::Value Fortran::lower::genCommonBlockMember( Fortran::lower::AbstractConverter &converter, mlir::Location loc, - const Fortran::semantics::Symbol &sym, mlir::Value commonValue) { + const Fortran::semantics::Symbol &sym, mlir::Value commonValue, + std::size_t commonSize) { fir::FirOpBuilder &builder = converter.getFirOpBuilder(); std::size_t byteOffset = sym.GetUltimate().offset(); mlir::IntegerType i8Ty = builder.getIntegerType(8); mlir::Type i8Ptr = builder.getRefType(i8Ty); - mlir::Type seqTy = builder.getRefType(builder.getVarLenSeqTy(i8Ty)); + fir::SequenceType::Shape shape(1, commonSize); + mlir::Type seqTy = builder.getRefType(fir::SequenceType::get(shape, i8Ty)); mlir::Value base = builder.createConvert(loc, seqTy, commonValue); mlir::Value offs = @@ -1670,6 +1612,8 @@ mlir::Value Fortran::lower::genCommonBlockMember( mlir::ValueRange{offs}); mlir::Type symType = converter.genType(sym); + converter.bindSymbolStorage(sym, {base, byteOffset}); + return Fortran::semantics::FindEquivalenceSet(sym) != nullptr ? castAliasToPointer(builder, loc, symType, varAddr) : builder.createConvert(loc, builder.getRefType(symType), varAddr); @@ -1698,7 +1642,8 @@ static void instantiateCommon(Fortran::lower::AbstractConverter &converter, symMap.addSymbol(common, commonAddr); } - mlir::Value local = genCommonBlockMember(converter, loc, varSym, commonAddr); + mlir::Value local = + genCommonBlockMember(converter, loc, varSym, commonAddr, common.size()); Fortran::lower::StatementContext stmtCtx; mapSymbolAttributes(converter, var, symMap, stmtCtx, local); } @@ -1720,7 +1665,7 @@ static bool lowerToBoxValue(const Fortran::semantics::Symbol &sym, return true; // Assumed rank and optional fir.box cannot yet be read while lowering the // specifications. - if (Fortran::evaluate::IsAssumedRank(sym) || + if (Fortran::semantics::IsAssumedRank(sym) || Fortran::semantics::IsOptional(sym)) return true; // Polymorphic entity should be tracked through a fir.box that has the @@ -1970,7 +1915,8 @@ static void genDeclareSymbol(Fortran::lower::AbstractConverter &converter, // Declare a local pointer variable. auto newBase = hlfir::DeclareOp::create( builder, loc, boxAlloc, name, /*shape=*/nullptr, lenParams, - /*dummy_scope=*/nullptr, attributes); + /*dummy_scope=*/nullptr, /*storage=*/nullptr, + /*storage_offset=*/0, attributes); mlir::Value nullAddr = builder.createNullConstant( loc, llvm::cast<fir::BaseBoxType>(ptrBoxType).getEleTy()); @@ -2000,9 +1946,10 @@ static void genDeclareSymbol(Fortran::lower::AbstractConverter &converter, mlir::Value dummyScope; if (converter.isRegisteredDummySymbol(sym)) dummyScope = converter.dummyArgsScopeValue(); - auto newBase = - hlfir::DeclareOp::create(builder, loc, base, name, shapeOrShift, - lenParams, dummyScope, attributes, dataAttr); + auto [storage, storageOffset] = converter.getSymbolStorage(sym); + auto newBase = hlfir::DeclareOp::create( + builder, loc, base, name, shapeOrShift, lenParams, dummyScope, storage, + storageOffset, attributes, dataAttr); symMap.addVariableDefinition(sym, newBase, force); return; } @@ -2060,8 +2007,10 @@ void Fortran::lower::genDeclareSymbol( base = genPackArray(converter, sym, exv); dummyScope = converter.dummyArgsScopeValue(); } - hlfir::EntityWithAttributes declare = hlfir::genDeclare( - loc, builder, base, name, attributes, dummyScope, dataAttr); + auto [storage, storageOffset] = converter.getSymbolStorage(sym); + hlfir::EntityWithAttributes declare = + hlfir::genDeclare(loc, builder, base, name, attributes, dummyScope, + storage, storageOffset, dataAttr); symMap.addVariableDefinition(sym, declare.getIfVariableInterface(), force); return; } @@ -2149,15 +2098,19 @@ void Fortran::lower::mapSymbolAttributes( if (Fortran::semantics::IsProcedure(sym)) { if (isUnusedEntryDummy) { // Additional discussion below. - mlir::Type dummyProcType = - Fortran::lower::getDummyProcedureType(sym, converter); - mlir::Value undefOp = fir::UndefOp::create(builder, loc, dummyProcType); - - Fortran::lower::genDeclareSymbol(converter, symMap, sym, undefOp); - } - - // Procedure pointer. - if (Fortran::semantics::IsPointer(sym)) { + if (Fortran::semantics::IsPointer(sym)) { + mlir::Type procPtrType = + Fortran::lower::getDummyProcedurePointerType(sym, converter); + mlir::Value undefOp = fir::UndefOp::create(builder, loc, procPtrType); + genProcPointer(converter, symMap, sym, undefOp, replace); + } else { + mlir::Type dummyProcType = + Fortran::lower::getDummyProcedureType(sym, converter); + mlir::Value undefOp = fir::UndefOp::create(builder, loc, dummyProcType); + Fortran::lower::genDeclareSymbol(converter, symMap, sym, undefOp); + } + } else if (Fortran::semantics::IsPointer(sym)) { + // Used procedure pointer. // global mlir::Value boxAlloc = preAlloc; // dummy or passed result @@ -2172,7 +2125,7 @@ void Fortran::lower::mapSymbolAttributes( return; } - const bool isAssumedRank = Fortran::evaluate::IsAssumedRank(sym); + const bool isAssumedRank = Fortran::semantics::IsAssumedRank(sym); if (isAssumedRank && !allowAssumedRank) TODO(loc, "assumed-rank variable in procedure implemented in Fortran"); |
