forked from OSchip/llvm-project
[flang] break up runtime into multiple headers and source files
Original-commit: flang-compiler/f18@7863350552 Reviewed-on: https://github.com/flang-compiler/f18/pull/162 Tree-same-pre-rewrite: false
This commit is contained in:
peter klausler
parent
79c74948cc
commit
2dce7b9554
|
|
@ -14,5 +14,7 @@
|
|||
|
||||
add_library(FortranRuntime
|
||||
ISO_Fortran_binding.cc
|
||||
derived-type.cc
|
||||
descriptor.cc
|
||||
type-code.cc
|
||||
)
|
||||
|
|
|
|||
|
|
@ -0,0 +1,50 @@
|
|||
// 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
|
||||
|
|
@ -0,0 +1,200 @@
|
|||
// 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_
|
||||
|
|
@ -12,113 +12,78 @@
|
|||
// 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);
|
||||
}
|
||||
|
||||
|
|
@ -128,40 +93,14 @@ std::size_t Descriptor::SizeInBytes() const {
|
|||
(addendum ? addendum->SizeInBytes() : 0);
|
||||
}
|
||||
|
||||
TypeParameterValue TypeParameter::KindParameterValue(
|
||||
const DerivedTypeSpecialization &specialization) const {
|
||||
return specialization.KindParameterValue(which_);
|
||||
void Descriptor::Check() const {
|
||||
// TODO
|
||||
}
|
||||
|
||||
TypeParameterValue TypeParameter::Value(const Descriptor &descriptor) const {
|
||||
const DescriptorAddendum &addendum{*descriptor.Addendum()};
|
||||
if (isLenTypeParameter_) {
|
||||
return addendum.LenParameterValue(which_);
|
||||
} else {
|
||||
return KindParameterValue(*addendum.derivedTypeSpecialization());
|
||||
std::size_t DescriptorAddendum::SizeInBytes() const {
|
||||
if (derivedType_ == nullptr) {
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
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;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
return false;
|
||||
return SizeInBytes(derivedType_->lenParameters());
|
||||
}
|
||||
} // namespace Fortran::runtime
|
||||
|
|
|
|||
|
|
@ -24,72 +24,23 @@
|
|||
// 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; }
|
||||
|
|
@ -100,31 +51,24 @@ public:
|
|||
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;
|
||||
const DerivedType *derivedType() const { return derivedType_; }
|
||||
|
||||
DescriptorAddendum &set_derivedType(const DerivedType &dt) {
|
||||
derivedType_ = &dt;
|
||||
return *this;
|
||||
}
|
||||
|
||||
const DerivedTypeSpecialization *derivedTypeSpecialization() const {
|
||||
return derivedTypeSpecialization_;
|
||||
}
|
||||
|
||||
TypeParameterValue LenParameterValue(int which) const { return len_[which]; }
|
||||
static constexpr std::size_t SizeInBytes(int lenParameters) {
|
||||
return sizeof(DescriptorAddendum) - sizeof(TypeParameterValue) +
|
||||
|
|
@ -137,7 +81,7 @@ public:
|
|||
}
|
||||
|
||||
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
|
||||
|
|
@ -148,21 +92,37 @@ private:
|
|||
// 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_; }
|
||||
|
|
@ -176,26 +136,24 @@ public:
|
|||
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]);
|
||||
|
|
@ -211,14 +169,14 @@ public:
|
|||
}
|
||||
|
||||
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 {
|
||||
|
|
@ -226,7 +184,7 @@ public:
|
|||
}
|
||||
}
|
||||
|
||||
void SetDerivedTypeSpecialization(const DerivedTypeSpecialization &);
|
||||
void SetDerivedType(const DerivedType &);
|
||||
|
||||
void SetLenParameterValue(int, TypeParameterValue);
|
||||
|
||||
|
|
@ -243,7 +201,7 @@ public:
|
|||
|
||||
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);
|
||||
|
|
@ -253,254 +211,69 @@ public:
|
|||
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};
|
||||
|
||||
Descriptor &descriptor() { return *reinterpret_cast<Descriptor *>(this); }
|
||||
const Descriptor &descriptor() const {
|
||||
return *reinterpret_cast<const Descriptor *>(this);
|
||||
}
|
||||
|
||||
// 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)};
|
||||
|
||||
Descriptor &descriptor() { return *reinterpret_cast<Descriptor *>(storage_); }
|
||||
const Descriptor &descriptor() const {
|
||||
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);
|
||||
}
|
||||
}
|
||||
|
||||
private:
|
||||
char storage_[byteSize];
|
||||
};
|
||||
} // namespace Fortran::runtime
|
||||
|
|
|
|||
|
|
@ -0,0 +1,63 @@
|
|||
// 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
|
||||
|
|
@ -0,0 +1,74 @@
|
|||
// 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_
|
||||
Loading…
Reference in New Issue