Skip to content

[flang][hlfir] Pass vector subscripted elemental call arg by address #68097

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 4 commits into from
Oct 4, 2023

Conversation

jeanPerier
Copy link
Contributor

I missed that vector subscripted arguments must still be passed by
address in an elemental call where the dummy argument does not have
the VALUE attribute.

Update PreparedActualArgument to hold an hlfir::Entity or an
hlfir::ElementalOp and to inline the elementalOp body in getActual.

Change in order to support vector subscripted entity passed by address
in elemental calls.

PreparedActualArguments will hold an hlfir::Entity or an
hlfir::ElementalAddrOp.
I missed that vector subscripted arguments must still be passed by
address in an elemental call where the dummy argument does not have
the VALUE attribute.

Update PreparedActualArgument to hold an hlfir::Entity or an
hlfir::ElementalOp and to inline the elementalOp body in `getActual`.
@jeanPerier jeanPerier requested review from tblah and vzakhari October 3, 2023 12:39
@llvmbot llvmbot added flang Flang issues not falling into any other category flang:fir-hlfir labels Oct 3, 2023
@llvmbot
Copy link
Member

llvmbot commented Oct 3, 2023

@llvm/pr-subscribers-flang-fir-hlfir

Changes

I missed that vector subscripted arguments must still be passed by
address in an elemental call where the dummy argument does not have
the VALUE attribute.

Update PreparedActualArgument to hold an hlfir::Entity or an
hlfir::ElementalOp and to inline the elementalOp body in getActual.


Full diff: https://github.com/llvm/llvm-project/pull/68097.diff

4 Files Affected:

  • (modified) flang/include/flang/Lower/HlfirIntrinsics.h (+64-9)
  • (modified) flang/lib/Lower/ConvertCall.cpp (+52-29)
  • (modified) flang/lib/Lower/HlfirIntrinsics.cpp (+2-2)
  • (added) flang/test/Lower/HLFIR/elemental-call-vector-subscripts.f90 (+73)
diff --git a/flang/include/flang/Lower/HlfirIntrinsics.h b/flang/include/flang/Lower/HlfirIntrinsics.h
index df1f1ac9a7cf5a7..088f8bccef4aa1b 100644
--- a/flang/include/flang/Lower/HlfirIntrinsics.h
+++ b/flang/include/flang/Lower/HlfirIntrinsics.h
@@ -19,6 +19,8 @@
 #define FORTRAN_LOWER_HLFIRINTRINSICS_H
 
 #include "flang/Optimizer/Builder/HLFIRTools.h"
+#include "flang/Optimizer/Builder/Todo.h"
+#include "flang/Optimizer/HLFIR/HLFIROps.h"
 #include "llvm/ADT/SmallVector.h"
 #include <cassert>
 #include <optional>
@@ -46,18 +48,71 @@ struct PreparedActualArgument {
   PreparedActualArgument(hlfir::Entity actual,
                          std::optional<mlir::Value> isPresent)
       : actual{actual}, isPresent{isPresent} {}
+  PreparedActualArgument(hlfir::ElementalAddrOp vectorSubscriptedActual)
+      : actual{vectorSubscriptedActual}, isPresent{std::nullopt} {}
   void setElementalIndices(mlir::ValueRange &indices) {
     oneBasedElementalIndices = &indices;
   }
-  hlfir::Entity getActual(mlir::Location loc,
-                          fir::FirOpBuilder &builder) const {
-    if (oneBasedElementalIndices)
-      return hlfir::getElementAt(loc, builder, actual,
-                                 *oneBasedElementalIndices);
-    return actual;
+
+  /// Get the prepared actual. If this is an array argument in an elemental
+  /// call, the current element value will be returned.
+  hlfir::Entity getActual(mlir::Location loc, fir::FirOpBuilder &builder) const;
+
+  void derefPointersAndAllocatables(mlir::Location loc,
+                                    fir::FirOpBuilder &builder) {
+    if (auto *actualEntity = std::get_if<hlfir::Entity>(&actual))
+      actual = hlfir::derefPointersAndAllocatables(loc, builder, *actualEntity);
+  }
+
+  void loadTrivialScalar(mlir::Location loc, fir::FirOpBuilder &builder) {
+    if (auto *actualEntity = std::get_if<hlfir::Entity>(&actual))
+      actual = hlfir::loadTrivialScalar(loc, builder, *actualEntity);
+  }
+
+  /// Ensure an array expression argument is fully evaluated in memory before
+  /// the call. Useful for impure elemental calls.
+  hlfir::AssociateOp associateIfArrayExpr(mlir::Location loc,
+                                          fir::FirOpBuilder &builder) {
+    if (auto *actualEntity = std::get_if<hlfir::Entity>(&actual)) {
+      if (!actualEntity->isVariable() && actualEntity->isArray()) {
+        mlir::Type storageType = actualEntity->getType();
+        hlfir::AssociateOp associate = hlfir::genAssociateExpr(
+            loc, builder, *actualEntity, storageType, "adapt.impure_arg_eval");
+        actual = hlfir::Entity{associate};
+        return associate;
+      }
+    }
+    return {};
+  }
+
+  bool isArray() const {
+    return std::holds_alternative<hlfir::ElementalAddrOp>(actual) ||
+           std::get<hlfir::Entity>(actual).isArray();
   }
-  hlfir::Entity getOriginalActual() const { return actual; }
-  void setOriginalActual(hlfir::Entity newActual) { actual = newActual; }
+
+  mlir::Value genShape(mlir::Location loc, fir::FirOpBuilder &builder) {
+    if (auto *actualEntity = std::get_if<hlfir::Entity>(&actual))
+      return hlfir::genShape(loc, builder, *actualEntity);
+    return std::get<hlfir::ElementalAddrOp>(actual).getShape();
+  }
+
+  mlir::Value genCharLength(mlir::Location loc, fir::FirOpBuilder &builder) {
+    if (auto *actualEntity = std::get_if<hlfir::Entity>(&actual))
+      return hlfir::genCharLength(loc, builder, *actualEntity);
+    auto typeParams = std::get<hlfir::ElementalAddrOp>(actual).getTypeparams();
+    assert(typeParams.size() == 1 &&
+           "failed to retrieve vector subscripted character length");
+    return typeParams[0];
+  }
+
+  /// When the argument is polymorphic, get mold value with the same dynamic
+  /// type.
+  mlir::Value getPolymorphicMold(mlir::Location loc) const {
+    if (auto *actualEntity = std::get_if<hlfir::Entity>(&actual))
+      return *actualEntity;
+    TODO(loc, "polymorphic vector subscripts");
+  }
+
   bool handleDynamicOptional() const { return isPresent.has_value(); }
   mlir::Value getIsPresent() const {
     assert(handleDynamicOptional() && "not a dynamic optional");
@@ -67,7 +122,7 @@ struct PreparedActualArgument {
   void resetOptionalAspect() { isPresent = std::nullopt; }
 
 private:
-  hlfir::Entity actual;
+  std::variant<hlfir::Entity, hlfir::ElementalAddrOp> actual;
   mlir::ValueRange *oneBasedElementalIndices{nullptr};
   // When the actual may be dynamically optional, "isPresent"
   // holds a boolean value indicating the presence of the
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index 169ef71d005ccd2..ab2401feefc4a57 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -29,6 +29,7 @@
 #include "flang/Optimizer/Builder/Todo.h"
 #include "flang/Optimizer/Dialect/FIROpsSupport.h"
 #include "flang/Optimizer/HLFIR/HLFIROps.h"
+#include "mlir/IR/IRMapping.h"
 #include "llvm/Support/CommandLine.h"
 #include "llvm/Support/Debug.h"
 #include <optional>
@@ -1619,37 +1620,33 @@ class ElementalCallBuilder {
     for (unsigned i = 0; i < numArgs; ++i) {
       auto &preparedActual = loweredActuals[i];
       if (preparedActual) {
-        hlfir::Entity actual = preparedActual->getOriginalActual();
         // Elemental procedure dummy arguments cannot be pointer/allocatables
         // (C15100), so it is safe to dereference any pointer or allocatable
         // actual argument now instead of doing this inside the elemental
         // region.
-        actual = hlfir::derefPointersAndAllocatables(loc, builder, actual);
+        preparedActual->derefPointersAndAllocatables(loc, builder);
         // Better to load scalars outside of the loop when possible.
         if (!preparedActual->handleDynamicOptional() &&
             impl().canLoadActualArgumentBeforeLoop(i))
-          actual = hlfir::loadTrivialScalar(loc, builder, actual);
+          preparedActual->loadTrivialScalar(loc, builder);
         // TODO: merge shape instead of using the first one.
-        if (!shape && actual.isArray()) {
+        if (!shape && preparedActual->isArray()) {
           if (preparedActual->handleDynamicOptional())
             optionalWithShape = &*preparedActual;
           else
-            shape = hlfir::genShape(loc, builder, actual);
+            shape = preparedActual->genShape(loc, builder);
         }
         // 15.8.3 p1. Elemental procedure with intent(out)/intent(inout)
         // arguments must be called in element order.
         if (impl().argMayBeModifiedByCall(i))
           mustBeOrdered = true;
-        // Propagates pointer dereferences and scalar loads.
-        preparedActual->setOriginalActual(actual);
       }
     }
     if (!shape && optionalWithShape) {
       // If all array operands appear in optional positions, then none of them
       // is allowed to be absent as per 15.5.2.12 point 3. (6). Just pick the
       // first operand.
-      shape =
-          hlfir::genShape(loc, builder, optionalWithShape->getOriginalActual());
+      shape = optionalWithShape->genShape(loc, builder);
       // TODO: There is an opportunity to add a runtime check here that
       // this array is present as required. Also, the optionality of all actual
       // could be checked and reset given the Fortran requirement.
@@ -1663,20 +1660,12 @@ class ElementalCallBuilder {
     // intent(inout) arguments. Note that the scalar arguments are handled
     // above.
     if (mustBeOrdered) {
-      for (unsigned i = 0; i < numArgs; ++i) {
-        auto &preparedActual = loweredActuals[i];
-        if (preparedActual) {
-          hlfir::Entity actual = preparedActual->getOriginalActual();
-          if (!actual.isVariable() && actual.isArray()) {
-            mlir::Type storageType = actual.getType();
-            hlfir::AssociateOp associate = hlfir::genAssociateExpr(
-                loc, builder, actual, storageType, "adapt.impure_arg_eval");
-            preparedActual->setOriginalActual(hlfir::Entity{associate});
-
-            fir::FirOpBuilder *bldr = &builder;
-            callContext.stmtCtx.attachCleanup(
-                [=]() { bldr->create<hlfir::EndAssociateOp>(loc, associate); });
-          }
+      for (auto &preparedActual : loweredActuals) {
+        if (hlfir::AssociateOp associate =
+                preparedActual->associateIfArrayExpr(loc, builder)) {
+          fir::FirOpBuilder *bldr = &builder;
+          callContext.stmtCtx.attachCleanup(
+              [=]() { bldr->create<hlfir::EndAssociateOp>(loc, associate); });
         }
       }
     }
@@ -1852,9 +1841,8 @@ class ElementalIntrinsicCallBuilder
     if (intrinsic)
       if (intrinsic->name == "adjustr" || intrinsic->name == "adjustl" ||
           intrinsic->name == "merge")
-        return hlfir::genCharLength(
-            callContext.loc, callContext.getBuilder(),
-            loweredActuals[0].value().getOriginalActual());
+        return loweredActuals[0].value().genCharLength(
+            callContext.loc, callContext.getBuilder());
     // Character MIN/MAX is the min/max of the arguments length that are
     // present.
     TODO(callContext.loc,
@@ -1874,7 +1862,7 @@ class ElementalIntrinsicCallBuilder
       // the same declared and dynamic types. So any of them can be used
       // for the mold.
       assert(!loweredActuals.empty());
-      return loweredActuals.front()->getOriginalActual();
+      return loweredActuals.front()->getPolymorphicMold(callContext.loc);
     }
 
     return {};
@@ -2137,7 +2125,7 @@ genProcedureRef(CallContext &callContext) {
   Fortran::lower::CallerInterface caller(callContext.procRef,
                                          callContext.converter);
   mlir::FunctionType callSiteType = caller.genFunctionType();
-
+  const bool isElemental = callContext.isElementalProcWithArrayArgs();
   Fortran::lower::PreparedActualArguments loweredActuals;
   // Lower the actual arguments
   for (const Fortran::lower::CallInterface<
@@ -2162,6 +2150,20 @@ genProcedureRef(CallContext &callContext) {
         }
       }
 
+      if (isElemental && !arg.hasValueAttribute() &&
+          Fortran::evaluate::HasVectorSubscript(*expr)) {
+        // Vector subscripted arguments are copied in calls, except in elemental
+        // calls without VALUE attribute where Fortran 2018 15.5.2.4 point 21
+        // does not apply and the address of each element must be passed.
+        hlfir::ElementalAddrOp elementalAddr =
+            Fortran::lower::convertVectorSubscriptedExprToElementalAddr(
+                loc, callContext.converter, *expr, callContext.symMap,
+                callContext.stmtCtx);
+        loweredActuals.emplace_back(
+            Fortran::lower::PreparedActualArgument{elementalAddr});
+        continue;
+      }
+
       auto loweredActual = Fortran::lower::convertExprToHLFIR(
           loc, callContext.converter, *expr, callContext.symMap,
           callContext.stmtCtx);
@@ -2178,7 +2180,7 @@ genProcedureRef(CallContext &callContext) {
       // Optional dummy argument for which there is no actual argument.
       loweredActuals.emplace_back(std::nullopt);
     }
-  if (callContext.isElementalProcWithArrayArgs()) {
+  if (isElemental) {
     bool isImpure = false;
     if (const Fortran::semantics::Symbol *procSym =
             callContext.procRef.proc().GetSymbol())
@@ -2189,6 +2191,27 @@ genProcedureRef(CallContext &callContext) {
   return genUserCall(loweredActuals, caller, callSiteType, callContext);
 }
 
+hlfir::Entity Fortran::lower::PreparedActualArgument::getActual(
+    mlir::Location loc, fir::FirOpBuilder &builder) const {
+  if (auto *actualEntity = std::get_if<hlfir::Entity>(&actual)) {
+    if (oneBasedElementalIndices)
+      return hlfir::getElementAt(loc, builder, *actualEntity,
+                                 *oneBasedElementalIndices);
+    return *actualEntity;
+  }
+  assert(oneBasedElementalIndices && "expect elemental context");
+  hlfir::ElementalAddrOp elementalAddr =
+      std::get<hlfir::ElementalAddrOp>(actual);
+  mlir::IRMapping mapper;
+  auto alwaysFalse = [](hlfir::ElementalOp) -> bool { return false; };
+  mlir::Value addr = hlfir::inlineElementalOp(
+      loc, builder, elementalAddr, *oneBasedElementalIndices, mapper,
+      /*mustRecursivelyInline=*/alwaysFalse);
+  assert(elementalAddr.getCleanup().empty() && "no clean-up expected");
+  elementalAddr.erase();
+  return hlfir::Entity{addr};
+}
+
 bool Fortran::lower::isIntrinsicModuleProcRef(
     const Fortran::evaluate::ProcedureRef &procRef) {
   const Fortran::semantics::Symbol *symbol = procRef.proc().GetSymbol();
diff --git a/flang/lib/Lower/HlfirIntrinsics.cpp b/flang/lib/Lower/HlfirIntrinsics.cpp
index 20e570044e8d4ae..9f764b614252261 100644
--- a/flang/lib/Lower/HlfirIntrinsics.cpp
+++ b/flang/lib/Lower/HlfirIntrinsics.cpp
@@ -152,7 +152,7 @@ mlir::Value HlfirTransformationalIntrinsic::loadBoxAddress(
   if (!arg)
     return mlir::Value{};
 
-  hlfir::Entity actual = arg->getOriginalActual();
+  hlfir::Entity actual = arg->getActual(loc, builder);
 
   if (!arg->handleDynamicOptional()) {
     if (actual.isMutableBox()) {
@@ -193,7 +193,7 @@ llvm::SmallVector<mlir::Value> HlfirTransformationalIntrinsic::getOperandVector(
       operands.emplace_back();
       continue;
     }
-    hlfir::Entity actual = arg->getOriginalActual();
+    hlfir::Entity actual = arg->getActual(loc, builder);
     mlir::Value valArg;
 
     if (!argLowering) {
diff --git a/flang/test/Lower/HLFIR/elemental-call-vector-subscripts.f90 b/flang/test/Lower/HLFIR/elemental-call-vector-subscripts.f90
new file mode 100644
index 000000000000000..8d2e5cf00fb5426
--- /dev/null
+++ b/flang/test/Lower/HLFIR/elemental-call-vector-subscripts.f90
@@ -0,0 +1,73 @@
+! Test passing of vector subscripted entities inside elemental
+! procedures.
+! RUN: bbc --emit-hlfir -o - %s | FileCheck %s
+
+subroutine test()
+  interface
+    elemental subroutine foo(x, y)
+      real, intent(in) :: x
+      real, value :: y
+    end subroutine
+  end interface
+  real :: x(10)
+  call foo(x([1,3,7]), 0.)
+end subroutine
+! CHECK-LABEL:   func.func @_QPtest() {
+! CHECK:           %[[VAL_0:.*]] = arith.constant 10 : index
+! CHECK:           %[[VAL_1:.*]] = fir.alloca !fir.array<10xf32> {bindc_name = "x", uniq_name = "_QFtestEx"}
+! CHECK:           %[[VAL_2:.*]] = fir.shape %[[VAL_0]] : (index) -> !fir.shape<1>
+! CHECK:           %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_1]](%[[VAL_2]]) {uniq_name = "_QFtestEx"} : (!fir.ref<!fir.array<10xf32>>, !fir.shape<1>) -> (!fir.ref<!fir.array<10xf32>>, !fir.ref<!fir.array<10xf32>>)
+! CHECK:           %[[VAL_4:.*]] = fir.address_of(@_QQro.3xi8.0) : !fir.ref<!fir.array<3xi64>>
+! CHECK:           %[[VAL_5:.*]] = arith.constant 3 : index
+! CHECK:           %[[VAL_6:.*]] = fir.shape %[[VAL_5]] : (index) -> !fir.shape<1>
+! CHECK:           %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_4]](%[[VAL_6]])
+! CHECK:           %[[VAL_8:.*]] = arith.constant 3 : index
+! CHECK:           %[[VAL_9:.*]] = arith.constant 0.000000e+00 : f32
+! CHECK:           %[[VAL_10:.*]] = arith.constant 1 : index
+! CHECK:           fir.do_loop %[[VAL_11:.*]] = %[[VAL_10]] to %[[VAL_8]] step %[[VAL_10]] unordered {
+! CHECK:             %[[VAL_12:.*]] = hlfir.designate %[[VAL_7]]#0 (%[[VAL_11]])  : (!fir.ref<!fir.array<3xi64>>, index) -> !fir.ref<i64>
+! CHECK:             %[[VAL_13:.*]] = fir.load %[[VAL_12]] : !fir.ref<i64>
+! CHECK:             %[[VAL_14:.*]] = hlfir.designate %[[VAL_3]]#0 (%[[VAL_13]])  : (!fir.ref<!fir.array<10xf32>>, i64) -> !fir.ref<f32>
+! CHECK:             fir.call @_QPfoo(%[[VAL_14]], %[[VAL_9]]) {{.*}}: (!fir.ref<f32>, f32) -> ()
+! CHECK:           }
+! CHECK:           return
+! CHECK:         }
+
+subroutine test_value()
+  interface
+    elemental subroutine foo_value(x, y)
+      real, value :: x
+      real, value :: y
+    end subroutine
+  end interface
+  real :: x(10)
+  call foo_value(x([1,3,7]), 0.)
+end subroutine
+
+! CHECK-LABEL:   func.func @_QPtest_value() {
+! CHECK:           %[[VAL_0:.*]] = arith.constant 10 : index
+! CHECK:           %[[VAL_1:.*]] = fir.alloca !fir.array<10xf32> {bindc_name = "x", uniq_name = "_QFtest_valueEx"}
+! CHECK:           %[[VAL_2:.*]] = fir.shape %[[VAL_0]] : (index) -> !fir.shape<1>
+! CHECK:           %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_1]](%[[VAL_2]]) {uniq_name = "_QFtest_valueEx"} : (!fir.ref<!fir.array<10xf32>>, !fir.shape<1>) -> (!fir.ref<!fir.array<10xf32>>, !fir.ref<!fir.array<10xf32>>)
+! CHECK:           %[[VAL_4:.*]] = fir.address_of(@_QQro.3xi8.0) : !fir.ref<!fir.array<3xi64>>
+! CHECK:           %[[VAL_5:.*]] = arith.constant 3 : index
+! CHECK:           %[[VAL_6:.*]] = fir.shape %[[VAL_5]] : (index) -> !fir.shape<1>
+! CHECK:           %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_4]](%[[VAL_6]])
+! CHECK:           %[[VAL_8:.*]] = arith.constant 3 : index
+! CHECK:           %[[VAL_9:.*]] = fir.shape %[[VAL_8]] : (index) -> !fir.shape<1>
+! CHECK:           %[[VAL_10:.*]] = hlfir.elemental %[[VAL_9]] unordered : (!fir.shape<1>) -> !hlfir.expr<3xf32> {
+! CHECK:           ^bb0(%[[VAL_11:.*]]: index):
+! CHECK:             %[[VAL_12:.*]] = hlfir.designate %[[VAL_7]]#0 (%[[VAL_11]])  : (!fir.ref<!fir.array<3xi64>>, index) -> !fir.ref<i64>
+! CHECK:             %[[VAL_13:.*]] = fir.load %[[VAL_12]] : !fir.ref<i64>
+! CHECK:             %[[VAL_14:.*]] = hlfir.designate %[[VAL_3]]#0 (%[[VAL_13]])  : (!fir.ref<!fir.array<10xf32>>, i64) -> !fir.ref<f32>
+! CHECK:             %[[VAL_15:.*]] = fir.load %[[VAL_14]] : !fir.ref<f32>
+! CHECK:             hlfir.yield_element %[[VAL_15]] : f32
+! CHECK:           }
+! CHECK:           %[[VAL_16:.*]] = arith.constant 0.000000e+00 : f32
+! CHECK:           %[[VAL_17:.*]] = arith.constant 1 : index
+! CHECK:           fir.do_loop %[[VAL_18:.*]] = %[[VAL_17]] to %[[VAL_8]] step %[[VAL_17]] unordered {
+! CHECK:             %[[VAL_19:.*]] = hlfir.apply %[[VAL_10]], %[[VAL_18]] : (!hlfir.expr<3xf32>, index) -> f32
+! CHECK:             fir.call @_QPfoo_value(%[[VAL_19]], %[[VAL_16]]) {{.*}}: (f32, f32) -> ()
+! CHECK:           }
+! CHECK:           hlfir.destroy %[[VAL_10]] : !hlfir.expr<3xf32>
+! CHECK:           return

Copy link
Contributor

@vzakhari vzakhari left a comment

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Looks great! Thank you!

I mistakenly thought that HasVectorSubscript would only return true for
variables, but it return true for expressions containing vector
subscripted designator in general. Fix and add a test.
@jeanPerier jeanPerier merged commit 8c2ed5c into llvm:main Oct 4, 2023
@jeanPerier jeanPerier deleted the jp-elemental-vector-subscripts branch October 4, 2023 12:00
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
flang:fir-hlfir flang Flang issues not falling into any other category
Projects
None yet
Development

Successfully merging this pull request may close these issues.

3 participants