[flang-commits] [flang] dda0163 - [flang] Use PointerAssociateLowerBounds when there is lower bounds
Valentin Clement via flang-commits
flang-commits at lists.llvm.org
Tue Feb 7 00:17:51 PST 2023
Author: Valentin Clement
Date: 2023-02-07T09:17:38+01:00
New Revision: dda01632db12d3b11d8e2e21d73d438626cb0436
URL: https://github.com/llvm/llvm-project/commit/dda01632db12d3b11d8e2e21d73d438626cb0436
DIFF: https://github.com/llvm/llvm-project/commit/dda01632db12d3b11d8e2e21d73d438626cb0436.diff
LOG: [flang] Use PointerAssociateLowerBounds when there is lower bounds
The current code was not taking provided lower bounds when the pointer
is polymorphic and was just calling PointerAssociate. This patch
updates the behavior and use PointerAssociateLowerBounds with the provided
lower bounds.
Reviewed By: jeanPerier
Differential Revision: https://reviews.llvm.org/D143392
Added:
Modified:
flang/include/flang/Lower/Runtime.h
flang/lib/Lower/Bridge.cpp
flang/lib/Lower/Runtime.cpp
flang/test/Lower/polymorphic.f90
Removed:
################################################################################
diff --git a/flang/include/flang/Lower/Runtime.h b/flang/include/flang/Lower/Runtime.h
index e4f8954727203..e71496edad9ba 100644
--- a/flang/include/flang/Lower/Runtime.h
+++ b/flang/include/flang/Lower/Runtime.h
@@ -68,6 +68,9 @@ void genPointerAssociate(fir::FirOpBuilder &, mlir::Location,
void genPointerAssociateRemapping(fir::FirOpBuilder &, mlir::Location,
mlir::Value pointer, mlir::Value target,
mlir::Value bounds);
+void genPointerAssociateLowerBounds(fir::FirOpBuilder &, mlir::Location,
+ mlir::Value pointer, mlir::Value target,
+ mlir::Value lbounds);
} // namespace lower
} // namespace Fortran
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index f6745a458f6f6..c0a5aa3c394ca 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -54,6 +54,7 @@
#include "mlir/IR/PatternMatch.h"
#include "mlir/Parser/Parser.h"
#include "mlir/Transforms/RegionUtils.h"
+#include "llvm/ADT/SmallVector.h"
#include "llvm/ADT/StringSet.h"
#include "llvm/Support/CommandLine.h"
#include "llvm/Support/Debug.h"
@@ -2589,6 +2590,30 @@ class FirConverter : public Fortran::lower::AbstractConverter {
return Fortran::lower::createMutableBox(loc, *this, expr, localSymbols);
}
+ // Create the [newRank] array with the lower bounds to be passed to the
+ // runtime as a descriptor.
+ mlir::Value createLboundArray(llvm::ArrayRef<mlir::Value> lbounds,
+ mlir::Location loc) {
+ mlir::Type indexTy = builder->getIndexType();
+ mlir::Type boundArrayTy = fir::SequenceType::get(
+ {static_cast<int64_t>(lbounds.size())}, builder->getI64Type());
+ mlir::Value boundArray = builder->create<fir::AllocaOp>(loc, boundArrayTy);
+ mlir::Value array = builder->create<fir::UndefOp>(loc, boundArrayTy);
+ for (unsigned i = 0; i < lbounds.size(); ++i) {
+ array = builder->create<fir::InsertValueOp>(
+ loc, boundArrayTy, array, lbounds[i],
+ builder->getArrayAttr({builder->getIntegerAttr(
+ builder->getIndexType(), static_cast<int>(i))}));
+ }
+ builder->create<fir::StoreOp>(loc, array, boundArray);
+ mlir::Type boxTy = fir::BoxType::get(boundArrayTy);
+ mlir::Value ext =
+ builder->createIntegerConstant(loc, indexTy, lbounds.size());
+ llvm::SmallVector<mlir::Value> shapes = {ext};
+ mlir::Value shapeOp = builder->genShape(loc, shapes);
+ return builder->create<fir::EmboxOp>(loc, boxTy, boundArray, shapeOp);
+ }
+
// Generate pointer assignment with possibly empty bounds-spec. R1035: a
// bounds-spec is a lower bound value.
void genPointerAssignment(
@@ -2606,8 +2631,18 @@ class FirConverter : public Fortran::lower::AbstractConverter {
if (lhsType && lhsType->IsPolymorphic()) {
if (!lowerToHighLevelFIR() && explicitIterationSpace())
TODO(loc, "polymorphic pointer assignment in FORALL");
+ llvm::SmallVector<mlir::Value> lbounds;
+ for (const Fortran::evaluate::ExtentExpr &lbExpr : lbExprs)
+ lbounds.push_back(
+ fir::getBase(genExprValue(toEvExpr(lbExpr), stmtCtx)));
mlir::Value lhs = genExprMutableBox(loc, assign.lhs).getAddr();
mlir::Value rhs = fir::getBase(genExprBox(loc, assign.rhs, stmtCtx));
+ if (!lbounds.empty()) {
+ mlir::Value boundsDesc = createLboundArray(lbounds, loc);
+ Fortran::lower::genPointerAssociateLowerBounds(*builder, loc, lhs, rhs,
+ boundsDesc);
+ return;
+ }
Fortran::lower::genPointerAssociate(*builder, loc, lhs, rhs);
return;
}
diff --git a/flang/lib/Lower/Runtime.cpp b/flang/lib/Lower/Runtime.cpp
index d490264874c08..54c3a4e95d710 100644
--- a/flang/lib/Lower/Runtime.cpp
+++ b/flang/lib/Lower/Runtime.cpp
@@ -205,3 +205,16 @@ void Fortran::lower::genPointerAssociateRemapping(fir::FirOpBuilder &builder,
sourceLine);
builder.create<fir::CallOp>(loc, func, args).getResult(0);
}
+
+void Fortran::lower::genPointerAssociateLowerBounds(fir::FirOpBuilder &builder,
+ mlir::Location loc,
+ mlir::Value pointer,
+ mlir::Value target,
+ mlir::Value lbounds) {
+ mlir::func::FuncOp func =
+ fir::runtime::getRuntimeFunc<mkRTKey(PointerAssociateLowerBounds)>(
+ loc, builder);
+ llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
+ builder, loc, func.getFunctionType(), pointer, target, lbounds);
+ builder.create<fir::CallOp>(loc, func, args).getResult(0);
+}
diff --git a/flang/test/Lower/polymorphic.f90 b/flang/test/Lower/polymorphic.f90
index 3e9a951e2528b..dd2c616bbd00f 100644
--- a/flang/test/Lower/polymorphic.f90
+++ b/flang/test/Lower/polymorphic.f90
@@ -434,6 +434,30 @@ subroutine pointer_assign_remap()
! CHECK: %[[ARG2:.*]] = fir.convert %[[BOXED_BOUND_ARRAY]] : (!fir.box<!fir.array<2x1xi64>>) -> !fir.box<none>
! CHECK: %{{.*}} = fir.call @_FortranAPointerAssociateRemapping(%[[ARG0]], %[[ARG1]], %[[ARG2]], %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref<!fir.box<none>>, !fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> none
+ subroutine pointer_assign_lower_bounds()
+ class(p1), allocatable, target :: a(:)
+ class(p1), pointer :: p(:)
+ allocate(a(100))
+ p(-50:) => a
+ end subroutine
+
+! CHECK-LABEL: func.func @_QMpolymorphic_testPpointer_assign_lower_bounds() {
+! CHECK: %[[A:.*]] = fir.alloca !fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>> {bindc_name = "a", fir.target, uniq_name = "_QMpolymorphic_testFpointer_assign_lower_boundsEa"}
+! CHECK: %[[P:.*]] = fir.alloca !fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>> {bindc_name = "p", uniq_name = "_QMpolymorphic_testFpointer_assign_lower_boundsEp"}
+! CHECK: %[[LB:.*]] = arith.constant -50 : i64
+! CHECK: %[[REBOX_A:.*]] = fir.rebox %21(%23) : (!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>, !fir.shift<1>) -> !fir.class<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>
+! CHECK: %[[LBOUND_ARRAY:.*]] = fir.alloca !fir.array<1xi64>
+! CHECK: %[[ARRAY:.*]] = fir.undefined !fir.array<1xi64>
+! CHECK: %[[ARRAY0:.*]] = fir.insert_value %[[ARRAY]], %[[LB]], [0 : index] : (!fir.array<1xi64>, i64) -> !fir.array<1xi64>
+! CHECK: fir.store %[[ARRAY0]] to %[[LBOUND_ARRAY]] : !fir.ref<!fir.array<1xi64>>
+! CHECK: %[[C1:.*]] = arith.constant 1 : index
+! CHECK: %[[LBOUND_ARRAY_SHAPE:.*]] = fir.shape %[[C1]] : (index) -> !fir.shape<1>
+! CHECK: %[[LBOUND_ARRAY_BOXED:.*]] = fir.embox %[[LBOUND_ARRAY]](%[[LBOUND_ARRAY_SHAPE]]) : (!fir.ref<!fir.array<1xi64>>, !fir.shape<1>) -> !fir.box<!fir.array<1xi64>>
+! CHECK: %[[P_BOX_NONE:.*]] = fir.convert %[[P]] : (!fir.ref<!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[A_BOX_NONE:.*]] = fir.convert %[[REBOX_A]] : (!fir.class<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>) -> !fir.box<none>
+! CHECK: %[[LBOUNDS_BOX_NONE:.*]] = fir.convert %[[LBOUND_ARRAY_BOXED]] : (!fir.box<!fir.array<1xi64>>) -> !fir.box<none>
+! CHECK: %{{.*}} = fir.call @_FortranAPointerAssociateLowerBounds(%[[P_BOX_NONE]], %[[A_BOX_NONE]], %[[LBOUNDS_BOX_NONE]]) {{.*}} : (!fir.ref<!fir.box<none>>, !fir.box<none>, !fir.box<none>) -> none
+
subroutine test_elemental_assign()
type(p1) :: pa(3)
pa = [ 1, 2, 3 ]
More information about the flang-commits
mailing list