add_library(FortranRuntime
ISO_Fortran_binding.cc
+ derived-type.cc
descriptor.cc
+ type-code.cc
)
--- /dev/null
+// Copyright (c) 2018, NVIDIA CORPORATION. All rights reserved.
+//
+// Licensed under the Apache License, Version 2.0 (the "License");
+// you may not use this file except in compliance with the License.
+// You may obtain a copy of the License at
+//
+// http://www.apache.org/licenses/LICENSE-2.0
+//
+// Unless required by applicable law or agreed to in writing, software
+// distributed under the License is distributed on an "AS IS" BASIS,
+// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+// See the License for the specific language governing permissions and
+// limitations under the License.
+
+#include "derived-type.h"
+#include "descriptor.h"
+#include <cstring>
+
+namespace Fortran::runtime {
+
+TypeParameterValue TypeParameter::GetValue(const Descriptor &descriptor) const {
+ if (which_ < 0) {
+ return value_;
+ } else {
+ return descriptor.Addendum()->LenParameterValue(which_);
+ }
+}
+
+bool DerivedType::IsNontrivialAnalysis() const {
+ if (kindParameters_ > 0 || lenParameters_ > 0 || typeBoundProcedures_ > 0 ||
+ definedAssignments_ > 0) {
+ return true;
+ }
+ for (int j{0}; j < components_; ++j) {
+ if (component_[j].IsDescriptor()) {
+ return true;
+ }
+ if (const Descriptor * staticDescriptor{component_[j].staticDescriptor()}) {
+ if (const DescriptorAddendum * addendum{staticDescriptor->Addendum()}) {
+ if (const DerivedType * dt{addendum->derivedType()}) {
+ if (dt->IsNontrivial()) {
+ return true;
+ }
+ }
+ }
+ }
+ }
+ return false;
+}
+} // namespace Fortran::runtime
--- /dev/null
+// Copyright (c) 2018, NVIDIA CORPORATION. All rights reserved.
+//
+// Licensed under the Apache License, Version 2.0 (the "License");
+// you may not use this file except in compliance with the License.
+// You may obtain a copy of the License at
+//
+// http://www.apache.org/licenses/LICENSE-2.0
+//
+// Unless required by applicable law or agreed to in writing, software
+// distributed under the License is distributed on an "AS IS" BASIS,
+// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+// See the License for the specific language governing permissions and
+// limitations under the License.
+
+#ifndef FORTRAN_RUNTIME_DERIVED_TYPE_H_
+#define FORTRAN_RUNTIME_DERIVED_TYPE_H_
+
+#include "type-code.h"
+#include "../include/flang/ISO_Fortran_binding.h"
+#include <cinttypes>
+#include <cstddef>
+
+namespace Fortran::runtime {
+
+class Descriptor;
+
+// Static type information about derived type specializations,
+// suitable for residence in read-only storage.
+
+using TypeParameterValue = ISO::CFI_index_t;
+
+class TypeParameter {
+public:
+ const char *name() const { return name_; }
+ const TypeCode typeCode() const { return typeCode_; }
+
+ bool IsLenTypeParameter() const { return which_ < 0; }
+
+ // Returns the static value of a KIND type parameter, or the default
+ // value of a LEN type parameter.
+ TypeParameterValue StaticValue() const { return value_; }
+
+ // Returns the static value of a KIND type parameter, or an
+ // instantiated value of LEN type parameter.
+ TypeParameterValue GetValue(const Descriptor &) const;
+
+private:
+ const char *name_;
+ TypeCode typeCode_; // INTEGER, but not necessarily default kind
+ int which_{-1}; // index into DescriptorAddendum LEN type parameter values
+ TypeParameterValue value_; // default in the case of LEN type parameter
+};
+
+// Components that have any need for a descriptor will either reference
+// a static descriptor that applies to all instances, or will *be* a
+// descriptor. Be advised: the base addresses in static descriptors
+// are null. Most runtime interfaces separate the data address from that
+// of the descriptor, and ignore the encapsulated base address in the
+// descriptor. Some interfaces, e.g. calls to interoperable procedures,
+// cannot pass a separate data address, and any static descriptor being used
+// in that kind of situation must be copied and customized.
+// Static descriptors are flagged in their attributes.
+class Component {
+public:
+ const char *name() const { return name_; }
+ TypeCode typeCode() const { return typeCode_; }
+ const Descriptor *staticDescriptor() const { return staticDescriptor_; }
+
+ bool IsParent() const { return (flags_ & PARENT) != 0; }
+ bool IsPrivate() const { return (flags_ & PRIVATE) != 0; }
+ bool IsDescriptor() const { return (flags_ & IS_DESCRIPTOR) != 0; }
+
+ template<typename A> A *Locate(char *dtInstance) const {
+ return reinterpret_cast<A *>(dtInstance + offset_);
+ }
+ template<typename A> const A *Locate(const char *dtInstance) const {
+ return reinterpret_cast<const A *>(dtInstance + offset_);
+ }
+
+ const Descriptor *GetDescriptor(const char *dtInstance) const {
+ if (staticDescriptor_ != nullptr) {
+ return staticDescriptor_;
+ } else if (IsDescriptor()) {
+ return Locate<const Descriptor>(dtInstance);
+ } else {
+ return nullptr;
+ }
+ }
+
+private:
+ enum Flag { PARENT = 1, PRIVATE = 2, IS_DESCRIPTOR = 4 };
+ const char *name_{nullptr};
+ std::uint32_t flags_{0};
+ TypeCode typeCode_{CFI_type_other};
+ const Descriptor *staticDescriptor_{nullptr};
+ std::size_t offset_{0}; // byte offset in derived type instance
+};
+
+struct ExecutableCode {
+ ExecutableCode() {}
+ ExecutableCode(const ExecutableCode &) = default;
+ ExecutableCode &operator=(const ExecutableCode &) = default;
+ std::intptr_t host{0};
+ std::intptr_t device{0};
+};
+
+struct TypeBoundProcedure {
+ const char *name;
+ ExecutableCode code;
+};
+
+struct DefinedAssignment {
+ int destinationRank, sourceRank;
+ bool isElemental;
+ ExecutableCode code;
+};
+
+// Represents a specialization of a derived type; i.e., any KIND type
+// parameters have values set at compilation time.
+// Extended derived types have the EXTENDS flag set and place their base
+// component first in the component descriptions, which is significant for
+// the execution of FINAL subroutines.
+class DerivedType {
+public:
+ DerivedType(const char *n, int kps, int lps, const TypeParameter *tp, int cs,
+ const Component *ca, int tbps, const TypeBoundProcedure *tbp, int das,
+ const DefinedAssignment *da, std::size_t sz)
+ : name_{n}, kindParameters_{kps}, lenParameters_{lps}, typeParameter_{tp},
+ components_{cs}, component_{ca}, typeBoundProcedures_{tbps},
+ typeBoundProcedure_{tbp}, definedAssignments_{das},
+ definedAssignment_{da}, bytes_{sz} {
+ if (IsNontrivialAnalysis()) {
+ flags_ |= NONTRIVIAL;
+ }
+ }
+
+ const char *name() const { return name_; }
+ int kindParameters() const { return kindParameters_; }
+ int lenParameters() const { return lenParameters_; }
+
+ // KIND type parameters come first.
+ const TypeParameter &typeParameter(int n) const { return typeParameter_[n]; }
+
+ int components() const { return components_; }
+
+ // TBP 0 is the initializer: SUBROUTINE INIT(INSTANCE)
+ static constexpr int initializerTBP{0};
+
+ // TBP 1 is the sourced allocation copier: SUBROUTINE COPYINIT(TO, FROM)
+ static constexpr int copierTBP{1};
+
+ // TBP 2 is the FINAL subroutine.
+ static constexpr int finalTBP{2};
+
+ int typeBoundProcedures() const { return typeBoundProcedures_; }
+ const TypeBoundProcedure &typeBoundProcedure(int n) const {
+ return typeBoundProcedure_[n];
+ }
+
+ DerivedType &set_sequence() {
+ flags_ |= SEQUENCE;
+ return *this;
+ }
+ DerivedType &set_bind_c() {
+ flags_ |= BIND_C;
+ return *this;
+ }
+
+ std::size_t SizeInBytes() const { return bytes_; }
+ bool Extends() const { return components_ > 0 && component_[0].IsParent(); }
+ bool AnyPrivate() const;
+ bool IsSequence() const { return (flags_ & SEQUENCE) != 0; }
+ bool IsBindC() const { return (flags_ & BIND_C) != 0; }
+ bool IsNontrivial() const { return (flags_ & NONTRIVIAL) != 0; }
+
+ bool IsSameType(const DerivedType &) const;
+
+private:
+ enum Flag { SEQUENCE = 1, BIND_C = 2, NONTRIVIAL = 4 };
+
+ // True when any descriptor of data of this derived type will require
+ // an addendum pointing to a DerivedType, possibly with values of
+ // LEN type parameters. Conservative.
+ bool IsNontrivialAnalysis() const;
+
+ const char *name_{""}; // NUL-terminated constant text
+ int kindParameters_{0};
+ int lenParameters_{0};
+ const TypeParameter *typeParameter_{nullptr}; // array
+ int components_{0}; // *not* including type parameters
+ const Component *component_{nullptr}; // array
+ int typeBoundProcedures_{0};
+ const TypeBoundProcedure *typeBoundProcedure_{nullptr}; // array
+ int definedAssignments_{0};
+ const DefinedAssignment *definedAssignment_{nullptr}; // array
+ std::uint64_t flags_{0};
+ std::size_t bytes_{0};
+};
+} // namespace Fortran::runtime
+#endif // FORTRAN_RUNTIME_DERIVED_TYPE_H_
// See the License for the specific language governing permissions and
// limitations under the License.
-// TODO: Not complete; exists to check compilability of descriptor.h
-
#include "descriptor.h"
+#include <cassert>
#include <cstdlib>
-#include <new>
namespace Fortran::runtime {
-TypeCode::TypeCode(TypeCode::Form f, int kind) {
- switch (f) {
- case Form::Integer:
- switch (kind) {
- case 1: raw_ = CFI_type_int8_t; break;
- case 2: raw_ = CFI_type_int16_t; break;
- case 4: raw_ = CFI_type_int32_t; break;
- case 8: raw_ = CFI_type_int64_t; break;
- case 16: raw_ = CFI_type_int128_t; break;
- }
- break;
- case Form::Real:
- switch (kind) {
- case 4: raw_ = CFI_type_float; break;
- case 8: raw_ = CFI_type_double; break;
- case 10:
- case 16: raw_ = CFI_type_long_double; break;
- }
- break;
- case Form::Complex:
- switch (kind) {
- case 4: raw_ = CFI_type_float_Complex; break;
- case 8: raw_ = CFI_type_double_Complex; break;
- case 10:
- case 16: raw_ = CFI_type_long_double_Complex; break;
- }
- break;
- case Form::Character:
- if (kind == 1) {
- raw_ = CFI_type_cptr;
- }
- break;
- case Form::Logical:
- switch (kind) {
- case 1: raw_ = CFI_type_Bool; break;
- case 2: raw_ = CFI_type_int16_t; break;
- case 4: raw_ = CFI_type_int32_t; break;
- case 8: raw_ = CFI_type_int64_t; break;
- }
- break;
- case Form::Derived: raw_ = CFI_type_struct; break;
- }
-}
+Descriptor::~Descriptor() { assert(!(Attributes() & CREATED)); }
-std::size_t DescriptorAddendum::SizeInBytes() const {
- return SizeInBytes(derivedTypeSpecialization_->derivedType().lenParameters());
-}
-
-Descriptor::Descriptor(TypeCode t, std::size_t elementBytes, void *p, int rank,
- const SubscriptValue *extent) {
- CFI_establish(
+int Descriptor::Establish(TypeCode t, std::size_t elementBytes, void *p,
+ int rank, const SubscriptValue *extent) {
+ return CFI_establish(
&raw_, p, CFI_attribute_other, t.raw(), elementBytes, rank, extent);
}
-Descriptor::Descriptor(TypeCode::Form f, int kind, void *p, int rank,
+int Descriptor::Establish(TypeCode::Form f, int kind, void *p, int rank,
const SubscriptValue *extent) {
std::size_t elementBytes = kind;
if (f == TypeCode::Form::Complex) {
elementBytes *= 2;
}
- ISO::CFI_establish(&raw_, p, CFI_attribute_other, TypeCode(f, kind).raw(),
- elementBytes, rank, extent);
+ return ISO::CFI_establish(&raw_, p, CFI_attribute_other,
+ TypeCode(f, kind).raw(), elementBytes, rank, extent);
}
-Descriptor::Descriptor(const DerivedTypeSpecialization &dts, void *p, int rank,
- const SubscriptValue *extent) {
- ISO::CFI_establish(
- &raw_, p, ADDENDUM, CFI_type_struct, dts.SizeInBytes(), rank, extent);
- Addendum()->set_derivedTypeSpecialization(dts);
+int Descriptor::Establish(
+ const DerivedType &dt, void *p, int rank, const SubscriptValue *extent) {
+ int result{ISO::CFI_establish(
+ &raw_, p, ADDENDUM, CFI_type_struct, dt.SizeInBytes(), rank, extent)};
+ Addendum()->set_derivedType(dt);
+ return result;
}
Descriptor *Descriptor::Create(TypeCode t, std::size_t elementBytes, void *p,
int rank, const SubscriptValue *extent) {
- return new (new char[SizeInBytes(rank)])
- Descriptor{t, elementBytes, p, rank, extent};
+ std::size_t bytes{SizeInBytes(rank)};
+ Descriptor *result{reinterpret_cast<Descriptor *>(new char[bytes])};
+ result->Establish(t, elementBytes, p, rank, extent);
+ result->Attributes() |= CREATED;
+ return result;
}
Descriptor *Descriptor::Create(TypeCode::Form f, int kind, void *p, int rank,
const SubscriptValue *extent) {
- return new (new char[SizeInBytes(rank)]) Descriptor{f, kind, p, rank, extent};
+ std::size_t bytes{SizeInBytes(rank)};
+ Descriptor *result{reinterpret_cast<Descriptor *>(new char[bytes])};
+ result->Establish(f, kind, p, rank, extent);
+ result->Attributes() |= CREATED;
+ return result;
}
-Descriptor *Descriptor::Create(const DerivedTypeSpecialization &dts, void *p,
- int rank, const SubscriptValue *extent) {
- const DerivedType &derivedType{dts.derivedType()};
- return new (new char[SizeInBytes(rank, derivedType.IsNontrivial(),
- derivedType.lenParameters())]) Descriptor{dts, p, rank, extent};
+Descriptor *Descriptor::Create(
+ const DerivedType &dt, void *p, int rank, const SubscriptValue *extent) {
+ std::size_t bytes{SizeInBytes(rank, dt.IsNontrivial(), dt.lenParameters())};
+ Descriptor *result{reinterpret_cast<Descriptor *>(new char[bytes])};
+ result->Establish(dt, p, rank, extent);
+ result->Attributes() |= CREATED;
+ return result;
}
-void Descriptor::Destroy() { delete[] reinterpret_cast<char *>(this); }
+void Descriptor::Destroy() {
+ if (Attributes() & CREATED) {
+ delete[] reinterpret_cast<char *>(this);
+ }
+}
-void Descriptor::SetDerivedTypeSpecialization(
- const DerivedTypeSpecialization &dts) {
- raw_.attribute |= ADDENDUM;
- Addendum()->set_derivedTypeSpecialization(dts);
+void Descriptor::SetDerivedType(const DerivedType &dt) {
+ Attributes() |= ADDENDUM;
+ Addendum()->set_derivedType(dt);
}
void Descriptor::SetLenParameterValue(int which, TypeParameterValue x) {
- raw_.attribute |= ADDENDUM;
+ Attributes() |= ADDENDUM;
Addendum()->SetLenParameterValue(which, x);
}
(addendum ? addendum->SizeInBytes() : 0);
}
-TypeParameterValue TypeParameter::KindParameterValue(
- const DerivedTypeSpecialization &specialization) const {
- return specialization.KindParameterValue(which_);
-}
-
-TypeParameterValue TypeParameter::Value(const Descriptor &descriptor) const {
- const DescriptorAddendum &addendum{*descriptor.Addendum()};
- if (isLenTypeParameter_) {
- return addendum.LenParameterValue(which_);
- } else {
- return KindParameterValue(*addendum.derivedTypeSpecialization());
- }
+void Descriptor::Check() const {
+ // TODO
}
-bool DerivedType::IsNontrivialAnalysis() const {
- if (kindParameters_ > 0 || lenParameters_ > 0 || typeBoundProcedures_ > 0 ||
- definedAssignments_ > 0 || finalSubroutine_.host != 0) {
- return true;
- }
- for (int j{0}; j < components_; ++j) {
- if (component_[j].IsDescriptor()) {
- return true;
- }
- if (const Descriptor * staticDescriptor{component_[j].staticDescriptor()}) {
- if (const DescriptorAddendum * addendum{staticDescriptor->Addendum()}) {
- if (const DerivedTypeSpecialization *
- dts{addendum->derivedTypeSpecialization()}) {
- if (dts->derivedType().IsNontrivial()) {
- return true;
- }
- }
- }
- }
+std::size_t DescriptorAddendum::SizeInBytes() const {
+ if (derivedType_ == nullptr) {
+ return 0;
}
- return false;
+ return SizeInBytes(derivedType_->lenParameters());
}
} // namespace Fortran::runtime
// User C code is welcome to depend on that ISO_Fortran_binding.h file,
// but should never reference this internal header.
+#include "derived-type.h"
+#include "type-code.h"
#include "../include/flang/ISO_Fortran_binding.h"
+#include <cassert>
#include <cinttypes>
#include <cstddef>
+#include <cstring>
namespace Fortran::runtime {
-class DerivedTypeSpecialization;
-
-using TypeParameterValue = ISO::CFI_index_t;
using SubscriptValue = ISO::CFI_index_t;
+static constexpr int maxRank{CFI_MAX_RANK};
+
// A C++ view of the sole interoperable standard descriptor (ISO_cdesc_t)
// and its type and per-dimension information.
-class TypeCode {
-public:
- enum class Form { Integer, Real, Complex, Character, Logical, Derived };
-
- TypeCode() {}
- explicit TypeCode(ISO::CFI_type_t t) : raw_{t} {}
- TypeCode(Form, int);
-
- int raw() const { return raw_; }
-
- constexpr bool IsValid() const {
- return raw_ >= CFI_type_signed_char && raw_ <= CFI_type_struct;
- }
- constexpr bool IsInteger() const {
- return raw_ >= CFI_type_signed_char && raw_ <= CFI_type_ptrdiff_t;
- }
- constexpr bool IsReal() const {
- return raw_ >= CFI_type_float && raw_ <= CFI_type_long_double;
- }
- constexpr bool IsComplex() const {
- return raw_ >= CFI_type_float_Complex &&
- raw_ <= CFI_type_long_double_Complex;
- }
- constexpr bool IsCharacter() const { return raw_ == CFI_type_cptr; }
- constexpr bool IsLogical() const { return raw_ == CFI_type_Bool; }
- constexpr bool IsDerived() const { return raw_ == CFI_type_struct; }
-
- constexpr bool IsIntrinsic() const { return IsValid() && !IsDerived(); }
-
- constexpr Form GetForm() const {
- if (IsInteger()) {
- return Form::Integer;
- }
- if (IsReal()) {
- return Form::Real;
- }
- if (IsComplex()) {
- return Form::Complex;
- }
- if (IsCharacter()) {
- return Form::Character;
- }
- if (IsLogical()) {
- return Form::Logical;
- }
- return Form::Derived;
- }
-
-private:
- ISO::CFI_type_t raw_{CFI_type_other};
-};
-
class Dimension {
public:
SubscriptValue LowerBound() const { return raw_.lower_bound; }
private:
ISO::CFI_dim_t raw_;
};
-static_assert(sizeof(Dimension) == sizeof(ISO::CFI_dim_t));
// The storage for this object follows the last used dim[] entry in a
-// Descriptor (CFI_cdesc_t) generic descriptor; this is why that class
-// cannot be defined as a derivation or encapsulation of the standard
-// argument descriptor. Space matters here, since dynamic descriptors
-// can serve as components of derived type instances. The presence of
-// this structure is implied by (CFI_cdesc_t.attribute & ADDENDUM) != 0,
-// and the number of elements in the len_[] array is determined by
-// DerivedType::lenParameters().
+// Descriptor (CFI_cdesc_t) generic descriptor. Space matters here, since
+// descriptors serve as POINTER and ALLOCATABLE components of derived type
+// instances. The presence of this structure is implied by the flag
+// (CFI_cdesc_t.attribute & ADDENDUM) != 0, and the number of elements in
+// the len_[] array is determined by DerivedType::lenParameters().
class DescriptorAddendum {
public:
- explicit DescriptorAddendum(const DerivedTypeSpecialization &dts)
- : derivedTypeSpecialization_{&dts} {}
+ explicit DescriptorAddendum(const DerivedType &dt) : derivedType_{&dt} {}
- DescriptorAddendum &set_derivedTypeSpecialization(
- const DerivedTypeSpecialization &dts) {
- derivedTypeSpecialization_ = &dts;
- return *this;
- }
+ const DerivedType *derivedType() const { return derivedType_; }
- const DerivedTypeSpecialization *derivedTypeSpecialization() const {
- return derivedTypeSpecialization_;
+ DescriptorAddendum &set_derivedType(const DerivedType &dt) {
+ derivedType_ = &dt;
+ return *this;
}
TypeParameterValue LenParameterValue(int which) const { return len_[which]; }
}
private:
- const DerivedTypeSpecialization *derivedTypeSpecialization_{nullptr};
+ const DerivedType *derivedType_{nullptr};
TypeParameterValue len_[1]; // must be the last component
// The LEN type parameter values can also include captured values of
// specification expressions that were used for bounds and for LEN type
// A C++ view of a standard descriptor object.
class Descriptor {
public:
- Descriptor(TypeCode t, std::size_t elementBytes, void *p = nullptr,
- int rank = CFI_MAX_RANK, const SubscriptValue *extent = nullptr);
- Descriptor(TypeCode::Form f, int kind, void *p = nullptr,
- int rank = CFI_MAX_RANK, const SubscriptValue *extent = nullptr);
- Descriptor(const DerivedTypeSpecialization &dts, void *p = nullptr,
- int rank = CFI_MAX_RANK, const SubscriptValue *extent = nullptr);
+ // Be advised: this class type is not suitable for use when allocating
+ // a descriptor -- it is a dynamic view of the common descriptor format.
+ // If used in a simple declaration of a local variable or dynamic allocation,
+ // the size is going to be wrong, since the true size of a descriptor
+ // depends on the number of its dimensions and the presence of an addendum
+ // with derived type information. Use the class template StaticDescriptor
+ // (below) to declare a descriptor with type and rank that are known at
+ // compilation time. Use the Create() static member functions to
+ // dynamically allocate a descriptor when the type or rank are not known
+ // at compilation time.
+ Descriptor() = delete;
+
+ ~Descriptor();
+
+ int Establish(TypeCode t, std::size_t elementBytes, void *p = nullptr,
+ int rank = maxRank, const SubscriptValue *extent = nullptr);
+ int Establish(TypeCode::Form f, int kind, void *p = nullptr,
+ int rank = maxRank, const SubscriptValue *extent = nullptr);
+ int Establish(const DerivedType &dt, void *p = nullptr, int rank = maxRank,
+ const SubscriptValue *extent = nullptr);
static Descriptor *Create(TypeCode t, std::size_t elementBytes,
- void *p = nullptr, int rank = CFI_MAX_RANK,
+ void *p = nullptr, int rank = maxRank,
const SubscriptValue *extent = nullptr);
static Descriptor *Create(TypeCode::Form f, int kind, void *p = nullptr,
- int rank = CFI_MAX_RANK, const SubscriptValue *extent = nullptr);
- static Descriptor *Create(const DerivedTypeSpecialization &dts,
- void *p = nullptr, int rank = CFI_MAX_RANK,
- const SubscriptValue *extent = nullptr);
+ int rank = maxRank, const SubscriptValue *extent = nullptr);
+ static Descriptor *Create(const DerivedType &dt, void *p = nullptr,
+ int rank = maxRank, const SubscriptValue *extent = nullptr);
+
+ // Descriptor instances allocated via Create() above must be deallocated
+ // by calling Destroy() so that operator delete[] is invoked.
void Destroy();
ISO::CFI_cdesc_t &raw() { return raw_; }
return *this;
}
- bool IsPointer() const {
- return (raw_.attribute & CFI_attribute_pointer) != 0;
- }
+ bool IsPointer() const { return (Attributes() & CFI_attribute_pointer) != 0; }
bool IsAllocatable() const {
- return (raw_.attribute & CFI_attribute_allocatable) != 0;
+ return (Attributes() & CFI_attribute_allocatable) != 0;
}
bool IsImplicitlyAllocated() const {
- return (raw_.attribute & IMPLICITLY_ALLOCATED) != 0;
+ return (Attributes() & IMPLICITLY_ALLOCATED) != 0;
}
bool IsDescriptorStatic() const {
- return (raw_.attribute & STATIC_DESCRIPTOR) != 0;
+ return (Attributes() & STATIC_DESCRIPTOR) != 0;
}
bool IsTarget() const {
- return (raw_.attribute & (CFI_attribute_pointer | TARGET)) != 0;
+ return (Attributes() & (CFI_attribute_pointer | TARGET)) != 0;
}
- bool IsContiguous() const { return (raw_.attribute & CONTIGUOUS) != 0; }
+ bool IsContiguous() const { return (Attributes() & CONTIGUOUS) != 0; }
bool IsColumnContiguous() const {
- return (raw_.attribute & COLUMN_CONTIGUOUS) != 0;
+ return (Attributes() & COLUMN_CONTIGUOUS) != 0;
}
- bool IsTemporary() const { return (raw_.attribute & TEMPORARY) != 0; }
+ bool IsTemporary() const { return (Attributes() & TEMPORARY) != 0; }
Dimension &GetDimension(int dim) {
return *reinterpret_cast<Dimension *>(&raw_.dim[dim]);
}
DescriptorAddendum *Addendum() {
- if ((raw_.attribute & ADDENDUM) != 0) {
+ if ((Attributes() & ADDENDUM) != 0) {
return reinterpret_cast<DescriptorAddendum *>(&GetDimension(rank()));
} else {
return nullptr;
}
}
const DescriptorAddendum *Addendum() const {
- if ((raw_.attribute & ADDENDUM) != 0) {
+ if ((Attributes() & ADDENDUM) != 0) {
return reinterpret_cast<const DescriptorAddendum *>(
&GetDimension(rank()));
} else {
}
}
- void SetDerivedTypeSpecialization(const DerivedTypeSpecialization &);
+ void SetDerivedType(const DerivedType &);
void SetLenParameterValue(int, TypeParameterValue);
void Check() const;
- // TODO: creation of sections
+ // TODO: creation of array sections
template<typename A> A &Element(std::size_t offset = 0) const {
auto p = reinterpret_cast<char *>(raw_.base_addr);
private:
// These values must coexist with the ISO_Fortran_binding.h definitions
// for CFI_attribute_... values and fit in the "attribute" field of
- // CFI_cdesc_t.
+ // CFI_cdesc_t, which is 16 bits wide.
enum AdditionalAttributes {
// non-pointer nonallocatable derived type component implemented as
// an implicit allocatable due to dependence on LEN type parameters
- IMPLICITLY_ALLOCATED = 0x100, // bounds depend on LEN type parameter
- ADDENDUM = 0x200, // last dim[] entry is followed by DescriptorAddendum
- STATIC_DESCRIPTOR = 0x400, // base_addr is null, get base address elsewhere
- TARGET = 0x800, // TARGET attribute; also implied by CFI_attribute_pointer
- CONTIGUOUS = 0x1000,
- COLUMN_CONTIGUOUS = 0x2000, // first dimension is contiguous
- TEMPORARY = 0x4000, // compiler temp, do not finalize
+ IMPLICITLY_ALLOCATED = 0x8, // bounds depend on LEN type parameter
+ ADDENDUM = 0x10, // last dim[] entry is followed by DescriptorAddendum
+ STATIC_DESCRIPTOR = 0x20, // base_addr is null, get base address elsewhere
+ TARGET = 0x40, // TARGET attribute; also implied by CFI_attribute_pointer
+ CONTIGUOUS = 0x80,
+ COLUMN_CONTIGUOUS = 0x100, // first dimension is contiguous
+ TEMPORARY = 0x200, // compiler temp, do not finalize
+ CREATED = 0x400, // was allocated by Descriptor::Create()
};
+ ISO::CFI_attribute_t &Attributes() { return raw_.attribute; }
+ const ISO::CFI_attribute_t &Attributes() const { return raw_.attribute; }
+
ISO::CFI_cdesc_t raw_;
};
static_assert(sizeof(Descriptor) == sizeof(ISO::CFI_cdesc_t));
-// Static type information is suitable for residence in a read-only section.
-// Information about intrinsic types is inferable from raw CFI_type_t
-// type codes (packaged as TypeCode above).
-// Information about derived types and their KIND parameter specializations
-// appears in the compiled program units that define or specialize the types.
-
-class TypeParameter {
-public:
- const char *name() const { return name_; }
- const TypeCode typeCode() const { return typeCode_; }
- bool isLenTypeParameter() const { return isLenTypeParameter_; }
- int which() const { return which_; }
- TypeParameterValue defaultValue() const { return defaultValue_; }
-
- TypeParameterValue KindParameterValue(
- const DerivedTypeSpecialization &) const;
- TypeParameterValue Value(const Descriptor &) const;
-
-private:
- const char *name_;
- TypeCode typeCode_; // INTEGER, but not necessarily default kind
- bool isLenTypeParameter_; // whether value is in dynamic descriptor
- int which_; // index of this parameter in kind/len array
- TypeParameterValue defaultValue_;
-};
-
-// Components that have any need for a descriptor will either reference
-// a static descriptor that applies to all instances, or will *be* a
-// descriptor. Be advised: the base addresses in static descriptors
-// are null. Most runtime interfaces separate the data address from that
-// of the descriptor, and ignore the encapsulated base address in the
-// descriptor. Some interfaces, e.g. calls to interoperable procedures,
-// cannot pass a separate data address, and any static descriptor being used
-// in that kind of situation must be copied and customized.
-// Static descriptors are flagged in their attributes.
-class Component {
-public:
- const char *name() const { return name_; }
- TypeCode typeCode() const { return typeCode_; }
- const Descriptor *staticDescriptor() const { return staticDescriptor_; }
- bool IsParent() const { return (flags_ & PARENT) != 0; }
- bool IsPrivate() const { return (flags_ & PRIVATE) != 0; }
- bool IsDescriptor() const { return (flags_ & IS_DESCRIPTOR) != 0; }
-
-private:
- enum Flag { PARENT = 1, PRIVATE = 2, IS_DESCRIPTOR = 4 };
- const char *name_{nullptr};
- std::uint32_t flags_{0};
- TypeCode typeCode_{CFI_type_other};
- const Descriptor *staticDescriptor_{nullptr};
-};
-
-struct ExecutableCode {
- ExecutableCode() {}
- ExecutableCode(const ExecutableCode &) = default;
- ExecutableCode &operator=(const ExecutableCode &) = default;
- std::intptr_t host{0};
- std::intptr_t device{0};
-};
-
-struct TypeBoundProcedure {
- const char *name;
- ExecutableCode code;
-};
-
-struct DefinedAssignment {
- int destinationRank, sourceRank;
- bool isElemental;
- ExecutableCode code;
-};
-
-// This static description of a derived type is not specialized by
-// the values of kind type parameters. All specializations share
-// this information.
-// Extended derived types have the EXTENDS flag set and place their base
-// component first in the component descriptions, which is significant for
-// the execution of FINAL subroutines.
-class DerivedType {
-public:
- DerivedType(const char *n, int kps, int lps, const TypeParameter *tp, int cs,
- const Component *ca, int tbps, const TypeBoundProcedure *tbp, int das,
- const DefinedAssignment *da)
- : name_{n}, kindParameters_{kps}, lenParameters_{lps}, components_{cs},
- typeParameter_{tp}, typeBoundProcedures_{tbps}, typeBoundProcedure_{tbp},
- definedAssignments_{das}, definedAssignment_{da} {
- if (IsNontrivialAnalysis()) {
- flags_ |= NONTRIVIAL;
- }
- }
-
- const char *name() const { return name_; }
- int kindParameters() const { return kindParameters_; }
- int lenParameters() const { return lenParameters_; }
- const TypeParameter &typeParameter(int n) const { return typeParameter_[n]; }
- int components() const { return components_; }
- int typeBoundProcedures() const { return typeBoundProcedures_; }
- const TypeBoundProcedure &typeBoundProcedure(int n) const {
- return typeBoundProcedure_[n];
- }
-
- DerivedType &set_sequence() {
- flags_ |= SEQUENCE;
- return *this;
- }
- DerivedType &set_bind_c() {
- flags_ |= BIND_C;
- return *this;
- }
- DerivedType &set_finalSubroutine(const ExecutableCode &c) {
- finalSubroutine_ = c;
- return *this;
- }
-
- bool Extends() const { return components_ > 0 && component_[0].IsParent(); }
- bool AnyPrivate() const;
- bool IsSequence() const { return (flags_ & SEQUENCE) != 0; }
- bool IsBindC() const { return (flags_ & BIND_C) != 0; }
- bool IsNontrivial() const { return (flags_ & NONTRIVIAL) != 0; }
-
- // TODO: assignment
- // TODO: finalization
-
-private:
- enum Flag { SEQUENCE = 1, BIND_C = 2, NONTRIVIAL = 4 };
-
- // True when any descriptor of data of this derived type will require
- // an addendum pointing to a DerivedTypeSpecialization &/or values of
- // length type parameters. Conservative.
- bool IsNontrivialAnalysis() const;
-
- const char *name_{""}; // NUL-terminated constant text
- int kindParameters_{0};
- int lenParameters_{0};
- int components_{0}; // *not* including type parameters
- const TypeParameter *typeParameter_{nullptr}; // array
- const Component *component_{nullptr}; // array
- int typeBoundProcedures_{0};
- const TypeBoundProcedure *typeBoundProcedure_{
- nullptr}; // array of overridable TBP bindings
- ExecutableCode finalSubroutine_; // can be null
- int definedAssignments_{0};
- const DefinedAssignment *definedAssignment_{nullptr}; // array
- std::uint64_t flags_{0};
-};
-
-class ComponentSpecialization {
-public:
- template<typename A> A *Locate(char *instance) const {
- return reinterpret_cast<A *>(instance + offset_);
- }
- template<typename A> const A *Locate(const char *instance) const {
- return reinterpret_cast<const A *>(instance + offset_);
- }
- const Descriptor *GetDescriptor(
- const Component &c, const char *instance) const {
- if (const Descriptor * staticDescriptor{c.staticDescriptor()}) {
- return staticDescriptor;
- } else if (c.IsDescriptor()) {
- return Locate<const Descriptor>(instance);
- } else {
- return nullptr;
- }
- }
-
-private:
- std::size_t offset_{0}; // relative to start of derived type instance
-};
-
-// This static representation of a derived type specialization includes
-// the values of all its KIND type parameters, and reflects those values
-// in the values of array bounds and static derived type descriptors that
-// appear in the static descriptors of the components.
-class DerivedTypeSpecialization {
-public:
- DerivedTypeSpecialization(const DerivedType &dt, std::size_t n,
- const char *init, const TypeParameterValue *kp,
- const ComponentSpecialization *cs)
- : derivedType_{dt}, bytes_{n}, initializer_{init}, kindParameterValue_{kp},
- componentSpecialization_{cs} {}
-
- const DerivedType &derivedType() const { return derivedType_; }
-
- std::size_t SizeInBytes() const { return bytes_; }
- TypeParameterValue KindParameterValue(int n) const {
- return kindParameterValue_[n];
- }
- const ComponentSpecialization &GetComponent(int n) const {
- return componentSpecialization_[n];
- }
- bool IsSameType(const DerivedTypeSpecialization &) const;
-
- // TODO: initialization
- // TODO: sourced allocation initialization
-
-private:
- const DerivedType &derivedType_;
- std::size_t bytes_; // allocation size of one scalar instance, w/ alignment
- const char *initializer_; // can be null; includes base components
- const TypeParameterValue *kindParameterValue_; // array
- const ComponentSpecialization *componentSpecialization_; // array
-};
-
-// Procedure pointers have static links for host association.
-// TODO: define the target data structure of that static link
-struct ProcedurePointer {
- ExecutableCode entryAddresses;
- void *staticLink;
-};
-
-template<int MAX_RANK = CFI_MAX_RANK,
- bool NONTRIVIAL_DERIVED_TYPE_ALLOWED = false, int MAX_LEN_PARMS = 0>
+// Properly configured instances of StaticDescriptor will occupy the
+// exact amount of storage required for the descriptor based on its
+// number of dimensions and whether it requires an addendum. To build
+// such a static descriptor, declare an instance of StaticDescriptor<>,
+// extract a reference to the Descriptor via the descriptor() accessor,
+// and then built a Descriptor therein via descriptor.Establish().
+// e.g.:
+// StaticDescriptor<R,NT,LP> statDesc;
+// Descriptor &descriptor{statDesc.descriptor()};
+// descriptor.Establish( ... );
+template<int MAX_RANK = maxRank, bool NONTRIVIAL_DERIVED_TYPE_ALLOWED = false,
+ int MAX_LEN_PARMS = 0>
class alignas(Descriptor) StaticDescriptor {
public:
static constexpr int maxRank{MAX_RANK};
static constexpr int maxLengthTypeParameters{MAX_LEN_PARMS};
static constexpr bool hasAddendum{
NONTRIVIAL_DERIVED_TYPE_ALLOWED || MAX_LEN_PARMS > 0};
+ static constexpr std::size_t byteSize{
+ Descriptor::SizeInBytes(maxRank, hasAddendum, maxLengthTypeParameters)};
- Descriptor &descriptor() { return *reinterpret_cast<Descriptor *>(this); }
+ Descriptor &descriptor() { return *reinterpret_cast<Descriptor *>(storage_); }
const Descriptor &descriptor() const {
- return *reinterpret_cast<const Descriptor *>(this);
+ return *reinterpret_cast<const Descriptor *>(storage_);
+ }
+
+ void Check() {
+ assert(descriptor().SizeInBytes() <= byteSize);
+ assert(descriptor().rank() <= maxRank);
+ if (DescriptorAddendum * addendum{descriptor().Addendum()}) {
+ if (const DerivedType * dt{addendum->derivedType()}) {
+ assert(dt->lenParameters() <= maxLengthTypeParameters);
+ } else {
+ assert(maxLengthTypeParameters == 0);
+ }
+ } else {
+ assert(!hasAddendum);
+ assert(maxLengthTypeParameters == 0);
+ }
}
- // Usage with placement new:
- // StaticDescriptor<R,NT,LP> staticDescriptor;
- // new(staticDescriptor.storage()) Descriptor{ .... }
- char *storage() const { return storage_; }
-
private:
- static constexpr std::size_t byteSize{
- Descriptor::SizeInBytes(maxRank, hasAddendum, maxLengthTypeParameters)};
char storage_[byteSize];
};
} // namespace Fortran::runtime
--- /dev/null
+// Copyright (c) 2018, NVIDIA CORPORATION. All rights reserved.
+//
+// Licensed under the Apache License, Version 2.0 (the "License");
+// you may not use this file except in compliance with the License.
+// You may obtain a copy of the License at
+//
+// http://www.apache.org/licenses/LICENSE-2.0
+//
+// Unless required by applicable law or agreed to in writing, software
+// distributed under the License is distributed on an "AS IS" BASIS,
+// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+// See the License for the specific language governing permissions and
+// limitations under the License.
+
+#include "type-code.h"
+
+namespace Fortran::runtime {
+
+TypeCode::TypeCode(TypeCode::Form f, int kind) {
+ switch (f) {
+ case Form::Integer:
+ switch (kind) {
+ case 1: raw_ = CFI_type_int8_t; break;
+ case 2: raw_ = CFI_type_int16_t; break;
+ case 4: raw_ = CFI_type_int32_t; break;
+ case 8: raw_ = CFI_type_int64_t; break;
+ case 16: raw_ = CFI_type_int128_t; break;
+ }
+ break;
+ case Form::Real:
+ switch (kind) {
+ case 4: raw_ = CFI_type_float; break;
+ case 8: raw_ = CFI_type_double; break;
+ case 10:
+ case 16: raw_ = CFI_type_long_double; break;
+ }
+ break;
+ case Form::Complex:
+ switch (kind) {
+ case 4: raw_ = CFI_type_float_Complex; break;
+ case 8: raw_ = CFI_type_double_Complex; break;
+ case 10:
+ case 16: raw_ = CFI_type_long_double_Complex; break;
+ }
+ break;
+ case Form::Character:
+ if (kind == 1) {
+ raw_ = CFI_type_cptr;
+ }
+ break;
+ case Form::Logical:
+ switch (kind) {
+ case 1: raw_ = CFI_type_Bool; break;
+ case 2: raw_ = CFI_type_int16_t; break;
+ case 4: raw_ = CFI_type_int32_t; break;
+ case 8: raw_ = CFI_type_int64_t; break;
+ }
+ break;
+ case Form::Derived: raw_ = CFI_type_struct; break;
+ }
+}
+
+} // namespace Fortran::runtime
--- /dev/null
+// Copyright (c) 2018, NVIDIA CORPORATION. All rights reserved.
+//
+// Licensed under the Apache License, Version 2.0 (the "License");
+// you may not use this file except in compliance with the License.
+// You may obtain a copy of the License at
+//
+// http://www.apache.org/licenses/LICENSE-2.0
+//
+// Unless required by applicable law or agreed to in writing, software
+// distributed under the License is distributed on an "AS IS" BASIS,
+// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+// See the License for the specific language governing permissions and
+// limitations under the License.
+
+#ifndef FORTRAN_RUNTIME_TYPE_CODE_H_
+#define FORTRAN_RUNTIME_TYPE_CODE_H_
+
+#include "../include/flang/ISO_Fortran_binding.h"
+
+namespace Fortran::runtime {
+
+class TypeCode {
+public:
+ enum class Form { Integer, Real, Complex, Character, Logical, Derived };
+
+ TypeCode() {}
+ explicit TypeCode(ISO::CFI_type_t t) : raw_{t} {}
+ TypeCode(Form, int);
+
+ int raw() const { return raw_; }
+
+ constexpr bool IsValid() const {
+ return raw_ >= CFI_type_signed_char && raw_ <= CFI_type_struct;
+ }
+ constexpr bool IsInteger() const {
+ return raw_ >= CFI_type_signed_char && raw_ <= CFI_type_ptrdiff_t;
+ }
+ constexpr bool IsReal() const {
+ return raw_ >= CFI_type_float && raw_ <= CFI_type_long_double;
+ }
+ constexpr bool IsComplex() const {
+ return raw_ >= CFI_type_float_Complex &&
+ raw_ <= CFI_type_long_double_Complex;
+ }
+ constexpr bool IsCharacter() const { return raw_ == CFI_type_cptr; }
+ constexpr bool IsLogical() const { return raw_ == CFI_type_Bool; }
+ constexpr bool IsDerived() const { return raw_ == CFI_type_struct; }
+
+ constexpr bool IsIntrinsic() const { return IsValid() && !IsDerived(); }
+
+ constexpr Form GetForm() const {
+ if (IsInteger()) {
+ return Form::Integer;
+ }
+ if (IsReal()) {
+ return Form::Real;
+ }
+ if (IsComplex()) {
+ return Form::Complex;
+ }
+ if (IsCharacter()) {
+ return Form::Character;
+ }
+ if (IsLogical()) {
+ return Form::Logical;
+ }
+ return Form::Derived;
+ }
+
+private:
+ ISO::CFI_type_t raw_{CFI_type_other};
+};
+} // namespace Fortran::runtime
+#endif // FORTRAN_RUNTIME_TYPE_CODE_H_
projects / platform / upstream / llvm.git / commitdiff