Skip to content

Lower initial data target #688

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 2 commits into from
Mar 19, 2021
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
140 changes: 125 additions & 15 deletions flang/lib/Lower/ConvertVariable.cpp
Original file line number Diff line number Diff line change
Expand Up @@ -123,6 +123,105 @@ static fir::GlobalOp declareGlobal(Fortran::lower::AbstractConverter &converter,
return builder.createGlobal(loc, converter.genType(var), globalName, linkage);
}

/// Temporary helper to catch todos in initial data target lowering.
static bool
hasDerivedTypeWithLengthParameters(const Fortran::semantics::Symbol &sym) {
if (const auto *declTy = sym.GetType())
if (const auto *derived = declTy->AsDerived())
return Fortran::semantics::CountLenParameters(*derived) > 0;
return false;
}

static mlir::Type unwrapElementType(mlir::Type type) {
if (auto ty = fir::dyn_cast_ptrOrBoxEleTy(type))
type = ty;
if (auto seqType = type.dyn_cast<fir::SequenceType>())
type = seqType.getEleTy();
return type;

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I'm surprised this isn't already implemented someplace. Seems to pop up often.

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Right, we had a discussion a while ago about having this in FIRType.h. For types that wraps character/record, we might want quick access on the character/record type to take decisions based on the length parameters. The conclusion at the time was that it was too custom (so there is something very similar in CharacterExpr.cpp).
Would you be in favor of moving this in FIRType.h ?

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Seems like the best place for it, if it can reduce some replication.

}

/// Helper to create initial-data-target fir.box in a global initializer region.
static mlir::Value
genInitialDataTarget(Fortran::lower::AbstractConverter &converter,
mlir::Location loc, mlir::Type boxType,
const Fortran::lower::SomeExpr &initialTarget) {
Fortran::lower::SymMap globalOpSymMap;
Fortran::lower::AggregateStoreMap storeMap;
Fortran::lower::StatementContext stmtCtx;
auto &builder = converter.getFirOpBuilder();
if (Fortran::common::Unwrap<Fortran::evaluate::NullPointer>(initialTarget))
return Fortran::lower::createUnallocatedBox(
builder, loc, boxType, /*nonDeferredParams*/ llvm::None);
// Pointer initial data target, and NULL(mold).
if (const auto *sym = Fortran::evaluate::GetFirstSymbol(initialTarget)) {
// Length parameters processing will need care in global initializer
// context.
if (hasDerivedTypeWithLengthParameters(*sym))
TODO(loc, "initial-data-target with derived type length parameters");

auto var = Fortran::lower::pft::Variable(*sym, /*global*/ true);
Fortran::lower::instantiateVariable(converter, var, globalOpSymMap,
storeMap);
}
mlir::Value box;
if (initialTarget.Rank() > 0) {
box = fir::getBase(Fortran::lower::createSomeArrayBox(
converter, initialTarget, globalOpSymMap, stmtCtx));
} else {
auto addr = Fortran::lower::createSomeExtendedAddress(
loc, converter, initialTarget, globalOpSymMap, stmtCtx);
box = builder.createBox(loc, addr);
}
// box is a fir.box<T>, not a fir.box<fir.ptr<T>> as it should to be used
// for pointers. A fir.convert should not be used here, because it would
// not actually set the pointer attribute in the descriptor.
// In a normal context, fir.rebox would be used to set the pointer attribute
// while copying the projection from another fir.box. But fir.rebox cannot be
// used in initializer because its current codegen expects that the input
// fir.box is in memory, which is not the case in initializers.
// So, just replace the fir.embox that created addr with one with
// fir.box<fir.ptr<T>> result type.
// Note that the descriptor cannot have been created with fir.rebox because
// the initial-data-target cannot be a fir.box itself (it cannot be
// assumed-shape, deferred-shape, or polymorphic as per C765). However the
// case where the initial data target is a derived type with length parameters
// will most likely be a bit trickier, hence the TODO above.

auto *op = box.getDefiningOp();
if (!op || !mlir::isa<fir::EmboxOp>(*op))
fir::emitFatalError(
loc, "fir.box must be created with embox in global initializers");
auto targetEleTy = unwrapElementType(box.getType());
if (!targetEleTy.isa<fir::CharacterType>())
return builder.create<fir::EmboxOp>(loc, boxType, op->getOperands(),
op->getAttrs());

// Handle the character case length particularities: embox takes a length
// value argument when the result type has unknown length, but not when the
// result type has constant length. The type of the initial target must be
// constant length, but the one of the pointer may not be. In this case, a
// length operand must be added.
auto targetLen = targetEleTy.cast<fir::CharacterType>().getLen();
auto ptrLen = unwrapElementType(boxType).cast<fir::CharacterType>().getLen();
if (ptrLen == targetLen)
// Nothing to do
return builder.create<fir::EmboxOp>(loc, boxType, op->getOperands(),
op->getAttrs());
auto embox = mlir::cast<fir::EmboxOp>(*op);
auto ptrType = boxType.cast<fir::BoxType>().getEleTy();
auto memref = builder.createConvert(loc, ptrType, embox.memref());
if (targetLen == fir::CharacterType::unknownLen())
// Drop the length argument.
return builder.create<fir::EmboxOp>(loc, boxType, memref, embox.shape(),
embox.slice());
// targetLen is constant and ptrLen is unknown. Add a length argument.
auto targetLenValue =
builder.createIntegerConstant(loc, builder.getIndexType(), targetLen);
return builder.create<fir::EmboxOp>(loc, boxType, memref, embox.shape(),
embox.slice(),
mlir::ValueRange{targetLenValue});
}

/// Create the global op and its init if it has one
static fir::GlobalOp defineGlobal(Fortran::lower::AbstractConverter &converter,
const Fortran::lower::pft::Variable &var,
Expand All @@ -135,20 +234,27 @@ static fir::GlobalOp defineGlobal(Fortran::lower::AbstractConverter &converter,
fir::GlobalOp global;
if (Fortran::semantics::IsAllocatableOrPointer(sym)) {
auto symTy = converter.genType(var);
// Pointers may have an initial target
if (Fortran::semantics::IsPointer(sym)) {
const auto *details =
sym.detailsIf<Fortran::semantics::ObjectEntityDetails>();
if (details && details->init())
mlir::emitError(loc, "TODO: global pointer initialization");
const auto *details =
sym.detailsIf<Fortran::semantics::ObjectEntityDetails>();
if (details && details->init()) {
auto expr = *details->init();
auto init = [&](Fortran::lower::FirOpBuilder &b) {
auto box = genInitialDataTarget(converter, loc, symTy, expr);
b.create<fir::HasValueOp>(loc, box);
};
global =
builder.createGlobal(loc, symTy, globalName, isConst, init, linkage);
} else {
// Create unallocated/disassociated descriptor if no explicit init
auto init = [&](Fortran::lower::FirOpBuilder &b) {
auto box =
Fortran::lower::createUnallocatedBox(b, loc, symTy, llvm::None);
b.create<fir::HasValueOp>(loc, box);
};
global =
builder.createGlobal(loc, symTy, globalName, isConst, init, linkage);
}
auto init = [&](Fortran::lower::FirOpBuilder &b) {
auto box =
Fortran::lower::createUnallocatedBox(b, loc, symTy, llvm::None);
b.create<fir::HasValueOp>(loc, box);
};
global =
builder.createGlobal(loc, symTy, globalName, isConst, init, linkage);

} else if (const auto *details =
sym.detailsIf<Fortran::semantics::ObjectEntityDetails>()) {
if (details->init()) {
Expand Down Expand Up @@ -621,8 +727,12 @@ defineCommonBlock(Fortran::lower::AbstractConverter &converter,
LLVM_DEBUG(llvm::dbgs()
<< "offset: " << mem->offset() << " is " << *mem << '\n');
Fortran::lower::StatementContext stmtCtx;
auto initVal = genInitializerExprValue(
converter, loc, memDet->init().value(), stmtCtx);
auto initExpr = memDet->init().value();
auto initVal =
Fortran::semantics::IsPointer(*mem)
? genInitialDataTarget(converter, loc,
converter.genType(*mem), initExpr)
: genInitializerExprValue(converter, loc, initExpr, stmtCtx);
auto offVal = builder.createIntegerConstant(loc, idxTy, tupIdx);
auto castVal = builder.createConvert(loc, commonTy.getType(tupIdx),
fir::getBase(initVal));
Expand Down
27 changes: 23 additions & 4 deletions flang/lib/Optimizer/CodeGen/TypeConverter.h
Original file line number Diff line number Diff line change
Expand Up @@ -79,8 +79,14 @@ class LLVMTypeConverter : public mlir::LLVMTypeConverter {
llvm::SmallVector<mlir::Type, 8> inMembers;
tuple.getFlattenedTypes(inMembers);
llvm::SmallVector<mlir::Type, 8> members;
for (auto mem : inMembers)
members.push_back(convertType(mem).cast<mlir::Type>());
for (auto mem : inMembers) {
// Prevent fir.box from degenerating to a pointer to a descriptor in the
// context of a tuple type.
if (auto box = mem.dyn_cast<fir::BoxType>())
members.push_back(convertBoxTypeAsStruct(box));
else
members.push_back(convertType(mem).cast<mlir::Type>());
}
return mlir::LLVM::LLVMStructType::getLiteral(&getContext(), members,
/*isPacked=*/false);
});
Expand Down Expand Up @@ -171,6 +177,13 @@ class LLVMTypeConverter : public mlir::LLVMTypeConverter {
mlir::LLVM::LLVMStructType::getLiteral(&getContext(), parts,
/*isPacked=*/false));
}
/// Convert fir.box type to the corresponding llvm struct type instead of a
/// pointer to this struct type.
mlir::Type convertBoxTypeAsStruct(BoxType box) {
return convertBoxType(box)
.cast<mlir::LLVM::LLVMPointerType>()
.getElementType();
}

// fir.boxproc<any> --> llvm<"{ any*, i8* }">
mlir::Type convertBoxProcType(BoxProcType boxproc) {
Expand Down Expand Up @@ -269,8 +282,14 @@ class LLVMTypeConverter : public mlir::LLVMTypeConverter {
auto st = mlir::LLVM::LLVMStructType::getIdentified(&getContext(), name);
identStructCache[name] = st;
llvm::SmallVector<mlir::Type, 8> members;
for (auto mem : derived.getTypeList())
members.push_back(convertType(mem.second).cast<mlir::Type>());
for (auto mem : derived.getTypeList()) {
// Prevent fir.box from degenerating to a pointer to a descriptor in the
// context of a record type.
if (auto box = mem.second.dyn_cast<fir::BoxType>())
members.push_back(convertBoxTypeAsStruct(box));
else
members.push_back(convertType(mem.second).cast<mlir::Type>());
}
(void)st.setBody(members, /*isPacked=*/false);
return st;
}
Expand Down
79 changes: 79 additions & 0 deletions flang/test/Lower/pointer-initial-target-2.f90
Original file line number Diff line number Diff line change
@@ -0,0 +1,79 @@
! Test lowering of pointer initial target
! RUN: bbc -emit-fir %s -o - | FileCheck %s

! This tests focus on the scope context of initial data target.
! More complete tests regarding the initial data target expression
! are done in pointer-initial-target.f90.

! Test pointer initial data target in modules
module some_mod
real, target :: x(100)
real, pointer :: p(:) => x
! CHECK-LABEL: fir.global linkonce @_QMsome_modEp : !fir.box<!fir.ptr<!fir.array<?xf32>>> {
! CHECK: %[[x:.*]] = fir.address_of(@_QMsome_modEx) : !fir.ref<!fir.array<100xf32>>
! CHECK: %[[shape:.*]] = fir.shape %c100{{.*}} : (index) -> !fir.shape<1>
! CHECK: %[[box:.*]] = fir.embox %[[x]](%[[shape]]) : (!fir.ref<!fir.array<100xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
! CHECK: fir.has_value %[[box]] : !fir.box<!fir.ptr<!fir.array<?xf32>>>
end module

! Test initial data target in a common block
module some_mod_2
real, target :: x(100), y(10:209)
common /com/ x, y
save :: /com/
real, pointer :: p(:) => y
! CHECK-LABEL: fir.global linkonce @_QMsome_mod_2Ep : !fir.box<!fir.ptr<!fir.array<?xf32>>> {
! CHECK: %[[c:.*]] = fir.address_of(@_QBcom) : !fir.ref<!fir.array<1200xi8>>
! CHECK: %[[com:.*]] = fir.convert %[[c]] : (!fir.ref<!fir.array<1200xi8>>) -> !fir.ref<!fir.array<?xi8>>
! CHECK: %[[yRaw:.*]] = fir.coordinate_of %[[com]], %c400{{.*}} : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
! CHECK: %[[y:.*]] = fir.convert %[[yRaw]] : (!fir.ref<i8>) -> !fir.ref<!fir.array<200xf32>>
! CHECK: %[[shape:.*]] = fir.shape_shift %c10{{.*}}, %c200{{.*}} : (index, index) -> !fir.shapeshift<1>
! CHECK: %[[box:.*]] = fir.embox %[[y]](%[[shape]]) : (!fir.ref<!fir.array<200xf32>>, !fir.shapeshift<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
! CHECK: fir.has_value %[[box]] : !fir.box<!fir.ptr<!fir.array<?xf32>>>
end module

! Test pointer initial data target with pointer in common blocks
block data
real, pointer :: p
real, save, target :: b
common /a/ p
data p /b/
! CHECK-LABEL: fir.global @_QBa : tuple<!fir.box<!fir.ptr<f32>>>
! CHECK: %[[undef:.*]] = fir.undefined tuple<!fir.box<!fir.ptr<f32>>>
! CHECK: %[[b:.*]] = fir.address_of(@_QEb) : !fir.ref<f32>
! CHECK: %[[box:.*]] = fir.embox %[[b]] : (!fir.ref<f32>) -> !fir.box<!fir.ptr<f32>>
! CHECK: %[[a:.*]] = fir.insert_value %[[undef]], %[[box]], %c0{{.*}} : (tuple<!fir.box<!fir.ptr<f32>>>, !fir.box<!fir.ptr<f32>>, index) -> tuple<!fir.box<!fir.ptr<f32>>>
! CHECK: fir.has_value %[[a]] : tuple<!fir.box<!fir.ptr<f32>>>
end block data

! Test pointer in a common with initial target in the same common.
block data snake
integer, target :: b = 42
integer, pointer :: p => b
common /snake/ p, b
! CHECK-LABEL: fir.global @_QBsnake : tuple<!fir.box<!fir.ptr<i32>>, i32>
! CHECK: %[[tuple0:.*]] = fir.undefined tuple<!fir.box<!fir.ptr<i32>>, i32>
! CHECK: %[[snakeAddr:.*]] = fir.address_of(@_QBsnake) : !fir.ref<tuple<!fir.box<!fir.ptr<i32>>, i32>>
! CHECK: %[[byteView:.*]] = fir.convert %[[snakeAddr:.*]] : (!fir.ref<tuple<!fir.box<!fir.ptr<i32>>, i32>>) -> !fir.ref<!fir.array<?xi8>>
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[byteView]], %c24{{.*}} : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
! CHECK: %[[bAddr:.*]] = fir.convert %[[coor]] : (!fir.ref<i8>) -> !fir.ref<i32>
! CHECK: %[[box:.*]] = fir.embox %[[bAddr]] : (!fir.ref<i32>) -> !fir.box<!fir.ptr<i32>>
! CHECK: %[[tuple1:.*]] = fir.insert_value %[[tuple0]], %[[box]], %c0{{.*}} : (tuple<!fir.box<!fir.ptr<i32>>, i32>, !fir.box<!fir.ptr<i32>>, index) -> tuple<!fir.box<!fir.ptr<i32>>, i32>
! CHECK: %[[tuple2:.*]] = fir.insert_value %[[tuple1]], %c42{{.*}}, %c1{{.*}} : (tuple<!fir.box<!fir.ptr<i32>>, i32>, i32, index) -> tuple<!fir.box<!fir.ptr<i32>>, i32>
! CHECK: fir.has_value %[[tuple2]] : tuple<!fir.box<!fir.ptr<i32>>, i32>
end block data

! Test two common depending on each others because of initial data
! targets
block data tied
real, target :: x1 = 42
real, target :: x2 = 43
real, pointer :: p1 => x2
real, pointer :: p2 => x1
common /c1/ x1, p1
common /c2/ x2, p2
! CHECK-LABEL: fir.global @_QBc1 : tuple<f32, !fir.array<4xi8>, !fir.box<!fir.ptr<f32>>>
! CHECK: fir.address_of(@_QBc2) : !fir.ref<tuple<f32, !fir.array<4xi8>, !fir.box<!fir.ptr<f32>>>>
! CHECK-LABEL: fir.global @_QBc2 : tuple<f32, !fir.array<4xi8>, !fir.box<!fir.ptr<f32>>>
! CHECK: fir.address_of(@_QBc1) : !fir.ref<tuple<f32, !fir.array<4xi8>, !fir.box<!fir.ptr<f32>>>>
end block data
Loading