[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:
committed by
GitHub
parent
7543d09b85
commit
cd8229bb4b
@@ -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);
|
||||
|
||||
@@ -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);
|
||||
}
|
||||
|
||||
@@ -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);
|
||||
|
||||
@@ -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>>>>
|
||||
|
||||
Reference in New Issue
Block a user