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.

Sign up for GitHub

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
Merged

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

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
6956c9a
[flang][NFC] Remove getOriginalActual from PreparedActualArgument
jeanPerier Oct 3, 2023
4444c39
[flang][hlfir] Pass vector subscripted elemental call arg by address
jeanPerier Oct 3, 2023
a0179e0
add back if removed by mistake
jeanPerier Oct 4, 2023
c68299f
test IsVariable before HasVectorSubscript
jeanPerier Oct 4, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
73 changes: 64 additions & 9 deletions flang/include/flang/Lower/HlfirIntrinsics.h
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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>
Expand Down Expand Up @@ -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");
Expand All @@ -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
Expand Down
74 changes: 50 additions & 24 deletions flang/lib/Lower/ConvertCall.cpp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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>
Expand Down Expand Up @@ -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.
Expand All @@ -1663,16 +1660,10 @@ 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];
for (auto &preparedActual : loweredActuals) {
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});

if (hlfir::AssociateOp associate =
preparedActual->associateIfArrayExpr(loc, builder)) {
fir::FirOpBuilder *bldr = &builder;
callContext.stmtCtx.attachCleanup(
[=]() { bldr->create<hlfir::EndAssociateOp>(loc, associate); });
Expand Down Expand Up @@ -1852,9 +1843,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,
Expand All @@ -1874,7 +1864,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 {};
Expand Down Expand Up @@ -2137,7 +2127,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<
Expand All @@ -2162,6 +2152,21 @@ genProcedureRef(CallContext &callContext) {
}
}

if (isElemental && !arg.hasValueAttribute() &&
Fortran::evaluate::IsVariable(*expr) &&
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);
Expand All @@ -2178,7 +2183,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())
Expand All @@ -2189,6 +2194,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();
Expand Down
4 changes: 2 additions & 2 deletions flang/lib/Lower/HlfirIntrinsics.cpp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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()) {
Expand Down Expand Up @@ -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) {
Expand Down
93 changes: 93 additions & 0 deletions flang/test/Lower/HLFIR/elemental-call-vector-subscripts.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,93 @@
! 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

subroutine test_not_a_variable(i)
interface
elemental subroutine foo2(j)
integer(8), intent(in) :: j
end subroutine
end interface
integer(8) :: i(:)
call foo2((i(i)))
end subroutine
! CHECK-LABEL: func.func @_QPtest_not_a_variable(
! CHECK: hlfir.elemental
! CHECK: %[[VAL_16:.*]] = hlfir.elemental
! CHECK: %[[VAL_20:.*]] = arith.constant 1 : index
! CHECK: fir.do_loop %[[VAL_21:.*]] = {{.*}}
! CHECK: %[[VAL_22:.*]] = hlfir.apply %[[VAL_16]], %[[VAL_21]] : (!hlfir.expr<?xi64>, index) -> i64
! CHECK: %[[VAL_23:.*]]:3 = hlfir.associate %[[VAL_22]] {uniq_name = "adapt.valuebyref"} : (i64) -> (!fir.ref<i64>, !fir.ref<i64>, i1)
! CHECK: fir.call @_QPfoo2(%[[VAL_23]]#1){{.*}}: (!fir.ref<i64>) -> ()
! CHECK: hlfir.end_associate %[[VAL_23]]#1, %[[VAL_23]]#2 : !fir.ref<i64>, i1
! CHECK: }