flang/runtime/type-info.h

   1 //===-- runtime/type-info.h -------------------------------------*- C++ -*-===//
   2 //
   3 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
   4 // See https://llvm.org/LICENSE.txt for license information.
   5 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
   6 //
   7 //===----------------------------------------------------------------------===//
   8
   9 #ifndef FORTRAN_RUNTIME_TYPE_INFO_H_
  10 #define FORTRAN_RUNTIME_TYPE_INFO_H_
  11
  12 // A C++ perspective of the derived type description schemata in
  13 // flang/module/__fortran_type_info.f90.
  14
  15 #include "terminator.h"
  16 #include "flang/Common/Fortran.h"
  17 #include "flang/Common/bit-population-count.h"
  18 #include "flang/Common/optional.h"
  19 #include "flang/Runtime/descriptor.h"
  20 #include <cinttypes>
  21 #include <memory>
  22
  23 namespace Fortran::runtime::typeInfo {
  24
  25 class DerivedType;
  26
  27 using ProcedurePointer = void (*)(); // TYPE(C_FUNPTR)
  28
  29 struct Binding {
  30   ProcedurePointer proc;
  31   StaticDescriptor<0> name; // CHARACTER(:), POINTER
  32 };
  33
  34 class Value {
  35 public:
  36   enum class Genre : std::uint8_t {
  37     Deferred = 1,
  38     Explicit = 2,
  39     LenParameter = 3
  40   };
  41   RT_API_ATTRS Genre genre() const { return genre_; }
  42   RT_API_ATTRS Fortran::common::optional<TypeParameterValue> GetValue(
  43       const Descriptor *) const;
  44
  45 private:
  46   Genre genre_{Genre::Explicit};
  47   // The value encodes an index into the table of LEN type parameters in
  48   // a descriptor's addendum for genre == Genre::LenParameter.
  49   TypeParameterValue value_{0};
  50 };
  51
  52 class Component {
  53 public:
  54   enum class Genre : std::uint8_t {
  55     Data = 1,
  56     Pointer = 2,
  57     Allocatable = 3,
  58     Automatic = 4
  59   };
  60
  61   RT_API_ATTRS const Descriptor &name() const { return name_.descriptor(); }
  62   RT_API_ATTRS Genre genre() const { return genre_; }
  63   RT_API_ATTRS TypeCategory category() const {
  64     return static_cast<TypeCategory>(category_);
  65   }
  66   RT_API_ATTRS int kind() const { return kind_; }
  67   RT_API_ATTRS int rank() const { return rank_; }
  68   RT_API_ATTRS std::uint64_t offset() const { return offset_; }
  69   RT_API_ATTRS const Value &characterLen() const { return characterLen_; }
  70   RT_API_ATTRS const DerivedType *derivedType() const {
  71     return derivedType_.descriptor().OffsetElement<const DerivedType>();
  72   }
  73   RT_API_ATTRS const Value *lenValue() const {
  74     return lenValue_.descriptor().OffsetElement<const Value>();
  75   }
  76   RT_API_ATTRS const Value *bounds() const {
  77     return bounds_.descriptor().OffsetElement<const Value>();
  78   }
  79   RT_API_ATTRS const char *initialization() const { return initialization_; }
  80
  81   RT_API_ATTRS std::size_t GetElementByteSize(const Descriptor &) const;
  82   RT_API_ATTRS std::size_t GetElements(const Descriptor &) const;
  83
  84   // For components that are descriptors, returns size of descriptor;
  85   // for Genre::Data, returns elemental byte size times element count.
  86   RT_API_ATTRS std::size_t SizeInBytes(const Descriptor &) const;
  87
  88   // Establishes a descriptor from this component description.
  89   RT_API_ATTRS void EstablishDescriptor(
  90       Descriptor &, const Descriptor &container, Terminator &) const;
  91
  92   // Creates a pointer descriptor from this component description, possibly
  93   // with subscripts
  94   RT_API_ATTRS void CreatePointerDescriptor(Descriptor &,
  95       const Descriptor &container, Terminator &,
  96       const SubscriptValue * = nullptr) const;
  97
  98   FILE *Dump(FILE * = stdout) const;
  99
 100 private:
 101   StaticDescriptor<0> name_; // CHARACTER(:), POINTER
 102   Genre genre_{Genre::Data};
 103   std::uint8_t category_; // common::TypeCategory
 104   std::uint8_t kind_{0};
 105   std::uint8_t rank_{0};
 106   std::uint64_t offset_{0};
 107   Value characterLen_; // for TypeCategory::Character
 108   StaticDescriptor<0, true> derivedType_; // TYPE(DERIVEDTYPE), POINTER
 109   StaticDescriptor<1, true>
 110       lenValue_; // TYPE(VALUE), POINTER, DIMENSION(:), CONTIGUOUS
 111   StaticDescriptor<2, true>
 112       bounds_; // TYPE(VALUE), POINTER, DIMENSION(2,:), CONTIGUOUS
 113   const char *initialization_{nullptr}; // for Genre::Data and Pointer
 114   // TODO: cobounds
 115   // TODO: `PRIVATE` attribute
 116 };
 117
 118 struct ProcPtrComponent {
 119   StaticDescriptor<0> name; // CHARACTER(:), POINTER
 120   std::uint64_t offset{0};
 121   ProcedurePointer procInitialization;
 122 };
 123
 124 class SpecialBinding {
 125 public:
 126   enum class Which : std::uint8_t {
 127     None = 0,
 128     ScalarAssignment = 1,
 129     ElementalAssignment = 2,
 130     ReadFormatted = 3,
 131     ReadUnformatted = 4,
 132     WriteFormatted = 5,
 133     WriteUnformatted = 6,
 134     ElementalFinal = 7,
 135     AssumedRankFinal = 8,
 136     ScalarFinal = 9,
 137     // higher-ranked final procedures follow
 138   };
 139
 140   // Special bindings can be created during execution to handle defined
 141   // I/O procedures that are not type-bound.
 142   RT_API_ATTRS SpecialBinding(Which which, ProcedurePointer proc,
 143       std::uint8_t isArgDescSet, std::uint8_t isTypeBound,
 144       std::uint8_t isArgContiguousSet)
 145       : which_{which}, isArgDescriptorSet_{isArgDescSet},
 146         isTypeBound_{isTypeBound}, isArgContiguousSet_{isArgContiguousSet},
 147         proc_{proc} {}
 148
 149   static constexpr RT_API_ATTRS Which RankFinal(int rank) {
 150     return static_cast<Which>(static_cast<int>(Which::ScalarFinal) + rank);
 151   }
 152
 153   RT_API_ATTRS Which which() const { return which_; }
 154   RT_API_ATTRS bool IsArgDescriptor(int zeroBasedArg) const {
 155     return (isArgDescriptorSet_ >> zeroBasedArg) & 1;
 156   }
 157   RT_API_ATTRS bool isTypeBound() const { return isTypeBound_; }
 158   RT_API_ATTRS bool IsArgContiguous(int zeroBasedArg) const {
 159     return (isArgContiguousSet_ >> zeroBasedArg) & 1;
 160   }
 161   template <typename PROC> RT_API_ATTRS PROC GetProc() const {
 162     return reinterpret_cast<PROC>(proc_);
 163   }
 164
 165   FILE *Dump(FILE *) const;
 166
 167 private:
 168   Which which_{Which::None};
 169
 170   // The following little bit-set identifies which dummy arguments are
 171   // passed via descriptors for their derived type arguments.
 172   //   Which::Assignment and Which::ElementalAssignment:
 173   //     Set to 1, 2, or (usually 3).
 174   //     The passed-object argument (usually the "to") is always passed via a
 175   //     a descriptor in the cases where the runtime will call a defined
 176   //     assignment because these calls are to type-bound generics,
 177   //     not generic interfaces, and type-bound generic defined assigment
 178   //     may appear only in an extensible type and requires a passed-object
 179   //     argument (see C774), and passed-object arguments to TBPs must be
 180   //     both polymorphic and scalar (C760).  The non-passed-object argument
 181   //     (usually the "from") is usually, but not always, also a descriptor.
 182   //   Which::Final and Which::ElementalFinal:
 183   //     Set to 1 when dummy argument is assumed-shape; otherwise, the
 184   //     argument can be passed by address.  (Fortran guarantees that
 185   //     any finalized object must be whole and contiguous by restricting
 186   //     the use of DEALLOCATE on pointers.  The dummy argument of an
 187   //     elemental final subroutine must be scalar and monomorphic, but
 188   //     use a descriptors when the type has LEN parameters.)
 189   //   Which::AssumedRankFinal: flag must necessarily be set
 190   //   Defined I/O:
 191   //     Set to 1 when "dtv" initial dummy argument is polymorphic, which is
 192   //     the case when and only when the derived type is extensible.
 193   //     When false, the defined I/O subroutine must have been
 194   //     called via a generic interface, not a generic TBP.
 195   std::uint8_t isArgDescriptorSet_{0};
 196   std::uint8_t isTypeBound_{0};
 197   // True when a FINAL subroutine has a dummy argument that is an array that
 198   // is CONTIGUOUS or neither assumed-rank nor assumed-shape.
 199   std::uint8_t isArgContiguousSet_{0};
 200
 201   ProcedurePointer proc_{nullptr};
 202 };
 203
 204 class DerivedType {
 205 public:
 206   ~DerivedType(); // never defined
 207
 208   RT_API_ATTRS const Descriptor &binding() const {
 209     return binding_.descriptor();
 210   }
 211   RT_API_ATTRS const Descriptor &name() const { return name_.descriptor(); }
 212   RT_API_ATTRS std::uint64_t sizeInBytes() const { return sizeInBytes_; }
 213   RT_API_ATTRS const Descriptor &uninstatiated() const {
 214     return uninstantiated_.descriptor();
 215   }
 216   RT_API_ATTRS const Descriptor &kindParameter() const {
 217     return kindParameter_.descriptor();
 218   }
 219   RT_API_ATTRS const Descriptor &lenParameterKind() const {
 220     return lenParameterKind_.descriptor();
 221   }
 222   RT_API_ATTRS const Descriptor &component() const {
 223     return component_.descriptor();
 224   }
 225   RT_API_ATTRS const Descriptor &procPtr() const {
 226     return procPtr_.descriptor();
 227   }
 228   RT_API_ATTRS const Descriptor &special() const {
 229     return special_.descriptor();
 230   }
 231   RT_API_ATTRS bool hasParent() const { return hasParent_; }
 232   RT_API_ATTRS bool noInitializationNeeded() const {
 233     return noInitializationNeeded_;
 234   }
 235   RT_API_ATTRS bool noDestructionNeeded() const { return noDestructionNeeded_; }
 236   RT_API_ATTRS bool noFinalizationNeeded() const {
 237     return noFinalizationNeeded_;
 238   }
 239
 240   RT_API_ATTRS std::size_t LenParameters() const {
 241     return lenParameterKind().Elements();
 242   }
 243
 244   RT_API_ATTRS const DerivedType *GetParentType() const;
 245
 246   // Finds a data component by name in this derived type or its ancestors.
 247   RT_API_ATTRS const Component *FindDataComponent(
 248       const char *name, std::size_t nameLen) const;
 249
 250   // O(1) look-up of special procedure bindings
 251   RT_API_ATTRS const SpecialBinding *FindSpecialBinding(
 252       SpecialBinding::Which which) const {
 253     auto bitIndex{static_cast<std::uint32_t>(which)};
 254     auto bit{std::uint32_t{1} << bitIndex};
 255     if (specialBitSet_ & bit) {
 256       // The index of this special procedure in the sorted array is the
 257       // number of special bindings that are present with smaller "which"
 258       // code values.
 259       int offset{common::BitPopulationCount(specialBitSet_ & (bit - 1))};
 260       const auto *binding{
 261           special_.descriptor().ZeroBasedIndexedElement<SpecialBinding>(
 262               offset)};
 263       INTERNAL_CHECK(binding && binding->which() == which);
 264       return binding;
 265     } else {
 266       return nullptr;
 267     }
 268   }
 269
 270   FILE *Dump(FILE * = stdout) const;
 271
 272 private:
 273   // This member comes first because it's used like a vtable by generated code.
 274   // It includes all of the ancestor types' bindings, if any, first,
 275   // with any overrides from descendants already applied to them.  Local
 276   // bindings then follow in alphabetic order of binding name.
 277   StaticDescriptor<1, true>
 278       binding_; // TYPE(BINDING), DIMENSION(:), POINTER, CONTIGUOUS
 279
 280   StaticDescriptor<0> name_; // CHARACTER(:), POINTER
 281
 282   std::uint64_t sizeInBytes_{0};
 283
 284   // Instantiations of a parameterized derived type with KIND type
 285   // parameters will point this data member to the description of
 286   // the original uninstantiated type, which may be shared from a
 287   // module via use association.  The original uninstantiated derived
 288   // type description will point to itself.  Derived types that have
 289   // no KIND type parameters will have a null pointer here.
 290   StaticDescriptor<0, true> uninstantiated_; // TYPE(DERIVEDTYPE), POINTER
 291
 292   // These pointer targets include all of the items from the parent, if any.
 293   StaticDescriptor<1> kindParameter_; // pointer to rank-1 array of INTEGER(8)
 294   StaticDescriptor<1>
 295       lenParameterKind_; // pointer to rank-1 array of INTEGER(1)
 296
 297   // This array of local data components includes the parent component.
 298   // Components are in component order, not collation order of their names.
 299   // It does not include procedure pointer components.
 300   StaticDescriptor<1, true>
 301       component_; // TYPE(COMPONENT), POINTER, DIMENSION(:), CONTIGUOUS
 302
 303   // Procedure pointer components
 304   StaticDescriptor<1, true>
 305       procPtr_; // TYPE(PROCPTR), POINTER, DIMENSION(:), CONTIGUOUS
 306
 307   // Packed in ascending order of "which" code values.
 308   // Does not include special bindings from ancestral types.
 309   StaticDescriptor<1, true>
 310       special_; // TYPE(SPECIALBINDING), POINTER, DIMENSION(:), CONTIGUOUS
 311
 312   // Little-endian bit-set of special procedure binding "which" code values
 313   // for O(1) look-up in FindSpecialBinding() above.
 314   std::uint32_t specialBitSet_{0};
 315
 316   // Flags
 317   bool hasParent_{false};
 318   bool noInitializationNeeded_{false};
 319   bool noDestructionNeeded_{false};
 320   bool noFinalizationNeeded_{false};
 321 };
 322
 323 } // namespace Fortran::runtime::typeInfo
 324 #endif // FORTRAN_RUNTIME_TYPE_INFO_H_