diff --git a/flang/include/flang/Optimizer/Dialect/FIRType.h b/flang/include/flang/Optimizer/Dialect/FIRType.h index 68e03eab7268b..3e505b81e1190 100644 --- a/flang/include/flang/Optimizer/Dialect/FIRType.h +++ b/flang/include/flang/Optimizer/Dialect/FIRType.h @@ -139,6 +139,13 @@ inline bool isa_builtin_cptr_type(mlir::Type t) { return false; } +/// Is `t` type(c_devptr)? +inline bool isa_builtin_cdevptr_type(mlir::Type t) { + if (auto recTy = mlir::dyn_cast_or_null(t)) + return recTy.getName().ends_with("T__builtin_c_devptr"); + return false; +} + /// Is `t` a FIR dialect aggregate type? inline bool isa_aggregate(mlir::Type t) { return mlir::isa(t) || fir::isa_derived(t); diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp index fcedf5ec3ddf8..ebe946ac60ccb 100644 --- a/flang/lib/Evaluate/intrinsics.cpp +++ b/flang/lib/Evaluate/intrinsics.cpp @@ -2811,8 +2811,10 @@ IntrinsicProcTable::Implementation::HandleC_F_Pointer( if (auto type{expr->GetType()}) { if (type->category() != TypeCategory::Derived || type->IsPolymorphic() || - type->GetDerivedTypeSpec().typeSymbol().name() != - "__builtin_c_ptr") { + (type->GetDerivedTypeSpec().typeSymbol().name() != + "__builtin_c_ptr" && + type->GetDerivedTypeSpec().typeSymbol().name() != + "__builtin_c_devptr")) { context.messages().Say(arguments[0]->sourceLocation(), "CPTR= argument to C_F_POINTER() must be a C_PTR"_err_en_US); } diff --git a/flang/lib/Optimizer/Builder/FIRBuilder.cpp b/flang/lib/Optimizer/Builder/FIRBuilder.cpp index 864e9d31e25cb..c5a135a189e8d 100644 --- a/flang/lib/Optimizer/Builder/FIRBuilder.cpp +++ b/flang/lib/Optimizer/Builder/FIRBuilder.cpp @@ -1580,6 +1580,24 @@ mlir::Value fir::factory::genCPtrOrCFunptrValue(fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value cPtr) { mlir::Type cPtrTy = fir::unwrapRefType(cPtr.getType()); + if (fir::isa_builtin_cdevptr_type(cPtrTy)) { + // Unwrap c_ptr from c_devptr. + auto [addrFieldIndex, addrFieldTy] = + genCPtrOrCFunptrFieldIndex(builder, loc, cPtrTy); + mlir::Value cPtrCoor; + if (fir::isa_ref_type(cPtr.getType())) { + cPtrCoor = builder.create( + loc, builder.getRefType(addrFieldTy), cPtr, addrFieldIndex); + } else { + auto arrayAttr = builder.getArrayAttr( + {builder.getIntegerAttr(builder.getIndexType(), 0)}); + cPtrCoor = builder.create(loc, addrFieldTy, cPtr, + arrayAttr); + } + mlir::Value cptr = builder.create(loc, cPtrCoor); + return genCPtrOrCFunptrValue(builder, loc, cptr); + } + if (fir::isa_ref_type(cPtr.getType())) { mlir::Value cPtrAddr = fir::factory::genCPtrOrCFunptrAddr(builder, loc, cPtr, cPtrTy); diff --git a/flang/test/Lower/CUDA/cuda-devptr.cuf b/flang/test/Lower/CUDA/cuda-devptr.cuf index 4e11e3c0fc8f8..21c5088b640fc 100644 --- a/flang/test/Lower/CUDA/cuda-devptr.cuf +++ b/flang/test/Lower/CUDA/cuda-devptr.cuf @@ -2,6 +2,18 @@ ! Test CUDA Fortran specific type +module cudafct + use __fortran_builtins, only : c_devptr => __builtin_c_devptr +contains + function c_devloc(x) + use iso_c_binding, only: c_loc + type(c_devptr) :: c_devloc + !dir$ ignore_tkr (tkr) x + real, target, device :: x + c_devloc%cptr = c_loc(x) + end function +end + subroutine sub1() use iso_c_binding use __fortran_builtins, only : c_devptr => __builtin_c_devptr @@ -14,3 +26,22 @@ end ! CHECK-LABEL: func.func @_QPsub1() ! CHECK-COUNT-2: %{{.*}} = fir.call @_FortranAioOutputDerivedType + +subroutine sub2() + use cudafct + use iso_c_binding, only: c_f_pointer + + real(4), device :: a(8, 10) + real(4), device, pointer :: x(:) + call c_f_pointer(c_devloc(a), x, (/80/)) +end + +! CHECK-LABEL: func.func @_QPsub2() +! CHECK: %[[X:.*]]:2 = hlfir.declare %{{.*}} {data_attr = #cuf.cuda, fortran_attrs = #fir.var_attrs, uniq_name = "_QFsub2Ex"} : (!fir.ref>>>) -> (!fir.ref>>>, !fir.ref>>>) +! CHECK: %[[CPTR:.*]] = fir.field_index cptr, !fir.type<_QM__fortran_builtinsT__builtin_c_devptr{cptr:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}> +! CHECK: %[[CPTR_COORD:.*]] = fir.coordinate_of %{{.*}}#1, %[[CPTR]] : (!fir.ref}>>, !fir.field) -> !fir.ref> +! CHECK: %[[CPTR_LOAD:.*]] = fir.load %[[CPTR_COORD]] : !fir.ref> +! CHECK: %[[ADDRESS:.*]] = fir.extract_value %[[CPTR_LOAD]], [0 : index] : (!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>) -> i64 +! CHECK: %[[ADDRESS_IDX:.*]] = fir.convert %[[ADDRESS]] : (i64) -> !fir.ptr> +! CHECK: %[[EMBOX:.*]] = fir.embox %[[ADDRESS_IDX]](%{{.*}}) : (!fir.ptr>, !fir.shape<1>) -> !fir.box>> +! CHECK: fir.store %[[EMBOX]] to %[[X]]#1 : !fir.ref>>>