[flang-commits] [flang] ad4e1ab - [flang] Pass VALUE CHARACTER arg by register in BIND(C) calls (#87774)
via flang-commits
flang-commits at lists.llvm.org
Fri Apr 12 01:29:06 PDT 2024
Author: jeanPerier
Date: 2024-04-12T10:29:01+02:00
New Revision: ad4e1aba3fd12f81de71ce3985ae66ff80773d90
URL: https://github.com/llvm/llvm-project/commit/ad4e1aba3fd12f81de71ce3985ae66ff80773d90
DIFF: https://github.com/llvm/llvm-project/commit/ad4e1aba3fd12f81de71ce3985ae66ff80773d90.diff
LOG: [flang] Pass VALUE CHARACTER arg by register in BIND(C) calls (#87774)
Fortran mandates "CHARACTER(1), VALUE" be passed as a C "char" in calls
to BIND(C) procedures (F'2023 18.3.7 (4)). Lowering passed them by
memory instead. Update call interface lowering code to pass them by
register. Fix related test and update it to use HLFIR.
Added:
Modified:
flang/lib/Lower/CallInterface.cpp
flang/lib/Lower/ConvertCall.cpp
flang/lib/Lower/ConvertVariable.cpp
flang/test/Lower/call-by-value.f90
Removed:
################################################################################
diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp
index 29cdb3cff589ba..05a0c10c709749 100644
--- a/flang/lib/Lower/CallInterface.cpp
+++ b/flang/lib/Lower/CallInterface.cpp
@@ -1136,14 +1136,22 @@ class Fortran::lower::CallInterfaceImpl {
addPassedArg(PassEntityBy::Box, entity, characteristics);
} else if (dynamicType.category() ==
Fortran::common::TypeCategory::Character) {
- // Pass as fir.box_char
- mlir::Type boxCharTy =
- fir::BoxCharType::get(&mlirContext, dynamicType.kind());
- addFirOperand(boxCharTy, nextPassedArgPosition(), Property::BoxChar,
- attrs);
- addPassedArg(isValueAttr ? PassEntityBy::CharBoxValueAttribute
- : PassEntityBy::BoxChar,
- entity, characteristics);
+ if (isValueAttr && isBindC) {
+ // Pass as fir.char<1>
+ mlir::Type charTy =
+ fir::CharacterType::getSingleton(&mlirContext, dynamicType.kind());
+ addFirOperand(charTy, nextPassedArgPosition(), Property::Value, attrs);
+ addPassedArg(PassEntityBy::Value, entity, characteristics);
+ } else {
+ // Pass as fir.box_char
+ 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). Also pass-by-value
// for numerical/logical scalar without OPTIONAL so that the behavior is
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index 315a3f6736aa1f..c6f7d3410ad5cf 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -1494,11 +1494,19 @@ genUserCall(Fortran::lower::PreparedActualArguments &loweredActuals,
value =
hlfir::Entity{genRecordCPtrValueArg(builder, loc, value, eleTy)};
}
- } else if (fir::isa_derived(value.getFortranElementType())) {
- // BIND(C), VALUE derived type. The derived type value must really
+ } else if (fir::isa_derived(value.getFortranElementType()) ||
+ value.isCharacter()) {
+ // BIND(C), VALUE derived type or character. The value must really
// be loaded here.
- auto [derived, cleanup] = hlfir::convertToValue(loc, builder, value);
- mlir::Value loadedValue = fir::getBase(derived);
+ auto [exv, cleanup] = hlfir::convertToValue(loc, builder, value);
+ mlir::Value loadedValue = fir::getBase(exv);
+ // Character actual arguments may have unknown length or a length longer
+ // than one. Cast the memory ref to the dummy type so that the load is
+ // valid and only loads what is needed.
+ if (mlir::Type baseTy = fir::dyn_cast_ptrEleTy(loadedValue.getType()))
+ if (fir::isa_char(baseTy))
+ loadedValue = builder.createConvert(
+ loc, fir::ReferenceType::get(argTy), loadedValue);
if (fir::isa_ref_type(loadedValue.getType()))
loadedValue = builder.create<fir::LoadOp>(loc, loadedValue);
caller.placeInput(arg, loadedValue);
diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index 01473f7f6cd72a..2d2d9eba905bdd 100644
--- a/flang/lib/Lower/ConvertVariable.cpp
+++ b/flang/lib/Lower/ConvertVariable.cpp
@@ -2100,10 +2100,15 @@ void Fortran::lower::mapSymbolAttributes(
if (ba.isChar()) {
if (arg) {
assert(!preAlloc && "dummy cannot be pre-allocated");
- if (arg.getType().isa<fir::BoxCharType>())
+ if (mlir::isa<fir::BoxCharType>(arg.getType())) {
std::tie(addr, len) = charHelp.createUnboxChar(arg);
- else if (!addr)
+ } else if (mlir::isa<fir::CharacterType>(arg.getType())) {
+ // fir.char<1> passed by value (BIND(C) with VALUE attribute).
+ addr = builder.create<fir::AllocaOp>(loc, arg.getType());
+ builder.create<fir::StoreOp>(loc, arg, addr);
+ } else if (!addr) {
addr = arg;
+ }
// Ensure proper type is given to array/scalar that was transmitted as a
// fir.boxchar arg or is a statement function actual argument with
// a
diff erent length than the dummy.
diff --git a/flang/test/Lower/call-by-value.f90 b/flang/test/Lower/call-by-value.f90
index e489ea432305fd..d4694f4575d087 100644
--- a/flang/test/Lower/call-by-value.f90
+++ b/flang/test/Lower/call-by-value.f90
@@ -1,9 +1,10 @@
! Test for PassBy::Value
-! RUN: bbc -emit-fir -hlfir=false %s -o - | FileCheck %s
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
!CHECK-LABEL: func @_QQmain()
-!CHECK: %[[LOGICAL:.*]] = fir.alloca !fir.logical<1>
!CHECK: %false = arith.constant false
+!CHECK: %[[LOGICAL_ALLOC:.*]] = fir.alloca !fir.logical<1>
+!CHECK: %[[LOGICAL:.*]] = fir.declare %[[LOGICAL_ALLOC]]
!CHECK: %[[VALUE:.*]] = fir.convert %false : (i1) -> !fir.logical<1>
!CHECK: fir.store %[[VALUE]] to %[[LOGICAL]]
!CHECK: %[[LOAD:.*]] = fir.load %[[LOGICAL]]
@@ -23,39 +24,42 @@ end subroutine omp_set_nested
call omp_set_nested(do_nested)
end program call_by_value
-! CHECK-LABEL: func.func @test_integer_value(
-! CHECK-SAME: %[[VAL_0:.*]]: i32 {fir.bindc_name = "x"}) attributes {fir.bindc_name = "test_integer_value"} {
-! CHECK: %[[VAL_1:.*]] = fir.alloca i32
-! CHECK: fir.store %[[VAL_0]] to %[[VAL_1]] : !fir.ref<i32>
-! CHECK: fir.call @_QPinternal_call(%[[VAL_1]]) {{.*}}: (!fir.ref<i32>) -> ()
-! CHECK: return
-! CHECK: }
+! CHECK-LABEL: func.func @test_integer_value(
+! CHECK-SAME: %[[VAL_0:.*]]: i32
+! CHECK: %[[VAL_1:.*]] = fir.alloca i32
+! CHECK: fir.store %[[VAL_0]] to %[[VAL_1]] : !fir.ref<i32>
+! CHECK: %[[VAL_2:.*]] = fir.declare %[[VAL_1]]
+! CHECK: fir.call @_QPinternal_call(%[[VAL_2]]) {{.*}}: (!fir.ref<i32>) -> ()
+! CHECK: return
+! CHECK: }
subroutine test_integer_value(x) bind(c)
integer, value :: x
call internal_call(x)
end
+! CHECK-LABEL: func.func @test_real_value(
+! CHECK-SAME: %[[VAL_0:.*]]: f32
+! CHECK: %[[VAL_1:.*]] = fir.alloca f32
+! CHECK: fir.store %[[VAL_0]] to %[[VAL_1]] : !fir.ref<f32>
+! CHECK: %[[VAL_2:.*]] = fir.declare %[[VAL_1]]
+! CHECK: fir.call @_QPinternal_call2(%[[VAL_2]]) {{.*}}: (!fir.ref<f32>) -> ()
+! CHECK: return
+! CHECK: }
-! CHECK-LABEL: func.func @test_real_value(
-! CHECK-SAME: %[[VAL_0:.*]]: f32 {fir.bindc_name = "x"}) attributes {fir.bindc_name = "test_real_value"} {
-! CHECK: %[[VAL_1:.*]] = fir.alloca f32
-! CHECK: fir.store %[[VAL_0]] to %[[VAL_1]] : !fir.ref<f32>
-! CHECK: fir.call @_QPinternal_call2(%[[VAL_1]]) {{.*}}: (!fir.ref<f32>) -> ()
-! CHECK: return
-! CHECK: }
subroutine test_real_value(x) bind(c)
real, value :: x
call internal_call2(x)
end
+! CHECK-LABEL: func.func @test_complex_value(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.complex<4>
+! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.complex<4>
+! CHECK: fir.store %[[VAL_0]] to %[[VAL_1]] : !fir.ref<!fir.complex<4>>
+! CHECK: %[[VAL_2:.*]] = fir.declare %[[VAL_1]]
+! CHECK: fir.call @_QPinternal_call3(%[[VAL_2]]) {{.*}}: (!fir.ref<!fir.complex<4>>) -> ()
+! CHECK: return
+! CHECK: }
-! CHECK-LABEL: func.func @test_complex_value(
-! CHECK-SAME: %[[VAL_0:.*]]: !fir.complex<4> {fir.bindc_name = "x"}) attributes {fir.bindc_name = "test_complex_value"} {
-! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.complex<4>
-! CHECK: fir.store %[[VAL_0]] to %[[VAL_1]] : !fir.ref<!fir.complex<4>>
-! CHECK: fir.call @_QPinternal_call3(%[[VAL_1]]) {{.*}}: (!fir.ref<!fir.complex<4>>) -> ()
-! CHECK: return
-! CHECK: }
subroutine test_complex_value(x) bind(c)
complex, value :: x
@@ -63,12 +67,13 @@ subroutine test_complex_value(x) bind(c)
end
! CHECK-LABEL: func.func @test_char_value(
-! CHECK-SAME: %[[VAL_0:.*]]: !fir.boxchar<1> {fir.bindc_name = "x"}) attributes {fir.bindc_name = "test_char_value"} {
-! CHECK: %[[VAL_1:.*]]:2 = fir.unboxchar %[[VAL_0]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
-! CHECK: %[[VAL_3:.*]] = fir.convert %[[VAL_1]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1>>
-! CHECK: %[[VAL_2:.*]] = arith.constant 1 : index
-! CHECK: %[[VAL_5:.*]] = fir.emboxchar %[[VAL_3]], %[[VAL_2]] : (!fir.ref<!fir.char<1>>, index) -> !fir.boxchar<1>
-! CHECK: fir.call @_QPinternal_call4(%[[VAL_5]]) fastmath<contract> : (!fir.boxchar<1>) -> ()
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.char<1>
+! CHECK: %[[VAL_1:.*]] = arith.constant 1 : index
+! CHECK: %[[VAL_2:.*]] = fir.alloca !fir.char<1>
+! CHECK: fir.store %[[VAL_0]] to %[[VAL_2]] : !fir.ref<!fir.char<1>>
+! CHECK: %[[VAL_3:.*]] = fir.declare %[[VAL_2]] typeparams %[[VAL_1]]
+! CHECK: %[[VAL_4:.*]] = fir.emboxchar %[[VAL_3]], %[[VAL_1]] : (!fir.ref<!fir.char<1>>, index) -> !fir.boxchar<1>
+! CHECK: fir.call @_QPinternal_call4(%[[VAL_4]]) {{.*}}: (!fir.boxchar<1>) -> ()
! CHECK: return
! CHECK: }
@@ -77,19 +82,40 @@ subroutine test_char_value(x) bind(c)
call internal_call4(x)
end
-! CHECK-LABEL: func.func @_QPtest_cptr_value(
-! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<i64> {fir.bindc_name = "x"}) {
-! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>
-! CHECK: %[[VAL_2:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>
-! CHECK: %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_2]] : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>>, !fir.field) -> !fir.ref<i64>
-! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<i64>) -> i64
-! CHECK: fir.store %[[VAL_4]] to %[[VAL_3]] : !fir.ref<i64>
-! CHECK: fir.call @_QPinternal_call5(%[[VAL_1]]) {{.*}}: (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>>) -> ()
-! CHECK: return
-! CHECK: }
+! CHECK-LABEL: func.func @_QPtest_call_char_value(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.boxchar<1>
+! CHECK: %[[VAL_1:.*]]:2 = fir.unboxchar %[[VAL_0]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK: %[[VAL_2:.*]] = fir.declare %[[VAL_1]]#0 typeparams %[[VAL_1]]#1
+! CHECK: %[[VAL_3:.*]] = fir.emboxchar %[[VAL_2]], %[[VAL_1]]#1 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_2]] : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1>>
+! CHECK: %[[VAL_5:.*]] = fir.load %[[VAL_4]] : !fir.ref<!fir.char<1>>
+! CHECK: fir.call @test_char_value(%[[VAL_5]]) {{.*}}: (!fir.char<1>) -> ()
+! CHECK: return
+! CHECK: }
+subroutine test_call_char_value(x)
+ character(*) :: x
+ interface
+ subroutine test_char_value(x) bind(c)
+ character(1), value :: x
+ end
+ end interface
+ call test_char_value(x)
+end subroutine
+
+! CHECK-LABEL: func.func @_QPtest_cptr_value(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<i64>
+! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>
+! CHECK: %[[VAL_2:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>
+! CHECK: %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_2]] : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>>, !fir.field) -> !fir.ref<i64>
+! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<i64>) -> i64
+! CHECK: fir.store %[[VAL_4]] to %[[VAL_3]] : !fir.ref<i64>
+! CHECK: %[[VAL_5:.*]] = fir.declare %[[VAL_1]]
+! CHECK: fir.call @_QPinternal_call5(%[[VAL_5]]) fastmath<contract> : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>>) -> ()
+! CHECK: return
+! CHECK: }
subroutine test_cptr_value(x)
- use iso_c_binding
+ use iso_c_binding, only: c_ptr
type(c_ptr), value :: x
call internal_call5(x)
end
More information about the flang-commits
mailing list