Skip to content

[flang] Pass VALUE CHARACTER arg by register in BIND(C) calls #87774

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 2 commits into from
Apr 12, 2024
Merged

[flang] Pass VALUE CHARACTER arg by register in BIND(C) calls #87774

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
4a91db0
[flang] Pass VALUE CHARACTER arg by register in BIND(C) calls
jeanPerier Apr 5, 2024
e806fdd
fix call side
jeanPerier Apr 8, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
24 changes: 16 additions & 8 deletions flang/lib/Lower/CallInterface.cpp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
16 changes: 12 additions & 4 deletions flang/lib/Lower/ConvertCall.cpp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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);
Expand Down
9 changes: 7 additions & 2 deletions flang/lib/Lower/ConvertVariable.cpp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand Down
106 changes: 66 additions & 40 deletions flang/test/Lower/call-by-value.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -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]]
Expand All @@ -23,52 +24,56 @@ 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
call internal_call3(x)
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: }

Expand All @@ -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