//===-- runtime/type-info.h -------------------------------------*- C++ -*-===//
//
// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
// See https://llvm.org/LICENSE.txt for license information.
// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
//
//===----------------------------------------------------------------------===//
#ifndef FORTRAN_RUNTIME_TYPE_INFO_H_
#define FORTRAN_RUNTIME_TYPE_INFO_H_
// A C++ perspective of the derived type description schemata in
// flang/module/__fortran_type_info.f90.
#include "terminator.h"
#include "flang/Common/Fortran.h"
#include "flang/Common/bit-population-count.h"
#include "flang/Common/optional.h"
#include "flang/Runtime/descriptor.h"
#include <cinttypes>
#include <memory>
namespace Fortran::runtime::typeInfo {
class DerivedType;
using ProcedurePointer = void (*)(); // TYPE(C_FUNPTR)
struct Binding {
ProcedurePointer proc;
StaticDescriptor<0> name; // CHARACTER(:), POINTER
};
class Value {
public:
enum class Genre : std::uint8_t {
Deferred = 1,
Explicit = 2,
LenParameter = 3
};
RT_API_ATTRS Genre genre() const { return genre_; }
RT_API_ATTRS Fortran::common::optional<TypeParameterValue> GetValue(
const Descriptor *) const;
private:
Genre genre_{Genre::Explicit};
// The value encodes an index into the table of LEN type parameters in
// a descriptor's addendum for genre == Genre::LenParameter.
TypeParameterValue value_{0};
};
class Component {
public:
enum class Genre : std::uint8_t {
Data = 1,
Pointer = 2,
Allocatable = 3,
Automatic = 4
};
RT_API_ATTRS const Descriptor &name() const { return name_.descriptor(); }
RT_API_ATTRS Genre genre() const { return genre_; }
RT_API_ATTRS TypeCategory category() const {
return static_cast<TypeCategory>(category_);
}
RT_API_ATTRS int kind() const { return kind_; }
RT_API_ATTRS int rank() const { return rank_; }
RT_API_ATTRS std::uint64_t offset() const { return offset_; }
RT_API_ATTRS const Value &characterLen() const { return characterLen_; }
RT_API_ATTRS const DerivedType *derivedType() const {
return derivedType_.descriptor().OffsetElement<const DerivedType>();
}
RT_API_ATTRS const Value *lenValue() const {
return lenValue_.descriptor().OffsetElement<const Value>();
}
RT_API_ATTRS const Value *bounds() const {
return bounds_.descriptor().OffsetElement<const Value>();
}
RT_API_ATTRS const char *initialization() const { return initialization_; }
RT_API_ATTRS std::size_t GetElementByteSize(const Descriptor &) const;
RT_API_ATTRS std::size_t GetElements(const Descriptor &) const;
// For components that are descriptors, returns size of descriptor;
// for Genre::Data, returns elemental byte size times element count.
RT_API_ATTRS std::size_t SizeInBytes(const Descriptor &) const;
// Establishes a descriptor from this component description.
RT_API_ATTRS void EstablishDescriptor(
Descriptor &, const Descriptor &container, Terminator &) const;
// Creates a pointer descriptor from this component description, possibly
// with subscripts
RT_API_ATTRS void CreatePointerDescriptor(Descriptor &,
const Descriptor &container, Terminator &,
const SubscriptValue * = nullptr) const;
FILE *Dump(FILE * = stdout) const;
private:
StaticDescriptor<0> name_; // CHARACTER(:), POINTER
Genre genre_{Genre::Data};
std::uint8_t category_; // common::TypeCategory
std::uint8_t kind_{0};
std::uint8_t rank_{0};
std::uint64_t offset_{0};
Value characterLen_; // for TypeCategory::Character
StaticDescriptor<0, true> derivedType_; // TYPE(DERIVEDTYPE), POINTER
StaticDescriptor<1, true>
lenValue_; // TYPE(VALUE), POINTER, DIMENSION(:), CONTIGUOUS
StaticDescriptor<2, true>
bounds_; // TYPE(VALUE), POINTER, DIMENSION(2,:), CONTIGUOUS
const char *initialization_{nullptr}; // for Genre::Data and Pointer
// TODO: cobounds
// TODO: `PRIVATE` attribute
};
struct ProcPtrComponent {
StaticDescriptor<0> name; // CHARACTER(:), POINTER
std::uint64_t offset{0};
ProcedurePointer procInitialization;
};
class SpecialBinding {
public:
enum class Which : std::uint8_t {
None = 0,
ScalarAssignment = 1,
ElementalAssignment = 2,
ReadFormatted = 3,
ReadUnformatted = 4,
WriteFormatted = 5,
WriteUnformatted = 6,
ElementalFinal = 7,
AssumedRankFinal = 8,
ScalarFinal = 9,
// higher-ranked final procedures follow
};
// Special bindings can be created during execution to handle defined
// I/O procedures that are not type-bound.
RT_API_ATTRS SpecialBinding(Which which, ProcedurePointer proc,
std::uint8_t isArgDescSet, std::uint8_t isTypeBound,
std::uint8_t isArgContiguousSet)
: which_{which}, isArgDescriptorSet_{isArgDescSet},
isTypeBound_{isTypeBound}, isArgContiguousSet_{isArgContiguousSet},
proc_{proc} {}
static constexpr RT_API_ATTRS Which RankFinal(int rank) {
return static_cast<Which>(static_cast<int>(Which::ScalarFinal) + rank);
}
RT_API_ATTRS Which which() const { return which_; }
RT_API_ATTRS bool IsArgDescriptor(int zeroBasedArg) const {
return (isArgDescriptorSet_ >> zeroBasedArg) & 1;
}
RT_API_ATTRS bool isTypeBound() const { return isTypeBound_; }
RT_API_ATTRS bool IsArgContiguous(int zeroBasedArg) const {
return (isArgContiguousSet_ >> zeroBasedArg) & 1;
}
template <typename PROC> RT_API_ATTRS PROC GetProc() const {
return reinterpret_cast<PROC>(proc_);
}
FILE *Dump(FILE *) const;
private:
Which which_{Which::None};
// The following little bit-set identifies which dummy arguments are
// passed via descriptors for their derived type arguments.
// Which::Assignment and Which::ElementalAssignment:
// Set to 1, 2, or (usually 3).
// The passed-object argument (usually the "to") is always passed via a
// a descriptor in the cases where the runtime will call a defined
// assignment because these calls are to type-bound generics,
// not generic interfaces, and type-bound generic defined assigment
// may appear only in an extensible type and requires a passed-object
// argument (see C774), and passed-object arguments to TBPs must be
// both polymorphic and scalar (C760). The non-passed-object argument
// (usually the "from") is usually, but not always, also a descriptor.
// Which::Final and Which::ElementalFinal:
// Set to 1 when dummy argument is assumed-shape; otherwise, the
// argument can be passed by address. (Fortran guarantees that
// any finalized object must be whole and contiguous by restricting
// the use of DEALLOCATE on pointers. The dummy argument of an
// elemental final subroutine must be scalar and monomorphic, but
// use a descriptors when the type has LEN parameters.)
// Which::AssumedRankFinal: flag must necessarily be set
// Defined I/O:
// Set to 1 when "dtv" initial dummy argument is polymorphic, which is
// the case when and only when the derived type is extensible.
// When false, the defined I/O subroutine must have been
// called via a generic interface, not a generic TBP.
std::uint8_t isArgDescriptorSet_{0};
std::uint8_t isTypeBound_{0};
// True when a FINAL subroutine has a dummy argument that is an array that
// is CONTIGUOUS or neither assumed-rank nor assumed-shape.
std::uint8_t isArgContiguousSet_{0};
ProcedurePointer proc_{nullptr};
};
class DerivedType {
public:
~DerivedType(); // never defined
RT_API_ATTRS const Descriptor &binding() const {
return binding_.descriptor();
}
RT_API_ATTRS const Descriptor &name() const { return name_.descriptor(); }
RT_API_ATTRS std::uint64_t sizeInBytes() const { return sizeInBytes_; }
RT_API_ATTRS const Descriptor &uninstatiated() const {
return uninstantiated_.descriptor();
}
RT_API_ATTRS const Descriptor &kindParameter() const {
return kindParameter_.descriptor();
}
RT_API_ATTRS const Descriptor &lenParameterKind() const {
return lenParameterKind_.descriptor();
}
RT_API_ATTRS const Descriptor &component() const {
return component_.descriptor();
}
RT_API_ATTRS const Descriptor &procPtr() const {
return procPtr_.descriptor();
}
RT_API_ATTRS const Descriptor &special() const {
return special_.descriptor();
}
RT_API_ATTRS bool hasParent() const { return hasParent_; }
RT_API_ATTRS bool noInitializationNeeded() const {
return noInitializationNeeded_;
}
RT_API_ATTRS bool noDestructionNeeded() const { return noDestructionNeeded_; }
RT_API_ATTRS bool noFinalizationNeeded() const {
return noFinalizationNeeded_;
}
RT_API_ATTRS std::size_t LenParameters() const {
return lenParameterKind().Elements();
}
RT_API_ATTRS const DerivedType *GetParentType() const;
// Finds a data component by name in this derived type or its ancestors.
RT_API_ATTRS const Component *FindDataComponent(
const char *name, std::size_t nameLen) const;
// O(1) look-up of special procedure bindings
RT_API_ATTRS const SpecialBinding *FindSpecialBinding(
SpecialBinding::Which which) const {
auto bitIndex{static_cast<std::uint32_t>(which)};
auto bit{std::uint32_t{1} << bitIndex};
if (specialBitSet_ & bit) {
// The index of this special procedure in the sorted array is the
// number of special bindings that are present with smaller "which"
// code values.
int offset{common::BitPopulationCount(specialBitSet_ & (bit - 1))};
const auto *binding{
special_.descriptor().ZeroBasedIndexedElement<SpecialBinding>(
offset)};
INTERNAL_CHECK(binding && binding->which() == which);
return binding;
} else {
return nullptr;
}
}
FILE *Dump(FILE * = stdout) const;
private:
// This member comes first because it's used like a vtable by generated code.
// It includes all of the ancestor types' bindings, if any, first,
// with any overrides from descendants already applied to them. Local
// bindings then follow in alphabetic order of binding name.
StaticDescriptor<1, true>
binding_; // TYPE(BINDING), DIMENSION(:), POINTER, CONTIGUOUS
StaticDescriptor<0> name_; // CHARACTER(:), POINTER
std::uint64_t sizeInBytes_{0};
// Instantiations of a parameterized derived type with KIND type
// parameters will point this data member to the description of
// the original uninstantiated type, which may be shared from a
// module via use association. The original uninstantiated derived
// type description will point to itself. Derived types that have
// no KIND type parameters will have a null pointer here.
StaticDescriptor<0, true> uninstantiated_; // TYPE(DERIVEDTYPE), POINTER
// These pointer targets include all of the items from the parent, if any.
StaticDescriptor<1> kindParameter_; // pointer to rank-1 array of INTEGER(8)
StaticDescriptor<1>
lenParameterKind_; // pointer to rank-1 array of INTEGER(1)
// This array of local data components includes the parent component.
// Components are in component order, not collation order of their names.
// It does not include procedure pointer components.
StaticDescriptor<1, true>
component_; // TYPE(COMPONENT), POINTER, DIMENSION(:), CONTIGUOUS
// Procedure pointer components
StaticDescriptor<1, true>
procPtr_; // TYPE(PROCPTR), POINTER, DIMENSION(:), CONTIGUOUS
// Packed in ascending order of "which" code values.
// Does not include special bindings from ancestral types.
StaticDescriptor<1, true>
special_; // TYPE(SPECIALBINDING), POINTER, DIMENSION(:), CONTIGUOUS
// Little-endian bit-set of special procedure binding "which" code values
// for O(1) look-up in FindSpecialBinding() above.
std::uint32_t specialBitSet_{0};
// Flags
bool hasParent_{false};
bool noInitializationNeeded_{false};
bool noDestructionNeeded_{false};
bool noFinalizationNeeded_{false};
};
} // namespace Fortran::runtime::typeInfo
#endif // FORTRAN_RUNTIME_TYPE_INFO_H_
Codebase Browser
llvm