Skip to content

Commit ec2c3ee

Browse files
jeanPerierjeanPerier
committed
Implement pointer initial data target lowering
1 parent adc0320 commit ec2c3ee

File tree

3 files changed

+363
-15
lines changed

3 files changed

+363
-15
lines changed

‎flang/lib/Lower/ConvertVariable.cpp

Lines changed: 125 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -123,6 +123,105 @@ static fir::GlobalOp declareGlobal(Fortran::lower::AbstractConverter &converter,
123123
return builder.createGlobal(loc, converter.genType(var), globalName, linkage);
124124
}
125125

126+
/// Temporary helper to catch todos in initial data target lowering.
127+
static bool
128+
hasDerivedTypeWithLengthParameters(const Fortran::semantics::Symbol &sym) {
129+
if (const auto *declTy = sym.GetType())
130+
if (const auto *derived = declTy->AsDerived())
131+
return Fortran::semantics::CountLenParameters(*derived) > 0;
132+
return false;
133+
}
134+
135+
static mlir::Type unwrapElementType(mlir::Type type) {
136+
if (auto ty = fir::dyn_cast_ptrOrBoxEleTy(type))
137+
type = ty;
138+
if (auto seqType = type.dyn_cast<fir::SequenceType>())
139+
type = seqType.getEleTy();
140+
return type;
141+
}
142+
143+
/// Helper to create initial-data-target fir.box in a global initializer region.
144+
static mlir::Value
145+
genInitialDataTarget(Fortran::lower::AbstractConverter &converter,
146+
mlir::Location loc, mlir::Type boxType,
147+
const Fortran::lower::SomeExpr &initialTarget) {
148+
Fortran::lower::SymMap globalOpSymMap;
149+
Fortran::lower::AggregateStoreMap storeMap;
150+
Fortran::lower::StatementContext stmtCtx;
151+
auto &builder = converter.getFirOpBuilder();
152+
if (Fortran::common::Unwrap<Fortran::evaluate::NullPointer>(initialTarget))
153+
return Fortran::lower::createUnallocatedBox(
154+
builder, loc, boxType, /*nonDeferredParams*/ llvm::None);
155+
// Pointer initial data target, and NULL(mold).
156+
if (const auto *sym = Fortran::evaluate::GetFirstSymbol(initialTarget)) {
157+
// Length parameters processing will need care in global initializer
158+
// context.
159+
if (hasDerivedTypeWithLengthParameters(*sym))
160+
TODO(loc, "initial-data-target with derived type length parameters");
161+
162+
auto var = Fortran::lower::pft::Variable(*sym, /*global*/ true);
163+
Fortran::lower::instantiateVariable(converter, var, globalOpSymMap,
164+
storeMap);
165+
}
166+
mlir::Value box;
167+
if (initialTarget.Rank() > 0) {
168+
box = fir::getBase(Fortran::lower::createSomeArrayBox(
169+
converter, initialTarget, globalOpSymMap, stmtCtx));
170+
} else {
171+
auto addr = Fortran::lower::createSomeExtendedAddress(
172+
loc, converter, initialTarget, globalOpSymMap, stmtCtx);
173+
box = builder.createBox(loc, addr);
174+
}
175+
// box is a fir.box<T>, not a fir.box<fir.ptr<T>> as it should to be used
176+
// for pointers. A fir.convert should not be used here, because it would
177+
// not actually set the pointer attribute in the descriptor.
178+
// In a normal context, fir.rebox would be used to set the pointer attribute
179+
// while copying the projection from another fir.box. But fir.rebox cannot be
180+
// used in initializer because its current codegen expects that the input
181+
// fir.box is in memory, which is not the case in initializers.
182+
// So, just replace the fir.embox that created addr with one with
183+
// fir.box<fir.ptr<T>> result type.
184+
// Note that the descriptor cannot have been created with fir.rebox because
185+
// the initial-data-target cannot be a fir.box itself (it cannot be
186+
// assumed-shape, deferred-shape, or polymorphic as per C765). However the
187+
// case where the initial data target is a derived type with length parameters
188+
// will most likely be a bit trickier, hence the TODO above.
189+
190+
auto *op = box.getDefiningOp();
191+
if (!op || !mlir::isa<fir::EmboxOp>(*op))
192+
fir::emitFatalError(
193+
loc, "fir.box must be created with embox in global initializers");
194+
auto targetEleTy = unwrapElementType(box.getType());
195+
if (!targetEleTy.isa<fir::CharacterType>())
196+
return builder.create<fir::EmboxOp>(loc, boxType, op->getOperands(),
197+
op->getAttrs());
198+
199+
// Handle the character case length particularities: embox takes a length
200+
// value argument when the result type has unknown length, but not when the
201+
// result type has constant length. The type of the initial target must be
202+
// constant length, but the one of the pointer may not be. In this case, a
203+
// length operand must be added.
204+
auto targetLen = targetEleTy.cast<fir::CharacterType>().getLen();
205+
auto ptrLen = unwrapElementType(boxType).cast<fir::CharacterType>().getLen();
206+
if (ptrLen == targetLen)
207+
// Nothing to do
208+
return builder.create<fir::EmboxOp>(loc, boxType, op->getOperands(),
209+
op->getAttrs());
210+
auto embox = mlir::cast<fir::EmboxOp>(*op);
211+
auto ptrType = boxType.cast<fir::BoxType>().getEleTy();
212+
auto memref = builder.createConvert(loc, ptrType, embox.memref());
213+
if (targetLen == fir::CharacterType::unknownLen())
214+
// Drop the length argument.
215+
return builder.create<fir::EmboxOp>(loc, boxType, memref, embox.shape(),
216+
embox.slice());
217+
// targetLen is constant and ptrLen is unknown. Add a length argument.
218+
auto targetLenValue =
219+
builder.createIntegerConstant(loc, builder.getIndexType(), targetLen);
220+
return builder.create<fir::EmboxOp>(loc, boxType, memref, embox.shape(),
221+
embox.slice(),
222+
mlir::ValueRange{targetLenValue});
223+
}
224+
126225
/// Create the global op and its init if it has one
127226
static fir::GlobalOp defineGlobal(Fortran::lower::AbstractConverter &converter,
128227
const Fortran::lower::pft::Variable &var,
@@ -135,20 +234,27 @@ static fir::GlobalOp defineGlobal(Fortran::lower::AbstractConverter &converter,
135234
fir::GlobalOp global;
136235
if (Fortran::semantics::IsAllocatableOrPointer(sym)) {
137236
auto symTy = converter.genType(var);
138-
// Pointers may have an initial target
139-
if (Fortran::semantics::IsPointer(sym)) {
140-
const auto *details =
141-
sym.detailsIf<Fortran::semantics::ObjectEntityDetails>();
142-
if (details && details->init())
143-
mlir::emitError(loc, "TODO: global pointer initialization");
237+
const auto *details =
238+
sym.detailsIf<Fortran::semantics::ObjectEntityDetails>();
239+
if (details && details->init()) {
240+
auto expr = *details->init();
241+
auto init = [&](Fortran::lower::FirOpBuilder &b) {
242+
auto box = genInitialDataTarget(converter, loc, symTy, expr);
243+
b.create<fir::HasValueOp>(loc, box);
244+
};
245+
global =
246+
builder.createGlobal(loc, symTy, globalName, isConst, init, linkage);
247+
} else {
248+
// Create unallocated/disassociated descriptor if no explicit init
249+
auto init = [&](Fortran::lower::FirOpBuilder &b) {
250+
auto box =
251+
Fortran::lower::createUnallocatedBox(b, loc, symTy, llvm::None);
252+
b.create<fir::HasValueOp>(loc, box);
253+
};
254+
global =
255+
builder.createGlobal(loc, symTy, globalName, isConst, init, linkage);
144256
}
145-
auto init = [&](Fortran::lower::FirOpBuilder &b) {
146-
auto box =
147-
Fortran::lower::createUnallocatedBox(b, loc, symTy, llvm::None);
148-
b.create<fir::HasValueOp>(loc, box);
149-
};
150-
global =
151-
builder.createGlobal(loc, symTy, globalName, isConst, init, linkage);
257+
152258
} else if (const auto *details =
153259
sym.detailsIf<Fortran::semantics::ObjectEntityDetails>()) {
154260
if (details->init()) {
@@ -621,8 +727,12 @@ defineCommonBlock(Fortran::lower::AbstractConverter &converter,
621727
LLVM_DEBUG(llvm::dbgs()
622728
<< "offset: " << mem->offset() << " is " << *mem << '\n');
623729
Fortran::lower::StatementContext stmtCtx;
624-
auto initVal = genInitializerExprValue(
625-
converter, loc, memDet->init().value(), stmtCtx);
730+
auto initExpr = memDet->init().value();
731+
auto initVal =
732+
Fortran::semantics::IsPointer(*mem)
733+
? genInitialDataTarget(converter, loc,
734+
converter.genType(*mem), initExpr)
735+
: genInitializerExprValue(converter, loc, initExpr, stmtCtx);
626736
auto offVal = builder.createIntegerConstant(loc, idxTy, tupIdx);
627737
auto castVal = builder.createConvert(loc, commonTy.getType(tupIdx),
628738
fir::getBase(initVal));

‎flang/test/Lower/pointer-initial-target-2.f90

Lines changed: 79 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,79 @@
1+
! Test lowering of pointer initial target
2+
! RUN: bbc -emit-fir %s -o - | FileCheck %s
3+
4+
! This tests focus on the scope context of initial data target.
5+
! More complete tests regarding the initial data target expression
6+
! are done in pointer-initial-target.f90.
7+
8+
! Test pointer initial data target in modules
9+
module some_mod
10+
real, target :: x(100)
11+
real, pointer :: p(:) => x
12+
! CHECK-LABEL: fir.global linkonce @_QMsome_modEp : !fir.box<!fir.ptr<!fir.array<?xf32>>> {
13+
! CHECK: %[[x:.*]] = fir.address_of(@_QMsome_modEx) : !fir.ref<!fir.array<100xf32>>
14+
! CHECK: %[[shape:.*]] = fir.shape %c100{{.*}} : (index) -> !fir.shape<1>
15+
! CHECK: %[[box:.*]] = fir.embox %[[x]](%[[shape]]) : (!fir.ref<!fir.array<100xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
16+
! CHECK: fir.has_value %[[box]] : !fir.box<!fir.ptr<!fir.array<?xf32>>>
17+
end module
18+
19+
! Test initial data target in a common block
20+
module some_mod_2
21+
real, target :: x(100), y(10:209)
22+
common /com/ x, y
23+
save :: /com/
24+
real, pointer :: p(:) => y
25+
! CHECK-LABEL: fir.global linkonce @_QMsome_mod_2Ep : !fir.box<!fir.ptr<!fir.array<?xf32>>> {
26+
! CHECK: %[[c:.*]] = fir.address_of(@_QBcom) : !fir.ref<!fir.array<1200xi8>>
27+
! CHECK: %[[com:.*]] = fir.convert %[[c]] : (!fir.ref<!fir.array<1200xi8>>) -> !fir.ref<!fir.array<?xi8>>
28+
! CHECK: %[[yRaw:.*]] = fir.coordinate_of %[[com]], %c400{{.*}} : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
29+
! CHECK: %[[y:.*]] = fir.convert %[[yRaw]] : (!fir.ref<i8>) -> !fir.ref<!fir.array<200xf32>>
30+
! CHECK: %[[shape:.*]] = fir.shape_shift %c10{{.*}}, %c200{{.*}} : (index, index) -> !fir.shapeshift<1>
31+
! CHECK: %[[box:.*]] = fir.embox %[[y]](%[[shape]]) : (!fir.ref<!fir.array<200xf32>>, !fir.shapeshift<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
32+
! CHECK: fir.has_value %[[box]] : !fir.box<!fir.ptr<!fir.array<?xf32>>>
33+
end module
34+
35+
! Test pointer initial data target with pointer in common blocks
36+
block data
37+
real, pointer :: p
38+
real, save, target :: b
39+
common /a/ p
40+
data p /b/
41+
! CHECK-LABEL: fir.global @_QBa : tuple<!fir.box<!fir.ptr<f32>>>
42+
! CHECK: %[[undef:.*]] = fir.undefined tuple<!fir.box<!fir.ptr<f32>>>
43+
! CHECK: %[[b:.*]] = fir.address_of(@_QEb) : !fir.ref<f32>
44+
! CHECK: %[[box:.*]] = fir.embox %[[b]] : (!fir.ref<f32>) -> !fir.box<!fir.ptr<f32>>
45+
! 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>>>
46+
! CHECK: fir.has_value %[[a]] : tuple<!fir.box<!fir.ptr<f32>>>
47+
end block data
48+
49+
! Test pointer in a common with initial target in the same common.
50+
block data snake
51+
integer, target :: b = 42
52+
integer, pointer :: p => b
53+
common /snake/ p, b
54+
! CHECK-LABEL: fir.global @_QBsnake : tuple<!fir.box<!fir.ptr<i32>>, i32>
55+
! CHECK: %[[tuple0:.*]] = fir.undefined tuple<!fir.box<!fir.ptr<i32>>, i32>
56+
! CHECK: %[[snakeAddr:.*]] = fir.address_of(@_QBsnake) : !fir.ref<tuple<!fir.box<!fir.ptr<i32>>, i32>>
57+
! CHECK: %[[byteView:.*]] = fir.convert %[[snakeAddr:.*]] : (!fir.ref<tuple<!fir.box<!fir.ptr<i32>>, i32>>) -> !fir.ref<!fir.array<?xi8>>
58+
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[byteView]], %c24{{.*}} : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
59+
! CHECK: %[[bAddr:.*]] = fir.convert %[[coor]] : (!fir.ref<i8>) -> !fir.ref<i32>
60+
! CHECK: %[[box:.*]] = fir.embox %[[bAddr]] : (!fir.ref<i32>) -> !fir.box<!fir.ptr<i32>>
61+
! 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>
62+
! CHECK: %[[tuple2:.*]] = fir.insert_value %[[tuple1]], %c42{{.*}}, %c1{{.*}} : (tuple<!fir.box<!fir.ptr<i32>>, i32>, i32, index) -> tuple<!fir.box<!fir.ptr<i32>>, i32>
63+
! CHECK: fir.has_value %[[tuple2]] : tuple<!fir.box<!fir.ptr<i32>>, i32>
64+
end block data
65+
66+
! Test two common depending on each others because of initial data
67+
! targets
68+
block data tied
69+
real, target :: x1 = 42
70+
real, target :: x2 = 43
71+
real, pointer :: p1 => x2
72+
real, pointer :: p2 => x1
73+
common /c1/ x1, p1
74+
common /c2/ x2, p2
75+
! CHECK-LABEL: fir.global @_QBc1 : tuple<f32, !fir.array<4xi8>, !fir.box<!fir.ptr<f32>>>
76+
! CHECK: fir.address_of(@_QBc2) : !fir.ref<tuple<f32, !fir.array<4xi8>, !fir.box<!fir.ptr<f32>>>>
77+
! CHECK-LABEL: fir.global @_QBc2 : tuple<f32, !fir.array<4xi8>, !fir.box<!fir.ptr<f32>>>
78+
! CHECK: fir.address_of(@_QBc1) : !fir.ref<tuple<f32, !fir.array<4xi8>, !fir.box<!fir.ptr<f32>>>>
79+
end block data

0 commit comments

Comments
 (0)