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?
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.
/// 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);
}
}
+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");
}
}
+ 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.
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());
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;
}
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));
+}
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(
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(
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
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);
}
--- /dev/null
+! 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