[flang] Pass VALUE CHARACTER arg by register in BIND(C) calls #87774
Conversation
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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.
llvmbot
added
flang
|
@llvm/pr-subscribers-flang-fir-hlfir Author: None (jeanPerier) ChangesFortran 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. Full diff: https://github.com/llvm/llvm-project/pull/87774.diff 4 Files Affected:
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..0e44ca6181a5ee 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -1494,11 +1494,15 @@ 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);
+ if (mlir::isa<fir::BoxCharType>(loadedValue.getType()))
+ loadedValue = builder.create<fir::BoxAddrOp>(
+ 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 f59c784cff6f9a..a8d1751909dd5b 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 different length than the dummy.
diff --git a/flang/test/Lower/call-by-value.f90 b/flang/test/Lower/call-by-value.f90
index e489ea432305fd..1e04b48aa39aed 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,20 @@ 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_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
|
vzakhari
reviewed
Apr 5, 2024
No, and the case where the actual argument length was not one was incorrect, thanks! |
|
FYI: This PR fixed issue #81646. |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Add this suggestion to a batch that can be applied as a single commit.
This suggestion is invalid because no changes were made to the code.
Suggestions cannot be applied while the pull request is closed.
Suggestions cannot be applied while viewing a subset of changes.
Only one suggestion per line can be applied in a batch.
Add this suggestion to a batch that can be applied as a single commit.
Applying suggestions on deleted lines is not supported.
You must change the existing code in this line in order to create a valid suggestion.
Outdated suggestions cannot be applied.
This suggestion has been applied or marked resolved.
Suggestions cannot be applied from pending reviews.
Suggestions cannot be applied on multi-line comments.
Suggestions cannot be applied while the pull request is queued to merge.
Suggestion cannot be applied right now. Please check back later.
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.