From 6131bc7bcde2fa3c459e710c7f0cb0e0158f2b34 Mon Sep 17 00:00:00 2001 From: Jean Perier Date: Fri, 7 Jun 2024 11:00:21 -0700 Subject: [PATCH 1/2] [flang] add source to SHAPE API --- flang/include/flang/Runtime/inquiry.h | 3 ++- flang/runtime/inquiry.cpp | 5 +++-- flang/unittests/Runtime/Inquiry.cpp | 9 ++++++--- 3 files changed, 11 insertions(+), 6 deletions(-) diff --git a/flang/include/flang/Runtime/inquiry.h b/flang/include/flang/Runtime/inquiry.h index 7161d1e41c4bb..0a3cd51236fa3 100644 --- a/flang/include/flang/Runtime/inquiry.h +++ b/flang/include/flang/Runtime/inquiry.h @@ -24,7 +24,8 @@ extern "C" { std::int64_t RTDECL(LboundDim)(const Descriptor &array, int dim, const char *sourceFile = nullptr, int line = 0); -void RTDECL(Shape)(void *result, const Descriptor &array, int kind); +void RTDECL(Shape)(void *result, const Descriptor &array, int kind, + const char *sourceFile = nullptr, int line = 0); std::int64_t RTDECL(Size)( const Descriptor &array, const char *sourceFile = nullptr, int line = 0); diff --git a/flang/runtime/inquiry.cpp b/flang/runtime/inquiry.cpp index ea114174de7fd..443e6291e5e23 100644 --- a/flang/runtime/inquiry.cpp +++ b/flang/runtime/inquiry.cpp @@ -85,8 +85,9 @@ std::int64_t RTDEF(SizeDim)( return static_cast(dimension.Extent()); } -void RTDEF(Shape)(void *result, const Descriptor &array, int kind) { - Terminator terminator{__FILE__, __LINE__}; +void RTDEF(Shape)(void *result, const Descriptor &array, int kind, + const char *sourceFile, int line) { + Terminator terminator{sourceFile, line}; INTERNAL_CHECK(array.rank() <= common::maxRank); for (SubscriptValue i{0}; i < array.rank(); ++i) { const Dimension &dimension{array.GetDimension(i)}; diff --git a/flang/unittests/Runtime/Inquiry.cpp b/flang/unittests/Runtime/Inquiry.cpp index 665a930ee4ff9..220ebb765f8c7 100644 --- a/flang/unittests/Runtime/Inquiry.cpp +++ b/flang/unittests/Runtime/Inquiry.cpp @@ -87,7 +87,8 @@ TEST(Inquiry, Shape) { auto int8Result{ MakeArray(std::vector{array->rank()}, std::vector(array->rank(), 0))}; - RTNAME(Shape)(int8Result->raw().base_addr, *array, /*KIND=*/1); + RTNAME(Shape) + (int8Result->raw().base_addr, *array, /*KIND=*/1, __FILE__, __LINE__); EXPECT_EQ(*int8Result->ZeroBasedIndexedElement(0), 2); EXPECT_EQ(*int8Result->ZeroBasedIndexedElement(1), 3); @@ -95,7 +96,8 @@ TEST(Inquiry, Shape) { auto int32Result{ MakeArray(std::vector{array->rank()}, std::vector(array->rank(), 0))}; - RTNAME(Shape)(int32Result->raw().base_addr, *array, /*KIND=*/4); + RTNAME(Shape) + (int32Result->raw().base_addr, *array, /*KIND=*/4, __FILE__, __LINE__); EXPECT_EQ(*int32Result->ZeroBasedIndexedElement(0), 2); EXPECT_EQ(*int32Result->ZeroBasedIndexedElement(1), 3); @@ -103,7 +105,8 @@ TEST(Inquiry, Shape) { auto int64Result{ MakeArray(std::vector{array->rank()}, std::vector(array->rank(), 0))}; - RTNAME(Shape)(int64Result->raw().base_addr, *array, /*KIND=*/8); + RTNAME(Shape) + (int64Result->raw().base_addr, *array, /*KIND=*/8, __FILE__, __LINE__); EXPECT_EQ(*int64Result->ZeroBasedIndexedElement(0), 2); EXPECT_EQ(*int64Result->ZeroBasedIndexedElement(1), 3); } From 7b347e77ef0ec82caa590bd4237c1845d3685398 Mon Sep 17 00:00:00 2001 From: Jean Perier Date: Fri, 7 Jun 2024 09:40:22 -0700 Subject: [PATCH 2/2] [flang] lower SHAPE with assumed-rank arguments --- .../flang/Optimizer/Builder/Runtime/Inquiry.h | 6 ++ flang/lib/Optimizer/Builder/IntrinsicCall.cpp | 34 ++++++++++- .../lib/Optimizer/Builder/Runtime/Inquiry.cpp | 14 +++++ .../Lower/HLFIR/assumed-rank-inquiries-3.f90 | 56 +++++++++++++++++++ 4 files changed, 108 insertions(+), 2 deletions(-) create mode 100644 flang/test/Lower/HLFIR/assumed-rank-inquiries-3.f90 diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Inquiry.h b/flang/include/flang/Optimizer/Builder/Runtime/Inquiry.h index 132592a0197f8..5f14d7781004b 100644 --- a/flang/include/flang/Optimizer/Builder/Runtime/Inquiry.h +++ b/flang/include/flang/Optimizer/Builder/Runtime/Inquiry.h @@ -32,6 +32,12 @@ mlir::Value genLboundDim(fir::FirOpBuilder &builder, mlir::Location loc, void genUbound(fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value resultBox, mlir::Value array, mlir::Value kind); +/// Generate call to `Shape` runtime routine. +/// First argument is a raw pointer to the result array storage that +/// must be allocated by the caller. +void genShape(fir::FirOpBuilder &builder, mlir::Location loc, + mlir::Value resultAddr, mlir::Value arrayt, mlir::Value kind); + /// Generate call to `Size` runtime routine. This routine is a specialized /// version when the DIM argument is not specified by the user. mlir::Value genSize(fir::FirOpBuilder &builder, mlir::Location loc, diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp index 861b26de06370..b3e1ee3da3a77 100644 --- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp +++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp @@ -5992,15 +5992,45 @@ mlir::Value IntrinsicLibrary::genSetExponent(mlir::Type resultType, fir::getBase(args[1]))); } +/// Generate runtime call to inquire about all the bounds/extents of an +/// assumed-rank array. +template +static fir::ExtendedValue genAssumedRankBoundInquiry( + fir::FirOpBuilder &builder, mlir::Location loc, mlir::Type resultType, + llvm::ArrayRef args, int kindPos, Func genRtCall) { + const fir::ExtendedValue &array = args[0]; + // Allocate an array with the maximum rank, that is big enough to hold the + // result but still "small" (15 elements). Static size alloca make stack + // analysis/manipulation easier. + mlir::Type resultElementType = fir::unwrapSequenceType(resultType); + mlir::Type allocSeqType = + fir::SequenceType::get({Fortran::common::maxRank}, resultElementType); + mlir::Value resultStorage = builder.createTemporary(loc, allocSeqType); + mlir::Value arrayBox = builder.createBox(loc, array); + mlir::Value kind = isStaticallyAbsent(args, kindPos) + ? builder.createIntegerConstant( + loc, builder.getI32Type(), + builder.getKindMap().defaultIntegerKind()) + : fir::getBase(args[kindPos]); + genRtCall(builder, loc, resultStorage, arrayBox, kind); + mlir::Type baseType = + fir::ReferenceType::get(builder.getVarLenSeqTy(resultElementType)); + mlir::Value resultBase = builder.createConvert(loc, baseType, resultStorage); + mlir::Value rank = + builder.create(loc, builder.getIndexType(), arrayBox); + return fir::ArrayBoxValue{resultBase, {rank}}; +} + // SHAPE fir::ExtendedValue IntrinsicLibrary::genShape(mlir::Type resultType, llvm::ArrayRef args) { assert(args.size() >= 1); const fir::ExtendedValue &array = args[0]; + if (array.hasAssumedRank()) + return genAssumedRankBoundInquiry(builder, loc, resultType, args, + /*kindPos=*/1, fir::runtime::genShape); int rank = array.rank(); - if (rank == 0) - TODO(loc, "shape intrinsic lowering with assumed-rank source"); mlir::Type indexType = builder.getIndexType(); mlir::Type extentType = fir::unwrapSequenceType(resultType); mlir::Type seqType = fir::SequenceType::get( diff --git a/flang/lib/Optimizer/Builder/Runtime/Inquiry.cpp b/flang/lib/Optimizer/Builder/Runtime/Inquiry.cpp index 16f63bea4617a..34c4020b5907c 100644 --- a/flang/lib/Optimizer/Builder/Runtime/Inquiry.cpp +++ b/flang/lib/Optimizer/Builder/Runtime/Inquiry.cpp @@ -87,3 +87,17 @@ mlir::Value fir::runtime::genIsContiguous(fir::FirOpBuilder &builder, auto args = fir::runtime::createArguments(builder, loc, fTy, array); return builder.create(loc, isContiguousFunc, args).getResult(0); } + +void fir::runtime::genShape(fir::FirOpBuilder &builder, mlir::Location loc, + mlir::Value resultAddr, mlir::Value array, + mlir::Value kind) { + mlir::func::FuncOp func = + fir::runtime::getRuntimeFunc(loc, builder); + auto fTy = func.getFunctionType(); + auto sourceFile = fir::factory::locationToFilename(builder, loc); + auto sourceLine = + fir::factory::locationToLineNo(builder, loc, fTy.getInput(4)); + auto args = fir::runtime::createArguments( + builder, loc, fTy, resultAddr, array, kind, sourceFile, sourceLine); + builder.create(loc, func, args).getResult(0); +} diff --git a/flang/test/Lower/HLFIR/assumed-rank-inquiries-3.f90 b/flang/test/Lower/HLFIR/assumed-rank-inquiries-3.f90 new file mode 100644 index 0000000000000..bbeff5ff05191 --- /dev/null +++ b/flang/test/Lower/HLFIR/assumed-rank-inquiries-3.f90 @@ -0,0 +1,56 @@ +! Test shape lowering for assumed-rank +! RUN: bbc -emit-hlfir -o - %s -allow-assumed-rank | FileCheck %s + +subroutine test_shape(x) + real :: x(..) + call takes_integer_array(shape(x)) +end subroutine +! CHECK-LABEL: func.func @_QPtest_shape( +! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.array<15xi32> +! CHECK: %[[VAL_4:.*]] = arith.constant 4 : i32 +! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_1]] : (!fir.ref>) -> !fir.llvm_ptr +! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_3:.*]] : (!fir.box>) -> !fir.box +! CHECK: %[[VAL_10:.*]] = fir.call @_FortranAShape(%[[VAL_7]], %[[VAL_8]], %[[VAL_4]], %{{.*}}, %{{.*}}) +! CHECK: %[[VAL_11:.*]] = fir.convert %[[VAL_1]] : (!fir.ref>) -> !fir.ref> +! CHECK: %[[VAL_12:.*]] = fir.box_rank %[[VAL_3]] : (!fir.box>) -> index +! CHECK: %[[VAL_13:.*]] = fir.shape %[[VAL_12]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_14:.*]]:2 = hlfir.declare %[[VAL_11]](%[[VAL_13]]) {uniq_name = ".tmp.intrinsic_result"} : (!fir.ref>, !fir.shape<1>) -> (!fir.box>, !fir.ref>) +! CHECK: %[[VAL_15:.*]] = arith.constant false +! CHECK: %[[VAL_16:.*]] = hlfir.as_expr %[[VAL_14]]#0 move %[[VAL_15]] : (!fir.box>, i1) -> !hlfir.expr +! CHECK: %[[VAL_17:.*]]:3 = hlfir.associate %[[VAL_16]](%[[VAL_13]]) {adapt.valuebyref} : (!hlfir.expr, !fir.shape<1>) -> (!fir.box>, !fir.ref>, i1) +! CHECK: fir.call @_QPtakes_integer_array(%[[VAL_17]]#1) fastmath : (!fir.ref>) -> () +! CHECK: hlfir.end_associate %[[VAL_17]]#1, %[[VAL_17]]#2 : !fir.ref>, i1 +! CHECK: hlfir.destroy %[[VAL_16]] : !hlfir.expr +! CHECK: return +! CHECK: } + +subroutine test_shape_kind(x) + real :: x(..) + call takes_integer8_array(shape(x, kind=8)) +end subroutine +! CHECK-LABEL: func.func @_QPtest_shape_kind( +! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.array<15xi64> +! CHECK: %[[VAL_4:.*]] = arith.constant 8 : i32 +! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_1]] : (!fir.ref>) -> !fir.llvm_ptr +! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_3:.*]] : (!fir.box>) -> !fir.box +! CHECK: %[[VAL_10:.*]] = fir.call @_FortranAShape(%[[VAL_7]], %[[VAL_8]], %[[VAL_4]], %{{.*}}, %{{.*}}) +! CHECK: %[[VAL_11:.*]] = fir.convert %[[VAL_1]] : (!fir.ref>) -> !fir.ref> +! CHECK: %[[VAL_12:.*]] = fir.box_rank %[[VAL_3]] : (!fir.box>) -> index +! CHECK: %[[VAL_13:.*]] = fir.shape %[[VAL_12]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_14:.*]]:2 = hlfir.declare %[[VAL_11]](%[[VAL_13]]) {uniq_name = ".tmp.intrinsic_result"} : (!fir.ref>, !fir.shape<1>) -> (!fir.box>, !fir.ref>) + +subroutine test_shape_2(x) + real, pointer :: x(..) + call takes_integer_array(shape(x)) +end subroutine +! CHECK-LABEL: func.func @_QPtest_shape_2( +! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.array<15xi32> +! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_3:.*]] : !fir.ref>>> +! CHECK: %[[VAL_5:.*]] = arith.constant 4 : i32 +! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_1]] : (!fir.ref>) -> !fir.llvm_ptr +! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_4]] : (!fir.box>>) -> !fir.box +! CHECK: %[[VAL_11:.*]] = fir.call @_FortranAShape(%[[VAL_8]], %[[VAL_9]], %[[VAL_5]], %{{.*}}, %{{.*}}) +! CHECK: %[[VAL_12:.*]] = fir.convert %[[VAL_1]] : (!fir.ref>) -> !fir.ref> +! CHECK: %[[VAL_13:.*]] = fir.box_rank %[[VAL_4]] : (!fir.box>>) -> index +! CHECK: %[[VAL_14:.*]] = fir.shape %[[VAL_13]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_15:.*]]:2 = hlfir.declare %[[VAL_12]](%[[VAL_14]]) {uniq_name = ".tmp.intrinsic_result"} : (!fir.ref>, !fir.shape<1>) -> (!fir.box>, !fir.ref>)