From: Peixin Qiao Date: Mon, 29 Aug 2022 14:29:34 +0000 (+0800) Subject: [flang] Support lowering of C_PTR and C_FUNPTR argument with VALUE attribute X-Git-Tag: upstream/17.0.6~35065 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=4943dbdf67bad8ddb6dbb6e31e4ce9a80ffd9097;p=platform%2Fupstream%2Fllvm.git [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 --- diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h index 4f73aaa..70c9455 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 97a60df..06724e0 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", 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. diff --git a/flang/include/flang/Optimizer/Dialect/FIRType.h b/flang/include/flang/Optimizer/Dialect/FIRType.h index e7726ef..067a049 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(); } +/// 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()) + 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() || fir::isa_derived(t); diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp index 43c4eb3..0cc6cdb 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 dd133f9..df4634d 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -2689,6 +2689,27 @@ private: } } + 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,16 @@ private: 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()) + 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 34b7e97..5928149 100644 --- a/flang/lib/Lower/CallInterface.cpp +++ b/flang/lib/Lower/CallInterface.cpp @@ -886,7 +886,13 @@ private: if (isBindC) { passBy = PassEntityBy::Value; prop = Property::Value; - passType = type; + if (fir::isa_builtin_cptr_type(type)) { + auto recTy = type.dyn_cast(); + 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::isa_integer(fir::unwrapRefType(ty)); +} diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp index 59156bb..84c30fd 100644 --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -957,14 +957,6 @@ public: 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 @@ public: 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 @@ public: 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 @@ -2675,14 +2690,18 @@ public: cast = builder.create(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 0000000..5e143ba --- /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.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