[flang-commits] [flang] [flang] Pass VALUE CHARACTER arg by register in BIND(C) calls (PR #87774)
via flang-commits
flang-commits at lists.llvm.org
Fri Apr 5 05:50:07 PDT 2024
https://github.com/jeanPerier created https://github.com/llvm/llvm-project/pull/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.
>From 4a91db0d416f16da07f593acbbd9aa8a63950815 Mon Sep 17 00:00:00 2001
From: Jean Perier <jperier at nvidia.com>
Date: Fri, 5 Apr 2024 05:30:45 -0700
Subject: [PATCH] [flang] Pass VALUE CHARACTER arg by register in BIND(C) calls
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.
---
flang/lib/Lower/CallInterface.cpp | 24 +++++---
flang/lib/Lower/ConvertCall.cpp | 12 ++--
flang/lib/Lower/ConvertVariable.cpp | 9 ++-
flang/test/Lower/call-by-value.f90 | 86 +++++++++++++++--------------
4 files changed, 77 insertions(+), 54 deletions(-)
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
More information about the flang-commits
mailing list