Skip to content

Commit 8c2ed5c

Browse files
jeanPerierjeanPerier
authored
[flang][hlfir] Pass vector subscripted elemental call arg by address (#68097)
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`.
1 parent 824251c commit 8c2ed5c

File tree

4 files changed

+209
-35
lines changed

4 files changed

+209
-35
lines changed

‎flang/include/flang/Lower/HlfirIntrinsics.h‎

Lines changed: 64 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -19,6 +19,8 @@
1919
#define FORTRAN_LOWER_HLFIRINTRINSICS_H
2020

2121
#include "flang/Optimizer/Builder/HLFIRTools.h"
22+
#include "flang/Optimizer/Builder/Todo.h"
23+
#include "flang/Optimizer/HLFIR/HLFIROps.h"
2224
#include "llvm/ADT/SmallVector.h"
2325
#include <cassert>
2426
#include <optional>
@@ -46,18 +48,71 @@ struct PreparedActualArgument {
4648
PreparedActualArgument(hlfir::Entity actual,
4749
std::optional<mlir::Value> isPresent)
4850
: actual{actual}, isPresent{isPresent} {}
51+
PreparedActualArgument(hlfir::ElementalAddrOp vectorSubscriptedActual)
52+
: actual{vectorSubscriptedActual}, isPresent{std::nullopt} {}
4953
void setElementalIndices(mlir::ValueRange &indices) {
5054
oneBasedElementalIndices = &indices;
5155
}
52-
hlfir::Entity getActual(mlir::Location loc,
53-
fir::FirOpBuilder &builder) const {
54-
if (oneBasedElementalIndices)
55-
return hlfir::getElementAt(loc, builder, actual,
56-
*oneBasedElementalIndices);
57-
return actual;
56+
57+
/// Get the prepared actual. If this is an array argument in an elemental
58+
/// call, the current element value will be returned.
59+
hlfir::Entity getActual(mlir::Location loc, fir::FirOpBuilder &builder) const;
60+
61+
void derefPointersAndAllocatables(mlir::Location loc,
62+
fir::FirOpBuilder &builder) {
63+
if (auto *actualEntity = std::get_if<hlfir::Entity>(&actual))
64+
actual = hlfir::derefPointersAndAllocatables(loc, builder, *actualEntity);
65+
}
66+
67+
void loadTrivialScalar(mlir::Location loc, fir::FirOpBuilder &builder) {
68+
if (auto *actualEntity = std::get_if<hlfir::Entity>(&actual))
69+
actual = hlfir::loadTrivialScalar(loc, builder, *actualEntity);
70+
}
71+
72+
/// Ensure an array expression argument is fully evaluated in memory before
73+
/// the call. Useful for impure elemental calls.
74+
hlfir::AssociateOp associateIfArrayExpr(mlir::Location loc,
75+
fir::FirOpBuilder &builder) {
76+
if (auto *actualEntity = std::get_if<hlfir::Entity>(&actual)) {
77+
if (!actualEntity->isVariable() && actualEntity->isArray()) {
78+
mlir::Type storageType = actualEntity->getType();
79+
hlfir::AssociateOp associate = hlfir::genAssociateExpr(
80+
loc, builder, *actualEntity, storageType, "adapt.impure_arg_eval");
81+
actual = hlfir::Entity{associate};
82+
return associate;
83+
}
84+
}
85+
return {};
86+
}
87+
88+
bool isArray() const {
89+
return std::holds_alternative<hlfir::ElementalAddrOp>(actual) ||
90+
std::get<hlfir::Entity>(actual).isArray();
5891
}
59-
hlfir::Entity getOriginalActual() const { return actual; }
60-
void setOriginalActual(hlfir::Entity newActual) { actual = newActual; }
92+
93+
mlir::Value genShape(mlir::Location loc, fir::FirOpBuilder &builder) {
94+
if (auto *actualEntity = std::get_if<hlfir::Entity>(&actual))
95+
return hlfir::genShape(loc, builder, *actualEntity);
96+
return std::get<hlfir::ElementalAddrOp>(actual).getShape();
97+
}
98+
99+
mlir::Value genCharLength(mlir::Location loc, fir::FirOpBuilder &builder) {
100+
if (auto *actualEntity = std::get_if<hlfir::Entity>(&actual))
101+
return hlfir::genCharLength(loc, builder, *actualEntity);
102+
auto typeParams = std::get<hlfir::ElementalAddrOp>(actual).getTypeparams();
103+
assert(typeParams.size() == 1 &&
104+
"failed to retrieve vector subscripted character length");
105+
return typeParams[0];
106+
}
107+
108+
/// When the argument is polymorphic, get mold value with the same dynamic
109+
/// type.
110+
mlir::Value getPolymorphicMold(mlir::Location loc) const {
111+
if (auto *actualEntity = std::get_if<hlfir::Entity>(&actual))
112+
return *actualEntity;
113+
TODO(loc, "polymorphic vector subscripts");
114+
}
115+
61116
bool handleDynamicOptional() const { return isPresent.has_value(); }
62117
mlir::Value getIsPresent() const {
63118
assert(handleDynamicOptional() && "not a dynamic optional");
@@ -67,7 +122,7 @@ struct PreparedActualArgument {
67122
void resetOptionalAspect() { isPresent = std::nullopt; }
68123

69124
private:
70-
hlfir::Entity actual;
125+
std::variant<hlfir::Entity, hlfir::ElementalAddrOp> actual;
71126
mlir::ValueRange *oneBasedElementalIndices{nullptr};
72127
// When the actual may be dynamically optional, "isPresent"
73128
// holds a boolean value indicating the presence of the

‎flang/lib/Lower/ConvertCall.cpp‎

Lines changed: 50 additions & 24 deletions
Original file line numberDiff line numberDiff line change
@@ -29,6 +29,7 @@
2929
#include "flang/Optimizer/Builder/Todo.h"
3030
#include "flang/Optimizer/Dialect/FIROpsSupport.h"
3131
#include "flang/Optimizer/HLFIR/HLFIROps.h"
32+
#include "mlir/IR/IRMapping.h"
3233
#include "llvm/Support/CommandLine.h"
3334
#include "llvm/Support/Debug.h"
3435
#include <optional>
@@ -1619,37 +1620,33 @@ class ElementalCallBuilder {
16191620
for (unsigned i = 0; i < numArgs; ++i) {
16201621
auto &preparedActual = loweredActuals[i];
16211622
if (preparedActual) {
1622-
hlfir::Entity actual = preparedActual->getOriginalActual();
16231623
// Elemental procedure dummy arguments cannot be pointer/allocatables
16241624
// (C15100), so it is safe to dereference any pointer or allocatable
16251625
// actual argument now instead of doing this inside the elemental
16261626
// region.
1627-
actual = hlfir::derefPointersAndAllocatables(loc, builder, actual);
1627+
preparedActual->derefPointersAndAllocatables(loc, builder);
16281628
// Better to load scalars outside of the loop when possible.
16291629
if (!preparedActual->handleDynamicOptional() &&
16301630
impl().canLoadActualArgumentBeforeLoop(i))
1631-
actual = hlfir::loadTrivialScalar(loc, builder, actual);
1631+
preparedActual->loadTrivialScalar(loc, builder);
16321632
// TODO: merge shape instead of using the first one.
1633-
if (!shape && actual.isArray()) {
1633+
if (!shape && preparedActual->isArray()) {
16341634
if (preparedActual->handleDynamicOptional())
16351635
optionalWithShape = &*preparedActual;
16361636
else
1637-
shape = hlfir::genShape(loc, builder, actual);
1637+
shape = preparedActual->genShape(loc, builder);
16381638
}
16391639
// 15.8.3 p1. Elemental procedure with intent(out)/intent(inout)
16401640
// arguments must be called in element order.
16411641
if (impl().argMayBeModifiedByCall(i))
16421642
mustBeOrdered = true;
1643-
// Propagates pointer dereferences and scalar loads.
1644-
preparedActual->setOriginalActual(actual);
16451643
}
16461644
}
16471645
if (!shape && optionalWithShape) {
16481646
// If all array operands appear in optional positions, then none of them
16491647
// is allowed to be absent as per 15.5.2.12 point 3. (6). Just pick the
16501648
// first operand.
1651-
shape =
1652-
hlfir::genShape(loc, builder, optionalWithShape->getOriginalActual());
1649+
shape = optionalWithShape->genShape(loc, builder);
16531650
// TODO: There is an opportunity to add a runtime check here that
16541651
// this array is present as required. Also, the optionality of all actual
16551652
// could be checked and reset given the Fortran requirement.
@@ -1663,16 +1660,10 @@ class ElementalCallBuilder {
16631660
// intent(inout) arguments. Note that the scalar arguments are handled
16641661
// above.
16651662
if (mustBeOrdered) {
1666-
for (unsigned i = 0; i < numArgs; ++i) {
1667-
auto &preparedActual = loweredActuals[i];
1663+
for (auto &preparedActual : loweredActuals) {
16681664
if (preparedActual) {
1669-
hlfir::Entity actual = preparedActual->getOriginalActual();
1670-
if (!actual.isVariable() && actual.isArray()) {
1671-
mlir::Type storageType = actual.getType();
1672-
hlfir::AssociateOp associate = hlfir::genAssociateExpr(
1673-
loc, builder, actual, storageType, "adapt.impure_arg_eval");
1674-
preparedActual->setOriginalActual(hlfir::Entity{associate});
1675-
1665+
if (hlfir::AssociateOp associate =
1666+
preparedActual->associateIfArrayExpr(loc, builder)) {
16761667
fir::FirOpBuilder *bldr = &builder;
16771668
callContext.stmtCtx.attachCleanup(
16781669
[=]() { bldr->create<hlfir::EndAssociateOp>(loc, associate); });
@@ -1852,9 +1843,8 @@ class ElementalIntrinsicCallBuilder
18521843
if (intrinsic)
18531844
if (intrinsic->name == "adjustr" || intrinsic->name == "adjustl" ||
18541845
intrinsic->name == "merge")
1855-
return hlfir::genCharLength(
1856-
callContext.loc, callContext.getBuilder(),
1857-
loweredActuals[0].value().getOriginalActual());
1846+
return loweredActuals[0].value().genCharLength(
1847+
callContext.loc, callContext.getBuilder());
18581848
// Character MIN/MAX is the min/max of the arguments length that are
18591849
// present.
18601850
TODO(callContext.loc,
@@ -1874,7 +1864,7 @@ class ElementalIntrinsicCallBuilder
18741864
// the same declared and dynamic types. So any of them can be used
18751865
// for the mold.
18761866
assert(!loweredActuals.empty());
1877-
return loweredActuals.front()->getOriginalActual();
1867+
return loweredActuals.front()->getPolymorphicMold(callContext.loc);
18781868
}
18791869

18801870
return {};
@@ -2137,7 +2127,7 @@ genProcedureRef(CallContext &callContext) {
21372127
Fortran::lower::CallerInterface caller(callContext.procRef,
21382128
callContext.converter);
21392129
mlir::FunctionType callSiteType = caller.genFunctionType();
2140-
2130+
const bool isElemental = callContext.isElementalProcWithArrayArgs();
21412131
Fortran::lower::PreparedActualArguments loweredActuals;
21422132
// Lower the actual arguments
21432133
for (const Fortran::lower::CallInterface<
@@ -2162,6 +2152,21 @@ genProcedureRef(CallContext &callContext) {
21622152
}
21632153
}
21642154

2155+
if (isElemental && !arg.hasValueAttribute() &&
2156+
Fortran::evaluate::IsVariable(*expr) &&
2157+
Fortran::evaluate::HasVectorSubscript(*expr)) {
2158+
// Vector subscripted arguments are copied in calls, except in elemental
2159+
// calls without VALUE attribute where Fortran 2018 15.5.2.4 point 21
2160+
// does not apply and the address of each element must be passed.
2161+
hlfir::ElementalAddrOp elementalAddr =
2162+
Fortran::lower::convertVectorSubscriptedExprToElementalAddr(
2163+
loc, callContext.converter, *expr, callContext.symMap,
2164+
callContext.stmtCtx);
2165+
loweredActuals.emplace_back(
2166+
Fortran::lower::PreparedActualArgument{elementalAddr});
2167+
continue;
2168+
}
2169+
21652170
auto loweredActual = Fortran::lower::convertExprToHLFIR(
21662171
loc, callContext.converter, *expr, callContext.symMap,
21672172
callContext.stmtCtx);
@@ -2178,7 +2183,7 @@ genProcedureRef(CallContext &callContext) {
21782183
// Optional dummy argument for which there is no actual argument.
21792184
loweredActuals.emplace_back(std::nullopt);
21802185
}
2181-
if (callContext.isElementalProcWithArrayArgs()) {
2186+
if (isElemental) {
21822187
bool isImpure = false;
21832188
if (const Fortran::semantics::Symbol *procSym =
21842189
callContext.procRef.proc().GetSymbol())
@@ -2189,6 +2194,27 @@ genProcedureRef(CallContext &callContext) {
21892194
return genUserCall(loweredActuals, caller, callSiteType, callContext);
21902195
}
21912196

2197+
hlfir::Entity Fortran::lower::PreparedActualArgument::getActual(
2198+
mlir::Location loc, fir::FirOpBuilder &builder) const {
2199+
if (auto *actualEntity = std::get_if<hlfir::Entity>(&actual)) {
2200+
if (oneBasedElementalIndices)
2201+
return hlfir::getElementAt(loc, builder, *actualEntity,
2202+
*oneBasedElementalIndices);
2203+
return *actualEntity;
2204+
}
2205+
assert(oneBasedElementalIndices && "expect elemental context");
2206+
hlfir::ElementalAddrOp elementalAddr =
2207+
std::get<hlfir::ElementalAddrOp>(actual);
2208+
mlir::IRMapping mapper;
2209+
auto alwaysFalse = [](hlfir::ElementalOp) -> bool { return false; };
2210+
mlir::Value addr = hlfir::inlineElementalOp(
2211+
loc, builder, elementalAddr, *oneBasedElementalIndices, mapper,
2212+
/*mustRecursivelyInline=*/alwaysFalse);
2213+
assert(elementalAddr.getCleanup().empty() && "no clean-up expected");
2214+
elementalAddr.erase();
2215+
return hlfir::Entity{addr};
2216+
}
2217+
21922218
bool Fortran::lower::isIntrinsicModuleProcRef(
21932219
const Fortran::evaluate::ProcedureRef &procRef) {
21942220
const Fortran::semantics::Symbol *symbol = procRef.proc().GetSymbol();

‎flang/lib/Lower/HlfirIntrinsics.cpp‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -152,7 +152,7 @@ mlir::Value HlfirTransformationalIntrinsic::loadBoxAddress(
152152
if (!arg)
153153
return mlir::Value{};
154154

155-
hlfir::Entity actual = arg->getOriginalActual();
155+
hlfir::Entity actual = arg->getActual(loc, builder);
156156

157157
if (!arg->handleDynamicOptional()) {
158158
if (actual.isMutableBox()) {
@@ -193,7 +193,7 @@ llvm::SmallVector<mlir::Value> HlfirTransformationalIntrinsic::getOperandVector(
193193
operands.emplace_back();
194194
continue;
195195
}
196-
hlfir::Entity actual = arg->getOriginalActual();
196+
hlfir::Entity actual = arg->getActual(loc, builder);
197197
mlir::Value valArg;
198198

199199
if (!argLowering) {

‎flang/test/Lower/HLFIR/elemental-call-vector-subscripts.f90‎

Lines changed: 93 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,93 @@
1+
! Test passing of vector subscripted entities inside elemental
2+
! procedures.
3+
! RUN: bbc --emit-hlfir -o - %s | FileCheck %s
4+
5+
subroutine test()
6+
interface
7+
elemental subroutine foo(x, y)
8+
real, intent(in) :: x
9+
real, value :: y
10+
end subroutine
11+
end interface
12+
real :: x(10)
13+
call foo(x([1,3,7]), 0.)
14+
end subroutine
15+
! CHECK-LABEL: func.func @_QPtest() {
16+
! CHECK: %[[VAL_0:.*]] = arith.constant 10 : index
17+
! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.array<10xf32> {bindc_name = "x", uniq_name = "_QFtestEx"}
18+
! CHECK: %[[VAL_2:.*]] = fir.shape %[[VAL_0]] : (index) -> !fir.shape<1>
19+
! 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>>)
20+
! CHECK: %[[VAL_4:.*]] = fir.address_of(@_QQro.3xi8.0) : !fir.ref<!fir.array<3xi64>>
21+
! CHECK: %[[VAL_5:.*]] = arith.constant 3 : index
22+
! CHECK: %[[VAL_6:.*]] = fir.shape %[[VAL_5]] : (index) -> !fir.shape<1>
23+
! CHECK: %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_4]](%[[VAL_6]])
24+
! CHECK: %[[VAL_8:.*]] = arith.constant 3 : index
25+
! CHECK: %[[VAL_9:.*]] = arith.constant 0.000000e+00 : f32
26+
! CHECK: %[[VAL_10:.*]] = arith.constant 1 : index
27+
! CHECK: fir.do_loop %[[VAL_11:.*]] = %[[VAL_10]] to %[[VAL_8]] step %[[VAL_10]] unordered {
28+
! CHECK: %[[VAL_12:.*]] = hlfir.designate %[[VAL_7]]#0 (%[[VAL_11]]) : (!fir.ref<!fir.array<3xi64>>, index) -> !fir.ref<i64>
29+
! CHECK: %[[VAL_13:.*]] = fir.load %[[VAL_12]] : !fir.ref<i64>
30+
! CHECK: %[[VAL_14:.*]] = hlfir.designate %[[VAL_3]]#0 (%[[VAL_13]]) : (!fir.ref<!fir.array<10xf32>>, i64) -> !fir.ref<f32>
31+
! CHECK: fir.call @_QPfoo(%[[VAL_14]], %[[VAL_9]]) {{.*}}: (!fir.ref<f32>, f32) -> ()
32+
! CHECK: }
33+
! CHECK: return
34+
! CHECK: }
35+
36+
subroutine test_value()
37+
interface
38+
elemental subroutine foo_value(x, y)
39+
real, value :: x
40+
real, value :: y
41+
end subroutine
42+
end interface
43+
real :: x(10)
44+
call foo_value(x([1,3,7]), 0.)
45+
end subroutine
46+
47+
! CHECK-LABEL: func.func @_QPtest_value() {
48+
! CHECK: %[[VAL_0:.*]] = arith.constant 10 : index
49+
! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.array<10xf32> {bindc_name = "x", uniq_name = "_QFtest_valueEx"}
50+
! CHECK: %[[VAL_2:.*]] = fir.shape %[[VAL_0]] : (index) -> !fir.shape<1>
51+
! 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>>)
52+
! CHECK: %[[VAL_4:.*]] = fir.address_of(@_QQro.3xi8.0) : !fir.ref<!fir.array<3xi64>>
53+
! CHECK: %[[VAL_5:.*]] = arith.constant 3 : index
54+
! CHECK: %[[VAL_6:.*]] = fir.shape %[[VAL_5]] : (index) -> !fir.shape<1>
55+
! CHECK: %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_4]](%[[VAL_6]])
56+
! CHECK: %[[VAL_8:.*]] = arith.constant 3 : index
57+
! CHECK: %[[VAL_9:.*]] = fir.shape %[[VAL_8]] : (index) -> !fir.shape<1>
58+
! CHECK: %[[VAL_10:.*]] = hlfir.elemental %[[VAL_9]] unordered : (!fir.shape<1>) -> !hlfir.expr<3xf32> {
59+
! CHECK: ^bb0(%[[VAL_11:.*]]: index):
60+
! CHECK: %[[VAL_12:.*]] = hlfir.designate %[[VAL_7]]#0 (%[[VAL_11]]) : (!fir.ref<!fir.array<3xi64>>, index) -> !fir.ref<i64>
61+
! CHECK: %[[VAL_13:.*]] = fir.load %[[VAL_12]] : !fir.ref<i64>
62+
! CHECK: %[[VAL_14:.*]] = hlfir.designate %[[VAL_3]]#0 (%[[VAL_13]]) : (!fir.ref<!fir.array<10xf32>>, i64) -> !fir.ref<f32>
63+
! CHECK: %[[VAL_15:.*]] = fir.load %[[VAL_14]] : !fir.ref<f32>
64+
! CHECK: hlfir.yield_element %[[VAL_15]] : f32
65+
! CHECK: }
66+
! CHECK: %[[VAL_16:.*]] = arith.constant 0.000000e+00 : f32
67+
! CHECK: %[[VAL_17:.*]] = arith.constant 1 : index
68+
! CHECK: fir.do_loop %[[VAL_18:.*]] = %[[VAL_17]] to %[[VAL_8]] step %[[VAL_17]] unordered {
69+
! CHECK: %[[VAL_19:.*]] = hlfir.apply %[[VAL_10]], %[[VAL_18]] : (!hlfir.expr<3xf32>, index) -> f32
70+
! CHECK: fir.call @_QPfoo_value(%[[VAL_19]], %[[VAL_16]]) {{.*}}: (f32, f32) -> ()
71+
! CHECK: }
72+
! CHECK: hlfir.destroy %[[VAL_10]] : !hlfir.expr<3xf32>
73+
! CHECK: return
74+
75+
subroutine test_not_a_variable(i)
76+
interface
77+
elemental subroutine foo2(j)
78+
integer(8), intent(in) :: j
79+
end subroutine
80+
end interface
81+
integer(8) :: i(:)
82+
call foo2((i(i)))
83+
end subroutine
84+
! CHECK-LABEL: func.func @_QPtest_not_a_variable(
85+
! CHECK: hlfir.elemental
86+
! CHECK: %[[VAL_16:.*]] = hlfir.elemental
87+
! CHECK: %[[VAL_20:.*]] = arith.constant 1 : index
88+
! CHECK: fir.do_loop %[[VAL_21:.*]] = {{.*}}
89+
! CHECK: %[[VAL_22:.*]] = hlfir.apply %[[VAL_16]], %[[VAL_21]] : (!hlfir.expr<?xi64>, index) -> i64
90+
! CHECK: %[[VAL_23:.*]]:3 = hlfir.associate %[[VAL_22]] {uniq_name = "adapt.valuebyref"} : (i64) -> (!fir.ref<i64>, !fir.ref<i64>, i1)
91+
! CHECK: fir.call @_QPfoo2(%[[VAL_23]]#1){{.*}}: (!fir.ref<i64>) -> ()
92+
! CHECK: hlfir.end_associate %[[VAL_23]]#1, %[[VAL_23]]#2 : !fir.ref<i64>, i1
93+
! CHECK: }

0 commit comments

Comments
 (0)