Skip to content

Commit 9e5b2fb

Browse files
klauslerklausler
authored
[flang][runtime] Preserve type when remapping monomorphic pointers (#149427)
Pointer remappings unconditionally update the element byte size and derived type of the pointer's descriptor. This is okay when the pointer is polymorphic, but not when a pointer is associated with an extended type. To communicate this monomorphic case to the runtime, add a new entry point so as to not break forward binary compatibility.
1 parent 680b8dd commit 9e5b2fb

File tree

9 files changed

+59
-23
lines changed

9 files changed

+59
-23
lines changed

‎flang-rt/include/flang-rt/runtime/descriptor.h

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -478,7 +478,8 @@ class Descriptor {
478478
const SubscriptValue *upper = nullptr,
479479
const SubscriptValue *stride = nullptr);
480480

481-
RT_API_ATTRS void ApplyMold(const Descriptor &, int rank);
481+
RT_API_ATTRS void ApplyMold(
482+
const Descriptor &, int rank, bool isMonomorphic = false);
482483

483484
RT_API_ATTRS void Check() const;
484485

‎flang-rt/lib/runtime/descriptor.cpp

Lines changed: 11 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -252,18 +252,21 @@ RT_API_ATTRS bool Descriptor::EstablishPointerSection(const Descriptor &source,
252252
return CFI_section(&raw_, &source.raw_, lower, upper, stride) == CFI_SUCCESS;
253253
}
254254

255-
RT_API_ATTRS void Descriptor::ApplyMold(const Descriptor &mold, int rank) {
256-
raw_.elem_len = mold.raw_.elem_len;
255+
RT_API_ATTRS void Descriptor::ApplyMold(
256+
const Descriptor &mold, int rank, bool isMonomorphic) {
257257
raw_.rank = rank;
258-
raw_.type = mold.raw_.type;
259258
for (int j{0}; j < rank && j < mold.raw_.rank; ++j) {
260259
GetDimension(j) = mold.GetDimension(j);
261260
}
262-
if (auto *addendum{Addendum()}) {
263-
if (auto *moldAddendum{mold.Addendum()}) {
264-
*addendum = *moldAddendum;
265-
} else {
266-
INTERNAL_CHECK(!addendum->derivedType());
261+
if (!isMonomorphic) {
262+
raw_.elem_len = mold.raw_.elem_len;
263+
raw_.type = mold.raw_.type;
264+
if (auto *addendum{Addendum()}) {
265+
if (auto *moldAddendum{mold.Addendum()}) {
266+
*addendum = *moldAddendum;
267+
} else {
268+
INTERNAL_CHECK(!addendum->derivedType());
269+
}
267270
}
268271
}
269272
}

‎flang-rt/lib/runtime/pointer.cpp

Lines changed: 16 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -87,9 +87,9 @@ void RTDEF(PointerAssociateLowerBounds)(Descriptor &pointer,
8787
}
8888
}
8989

90-
void RTDEF(PointerAssociateRemapping)(Descriptor &pointer,
90+
static void RT_API_ATTRS PointerRemapping(Descriptor &pointer,
9191
const Descriptor &target, const Descriptor &bounds, const char *sourceFile,
92-
int sourceLine) {
92+
int sourceLine, bool isMonomorphic) {
9393
Terminator terminator{sourceFile, sourceLine};
9494
SubscriptValue byteStride{/*captured from first dimension*/};
9595
std::size_t boundElementBytes{bounds.ElementBytes()};
@@ -99,7 +99,7 @@ void RTDEF(PointerAssociateRemapping)(Descriptor &pointer,
9999
// the ranks may mismatch. Use target as a mold for initializing
100100
// the pointer descriptor.
101101
INTERNAL_CHECK(static_cast<std::size_t>(pointer.rank()) == boundsRank);
102-
pointer.ApplyMold(target, boundsRank);
102+
pointer.ApplyMold(target, boundsRank, isMonomorphic);
103103
pointer.set_base_addr(target.raw().base_addr);
104104
pointer.raw().attribute = CFI_attribute_pointer;
105105
for (unsigned j{0}; j < boundsRank; ++j) {
@@ -124,6 +124,19 @@ void RTDEF(PointerAssociateRemapping)(Descriptor &pointer,
124124
}
125125
}
126126

127+
void RTDEF(PointerAssociateRemapping)(Descriptor &pointer,
128+
const Descriptor &target, const Descriptor &bounds, const char *sourceFile,
129+
int sourceLine) {
130+
PointerRemapping(
131+
pointer, target, bounds, sourceFile, sourceLine, /*isMonomorphic=*/false);
132+
}
133+
void RTDEF(PointerAssociateRemappingMonomorphic)(Descriptor &pointer,
134+
const Descriptor &target, const Descriptor &bounds, const char *sourceFile,
135+
int sourceLine) {
136+
PointerRemapping(
137+
pointer, target, bounds, sourceFile, sourceLine, /*isMonomorphic=*/true);
138+
}
139+
127140
RT_API_ATTRS void *AllocateValidatedPointerPayload(
128141
std::size_t byteSize, int allocatorIdx) {
129142
// Add space for a footer to validate during deallocation.

‎flang/include/flang/Lower/Runtime.h

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -70,7 +70,7 @@ void genPointerAssociate(fir::FirOpBuilder &, mlir::Location,
7070
mlir::Value pointer, mlir::Value target);
7171
void genPointerAssociateRemapping(fir::FirOpBuilder &, mlir::Location,
7272
mlir::Value pointer, mlir::Value target,
73-
mlir::Value bounds);
73+
mlir::Value bounds, bool isMonomorphic);
7474
void genPointerAssociateLowerBounds(fir::FirOpBuilder &, mlir::Location,
7575
mlir::Value pointer, mlir::Value target,
7676
mlir::Value lbounds);

‎flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -37,7 +37,7 @@ void genPointerAssociate(fir::FirOpBuilder &, mlir::Location,
3737
mlir::Value pointer, mlir::Value target);
3838
void genPointerAssociateRemapping(fir::FirOpBuilder &, mlir::Location,
3939
mlir::Value pointer, mlir::Value target,
40-
mlir::Value bounds);
40+
mlir::Value bounds, bool isMonomorphic);
4141

4242
mlir::Value genCpuTime(fir::FirOpBuilder &, mlir::Location);
4343
void genDateAndTime(fir::FirOpBuilder &, mlir::Location,

‎flang/include/flang/Runtime/pointer.h

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -59,9 +59,14 @@ void RTDECL(PointerAssociateLowerBounds)(
5959
// Associates a pointer with a target with bounds remapping. The target must be
6060
// simply contiguous &/or of rank 1. The bounds constitute a [2,newRank]
6161
// integer array whose columns are [lower bound, upper bound] on each dimension.
62+
// Use the Monomorphic form if the pointer's type shouldn't change and
63+
// the target is polymorphic.
6264
void RTDECL(PointerAssociateRemapping)(Descriptor &, const Descriptor &target,
6365
const Descriptor &bounds, const char *sourceFile = nullptr,
6466
int sourceLine = 0);
67+
void RTDECL(PointerAssociateRemappingMonomorphic)(Descriptor &,
68+
const Descriptor &target, const Descriptor &bounds,
69+
const char *sourceFile = nullptr, int sourceLine = 0);
6570

6671
// Data pointer allocation and deallocation
6772

‎flang/lib/Lower/Bridge.cpp

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -4703,8 +4703,10 @@ class FirConverter : public Fortran::lower::AbstractConverter {
47034703
mlir::Value lhs = lhsMutableBox.getAddr();
47044704
mlir::Value rhs = fir::getBase(genExprBox(loc, assign.rhs, stmtCtx));
47054705
mlir::Value boundsDesc = createBoundArray(lbounds, ubounds, loc);
4706-
Fortran::lower::genPointerAssociateRemapping(*builder, loc, lhs, rhs,
4707-
boundsDesc);
4706+
Fortran::lower::genPointerAssociateRemapping(
4707+
*builder, loc, lhs, rhs, boundsDesc,
4708+
lhsType && rhsType && !lhsType->IsPolymorphic() &&
4709+
rhsType->IsPolymorphic());
47084710
return;
47094711
}
47104712
if (!lowerToHighLevelFIR() && explicitIterationSpace()) {

‎flang/lib/Lower/Runtime.cpp

Lines changed: 8 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -213,14 +213,15 @@ void Fortran::lower::genPointerAssociate(fir::FirOpBuilder &builder,
213213
builder.create<fir::CallOp>(loc, func, args);
214214
}
215215

216-
void Fortran::lower::genPointerAssociateRemapping(fir::FirOpBuilder &builder,
217-
mlir::Location loc,
218-
mlir::Value pointer,
219-
mlir::Value target,
220-
mlir::Value bounds) {
216+
void Fortran::lower::genPointerAssociateRemapping(
217+
fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value pointer,
218+
mlir::Value target, mlir::Value bounds, bool isMonomorphic) {
221219
mlir::func::FuncOp func =
222-
fir::runtime::getRuntimeFunc<mkRTKey(PointerAssociateRemapping)>(loc,
223-
builder);
220+
isMonomorphic
221+
? fir::runtime::getRuntimeFunc<mkRTKey(
222+
PointerAssociateRemappingMonomorphic)>(loc, builder)
223+
: fir::runtime::getRuntimeFunc<mkRTKey(PointerAssociateRemapping)>(
224+
loc, builder);
224225
auto fTy = func.getFunctionType();
225226
auto sourceFile = fir::factory::locationToFilename(builder, loc);
226227
auto sourceLine =

‎flang/test/Lower/polymorphic.f90

Lines changed: 11 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -178,6 +178,17 @@ subroutine polymorphic_to_nonpolymorphic(p)
178178
! CHECK-LABEL: func.func @_QMpolymorphic_testPpolymorphic_to_nonpolymorphic
179179
! Just checking that FIR is generated without error.
180180

181+
subroutine nonpolymorphic_to_polymorphic(p, t)
182+
type p1
183+
end type
184+
type(p1), pointer :: p(:)
185+
class(p1), target :: t(:)
186+
p(0:1) => t
187+
end subroutine
188+
189+
! CHECK-LABEL: func.func @_QMpolymorphic_testPnonpolymorphic_to_polymorphic
190+
! CHECK: fir.call @_FortranAPointerAssociateRemappingMonomorphic
191+
181192
! Test that lowering does not crash for function return with unlimited
182193
! polymoprhic value.
183194

0 commit comments

Comments
 (0)