[flang-commits] [flang] 4943dbd - [flang] Support lowering of C_PTR and C_FUNPTR argument with VALUE attribute
Peixin Qiao via flang-commits
flang-commits at lists.llvm.org
Mon Aug 29 07:30:55 PDT 2022
Author: Peixin Qiao
Date: 2022-08-29T22:29:34+08:00
New Revision: 4943dbdf67bad8ddb6dbb6e31e4ce9a80ffd9097
URL: https://github.com/llvm/llvm-project/commit/4943dbdf67bad8ddb6dbb6e31e4ce9a80ffd9097
DIFF: https://github.com/llvm/llvm-project/commit/4943dbdf67bad8ddb6dbb6e31e4ce9a80ffd9097.diff
LOG: [flang] Support lowering of C_PTR and C_FUNPTR argument with VALUE attribute
As Fortran 2018 18.3.2, C_PTR is interoperable with any C object pointer
type. C_FUNPTR is interoperable with any C function pointer type. As
18.3.6, a C pointer can correspond to a Fortran dummy argument of type
C_PTR with the VALUE attribute.
The interface for type(C_PTR)/type(C_FUNPTR) argument with value
attribute is different from the the usual derived type. For type(C_PTR)
or type(C_FUNPTR), the component is the address, and the interface is
a pointer even with VALUE attribute. For a usual derived type such as
the drived type with the component of integer 64, the interface is a i64
value when it has VALUE attribute on aarch64 linux.
To lower the type(C_PTR)/type(C_FUNPTR) argument with value attribute,
get the value of the component of the type(C_PTR)/type(C_FUNPTR), which
is the address, and then convert it to the pointer and pass it.
Reviewed By: Jean Perier
Differential Revision: https://reviews.llvm.org/D131583
Added:
flang/test/Lower/c-interoperability-c-pointer.f90
Modified:
flang/include/flang/Evaluate/tools.h
flang/include/flang/Lower/CallInterface.h
flang/include/flang/Optimizer/Dialect/FIRType.h
flang/lib/Evaluate/tools.cpp
flang/lib/Lower/Bridge.cpp
flang/lib/Lower/CallInterface.cpp
flang/lib/Lower/ConvertExpr.cpp
Removed:
################################################################################
diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h
index 4f73aaad0c27..70c94557f3e2 100644
--- a/flang/include/flang/Evaluate/tools.h
+++ b/flang/include/flang/Evaluate/tools.h
@@ -1133,6 +1133,7 @@ bool IsKindTypeParameter(const Symbol &);
bool IsLenTypeParameter(const Symbol &);
bool IsExtensibleType(const DerivedTypeSpec *);
bool IsBuiltinDerivedType(const DerivedTypeSpec *derived, const char *name);
+bool IsBuiltinCPtr(const Symbol &);
// Is this derived type TEAM_TYPE from module ISO_FORTRAN_ENV?
bool IsTeamType(const DerivedTypeSpec *);
// Is this derived type TEAM_TYPE, C_PTR, or C_FUNPTR?
diff --git a/flang/include/flang/Lower/CallInterface.h b/flang/include/flang/Lower/CallInterface.h
index 97a60df3f4c8..06724e002123 100644
--- a/flang/include/flang/Lower/CallInterface.h
+++ b/flang/include/flang/Lower/CallInterface.h
@@ -407,6 +407,10 @@ getOrDeclareFunction(llvm::StringRef name,
mlir::Type getDummyProcedureType(const Fortran::semantics::Symbol &dummyProc,
Fortran::lower::AbstractConverter &);
+/// Return true if \p ty is "!fir.ref<i64>", 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<function address, result length> ?
// This is required to convey the length of character functions passed as dummy
// procedures.
diff --git a/flang/include/flang/Optimizer/Dialect/FIRType.h b/flang/include/flang/Optimizer/Dialect/FIRType.h
index e7726ef10e83..067a04976a50 100644
--- a/flang/include/flang/Optimizer/Dialect/FIRType.h
+++ b/flang/include/flang/Optimizer/Dialect/FIRType.h
@@ -87,6 +87,14 @@ inline bool conformsWithPassByRef(mlir::Type t) {
/// Is `t` a derived (record) type?
inline bool isa_derived(mlir::Type t) { return t.isa<fir::RecordType>(); }
+/// Is `t` type(c_ptr) or type(c_funptr)?
+inline bool isa_builtin_cptr_type(mlir::Type t) {
+ if (auto recTy = t.dyn_cast_or_null<fir::RecordType>())
+ return recTy.getName().endswith("T__builtin_c_ptr") ||
+ recTy.getName().endswith("T__builtin_c_funptr");
+ return false;
+}
+
/// Is `t` a FIR dialect aggregate type?
inline bool isa_aggregate(mlir::Type t) {
return t.isa<SequenceType, mlir::TupleType>() || fir::isa_derived(t);
diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp
index 43c4eb34980f..0cc6cdb804e5 100644
--- a/flang/lib/Evaluate/tools.cpp
+++ b/flang/lib/Evaluate/tools.cpp
@@ -1483,6 +1483,13 @@ bool IsBuiltinDerivedType(const DerivedTypeSpec *derived, const char *name) {
}
}
+bool IsBuiltinCPtr(const Symbol &symbol) {
+ if (const DeclTypeSpec *declType = symbol.GetType())
+ if (const DerivedTypeSpec *derived = declType->AsDerived())
+ return IsIsoCType(derived);
+ return false;
+}
+
bool IsIsoCType(const DerivedTypeSpec *derived) {
return IsBuiltinDerivedType(derived, "c_ptr") ||
IsBuiltinDerivedType(derived, "c_funptr");
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index dd133f9d68fa..df4634dca737 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -2689,6 +2689,27 @@ class FirConverter : public Fortran::lower::AbstractConverter {
}
}
+ void mapCPtrArgByValue(const Fortran::semantics::Symbol &sym,
+ mlir::Value val) {
+ mlir::Type symTy = Fortran::lower::translateSymbolToFIRType(*this, sym);
+ assert(symTy.isa<fir::RecordType>());
+ auto resTy = symTy.dyn_cast<fir::RecordType>();
+ 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<fir::AllocaOp>(loc, symTy);
+ auto fieldIndexType = fir::FieldType::get(symTy.getContext());
+ mlir::Value field = builder->create<fir::FieldIndexOp>(
+ loc, fieldIndexType, fieldName, resTy,
+ /*typeParams=*/mlir::ValueRange{});
+ mlir::Value resAddr = builder->create<fir::CoordinateOp>(
+ loc, builder->getRefType(fieldTy), res, field);
+ mlir::Value argAddrVal = builder->createConvert(loc, fieldTy, val);
+ builder->create<fir::StoreOp>(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,16 @@ class FirConverter : public Fortran::lower::AbstractConverter {
addSymbol(arg.entity->get(), box);
} else {
if (arg.entity.has_value()) {
+ if (arg.passBy == PassBy::Value) {
+ mlir::Type argTy = arg.firArgument.getType();
+ if (argTy.isa<fir::RecordType>())
+ TODO(toLocation(), "derived type argument passed by value");
+ if (Fortran::semantics::IsBuiltinCPtr(arg.entity->get()) &&
+ Fortran::lower::isCPtrArgByValueType(argTy)) {
+ mapCPtrArgByValue(arg.entity->get(), arg.firArgument);
+ return;
+ }
+ }
addSymbol(arg.entity->get(), arg.firArgument);
} else {
assert(funit.parentHasHostAssoc());
diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp
index 34b7e978ac12..5928149c03f6 100644
--- a/flang/lib/Lower/CallInterface.cpp
+++ b/flang/lib/Lower/CallInterface.cpp
@@ -886,7 +886,13 @@ class Fortran::lower::CallInterfaceImpl {
if (isBindC) {
passBy = PassEntityBy::Value;
prop = Property::Value;
- passType = type;
+ if (fir::isa_builtin_cptr_type(type)) {
+ auto recTy = type.dyn_cast<fir::RecordType>();
+ mlir::Type fieldTy = recTy.getTypeList()[0].second;
+ passType = fir::ReferenceType::get(fieldTy);
+ } else {
+ passType = type;
+ }
} else {
passBy = PassEntityBy::BaseAddressValueAttribute;
}
@@ -1239,3 +1245,8 @@ mlir::Type Fortran::lower::getDummyProcedureType(
return fir::factory::getCharacterProcedureTupleType(procType);
return procType;
}
+
+bool Fortran::lower::isCPtrArgByValueType(mlir::Type ty) {
+ return ty.isa<fir::ReferenceType>() &&
+ fir::isa_integer(fir::unwrapRefType(ty));
+}
diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp
index 59156bb9332f..84c30fd1ac1a 100644
--- a/flang/lib/Lower/ConvertExpr.cpp
+++ b/flang/lib/Lower/ConvertExpr.cpp
@@ -957,14 +957,6 @@ class ScalarExprLowering {
return false;
}
- static bool isBuiltinCPtr(const Fortran::semantics::Symbol &sym) {
- if (const Fortran::semantics::DeclTypeSpec *declType = sym.GetType())
- if (const Fortran::semantics::DerivedTypeSpec *derived =
- declType->AsDerived())
- return Fortran::semantics::IsIsoCType(derived);
- return false;
- }
-
/// Lower structure constructor without a temporary. This can be used in
/// fir::GloablOp, and assumes that the structure component is a constant.
ExtValue genStructComponentInInitializer(
@@ -1003,7 +995,7 @@ class ScalarExprLowering {
if (isDerivedTypeWithLenParameters(sym))
TODO(loc, "component with length parameters in structure constructor");
- if (isBuiltinCPtr(sym)) {
+ if (Fortran::semantics::IsBuiltinCPtr(sym)) {
// Builtin c_ptr and c_funptr have special handling because initial
// value are handled for them as an extension.
mlir::Value addr = fir::getBase(Fortran::lower::genExtAddrInInitializer(
@@ -2466,6 +2458,29 @@ class ScalarExprLowering {
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<fir::RecordType>();
+ 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<fir::FieldIndexOp>(loc, fieldIndexType, fieldName, recTy,
+ /*typeParams=*/mlir::ValueRange{});
+ mlir::Value cAddr = builder.create<fir::CoordinateOp>(
+ loc, builder.getRefType(fieldTy), rec, field);
+ mlir::Value val = builder.create<fir::LoadOp>(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
@@ -2675,14 +2690,18 @@ class ScalarExprLowering {
cast = builder.create<fir::EmboxProcOp>(loc, boxProcTy, fst);
}
} else {
- if (fir::isa_derived(snd)) {
+ mlir::Type fromTy = fir::unwrapRefType(fst.getType());
+ if (fir::isa_builtin_cptr_type(fromTy) &&
+ Fortran::lower::isCPtrArgByValueType(snd)) {
+ cast = genRecordCPtrValueArg(converter, fst, fromTy);
+ } 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);
}
diff --git a/flang/test/Lower/c-interoperability-c-pointer.f90 b/flang/test/Lower/c-interoperability-c-pointer.f90
new file mode 100644
index 000000000000..5e143bad592b
--- /dev/null
+++ b/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.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>> {fir.bindc_name = "ptr1"},
+! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>> {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.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>>, !fir.field) -> !fir.ref<i64>
+! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_3]] : !fir.ref<i64>
+! CHECK: %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (i64) -> !fir.ref<i64>
+! 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.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>>, !fir.field) -> !fir.ref<i64>
+! CHECK: %[[VAL_8:.*]] = fir.load %[[VAL_7]] : !fir.ref<i64>
+! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (i64) -> !fir.ref<i64>
+! CHECK: fir.call @c_func(%[[VAL_5]], %[[VAL_9]]) : (!fir.ref<i64>, !fir.ref<i64>) -> ()
+! 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<i64> {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.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.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.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>>, !fir.field) -> !fir.ref<i64>
+! 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.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>>, !fir.field) -> !fir.ref<i64>
+! CHECK: %[[VAL_10:.*]] = fir.load %[[VAL_7]] : !fir.ref<i64>
+! CHECK: fir.store %[[VAL_10]] to %[[VAL_9]] : !fir.ref<i64>
+! 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<i64> {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.type<_QM__fortran_builtinsT__builtin_c_funptr{__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.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.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>>, !fir.field) -> !fir.ref<i64>
+! 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.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>>, !fir.field) -> !fir.ref<i64>
+! CHECK: %[[VAL_10:.*]] = fir.load %[[VAL_7]] : !fir.ref<i64>
+! CHECK: fir.store %[[VAL_10]] to %[[VAL_9]] : !fir.ref<i64>
+! 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
More information about the flang-commits
mailing list