summaryrefslogtreecommitdiff
path: root/flang/lib/Lower/ConvertVariable.cpp
diff options
context:
space:
mode:
Diffstat (limited to 'flang/lib/Lower/ConvertVariable.cpp')
-rw-r--r--flang/lib/Lower/ConvertVariable.cpp119
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");