[flang] Add special genre for allocatable and pointer device component #157731

clementval · 2025-09-09T18:28:30Z

Allocatable and pointer device components need a different allocator index to be set in their descriptor when it is establish. This PR adds two genre for the components AllocatableDevice and PointerDevice so the correct allocator index can be set accordingly.

llvmbot · 2025-09-09T18:29:03Z

@llvm/pr-subscribers-flang-fir-hlfir

@llvm/pr-subscribers-flang-semantics

Author: Valentin Clement (バレンタインクレメン) (clementval)

Changes

Allocatable and pointer device components need a different allocator index to be set in their descriptor when it is establish. This PR adds two genre for the components AllocatableDevice and PointerDevice so the correct allocator index can be set accordingly.

Full diff: https://github.com/llvm/llvm-project/pull/157731.diff

10 Files Affected:

(modified) flang-rt/include/flang-rt/runtime/descriptor.h (+5-4)
(modified) flang-rt/lib/runtime/assign.cpp (+3-1)
(modified) flang-rt/lib/runtime/copy.cpp (+2)
(modified) flang-rt/lib/runtime/derived.cpp (+12-5)
(modified) flang-rt/lib/runtime/descriptor.cpp (+9-6)
(modified) flang-rt/lib/runtime/type-info.cpp (+26-13)
(modified) flang/include/flang/Semantics/tools.h (+10)
(modified) flang/lib/Semantics/runtime-type-info.cpp (+14-2)
(modified) flang/module/__fortran_type_info.f90 (+1-1)
(added) flang/test/Lower/CUDA/cuda-allocatable-device.cuf (+14)

diff --git a/flang-rt/include/flang-rt/runtime/descriptor.h b/flang-rt/include/flang-rt/runtime/descriptor.h
index 4c65abce782d3..1ad75d41763ba 100644
--- a/flang-rt/include/flang-rt/runtime/descriptor.h
+++ b/flang-rt/include/flang-rt/runtime/descriptor.h
@@ -171,20 +171,21 @@ class Descriptor {
       void *p = nullptr, int rank = maxRank,
       const SubscriptValue *extent = nullptr,
       ISO::CFI_attribute_t attribute = CFI_attribute_other,
-      bool addendum = false);
+      bool addendum = false, unsigned allocatorIdx = kDefaultAllocator);
   RT_API_ATTRS void Establish(TypeCategory, int kind, void *p = nullptr,
       int rank = maxRank, const SubscriptValue *extent = nullptr,
       ISO::CFI_attribute_t attribute = CFI_attribute_other,
-      bool addendum = false);
+      bool addendum = false, unsigned allocatorIdx = kDefaultAllocator);
   RT_API_ATTRS void Establish(int characterKind, std::size_t characters,
       void *p = nullptr, int rank = maxRank,
       const SubscriptValue *extent = nullptr,
       ISO::CFI_attribute_t attribute = CFI_attribute_other,
-      bool addendum = false);
+      bool addendum = false, unsigned allocatorIdx = kDefaultAllocator);
   RT_API_ATTRS void Establish(const typeInfo::DerivedType &dt,
       void *p = nullptr, int rank = maxRank,
       const SubscriptValue *extent = nullptr,
-      ISO::CFI_attribute_t attribute = CFI_attribute_other);
+      ISO::CFI_attribute_t attribute = CFI_attribute_other,
+      unsigned allocatorIdx = kDefaultAllocator);
 
   RT_API_ATTRS void UncheckedScalarEstablish(
       const typeInfo::DerivedType &, void *);
diff --git a/flang-rt/lib/runtime/assign.cpp b/flang-rt/lib/runtime/assign.cpp
index 923b76adca726..b70182ccb3178 100644
--- a/flang-rt/lib/runtime/assign.cpp
+++ b/flang-rt/lib/runtime/assign.cpp
@@ -648,7 +648,8 @@ RT_API_ATTRS int DerivedAssignTicket<IS_COMPONENTWISE>::Continue(
         }
       }
       break;
-    case typeInfo::Component::Genre::Pointer: {
+    case typeInfo::Component::Genre::Pointer:
+    case typeInfo::Component::Genre::PointerDevice: {
       std::size_t componentByteSize{
           this->component_->SizeInBytes(this->instance_)};
       if (IS_COMPONENTWISE && toIsContiguous_ && fromIsContiguous_) {
@@ -680,6 +681,7 @@ RT_API_ATTRS int DerivedAssignTicket<IS_COMPONENTWISE>::Continue(
       }
     } break;
     case typeInfo::Component::Genre::Allocatable:
+    case typeInfo::Component::Genre::AllocatableDevice:
     case typeInfo::Component::Genre::Automatic: {
       auto *toDesc{reinterpret_cast<Descriptor *>(
           this->instance_.template Element<char>(this->subscripts_) +
diff --git a/flang-rt/lib/runtime/copy.cpp b/flang-rt/lib/runtime/copy.cpp
index 1db8962dad0d3..8b7db61b014e1 100644
--- a/flang-rt/lib/runtime/copy.cpp
+++ b/flang-rt/lib/runtime/copy.cpp
@@ -168,6 +168,8 @@ RT_API_ATTRS void CopyElement(const Descriptor &to, const SubscriptValue toAt[],
         std::size_t nComponents{componentDesc.Elements()};
         for (std::size_t j{0}; j < nComponents; ++j, ++component) {
           if (component->genre() == typeInfo::Component::Genre::Allocatable ||
+              component->genre() ==
+                  typeInfo::Component::Genre::AllocatableDevice ||
               component->genre() == typeInfo::Component::Genre::Automatic) {
             Descriptor &toDesc{
                 *reinterpret_cast<Descriptor *>(toPtr + component->offset())};
diff --git a/flang-rt/lib/runtime/derived.cpp b/flang-rt/lib/runtime/derived.cpp
index 6abeb2edd1da7..7e50674631624 100644
--- a/flang-rt/lib/runtime/derived.cpp
+++ b/flang-rt/lib/runtime/derived.cpp
@@ -63,7 +63,8 @@ RT_API_ATTRS int InitializeTicket::Continue(WorkQueue &workQueue) {
   char *rawInstance{instance_.OffsetElement<char>()};
   for (; !Componentwise::IsComplete(); SkipToNextComponent()) {
     char *rawComponent{rawInstance + component_->offset()};
-    if (component_->genre() == typeInfo::Component::Genre::Allocatable) {
+    if (component_->genre() == typeInfo::Component::Genre::Allocatable ||
+        component_->genre() == typeInfo::Component::Genre::AllocatableDevice) {
       Descriptor &allocDesc{*reinterpret_cast<Descriptor *>(rawComponent)};
       component_->EstablishDescriptor(
           allocDesc, instance_, workQueue.terminator());
@@ -72,7 +73,8 @@ RT_API_ATTRS int InitializeTicket::Continue(WorkQueue &workQueue) {
       // non-allocatable non-automatic components
       std::size_t bytes{component_->SizeInBytes(instance_)};
       runtime::memcpy(rawComponent, init, bytes);
-    } else if (component_->genre() == typeInfo::Component::Genre::Pointer) {
+    } else if (component_->genre() == typeInfo::Component::Genre::Pointer ||
+        component_->genre() == typeInfo::Component::Genre::PointerDevice) {
       // Data pointers without explicit initialization are established
       // so that they are valid right-hand side targets of pointer
       // assignment statements.
@@ -143,7 +145,8 @@ RT_API_ATTRS int InitializeClone(const Descriptor &clone,
 
 RT_API_ATTRS int InitializeCloneTicket::Continue(WorkQueue &workQueue) {
   while (!IsComplete()) {
-    if (component_->genre() == typeInfo::Component::Genre::Allocatable) {
+    if (component_->genre() == typeInfo::Component::Genre::Allocatable ||
+        component_->genre() == typeInfo::Component::Genre::AllocatableDevice) {
       Descriptor &origDesc{*instance_.ElementComponent<Descriptor>(
           subscripts_, component_->offset())};
       if (origDesc.IsAllocated()) {
@@ -320,7 +323,9 @@ RT_API_ATTRS int FinalizeTicket::Begin(WorkQueue &workQueue) {
 
 RT_API_ATTRS int FinalizeTicket::Continue(WorkQueue &workQueue) {
   while (!IsComplete()) {
-    if (component_->genre() == typeInfo::Component::Genre::Allocatable &&
+    if ((component_->genre() == typeInfo::Component::Genre::Allocatable ||
+            component_->genre() ==
+                typeInfo::Component::Genre::AllocatableDevice) &&
         component_->category() == TypeCategory::Derived) {
       // Component may be polymorphic or unlimited polymorphic. Need to use the
       // dynamic type to check whether finalization is needed.
@@ -342,6 +347,7 @@ RT_API_ATTRS int FinalizeTicket::Continue(WorkQueue &workQueue) {
         }
       }
     } else if (component_->genre() == typeInfo::Component::Genre::Allocatable ||
+        component_->genre() == typeInfo::Component::Genre::AllocatableDevice ||
         component_->genre() == typeInfo::Component::Genre::Automatic) {
       if (const typeInfo::DerivedType *compType{component_->derivedType()};
           compType && !compType->noFinalizationNeeded()) {
@@ -424,7 +430,8 @@ RT_API_ATTRS int DestroyTicket::Continue(WorkQueue &workQueue) {
   // Contrary to finalization, the order of deallocation does not matter.
   while (!IsComplete()) {
     const auto *componentDerived{component_->derivedType()};
-    if (component_->genre() == typeInfo::Component::Genre::Allocatable) {
+    if (component_->genre() == typeInfo::Component::Genre::Allocatable ||
+        component_->genre() == typeInfo::Component::Genre::AllocatableDevice) {
       if (fixedStride_ &&
           (!componentDerived || componentDerived->noDestructionNeeded())) {
         // common fast path, just deallocate in every element
diff --git a/flang-rt/lib/runtime/descriptor.cpp b/flang-rt/lib/runtime/descriptor.cpp
index 45191bfbe3ad6..0cb3547c4e12a 100644
--- a/flang-rt/lib/runtime/descriptor.cpp
+++ b/flang-rt/lib/runtime/descriptor.cpp
@@ -33,7 +33,7 @@ RT_API_ATTRS Descriptor &Descriptor::operator=(const Descriptor &that) {
 
 RT_API_ATTRS void Descriptor::Establish(TypeCode t, std::size_t elementBytes,
     void *p, int rank, const SubscriptValue *extent,
-    ISO::CFI_attribute_t attribute, bool addendum) {
+    ISO::CFI_attribute_t attribute, bool addendum, unsigned allocatorIdx) {
   Terminator terminator{__FILE__, __LINE__};
   int cfiStatus{ISO::VerifyEstablishParameters(&raw_, p, attribute, t.raw(),
       elementBytes, rank, extent, /*external=*/false)};
@@ -60,6 +60,7 @@ RT_API_ATTRS void Descriptor::Establish(TypeCode t, std::size_t elementBytes,
   if (a) {
     new (a) DescriptorAddendum{};
   }
+  SetAllocIdx(allocatorIdx);
 }
 
 RT_API_ATTRS std::size_t Descriptor::BytesFor(TypeCategory category, int kind) {
@@ -71,21 +72,22 @@ RT_API_ATTRS std::size_t Descriptor::BytesFor(TypeCategory category, int kind) {
 
 RT_API_ATTRS void Descriptor::Establish(TypeCategory c, int kind, void *p,
     int rank, const SubscriptValue *extent, ISO::CFI_attribute_t attribute,
-    bool addendum) {
+    bool addendum, unsigned allocatorIdx) {
   Establish(TypeCode(c, kind), BytesFor(c, kind), p, rank, extent, attribute,
-      addendum);
+      addendum, allocatorIdx);
 }
 
 RT_API_ATTRS void Descriptor::Establish(int characterKind,
     std::size_t characters, void *p, int rank, const SubscriptValue *extent,
-    ISO::CFI_attribute_t attribute, bool addendum) {
+    ISO::CFI_attribute_t attribute, bool addendum, unsigned allocatorIdx) {
   Establish(TypeCode{TypeCategory::Character, characterKind},
-      characterKind * characters, p, rank, extent, attribute, addendum);
+      characterKind * characters, p, rank, extent, attribute, addendum,
+      allocatorIdx);
 }
 
 RT_API_ATTRS void Descriptor::Establish(const typeInfo::DerivedType &dt,
     void *p, int rank, const SubscriptValue *extent,
-    ISO::CFI_attribute_t attribute) {
+    ISO::CFI_attribute_t attribute, unsigned allocatorIdx) {
   auto elementBytes{static_cast<std::size_t>(dt.sizeInBytes())};
   ISO::EstablishDescriptor(
       &raw_, p, attribute, CFI_type_struct, elementBytes, rank, extent);
@@ -99,6 +101,7 @@ RT_API_ATTRS void Descriptor::Establish(const typeInfo::DerivedType &dt,
   }
   SetHasAddendum();
   new (Addendum()) DescriptorAddendum{&dt};
+  SetAllocIdx(allocatorIdx);
 }
 
 RT_API_ATTRS void Descriptor::UncheckedScalarEstablish(
diff --git a/flang-rt/lib/runtime/type-info.cpp b/flang-rt/lib/runtime/type-info.cpp
index 70e0f611ec6d2..3167d48060969 100644
--- a/flang-rt/lib/runtime/type-info.cpp
+++ b/flang-rt/lib/runtime/type-info.cpp
@@ -95,10 +95,16 @@ RT_API_ATTRS std::size_t Component::SizeInBytes(
 RT_API_ATTRS void Component::EstablishDescriptor(Descriptor &descriptor,
     const Descriptor &container, Terminator &terminator) const {
   ISO::CFI_attribute_t attribute{static_cast<ISO::CFI_attribute_t>(
-      genre_ == Genre::Allocatable   ? CFI_attribute_allocatable
-          : genre_ == Genre::Pointer ? CFI_attribute_pointer
-                                     : CFI_attribute_other)};
+      genre_ == Genre::Allocatable || genre_ == Genre::AllocatableDevice
+          ? CFI_attribute_allocatable
+          : genre_ == Genre::Pointer || genre_ == Genre::pointerDevice
+          ? CFI_attribute_pointer
+          : CFI_attribute_other)};
   TypeCategory cat{category()};
+  unsigned allocatorIdx{
+      genre_ == Genre::AllocatableDevice || genre_ == Genre::PointerDevice
+          ? kDeviceAllocatorPos
+          : kDefaultAllocator};
   if (cat == TypeCategory::Character) {
     std::size_t lengthInChars{0};
     if (auto length{characterLen_.GetValue(&container)}) {
@@ -107,19 +113,22 @@ RT_API_ATTRS void Component::EstablishDescriptor(Descriptor &descriptor,
       RUNTIME_CHECK(
           terminator, characterLen_.genre() == Value::Genre::Deferred);
     }
-    descriptor.Establish(
-        kind_, lengthInChars, nullptr, rank_, nullptr, attribute);
+    descriptor.Establish(kind_, lengthInChars, nullptr, rank_, nullptr,
+        attribute, false, allocatorIdx);
   } else if (cat == TypeCategory::Derived) {
     if (const DerivedType * type{derivedType()}) {
-      descriptor.Establish(*type, nullptr, rank_, nullptr, attribute);
+      descriptor.Establish(
+          *type, nullptr, rank_, nullptr, attribute, false, allocatorIdx);
     } else { // unlimited polymorphic
       descriptor.Establish(TypeCode{TypeCategory::Derived, 0}, 0, nullptr,
-          rank_, nullptr, attribute, true);
+          rank_, nullptr, attribute, true, allocatorIdx);
     }
   } else {
-    descriptor.Establish(cat, kind_, nullptr, rank_, nullptr, attribute);
+    descriptor.Establish(
+        cat, kind_, nullptr, rank_, nullptr, attribute, false, allocatorIdx);
   }
-  if (rank_ && genre_ != Genre::Allocatable && genre_ != Genre::Pointer) {
+  if (rank_ && genre_ != Genre::Allocatable && genre_ != Genre::Pointer &&
+      genre_ != Genre::AllocatableDevice && genre_ != Genre::PointerDevice) {
     const typeInfo::Value *boundValues{bounds()};
     RUNTIME_CHECK(terminator, boundValues != nullptr);
     auto byteStride{static_cast<SubscriptValue>(descriptor.ElementBytes())};
@@ -267,13 +276,17 @@ FILE *Component::Dump(FILE *f) const {
   std::fputs("    name: ", f);
   DumpScalarCharacter(f, name(), "Component::name");
   if (genre_ == Genre::Data) {
-    std::fputs("    Data       ", f);
+    std::fputs("    Data            ", f);
   } else if (genre_ == Genre::Pointer) {
-    std::fputs("    Pointer    ", f);
+    std::fputs("    Pointer          ", f);
+  } else if (genre_ == Genre::PointerDevice) {
+    std::fputs("    PointerDevice    ", f);
   } else if (genre_ == Genre::Allocatable) {
-    std::fputs("    Allocatable", f);
+    std::fputs("    Allocatable.     ", f);
+  } else if (genre_ == Genre::AllocatableDevice) {
+    std::fputs("    AllocatableDevice", f);
   } else if (genre_ == Genre::Automatic) {
-    std::fputs("    Automatic  ", f);
+    std::fputs("    Automatic        ", f);
   } else {
     std::fprintf(f, "    (bad genre 0x%x)", static_cast<int>(genre_));
   }
diff --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h
index cb1def32dfe0c..37e2fed5f676c 100644
--- a/flang/include/flang/Semantics/tools.h
+++ b/flang/include/flang/Semantics/tools.h
@@ -225,6 +225,16 @@ inline bool HasCUDAAttr(const Symbol &sym) {
 
 bool HasCUDAComponent(const Symbol &sym);
 
+inline bool IsCUDADevice(const Symbol &sym) {
+  if (const auto *details{sym.GetUltimate().detailsIf<ObjectEntityDetails>()}) {
+    if (details->cudaDataAttr() &&
+        *details->cudaDataAttr() == common::CUDADataAttr::Device) {
+      return true;
+    }
+  }
+  return false;
+}
+
 inline bool IsCUDAShared(const Symbol &sym) {
   if (const auto *details{sym.GetUltimate().detailsIf<ObjectEntityDetails>()}) {
     if (details->cudaDataAttr() &&
diff --git a/flang/lib/Semantics/runtime-type-info.cpp b/flang/lib/Semantics/runtime-type-info.cpp
index 5916a07df7744..b8c3db8723964 100644
--- a/flang/lib/Semantics/runtime-type-info.cpp
+++ b/flang/lib/Semantics/runtime-type-info.cpp
@@ -771,6 +771,8 @@ evaluate::StructureConstructor RuntimeTableBuilder::DescribeComponent(
   auto &foldingContext{context_.foldingContext()};
   auto typeAndShape{evaluate::characteristics::TypeAndShape::Characterize(
       symbol, foldingContext)};
+  bool isDevice{object.cudaDataAttr() &&
+      *object.cudaDataAttr() == common::CUDADataAttr::Device};
   CHECK(typeAndShape.has_value());
   auto dyType{typeAndShape->type()};
   int rank{typeAndShape->Rank()};
@@ -883,9 +885,19 @@ evaluate::StructureConstructor RuntimeTableBuilder::DescribeComponent(
   // Default component initialization
   bool hasDataInit{false};
   if (IsAllocatable(symbol)) {
-    AddValue(values, componentSchema_, "genre"s, GetEnumValue("allocatable"));
+    if (isDevice) {
+      AddValue(values, componentSchema_, "genre"s,
+          GetEnumValue("allocatabledevice"));
+    } else {
+      AddValue(values, componentSchema_, "genre"s, GetEnumValue("allocatable"));
+    }
   } else if (IsPointer(symbol)) {
-    AddValue(values, componentSchema_, "genre"s, GetEnumValue("pointer"));
+    if (isDevice) {
+      AddValue(
+          values, componentSchema_, "genre"s, GetEnumValue("pointerdevice"));
+    } else {
+      AddValue(values, componentSchema_, "genre"s, GetEnumValue("pointer"));
+    }
     hasDataInit = InitializeDataPointer(
         values, symbol, object, scope, dtScope, distinctName);
   } else if (IsAutomatic(symbol)) {
diff --git a/flang/module/__fortran_type_info.f90 b/flang/module/__fortran_type_info.f90
index 6af2a5a5e30ff..ae8eeef4a55e8 100644
--- a/flang/module/__fortran_type_info.f90
+++ b/flang/module/__fortran_type_info.f90
@@ -75,7 +75,7 @@
   end type
 
   enum, bind(c) ! Component::Genre
-    enumerator :: Data = 1, Pointer = 2, Allocatable = 3, Automatic = 4
+    enumerator :: Data = 1, Pointer = 2, Allocatable = 3, Automatic = 4, PointerDevice = 5, AllocatableDevice = 6
   end enum
 
   enum, bind(c) ! common::TypeCategory
diff --git a/flang/test/Lower/CUDA/cuda-allocatable-device.cuf b/flang/test/Lower/CUDA/cuda-allocatable-device.cuf
new file mode 100644
index 0000000000000..aed52e7f0f49d
--- /dev/null
+++ b/flang/test/Lower/CUDA/cuda-allocatable-device.cuf
@@ -0,0 +1,14 @@
+! RUN: bbc -emit-hlfir -fcuda %s -o - | FileCheck %s
+
+module m
+  type device_array
+    real(kind=8), allocatable, dimension(:), device :: ad
+    real(kind=8), pointer, dimension(:), device :: pd
+  end type
+
+  type(device_array), allocatable :: da(:)
+end module
+
+! CHECK-LABEL: fir.global linkonce_odr @_QMmE.c.device_array
+! CHECK: fir.insert_value %{{.*}}, %c6{{.*}}, ["genre"
+! CHECK: fir.insert_value %{{.*}}, %c5{{.*}}, ["genre"

vzakhari

Thank you, Valentin! LGTM!

flang-rt/include/flang-rt/runtime/descriptor.h

flang-rt/lib/runtime/type-info.cpp

flang/include/flang/Semantics/tools.h

The allocator index is set from the component genre #157731 . There is no more need of an operation to set it at a later point.

[flang] Add special genre for allocatable and pointer device component

b3af906

clementval requested review from jeanPerier, klausler, wangzpgi and vzakhari September 9, 2025 18:28

llvmbot added flang Flang issues not falling into any other category flang:fir-hlfir flang:semantics labels Sep 9, 2025

clementval mentioned this pull request Sep 9, 2025

[flang][cuda] Pass allocator index to allocate functions #157189

Closed

vzakhari reviewed Sep 9, 2025

View reviewed changes

klausler reviewed Sep 9, 2025

View reviewed changes

flang-rt/include/flang-rt/runtime/descriptor.h Outdated Show resolved Hide resolved

flang-rt/lib/runtime/type-info.cpp Outdated Show resolved Hide resolved

flang/include/flang/Semantics/tools.h Outdated Show resolved Hide resolved

clementval added 3 commits September 9, 2025 11:50

Fix fang-rt build

f29494e

Use int instead of unsigned

b4795ee

Apply suggestion

96d86c7

clementval merged commit d3c09c4 into llvm:main Sep 9, 2025
9 checks passed

clementval deleted the component_device branch September 9, 2025 20:12

clementval mentioned this pull request Sep 9, 2025

[flang][cuda] Remove set_allocator_idx operation #157747

Merged

clementval added a commit that referenced this pull request Sep 9, 2025

[flang][cuda] Remove set_allocator_idx operation (#157747)

3e98021

The allocator index is set from the component genre #157731 . There is no more need of an operation to set it at a later point.

Provide feedback

Saved searches

Use saved searches to filter your results more quickly

Uh oh!

[flang] Add special genre for allocatable and pointer device component #157731

[flang] Add special genre for allocatable and pointer device component #157731

Uh oh!

clementval commented Sep 9, 2025

Uh oh!

llvmbot commented Sep 9, 2025 •

edited

Loading

Uh oh!

vzakhari left a comment

Uh oh!

Uh oh!

Uh oh!

Uh oh!

Uh oh!

Uh oh!

[flang] Add special genre for allocatable and pointer device component #157731

[flang] Add special genre for allocatable and pointer device component #157731

Uh oh!

Conversation

clementval commented Sep 9, 2025

Uh oh!

llvmbot commented Sep 9, 2025 • edited Loading Uh oh! There was an error while loading. Please reload this page.

Uh oh!

Uh oh!

vzakhari left a comment

Choose a reason for hiding this comment

Uh oh!

Uh oh!

Uh oh!

Uh oh!

Uh oh!

Uh oh!

llvmbot commented Sep 9, 2025 •

edited

Loading