Index: flang/include/flang/Lower/CallInterface.h =================================================================== --- flang/include/flang/Lower/CallInterface.h +++ flang/include/flang/Lower/CallInterface.h @@ -407,6 +407,10 @@ mlir::Type getDummyProcedureType(const Fortran::semantics::Symbol &dummyProc, Fortran::lower::AbstractConverter &); +/// Return true if \p ty is "!fir.ref", which is the interface for +/// type(C_PTR/C_FUNPTR) passed by value. +bool isCPtrArgByValueType(mlir::Type ty); + /// Is it required to pass \p proc as a tuple ? // This is required to convey the length of character functions passed as dummy // procedures. Index: flang/lib/Lower/Bridge.cpp =================================================================== --- flang/lib/Lower/Bridge.cpp +++ flang/lib/Lower/Bridge.cpp @@ -2689,6 +2689,27 @@ } } + void mapCPtrArgByValue(const Fortran::semantics::Symbol &sym, + mlir::Value val) { + mlir::Type symTy = Fortran::lower::translateSymbolToFIRType(*this, sym); + assert(symTy.isa()); + auto resTy = symTy.dyn_cast(); + assert(resTy.getTypeList().size() == 1); + auto fieldName = resTy.getTypeList()[0].first; + auto fieldTy = resTy.getTypeList()[0].second; + mlir::Location loc = toLocation(); + mlir::Value res = builder->create(loc, symTy); + auto fieldIndexType = fir::FieldType::get(symTy.getContext()); + mlir::Value field = builder->create( + loc, fieldIndexType, fieldName, resTy, + /*typeParams=*/mlir::ValueRange{}); + mlir::Value resAddr = builder->create( + loc, builder->getRefType(fieldTy), res, field); + mlir::Value argAddrVal = builder->createConvert(loc, fieldTy, val); + builder->create(loc, argAddrVal, resAddr); + addSymbol(sym, res); + } + /// Map mlir function block arguments to the corresponding Fortran dummy /// variables. When the result is passed as a hidden argument, the Fortran /// result is also mapped. The symbol map is used to hold this mapping. @@ -2707,6 +2728,20 @@ addSymbol(arg.entity->get(), box); } else { if (arg.entity.has_value()) { + if (const auto *symType{arg.entity->get().GetType()}) { + if (const auto *derived{symType->AsDerived()}; + arg.passBy == PassBy::Value) { + mlir::Type argTy = arg.firArgument.getType(); + if (argTy.isa()) + TODO(toLocation(), "derived type argument passed by value"); + if ((derived->typeSymbol().name() == "__builtin_c_ptr" || + derived->typeSymbol().name() == "__builtin_c_funptr") && + Fortran::lower::isCPtrArgByValueType(argTy)) { + mapCPtrArgByValue(arg.entity->get(), arg.firArgument); + return; + } + } + } addSymbol(arg.entity->get(), arg.firArgument); } else { assert(funit.parentHasHostAssoc()); Index: flang/lib/Lower/CallInterface.cpp =================================================================== --- flang/lib/Lower/CallInterface.cpp +++ flang/lib/Lower/CallInterface.cpp @@ -886,7 +886,16 @@ if (isBindC) { passBy = PassEntityBy::Value; prop = Property::Value; - passType = type; + auto recTy = type.dyn_cast_or_null(); + llvm::StringRef builtinCPtrName = "T__builtin_c_ptr"; + llvm::StringRef builtinCFunptrName = "T__builtin_c_funptr"; + if (recTy && (recTy.getName().endswith(builtinCPtrName) || + recTy.getName().endswith(builtinCFunptrName))) { + mlir::Type fieldTy = recTy.getTypeList()[0].second; + passType = fir::ReferenceType::get(fieldTy); + } else { + passType = type; + } } else { passBy = PassEntityBy::BaseAddressValueAttribute; } @@ -1239,3 +1248,12 @@ return fir::factory::getCharacterProcedureTupleType(procType); return procType; } + +bool Fortran::lower::isCPtrArgByValueType(mlir::Type ty) { + if (ty.isa()) { + mlir::Type intTy = fir::unwrapRefType(ty); + if (fir::isa_integer(intTy) && intTy.getIntOrFloatBitWidth() == 64) + return true; + } + return false; +} Index: flang/lib/Lower/ConvertExpr.cpp =================================================================== --- flang/lib/Lower/ConvertExpr.cpp +++ flang/lib/Lower/ConvertExpr.cpp @@ -2473,6 +2473,29 @@ return res; } + /// Lower a type(C_PTR/C_FUNPTR) argument with VALUE attribute into a + /// reference. A C pointer can correspond to a Fortran dummy argument of type + /// C_PTR with the VALUE attribute. (see 18.3.6 note 3). + static mlir::Value + genRecordCPtrValueArg(Fortran::lower::AbstractConverter &converter, + mlir::Value rec, mlir::Type ty) { + assert(fir::isa_derived(ty)); + auto recTy = ty.dyn_cast(); + assert(recTy.getTypeList().size() == 1); + auto fieldName = recTy.getTypeList()[0].first; + mlir::Type fieldTy = recTy.getTypeList()[0].second; + fir::FirOpBuilder &builder = converter.getFirOpBuilder(); + mlir::Location loc = converter.getCurrentLocation(); + auto fieldIndexType = fir::FieldType::get(ty.getContext()); + mlir::Value field = + builder.create(loc, fieldIndexType, fieldName, recTy, + /*typeParams=*/mlir::ValueRange{}); + mlir::Value cAddr = builder.create( + loc, builder.getRefType(fieldTy), rec, field); + mlir::Value val = builder.create(loc, cAddr); + return builder.createConvert(loc, builder.getRefType(fieldTy), val); + } + /// Given a call site for which the arguments were already lowered, generate /// the call and return the result. This function deals with explicit result /// allocation and lowering if needed. It also deals with passing the host @@ -2682,14 +2705,24 @@ cast = builder.create(loc, boxProcTy, fst); } } else { - if (fir::isa_derived(snd)) { + mlir::Type fromTy = fst.getType(); + auto recTy = + fir::unwrapRefType(fromTy).dyn_cast_or_null(); + llvm::StringRef builtinCPtrName = "T__builtin_c_ptr"; + llvm::StringRef builtinCFunptrName = "T__builtin_c_funptr"; + if (recTy && + (recTy.getName().endswith(builtinCPtrName) || + recTy.getName().endswith(builtinCFunptrName)) && + Fortran::lower::isCPtrArgByValueType(snd)) { + cast = genRecordCPtrValueArg(converter, fst, recTy); + } else if (fir::isa_derived(snd)) { // FIXME: This seems like a serious bug elsewhere in lowering. Paper // over the problem for now. TODO(loc, "derived type argument passed by value"); + } else { + cast = builder.convertWithSemantics(loc, snd, fst, + callingImplicitInterface); } - assert(!fir::isa_derived(snd)); - cast = builder.convertWithSemantics(loc, snd, fst, - callingImplicitInterface); } operands.push_back(cast); } Index: flang/test/Lower/c-interoperability-c-pointer.f90 =================================================================== --- /dev/null +++ flang/test/Lower/c-interoperability-c-pointer.f90 @@ -0,0 +1,80 @@ +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +! CHECK-LABEL: func.func @_QPtest( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref> {fir.bindc_name = "ptr1"}, +! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref> {fir.bindc_name = "ptr2"}) { +! CHECK: %[[VAL_2:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_2]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_3]] : !fir.ref +! CHECK: %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (i64) -> !fir.ref +! CHECK: %[[VAL_6:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}> +! CHECK: %[[VAL_7:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_6]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_8:.*]] = fir.load %[[VAL_7]] : !fir.ref +! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (i64) -> !fir.ref +! CHECK: fir.call @c_func(%[[VAL_5]], %[[VAL_9]]) : (!fir.ref, !fir.ref) -> () +! CHECK: return +! CHECK: } + +subroutine test(ptr1, ptr2) + use, intrinsic :: iso_c_binding + type(c_ptr) :: ptr1 + type(c_funptr) :: ptr2 + + interface + subroutine c_func(c_t1, c_t2) bind(c, name="c_func") + import :: c_ptr, c_funptr + type(c_ptr), value :: c_t1 + type(c_funptr), value :: c_t2 + end + end interface + + call c_func(ptr1, ptr2) +end + +! CHECK-LABEL: func.func @test_callee_c_ptr( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref {fir.bindc_name = "ptr1"}) attributes {fir.bindc_name = "test_callee_c_ptr"} { +! 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.field) -> !fir.ref +! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_0]] : (!fir.ref) -> i64 +! CHECK: fir.store %[[VAL_4]] to %[[VAL_3]] : !fir.ref +! CHECK: %[[VAL_5:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> {bindc_name = "local", uniq_name = "_QFtest_callee_c_ptrElocal"} +! CHECK: %[[VAL_6:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_7:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_6]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_8:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_9:.*]] = fir.coordinate_of %[[VAL_5]], %[[VAL_8]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_10:.*]] = fir.load %[[VAL_7]] : !fir.ref +! CHECK: fir.store %[[VAL_10]] to %[[VAL_9]] : !fir.ref +! CHECK: return +! CHECK: } + +subroutine test_callee_c_ptr(ptr1) bind(c) + use, intrinsic :: iso_c_binding + type(c_ptr), value :: ptr1 + type(c_ptr) :: local + local = ptr1 +end subroutine + +! CHECK-LABEL: func.func @test_callee_c_funptr( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref {fir.bindc_name = "ptr1"}) attributes {fir.bindc_name = "test_callee_c_funptr"} { +! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}> +! CHECK: %[[VAL_2:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}> +! CHECK: %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_2]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_0]] : (!fir.ref) -> i64 +! CHECK: fir.store %[[VAL_4]] to %[[VAL_3]] : !fir.ref +! CHECK: %[[VAL_5:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}> {bindc_name = "local", uniq_name = "_QFtest_callee_c_funptrElocal"} +! CHECK: %[[VAL_6:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}> +! CHECK: %[[VAL_7:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_6]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_8:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}> +! CHECK: %[[VAL_9:.*]] = fir.coordinate_of %[[VAL_5]], %[[VAL_8]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_10:.*]] = fir.load %[[VAL_7]] : !fir.ref +! CHECK: fir.store %[[VAL_10]] to %[[VAL_9]] : !fir.ref +! CHECK: return +! CHECK: } + +subroutine test_callee_c_funptr(ptr1) bind(c) + use, intrinsic :: iso_c_binding + type(c_funptr), value :: ptr1 + type(c_funptr) :: local + local = ptr1 +end subroutine