[flang-commits] [flang] cd8229b - [flang][cuda] Support c_devptr in c_f_pointer intrinsic (#107470)
via flang-commits
flang-commits at lists.llvm.org
Mon Sep 9 10:32:39 PDT 2024
Author: Valentin Clement (バレンタイン クレメン)
Date: 2024-09-09T10:32:35-07:00
New Revision: cd8229bb4bfa4de45528ce101d9dceb9be8bff9e
URL: https://github.com/llvm/llvm-project/commit/cd8229bb4bfa4de45528ce101d9dceb9be8bff9e
DIFF: https://github.com/llvm/llvm-project/commit/cd8229bb4bfa4de45528ce101d9dceb9be8bff9e.diff
LOG: [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.
Added:
Modified:
flang/include/flang/Optimizer/Dialect/FIRType.h
flang/lib/Evaluate/intrinsics.cpp
flang/lib/Optimizer/Builder/FIRBuilder.cpp
flang/test/Lower/CUDA/cuda-devptr.cuf
Removed:
################################################################################
diff --git a/flang/include/flang/Optimizer/Dialect/FIRType.h b/flang/include/flang/Optimizer/Dialect/FIRType.h
index 68e03eab7268b1..3e505b81e1190c 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<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);
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index fcedf5ec3ddf83..ebe946ac60ccb1 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 864e9d31e25cb9..c5a135a189e8dc 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<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);
diff --git a/flang/test/Lower/CUDA/cuda-devptr.cuf b/flang/test/Lower/CUDA/cuda-devptr.cuf
index 4e11e3c0fc8f85..21c5088b640fc7 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<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>>>>
More information about the flang-commits
mailing list