[flang] CUDA Fortran - part 2/5: symbols & scopes

[klausler]

Summary

Add representations of CUDA Fortran data and subprogram attributes
to the symbol table and scopes of semantics. Set them in name
resolution, and emit them to module files.

Depends on https://reviews.llvm.org/D150159.

[klausler]

Remove redundantly added tests.

[clementval]

LGTM

[wangzpgi]

flang/lib/Semantics/resolve-names.cpp

3526

Can launch_bounds take third argument of max cluster rank for Hopper?

3551

Can cluster_dim take variable argument such as "cluster_dim(x,y,z)", where x, y, and z are integer variables?

[wangzpgi]

flang/include/flang/Semantics/symbol.h

152

misspelling: LANCH_BOUNDS -> LAUNCH_BOUNDS

[klausler]

flang/lib/Semantics/resolve-names.cpp

3526

Not according to https://docs.nvidia.com/hpc-sdk/compilers/cuda-fortran-prog-guide/index.html#cfref-new-subs-func-attr which has "The form used in CUDA Fortran is:

attributes(global) launch_bounds(maxTPB, minBPM) subroutine sub(...)

where maxTPB is the maxThreadsPerBlock, the maximum number of threads per block with which the application will ever launch, and minBPM is the desired minimum number of resident blocks per multiprocessor. Both values must be numeric constants." in 3.1.2.

3551

No, not according to https://docs.nvidia.com/hpc-sdk/compilers/cuda-fortran-prog-guide/index.html#cfref-new-subs-func-attr , which has "Beginning with the 23.3 release, support for thread block clusters is enabled for Hopper (cc90) and later targets. To specify the dimensions of the cluster, use the cluster_dims syntax and specify each x, y, and z dimension. Values must be numeric constants." in 3.1.3.

[klausler]

Fix misspelling in comment.

[klausler]

Generate diff against part 1 rather than main (oops).

[wangzpgi]

flang/lib/Semantics/resolve-names.cpp

3551

It mentioned at the end of 3.1.2: "Also, as part of the Hopper support, the launch_bounds syntax has been extended to accept a third argument, an upper bound on the cluster size."

[klausler]

flang/lib/Semantics/resolve-names.cpp

3551

That's for LAUNCH_BOUNDS(), not CLUSTER_DIMS().

[klausler]

Allow third parameter to LAUNCH_BOUNDS().

[klausler]

Upload correct diff (sorry).

[wangzpgi]

flang/lib/Semantics/resolve-names.cpp

3551

Yes, allowing third argument was for launch_bounds, not cluster_dims, I commented at the wrong place. Not quite sure how this Phabricator review works.

For cluster_dims as well as launch_bounds, Brent has requested to take maybe const expressions. He would like to use module parameters, for global routines that are in that module. Neither Michael nor I implemented that in nvfortran.

[wangzpgi]

Is there checks for CUDA Version that some features are allowed for certain CUDA Version?

[klausler]

In D150161#4331054, @wangzpgi wrote:

Is there checks for CUDA Version that some features are allowed for certain CUDA Version?

Not yet.

flang/lib/Semantics/resolve-names.cpp

3551

That's what I implemented -- any expression that can be folded to a constant value at compilation time will work. They don't have to integer literals.

[wangzpgi]

flang/lib/Semantics/resolve-names.cpp

3551

Great. Thanks.

[klausler]

Rebase to current head.

[klausler]

Rebasing to current head in preparation for merging.

flang/include/flang/Semantics/scope.h

ENUM_CLASS(Kind, Global, IntrinsicModules, Module, MainProgram, Subprogram,
       BlockData, DerivedType, BlockConstruct, Forall, OtherConstruct,
       ImpliedDos)
   using ImportKind = common::ImportKind;
 
   // Create the Global scope -- the root of the scope tree
   explicit Scope(SemanticsContext &context)
       : Scope{*this, Kind::Global, nullptr, context} {}
   Scope(Scope &parent, Kind kind, Symbol *symbol, SemanticsContext &context)
-      : parent_{parent}, kind_{kind}, symbol_{symbol}, context_{context} {
+      : parent_{&parent}, kind_{kind}, symbol_{symbol}, context_{context} {
     if (symbol) {
       symbol->set_scope(this);
     }
   }
   Scope(const Scope &) = delete;
 
   bool operator==(const Scope &that) const { return this == &that; }
   bool operator!=(const Scope &that) const { return this != &that; }
 
   Scope &parent() {
-    CHECK(&parent_ != this);
-    return parent_;
+    CHECK(parent_ != this);
+    return *parent_;
   }
   const Scope &parent() const {
-    CHECK(&parent_ != this);
-    return parent_;
+    CHECK(parent_ != this);
+    return *parent_;
   }
   Kind kind() const { return kind_; }
   bool IsGlobal() const { return kind_ == Kind::Global; }
   bool IsIntrinsicModules() const { return kind_ == Kind::IntrinsicModules; }
   bool IsTopLevel() const {
     return kind_ == Kind::Global || kind_ == Kind::IntrinsicModules;
   }
   bool IsModule() const {
public:
   inline const Symbol *GetSymbol() const;
   const Scope *GetDerivedTypeParent() const;
   const Scope &GetDerivedTypeBase() const;
   inline std::optional<SourceName> GetName() const;
   // Returns true if this scope contains, or is, another scope.
   bool Contains(const Scope &) const;
   /// Make a scope nested in this one
   Scope &MakeScope(Kind kind, Symbol *symbol = nullptr);
+
   SemanticsContext &GetMutableSemanticsContext() const {
     return const_cast<SemanticsContext &>(context());
   }
 
   using size_type = mapType::size_type;
   using iterator = mapType::iterator;
   using const_iterator = mapType::const_iterator;
 
public:
   const Symbol *runtimeDerivedTypeDescription() const {
     return runtimeDerivedTypeDescription_;
   }
   void set_runtimeDerivedTypeDescription(const Symbol &symbol) {
     runtimeDerivedTypeDescription_ = &symbol;
   }
 
 private:
-  Scope &parent_; // this is enclosing scope, not extended derived type base
+  Scope *parent_{
+      nullptr}; // this is enclosing scope, not extended derived type base
   const Kind kind_;
   std::size_t size_{0}; // size in bytes
   std::optional<std::size_t> alignment_; // required alignment in bytes
   parser::CharBlock sourceRange_;
   const parser::CookedSource *cookedSource_{nullptr};
   Symbol *const symbol_; // if not null, symbol_->scope() == this
   std::list<Scope> children_;
   mapType symbols_;

flang/include/flang/Semantics/semantics.h

public:
   static bool IsTempName(const std::string &);
 
   // Locate and process the contents of a built-in module on demand
   Scope *GetBuiltinModule(const char *name);
 
   // Defines builtinsScope_ from the __Fortran_builtins module
   void UseFortranBuiltinsModule();
   const Scope *GetBuiltinsScope() const { return builtinsScope_; }
-
   void UsePPCFortranBuiltinTypesModule();
+  const Scope *GetCUDABuiltinsScope();
   void UsePPCFortranBuiltinsModule();
   Scope *GetPPCBuiltinTypesScope() { return ppcBuiltinTypesScope_; }
   const Scope *GetPPCBuiltinsScope() const { return ppcBuiltinsScope_; }
 
   // Saves a module file's parse tree so that it remains available
   // during semantics.
   parser::Program &SaveParseTree(parser::Program &&);
 
public:
   CommonBlockList GetCommonBlocks() const;
 
 private:
   void CheckIndexVarRedefine(
       const parser::CharBlock &, const Symbol &, parser::MessageFixedText &&);
   void CheckError(const Symbol &);
 
   const common::IntrinsicTypeDefaultKinds &defaultKinds_;
-  const common::LanguageFeatureControl languageFeatures_;
+  const common::LanguageFeatureControl &languageFeatures_;
   parser::AllCookedSources &allCookedSources_;
   std::optional<parser::CharBlock> location_;
   std::vector<std::string> searchDirectories_;
   std::vector<std::string> intrinsicModuleDirectories_;
   std::string moduleDirectory_{"."s};
   std::string moduleFileSuffix_{".mod"};
   bool warnOnNonstandardUsage_{false};
   bool warningsAreErrors_{false};
struct IndexVarInfo {
     IndexVarKind kind;
   };
   std::map<SymbolRef, const IndexVarInfo, SymbolAddressCompare>
       activeIndexVars_;
   UnorderedSymbolSet errorSymbols_;
   std::set<std::string> tempNames_;
   const Scope *builtinsScope_{nullptr}; // module __Fortran_builtins
   Scope *ppcBuiltinTypesScope_{nullptr}; // module __Fortran_PPC_types
+  std::optional<const Scope *> CUDABuiltinsScope_; // module __CUDA_builtins
   const Scope *ppcBuiltinsScope_{nullptr}; // module __Fortran_PPC_intrinsics
   std::list<parser::Program> modFileParseTrees_;
   std::unique_ptr<CommonBlockMap> commonBlockMap_;
   bool anyDefinedIntrinsicOperator_{false};
 };
 
 class Semantics {
 public:

flang/include/flang/Semantics/symbol.h

public:
   const Symbol *moduleInterface() const { return moduleInterface_; }
   void set_moduleInterface(Symbol &);
   void ReplaceResult(Symbol &result) {
     CHECK(result_ != nullptr);
     result_ = &result;
   }
   bool defaultIgnoreTKR() const { return defaultIgnoreTKR_; }
   void set_defaultIgnoreTKR(bool yes) { defaultIgnoreTKR_ = yes; }
+  std::optional<common::CUDASubprogramAttrs> cudaSubprogramAttrs() const {
+    return cudaSubprogramAttrs_;
+  }
+  void set_cudaSubprogramAttrs(common::CUDASubprogramAttrs csas) {
+    cudaSubprogramAttrs_ = csas;
+  }
+  std::vector<std::int64_t> &cudaLaunchBounds() { return cudaLaunchBounds_; }
+  const std::vector<std::int64_t> &cudaLaunchBounds() const {
+    return cudaLaunchBounds_;
+  }
+  void set_cudaLaunchBounds(std::vector<std::int64_t> &&x) {
+    cudaLaunchBounds_ = std::move(x);
+  }
+  std::vector<std::int64_t> &cudaClusterDims() { return cudaClusterDims_; }
+  const std::vector<std::int64_t> &cudaClusterDims() const {
+    return cudaClusterDims_;
+  }
+  void set_cudaClusterDims(std::vector<std::int64_t> &&x) {
+    cudaClusterDims_ = std::move(x);
+  }
 
 private:
   bool isInterface_{false}; // true if this represents an interface-body
   bool isDummy_{false}; // true when interface of dummy procedure
   std::vector<Symbol *> dummyArgs_; // nullptr -> alternate return indicator
   Symbol *result_{nullptr};
   Scope *entryScope_{nullptr}; // if ENTRY, points to subprogram's scope
   MaybeExpr stmtFunction_;
   // For MODULE FUNCTION or SUBROUTINE, this is the symbol of its declared
   // interface.  For MODULE PROCEDURE, this is the declared interface if it
   // appeared in an ancestor (sub)module.
   Symbol *moduleInterface_{nullptr};
   bool defaultIgnoreTKR_{false};
+  // CUDA ATTRIBUTES(...) from subroutine/function prefix
+  std::optional<common::CUDASubprogramAttrs> cudaSubprogramAttrs_;
+  // CUDA LAUNCH_BOUNDS(...) & CLUSTER_DIMS(...) from prefix
+  std::vector<std::int64_t> cudaLaunchBounds_, cudaClusterDims_;
 
   friend llvm::raw_ostream &operator<<(
       llvm::raw_ostream &, const SubprogramDetails &);
 };
 
 // For SubprogramNameDetails, the kind indicates whether it is the name
 // of a module subprogram or an internal subprogram or ENTRY.
 ENUM_CLASS(SubprogramKind, Module, Internal)
public:
   bool IsArray() const { return !shape_.empty(); }
   bool IsCoarray() const { return !coshape_.empty(); }
   bool CanBeAssumedShape() const {
     return isDummy() && shape_.CanBeAssumedShape();
   }
   bool CanBeDeferredShape() const { return shape_.CanBeDeferredShape(); }
   bool IsAssumedSize() const { return isDummy() && shape_.CanBeAssumedSize(); }
   bool IsAssumedRank() const { return isDummy() && shape_.IsAssumedRank(); }
+  std::optional<common::CUDADataAttr> cudaDataAttr() const {
+    return cudaDataAttr_;
+  }
+  void set_cudaDataAttr(std::optional<common::CUDADataAttr> attr) {
+    cudaDataAttr_ = attr;
+  }
 
 private:
   MaybeExpr init_;
   const parser::Expr *unanalyzedPDTComponentInit_{nullptr};
   ArraySpec shape_;
   ArraySpec coshape_;
   common::IgnoreTKRSet ignoreTKR_;
   const Symbol *commonBlock_{nullptr}; // common block this object is in
+  std::optional<common::CUDADataAttr> cudaDataAttr_;
   friend llvm::raw_ostream &operator<<(
       llvm::raw_ostream &, const ObjectEntityDetails &);
 };
 
 // Mixin for details with passed-object dummy argument.
 // If a procedure pointer component or type-bound procedure does not have
 // the NOPASS attribute on its symbol, then PASS is assumed; the name
 // is optional; if it is missing, the first dummy argument of the procedure's
public:
   bool IsInterfaceSet() { return procInterface_ || type(); }
   inline bool HasExplicitInterface() const;
 
   // Be advised: !init().has_value() => uninitialized pointer,
   // while *init() == nullptr => explicit NULL() initialization.
   std::optional<const Symbol *> init() const { return init_; }
   void set_init(const Symbol &symbol) { init_ = &symbol; }
   void set_init(std::nullptr_t) { init_ = nullptr; }
+  bool isCUDAKernel() const { return isCUDAKernel_; }
+  void set_isCUDAKernel(bool yes = true) { isCUDAKernel_ = yes; }
 
 private:
   const Symbol *procInterface_{nullptr};
   std::optional<const Symbol *> init_;
+  bool isCUDAKernel_{false};
   friend llvm::raw_ostream &operator<<(
       llvm::raw_ostream &, const ProcEntityDetails &);
 };
 
 // These derived type details represent the characteristics of a derived
 // type definition that are shared by all instantiations of that type.
 // The DerivedTypeSpec instances whose type symbols share these details
 // each own a scope into which the components' symbols have been cloned

flang/include/flang/Semantics/tools.h

 bool IsExternal(const Symbol &);
 bool IsModuleProcedure(const Symbol &);
 bool HasCoarray(const parser::Expr &);
 bool IsAssumedType(const Symbol &);
 bool IsPolymorphic(const Symbol &);
 bool IsUnlimitedPolymorphic(const Symbol &);
 bool IsPolymorphicAllocatable(const Symbol &);
 
+inline bool IsCUDADeviceContext(const Scope *scope) {
+  if (scope) {
+    if (const Symbol * symbol{scope->symbol()}) {
+      if (const auto *subp{symbol->detailsIf<SubprogramDetails>()}) {
+        if (auto attrs{subp->cudaSubprogramAttrs()}) {
+          return *attrs != common::CUDASubprogramAttrs::Host;
+        }
+      }
+    }
+  }
+  return false;
+}
+
+const Scope *FindCUDADeviceContext(const Scope *);
+std::optional<common::CUDADataAttr> GetCUDADataAttr(const Symbol *);
+
 // Return an error if a symbol is not accessible from a scope
 std::optional<parser::MessageFormattedText> CheckAccessibleSymbol(
     const semantics::Scope &, const Symbol &);
 
 // Analysis of image control statements
 bool IsImageControlStmt(const parser::ExecutableConstruct &);
 // Get the location of the image control statement in this ExecutableConstruct
 parser::CharBlock GetImageControlStmtLocation(

 //   - Direct components of a derived type are all of its components, and all
 //     of the direct components of its non-ALLOCATABLE non-POINTER derived type
 //     components.  (Direct components are always present.)
 //   - Potential subobject components of a derived type are the closure of
 //     its non-POINTER components and the potential subobject components of
 //     its non-POINTER derived type components.  (The lifetime of each
 //     potential subobject component is that of the entire instance.)
 //   - PotentialAndPointer subobject components of a derived type are the
-//   closure of
-//     its components (including POINTERs) and the PotentialAndPointer subobject
-//     components of its non-POINTER derived type components.
+//     closure of its components (including POINTERs) and the
+//     PotentialAndPointer subobject components of its non-POINTER derived type
+//     components.
 // Parent and procedure components are considered against these definitions.
 // For this kind of iterator, the component tree is recursively visited in the
 // following order:
 //  - the parent component first (if relevant)
 //  - then, the components of the parent type (if relevant)
 //      + visiting the component and then, if it is derived type data component,
 //        visiting the subcomponents before visiting the next
 //        component in declaration order.

flang/lib/Semantics/mod-file.cpp

if (!ss.str().empty()) {
     decls_ << ss.str().substr(1) << "::" << symbol.name() << '\n';
   }
   bool isInterface{details.isInterface()};
   llvm::raw_ostream &os{isInterface ? decls_ : contains_};
   if (isInterface) {
     os << (isAbstract ? "abstract " : "") << "interface\n";
   }
   PutAttrs(os, prefixAttrs, nullptr, false, ""s, " "s);
+  if (auto attrs{details.cudaSubprogramAttrs()}) {
+    if (*attrs == common::CUDASubprogramAttrs::HostDevice) {
+      os << "attributes(host,device) ";
+    } else {
+      PutLower(os << "attributes(", common::EnumToString(*attrs)) << ") ";
+    }
+    if (!details.cudaLaunchBounds().empty()) {
+      os << "launch_bounds";
+      char sep{'('};
+      for (auto x : details.cudaLaunchBounds()) {
+        os << sep << x;
+        sep = ',';
+      }
+      os << ") ";
+    }
+    if (!details.cudaClusterDims().empty()) {
+      os << "cluster_dims";
+      char sep{'('};
+      for (auto x : details.cudaClusterDims()) {
+        os << sep << x;
+        sep = ',';
+      }
+      os << ") ";
+    }
+  }
   os << (details.isFunction() ? "function " : "subroutine ");
   os << symbol.name() << '(';
   int n = 0;
   for (const auto &dummy : details.dummyArgs()) {
     if (n++ > 0) {
       os << ',';
     }
     if (dummy) {
tkr.IterateOverMembers([&](common::IgnoreTKR tkr) {
         break;
       case common::IgnoreTKR::Contiguous:
         os << 'c';
         break;
       }
     });
     os << ") " << symbol.name() << '\n';
   }
+  if (auto attr{details.cudaDataAttr()}) {
+    PutLower(os << "attributes(", common::EnumToString(*attr))
+        << ") " << symbol.name() << '\n';
+  }
 }
 
 void ModFileWriter::PutProcEntity(llvm::raw_ostream &os, const Symbol &symbol) {
   if (symbol.attrs().test(Attr::INTRINSIC)) {
     os << "intrinsic::" << symbol.name() << '\n';
     if (!isSubmodule_ && symbol.attrs().test(Attr::PRIVATE)) {
       os << "private::" << symbol.name() << '\n';
     }
if (!isIntrinsic.value_or(false) && !ancestor) {
     }
   }
   auto path{ModFileName(name, ancestorName, context_.moduleFileSuffix())};
   parser::Parsing parsing{context_.allCookedSources()};
   parser::Options options;
   options.isModuleFile = true;
   options.features.Enable(common::LanguageFeature::BackslashEscapes);
   options.features.Enable(common::LanguageFeature::OpenMP);
+  options.features.Enable(common::LanguageFeature::CUDA);
   if (!isIntrinsic.value_or(false) && !notAModule) {
     // The search for this module file will scan non-intrinsic module
     // directories.  If a directory is in both the intrinsic and non-intrinsic
     // directory lists, the intrinsic module directory takes precedence.
     options.searchDirectories = context_.searchDirectories();
     for (const auto &dir : context_.intrinsicModuleDirectories()) {
       options.searchDirectories.erase(
           std::remove(options.searchDirectories.begin(),

flang/lib/Semantics/resolve-names.cpp

private:
   MessageHandler messageHandler_;
 };
 
 // Provide Post methods to collect attributes into a member variable.
 class AttrsVisitor : public virtual BaseVisitor {
 public:
   bool BeginAttrs(); // always returns true
   Attrs GetAttrs();
+  std::optional<common::CUDADataAttr> cudaDataAttr() { return cudaDataAttr_; }
   Attrs EndAttrs();
   bool SetPassNameOn(Symbol &);
   void SetBindNameOn(Symbol &);
   void Post(const parser::LanguageBindingSpec &);
   bool Pre(const parser::IntentSpec &);
   bool Pre(const parser::Pass &);
 
   bool CheckAndSet(Attr);
#define HANDLE_ATTR_CLASS(CLASSNAME, ATTRNAME) \
   HANDLE_ATTR_CLASS(Parameter, PARAMETER)
   HANDLE_ATTR_CLASS(Pointer, POINTER)
   HANDLE_ATTR_CLASS(Protected, PROTECTED)
   HANDLE_ATTR_CLASS(Save, SAVE)
   HANDLE_ATTR_CLASS(Target, TARGET)
   HANDLE_ATTR_CLASS(Value, VALUE)
   HANDLE_ATTR_CLASS(Volatile, VOLATILE)
 #undef HANDLE_ATTR_CLASS
+  bool Pre(const common::CUDADataAttr);
 
 protected:
   std::optional<Attrs> attrs_;
+  std::optional<common::CUDADataAttr> cudaDataAttr_;
 
   Attr AccessSpecToAttr(const parser::AccessSpec &x) {
     switch (x.v) {
     case parser::AccessSpec::Kind::Public:
       return Attr::PUBLIC;
     case parser::AccessSpec::Kind::Private:
       return Attr::PRIVATE;
     }
private:
   std::optional<SourceName> prevImplicitNone_;
   std::optional<SourceName> prevImplicitNoneType_;
   std::optional<SourceName> prevParameterStmt_;
 
   bool HandleImplicitNone(const std::list<ImplicitNoneNameSpec> &nameSpecs);
 };
 
 // Track array specifications. They can occur in AttrSpec, EntityDecl,
-// ObjectDecl, DimensionStmt, CommonBlockObject, or BasedPointerStmt.
+// ObjectDecl, DimensionStmt, CommonBlockObject, BasedPointerStmt, and
+// ComponentDecl.
 // 1. INTEGER, DIMENSION(10) :: x
 // 2. INTEGER :: x(10)
 // 3. ALLOCATABLE :: x(:)
 // 4. DIMENSION :: x(10)
 // 5. COMMON x(10)
 // 6. BasedPointerStmt
 class ArraySpecVisitor : public virtual BaseVisitor {
 public:
public:
   void SetExplicitAttrs(Symbol &symbol, Attrs attrs) const {
     symbol.attrs() |= attrs;
     symbol.implicitAttrs() &= ~attrs;
   }
   void SetImplicitAttr(Symbol &symbol, Attr attr) const {
     symbol.attrs().set(attr);
     symbol.implicitAttrs().set(attr);
   }
+  void SetCUDADataAttr(
+      SourceName, Symbol &, std::optional<common::CUDADataAttr>);
 
 protected:
   FuncResultStack &funcResultStack() { return funcResultStack_; }
 
   // Apply the implicit type rules to this symbol.
   void ApplyImplicitRules(Symbol &, bool allowForwardReference = false);
   bool ImplicitlyTypeForwardRef(Symbol &);
   void AcquireIntrinsicProcedureFlags(Symbol &);
public:
   bool Pre(const parser::EntryStmt &);
   void Post(const parser::EntryStmt &);
   bool Pre(const parser::InterfaceBody::Subroutine &);
   void Post(const parser::InterfaceBody::Subroutine &);
   bool Pre(const parser::InterfaceBody::Function &);
   void Post(const parser::InterfaceBody::Function &);
   bool Pre(const parser::Suffix &);
   bool Pre(const parser::PrefixSpec &);
+  bool Pre(const parser::PrefixSpec::Attributes &);
+  void Post(const parser::PrefixSpec::Launch_Bounds &);
+  void Post(const parser::PrefixSpec::Cluster_Dims &);
 
   bool BeginSubprogram(const parser::Name &, Symbol::Flag,
       bool hasModulePrefix = false,
       const parser::LanguageBindingSpec * = nullptr,
       const ProgramTree::EntryStmtList * = nullptr);
   bool BeginMpSubprogram(const parser::Name &);
   void PushBlockDataScope(const parser::Name &);
   void EndSubprogram(std::optional<parser::CharBlock> stmtSource = std::nullopt,
bool Pre(const parser::AllocatableStmt &) {
     objectDeclAttr_ = Attr::ALLOCATABLE;
     return true;
   }
   void Post(const parser::AllocatableStmt &) { objectDeclAttr_ = std::nullopt; }
   bool Pre(const parser::TargetStmt &) {
     objectDeclAttr_ = Attr::TARGET;
     return true;
   }
+  bool Pre(const parser::CUDAAttributesStmt &);
   void Post(const parser::TargetStmt &) { objectDeclAttr_ = std::nullopt; }
   void Post(const parser::DimensionStmt::Declaration &);
   void Post(const parser::CodimensionDecl &);
   bool Pre(const parser::TypeDeclarationStmt &) { return BeginDecl(); }
   void Post(const parser::TypeDeclarationStmt &);
   void Post(const parser::IntegerTypeSpec &);
   void Post(const parser::IntrinsicTypeSpec::Real &);
   void Post(const parser::IntrinsicTypeSpec::Complex &);
public:
   }
   bool Pre(const parser::Submodule &) {
     llvm_unreachable("This node is handled in ProgramUnit");
   }
   bool Pre(const parser::BlockData &) {
     llvm_unreachable("This node is handled in ProgramUnit");
   }
 
-  void NoteExecutablePartCall(Symbol::Flag, const parser::Call &);
+  void NoteExecutablePartCall(
+      Symbol::Flag, const parser::Call &, bool hasCUDAChevrons);
 
   friend void ResolveSpecificationParts(SemanticsContext &, const Symbol &);
 
 private:
   // Kind of procedure we are expecting to see in a ProcedureDesignator
   std::optional<Symbol::Flag> expectedProcFlag_;
   std::optional<SourceName> prevImportStmt_;
   Scope &topScope_;
private:
   bool SetProcFlag(const parser::Name &, Symbol &, Symbol::Flag);
   void ResolveSpecificationParts(ProgramTree &);
   void AddSubpNames(ProgramTree &);
   bool BeginScopeForNode(const ProgramTree &);
   void EndScopeForNode(const ProgramTree &);
   void FinishSpecificationParts(const ProgramTree &);
   void FinishDerivedTypeInstantiation(Scope &);
   void ResolveExecutionParts(const ProgramTree &);
+  void UseCUDABuiltinNames();
 };
 
 // ImplicitRules implementation
 
 bool ImplicitRules::isImplicitNoneType() const {
   if (isImplicitNoneType_) {
     return true;
   } else if (map_.empty() && inheritFromParent_) {
if (!name.symbol) {
     name.symbol = &context_->globalScope().MakeSymbol(
         name.source, Attrs{}, MiscDetails{kind});
   }
 }
 
 // AttrsVisitor implementation
 
 bool AttrsVisitor::BeginAttrs() {
-  CHECK(!attrs_);
-  attrs_ = std::make_optional<Attrs>();
+  CHECK(!attrs_ && !cudaDataAttr_);
+  attrs_ = Attrs{};
   return true;
 }
 Attrs AttrsVisitor::GetAttrs() {
   CHECK(attrs_);
   return *attrs_;
 }
 Attrs AttrsVisitor::EndAttrs() {
   Attrs result{GetAttrs()};
   attrs_.reset();
+  cudaDataAttr_.reset();
   passName_ = std::nullopt;
   bindName_.reset();
   return result;
 }
 
 bool AttrsVisitor::SetPassNameOn(Symbol &symbol) {
   if (!passName_) {
     return false;

 bool AttrsVisitor::CheckAndSet(Attr attrName) {
   CHECK(attrs_);
   if (IsConflictingAttr(attrName) || IsDuplicateAttr(attrName)) {
     return false;
   }
   attrs_->set(attrName);
   return true;
 }
+bool AttrsVisitor::Pre(const common::CUDADataAttr x) {
+  if (cudaDataAttr_.value_or(x) != x) {
+    Say(currStmtSource().value(),
+        "CUDA data attributes '%s' and '%s' may not both be specified"_err_en_US,
+        common::EnumToString(*cudaDataAttr_), common::EnumToString(x));
+  }
+  cudaDataAttr_ = x;
+  return false;
+}
 
 // DeclTypeSpecVisitor implementation
 
 const DeclTypeSpec *DeclTypeSpecVisitor::GetDeclTypeSpec() {
   return state_.declTypeSpec;
 }
 
 void DeclTypeSpecVisitor::BeginDeclTypeSpec() {

 bool ScopeHandler::CheckDuplicatedAttrs(
     SourceName name, const Symbol &symbol, Attrs attrs) {
   bool ok{true};
   attrs.IterateOverMembers(
       [&](Attr x) { ok &= CheckDuplicatedAttr(name, symbol, x); });
   return ok;
 }
 
+void ScopeHandler::SetCUDADataAttr(SourceName source, Symbol &symbol,
+    std::optional<common::CUDADataAttr> attr) {
+  if (attr) {
+    ConvertToObjectEntity(symbol);
+    if (auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
+      if (*attr != object->cudaDataAttr().value_or(*attr)) {
+        Say(source,
+            "'%s' already has another CUDA data attribute ('%s')"_err_en_US,
+            symbol.name(),
+            common::EnumToString(*object->cudaDataAttr()).substr());
+      } else {
+        object->set_cudaDataAttr(attr);
+      }
+    } else {
+      Say(source,
+          "'%s' is not an object and may not have a CUDA data attribute"_err_en_US,
+          symbol.name());
+    }
+  }
+}
+
 // ModuleVisitor implementation
 
 bool ModuleVisitor::Pre(const parser::Only &x) {
   common::visit(common::visitors{
                     [&](const Indirection<parser::GenericSpec> &generic) {
                       GenericSpecInfo genericSpecInfo{generic.value()};
                       AddUseOnly(genericSpecInfo.symbolName());
                       AddUse(genericSpecInfo);

 
 bool SubprogramVisitor::Pre(const parser::PrefixSpec &x) {
   // Save this to process after UseStmt and ImplicitPart
   if (const auto *parsedType{std::get_if<parser::DeclarationTypeSpec>(&x.u)}) {
     FuncResultStack::FuncInfo &info{DEREF(funcResultStack().Top())};
     if (info.parsedType) { // C1543
       Say(currStmtSource().value(),
           "FUNCTION prefix cannot specify the type more than once"_err_en_US);
-      return false;
     } else {
       info.parsedType = parsedType;
       info.source = currStmtSource();
-      return false;
     }
+    return false;
   } else {
     return true;
   }
 }
 
+bool SubprogramVisitor::Pre(const parser::PrefixSpec::Attributes &attrs) {
+  if (auto *subp{currScope().symbol()
+              ? currScope().symbol()->detailsIf<SubprogramDetails>()
+              : nullptr}) {
+    for (auto attr : attrs.v) {
+      if (auto current{subp->cudaSubprogramAttrs()}) {
+        if (attr == *current ||
+            (*current == common::CUDASubprogramAttrs::HostDevice &&
+                (attr == common::CUDASubprogramAttrs::Host ||
+                    attr == common::CUDASubprogramAttrs::Device))) {
+          Say(currStmtSource().value(),
+              "ATTRIBUTES(%s) appears more than once"_warn_en_US,
+              common::EnumToString(attr));
+        } else if ((attr == common::CUDASubprogramAttrs::Host ||
+                       attr == common::CUDASubprogramAttrs::Device) &&
+            (*current == common::CUDASubprogramAttrs::Host ||
+                *current == common::CUDASubprogramAttrs::Device ||
+                *current == common::CUDASubprogramAttrs::HostDevice)) {
+          // HOST,DEVICE or DEVICE,HOST -> HostDevice
+          subp->set_cudaSubprogramAttrs(
+              common::CUDASubprogramAttrs::HostDevice);
+        } else {
+          Say(currStmtSource().value(),
+              "ATTRIBUTES(%s) conflicts with earlier ATTRIBUTES(%s)"_err_en_US,
+              common::EnumToString(attr), common::EnumToString(*current));
+        }
+      } else {
+        subp->set_cudaSubprogramAttrs(attr);
+      }
+    }
+  }
+  return false;
+}
+
+void SubprogramVisitor::Post(const parser::PrefixSpec::Launch_Bounds &x) {
+  std::vector<std::int64_t> bounds;
+  bool ok{true};
+  for (const auto &sicx : x.v) {
+    if (auto value{evaluate::ToInt64(EvaluateExpr(sicx))}) {
+      bounds.push_back(*value);
+    } else {
+      ok = false;
+    }
+  }
+  if (!ok || bounds.size() < 2 || bounds.size() > 3) {
+    Say(currStmtSource().value(),
+        "Operands of LAUNCH_BOUNDS() must be 2 or 3 integer constants"_err_en_US);
+  } else if (auto *subp{currScope().symbol()
+                     ? currScope().symbol()->detailsIf<SubprogramDetails>()
+                     : nullptr}) {
+    if (subp->cudaLaunchBounds().empty()) {
+      subp->set_cudaLaunchBounds(std::move(bounds));
+    } else {
+      Say(currStmtSource().value(),
+          "LAUNCH_BOUNDS() may only appear once"_err_en_US);
+    }
+  }
+}
+
+void SubprogramVisitor::Post(const parser::PrefixSpec::Cluster_Dims &x) {
+  std::vector<std::int64_t> dims;
+  bool ok{true};
+  for (const auto &sicx : x.v) {
+    if (auto value{evaluate::ToInt64(EvaluateExpr(sicx))}) {
+      dims.push_back(*value);
+    } else {
+      ok = false;
+    }
+  }
+  if (!ok || dims.size() != 3) {
+    Say(currStmtSource().value(),
+        "Operands of CLUSTER_DIMS() must be three integer constants"_err_en_US);
+  } else if (auto *subp{currScope().symbol()
+                     ? currScope().symbol()->detailsIf<SubprogramDetails>()
+                     : nullptr}) {
+    if (subp->cudaClusterDims().empty()) {
+      subp->set_cudaClusterDims(std::move(dims));
+    } else {
+      Say(currStmtSource().value(),
+          "CLUSTER_DIMS() may only appear once"_err_en_US);
+    }
+  }
+}
+
 bool SubprogramVisitor::Pre(const parser::InterfaceBody::Subroutine &x) {
   const auto &name{std::get<parser::Name>(
       std::get<parser::Statement<parser::SubroutineStmt>>(x.t).statement.t)};
   return BeginSubprogram(name, Symbol::Flag::Subroutine);
 }
 void SubprogramVisitor::Post(const parser::InterfaceBody::Subroutine &x) {
   const auto &stmt{std::get<parser::Statement<parser::SubroutineStmt>>(x.t)};
   EndSubprogram(stmt.source,
if (context().HasError(entrySymbol)) {
     return;
   }
   if (!entrySymbol.has<SubprogramDetails>()) {
     SayAlreadyDeclared(name, entrySymbol);
     return;
   }
   SubprogramDetails &entryDetails{entrySymbol.get<SubprogramDetails>()};
   CHECK(entryDetails.entryScope() == &inclusiveScope);
+  SetCUDADataAttr(name.source, entrySymbol, cudaDataAttr());
   entrySymbol.attrs() |= GetAttrs();
   SetBindNameOn(entrySymbol);
   for (const auto &dummyArg : std::get<std::list<parser::DummyArg>>(stmt.t)) {
     if (const auto *dummyName{std::get_if<parser::Name>(&dummyArg.u)}) {
       if (Symbol * dummy{FindInScope(*dummyName)}) {
         if (dummy->test(Symbol::Flag::EntryDummyArgument)) {
           const auto *subp{dummy->detailsIf<SubprogramDetails>()};
           if (subp && subp->isInterface()) { // ok
bool DeclarationVisitor::Pre(const parser::Initialization &) {
   return false;
 }
 
 void DeclarationVisitor::Post(const parser::EntityDecl &x) {
   const auto &name{std::get<parser::ObjectName>(x.t)};
   Attrs attrs{attrs_ ? HandleSaveName(name.source, *attrs_) : Attrs{}};
   Symbol &symbol{DeclareUnknownEntity(name, attrs)};
   symbol.ReplaceName(name.source);
+  SetCUDADataAttr(name.source, symbol, cudaDataAttr());
   if (const auto &init{std::get<std::optional<parser::Initialization>>(x.t)}) {
     ConvertToObjectEntity(symbol) || ConvertToProcEntity(symbol);
     symbol.set(
         Symbol::Flag::EntryDummyArgument, false); // forestall excessive errors
     Initialization(name, *init, false);
   } else if (attrs.test(Attr::PARAMETER)) { // C882, C883
     Say(name, "Missing initialization for parameter '%s'"_err_en_US);
   }

 }
 bool DeclarationVisitor::Pre(const parser::ValueStmt &x) {
   return CheckNotInBlock("VALUE") && // C1107
       HandleAttributeStmt(Attr::VALUE, x.v);
 }
 bool DeclarationVisitor::Pre(const parser::VolatileStmt &x) {
   return HandleAttributeStmt(Attr::VOLATILE, x.v);
 }
+bool DeclarationVisitor::Pre(const parser::CUDAAttributesStmt &x) {
+  auto attr{std::get<common::CUDADataAttr>(x.t)};
+  for (const auto &name : std::get<std::list<parser::Name>>(x.t)) {
+    auto *symbol{FindInScope(name)};
+    if (symbol && symbol->has<UseDetails>()) {
+      Say(currStmtSource().value(),
+          "Cannot apply CUDA data attribute to use-associated '%s'"_err_en_US,
+          name.source);
+    } else {
+      if (!symbol) {
+        symbol = &MakeSymbol(name, ObjectEntityDetails{});
+      }
+      SetCUDADataAttr(name.source, *symbol, attr);
+    }
+  }
+  return false;
+}
 // Handle a statement that sets an attribute on a list of names.
 bool DeclarationVisitor::HandleAttributeStmt(
     Attr attr, const std::list<parser::Name> &names) {
   for (const auto &name : names) {
     HandleAttributeStmt(attr, name);
   }
   return false;
 }
if (const auto *derived{declType->AsDerived()}) {
                 derived->typeSymbol());
           }
         }
       }
     }
   }
   if (OkToAddComponent(name)) {
     auto &symbol{DeclareObjectEntity(name, attrs)};
+    SetCUDADataAttr(name.source, symbol, cudaDataAttr());
     if (symbol.has<ObjectEntityDetails>()) {
       if (auto &init{std::get<std::optional<parser::Initialization>>(x.t)}) {
         Initialization(name, *init, true);
       }
     }
     currScope().symbol()->get<DerivedTypeDetails>().add_component(symbol);
   }
   ClearArraySpec();
void DeclarationVisitor::Post(const parser::ProcDecl &x) {
   DerivedTypeDetails *dtDetails{nullptr};
   if (Symbol * symbol{currScope().symbol()}) {
     dtDetails = symbol->detailsIf<DerivedTypeDetails>();
   }
   if (!dtDetails) {
     attrs.set(Attr::EXTERNAL);
   }
   Symbol &symbol{DeclareProcEntity(name, attrs, procInterface)};
+  SetCUDADataAttr(name.source, symbol, cudaDataAttr()); // for error
   symbol.ReplaceName(name.source);
   if (dtDetails) {
     dtDetails->add_component(symbol);
   }
 }
 
 bool DeclarationVisitor::Pre(const parser::TypeBoundProcedurePart &) {
   derivedTypeInfo_.sawContains = true;
if (auto *symbol{FindInScope(derivedType, name)}) { // C742
     auto attrs{GetAttrs()};
     // Apply binding-private-stmt if present and this is a procedure binding
     if (derivedTypeInfo_.privateBindings &&
         !attrs.HasAny({Attr::PUBLIC, Attr::PRIVATE}) &&
         std::holds_alternative<ProcBindingDetails>(details)) {
       attrs.set(Attr::PRIVATE);
     }
     Symbol &result{MakeSymbol(name, attrs, std::move(details))};
+    SetCUDADataAttr(name, result, cudaDataAttr());
     if (result.has<TypeParamDetails>()) {
       derivedType.symbol()->get<DerivedTypeDetails>().add_paramDecl(result);
     }
     return &result;
   }
 }
 
 // Return true if it is ok to declare this component in the current scope.

 // ResolveNamesVisitor implementation
 
 bool ResolveNamesVisitor::Pre(const parser::FunctionReference &x) {
   HandleCall(Symbol::Flag::Function, x.v);
   return false;
 }
 bool ResolveNamesVisitor::Pre(const parser::CallStmt &x) {
   HandleCall(Symbol::Flag::Subroutine, x.call);
+  Walk(x.chevrons);
   return false;
 }
 
 bool ResolveNamesVisitor::Pre(const parser::ImportStmt &x) {
   auto &scope{currScope()};
   // Check C896 and C899: where IMPORT statements are allowed
   switch (scope.kind()) {
   case Scope::Kind::Module:
bool ResolveNamesVisitor::CheckImplicitNoneExternal(
   return true;
 }
 
 // Variant of HandleProcedureName() for use while skimming the executable
 // part of a subprogram to catch calls to dummy procedures that are part
 // of the subprogram's interface, and to mark as procedures any symbols
 // that might otherwise have been miscategorized as objects.
 void ResolveNamesVisitor::NoteExecutablePartCall(
-    Symbol::Flag flag, const parser::Call &call) {
+    Symbol::Flag flag, const parser::Call &call, bool hasCUDAChevrons) {
   auto &designator{std::get<parser::ProcedureDesignator>(call.t)};
   if (const auto *name{std::get_if<parser::Name>(&designator.u)}) {
     // Subtlety: The symbol pointers in the parse tree are not set, because
     // they might end up resolving elsewhere (e.g., construct entities in
     // SELECT TYPE).
     if (Symbol * symbol{currScope().FindSymbol(name->source)}) {
       Symbol::Flag other{flag == Symbol::Flag::Subroutine
               ? Symbol::Flag::Function
               : Symbol::Flag::Subroutine};
       if (!symbol->test(other)) {
         ConvertToProcEntity(*symbol);
-        if (symbol->has<ProcEntityDetails>()) {
+        if (auto *details{symbol->detailsIf<ProcEntityDetails>()}) {
           symbol->set(flag);
           if (IsDummy(*symbol)) {
             SetImplicitAttr(*symbol, Attr::EXTERNAL);
           }
           ApplyImplicitRules(*symbol);
+          if (hasCUDAChevrons) {
+            details->set_isCUDAKernel();
+          }
         }
       }
     }
   }
 }
 
 static bool IsLocallyImplicitGlobalSymbol(
     const Symbol &symbol, const parser::Name &localName) {
const auto &[accDecls, ompDecls, compilerDirectives, useStmts, importStmts,
       implicitPart, decls] = x.t;
   auto flagRestorer{common::ScopedSet(inSpecificationPart_, true)};
   auto stateRestorer{
       common::ScopedSet(specPartState_, SpecificationPartState{})};
   Walk(accDecls);
   Walk(ompDecls);
   Walk(compilerDirectives);
   Walk(useStmts);
+  UseCUDABuiltinNames();
   ClearUseRenames();
   ClearUseOnly();
   ClearModuleUses();
   Walk(importStmts);
   Walk(implicitPart);
   for (const auto &decl : decls) {
     if (const auto *spec{
             std::get_if<parser::SpecificationConstruct>(&decl.u)}) {
       PreSpecificationConstruct(*spec);
     }
   }
   Walk(decls);
   FinishSpecificationPart(decls);
   return false;
 }
 
+void ResolveNamesVisitor::UseCUDABuiltinNames() {
+  if (FindCUDADeviceContext(&currScope())) {
+    if (const Scope * CUDABuiltins{context().GetCUDABuiltinsScope()}) {
+      for (const auto &[name, symbol] : *CUDABuiltins) {
+        if (!FindInScope(name)) {
+          auto &localSymbol{MakeSymbol(name)};
+          localSymbol.set_details(UseDetails{name, *symbol});
+          localSymbol.flags() = symbol->flags();
+        }
+      }
+    }
+  }
+}
+
 // Initial processing on specification constructs, before visiting them.
 void ResolveNamesVisitor::PreSpecificationConstruct(
     const parser::SpecificationConstruct &spec) {
   common::visit(
       common::visitors{
           [&](const parser::Statement<Indirection<parser::GenericStmt>> &y) {
             CreateGeneric(std::get<parser::GenericSpec>(y.statement.value().t));
           },
void Walk(const parser::ExecutionPart *exec) {
     if (exec) {
       parser::Walk(*exec, *this);
     }
   }
 
   template <typename A> bool Pre(const A &) { return true; }
   template <typename A> void Post(const A &) {}
   void Post(const parser::FunctionReference &fr) {
-    resolver_.NoteExecutablePartCall(Symbol::Flag::Function, fr.v);
+    resolver_.NoteExecutablePartCall(Symbol::Flag::Function, fr.v, false);
   }
   void Post(const parser::CallStmt &cs) {
-    resolver_.NoteExecutablePartCall(Symbol::Flag::Subroutine, cs.call);
+    resolver_.NoteExecutablePartCall(
+        Symbol::Flag::Subroutine, cs.call, cs.chevrons.has_value());
   }
 
 private:
   ResolveNamesVisitor &resolver_;
 };
 
 // Build the scope tree and resolve names in the specification parts of this
 // node and its children
void ResolveNamesVisitor::ResolveExecutionParts(const ProgramTree &node) {
   for (const auto &child : node.children()) {
     ResolveExecutionParts(child);
   }
 }
 
 void ResolveNamesVisitor::Post(const parser::Program &) {
   // ensure that all temps were deallocated
   CHECK(!attrs_);
+  CHECK(!cudaDataAttr_);
   CHECK(!GetDeclTypeSpec());
 }
 
 // A singleton instance of the scope -> IMPLICIT rules mapping is
 // shared by all instances of ResolveNamesVisitor and accessed by this
 // pointer when the visitors (other than the top-level original) are
 // constructed.
 static ImplicitRulesMap *sharedImplicitRulesMap{nullptr};

flang/lib/Semantics/scope.cpp

 Symbol *Scope::FindSymbol(const SourceName &name) const {
   auto it{find(name)};
   if (it != end()) {
     return &*it->second;
   } else if (IsSubmodule()) {
     const Scope *parent{symbol_->get<ModuleDetails>().parent()};
     return parent ? parent->FindSymbol(name) : nullptr;
   } else if (CanImport(name)) {
-    return parent_.FindSymbol(name);
+    return parent_->FindSymbol(name);
   } else {
     return nullptr;
   }
 }
 
 Symbol *Scope::FindComponent(SourceName name) const {
   CHECK(IsDerivedType());
   auto found{find(name)};

 }
 
 void Scope::add_importName(const SourceName &name) {
   importNames_.insert(name);
 }
 
 // true if name can be imported or host-associated from parent scope.
 bool Scope::CanImport(const SourceName &name) const {
-  if (IsTopLevel() || parent_.IsTopLevel()) {
+  if (IsTopLevel() || parent_->IsTopLevel()) {
     return false;
   }
   switch (GetImportKind()) {
     SWITCH_COVERS_ALL_CASES
   case ImportKind::None:
     return false;
   case ImportKind::All:
   case ImportKind::Default:

flang/lib/Semantics/semantics.cpp

 }
 
 void SemanticsContext::UsePPCFortranBuiltinTypesModule() {
   if (ppcBuiltinTypesScope_ == nullptr) {
     ppcBuiltinTypesScope_ = GetBuiltinModule("__fortran_ppc_types");
   }
 }
 
+const Scope *SemanticsContext::GetCUDABuiltinsScope() {
+  if (!CUDABuiltinsScope_) {
+    CUDABuiltinsScope_ = GetBuiltinModule("__cuda_builtins");
+  }
+  return *CUDABuiltinsScope_;
+}
+
 void SemanticsContext::UsePPCFortranBuiltinsModule() {
   if (ppcBuiltinsScope_ == nullptr) {
     ppcBuiltinsScope_ = GetBuiltinModule("__fortran_ppc_intrinsics");
   }
 }
 
 parser::Program &SemanticsContext::SaveParseTree(parser::Program &&tree) {
   return modFileParseTrees_.emplace_back(std::move(tree));

flang/lib/Semantics/symbol.cpp

if (x.stmtFunction_) {
     os << " -> " << x.stmtFunction_->AsFortran();
   }
   if (x.moduleInterface_) {
     os << " moduleInterface: " << *x.moduleInterface_;
   }
   if (x.defaultIgnoreTKR_) {
     os << " defaultIgnoreTKR";
   }
+  if (x.cudaSubprogramAttrs_) {
+    os << " cudaSubprogramAttrs: "
+       << common::EnumToString(*x.cudaSubprogramAttrs_);
+  }
+  if (!x.cudaLaunchBounds_.empty()) {
+    os << " cudaLaunchBounds:";
+    for (auto x : x.cudaLaunchBounds_) {
+      os << ' ' << x;
+    }
+  }
+  if (!x.cudaClusterDims_.empty()) {
+    os << " cudaClusterDims:";
+    for (auto x : x.cudaClusterDims_) {
+      os << ' ' << x;
+    }
+  }
   return os;
 }
 
 void EntityDetails::set_type(const DeclTypeSpec &type) {
   CHECK(!type_);
   type_ = &type;
 }
 
llvm::raw_ostream &operator<<(
   DumpList(os, "coshape", x.coshape());
   DumpExpr(os, "init", x.init_);
   if (x.unanalyzedPDTComponentInit()) {
     os << " (has unanalyzedPDTComponentInit)";
   }
   if (!x.ignoreTKR_.empty()) {
     x.ignoreTKR_.Dump(os << ' ', common::EnumToString);
   }
+  if (x.cudaDataAttr()) {
+    os << " cudaDataAttr: " << common::EnumToString(*x.cudaDataAttr());
+  }
   return os;
 }
 
 llvm::raw_ostream &operator<<(
     llvm::raw_ostream &os, const AssocEntityDetails &x) {
   os << *static_cast<const EntityDetails *>(&x);
   if (auto assocRank{x.rank()}) {
     os << " rank: " << *assocRank;
llvm::raw_ostream &operator<<(
   DumpOptional(os, "passName", x.passName());
   if (x.init()) {
     if (const Symbol * target{*x.init()}) {
       os << " => " << target->name();
     } else {
       os << " => NULL()";
     }
   }
+  if (x.isCUDAKernel()) {
+    os << " isCUDAKernel";
+  }
   return os;
 }
 
 llvm::raw_ostream &operator<<(
     llvm::raw_ostream &os, const DerivedTypeDetails &x) {
   DumpBool(os, "sequence", x.sequence_);
   DumpList(os, "components", x.componentNames_);
   return os;

flang/lib/Semantics/tools.cpp

bool IsUnlimitedPolymorphic(const Symbol &symbol) {
   }
   return false;
 }
 
 bool IsPolymorphicAllocatable(const Symbol &symbol) {
   return IsAllocatable(symbol) && IsPolymorphic(symbol);
 }
 
+const Scope *FindCUDADeviceContext(const Scope *scope) {
+  return !scope ? nullptr : FindScopeContaining(*scope, [](const Scope &s) {
+    return IsCUDADeviceContext(&s);
+  });
+}
+
+std::optional<common::CUDADataAttr> GetCUDADataAttr(const Symbol *symbol) {
+  const auto *object{
+      symbol ? symbol->detailsIf<ObjectEntityDetails>() : nullptr};
+  return object ? object->cudaDataAttr() : std::nullopt;
+}
+
 std::optional<parser::MessageFormattedText> CheckAccessibleSymbol(
     const Scope &scope, const Symbol &symbol) {
   if (symbol.attrs().test(Attr::PRIVATE)) {
     if (FindModuleFileContaining(scope)) {
       // Don't enforce component accessibility checks in module files;
       // there may be forward-substituted named constants of derived type
       // whose structure constructors reference private components.
     } else if (const Scope *

flang/module/__fortran_builtins.f90

module __Fortran_builtins
 
   type :: __builtin_team_type
     integer(kind=int64) :: __id
   end type
 
   integer, parameter :: __builtin_atomic_int_kind = selected_int_kind(18)
   integer, parameter :: __builtin_atomic_logical_kind = __builtin_atomic_int_kind
 
+  procedure(type(__builtin_c_ptr)) :: __builtin_c_loc
+
+  type :: __builtin_dim3
+    integer :: x=1, y=1, z=1
+  end type
+  type(__builtin_dim3) :: &
+    __builtin_threadIdx, __builtin_blockDim, __builtin_blockIdx, __builtin_gridDim
+  integer, parameter :: __builtin_warpsize = 32
+
   intrinsic :: __builtin_ieee_is_nan, __builtin_ieee_is_negative, &
     __builtin_ieee_is_normal
   intrinsic :: __builtin_ieee_next_after, __builtin_ieee_next_down, &
     __builtin_ieee_next_up
   intrinsic :: scale ! for ieee_scalb
   intrinsic :: __builtin_ieee_selected_real_kind
   intrinsic :: __builtin_ieee_support_datatype, &
     __builtin_ieee_support_denormal, __builtin_ieee_support_divide, &

flang/test/Parser/cuf-sanity-common

contains
   attributes(device) subroutine devicesub; end
   attributes(device) real function devicefunc(); devicefunc = 1.; end
   attributes(global) subroutine globalsub; end
   attributes(grid_global) subroutine gridglobalsub; end
   attributes(host) subroutine hostsub; end
   attributes(global) launch_bounds(1, 2) subroutine lbsub; end
   attributes(global) cluster_dims(1, 2, 3) subroutine cdsub; end
   attributes(device) subroutine attrs
-! enable with name resolution:    attributes(device) :: devx1
+    attributes(device) :: devx1
     real, device :: devx2
   end subroutine
   subroutine test
     logical isPinned
     !$cuf kernel do(1) <<<*, *, stream = 1>>>
     do j = 1, 10
     end do
     !$cuf kernel do <<<1, (2, 3), stream = 1>>>
     do j = 1, 10
     end do
     call globalsub<<<1, 2>>>
     call globalsub<<<1, 2, 3>>>
     call globalsub<<<1, 2, 3, 4>>>
     allocate(pa(32), stream = 1, pinned = isPinned)
   end subroutine
 end module

flang/test/Semantics/cuf01.cuf

+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Test conflicting CUDA subprogram attributes
+module m1
+ contains
+  !WARNING: ATTRIBUTES(Host) appears more than once
+  attributes(host,host) subroutine ok1; end
+  !WARNING: ATTRIBUTES(Host) appears more than once
+  attributes(host) attributes(host) subroutine ok2; end
+  attributes(host,device) subroutine ok3; end
+  attributes(device,host) subroutine ok4; end
+  !WARNING: ATTRIBUTES(Host) appears more than once
+  attributes(host,device,host) subroutine ok5; end
+  !WARNING: ATTRIBUTES(Device) appears more than once
+  attributes(device,host,device) subroutine ok6; end
+  !ERROR: ATTRIBUTES(Global) conflicts with earlier ATTRIBUTES(Host)
+  attributes(host,global) subroutine conflict1; end
+  !ERROR: ATTRIBUTES(Host) conflicts with earlier ATTRIBUTES(Global)
+  attributes(global,host) subroutine conflict2; end
+  !ERROR: ATTRIBUTES(Grid_Global) conflicts with earlier ATTRIBUTES(Host)
+  attributes(host,grid_global) subroutine conflict3; end
+  !TODO: more with launch_bounds & cluster_dims
+end module

flang/test/Semantics/modfile55.cuf

+! RUN: %python %S/test_modfile.py %s %flang_fc1
+! Sanity check for CUDA Fortran attributes in module files
+module m
+  attributes(device) dd
+  real, managed, allocatable :: md
+  real, pinned, allocatable :: mp
+  attributes(constant) cd
+ contains
+  attributes(global) subroutine globsub(x,y,z)
+    real, value :: x
+    real, device :: y
+    real, managed :: z
+  end subroutine
+  attributes(host,device) real function foo(x)
+    foo = x + 1.
+  end function
+end
+
+!Expect: m.mod
+!module m
+!real(4)::dd
+!attributes(device) dd
+!real(4),allocatable::md
+!attributes(managed) md
+!real(4),allocatable::mp
+!attributes(pinned) mp
+!real(4)::cd
+!attributes(constant) cd
+!contains
+!attributes(global) subroutine globsub(x,y,z)
+!real(4),value::x
+!real(4)::y
+!attributes(device) y
+!real(4)::z
+!attributes(managed) z
+!end
+!attributes(host,device) function foo(x)
+!real(4)::x
+!real(4)::foo
+!end
+!end