[flang][cuda] Support c_devptr in c_f_pointer intrinsic (#107470)

This is an extension of CUDA Fortran. The iso_c_binding intrinsic can
accept a `TYPE(c_devptr)` as its first argument. This patch relax the
semantic check to accept it and update the lowering to unwrap the cptr
field from the c_devptr.
This commit is contained in:
Valentin Clement (バレンタイン クレメン)
2024-09-09 10:32:35 -07:00
committed by GitHub
parent 7543d09b85
commit cd8229bb4b
4 changed files with 60 additions and 2 deletions

View File

@@ -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<fir::RecordType>(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<SequenceType, mlir::TupleType>(t) || fir::isa_derived(t);

View File

@@ -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);
}

View File

@@ -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<fir::CoordinateOp>(
loc, builder.getRefType(addrFieldTy), cPtr, addrFieldIndex);
} else {
auto arrayAttr = builder.getArrayAttr(
{builder.getIntegerAttr(builder.getIndexType(), 0)});
cPtrCoor = builder.create<fir::ExtractValueOp>(loc, addrFieldTy, cPtr,
arrayAttr);
}
mlir::Value cptr = builder.create<fir::LoadOp>(loc, cPtrCoor);
return genCPtrOrCFunptrValue(builder, loc, cptr);
}
if (fir::isa_ref_type(cPtr.getType())) {
mlir::Value cPtrAddr =
fir::factory::genCPtrOrCFunptrAddr(builder, loc, cPtr, cPtrTy);

View File

@@ -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<device>, fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFsub2Ex"} : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>) -> (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>, !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>)
! 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.type<_QM__fortran_builtinsT__builtin_c_devptr{cptr:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>>, !fir.field) -> !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>>
! CHECK: %[[CPTR_LOAD:.*]] = fir.load %[[CPTR_COORD]] : !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>>
! 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<!fir.array<?xf32>>
! CHECK: %[[EMBOX:.*]] = fir.embox %[[ADDRESS_IDX]](%{{.*}}) : (!fir.ptr<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
! CHECK: fir.store %[[EMBOX]] to %[[X]]#1 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>