[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.
This commit is contained in:
Peter Klausler
2025-07-18 13:45:05 -07:00
committed by GitHub
parent 680b8dd707
commit 9e5b2fbe86
9 changed files with 59 additions and 23 deletions

View File

@@ -478,7 +478,8 @@ public:
const SubscriptValue *upper = nullptr,
const SubscriptValue *stride = nullptr);
RT_API_ATTRS void ApplyMold(const Descriptor &, int rank);
RT_API_ATTRS void ApplyMold(
const Descriptor &, int rank, bool isMonomorphic = false);
RT_API_ATTRS void Check() const;

View File

@@ -252,18 +252,21 @@ RT_API_ATTRS bool Descriptor::EstablishPointerSection(const Descriptor &source,
return CFI_section(&raw_, &source.raw_, lower, upper, stride) == CFI_SUCCESS;
}
RT_API_ATTRS void Descriptor::ApplyMold(const Descriptor &mold, int rank) {
raw_.elem_len = mold.raw_.elem_len;
RT_API_ATTRS void Descriptor::ApplyMold(
const Descriptor &mold, int rank, bool isMonomorphic) {
raw_.rank = rank;
raw_.type = mold.raw_.type;
for (int j{0}; j < rank && j < mold.raw_.rank; ++j) {
GetDimension(j) = mold.GetDimension(j);
}
if (auto *addendum{Addendum()}) {
if (auto *moldAddendum{mold.Addendum()}) {
*addendum = *moldAddendum;
} else {
INTERNAL_CHECK(!addendum->derivedType());
if (!isMonomorphic) {
raw_.elem_len = mold.raw_.elem_len;
raw_.type = mold.raw_.type;
if (auto *addendum{Addendum()}) {
if (auto *moldAddendum{mold.Addendum()}) {
*addendum = *moldAddendum;
} else {
INTERNAL_CHECK(!addendum->derivedType());
}
}
}
}

View File

@@ -87,9 +87,9 @@ void RTDEF(PointerAssociateLowerBounds)(Descriptor &pointer,
}
}
void RTDEF(PointerAssociateRemapping)(Descriptor &pointer,
static void RT_API_ATTRS PointerRemapping(Descriptor &pointer,
const Descriptor &target, const Descriptor &bounds, const char *sourceFile,
int sourceLine) {
int sourceLine, bool isMonomorphic) {
Terminator terminator{sourceFile, sourceLine};
SubscriptValue byteStride{/*captured from first dimension*/};
std::size_t boundElementBytes{bounds.ElementBytes()};
@@ -99,7 +99,7 @@ void RTDEF(PointerAssociateRemapping)(Descriptor &pointer,
// the ranks may mismatch. Use target as a mold for initializing
// the pointer descriptor.
INTERNAL_CHECK(static_cast<std::size_t>(pointer.rank()) == boundsRank);
pointer.ApplyMold(target, boundsRank);
pointer.ApplyMold(target, boundsRank, isMonomorphic);
pointer.set_base_addr(target.raw().base_addr);
pointer.raw().attribute = CFI_attribute_pointer;
for (unsigned j{0}; j < boundsRank; ++j) {
@@ -124,6 +124,19 @@ void RTDEF(PointerAssociateRemapping)(Descriptor &pointer,
}
}
void RTDEF(PointerAssociateRemapping)(Descriptor &pointer,
const Descriptor &target, const Descriptor &bounds, const char *sourceFile,
int sourceLine) {
PointerRemapping(
pointer, target, bounds, sourceFile, sourceLine, /*isMonomorphic=*/false);
}
void RTDEF(PointerAssociateRemappingMonomorphic)(Descriptor &pointer,
const Descriptor &target, const Descriptor &bounds, const char *sourceFile,
int sourceLine) {
PointerRemapping(
pointer, target, bounds, sourceFile, sourceLine, /*isMonomorphic=*/true);
}
RT_API_ATTRS void *AllocateValidatedPointerPayload(
std::size_t byteSize, int allocatorIdx) {
// Add space for a footer to validate during deallocation.

View File

@@ -70,7 +70,7 @@ void genPointerAssociate(fir::FirOpBuilder &, mlir::Location,
mlir::Value pointer, mlir::Value target);
void genPointerAssociateRemapping(fir::FirOpBuilder &, mlir::Location,
mlir::Value pointer, mlir::Value target,
mlir::Value bounds);
mlir::Value bounds, bool isMonomorphic);
void genPointerAssociateLowerBounds(fir::FirOpBuilder &, mlir::Location,
mlir::Value pointer, mlir::Value target,
mlir::Value lbounds);

View File

@@ -37,7 +37,7 @@ void genPointerAssociate(fir::FirOpBuilder &, mlir::Location,
mlir::Value pointer, mlir::Value target);
void genPointerAssociateRemapping(fir::FirOpBuilder &, mlir::Location,
mlir::Value pointer, mlir::Value target,
mlir::Value bounds);
mlir::Value bounds, bool isMonomorphic);
mlir::Value genCpuTime(fir::FirOpBuilder &, mlir::Location);
void genDateAndTime(fir::FirOpBuilder &, mlir::Location,

View File

@@ -59,9 +59,14 @@ void RTDECL(PointerAssociateLowerBounds)(
// Associates a pointer with a target with bounds remapping. The target must be
// simply contiguous &/or of rank 1. The bounds constitute a [2,newRank]
// integer array whose columns are [lower bound, upper bound] on each dimension.
// Use the Monomorphic form if the pointer's type shouldn't change and
// the target is polymorphic.
void RTDECL(PointerAssociateRemapping)(Descriptor &, const Descriptor &target,
const Descriptor &bounds, const char *sourceFile = nullptr,
int sourceLine = 0);
void RTDECL(PointerAssociateRemappingMonomorphic)(Descriptor &,
const Descriptor &target, const Descriptor &bounds,
const char *sourceFile = nullptr, int sourceLine = 0);
// Data pointer allocation and deallocation

View File

@@ -4703,8 +4703,10 @@ private:
mlir::Value lhs = lhsMutableBox.getAddr();
mlir::Value rhs = fir::getBase(genExprBox(loc, assign.rhs, stmtCtx));
mlir::Value boundsDesc = createBoundArray(lbounds, ubounds, loc);
Fortran::lower::genPointerAssociateRemapping(*builder, loc, lhs, rhs,
boundsDesc);
Fortran::lower::genPointerAssociateRemapping(
*builder, loc, lhs, rhs, boundsDesc,
lhsType && rhsType && !lhsType->IsPolymorphic() &&
rhsType->IsPolymorphic());
return;
}
if (!lowerToHighLevelFIR() && explicitIterationSpace()) {

View File

@@ -213,14 +213,15 @@ void Fortran::lower::genPointerAssociate(fir::FirOpBuilder &builder,
builder.create<fir::CallOp>(loc, func, args);
}
void Fortran::lower::genPointerAssociateRemapping(fir::FirOpBuilder &builder,
mlir::Location loc,
mlir::Value pointer,
mlir::Value target,
mlir::Value bounds) {
void Fortran::lower::genPointerAssociateRemapping(
fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value pointer,
mlir::Value target, mlir::Value bounds, bool isMonomorphic) {
mlir::func::FuncOp func =
fir::runtime::getRuntimeFunc<mkRTKey(PointerAssociateRemapping)>(loc,
builder);
isMonomorphic
? fir::runtime::getRuntimeFunc<mkRTKey(
PointerAssociateRemappingMonomorphic)>(loc, builder)
: fir::runtime::getRuntimeFunc<mkRTKey(PointerAssociateRemapping)>(
loc, builder);
auto fTy = func.getFunctionType();
auto sourceFile = fir::factory::locationToFilename(builder, loc);
auto sourceLine =

View File

@@ -178,6 +178,17 @@ module polymorphic_test
! CHECK-LABEL: func.func @_QMpolymorphic_testPpolymorphic_to_nonpolymorphic
! Just checking that FIR is generated without error.
subroutine nonpolymorphic_to_polymorphic(p, t)
type p1
end type
type(p1), pointer :: p(:)
class(p1), target :: t(:)
p(0:1) => t
end subroutine
! CHECK-LABEL: func.func @_QMpolymorphic_testPnonpolymorphic_to_polymorphic
! CHECK: fir.call @_FortranAPointerAssociateRemappingMonomorphic
! Test that lowering does not crash for function return with unlimited
! polymoprhic value.