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 "descriptor.h" 16 #include "flang/Common/Fortran.h" 17 #include <cinttypes> 18 #include <memory> 19 #include <optional> 20 21 namespace Fortran::runtime::typeInfo { 22 23 class DerivedType; 24 25 using ProcedurePointer = void (*)(); // TYPE(C_FUNPTR) 26 27 struct Binding { 28 ProcedurePointer proc; 29 StaticDescriptor<0> name; // CHARACTER(:), POINTER 30 }; 31 32 class Value { 33 public: 34 enum class Genre : std::uint8_t { 35 Deferred = 1, 36 Explicit = 2, 37 LenParameter = 3 38 }; 39 40 std::optional<TypeParameterValue> GetValue(const Descriptor *) const; 41 42 private: 43 Genre genre_{Genre::Explicit}; 44 // The value encodes an index into the table of LEN type parameters in 45 // a descriptor's addendum for genre == Genre::LenParameter. 46 TypeParameterValue value_{0}; 47 }; 48 49 class Component { 50 public: 51 enum class Genre : std::uint8_t { 52 Data = 1, 53 Pointer = 2, 54 Allocatable = 3, 55 Automatic = 4 56 }; 57 name()58 const Descriptor &name() const { return name_.descriptor(); } genre()59 Genre genre() const { return genre_; } category()60 TypeCategory category() const { return static_cast<TypeCategory>(category_); } kind()61 int kind() const { return kind_; } rank()62 int rank() const { return rank_; } offset()63 std::uint64_t offset() const { return offset_; } characterLen()64 const Value &characterLen() const { return characterLen_; } derivedType()65 const DerivedType *derivedType() const { 66 return derivedType_.descriptor().OffsetElement<const DerivedType>(); 67 } lenValue()68 const Value *lenValue() const { 69 return lenValue_.descriptor().OffsetElement<const Value>(); 70 } bounds()71 const Value *bounds() const { 72 return bounds_.descriptor().OffsetElement<const Value>(); 73 } initialization()74 const char *initialization() const { return initialization_; } 75 76 std::size_t GetElementByteSize(const Descriptor &) const; 77 std::size_t GetElements(const Descriptor &) const; 78 79 // For ocmponents that are descriptors, returns size of descriptor; 80 // for Genre::Data, returns elemental byte size times element count. 81 std::size_t SizeInBytes(const Descriptor &) const; 82 83 // Establishes a descriptor from this component description. 84 void EstablishDescriptor( 85 Descriptor &, const Descriptor &container, Terminator &) const; 86 87 // Creates a pointer descriptor from this component description. 88 void CreatePointerDescriptor(Descriptor &, const Descriptor &container, 89 const SubscriptValue[], Terminator &) const; 90 91 FILE *Dump(FILE * = stdout) const; 92 93 private: 94 StaticDescriptor<0> name_; // CHARACTER(:), POINTER 95 Genre genre_{Genre::Data}; 96 std::uint8_t category_; // common::TypeCategory 97 std::uint8_t kind_{0}; 98 std::uint8_t rank_{0}; 99 std::uint64_t offset_{0}; 100 Value characterLen_; // for TypeCategory::Character 101 StaticDescriptor<0, true> derivedType_; // TYPE(DERIVEDTYPE), POINTER 102 StaticDescriptor<1, true> 103 lenValue_; // TYPE(VALUE), POINTER, DIMENSION(:), CONTIGUOUS 104 StaticDescriptor<2, true> 105 bounds_; // TYPE(VALUE), POINTER, DIMENSION(2,:), CONTIGUOUS 106 const char *initialization_{nullptr}; // for Genre::Data and Pointer 107 // TODO: cobounds 108 // TODO: `PRIVATE` attribute 109 }; 110 111 struct ProcPtrComponent { 112 StaticDescriptor<0> name; // CHARACTER(:), POINTER 113 std::uint64_t offset{0}; 114 ProcedurePointer procInitialization; 115 }; 116 117 class SpecialBinding { 118 public: 119 enum class Which : std::uint8_t { 120 None = 0, 121 Assignment = 4, 122 ElementalAssignment = 5, 123 Final = 8, 124 ElementalFinal = 9, 125 AssumedRankFinal = 10, 126 ReadFormatted = 16, 127 ReadUnformatted = 17, 128 WriteFormatted = 18, 129 WriteUnformatted = 19 130 }; 131 which()132 Which which() const { return which_; } rank()133 int rank() const { return rank_; } IsArgDescriptor(int zeroBasedArg)134 bool IsArgDescriptor(int zeroBasedArg) const { 135 return (isArgDescriptorSet_ >> zeroBasedArg) & 1; 136 } GetProc()137 template <typename PROC> PROC GetProc() const { 138 return reinterpret_cast<PROC>(proc_); 139 } 140 141 FILE *Dump(FILE *) const; 142 143 private: 144 Which which_{Which::None}; 145 146 // Used for Which::Final only. Which::Assignment always has rank 0, as 147 // type-bound defined assignment for rank > 0 must be elemental 148 // due to the required passed object dummy argument, which are scalar. 149 // User defined derived type I/O is always scalar. 150 std::uint8_t rank_{0}; 151 152 // The following little bit-set identifies which dummy arguments are 153 // passed via descriptors for their derived type arguments. 154 // Which::Assignment and Which::ElementalAssignment: 155 // Set to 1, 2, or (usually 3). 156 // The passed-object argument (usually the "to") is always passed via a 157 // a descriptor in the cases where the runtime will call a defined 158 // assignment because these calls are to type-bound generics, 159 // not generic interfaces, and type-bound generic defined assigment 160 // may appear only in an extensible type and requires a passed-object 161 // argument (see C774), and passed-object arguments to TBPs must be 162 // both polymorphic and scalar (C760). The non-passed-object argument 163 // (usually the "from") is usually, but not always, also a descriptor. 164 // Which::Final and Which::ElementalFinal: 165 // Set to 1 when dummy argument is assumed-shape; otherwise, the 166 // argument can be passed by address. (Fortran guarantees that 167 // any finalized object must be whole and contiguous by restricting 168 // the use of DEALLOCATE on pointers. The dummy argument of an 169 // elemental final subroutine must be scalar and monomorphic, but 170 // use a descriptors when the type has LEN parameters.) 171 // Which::AssumedRankFinal: flag must necessarily be set 172 // User derived type I/O: 173 // Set to 1 when "dtv" initial dummy argument is polymorphic, which is 174 // the case when and only when the derived type is extensible. 175 // When false, the user derived type I/O subroutine must have been 176 // called via a generic interface, not a generic TBP. 177 std::uint8_t isArgDescriptorSet_{0}; 178 179 ProcedurePointer proc_{nullptr}; 180 }; 181 182 class DerivedType { 183 public: 184 ~DerivedType(); // never defined 185 binding()186 const Descriptor &binding() const { return binding_.descriptor(); } name()187 const Descriptor &name() const { return name_.descriptor(); } sizeInBytes()188 std::uint64_t sizeInBytes() const { return sizeInBytes_; } typeHash()189 std::uint64_t typeHash() const { return typeHash_; } uninstatiated()190 const Descriptor &uninstatiated() const { 191 return uninstantiated_.descriptor(); 192 } kindParameter()193 const Descriptor &kindParameter() const { 194 return kindParameter_.descriptor(); 195 } lenParameterKind()196 const Descriptor &lenParameterKind() const { 197 return lenParameterKind_.descriptor(); 198 } component()199 const Descriptor &component() const { return component_.descriptor(); } procPtr()200 const Descriptor &procPtr() const { return procPtr_.descriptor(); } special()201 const Descriptor &special() const { return special_.descriptor(); } hasParent()202 bool hasParent() const { return hasParent_; } noInitializationNeeded()203 bool noInitializationNeeded() const { return noInitializationNeeded_; } noDestructionNeeded()204 bool noDestructionNeeded() const { return noDestructionNeeded_; } 205 LenParameters()206 std::size_t LenParameters() const { return lenParameterKind().Elements(); } 207 208 const DerivedType *GetParentType() const; 209 210 // Finds a data component by name in this derived type or tis ancestors. 211 const Component *FindDataComponent( 212 const char *name, std::size_t nameLen) const; 213 214 const SpecialBinding *FindSpecialBinding(SpecialBinding::Which) const; 215 216 FILE *Dump(FILE * = stdout) const; 217 218 private: 219 // This member comes first because it's used like a vtable by generated code. 220 // It includes all of the ancestor types' bindings, if any, first, 221 // with any overrides from descendants already applied to them. Local 222 // bindings then follow in alphabetic order of binding name. 223 StaticDescriptor<1, true> 224 binding_; // TYPE(BINDING), DIMENSION(:), POINTER, CONTIGUOUS 225 226 StaticDescriptor<0> name_; // CHARACTER(:), POINTER 227 228 std::uint64_t sizeInBytes_{0}; 229 230 // Instantiations of a parameterized derived type with KIND type 231 // parameters will point this data member to the description of 232 // the original uninstantiated type, which may be shared from a 233 // module via use association. The original uninstantiated derived 234 // type description will point to itself. Derived types that have 235 // no KIND type parameters will have a null pointer here. 236 StaticDescriptor<0, true> uninstantiated_; // TYPE(DERIVEDTYPE), POINTER 237 238 // TODO: flags for SEQUENCE, BIND(C), any PRIVATE component(? see 7.5.2) 239 std::uint64_t typeHash_{0}; 240 241 // These pointer targets include all of the items from the parent, if any. 242 StaticDescriptor<1> kindParameter_; // pointer to rank-1 array of INTEGER(8) 243 StaticDescriptor<1> 244 lenParameterKind_; // pointer to rank-1 array of INTEGER(1) 245 246 // This array of local data components includes the parent component. 247 // Components are in component order, not collation order of their names. 248 // It does not include procedure pointer components. 249 StaticDescriptor<1, true> 250 component_; // TYPE(COMPONENT), POINTER, DIMENSION(:), CONTIGUOUS 251 252 // Procedure pointer components 253 StaticDescriptor<1, true> 254 procPtr_; // TYPE(PROCPTR), POINTER, DIMENSION(:), CONTIGUOUS 255 256 // Does not include special bindings from ancestral types. 257 StaticDescriptor<1, true> 258 special_; // TYPE(SPECIALBINDING), POINTER, DIMENSION(:), CONTIGUOUS 259 260 bool hasParent_{false}; 261 bool noInitializationNeeded_{false}; 262 bool noDestructionNeeded_{false}; 263 }; 264 265 } // namespace Fortran::runtime::typeInfo 266 #endif // FORTRAN_RUNTIME_TYPE_INFO_H_ 267