[flang] Fix the interface for numerical/logical scalar with VALUE attribute

[peixin]

Summary

Programmers may use procedure without BIND(C) attribute to interoperate
with C code. For numerical/logical scalar with VALUE attribute, pass the
argument by value so that the behavior is consistent with gfortran or
nvfortran. The argument with the OPTIONAL attribute cannot be passed by
value since the actual argument may be absent.

For the derived type, pass-by-value is not supported yet, so pass the
argument by reference for now.

[jeanPerier]

Could you elaborate a bit more on why you are choosing to still pass VALUE argument of elemental procedures by reference copy ?

I understand why optionality is needs to be passed by reference copy to encode the presence/absence of the value. But I do not get what is preventing elemental function VALUE arguments to be passed by value.

[peixin]

In D136260#3870493, @jeanPerier wrote:

Could you elaborate a bit more on why you are choosing to still pass VALUE argument of elemental procedures by reference copy ?

I understand why optionality is needs to be passed by reference copy to encode the presence/absence of the value. But I do not get what is preventing elemental function VALUE arguments to be passed by value.

The ELEMENTAL conflicts with BIND(C) attribute. In semantics, the intention of elemental procedure is not to be called by C code. But the truth is that gfortran and classic-flang do support pass-by-value for elemental procedure. Do you think we should support it in flang-new, too?

[peixin]

BTW, for optional argument with VALUE attribute, gfortran still supports pass-by-value. But classic-flang pass the argument by reference. But I think for optional arugment should be passed by reference since it can be absent.

[jeanPerier]

In D136260#3870646, @peixin wrote:

In D136260#3870493, @jeanPerier wrote:

Could you elaborate a bit more on why you are choosing to still pass VALUE argument of elemental procedures by reference copy ?

I understand why optionality is needs to be passed by reference copy to encode the presence/absence of the value. But I do not get what is preventing elemental function VALUE arguments to be passed by value.

The ELEMENTAL conflicts with BIND(C) attribute. In semantics, the intention of elemental procedure is not to be called by C code. But the truth is that gfortran and classic-flang do support pass-by-value for elemental procedure. Do you think we should support it in flang-new, too?

I think we should be consistent as much as possible. If we start to pass non optional VALUE logical and numeric scalar by value for non bind(c) procedure, it seems to me we should also do it for elemental procedures.

In D136260#3870647, @peixin wrote:

BTW, for optional argument with VALUE attribute, gfortran still supports pass-by-value. But classic-flang pass the argument by reference. But I think for optional arugment should be passed by reference since it can be absent.

Interesting. It may encode the presence/absence in an extra argument then. I would stay away from this for the sake of simplicity.

[peixin]

Address the comments.

[peixin]

In D136260#3870647, @peixin wrote:

BTW, for optional argument with VALUE attribute, gfortran still supports pass-by-value. But classic-flang pass the argument by reference. But I think for optional arugment should be passed by reference since it can be absent.

Interesting. It may encode the presence/absence in an extra argument then. I would stay away from this for the sake of simplicity.

Agree.

[jeanPerier]

Thanks a lot @peixin, looks good

flang/lib/Lower/CallInterface.cpp

if (obj.attrs.test(Attrs::Allocatable) || obj.attrs.test(Attrs::Pointer)) {
       mlir::Type boxCharTy =
           fir::BoxCharType::get(&mlirContext, dynamicType.kind());
       addFirOperand(boxCharTy, nextPassedArgPosition(), Property::BoxChar,
                     attrs);
       addPassedArg(isValueAttr ? PassEntityBy::CharBoxValueAttribute
                                : PassEntityBy::BoxChar,
                    entity, characteristics);
     } else {
-      // Pass as fir.ref unless it's by VALUE and BIND(C)
+      // Pass as fir.ref unless it's by VALUE and BIND(C). Also pass-by-value
+      // for numerical/logical scalar without OPTIONAL so that the behavior is
+      // consistent with gfortran/nvfortran.
+      // TODO: pass-by-value for derived type is not supported yet
       mlir::Type passType = fir::ReferenceType::get(type);
       PassEntityBy passBy = PassEntityBy::BaseAddress;
       Property prop = Property::BaseAddress;
       if (isValueAttr) {
-        if (isBindC) {
+        if (isBindC || (!type.isa<fir::SequenceType>() &&
+                        !obj.attrs.test(Attrs::Optional) &&
+                        dynamicType.category() !=
+                            Fortran::common::TypeCategory::Derived)) {
           passBy = PassEntityBy::Value;
           prop = Property::Value;
           if (type.isa<fir::SequenceType>())
             fir::emitFatalError(
                 loc, "array with VALUE attribute is not interoperable");
           if (fir::isa_builtin_cptr_type(type)) {
             auto recTy = type.dyn_cast<fir::RecordType>();
             mlir::Type fieldTy = recTy.getTypeList()[0].second;

flang/test/Lower/array-elemental-calls-2.f90

 ! CHECK:  %[[VAL_28:.*]] = fir.convert %[[VAL_27]] : (i1) -> !fir.logical<4>
 ! CHECK:  fir.store %[[VAL_28]] to %[[VAL_0]] : !fir.ref<!fir.logical<4>>
 ! CHECK:  fir.call @_QPelem_func_logical4(%[[VAL_0]]) : (!fir.ref<!fir.logical<4>>) -> i32
 end subroutine
 
 ! CHECK-LABEL: func @_QMtest_opsPcheck_pow() {
 subroutine check_pow()
   print *,  elem_func_real(x**y)
-! CHECK:  %[[VAL_0:.*]] = fir.alloca f64
 ! CHECK:  fir.do_loop
 ! CHECK:  %[[VAL_25:.*]] = fir.array_fetch %{{.*}}, %{{.*}} : (!fir.array<10xf64>, index) -> f64
 ! CHECK:  %[[VAL_26:.*]] = fir.array_fetch %{{.*}}, %{{.*}} : (!fir.array<10xf64>, index) -> f64
 ! CHECK:  %[[VAL_27:.*]] = math.powf %[[VAL_25]], %[[VAL_26]] : f64
-! CHECK:  fir.store %[[VAL_27]] to %[[VAL_0]] : !fir.ref<f64>
-! CHECK:  %[[VAL_28:.*]] = fir.call @_QPelem_func_real(%[[VAL_0]]) : (!fir.ref<f64>) -> i32
+! CHECK:  %[[VAL_28:.*]] = fir.call @_QPelem_func_real(%[[VAL_27]]) : (f64) -> i32
 end subroutine
 
 ! CHECK-LABEL: func @_QMtest_opsPcheck_cmplx_part() {
 subroutine check_cmplx_part()
   print *,  elem_func_real(AIMAG(z1 + z2))
-! CHECK:  %[[VAL_0:.*]] = fir.alloca f64
 ! CHECK:  %[[VAL_13:.*]] = fir.load %{{.*}} : !fir.ref<!fir.complex<8>>
 ! CHECK:  fir.do_loop
 ! CHECK:  %[[VAL_23:.*]] = fir.array_fetch %{{.*}}, %{{.*}} : (!fir.array<10x!fir.complex<8>>, index) -> !fir.complex<8>
 ! CHECK:  %[[VAL_24:.*]] = fir.addc %[[VAL_23]], %[[VAL_13]] : !fir.complex<8>
 ! CHECK:  %[[VAL_25:.*]] = fir.extract_value %[[VAL_24]], [1 : index] : (!fir.complex<8>) -> f64
-! CHECK:  fir.store %[[VAL_25]] to %[[VAL_0]] : !fir.ref<f64>
-! CHECK:  fir.call @_QPelem_func_real(%[[VAL_0]]) : (!fir.ref<f64>) -> i32
+! CHECK:  fir.call @_QPelem_func_real(%[[VAL_25]]) : (f64) -> i32
 end subroutine
 
 ! CHECK-LABEL: func @_QMtest_opsPcheck_parentheses() {
 subroutine check_parentheses()
   print *,  elem_func_real((x))
-! CHECK:  %[[VAL_0:.*]] = fir.alloca f64
 ! CHECK:  fir.do_loop
 ! CHECK:  %[[VAL_21:.*]] = fir.array_fetch %{{.*}}, %{{.*}} : (!fir.array<10xf64>, index) -> f64
 ! CHECK:  %[[VAL_22:.*]] = fir.no_reassoc %[[VAL_21]] : f64
-! CHECK:  fir.store %[[VAL_22]] to %[[VAL_0]] : !fir.ref<f64>
-! CHECK:  fir.call @_QPelem_func_real(%[[VAL_0]]) : (!fir.ref<f64>) -> i32
+! CHECK:  fir.call @_QPelem_func_real(%[[VAL_22]]) : (f64) -> i32
 end subroutine
 
 ! CHECK-LABEL: func @_QMtest_opsPcheck_parentheses_logical() {
 subroutine check_parentheses_logical()
   print *,  elem_func_logical((a))
 ! CHECK:  %[[VAL_0:.*]] = fir.alloca !fir.logical<8>
 ! CHECK:  fir.do_loop
 ! CHECK:  %[[VAL_21:.*]] = fir.array_fetch %{{.*}}, %{{.*}} : (!fir.array<10x!fir.logical<8>>, index) -> !fir.logical<8>

flang/test/Lower/array-elemental-calls.f90

! CHECK: fir.do_loop
     ! CHECK: fir.result
   i = elem_by_ref(j, 42.)
 end
 
 ! CHECK-LABEL: func @_QMscalar_in_elemPtest_elem_by_valueref(
 ! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.array<100xi32>>{{.*}}, %[[arg1:.*]]: !fir.ref<!fir.array<100xi32>>{{.*}}) {
 subroutine test_elem_by_valueref(i, j)
   integer :: i(100), j(100)
-  ! CHECK-DAG: %[[tmpA:.*]] = fir.alloca i32 {adapt.valuebyref}
-  ! CHECK-DAG: %[[tmpB:.*]] = fir.alloca f32 {adapt.valuebyref}
   ! CHECK: %[[jload:.*]] = fir.array_load %[[arg1]]
   ! CHECK: %[[cst:.*]] = arith.constant 4.200000e+01 : f32
-  ! CHECK: fir.store %[[cst]] to %[[tmpB]] : !fir.ref<f32>
 
   ! CHECK: fir.do_loop
     ! CHECK: %[[j:.*]] = fir.array_fetch %[[jload]], %{{.*}} : (!fir.array<100xi32>, index) -> i32
-    ! CHECK: fir.store %[[j]] to %[[tmpA]] : !fir.ref<i32>
-    ! CHECK: fir.call @_QMscalar_in_elemPelem_by_valueref(%[[tmpA]], %[[tmpB]]) : (!fir.ref<i32>, !fir.ref<f32>) -> i32
+    ! CHECK: fir.call @_QMscalar_in_elemPelem_by_valueref(%[[j]], %[[cst]]) : (i32, f32) -> i32
     ! CHECK: fir.result
   i = elem_by_valueref(j, 42.)
 end
 end module
 
 
 ! Test that impure elemental functions cause ordered loops to be emitted
 subroutine test_loop_order(i, j)

flang/test/Lower/array-elemental-subroutines.f90

 ! Test lowering of elemental subroutine calls with array arguments
 ! RUN: bbc -o - -emit-fir %s | FileCheck %s
 
 ! CHECK-LABEL: func @_QPtest_elem_sub(
 ! CHECK-SAME:    %[[VAL_0:.*]]: !fir.box<!fir.array<?xf32>>{{.*}}, %[[VAL_1:.*]]: !fir.box<!fir.array<?x!fir.char<1,?>>>{{.*}}, %[[VAL_2:.*]]: !fir.ref<i32>{{.*}}, %[[VAL_3:.*]]: !fir.ref<!fir.complex<4>>{{.*}}) {
-! CHECK:         %[[VAL_4:.*]] = fir.alloca !fir.complex<4> {adapt.valuebyref}
 ! CHECK:         %[[VAL_5:.*]] = arith.constant 0 : index
 ! CHECK:         %[[VAL_6:.*]]:3 = fir.box_dims %[[VAL_0]], %[[VAL_5]] : (!fir.box<!fir.array<?xf32>>, index) -> (index, index, index)
 ! CHECK:         %[[VAL_7:.*]] = arith.constant 10 : i64
 ! CHECK:         %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (i64) -> index
 ! CHECK:         %[[VAL_9:.*]] = arith.constant -1 : i64
 ! CHECK:         %[[VAL_10:.*]] = fir.convert %[[VAL_9]] : (i64) -> index
 ! CHECK:         %[[VAL_11:.*]] = arith.constant 1 : i64
 ! CHECK:         %[[VAL_12:.*]] = fir.convert %[[VAL_11]] : (i64) -> index
 ! CHECK:         %[[VAL_13:.*]] = fir.slice %[[VAL_8]], %[[VAL_12]], %[[VAL_10]] : (index, index, index) -> !fir.slice<1>
 ! CHECK:         %[[VAL_14:.*]] = fir.load %[[VAL_3]] : !fir.ref<!fir.complex<4>>
-! CHECK:         fir.store %[[VAL_14]] to %[[VAL_4]] : !fir.ref<!fir.complex<4>>
 ! CHECK:         %[[VAL_15:.*]] = arith.constant 1 : index
 ! CHECK:         %[[VAL_16:.*]] = arith.constant 0 : index
 ! CHECK:         %[[VAL_17:.*]] = arith.subi %[[VAL_6]]#1, %[[VAL_15]] : index
 ! CHECK:         fir.do_loop %[[VAL_18:.*]] = %[[VAL_16]] to %[[VAL_17]] step %[[VAL_15]] {
 ! CHECK:           %[[VAL_19:.*]] = arith.constant 1 : index
 ! CHECK:           %[[VAL_20:.*]] = arith.addi %[[VAL_18]], %[[VAL_19]] : index
 ! CHECK:           %[[VAL_21:.*]] = fir.array_coor %[[VAL_0]] %[[VAL_20]] : (!fir.box<!fir.array<?xf32>>, index) -> !fir.ref<f32>
 ! CHECK:           %[[VAL_22:.*]] = arith.constant 1 : index
 ! CHECK:           %[[VAL_23:.*]] = arith.addi %[[VAL_18]], %[[VAL_22]] : index
 ! CHECK:           %[[VAL_24:.*]] = fir.array_coor %[[VAL_1]] {{\[}}%[[VAL_13]]] %[[VAL_23]] : (!fir.box<!fir.array<?x!fir.char<1,?>>>, !fir.slice<1>, index) -> !fir.ref<!fir.char<1,?>>
 ! CHECK:           %[[VAL_25:.*]] = fir.box_elesize %[[VAL_1]] : (!fir.box<!fir.array<?x!fir.char<1,?>>>) -> index
 ! CHECK:           %[[VAL_26:.*]] = fir.emboxchar %[[VAL_24]], %[[VAL_25]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
-! CHECK:           fir.call @_QPfoo(%[[VAL_21]], %[[VAL_26]], %[[VAL_2]], %[[VAL_4]]) : (!fir.ref<f32>, !fir.boxchar<1>, !fir.ref<i32>, !fir.ref<!fir.complex<4>>) -> ()
+! CHECK:           fir.call @_QPfoo(%[[VAL_21]], %[[VAL_26]], %[[VAL_2]], %[[VAL_14]]) : (!fir.ref<f32>, !fir.boxchar<1>, !fir.ref<i32>, !fir.complex<4>) -> ()
 ! CHECK:         }
 ! CHECK:         return
 ! CHECK:       }
 
 subroutine test_elem_sub(x, c, i, z)
   real :: x(:)
   character(*) :: c(:)
   integer :: i

flang/test/Lower/array-expression.f90

subroutine test15(a,b)
   ! CHECK: fir.array_merge_store %[[barr]], %[[loop]] to %[[b]]
   b = abs(a)
 end subroutine test15
 
 ! Test elemental call to function f2 with VALUE attribute
 ! CHECK-LABEL: func @_QPtest16(
 ! CHECK-SAME: %[[a:.*]]: !fir.ref<!fir.array<100xf32>>{{.*}}, %[[b:.*]]: !fir.ref<!fir.array<100xf32>>{{.*}})
 subroutine test16(a,b)
-  ! CHECK: %[[tmp:.*]] = fir.alloca f32 {adapt.valuebyref
   ! CHECK-DAG: %[[aarr:.*]] = fir.array_load %[[a]](%{{.*}}) : (!fir.ref<!fir.array<100xf32>>, !fir.shape<1>) -> !fir.array<100xf32>
   ! CHECK-DAG: %[[barr:.*]] = fir.array_load %[[b]](%{{.*}}) : (!fir.ref<!fir.array<100xf32>>, !fir.shape<1>) -> !fir.array<100xf32>
   interface
      real elemental function f2(i)
        real, VALUE :: i
      end function f2
   end interface
   real :: a(100), b(100)
   ! CHECK: %[[loop:.*]] = fir.do_loop %[[i:.*]] = %{{.*}} to %{{.*}} step %{{.*}} iter_args(%[[bth:.*]] = %[[barr]]) -> (!fir.array<100xf32>) {
   ! CHECK: %[[val:.*]] = fir.array_fetch %[[aarr]], %[[i]] : (!fir.array<100xf32>, index) -> f32
-  ! CHECK: fir.store %[[val]] to %[[tmp]]
-  ! CHECK: %[[fres:.*]] = fir.call @_QPf2(%[[tmp]]) : (!fir.ref<f32>) -> f32
+  ! CHECK: %[[fres:.*]] = fir.call @_QPf2(%[[val]]) : (f32) -> f32
   ! CHECK: %[[res:.*]] = fir.array_update %[[bth]], %[[fres]], %[[i]] : (!fir.array<100xf32>, f32, index) -> !fir.array<100xf32>
   ! CHECK: fir.result %[[res]] : !fir.array<100xf32>
   ! CHECK: fir.array_merge_store %[[barr]], %[[loop]] to %[[b]]
   b = f2(a)
 end subroutine test16
 
 ! Test elemental impure call to function f3.
 !

flang/test/Lower/call-by-value-attr.f90

program call_by_value_attr
   end interface
 
 !CHECK-LABEL: func @_QQmain()
   integer :: v
   integer, dimension(10) :: a
   integer, dimension(15) :: b
   v = 17
   call subri(v)
-  !CHECK: %[[COPY:.*]] = fir.alloca i32
   !CHECK: %[[ARRAY_A:.*]] = fir.address_of(@_QFEa)
   !CHECK: %[[CONST_10_1:.*]] = arith.constant 10 : index
   !CHECK: %[[ARRAY_B:.*]] = fir.address_of(@_QFEb)
   !CHECK: %[[CONST_15_1:.*]] = arith.constant 15 : index
   !CHECK: %[[VALUE:.*]] = fir.alloca i32 {bindc_name = "v", {{.*}}}
   !CHECK: %[[CONST:.*]] = arith.constant 17
   !CHECK: fir.store %[[CONST]] to %[[VALUE]]
   !CHECK: %[[LOAD:.*]] = fir.load %[[VALUE]]
-  !CHECK: fir.store %[[LOAD]] to %[[COPY]]
-  !CHECK: fir.call @_QPsubri(%[[COPY]]) : {{.*}}
+  !CHECK: fir.call @_QPsubri(%[[LOAD]]) : {{.*}}
   a = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 /)
   !CHECK: %[[SHAPE_1:.*]] = fir.shape %[[CONST_10_1]]
   !CHECK: %[[ARRAY_LOAD_1:.*]] = fir.array_load %[[ARRAY_A]](%[[SHAPE_1]]) : {{.*}}
   !CHECK: %[[ARRAY_INIT_A:.*]] = fir.address_of({{.*}})
   !CHECK: %[[CONST_10_2:.*]] = arith.constant 10 : index
   !CHECK: %[[SHAPE_2:.*]] = fir.shape %[[CONST_10_2]]
   !CHECK: %[[ARRAY_LOAD_2:.*]] = fir.array_load %[[ARRAY_INIT_A]](%[[SHAPE_2]]) : {{.*}}
   !CHECK: %[[DO_1:.*]] = fir.do_loop {{.*}} {
!CHECK-LABEL: func @_QQmain()
   !CHECK: }
   !CHECK: fir.array_merge_store %[[ARRAY_LOAD_7]], %[[DO_4]] to %[[ARRAY_COPY_2]] : !fir.array<11xi32>, !fir.array<11xi32>, !fir.heap<!fir.array<11xi32>>
   !CHECK: fir.result %[[ARRAY_COPY_2]] : !fir.heap<!fir.array<11xi32>>
   !CHECK: %[[CONVERT_B:.*]] = fir.convert %[[ADDR]] : (!fir.heap<!fir.array<11xi32>>) -> !fir.ref<!fir.array<10xi32>>
   !CHECK: fir.call @_QPsubra(%[[CONVERT_B]])
   call subra(b(5:15))
 end program call_by_value_attr
 
+! CHECK-LABEL: func.func @_QPsubri(
+! CHECK-SAME:                      %[[VAL_0:.*]]: i32 {fir.bindc_name = "val"}) {
+! CHECK:         %[[VAL_1:.*]] = fir.alloca i32
+! CHECK:         fir.store %[[VAL_0]] to %[[VAL_1]] : !fir.ref<i32>
+! CHECK:         fir.call @_QPtest_numeric_scalar_value(%[[VAL_1]]) : (!fir.ref<i32>) -> ()
+! CHECK:         return
+! CHECK:       }
+
+subroutine subri(val)
+  integer, value :: val
+  call test_numeric_scalar_value(val)
+end subroutine subri
 
 ! CHECK-LABEL: func @_QPtest_litteral_copies_1
 subroutine test_litteral_copies_1
   ! VALUE arguments  can be modified by the callee, so the static storage of
   ! literal constants and named parameters must not be passed directly to them.
   interface
     subroutine takes_array_value(v)
       integer, value :: v(4)