[flang-commits] [flang] 81ea91a - [flang][hlfir] Return function call result as AsExpr. (#67769)
via flang-commits
flang-commits at lists.llvm.org
Mon Oct 2 07:46:13 PDT 2023
Author: Slava Zakharin
Date: 2023-10-02T07:46:09-07:00
New Revision: 81ea91a9b4983738bcea5e7a77677c0f84b9f9d6
URL: https://github.com/llvm/llvm-project/commit/81ea91a9b4983738bcea5e7a77677c0f84b9f9d6
DIFF: https://github.com/llvm/llvm-project/commit/81ea91a9b4983738bcea5e7a77677c0f84b9f9d6.diff
LOG: [flang][hlfir] Return function call result as AsExpr. (#67769)
This should help inlining elemental into another elemental, and also
will help to get rid of unnecessary deep copies in bufferization.
Added:
flang/test/Lower/HLFIR/function-return-as-expr.f90
Modified:
flang/lib/Lower/ConvertCall.cpp
flang/test/Lower/HLFIR/elemental-array-ops.f90
flang/test/Lower/HLFIR/where.f90
flang/test/Lower/Intrinsics/storage_size-2.f90
Removed:
################################################################################
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index 0510965a596fb05..f703e0310b6fb84 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -1232,8 +1232,25 @@ genUserCall(Fortran::lower::PreparedActualArguments &loweredActuals,
if (!fir::getBase(result))
return std::nullopt; // subroutine call.
- // TODO: "move" non pointer results into hlfir.expr.
- return extendedValueToHlfirEntity(loc, builder, result, ".tmp.func_result");
+
+ hlfir::Entity resultEntity =
+ extendedValueToHlfirEntity(loc, builder, result, ".tmp.func_result");
+
+ if (!fir::isPointerType(fir::getBase(result).getType())) {
+ resultEntity = loadTrivialScalar(loc, builder, resultEntity);
+
+ if (resultEntity.isVariable()) {
+ // Function result must not be freed, since it is allocated on the stack.
+ // Note that in non-elemental case, genCallOpAndResult()
+ // is responsible for establishing the clean-up that destroys
+ // the derived type result or deallocates its components
+ // without finalization.
+ auto asExpr = builder.create<hlfir::AsExprOp>(
+ loc, resultEntity, /*mustFree=*/builder.createBool(loc, false));
+ resultEntity = hlfir::EntityWithAttributes{asExpr.getResult()};
+ }
+ }
+ return hlfir::EntityWithAttributes{resultEntity};
}
/// Create an optional dummy argument value from an entity that may be
diff --git a/flang/test/Lower/HLFIR/elemental-array-ops.f90 b/flang/test/Lower/HLFIR/elemental-array-ops.f90
index 582912305c0068b..96cda16cad2e6ae 100644
--- a/flang/test/Lower/HLFIR/elemental-array-ops.f90
+++ b/flang/test/Lower/HLFIR/elemental-array-ops.f90
@@ -185,8 +185,10 @@ end subroutine char_return
! CHECK: %[[VAL_26:.*]] = fir.call @llvm.stacksave.p0() fastmath<contract> : () -> !fir.ref<i8>
! CHECK: %[[VAL_27:.*]] = fir.call @_QPcallee(%[[VAL_2]], %[[VAL_25]], %[[VAL_20]]) fastmath<contract> : (!fir.ref<!fir.char<1,3>>, index, !fir.boxchar<1>) -> !fir.boxchar<1>
! CHECK: %[[VAL_28:.*]]:2 = hlfir.declare %[[VAL_2]] typeparams %[[VAL_25]] {uniq_name = ".tmp.func_result"} : (!fir.ref<!fir.char<1,3>>, index) -> (!fir.ref<!fir.char<1,3>>, !fir.ref<!fir.char<1,3>>)
+! CHECK: %[[MustFree:.*]] = arith.constant false
+! CHECK: %[[ResultTemp:.*]] = hlfir.as_expr %[[VAL_28]]#0 move %[[MustFree]] : (!fir.ref<!fir.char<1,3>>, i1) -> !hlfir.expr<!fir.char<1,3>>
! CHECK: fir.call @llvm.stackrestore.p0(%[[VAL_26]]) fastmath<contract> : (!fir.ref<i8>) -> ()
-! CHECK: hlfir.yield_element %[[VAL_28]]#0 : !fir.ref<!fir.char<1,3>>
+! CHECK: hlfir.yield_element %[[ResultTemp]] : !hlfir.expr<!fir.char<1,3>>
! CHECK: }
! CHECK: %[[VAL_29:.*]] = arith.constant 0 : index
! CHECK: %[[VAL_30:.*]]:3 = fir.box_dims %[[VAL_10]]#0, %[[VAL_29]] : (!fir.box<!fir.array<?x!fir.char<1,3>>>, index) -> (index, index, index)
diff --git a/flang/test/Lower/HLFIR/function-return-as-expr.f90 b/flang/test/Lower/HLFIR/function-return-as-expr.f90
new file mode 100644
index 000000000000000..7c8e73779d79e9a
--- /dev/null
+++ b/flang/test/Lower/HLFIR/function-return-as-expr.f90
@@ -0,0 +1,135 @@
+! RUN: bbc -emit-hlfir --polymorphic-type -o - %s -I nowhere 2>&1 | FileCheck %s
+
+module types
+ type t1
+ end type t1
+end module types
+
+subroutine test1
+ integer :: i
+ i = inner() + 1
+contains
+ function inner()
+ integer, allocatable :: inner
+ end function inner
+end subroutine test1
+! CHECK-LABEL: func.func @_QPtest1() {
+! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.box<!fir.heap<i32>> {bindc_name = ".result"}
+! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = ".tmp.func_result"} : (!fir.ref<!fir.box<!fir.heap<i32>>>) -> (!fir.ref<!fir.box<!fir.heap<i32>>>, !fir.ref<!fir.box<!fir.heap<i32>>>)
+! CHECK: %[[VAL_5:.*]] = fir.load %[[VAL_4]]#0 : !fir.ref<!fir.box<!fir.heap<i32>>>
+! CHECK: %[[VAL_6:.*]] = fir.box_addr %[[VAL_5]] : (!fir.box<!fir.heap<i32>>) -> !fir.heap<i32>
+! CHECK: %[[VAL_7:.*]] = fir.load %[[VAL_6]] : !fir.heap<i32>
+! CHECK: %[[VAL_8:.*]] = arith.constant 1 : i32
+! CHECK: %[[VAL_9:.*]] = arith.addi %[[VAL_7]], %[[VAL_8]] : i32
+
+subroutine test2
+ character(len=:), allocatable :: c
+ c = inner()
+contains
+ function inner()
+ character(len=:), allocatable :: inner
+ end function inner
+end subroutine test2
+! CHECK-LABEL: func.func @_QPtest2() {
+! CHECK: %[[VAL_7:.*]]:2 = hlfir.declare %{{.*}} {uniq_name = ".tmp.func_result"} : (!fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>) -> (!fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>, !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>)
+! CHECK: %[[VAL_8:.*]] = fir.load %[[VAL_7]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>
+! CHECK: %[[VAL_9:.*]] = fir.box_addr %[[VAL_8]] : (!fir.box<!fir.heap<!fir.char<1,?>>>) -> !fir.heap<!fir.char<1,?>>
+! CHECK: %[[VAL_10:.*]] = fir.load %[[VAL_7]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>
+! CHECK: %[[VAL_11:.*]] = fir.box_elesize %[[VAL_10]] : (!fir.box<!fir.heap<!fir.char<1,?>>>) -> index
+! CHECK: %[[VAL_12:.*]] = fir.emboxchar %[[VAL_9]], %[[VAL_11]] : (!fir.heap<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+! CHECK: %[[VAL_13:.*]] = arith.constant false
+! CHECK: %[[VAL_14:.*]] = hlfir.as_expr %[[VAL_12]] move %[[VAL_13]] : (!fir.boxchar<1>, i1) -> !hlfir.expr<!fir.char<1,?>>
+! CHECK: hlfir.assign %[[VAL_14]] to %{{.*}}#0 realloc : !hlfir.expr<!fir.char<1,?>>, !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>
+
+subroutine test3
+ character(len=:), allocatable :: c
+ c = inner()
+contains
+ function inner()
+ character(len=3), allocatable :: inner
+ end function inner
+end subroutine test3
+! CHECK-LABEL: func.func @_QPtest3() {
+! CHECK: %[[VAL_13:.*]]:2 = hlfir.declare %{{.*}} typeparams %{{.*}} {uniq_name = ".tmp.func_result"} : (!fir.ref<!fir.box<!fir.heap<!fir.char<1,3>>>>, index) -> (!fir.ref<!fir.box<!fir.heap<!fir.char<1,3>>>>, !fir.ref<!fir.box<!fir.heap<!fir.char<1,3>>>>)
+! CHECK: %[[VAL_14:.*]] = fir.load %[[VAL_13]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.char<1,3>>>>
+! CHECK: %[[VAL_15:.*]] = fir.box_addr %[[VAL_14]] : (!fir.box<!fir.heap<!fir.char<1,3>>>) -> !fir.heap<!fir.char<1,3>>
+! CHECK: %[[VAL_16:.*]] = arith.constant false
+! CHECK: %[[VAL_17:.*]] = hlfir.as_expr %[[VAL_15]] move %[[VAL_16]] : (!fir.heap<!fir.char<1,3>>, i1) -> !hlfir.expr<!fir.char<1,3>>
+! CHECK: hlfir.assign %[[VAL_17]] to %{{.*}}#0 realloc : !hlfir.expr<!fir.char<1,3>>, !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>
+
+subroutine test4
+ class(*), allocatable :: p
+ p = inner()
+contains
+ function inner()
+ class(*), allocatable :: inner
+ end function inner
+end subroutine test4
+! CHECK-LABEL: func.func @_QPtest4() {
+! CHECK: %[[VAL_6:.*]]:2 = hlfir.declare %{{.*}} {uniq_name = ".tmp.func_result"} : (!fir.ref<!fir.class<!fir.heap<none>>>) -> (!fir.ref<!fir.class<!fir.heap<none>>>, !fir.ref<!fir.class<!fir.heap<none>>>)
+! CHECK: %[[VAL_7:.*]] = fir.load %[[VAL_6]]#0 : !fir.ref<!fir.class<!fir.heap<none>>>
+! CHECK: %[[VAL_8:.*]] = arith.constant false
+! CHECK: %[[VAL_9:.*]] = hlfir.as_expr %[[VAL_7]] move %[[VAL_8]] : (!fir.class<!fir.heap<none>>, i1) -> !hlfir.expr<none?>
+! CHECK: hlfir.assign %[[VAL_9]] to %{{.*}}#0 realloc : !hlfir.expr<none?>, !fir.ref<!fir.class<!fir.heap<none>>>
+
+subroutine test5
+ use types
+ type(t1) :: r
+ r = inner()
+contains
+ function inner()
+ type(t1) :: inner
+ end function inner
+end subroutine test5
+! CHECK-LABEL: func.func @_QPtest5() {
+! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare %{{.*}} {uniq_name = ".tmp.func_result"} : (!fir.ref<!fir.type<_QMtypesTt1>>) -> (!fir.ref<!fir.type<_QMtypesTt1>>, !fir.ref<!fir.type<_QMtypesTt1>>)
+! CHECK: %[[VAL_5:.*]] = arith.constant false
+! CHECK: %[[VAL_6:.*]] = hlfir.as_expr %[[VAL_4]]#0 move %[[VAL_5]] : (!fir.ref<!fir.type<_QMtypesTt1>>, i1) -> !hlfir.expr<!fir.type<_QMtypesTt1>>
+! CHECK: hlfir.assign %[[VAL_6]] to %{{.*}}#0 : !hlfir.expr<!fir.type<_QMtypesTt1>>, !fir.ref<!fir.type<_QMtypesTt1>>
+
+subroutine test6(x)
+ character(len=:), allocatable :: c(:)
+ integer :: x(:)
+ c = inner(x)
+contains
+ elemental function inner(x)
+ integer, intent(in) :: x
+ character(len=3) :: inner
+ end function inner
+end subroutine test6
+! CHECK-LABEL: func.func @_QPtest6(
+! CHECK: %[[VAL_14:.*]] = hlfir.elemental
+! CHECK: %[[VAL_24:.*]]:2 = hlfir.declare %{{.*}} typeparams %{{.*}} {uniq_name = ".tmp.func_result"} : (!fir.ref<!fir.char<1,3>>, index) -> (!fir.ref<!fir.char<1,3>>, !fir.ref<!fir.char<1,3>>)
+! CHECK: %[[VAL_25:.*]] = arith.constant false
+! CHECK: %[[VAL_26:.*]] = hlfir.as_expr %[[VAL_24]]#0 move %[[VAL_25]] : (!fir.ref<!fir.char<1,3>>, i1) -> !hlfir.expr<!fir.char<1,3>>
+! CHECK: hlfir.yield_element %[[VAL_26]] : !hlfir.expr<!fir.char<1,3>>
+
+subroutine test7(x)
+ use types
+ integer :: x(:)
+ class(*), allocatable :: p(:)
+ p = inner(x)
+contains
+ elemental function inner(x)
+ integer, intent(in) :: x
+ type(t1) :: inner
+ end function inner
+end subroutine test7
+! CHECK-LABEL: func.func @_QPtest7(
+! CHECK: %[[VAL_12:.*]] = hlfir.elemental
+! CHECK: %[[VAL_16:.*]]:2 = hlfir.declare %{{.*}} {uniq_name = ".tmp.func_result"} : (!fir.ref<!fir.type<_QMtypesTt1>>) -> (!fir.ref<!fir.type<_QMtypesTt1>>, !fir.ref<!fir.type<_QMtypesTt1>>)
+! CHECK: %[[VAL_17:.*]] = arith.constant false
+! CHECK: %[[VAL_18:.*]] = hlfir.as_expr %[[VAL_16]]#0 move %[[VAL_17]] : (!fir.ref<!fir.type<_QMtypesTt1>>, i1) -> !hlfir.expr<!fir.type<_QMtypesTt1>>
+! CHECK: hlfir.yield_element %[[VAL_18]] : !hlfir.expr<!fir.type<_QMtypesTt1>>
+
+subroutine test8
+ if (associated(inner())) STOP 1
+contains
+ function inner()
+ real, pointer :: inner
+ end function inner
+end subroutine test8
+! CHECK-LABEL: func.func @_QPtest8() {
+! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %{{.*}} {uniq_name = ".tmp.func_result"} : (!fir.ref<!fir.box<!fir.ptr<f32>>>) -> (!fir.ref<!fir.box<!fir.ptr<f32>>>, !fir.ref<!fir.box<!fir.ptr<f32>>>)
+! CHECK: %[[VAL_3:.*]] = fir.load %[[VAL_2]]#1 : !fir.ref<!fir.box<!fir.ptr<f32>>>
+! CHECK: %[[VAL_4:.*]] = fir.box_addr %[[VAL_3]] : (!fir.box<!fir.ptr<f32>>) -> !fir.ptr<f32>
diff --git a/flang/test/Lower/HLFIR/where.f90 b/flang/test/Lower/HLFIR/where.f90
index 0f3efcc0b31ab52..bd4cc64de95094c 100644
--- a/flang/test/Lower/HLFIR/where.f90
+++ b/flang/test/Lower/HLFIR/where.f90
@@ -79,8 +79,10 @@ subroutine where_cleanup()
! CHECK: %[[VAL_6:.*]] = fir.call @_QPreturn_temporary_mask() fastmath<contract> : () -> !fir.box<!fir.heap<!fir.array<?x!fir.logical<4>>>>
! CHECK: fir.save_result %[[VAL_6]] to %[[VAL_1]] : !fir.box<!fir.heap<!fir.array<?x!fir.logical<4>>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.logical<4>>>>>
! CHECK: %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_1]] {uniq_name = ".tmp.func_result"} : (!fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.logical<4>>>>>) -> (!fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.logical<4>>>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.logical<4>>>>>)
-! CHECK: %[[VAL_8:.*]] = fir.load %[[VAL_7]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.logical<4>>>>>
-! CHECK: hlfir.yield %[[VAL_8]] : !fir.box<!fir.heap<!fir.array<?x!fir.logical<4>>>> cleanup {
+! CHECK: %[[deref:.*]] = fir.load %[[VAL_7]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.logical<4>>>>>
+! CHECK: %[[MustFree:.*]] = arith.constant false
+! CHECK: %[[ResTemp:.*]] = hlfir.as_expr %[[deref]] move %[[MustFree]] : (!fir.box<!fir.heap<!fir.array<?x!fir.logical<4>>>>, i1) -> !hlfir.expr<?x!fir.logical<4>>
+! CHECK: hlfir.yield %[[ResTemp]] : !hlfir.expr<?x!fir.logical<4>> cleanup {
! CHECK: fir.freemem
! CHECK: }
! CHECK: } do {
@@ -88,8 +90,10 @@ subroutine where_cleanup()
! CHECK: %[[VAL_14:.*]] = fir.call @_QPreturn_temporary_array() fastmath<contract> : () -> !fir.box<!fir.heap<!fir.array<?xf32>>>
! CHECK: fir.save_result %[[VAL_14]] to %[[VAL_0]] : !fir.box<!fir.heap<!fir.array<?xf32>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
! CHECK: %[[VAL_15:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = ".tmp.func_result"} : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>)
-! CHECK: %[[VAL_16:.*]] = fir.load %[[VAL_15]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
-! CHECK: hlfir.yield %[[VAL_16]] : !fir.box<!fir.heap<!fir.array<?xf32>>> cleanup {
+! CHECK: %[[deref:.*]] = fir.load %[[VAL_15]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
+! CHECK: %[[MustFree:.*]] = arith.constant false
+! CHECK: %[[ResTemp:.*]] = hlfir.as_expr %[[deref]] move %[[MustFree]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>, i1) -> !hlfir.expr<?xf32>
+! CHECK: hlfir.yield %[[ResTemp]] : !hlfir.expr<?xf32> cleanup {
! CHECK: fir.freemem
! CHECK: }
! CHECK: } to {
diff --git a/flang/test/Lower/Intrinsics/storage_size-2.f90 b/flang/test/Lower/Intrinsics/storage_size-2.f90
index e784063c76c350c..1195583dc872732 100644
--- a/flang/test/Lower/Intrinsics/storage_size-2.f90
+++ b/flang/test/Lower/Intrinsics/storage_size-2.f90
@@ -13,7 +13,10 @@ function return_char(l)
print*, storage_size(return_char(n))
! CHECK: %[[val_16:.*]] = fir.call @_QPreturn_char(%[[res_addr:[^,]*]], %[[res_len:[^,]*]], {{.*}})
! CHECK: %[[res:.*]]:2 = hlfir.declare %[[res_addr]] typeparams %[[res_len]]
-! CHECK: %[[val_18:.*]] = fir.embox %[[res]]#1 typeparams %[[res_len]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.box<!fir.char<1,?>>
+! CHECK: %[[false:.*]] = arith.constant false
+! CHECK: %[[expr:.*]] = hlfir.as_expr %[[res]]#0 move %[[false]] : (!fir.boxchar<1>, i1) -> !hlfir.expr<!fir.char<1,?>>
+! CHECK: %[[assoc:.*]]:3 = hlfir.associate %[[expr]] typeparams %[[res_len]] {uniq_name = "adapt.valuebyref"} : (!hlfir.expr<!fir.char<1,?>>, index) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>, i1)
+! CHECK: %[[val_18:.*]] = fir.embox %[[assoc]]#1 typeparams %[[res_len]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.box<!fir.char<1,?>>
! CHECK: %[[val_19:.*]] = fir.box_elesize %[[val_18]] : (!fir.box<!fir.char<1,?>>) -> i32
! CHECK: %[[val_20:.*]] = arith.constant 8 : i32
! CHECK: %[[val_21:.*]] = arith.muli %[[val_19]], %[[val_20]] : i32
More information about the flang-commits
mailing list