[flang-commits] [flang] b2bf995 - [flang] Lower storage_size intrinsic for polymorphic entities
Valentin Clement via flang-commits
flang-commits at lists.llvm.org
Tue Jan 31 00:44:42 PST 2023
Author: Valentin Clement
Date: 2023-01-31T09:44:33+01:00
New Revision: b2bf995c02a04fd7f453d6931b79ce5a51871489
URL: https://github.com/llvm/llvm-project/commit/b2bf995c02a04fd7f453d6931b79ce5a51871489
DIFF: https://github.com/llvm/llvm-project/commit/b2bf995c02a04fd7f453d6931b79ce5a51871489.diff
LOG: [flang] Lower storage_size intrinsic for polymorphic entities
Lower STOARGE_SIZE intrinsic when the argument is polymoprhic
or unlimited polymorphic. STOARGE_SIZE for monomorphic entity is folded
by the frontend.
Reviewed By: vzakhari, vdonaldson
Differential Revision: https://reviews.llvm.org/D142896
Added:
flang/test/Lower/Intrinsics/storage_size.f90
Modified:
flang/include/flang/Optimizer/Builder/MutableBox.h
flang/lib/Lower/IntrinsicCall.cpp
flang/lib/Optimizer/Builder/MutableBox.cpp
Removed:
################################################################################
diff --git a/flang/include/flang/Optimizer/Builder/MutableBox.h b/flang/include/flang/Optimizer/Builder/MutableBox.h
index 56f43a8475235..d49d2e7ae8119 100644
--- a/flang/include/flang/Optimizer/Builder/MutableBox.h
+++ b/flang/include/flang/Optimizer/Builder/MutableBox.h
@@ -161,6 +161,12 @@ mlir::Value genIsAllocatedOrAssociatedTest(fir::FirOpBuilder &builder,
mlir::Location loc,
const fir::MutableBoxValue &box);
+/// Generate allocation or association status test and returns the resulting
+/// i1. This is testing this for a valid/non-null base address value.
+mlir::Value genIsNotAllocatedOrAssociatedTest(fir::FirOpBuilder &builder,
+ mlir::Location loc,
+ const fir::MutableBoxValue &box);
+
} // namespace fir::factory
#endif // FORTRAN_OPTIMIZER_BUILDER_MUTABLEBOX_H
diff --git a/flang/lib/Lower/IntrinsicCall.cpp b/flang/lib/Lower/IntrinsicCall.cpp
index 26ae437d84b75..126696e0df474 100644
--- a/flang/lib/Lower/IntrinsicCall.cpp
+++ b/flang/lib/Lower/IntrinsicCall.cpp
@@ -18,6 +18,7 @@
#include "flang/Lower/Mangler.h"
#include "flang/Lower/Runtime.h"
#include "flang/Lower/StatementContext.h"
+#include "flang/Lower/Support/Utils.h"
#include "flang/Lower/SymbolMap.h"
#include "flang/Optimizer/Builder/BoxValue.h"
#include "flang/Optimizer/Builder/Character.h"
@@ -306,6 +307,8 @@ struct IntrinsicLibrary {
mlir::Value genSpacing(mlir::Type resultType,
llvm::ArrayRef<mlir::Value> args);
fir::ExtendedValue genSpread(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
+ fir::ExtendedValue genStorageSize(mlir::Type,
+ llvm::ArrayRef<fir::ExtendedValue>);
fir::ExtendedValue genSum(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
void genSystemClock(llvm::ArrayRef<fir::ExtendedValue>);
mlir::Value genTrailz(mlir::Type, llvm::ArrayRef<mlir::Value>);
@@ -818,6 +821,10 @@ static constexpr IntrinsicHandler handlers[]{
&I::genSpread,
{{{"source", asBox}, {"dim", asValue}, {"ncopies", asValue}}},
/*isElemental=*/false},
+ {"storage_size",
+ &I::genStorageSize,
+ {{{"a", asInquired}, {"kind", asValue}}},
+ /*isElemental=*/false},
{"sum",
&I::genSum,
{{{"array", asBox},
@@ -4787,6 +4794,57 @@ IntrinsicLibrary::genSpread(mlir::Type resultType,
return readAndAddCleanUp(resultMutableBox, resultType, "SPREAD");
}
+// STORAGE_SIZE
+fir::ExtendedValue
+IntrinsicLibrary::genStorageSize(mlir::Type resultType,
+ llvm::ArrayRef<fir::ExtendedValue> args) {
+ assert(args.size() == 2 || args.size() == 1);
+ mlir::Value box = fir::getBase(args[0]);
+ mlir::Type boxTy = box.getType();
+ mlir::Type kindTy = builder.getDefaultIntegerType();
+ bool needRuntimeCheck = false;
+ std::string errorMsg;
+
+ if (fir::isUnlimitedPolymorphicType(boxTy) &&
+ (fir::isAllocatableType(boxTy) || fir::isPointerType(boxTy))) {
+ needRuntimeCheck = true;
+ errorMsg =
+ fir::isPointerType(boxTy)
+ ? "unlimited polymorphic disassociated POINTER in STORAGE_SIZE"
+ : "unlimited polymorphic unallocated ALLOCATABLE in STORAGE_SIZE";
+ } else if (fir::isPolymorphicType(boxTy) && fir::isPointerType(boxTy)) {
+ needRuntimeCheck = true;
+ errorMsg = "polymorphic disassociated POINTER in STORAGE_SIZE";
+ }
+ const fir::MutableBoxValue *mutBox = args[0].getBoxOf<fir::MutableBoxValue>();
+ if (needRuntimeCheck && mutBox) {
+ mlir::Value isNotAllocOrAssoc =
+ fir::factory::genIsNotAllocatedOrAssociatedTest(builder, loc, *mutBox);
+ builder.genIfThen(loc, isNotAllocOrAssoc)
+ .genThen([&]() {
+ fir::runtime::genReportFatalUserError(builder, loc, errorMsg);
+ })
+ .end();
+ }
+
+ // Handle optional kind argument
+ bool absentKind = isStaticallyAbsent(args, 1);
+ if (!absentKind) {
+ mlir::Operation *defKind = fir::getBase(args[1]).getDefiningOp();
+ assert(mlir::isa<mlir::arith::ConstantOp>(*defKind) &&
+ "kind not a constant");
+ auto constOp = mlir::dyn_cast<mlir::arith::ConstantOp>(*defKind);
+ kindTy = builder.getIntegerType(
+ builder.getKindMap().getIntegerBitsize(fir::toInt(constOp)));
+ }
+
+ if (box.getType().isa<fir::ReferenceType>())
+ box = builder.create<fir::LoadOp>(loc, box);
+ mlir::Value eleSize = builder.create<fir::BoxEleSizeOp>(loc, kindTy, box);
+ mlir::Value c8 = builder.createIntegerConstant(loc, kindTy, 8);
+ return builder.create<mlir::arith::MulIOp>(loc, eleSize, c8);
+}
+
// SUM
fir::ExtendedValue
IntrinsicLibrary::genSum(mlir::Type resultType,
diff --git a/flang/lib/Optimizer/Builder/MutableBox.cpp b/flang/lib/Optimizer/Builder/MutableBox.cpp
index a66a4c607b68c..44b04c0b20516 100644
--- a/flang/lib/Optimizer/Builder/MutableBox.cpp
+++ b/flang/lib/Optimizer/Builder/MutableBox.cpp
@@ -440,6 +440,13 @@ fir::factory::genIsAllocatedOrAssociatedTest(fir::FirOpBuilder &builder,
return builder.genIsNotNullAddr(loc, addr);
}
+mlir::Value fir::factory::genIsNotAllocatedOrAssociatedTest(
+ fir::FirOpBuilder &builder, mlir::Location loc,
+ const fir::MutableBoxValue &box) {
+ auto addr = MutablePropertyReader(builder, loc, box).readBaseAddress();
+ return builder.genIsNullAddr(loc, addr);
+}
+
/// Generate finalizer call and inlined free. This does not check that the
/// address was allocated.
static void genFinalizeAndFree(fir::FirOpBuilder &builder, mlir::Location loc,
diff --git a/flang/test/Lower/Intrinsics/storage_size.f90 b/flang/test/Lower/Intrinsics/storage_size.f90
new file mode 100644
index 0000000000000..2c975a194186c
--- /dev/null
+++ b/flang/test/Lower/Intrinsics/storage_size.f90
@@ -0,0 +1,116 @@
+! RUN: bbc -emit-fir -polymorphic-type %s -o - | FileCheck %s
+
+module storage_size_test
+ type :: p1
+ integer :: a
+ end type
+
+ type, extends(p1) :: p2
+ integer :: b
+ end type
+
+contains
+
+ integer function unlimited_polymorphic_pointer(p) result(size)
+ class(*), pointer :: p
+ size = storage_size(p)
+ end function
+
+! CHECK-LABEL: func.func @_QMstorage_size_testPunlimited_polymorphic_pointer(
+! CHECK-SAME: %[[P:.*]]: !fir.ref<!fir.class<!fir.ptr<none>>> {fir.bindc_name = "p"}) -> i32 {
+! CHECK: %[[SIZE:.*]] = fir.alloca i32 {bindc_name = "size", uniq_name = "_QMstorage_size_testFunlimited_polymorphic_pointerEsize"}
+! CHECK: %[[LOAD_P:.*]] = fir.load %[[P]] : !fir.ref<!fir.class<!fir.ptr<none>>>
+! CHECK: %[[P_ADDR:.*]] = fir.box_addr %[[LOAD_P]] : (!fir.class<!fir.ptr<none>>) -> !fir.ptr<none>
+! CHECK: %[[P_ADDR_I64:.*]] = fir.convert %[[P_ADDR]] : (!fir.ptr<none>) -> i64
+! CHECK: %[[C0:.*]] = arith.constant 0 : i64
+! CHECK: %[[IS_NULL_ADDR:.*]] = arith.cmpi eq, %[[P_ADDR_I64]], %[[C0]] : i64
+! CHECK: fir.if %[[IS_NULL_ADDR]] {
+! CHECK: %{{.*}} = fir.call @_FortranAReportFatalUserError(%{{.*}}, %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref<i8>, !fir.ref<i8>, i32) -> none
+! CHECK: }
+! CHECK: %[[LOAD_P:.*]] = fir.load %[[P]] : !fir.ref<!fir.class<!fir.ptr<none>>>
+! CHECK: %[[ELE_SIZE:.*]] = fir.box_elesize %[[LOAD_P]] : (!fir.class<!fir.ptr<none>>) -> i32
+! CHECK: %[[C8:.*]] = arith.constant 8 : i32
+! CHECK: %[[BITS:.*]] = arith.muli %[[ELE_SIZE]], %[[C8]] : i32
+! CHECK: fir.store %[[BITS]] to %[[SIZE]] : !fir.ref<i32>
+! CHECK: %[[RES:.*]] = fir.load %[[SIZE]] : !fir.ref<i32>
+! CHECK: return %[[RES]] : i32
+
+ integer function unlimited_polymorphic_allocatable(p) result(size)
+ class(*), allocatable :: p
+ size = storage_size(p)
+ end function
+
+! CHECK-LABEL: func.func @_QMstorage_size_testPunlimited_polymorphic_allocatable(
+! CHECK-SAME: %[[P:.*]]: !fir.ref<!fir.class<!fir.heap<none>>> {fir.bindc_name = "p"}) -> i32 {
+! CHECK: %[[SIZE:.*]] = fir.alloca i32 {bindc_name = "size", uniq_name = "_QMstorage_size_testFunlimited_polymorphic_allocatableEsize"}
+! CHECK: %[[LOAD_P:.*]] = fir.load %[[P]] : !fir.ref<!fir.class<!fir.heap<none>>>
+! CHECK: %[[P_ADDR:.*]] = fir.box_addr %[[LOAD_P]] : (!fir.class<!fir.heap<none>>) -> !fir.heap<none>
+! CHECK: %[[P_ADDR_I64:.*]] = fir.convert %[[P_ADDR]] : (!fir.heap<none>) -> i64
+! CHECK: %[[C0:.*]] = arith.constant 0 : i64
+! CHECK: %[[IS_NULL_ADDR:.*]] = arith.cmpi eq, %[[P_ADDR_I64]], %[[C0]] : i64
+! CHECK: fir.if %[[IS_NULL_ADDR]] {
+! CHECK: %{{.*}} = fir.call @_FortranAReportFatalUserError(%{{.*}}, %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref<i8>, !fir.ref<i8>, i32) -> none
+! CHECK: }
+! CHECK: %[[LOAD_P:.*]] = fir.load %[[P]] : !fir.ref<!fir.class<!fir.heap<none>>>
+! CHECK: %[[ELE_SIZE:.*]] = fir.box_elesize %[[LOAD_P]] : (!fir.class<!fir.heap<none>>) -> i32
+! CHECK: %[[C8:.*]] = arith.constant 8 : i32
+! CHECK: %[[BITS:.*]] = arith.muli %[[ELE_SIZE]], %[[C8]] : i32
+! CHECK: fir.store %[[BITS]] to %[[SIZE]] : !fir.ref<i32>
+! CHECK: %[[RES:.*]] = fir.load %[[SIZE]] : !fir.ref<i32>
+! CHECK: return %[[RES]] : i32
+
+ integer function polymorphic_pointer(p) result(size)
+ class(p1), pointer :: p
+ size = storage_size(p)
+ end function
+
+! CHECK-LABEL: func.func @_QMstorage_size_testPpolymorphic_pointer(
+! CHECK-SAME: %[[P:.*]]: !fir.ref<!fir.class<!fir.ptr<!fir.type<_QMstorage_size_testTp1{a:i32}>>>> {fir.bindc_name = "p"}) -> i32 {
+! CHECK: %[[SIZE:.*]] = fir.alloca i32 {bindc_name = "size", uniq_name = "_QMstorage_size_testFpolymorphic_pointerEsize"}
+! CHECK: %[[LOAD_P:.*]] = fir.load %[[P]] : !fir.ref<!fir.class<!fir.ptr<!fir.type<_QMstorage_size_testTp1{a:i32}>>>>
+! CHECK: %[[P_ADDR:.*]] = fir.box_addr %[[LOAD_P]] : (!fir.class<!fir.ptr<!fir.type<_QMstorage_size_testTp1{a:i32}>>>) -> !fir.ptr<!fir.type<_QMstorage_size_testTp1{a:i32}>>
+! CHECK: %[[P_ADDR_I64:.*]] = fir.convert %[[P_ADDR]] : (!fir.ptr<!fir.type<_QMstorage_size_testTp1{a:i32}>>) -> i64
+! CHECK: %[[C0:.*]] = arith.constant 0 : i64
+! CHECK: %[[IS_NULL_ADDR:.*]] = arith.cmpi eq, %[[P_ADDR_I64]], %[[C0]] : i64
+! CHECK: fir.if %[[IS_NULL_ADDR]] {
+! CHECK: %{{.*}} = fir.call @_FortranAReportFatalUserError(%{{.*}}, %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref<i8>, !fir.ref<i8>, i32) -> none
+! CHECK: }
+! CHECK: %[[LOAD_P:.*]] = fir.load %[[P]] : !fir.ref<!fir.class<!fir.ptr<!fir.type<_QMstorage_size_testTp1{a:i32}>>>>
+! CHECK: %[[ELE_SIZE:.*]] = fir.box_elesize %[[LOAD_P]] : (!fir.class<!fir.ptr<!fir.type<_QMstorage_size_testTp1{a:i32}>>>) -> i32
+! CHECK: %[[C8:.*]] = arith.constant 8 : i32
+! CHECK: %[[BITS:.*]] = arith.muli %[[ELE_SIZE]], %[[C8]] : i32
+! CHECK: fir.store %[[BITS]] to %[[SIZE]] : !fir.ref<i32>
+! CHECK: %[[RES:.*]] = fir.load %[[SIZE]] : !fir.ref<i32>
+! CHECK: return %[[RES]] : i32
+
+ integer function polymorphic(p) result(size)
+ class(p1) :: p
+ size = storage_size(p)
+ end function
+
+! CHECK-LABEL: func.func @_QMstorage_size_testPpolymorphic(
+! CHECK-SAME: %[[P:.*]]: !fir.class<!fir.type<_QMstorage_size_testTp1{a:i32}>> {fir.bindc_name = "p"}) -> i32 {
+! CHECK: %[[SIZE:.*]] = fir.alloca i32 {bindc_name = "size", uniq_name = "_QMstorage_size_testFpolymorphicEsize"}
+! CHECK: %[[ELE_SIZE:.*]] = fir.box_elesize %[[P]] : (!fir.class<!fir.type<_QMstorage_size_testTp1{a:i32}>>) -> i32
+! CHECK: %[[C8:.*]] = arith.constant 8 : i32
+! CHECK: %[[BITS:.*]] = arith.muli %[[ELE_SIZE]], %[[C8]] : i32
+! CHECK: fir.store %[[BITS]] to %[[SIZE]] : !fir.ref<i32>
+! CHECK: %[[RES:.*]] = fir.load %[[SIZE]] : !fir.ref<i32>
+! CHECK: return %[[RES]] : i32
+
+ integer(8) function polymorphic_rank(p) result(size)
+ class(p1) :: p
+ size = storage_size(p, 8)
+ end function
+
+! CHECK-LABEL: func.func @_QMstorage_size_testPpolymorphic_rank(
+! CHECK-SAME: %[[P:.*]]: !fir.class<!fir.type<_QMstorage_size_testTp1{a:i32}>> {fir.bindc_name = "p"}) -> i64 {
+! CHECK: %[[SIZE:.*]] = fir.alloca i64 {bindc_name = "size", uniq_name = "_QMstorage_size_testFpolymorphic_rankEsize"}
+! CHECK: %[[ELE_SIZE:.*]] = fir.box_elesize %[[P]] : (!fir.class<!fir.type<_QMstorage_size_testTp1{a:i32}>>) -> i64
+! CHECK: %[[C8:.*]] = arith.constant 8 : i64
+! CHECK: %[[BITS:.*]] = arith.muli %[[ELE_SIZE]], %[[C8]] : i64
+! CHECK: fir.store %[[BITS]] to %[[SIZE]] : !fir.ref<i64>
+! CHECK: %[[RES:.*]] = fir.load %[[SIZE]] : !fir.ref<i64>
+! CHECK: return %[[RES]] : i64
+
+end module
More information about the flang-commits
mailing list