[flang-commits] [flang] [flang] Generate fir.pack/unpack_array in Lowering. (PR #131704)

Slava Zakharin via flang-commits flang-commits at lists.llvm.org
Tue Mar 18 12:59:37 PDT 2025


https://github.com/vzakhari updated https://github.com/llvm/llvm-project/pull/131704

>From 00bd36cfdaad1aeac5098e48e098b7e6d8bfeb25 Mon Sep 17 00:00:00 2001
From: Slava Zakharin <szakharin at nvidia.com>
Date: Mon, 10 Mar 2025 19:00:09 -0700
Subject: [PATCH] [flang] Generate fir.pack/unpack_array in Lowering.

Basic generation of array repacking operations in Lowering.
---
 flang/include/flang/Lower/ConvertVariable.h   |  16 ++
 flang/include/flang/Lower/LoweringOptions.def |  15 ++
 flang/lib/Lower/ConvertVariable.cpp           | 101 ++++++-
 flang/test/Lower/repack-arrays.f90            | 247 ++++++++++++++++++
 flang/tools/bbc/bbc.cpp                       |  26 ++
 5 files changed, 403 insertions(+), 2 deletions(-)
 create mode 100644 flang/test/Lower/repack-arrays.f90

diff --git a/flang/include/flang/Lower/ConvertVariable.h b/flang/include/flang/Lower/ConvertVariable.h
index b9d7f89138032..293ffa010d14a 100644
--- a/flang/include/flang/Lower/ConvertVariable.h
+++ b/flang/include/flang/Lower/ConvertVariable.h
@@ -182,6 +182,22 @@ void genDeclareSymbol(Fortran::lower::AbstractConverter &converter,
 /// track the cray pointee as Fortran pointer.
 mlir::Type getCrayPointeeBoxType(mlir::Type);
 
+/// If the given array symbol must be repacked into contiguous
+/// memory, generate fir.pack_array for the given box array value.
+/// The returned extended value is a box with the same properties
+/// as the original.
+fir::ExtendedValue genPackArray(Fortran::lower::AbstractConverter &converter,
+                                const Fortran::semantics::Symbol &sym,
+                                fir::ExtendedValue exv);
+
+/// Given an operation defining the variable corresponding
+/// to the given symbol, generate fir.unpack_array operation
+/// that reverts the effect of fir.pack_array.
+/// \p def is expected to be hlfir.declare operation.
+void genUnpackArray(fir::FirOpBuilder &builder, mlir::Location loc,
+                    fir::FortranVariableOpInterface def,
+                    const Fortran::semantics::Symbol &sym);
+
 } // namespace lower
 } // namespace Fortran
 #endif // FORTRAN_LOWER_CONVERT_VARIABLE_H
diff --git a/flang/include/flang/Lower/LoweringOptions.def b/flang/include/flang/Lower/LoweringOptions.def
index 396c91948be36..6735bea551414 100644
--- a/flang/include/flang/Lower/LoweringOptions.def
+++ b/flang/include/flang/Lower/LoweringOptions.def
@@ -47,5 +47,20 @@ ENUM_LOWERINGOPT(ReallocateLHS, unsigned, 1, 1)
 /// If true, initialize globals without initialization to zero.
 /// On by default.
 ENUM_LOWERINGOPT(InitGlobalZero, unsigned, 1, 1)
+
+/// If true, the arrays of unknown size and array temporaries
+/// are requested to be allocated in stack memory.
+ENUM_LOWERINGOPT(StackArrays, unsigned, 1, 0)
+
+/// If true, the dummy assumed shape arrays are conditionally
+/// packed into contiguous memory.
+ENUM_LOWERINGOPT(RepackArrays, unsigned, 1, 0)
+
+/// If true, the repacking (RepackArrays option above)
+/// will be done for arrays non-contiguous in any dimension,
+/// otherwise, it will be done only for arrays non-contiguous
+/// in the leading dimension.
+ENUM_LOWERINGOPT(RepackArraysWhole, unsigned, 1, 0)
+
 #undef LOWERINGOPT
 #undef ENUM_LOWERINGOPT
diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index 05256fec67241..52e3578ae21f0 100644
--- a/flang/lib/Lower/ConvertVariable.cpp
+++ b/flang/lib/Lower/ConvertVariable.cpp
@@ -1009,6 +1009,17 @@ static void deallocateIntentOut(Fortran::lower::AbstractConverter &converter,
   }
 }
 
+static bool needsRepack(Fortran::lower::AbstractConverter &converter,
+                        const Fortran::semantics::Symbol &sym) {
+  if (!converter.getLoweringOptions().getRepackArrays() ||
+      !converter.isRegisteredDummySymbol(sym) ||
+      !Fortran::semantics::IsAssumedShape(sym) ||
+      Fortran::evaluate::IsSimplyContiguous(sym, converter.getFoldingContext()))
+    return false;
+
+  return true;
+}
+
 /// Instantiate a local variable. Precondition: Each variable will be visited
 /// such that if its properties depend on other variables, the variables upon
 /// which its properties depend will already have been visited.
@@ -1077,6 +1088,17 @@ static void instantiateLocal(Fortran::lower::AbstractConverter &converter,
                                                  loc, sym);
       });
     }
+  } else if (var.hasSymbol() && needsRepack(converter, var.getSymbol())) {
+    auto *builder = &converter.getFirOpBuilder();
+    mlir::Location loc = converter.getCurrentLocation();
+    auto *sym = &var.getSymbol();
+    std::optional<fir::FortranVariableOpInterface> varDef =
+        symMap.lookupVariableDefinition(*sym);
+    assert(varDef && "cannot find defining operation for an array that needs "
+                     "to be repacked");
+    converter.getFctCtx().attachCleanup([builder, loc, varDef, sym]() {
+      Fortran::lower::genUnpackArray(*builder, loc, *varDef, *sym);
+    });
   }
 }
 
@@ -1914,10 +1936,13 @@ void Fortran::lower::genDeclareSymbol(
                                                         sym.GetUltimate());
     auto name = converter.mangleName(sym);
     mlir::Value dummyScope;
-    if (converter.isRegisteredDummySymbol(sym))
+    fir::ExtendedValue base = exv;
+    if (converter.isRegisteredDummySymbol(sym)) {
+      base = genPackArray(converter, sym, exv);
       dummyScope = converter.dummyArgsScopeValue();
+    }
     hlfir::EntityWithAttributes declare = hlfir::genDeclare(
-        loc, builder, exv, name, attributes, dummyScope, dataAttr);
+        loc, builder, base, name, attributes, dummyScope, dataAttr);
     symMap.addVariableDefinition(sym, declare.getIfVariableInterface(), force);
     return;
   }
@@ -2562,3 +2587,75 @@ mlir::Type Fortran::lower::getCrayPointeeBoxType(mlir::Type fortranType) {
   }
   return fir::BoxType::get(fir::PointerType::get(baseType));
 }
+
+fir::ExtendedValue
+Fortran::lower::genPackArray(Fortran::lower::AbstractConverter &converter,
+                             const Fortran::semantics::Symbol &sym,
+                             fir::ExtendedValue exv) {
+  if (!needsRepack(converter, sym))
+    return exv;
+
+  auto &opts = converter.getLoweringOptions();
+  llvm::SmallVector<mlir::Value> lenParams;
+  exv.match(
+      [&](const fir::CharArrayBoxValue &box) {
+        lenParams.emplace_back(box.getLen());
+      },
+      [&](const fir::BoxValue &box) {
+        lenParams.append(box.getExplicitParameters().begin(),
+                         box.getExplicitParameters().end());
+      },
+      [](const auto &) {
+        llvm_unreachable("unexpected lowering for assumed-shape dummy");
+      });
+  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+  const mlir::Location loc = genLocation(converter, sym);
+  bool stackAlloc = opts.getStackArrays();
+  // 1D arrays must always use 'whole' mode.
+  bool isInnermostMode = !opts.getRepackArraysWhole() && sym.Rank() > 1;
+  // Avoid copy-in for 'intent(out)' variables.
+  bool noCopy = Fortran::semantics::IsIntentOut(sym);
+  auto boxType = mlir::cast<fir::BaseBoxType>(fir::getBase(exv).getType());
+  mlir::Type elementType = boxType.unwrapInnerType();
+  llvm::SmallVector<mlir::Value> elidedLenParams =
+      fir::factory::elideLengthsAlreadyInType(elementType, lenParams);
+  auto packOp = builder.create<fir::PackArrayOp>(
+      loc, fir::getBase(exv), stackAlloc, isInnermostMode, noCopy,
+      /*max_size=*/mlir::IntegerAttr{},
+      /*max_element_size=*/mlir::IntegerAttr{},
+      /*min_stride=*/mlir::IntegerAttr{}, fir::PackArrayHeuristics::None,
+      elidedLenParams);
+
+  mlir::Value newBase = packOp.getResult();
+  return exv.match(
+      [&](const fir::CharArrayBoxValue &box) -> fir::ExtendedValue {
+        return box.clone(newBase);
+      },
+      [&](const fir::BoxValue &box) -> fir::ExtendedValue {
+        return box.clone(newBase);
+      },
+      [](const auto &) -> fir::ExtendedValue {
+        llvm_unreachable("unexpected lowering for assumed-shape dummy");
+      });
+}
+
+void Fortran::lower::genUnpackArray(fir::FirOpBuilder &builder,
+                                    mlir::Location loc,
+                                    fir::FortranVariableOpInterface def,
+                                    const Fortran::semantics::Symbol &sym) {
+  // Subtle: rely on the fact that the memref of the defining
+  // hlfir.declare is a result of fir.pack_array.
+  // Alternatively, we can track the pack operation for a symbol
+  // via SymMap.
+  auto declareOp = mlir::dyn_cast<hlfir::DeclareOp>(def.getOperation());
+  assert(declareOp &&
+         "cannot find hlfir.declare for an array that needs to be repacked");
+  auto packOp = declareOp.getMemref().getDefiningOp<fir::PackArrayOp>();
+  assert(packOp && "cannot find fir.pack_array");
+  mlir::Value temp = packOp.getResult();
+  mlir::Value original = packOp.getArray();
+  bool stackAlloc = packOp.getStack();
+  // Avoid copy-out for 'intent(in)' variables.
+  bool noCopy = Fortran::semantics::IsIntentIn(sym);
+  builder.create<fir::UnpackArrayOp>(loc, temp, original, stackAlloc, noCopy);
+}
diff --git a/flang/test/Lower/repack-arrays.f90 b/flang/test/Lower/repack-arrays.f90
new file mode 100644
index 0000000000000..19ea93a3521a3
--- /dev/null
+++ b/flang/test/Lower/repack-arrays.f90
@@ -0,0 +1,247 @@
+! RUN: bbc -emit-hlfir -frepack-arrays -fstack-arrays -frepack-arrays-continuity-whole %s -o - -I nowhere | FileCheck --check-prefixes=ALL,STACK,WHOLE %s
+! RUN: bbc -emit-hlfir -frepack-arrays -fstack-arrays=false -frepack-arrays-continuity-whole %s -o - -I nowhere | FileCheck --check-prefixes=ALL,HEAP,WHOLE %s
+! RUN: bbc -emit-hlfir -frepack-arrays -fstack-arrays -frepack-arrays-continuity-whole=false %s -o - -I nowhere | FileCheck --check-prefixes=ALL,STACK,INNER %s
+! RUN: bbc -emit-hlfir -frepack-arrays -fstack-arrays=false -frepack-arrays-continuity-whole=false %s -o - -I nowhere | FileCheck --check-prefixes=ALL,HEAP,INNER %s
+
+! ALL-LABEL:   func.func @_QPtest1(
+! ALL-SAME:                        %[[VAL_0:[0-9]+|[a-zA-Z$._-][a-zA-Z0-9$._-]*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x"}) {
+subroutine test1(x)
+  real :: x(:)
+! ALL:           %[[VAL_2:.*]] = fir.pack_array %[[VAL_0]]
+! STACK-SAME:    stack
+! HEAP-SAME:     heap
+! WHOLE-SAME:    whole
+! ALL-NOT:       no_copy
+! ALL-SAME       : (!fir.box<!fir.array<?xf32>>) -> !fir.box<!fir.array<?xf32>>
+! ALL:           %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_2]] dummy_scope %{{.*}} {uniq_name = "_QFtest1Ex"} : (!fir.box<!fir.array<?xf32>>, !fir.dscope) -> (!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>)
+! ALL:           fir.unpack_array %[[VAL_2]] to %[[VAL_0]]
+! STACK-SAME:    stack
+! HEAP-SAME:     heap
+! ALL-NOT:       no_copy
+! ALL-SAME:      : !fir.box<!fir.array<?xf32>>
+end subroutine test1
+
+! ALL-LABEL:   func.func @_QPtest2(
+! ALL-SAME:                        %[[VAL_0:[0-9]+|[a-zA-Z$._-][a-zA-Z0-9$._-]*]]: !fir.ref<i32> {fir.bindc_name = "n"},
+! ALL-SAME:                        %[[VAL_1:[0-9]+|[a-zA-Z$._-][a-zA-Z0-9$._-]*]]: !fir.box<!fir.array<?x?x!fir.char<1,?>>> {fir.bindc_name = "x"}) {
+subroutine test2(n, x)
+  integer :: n
+  character(n) :: x(:,:)
+! ALL:           %[[VAL_8:.*]] = fir.pack_array %[[VAL_1]]
+! STACK-SAME:    stack
+! HEAP-SAME:     heap
+! WHOLE-SAME:    whole
+! INNER-SAME:    innermost
+! ALL-NOT:       no_copy
+! ALL-SAME:      typeparams %[[VAL_7:.*]] : (!fir.box<!fir.array<?x?x!fir.char<1,?>>>, i32) -> !fir.box<!fir.array<?x?x!fir.char<1,?>>>
+! ALL:           %[[VAL_9:.*]]:2 = hlfir.declare %[[VAL_8]] typeparams %[[VAL_7]] dummy_scope %{{.*}} {uniq_name = "_QFtest2Ex"} : (!fir.box<!fir.array<?x?x!fir.char<1,?>>>, i32, !fir.dscope) -> (!fir.box<!fir.array<?x?x!fir.char<1,?>>>, !fir.box<!fir.array<?x?x!fir.char<1,?>>>)
+! ALL:           fir.unpack_array %[[VAL_8]] to %[[VAL_1]]
+! STACK-SAME:    stack
+! HEAP-SAME:     heap
+! ALL-NOT:       no_copy
+! ALL-SAME:      : !fir.box<!fir.array<?x?x!fir.char<1,?>>>
+end subroutine test2
+
+! ALL-LABEL:   func.func @_QPtest3(
+! ALL-SAME:                        %[[VAL_0:[0-9]+|[a-zA-Z$._-][a-zA-Z0-9$._-]*]]: !fir.box<!fir.array<?x?x!fir.type<_QFtest3Tt>>> {fir.bindc_name = "x"}) {
+subroutine test3(x)
+  type t
+  end type t
+  type(t) :: x(:,:)
+! ALL:           %[[VAL_2:.*]] = fir.pack_array %[[VAL_0]]
+! STACK-SAME:    stack
+! HEAP-SAME:     heap
+! WHOLE-SAME:    whole
+! INNER-SAME:    innermost
+! ALL-NOT:       no_copy
+! ALL-SAME:      : (!fir.box<!fir.array<?x?x!fir.type<_QFtest3Tt>>>) -> !fir.box<!fir.array<?x?x!fir.type<_QFtest3Tt>>>
+! ALL:           %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_2]] dummy_scope %{{.*}} {uniq_name = "_QFtest3Ex"} : (!fir.box<!fir.array<?x?x!fir.type<_QFtest3Tt>>>, !fir.dscope) -> (!fir.box<!fir.array<?x?x!fir.type<_QFtest3Tt>>>, !fir.box<!fir.array<?x?x!fir.type<_QFtest3Tt>>>)
+! ALL:           fir.unpack_array %[[VAL_2]] to %[[VAL_0]]
+! STACK-SAME:    stack
+! HEAP-SAME:     heap
+! ALL-NOT:       no_copy
+! ALL-SAME:      : !fir.box<!fir.array<?x?x!fir.type<_QFtest3Tt>>>
+end subroutine test3
+
+! ALL-LABEL:   func.func @_QPtest4(
+! ALL-SAME:                        %[[VAL_0:[0-9]+|[a-zA-Z$._-][a-zA-Z0-9$._-]*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x"}) {
+subroutine test4(x)
+  real, intent(inout) :: x(:)
+! ALL:           %[[VAL_2:.*]] = fir.pack_array %[[VAL_0]]
+! STACK-SAME:    stack
+! HEAP-SAME:     heap
+! WHOLE-SAME:    whole
+! ALL-NOT:       no_copy
+! ALL-SAME       : (!fir.box<!fir.array<?xf32>>) -> !fir.box<!fir.array<?xf32>>
+! ALL:           %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_2]] dummy_scope %{{.*}} {fortran_attrs = #fir.var_attrs<intent_inout>, uniq_name = "_QFtest4Ex"} : (!fir.box<!fir.array<?xf32>>, !fir.dscope) -> (!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>)
+! ALL:           fir.unpack_array %[[VAL_2]] to %[[VAL_0]]
+! STACK-SAME:    stack
+! HEAP-SAME:     heap
+! ALL-NOT:       no_copy
+! ALL-SAME       : !fir.box<!fir.array<?xf32>>
+end subroutine test4
+
+! ALL-LABEL:   func.func @_QPtest5(
+! ALL-SAME:                        %[[VAL_0:[0-9]+|[a-zA-Z$._-][a-zA-Z0-9$._-]*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x"}) {
+subroutine test5(x)
+  real, intent(in) :: x(:)
+! ALL:           %[[VAL_2:.*]] = fir.pack_array %[[VAL_0]]
+! STACK-SAME:    stack
+! HEAP-SAME:     heap
+! WHOLE-SAME:    whole
+! ALL-NOT:       no_copy
+! ALL-SAME:      (!fir.box<!fir.array<?xf32>>) -> !fir.box<!fir.array<?xf32>>
+! ALL:           %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_2]] dummy_scope %{{.*}} {fortran_attrs = #fir.var_attrs<intent_in>, uniq_name = "_QFtest5Ex"} : (!fir.box<!fir.array<?xf32>>, !fir.dscope) -> (!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>)
+! ALL:           fir.unpack_array %[[VAL_2]] to %[[VAL_0]]
+! STACK-SAME:    stack
+! HEAP-SAME:     heap
+! ALL-SAME       no_copy : !fir.box<!fir.array<?xf32>>
+end subroutine test5
+
+! ALL-LABEL:   func.func @_QPtest6(
+! ALL-SAME:                        %[[VAL_0:[0-9]+|[a-zA-Z$._-][a-zA-Z0-9$._-]*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x"}) {
+subroutine test6(x)
+  real, intent(out) :: x(:)
+! ALL:           %[[VAL_2:.*]] = fir.pack_array %[[VAL_0]]
+! STACK-SAME:    stack
+! HEAP-SAME:     heap
+! WHOLE-SAME:    whole
+! ALL-SAME       no_copy : (!fir.box<!fir.array<?xf32>>) -> !fir.box<!fir.array<?xf32>>
+! ALL:           %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_2]] dummy_scope %{{.*}} {fortran_attrs = #fir.var_attrs<intent_out>, uniq_name = "_QFtest6Ex"} : (!fir.box<!fir.array<?xf32>>, !fir.dscope) -> (!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>)
+! ALL:           fir.unpack_array %[[VAL_2]] to %[[VAL_0]]
+! STACK-SAME:    stack
+! HEAP-SAME:     heap
+! ALL-NOT:       no_copy
+! ALL-SAME       : !fir.box<!fir.array<?xf32>>
+end subroutine test6
+
+! ALL-LABEL:   func.func @_QPtest7(
+! ALL-SAME:                        %[[VAL_0:[0-9]+|[a-zA-Z$._-][a-zA-Z0-9$._-]*]]: !fir.class<!fir.array<?x!fir.type<_QFtest7Tt>>> {fir.bindc_name = "x"}) {
+subroutine test7(x)
+  type t
+  end type t
+  class(t) :: x(:)
+! ALL:           %[[VAL_2:.*]] = fir.pack_array %[[VAL_0]]
+! STACK-SAME:    stack
+! HEAP-SAME:     heap
+! WHOLE-SAME:    whole
+! ALL-NOT:       no_copy
+! ALL-SAME       : (!fir.class<!fir.array<?x!fir.type<_QFtest7Tt>>>) -> !fir.class<!fir.array<?x!fir.type<_QFtest7Tt>>>
+! ALL:           %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_2]] dummy_scope %{{.*}} {uniq_name = "_QFtest7Ex"} : (!fir.class<!fir.array<?x!fir.type<_QFtest7Tt>>>, !fir.dscope) -> (!fir.class<!fir.array<?x!fir.type<_QFtest7Tt>>>, !fir.class<!fir.array<?x!fir.type<_QFtest7Tt>>>)
+! ALL:           fir.unpack_array %[[VAL_2]] to %[[VAL_0]]
+! STACK-SAME:    stack
+! HEAP-SAME:     heap
+! ALL-NOT:       no_copy
+! ALL-SAME       : !fir.class<!fir.array<?x!fir.type<_QFtest7Tt>>>
+end subroutine test7
+
+! ALL-LABEL:   func.func @_QPtest8(
+! ALL-SAME:                        %[[VAL_0:[0-9]+|[a-zA-Z$._-][a-zA-Z0-9$._-]*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x"}) {
+subroutine test8(x)
+  real :: x(:)
+! ALL:           %[[VAL_2:.*]] = fir.pack_array %[[VAL_0]]
+! STACK-SAME:    stack
+! HEAP-SAME:     heap
+! WHOLE-SAME:    whole
+! ALL-NOT:       no_copy
+! ALL-SAME       : (!fir.box<!fir.array<?xf32>>) -> !fir.box<!fir.array<?xf32>>
+! ALL:           %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_2]] dummy_scope %{{.*}} {uniq_name = "_QFtest8Ex"} : (!fir.box<!fir.array<?xf32>>, !fir.dscope) -> (!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>)
+  call inner(x(1))
+! ALL:           fir.call @_QFtest8Pinner
+! ALL:           fir.unpack_array %[[VAL_2]] to %[[VAL_0]]
+! STACK-SAME:    stack
+! HEAP-SAME:     heap
+! ALL-NOT:       no_copy
+! ALL-SAME       : !fir.box<!fir.array<?xf32>>
+contains
+! ALL-LABEL:   func.func private @_QFtest8Pinner(
+  subroutine inner(y)
+! ALL-NOT: fir.pack_array
+! ALL-NOT: fir.unpack_array
+    real :: y
+    y = 1.0
+  end subroutine inner
+end subroutine test8
+
+! ALL-LABEL:   func.func @_QPtest9(
+! ALL-SAME:                        %[[VAL_0:[0-9]+|[a-zA-Z$._-][a-zA-Z0-9$._-]*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x"}) -> f32 {
+real function test9(x)
+  real :: x(:)
+! ALL:           %[[VAL_6:.*]] = fir.pack_array %[[VAL_0]]
+! STACK-SAME:    stack
+! HEAP-SAME:     heap
+! WHOLE-SAME:    whole
+! ALL-NOT:       no_copy
+! ALL-SAME       : (!fir.box<!fir.array<?xf32>>) -> !fir.box<!fir.array<?xf32>>
+! ALL:           %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_6]] dummy_scope %{{.*}} {uniq_name = "_QFtest9Ex"} : (!fir.box<!fir.array<?xf32>>, !fir.dscope) -> (!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>)
+  real :: y(10)
+  test9 = x(1)
+! ALL:           fir.unpack_array %[[VAL_6]] to %[[VAL_0]]
+! STACK-SAME:    stack
+! HEAP-SAME:     heap
+! ALL-NOT:       no_copy
+! ALL-SAME       : !fir.box<!fir.array<?xf32>>
+! ALL-NEXT:      return
+  return
+
+! ALL-LABEL:   func.func @_QPtest9_alt(
+  entry test9_alt(y)
+! ALL-NOT: fir.pack_array
+! ALL-NOT: fir.unpack_array
+  rest9_ = y(1)
+end function test9
+
+! ALL-LABEL:   func.func @_QPtest10(
+! ALL-SAME:                         %[[VAL_0:[0-9]+|[a-zA-Z$._-][a-zA-Z0-9$._-]*]]: !fir.box<!fir.array<?x?xf32>> {fir.bindc_name = "x", fir.optional}) {
+subroutine test10(x)
+  real, optional :: x(:,:)
+! ALL:           %[[VAL_2:.*]] = fir.pack_array %[[VAL_0]]
+! STACK-SAME:    stack
+! HEAP-SAME:     heap
+! WHOLE-SAME:    whole
+! INNER-SAME:    innermost
+! ALL-NOT:       no_copy
+! ALL-SAME:      : (!fir.box<!fir.array<?x?xf32>>) -> !fir.box<!fir.array<?x?xf32>>
+! ALL:           %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_2]] dummy_scope %{{.*}} {fortran_attrs = #fir.var_attrs<optional>, uniq_name = "_QFtest10Ex"} : (!fir.box<!fir.array<?x?xf32>>, !fir.dscope) -> (!fir.box<!fir.array<?x?xf32>>, !fir.box<!fir.array<?x?xf32>>)
+! ALL:           fir.unpack_array %[[VAL_2]] to %[[VAL_0]]
+! STACK-SAME:    stack
+! HEAP-SAME:     heap
+! ALL-NOT:       no_copy
+! ALL-SAME:      : !fir.box<!fir.array<?x?xf32>>
+end subroutine test10
+
+! ALL-LABEL:   func.func @_QPtest11(
+! ALL-SAME:                         %[[VAL_0:[0-9]+|[a-zA-Z$._-][a-zA-Z0-9$._-]*]]: !fir.box<!fir.array<?x!fir.char<1,10>>> {fir.bindc_name = "x"}) {
+subroutine test11(x)
+  character(10) :: x(:)
+! ALL:           %[[VAL_3:.*]] = fir.pack_array %[[VAL_0]]
+! STACK-SAME:    stack
+! HEAP-SAME:     heap
+! WHOLE-SAME:    whole
+! INNER-SAME:    whole
+! ALL-NOT:       no_copy
+! ALL-SAME:      : (!fir.box<!fir.array<?x!fir.char<1,10>>>) -> !fir.box<!fir.array<?x!fir.char<1,10>>>
+! ALL:           fir.unpack_array %[[VAL_3]] to %[[VAL_0]]
+! STACK-SAME:    stack
+! HEAP-SAME:     heap
+! ALL-NOT:       no_copy
+! ALL-SAME:      : !fir.box<!fir.array<?x!fir.char<1,10>>>
+end subroutine test11
+
+! ALL-LABEL:   func.func @_QPtest12(
+! ALL-SAME:                         %[[VAL_0:[0-9]+|[a-zA-Z$._-][a-zA-Z0-9$._-]*]]: !fir.box<!fir.array<?x!fir.char<1,?>>> {fir.bindc_name = "x"}) {
+subroutine test12(x)
+  character(*) :: x(:)
+! ALL:           %[[VAL_2:.*]] = fir.pack_array %[[VAL_0]]
+! STACK-SAME:    stack
+! HEAP-SAME:     heap
+! WHOLE-SAME:    whole
+! INNER-SAME:    whole
+! ALL-NOT:       no_copy
+! ALL-SAME:      : (!fir.box<!fir.array<?x!fir.char<1,?>>>) -> !fir.box<!fir.array<?x!fir.char<1,?>>>
+! ALL:           fir.unpack_array %[[VAL_2]] to %[[VAL_0]]
+! STACK-SAME:    stack
+! HEAP-SAME:     heap
+! ALL-NOT:       no_copy
+! ALL-SAME:      : !fir.box<!fir.array<?x!fir.char<1,?>>>
+end subroutine test12
diff --git a/flang/tools/bbc/bbc.cpp b/flang/tools/bbc/bbc.cpp
index efaeb0c0a3891..2cc75b7aa4e87 100644
--- a/flang/tools/bbc/bbc.cpp
+++ b/flang/tools/bbc/bbc.cpp
@@ -245,6 +245,29 @@ static llvm::cl::opt<bool>
                                  "the LHS of the intrinsic assignment"),
                   llvm::cl::init(true));
 
+// TODO: -fstack-arrays is currently only used for fir.pack_array,
+// but it should probably be used for deciding how arrays/temporaries
+// are allocated during lowering.
+static llvm::cl::opt<bool>
+    stackArrays("fstack-arrays",
+                llvm::cl::desc("Allocate all arrays of unknown size and "
+                               "temporary arrays in stack memory"),
+                llvm::cl::init(false));
+
+static llvm::cl::opt<bool>
+    repackArrays("frepack-arrays",
+                 llvm::cl::desc("Pack non-contiguous assummed shape arrays "
+                                "into contiguous memory"),
+                 llvm::cl::init(false));
+
+static llvm::cl::opt<bool>
+    repackArraysWhole("frepack-arrays-continuity-whole",
+                      llvm::cl::desc("Repack arrays that are non-contiguous "
+                                     "in any dimension. If set to false, "
+                                     "only the arrays non-contiguous in the "
+                                     "leading dimension will be repacked"),
+                      llvm::cl::init(true));
+
 #define FLANG_EXCLUDE_CODEGEN
 #include "flang/Optimizer/Passes/CommandLineOpts.h"
 #include "flang/Optimizer/Passes/Pipelines.h"
@@ -388,6 +411,9 @@ static llvm::LogicalResult convertFortranSourceToMLIR(
   loweringOptions.setIntegerWrapAround(integerWrapAround);
   loweringOptions.setInitGlobalZero(initGlobalZero);
   loweringOptions.setReallocateLHS(reallocateLHS);
+  loweringOptions.setStackArrays(stackArrays);
+  loweringOptions.setRepackArrays(repackArrays);
+  loweringOptions.setRepackArraysWhole(repackArraysWhole);
   std::vector<Fortran::lower::EnvironmentDefault> envDefaults = {};
   Fortran::frontend::TargetOptions targetOpts;
   Fortran::frontend::CodeGenOptions cgOpts;



More information about the flang-commits mailing list