[flang-commits] [flang] 6aa3591 - [flang] Implement STORAGE_SIZE(), SIZEOF(), C_SIZEOF()
peter klausler via flang-commits
flang-commits at lists.llvm.org
Tue Dec 15 17:26:32 PST 2020
Author: peter klausler
Date: 2020-12-15T17:26:20-08:00
New Revision: 6aa3591e98402418e110c506cdd488ed1e3021b6
URL: https://github.com/llvm/llvm-project/commit/6aa3591e98402418e110c506cdd488ed1e3021b6
DIFF: https://github.com/llvm/llvm-project/commit/6aa3591e98402418e110c506cdd488ed1e3021b6.diff
LOG: [flang] Implement STORAGE_SIZE(), SIZEOF(), C_SIZEOF()
STORAGE_SIZE() is a standard inquiry intrinsic (size in bits
of an array element of the same type as the argument); SIZEOF()
is a common extension that returns the size in bytes of its
argument; C_SIZEOF() is a renaming of SIZEOF() in module ISO_C_BINDING.
STORAGE_SIZE() and SIZEOF() are implemented via rewrites to
expressions; these expressions will be constant when the necessary
type parameters and bounds are also constant.
Code to calculate the sizes of types (with and without alignment)
was isolated into Evaluate/type.* and /characteristics.*.
Code in Semantics/compute-offsets.* to calculate sizes and alignments
of derived types' scopes was exposed so that it can be called at type
instantiation time (earlier than before) so that these inquiry intrinsics
could be called from specification expressions.
Differential Revision: https://reviews.llvm.org/D93322
Added:
flang/test/Evaluate/folding17.f90
Modified:
flang/docs/Extensions.md
flang/include/flang/Evaluate/characteristics.h
flang/include/flang/Evaluate/common.h
flang/include/flang/Evaluate/initial-image.h
flang/include/flang/Evaluate/type.h
flang/lib/Evaluate/characteristics.cpp
flang/lib/Evaluate/fold-designator.cpp
flang/lib/Evaluate/fold-integer.cpp
flang/lib/Evaluate/initial-image.cpp
flang/lib/Evaluate/intrinsics.cpp
flang/lib/Evaluate/shape.cpp
flang/lib/Evaluate/type.cpp
flang/lib/Semantics/compute-offsets.cpp
flang/lib/Semantics/compute-offsets.h
flang/lib/Semantics/data-to-inits.cpp
flang/lib/Semantics/semantics.cpp
flang/lib/Semantics/type.cpp
flang/module/__fortran_builtins.f90
flang/module/iso_c_binding.f90
flang/test/Semantics/resolve92.f90
flang/test/Semantics/typeinfo01.f90
Removed:
################################################################################
diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md
index d0b24969b41b..ea90db1aa77c 100644
--- a/flang/docs/Extensions.md
+++ b/flang/docs/Extensions.md
@@ -129,7 +129,7 @@ accepted if enabled by command-line options.
* A `RETURN` statement may appear in a main program.
* DATA statement initialization is allowed for procedure pointers outside
structure constructors.
-* Nonstandard intrinsic functions: ISNAN
+* Nonstandard intrinsic functions: ISNAN, SIZEOF
### Extensions supported when enabled by options
@@ -144,10 +144,11 @@ accepted if enabled by command-line options.
rule imposes an artificially small constraint in some cases
where Fortran mandates that something have the default `INTEGER`
type: specifically, the results of references to the intrinsic functions
- `SIZE`, `LBOUND`, `UBOUND`, `SHAPE`, and the location reductions
+ `SIZE`, `STORAGE_SIZE`,`LBOUND`, `UBOUND`, `SHAPE`, and the location reductions
`FINDLOC`, `MAXLOC`, and `MINLOC` in the absence of an explicit
`KIND=` actual argument. We return `INTEGER(KIND=8)` by default in
these cases when the `-flarge-sizes` option is enabled.
+ `SIZEOF` and `C_SIZEOF` always return `INTEGER(KIND=8)`.
* Treat each specification-part like is has `IMPLICIT NONE`
[-fimplicit-none-type-always]
* Ignore occurrences of `IMPLICIT NONE` and `IMPLICIT NONE(TYPE)`
diff --git a/flang/include/flang/Evaluate/characteristics.h b/flang/include/flang/Evaluate/characteristics.h
index 5d140a642c86..c7ef66e800a9 100644
--- a/flang/include/flang/Evaluate/characteristics.h
+++ b/flang/include/flang/Evaluate/characteristics.h
@@ -149,7 +149,7 @@ class TypeAndShape {
bool isElemental = false, bool thisIsDeferredShape = false,
bool thatIsDeferredShape = false) const;
std::optional<Expr<SubscriptInteger>> MeasureSizeInBytes(
- FoldingContext * = nullptr) const;
+ FoldingContext &) const;
llvm::raw_ostream &Dump(llvm::raw_ostream &) const;
diff --git a/flang/include/flang/Evaluate/common.h b/flang/include/flang/Evaluate/common.h
index 5328f007bf40..284014fb5fb9 100644
--- a/flang/include/flang/Evaluate/common.h
+++ b/flang/include/flang/Evaluate/common.h
@@ -235,6 +235,7 @@ class FoldingContext {
Rounding rounding() const { return rounding_; }
bool flushSubnormalsToZero() const { return flushSubnormalsToZero_; }
bool bigEndian() const { return bigEndian_; }
+ std::size_t maxAlignment() const { return maxAlignment_; }
const semantics::DerivedTypeSpec *pdtInstance() const { return pdtInstance_; }
const IntrinsicProcTable &intrinsics() const { return intrinsics_; }
@@ -257,7 +258,8 @@ class FoldingContext {
const IntrinsicProcTable &intrinsics_;
Rounding rounding_{defaultRounding};
bool flushSubnormalsToZero_{false};
- bool bigEndian_{false};
+ static constexpr bool bigEndian_{false}; // TODO: configure for target
+ static constexpr std::size_t maxAlignment_{8}; // TODO: configure for target
const semantics::DerivedTypeSpec *pdtInstance_{nullptr};
std::map<parser::CharBlock, ConstantSubscript> impliedDos_;
};
diff --git a/flang/include/flang/Evaluate/initial-image.h b/flang/include/flang/Evaluate/initial-image.h
index eb39e9457528..c2cf12e377e0 100644
--- a/flang/include/flang/Evaluate/initial-image.h
+++ b/flang/include/flang/Evaluate/initial-image.h
@@ -33,16 +33,17 @@ class InitialImage {
std::size_t size() const { return data_.size(); }
- template <typename A> Result Add(ConstantSubscript, std::size_t, const A &) {
+ template <typename A>
+ Result Add(ConstantSubscript, std::size_t, const A &, FoldingContext &) {
return NotAConstant;
}
template <typename T>
- Result Add(
- ConstantSubscript offset, std::size_t bytes, const Constant<T> &x) {
+ Result Add(ConstantSubscript offset, std::size_t bytes, const Constant<T> &x,
+ FoldingContext &context) {
if (offset < 0 || offset + bytes > data_.size()) {
return OutOfRange;
} else {
- auto elementBytes{ToInt64(x.GetType().MeasureSizeInBytes())};
+ auto elementBytes{ToInt64(x.GetType().MeasureSizeInBytes(context, true))};
if (!elementBytes ||
bytes !=
x.values().size() * static_cast<std::size_t>(*elementBytes)) {
@@ -55,7 +56,8 @@ class InitialImage {
}
template <int KIND>
Result Add(ConstantSubscript offset, std::size_t bytes,
- const Constant<Type<TypeCategory::Character, KIND>> &x) {
+ const Constant<Type<TypeCategory::Character, KIND>> &x,
+ FoldingContext &) {
if (offset < 0 || offset + bytes > data_.size()) {
return OutOfRange;
} else {
@@ -80,11 +82,13 @@ class InitialImage {
}
}
}
- Result Add(ConstantSubscript, std::size_t, const Constant<SomeDerived> &);
+ Result Add(ConstantSubscript, std::size_t, const Constant<SomeDerived> &,
+ FoldingContext &);
template <typename T>
- Result Add(ConstantSubscript offset, std::size_t bytes, const Expr<T> &x) {
+ Result Add(ConstantSubscript offset, std::size_t bytes, const Expr<T> &x,
+ FoldingContext &c) {
return std::visit(
- [&](const auto &y) { return Add(offset, bytes, y); }, x.u);
+ [&](const auto &y) { return Add(offset, bytes, y, c); }, x.u);
}
void AddPointer(ConstantSubscript, const Expr<SomeType> &);
diff --git a/flang/include/flang/Evaluate/type.h b/flang/include/flang/Evaluate/type.h
index 3326857fc34f..3e44b972c808 100644
--- a/flang/include/flang/Evaluate/type.h
+++ b/flang/include/flang/Evaluate/type.h
@@ -141,8 +141,10 @@ class DynamicType {
return charLength_;
}
std::optional<Expr<SubscriptInteger>> GetCharLength() const;
+
+ std::size_t GetAlignment(const FoldingContext &) const;
std::optional<Expr<SubscriptInteger>> MeasureSizeInBytes(
- FoldingContext * = nullptr) const;
+ FoldingContext &, bool aligned) const;
std::string AsFortran() const;
std::string AsFortran(std::string &&charLenExpr) const;
diff --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp
index 7b7e62ee179e..1f69aa3eae3c 100644
--- a/flang/lib/Evaluate/characteristics.cpp
+++ b/flang/lib/Evaluate/characteristics.cpp
@@ -167,17 +167,17 @@ bool TypeAndShape::IsCompatibleWith(parser::ContextualMessages &messages,
}
std::optional<Expr<SubscriptInteger>> TypeAndShape::MeasureSizeInBytes(
- FoldingContext *foldingContext) const {
- if (type_.category() == TypeCategory::Character && LEN_) {
- Expr<SubscriptInteger> result{
- common::Clone(*LEN_) * Expr<SubscriptInteger>{type_.kind()}};
- if (foldingContext) {
- result = Fold(*foldingContext, std::move(result));
+ FoldingContext &foldingContext) const {
+ if (auto elements{GetSize(Shape{shape_})}) {
+ // Sizes of arrays (even with single elements) are multiples of
+ // their alignments.
+ if (auto elementBytes{
+ type_.MeasureSizeInBytes(foldingContext, GetRank(shape_) > 0)}) {
+ return Fold(
+ foldingContext, std::move(*elements) * std::move(*elementBytes));
}
- return result;
- } else {
- return type_.MeasureSizeInBytes(foldingContext);
}
+ return std::nullopt;
}
void TypeAndShape::AcquireShape(
diff --git a/flang/lib/Evaluate/fold-designator.cpp b/flang/lib/Evaluate/fold-designator.cpp
index 3e84a00fd2ba..dea8a43973ae 100644
--- a/flang/lib/Evaluate/fold-designator.cpp
+++ b/flang/lib/Evaluate/fold-designator.cpp
@@ -27,8 +27,9 @@ std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
} else if (symbol.has<semantics::ObjectEntityDetails>() &&
!IsNamedConstant(symbol)) {
if (auto type{DynamicType::From(symbol)}) {
- if (auto bytes{ToInt64(type->MeasureSizeInBytes(&context_))}) {
- if (auto extents{GetConstantExtents(context_, symbol)}) {
+ if (auto extents{GetConstantExtents(context_, symbol)}) {
+ if (auto bytes{ToInt64(
+ type->MeasureSizeInBytes(context_, GetRank(*extents) > 0))}) {
OffsetSymbol result{symbol, static_cast<std::size_t>(*bytes)};
auto stride{*bytes};
for (auto extent : *extents) {
@@ -57,8 +58,8 @@ std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
const ArrayRef &x, ConstantSubscript which) {
const Symbol &array{x.base().GetLastSymbol()};
if (auto type{DynamicType::From(array)}) {
- if (auto bytes{ToInt64(type->MeasureSizeInBytes(&context_))}) {
- if (auto extents{GetConstantExtents(context_, array)}) {
+ if (auto extents{GetConstantExtents(context_, array)}) {
+ if (auto bytes{ToInt64(type->MeasureSizeInBytes(context_, true))}) {
Shape lbs{GetLowerBounds(context_, x.base())};
if (auto lowerBounds{AsConstantExtents(context_, lbs)}) {
std::optional<OffsetSymbol> result;
@@ -217,7 +218,7 @@ static std::optional<ArrayRef> OffsetToArrayRef(FoldingContext &context,
auto extents{AsConstantExtents(context, shape)};
Shape lbs{GetLowerBounds(context, entity)};
auto lower{AsConstantExtents(context, lbs)};
- auto elementBytes{ToInt64(elementType.MeasureSizeInBytes(&context))};
+ auto elementBytes{ToInt64(elementType.MeasureSizeInBytes(context, true))};
if (!extents || !lower || !elementBytes || *elementBytes <= 0) {
return std::nullopt;
}
@@ -316,7 +317,7 @@ std::optional<Expr<SomeType>> OffsetToDesignator(FoldingContext &context,
TypedWrapper<Designator>(*type, std::move(*dataRef))}) {
if (IsAllocatableOrPointer(symbol)) {
} else if (auto elementBytes{
- ToInt64(type->MeasureSizeInBytes(&context))}) {
+ ToInt64(type->MeasureSizeInBytes(context, true))}) {
if (auto *zExpr{std::get_if<Expr<SomeComplex>>(&result->u)}) {
if (size * 2 > static_cast<std::size_t>(*elementBytes)) {
return result;
diff --git a/flang/lib/Evaluate/fold-integer.cpp b/flang/lib/Evaluate/fold-integer.cpp
index c48148900bbd..c81df1fd4069 100644
--- a/flang/lib/Evaluate/fold-integer.cpp
+++ b/flang/lib/Evaluate/fold-integer.cpp
@@ -587,6 +587,22 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
return Expr<T>{ConvertToType<T>(Fold(context, std::move(product)))};
}
}
+ } else if (name == "sizeof") { // in bytes; extension
+ if (auto info{
+ characteristics::TypeAndShape::Characterize(args[0], context)}) {
+ if (auto bytes{info->MeasureSizeInBytes(context)}) {
+ return Expr<T>{Fold(context, ConvertToType<T>(std::move(*bytes)))};
+ }
+ }
+ } else if (name == "storage_size") { // in bits
+ if (const auto *expr{UnwrapExpr<Expr<SomeType>>(args[0])}) {
+ if (auto type{expr->GetType()}) {
+ if (auto bytes{type->MeasureSizeInBytes(context, true)}) {
+ return Expr<T>{
+ Fold(context, Expr<T>{8} * ConvertToType<T>(std::move(*bytes)))};
+ }
+ }
+ }
} else if (name == "ubound") {
return UBOUND(context, std::move(funcRef));
}
diff --git a/flang/lib/Evaluate/initial-image.cpp b/flang/lib/Evaluate/initial-image.cpp
index d096df9d4d1b..35be2238af1a 100644
--- a/flang/lib/Evaluate/initial-image.cpp
+++ b/flang/lib/Evaluate/initial-image.cpp
@@ -14,7 +14,7 @@
namespace Fortran::evaluate {
auto InitialImage::Add(ConstantSubscript offset, std::size_t bytes,
- const Constant<SomeDerived> &x) -> Result {
+ const Constant<SomeDerived> &x, FoldingContext &context) -> Result {
if (offset < 0 || offset + bytes > data_.size()) {
return OutOfRange;
} else {
@@ -36,7 +36,7 @@ auto InitialImage::Add(ConstantSubscript offset, std::size_t bytes,
AddPointer(offset + component.offset(), indExpr.value());
} else {
Result added{Add(offset + component.offset(), component.size(),
- indExpr.value())};
+ indExpr.value(), context)};
if (added != Ok) {
return Ok;
}
@@ -88,7 +88,8 @@ class AsConstantHelper {
using Scalar = typename Const::Element;
std::size_t elements{TotalElementCount(extents_)};
std::vector<Scalar> typedValue(elements);
- auto elemBytes{ToInt64(type_.MeasureSizeInBytes(&context_))};
+ auto elemBytes{
+ ToInt64(type_.MeasureSizeInBytes(context_, GetRank(extents_) > 0))};
CHECK(elemBytes && *elemBytes >= 0);
std::size_t stride{static_cast<std::size_t>(*elemBytes)};
CHECK(offset_ + elements * stride <= image_.data_.size());
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 0fe5ac8ab75b..39b5da97f57e 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -685,6 +685,8 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
{{"array", AnyData, Rank::anyOrAssumedRank}, OptionalDIM,
SizeDefaultKIND},
KINDInt, Rank::scalar, IntrinsicClass::inquiryFunction},
+ {"sizeof", {{"a", AnyData, Rank::anyOrAssumedRank}}, SubscriptInt,
+ Rank::scalar, IntrinsicClass::inquiryFunction},
{"spacing", {{"x", SameReal}}, SameReal},
{"spread",
{{"source", SameType, Rank::known}, RequiredDIM,
@@ -742,7 +744,7 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
// AND, OR, XOR, LSHIFT, RSHIFT, SHIFT, ZEXT, IZEXT,
// COMPL, EQV, NEQV, INT8, JINT, JNINT, KNINT,
// QCMPLX, DFLOAT, QEXT, QFLOAT, QREAL, DNUM,
-// INUM, JNUM, KNUM, QNUM, RNUM, RAN, RANF, ILEN, SIZEOF,
+// INUM, JNUM, KNUM, QNUM, RNUM, RAN, RANF, ILEN,
// MCLOCK, SECNDS, COTAN, IBCHNG, ISHA, ISHC, ISHL, IXOR
// IARG, IARGC, NARGS, NUMARG, BADDRESS, IADDR, CACHESIZE,
// EOF, FP_CLASS, INT_PTR_KIND, MALLOC
diff --git a/flang/lib/Evaluate/shape.cpp b/flang/lib/Evaluate/shape.cpp
index b740c81e0796..8936974e5247 100644
--- a/flang/lib/Evaluate/shape.cpp
+++ b/flang/lib/Evaluate/shape.cpp
@@ -643,17 +643,13 @@ auto GetShapeHelper::operator()(const ProcedureRef &call) const -> Result {
if (auto sourceTypeAndShape{
characteristics::TypeAndShape::Characterize(
call.arguments().at(0), context_)}) {
- auto sourceElements{
- GetSize(common::Clone(sourceTypeAndShape->shape()))};
- auto sourceElementBytes{
- sourceTypeAndShape->MeasureSizeInBytes(&context_)};
+ auto sourceBytes{sourceTypeAndShape->MeasureSizeInBytes(context_)};
auto moldElementBytes{
- moldTypeAndShape->MeasureSizeInBytes(&context_)};
- if (sourceElements && sourceElementBytes && moldElementBytes) {
+ moldTypeAndShape->type().MeasureSizeInBytes(context_, true)};
+ if (sourceBytes && moldElementBytes) {
ExtentExpr extent{Fold(context_,
- ((std::move(*sourceElements) *
- std::move(*sourceElementBytes)) +
- common::Clone(*moldElementBytes) - ExtentExpr{1}) /
+ (std::move(*sourceBytes) + common::Clone(*moldElementBytes) -
+ ExtentExpr{1}) /
common::Clone(*moldElementBytes))};
return Shape{MaybeExtentExpr{std::move(extent)}};
}
diff --git a/flang/lib/Evaluate/type.cpp b/flang/lib/Evaluate/type.cpp
index ef43edee075c..1d5f720210ea 100644
--- a/flang/lib/Evaluate/type.cpp
+++ b/flang/lib/Evaluate/type.cpp
@@ -111,7 +111,7 @@ std::optional<Expr<SubscriptInteger>> DynamicType::GetCharLength() const {
return std::nullopt;
}
-static constexpr int RealKindBytes(int kind) {
+static constexpr std::size_t RealKindBytes(int kind) {
switch (kind) {
case 3: // non-IEEE 16-bit format (truncated 32-bit)
return 2;
@@ -123,8 +123,26 @@ static constexpr int RealKindBytes(int kind) {
}
}
+std::size_t DynamicType::GetAlignment(const FoldingContext &context) const {
+ switch (category_) {
+ case TypeCategory::Integer:
+ case TypeCategory::Character:
+ case TypeCategory::Logical:
+ return std::min<std::size_t>(kind_, context.maxAlignment());
+ case TypeCategory::Real:
+ case TypeCategory::Complex:
+ return std::min(RealKindBytes(kind_), context.maxAlignment());
+ case TypeCategory::Derived:
+ if (derived_ && derived_->scope()) {
+ return derived_->scope()->alignment().value_or(1);
+ }
+ break;
+ }
+ return 1; // needs to be after switch to dodge a bogus gcc warning
+}
+
std::optional<Expr<SubscriptInteger>> DynamicType::MeasureSizeInBytes(
- FoldingContext *context) const {
+ FoldingContext &context, bool aligned) const {
switch (category_) {
case TypeCategory::Integer:
return Expr<SubscriptInteger>{kind_};
@@ -134,20 +152,18 @@ std::optional<Expr<SubscriptInteger>> DynamicType::MeasureSizeInBytes(
return Expr<SubscriptInteger>{2 * RealKindBytes(kind_)};
case TypeCategory::Character:
if (auto len{GetCharLength()}) {
- auto result{Expr<SubscriptInteger>{kind_} * std::move(*len)};
- if (context) {
- return Fold(*context, std::move(result));
- } else {
- return std::move(result);
- }
+ return Fold(context, Expr<SubscriptInteger>{kind_} * std::move(*len));
}
break;
case TypeCategory::Logical:
return Expr<SubscriptInteger>{kind_};
case TypeCategory::Derived:
if (derived_ && derived_->scope()) {
+ auto size{derived_->scope()->size()};
+ auto align{aligned ? derived_->scope()->alignment().value_or(0) : 0};
+ auto alignedSize{align > 0 ? ((size + align - 1) / align) * align : size};
return Expr<SubscriptInteger>{
- static_cast<common::ConstantSubscript>(derived_->scope()->size())};
+ static_cast<ConstantSubscript>(alignedSize)};
}
break;
}
diff --git a/flang/lib/Semantics/compute-offsets.cpp b/flang/lib/Semantics/compute-offsets.cpp
index 107491da791b..a11ec2b4daac 100644
--- a/flang/lib/Semantics/compute-offsets.cpp
+++ b/flang/lib/Semantics/compute-offsets.cpp
@@ -24,11 +24,8 @@ namespace Fortran::semantics {
class ComputeOffsetsHelper {
public:
- // TODO: configure based on target
- static constexpr std::size_t maxAlignment{8};
-
ComputeOffsetsHelper(SemanticsContext &context) : context_{context} {}
- void Compute() { Compute(context_.globalScope()); }
+ void Compute(Scope &);
private:
struct SizeAndAlignment {
@@ -48,24 +45,18 @@ class ComputeOffsetsHelper {
const EquivalenceObject *object;
};
- void Compute(Scope &);
- void DoScope(Scope &);
void DoCommonBlock(Symbol &);
void DoEquivalenceBlockBase(Symbol &, SizeAndAlignment &);
void DoEquivalenceSet(const EquivalenceSet &);
SymbolAndOffset Resolve(const SymbolAndOffset &);
std::size_t ComputeOffset(const EquivalenceObject &);
void DoSymbol(Symbol &);
- SizeAndAlignment GetSizeAndAlignment(const Symbol &);
- SizeAndAlignment GetElementSize(const Symbol &);
- std::size_t CountElements(const Symbol &);
- static std::size_t Align(std::size_t, std::size_t);
- static SizeAndAlignment GetIntrinsicSizeAndAlignment(TypeCategory, int);
+ SizeAndAlignment GetSizeAndAlignment(const Symbol &, bool entire);
+ std::size_t Align(std::size_t, std::size_t);
SemanticsContext &context_;
- evaluate::FoldingContext &foldingContext_{context_.foldingContext()};
std::size_t offset_{0};
- std::size_t alignment_{0};
+ std::size_t alignment_{1};
// symbol -> symbol+offset that determines its location, from EQUIVALENCE
std::map<MutableSymbolRef, SymbolAndOffset> dependents_;
// base symbol -> SizeAndAlignment for each distinct EQUIVALENCE block
@@ -74,14 +65,8 @@ class ComputeOffsetsHelper {
void ComputeOffsetsHelper::Compute(Scope &scope) {
for (Scope &child : scope.children()) {
- Compute(child);
+ ComputeOffsets(context_, child);
}
- DoScope(scope);
- dependents_.clear();
- equivalenceBlock_.clear();
-}
-
-void ComputeOffsetsHelper::DoScope(Scope &scope) {
if (scope.symbol() && scope.IsParameterizedDerivedType()) {
return; // only process instantiations of parameterized derived types
}
@@ -93,14 +78,12 @@ void ComputeOffsetsHelper::DoScope(Scope &scope) {
for (const EquivalenceSet &set : scope.equivalenceSets()) {
DoEquivalenceSet(set);
}
- offset_ = 0;
- alignment_ = 1;
// Compute a base symbol and overall block size for each
// disjoint EQUIVALENCE storage sequence.
for (auto &[symbol, dep] : dependents_) {
dep = Resolve(dep);
CHECK(symbol->size() == 0);
- auto symInfo{GetSizeAndAlignment(*symbol)};
+ auto symInfo{GetSizeAndAlignment(*symbol, true)};
symbol->set_size(symInfo.size);
Symbol &base{*dep.symbol};
auto iter{equivalenceBlock_.find(base)};
@@ -285,7 +268,7 @@ std::size_t ComputeOffsetsHelper::ComputeOffset(
offset *= ubound(i) - lbound(i) + 1;
}
}
- auto result{offset * GetElementSize(object.symbol).size};
+ auto result{offset * GetSizeAndAlignment(object.symbol, false).size};
if (object.substringStart) {
int kind{context_.defaultKinds().GetDefaultKind(TypeCategory::Character)};
if (const DeclTypeSpec * type{object.symbol.GetType()}) {
@@ -302,7 +285,7 @@ void ComputeOffsetsHelper::DoSymbol(Symbol &symbol) {
if (!symbol.has<ObjectEntityDetails>() && !symbol.has<ProcEntityDetails>()) {
return;
}
- SizeAndAlignment s{GetSizeAndAlignment(symbol)};
+ SizeAndAlignment s{GetSizeAndAlignment(symbol, true)};
if (s.size == 0) {
return;
}
@@ -313,101 +296,51 @@ void ComputeOffsetsHelper::DoSymbol(Symbol &symbol) {
alignment_ = std::max(alignment_, s.alignment);
}
-auto ComputeOffsetsHelper::GetSizeAndAlignment(const Symbol &symbol)
- -> SizeAndAlignment {
- SizeAndAlignment result{GetElementSize(symbol)};
- std::size_t elements{CountElements(symbol)};
- if (elements > 1) {
- result.size = Align(result.size, result.alignment);
- }
- result.size *= elements;
- return result;
-}
-
-auto ComputeOffsetsHelper::GetElementSize(const Symbol &symbol)
- -> SizeAndAlignment {
- const DeclTypeSpec *type{symbol.GetType()};
- if (!evaluate::DynamicType::From(type).has_value()) {
- return {};
- }
+auto ComputeOffsetsHelper::GetSizeAndAlignment(
+ const Symbol &symbol, bool entire) -> SizeAndAlignment {
// TODO: The size of procedure pointers is not yet known
// and is independent of rank (and probably also the number
// of length type parameters).
+ auto &foldingContext{context_.foldingContext()};
if (IsDescriptor(symbol) || IsProcedurePointer(symbol)) {
int lenParams{0};
- if (const DerivedTypeSpec * derived{type->AsDerived()}) {
+ if (const auto *derived{evaluate::GetDerivedTypeSpec(
+ evaluate::DynamicType::From(symbol))}) {
lenParams = CountLenParameters(*derived);
}
std::size_t size{
runtime::Descriptor::SizeInBytes(symbol.Rank(), false, lenParams)};
- return {size, maxAlignment};
+ return {size, foldingContext.maxAlignment()};
}
if (IsProcedure(symbol)) {
return {};
}
- SizeAndAlignment result;
- if (const IntrinsicTypeSpec * intrinsic{type->AsIntrinsic()}) {
- if (auto kind{ToInt64(intrinsic->kind())}) {
- result = GetIntrinsicSizeAndAlignment(intrinsic->category(), *kind);
- }
- if (type->category() == DeclTypeSpec::Character) {
- ParamValue length{type->characterTypeSpec().length()};
- CHECK(length.isExplicit()); // else should be descriptor
- if (MaybeIntExpr lengthExpr{length.GetExplicit()}) {
- if (auto lengthInt{ToInt64(*lengthExpr)}) {
- result.size *= *lengthInt;
- }
+ if (auto chars{evaluate::characteristics::TypeAndShape::Characterize(
+ symbol, foldingContext)}) {
+ if (entire) {
+ if (auto size{ToInt64(chars->MeasureSizeInBytes(foldingContext))}) {
+ return {static_cast<std::size_t>(*size),
+ chars->type().GetAlignment(foldingContext)};
}
- }
- } else if (const DerivedTypeSpec * derived{type->AsDerived()}) {
- if (derived->scope()) {
- DoScope(*const_cast<Scope *>(derived->scope()));
- result.size = derived->scope()->size();
- result.alignment = derived->scope()->alignment().value_or(0);
- }
- } else {
- DIE("not intrinsic or derived");
- }
- return result;
-}
-
-std::size_t ComputeOffsetsHelper::CountElements(const Symbol &symbol) {
- if (auto shape{GetShape(foldingContext_, symbol)}) {
- if (auto sizeExpr{evaluate::GetSize(std::move(*shape))}) {
- if (auto size{ToInt64(Fold(foldingContext_, std::move(*sizeExpr)))}) {
- return *size;
+ } else { // element size only
+ if (auto size{ToInt64(chars->type().MeasureSizeInBytes(
+ foldingContext, true /*aligned*/))}) {
+ return {static_cast<std::size_t>(*size),
+ chars->type().GetAlignment(foldingContext)};
}
}
}
- return 1;
+ return {};
}
// Align a size to its natural alignment, up to maxAlignment.
std::size_t ComputeOffsetsHelper::Align(std::size_t x, std::size_t alignment) {
- if (alignment > maxAlignment) {
- alignment = maxAlignment;
- }
+ alignment = std::min(alignment, context_.foldingContext().maxAlignment());
return (x + alignment - 1) & -alignment;
}
-auto ComputeOffsetsHelper::GetIntrinsicSizeAndAlignment(
- TypeCategory category, int kind) -> SizeAndAlignment {
- if (category == TypeCategory::Character) {
- return {static_cast<std::size_t>(kind)};
- }
- auto bytes{evaluate::ToInt64(
- evaluate::DynamicType{category, kind}.MeasureSizeInBytes())};
- CHECK(bytes && *bytes > 0);
- std::size_t size{static_cast<std::size_t>(*bytes)};
- if (category == TypeCategory::Complex) {
- return {size, size >> 1};
- } else {
- return {size};
- }
-}
-
-void ComputeOffsets(SemanticsContext &context) {
- ComputeOffsetsHelper{context}.Compute();
+void ComputeOffsets(SemanticsContext &context, Scope &scope) {
+ ComputeOffsetsHelper{context}.Compute(scope);
}
} // namespace Fortran::semantics
diff --git a/flang/lib/Semantics/compute-offsets.h b/flang/lib/Semantics/compute-offsets.h
index 2ab81713a25b..40c608ecfcf7 100644
--- a/flang/lib/Semantics/compute-offsets.h
+++ b/flang/lib/Semantics/compute-offsets.h
@@ -11,7 +11,8 @@
namespace Fortran::semantics {
class SemanticsContext;
-void ComputeOffsets(SemanticsContext &);
+class Scope;
+void ComputeOffsets(SemanticsContext &, Scope &);
} // namespace Fortran::semantics
#endif
diff --git a/flang/lib/Semantics/data-to-inits.cpp b/flang/lib/Semantics/data-to-inits.cpp
index 2ef9132785e7..e72216c8233f 100644
--- a/flang/lib/Semantics/data-to-inits.cpp
+++ b/flang/lib/Semantics/data-to-inits.cpp
@@ -229,9 +229,9 @@ DataInitializationCompiler::ConvertElement(
// (most) other Fortran compilers do. Pad on the right with spaces
// when short, truncate the right if long.
// TODO: big-endian targets
- std::size_t bytes{static_cast<std::size_t>(evaluate::ToInt64(
- type.MeasureSizeInBytes(&exprAnalyzer_.GetFoldingContext()))
- .value())};
+ auto bytes{static_cast<std::size_t>(evaluate::ToInt64(
+ type.MeasureSizeInBytes(exprAnalyzer_.GetFoldingContext(), false))
+ .value())};
evaluate::BOZLiteralConstant bits{0};
for (std::size_t j{0}; j < bytes; ++j) {
char ch{j >= chValue->size() ? ' ' : chValue->at(j)};
@@ -349,8 +349,8 @@ bool DataInitializationCompiler::InitElement(
DescribeElement(), designatorType->AsFortran());
}
auto folded{evaluate::Fold(context, std::move(converted->first))};
- switch (
- GetImage().Add(offsetSymbol.offset(), offsetSymbol.size(), folded)) {
+ switch (GetImage().Add(
+ offsetSymbol.offset(), offsetSymbol.size(), folded, context)) {
case evaluate::InitialImage::Ok:
return true;
case evaluate::InitialImage::NotAConstant:
@@ -434,15 +434,15 @@ static bool CombineSomeEquivalencedInits(
// Compute the minimum common granularity
if (auto dyType{evaluate::DynamicType::From(symbol)}) {
minElementBytes = evaluate::ToInt64(
- dyType->MeasureSizeInBytes(&exprAnalyzer.GetFoldingContext()))
+ dyType->MeasureSizeInBytes(exprAnalyzer.GetFoldingContext(), true))
.value_or(1);
}
for (const Symbol *s : conflicts) {
if (auto dyType{evaluate::DynamicType::From(*s)}) {
- minElementBytes = std::min(minElementBytes,
- static_cast<std::size_t>(evaluate::ToInt64(
- dyType->MeasureSizeInBytes(&exprAnalyzer.GetFoldingContext()))
- .value_or(1)));
+ minElementBytes = std::min<std::size_t>(minElementBytes,
+ evaluate::ToInt64(dyType->MeasureSizeInBytes(
+ exprAnalyzer.GetFoldingContext(), true))
+ .value_or(1));
} else {
minElementBytes = 1;
}
diff --git a/flang/lib/Semantics/semantics.cpp b/flang/lib/Semantics/semantics.cpp
index 66f985408f20..e665cf4cd1f0 100644
--- a/flang/lib/Semantics/semantics.cpp
+++ b/flang/lib/Semantics/semantics.cpp
@@ -167,7 +167,7 @@ static bool PerformStatementSemantics(
SemanticsContext &context, parser::Program &program) {
ResolveNames(context, program);
RewriteParseTree(context, program);
- ComputeOffsets(context);
+ ComputeOffsets(context, context.globalScope());
CheckDeclarations(context);
StatementSemanticsPass1{context}.Walk(program);
StatementSemanticsPass2 pass2{context};
diff --git a/flang/lib/Semantics/type.cpp b/flang/lib/Semantics/type.cpp
index 2107f47c3faf..e7b0fabe8cac 100644
--- a/flang/lib/Semantics/type.cpp
+++ b/flang/lib/Semantics/type.cpp
@@ -8,6 +8,7 @@
#include "flang/Semantics/type.h"
#include "check-declarations.h"
+#include "compute-offsets.h"
#include "flang/Evaluate/fold.h"
#include "flang/Parser/characters.h"
#include "flang/Semantics/scope.h"
@@ -248,6 +249,7 @@ void DerivedTypeSpec::Instantiate(
}
}
}
+ ComputeOffsets(context, const_cast<Scope &>(typeScope));
return;
}
Scope &newScope{containingScope.MakeScope(Scope::Kind::DerivedType)};
@@ -306,6 +308,7 @@ void InstantiateHelper::InstantiateComponents(const Scope &fromScope) {
for (const auto &pair : fromScope) {
InstantiateComponent(*pair.second);
}
+ ComputeOffsets(context_, scope_);
}
void InstantiateHelper::InstantiateComponent(const Symbol &oldSymbol) {
diff --git a/flang/module/__fortran_builtins.f90 b/flang/module/__fortran_builtins.f90
index bdff2a97954b..167bd80d6ad9 100644
--- a/flang/module/__fortran_builtins.f90
+++ b/flang/module/__fortran_builtins.f90
@@ -16,6 +16,7 @@
integer, parameter, private :: int64 = selected_int_kind(18)
intrinsic :: __builtin_c_f_pointer
+ intrinsic :: sizeof ! extension
type :: __builtin_event_type
integer(kind=int64) :: __count
diff --git a/flang/module/iso_c_binding.f90 b/flang/module/iso_c_binding.f90
index 52c28e7a031d..eed264f531a4 100644
--- a/flang/module/iso_c_binding.f90
+++ b/flang/module/iso_c_binding.f90
@@ -13,7 +13,8 @@ module iso_c_binding
use __Fortran_builtins, only: &
c_f_pointer => __builtin_c_f_pointer, &
c_ptr => __builtin_c_ptr, &
- c_funptr => __builtin_c_funptr
+ c_funptr => __builtin_c_funptr, &
+ c_sizeof => sizeof
type(c_ptr), parameter :: c_null_ptr = c_ptr(0)
type(c_funptr), parameter :: c_null_funptr = c_funptr(0)
@@ -32,7 +33,7 @@ module iso_c_binding
c_long = c_int64_t, &
c_long_long = c_int64_t, &
c_signed_char = c_int8_t, &
- c_size_t = c_long_long, &
+ c_size_t = kind(c_sizeof(1)), &
c_intmax_t = c_int128_t, &
c_intptr_t = c_size_t, &
c_ptr
diff _t = c_size_t
@@ -102,6 +103,5 @@ function c_funloc(x)
end function c_funloc
! TODO c_f_procpointer
- ! TODO c_sizeof
end module iso_c_binding
diff --git a/flang/test/Evaluate/folding17.f90 b/flang/test/Evaluate/folding17.f90
new file mode 100644
index 000000000000..cbfddaac5245
--- /dev/null
+++ b/flang/test/Evaluate/folding17.f90
@@ -0,0 +1,23 @@
+! RUN: %S/test_folding.sh %s %t %f18
+! Test implementations of STORAGE_SIZE() and SIZEOF() as expression rewrites
+module m1
+ type :: t1
+ real :: a(2,3)
+ character*5 :: c(3)
+ end type
+ type :: t2(k)
+ integer, kind :: k
+ type(t1) :: a(k)
+ end type
+ type(t2(2)) :: a(2)
+ integer, parameter :: ss1 = storage_size(a(1)%a(1)%a)
+ integer, parameter :: sz1 = sizeof(a(1)%a(1)%a)
+ integer, parameter :: ss2 = storage_size(a(1)%a(1)%c)
+ integer, parameter :: sz2 = sizeof(a(1)%a(1)%c)
+ integer, parameter :: ss3 = storage_size(a(1)%a)
+ integer, parameter :: sz3 = sizeof(a(1)%a)
+ integer, parameter :: ss4 = storage_size(a)
+ integer, parameter :: sz4 = sizeof(a)
+ logical, parameter :: test_ss = all([ss1,ss2,ss3,ss4]==[32, 40, 320, 640])
+ logical, parameter :: test_sz = all([sz1,sz2,sz3,sz4]==[24, 15, 80, 160])
+end module
diff --git a/flang/test/Semantics/resolve92.f90 b/flang/test/Semantics/resolve92.f90
index 24d86c34a5d2..7a6bd874eb4b 100644
--- a/flang/test/Semantics/resolve92.f90
+++ b/flang/test/Semantics/resolve92.f90
@@ -6,7 +6,7 @@ module m1
integer :: n
end type
type t2
- ! t and t2 must be resolved to types in m, not components in t2
+ ! t and t2 must be resolved to types in m1, not components in t2
type(t) :: t(10) = t(1)
type(t) :: x = t(1)
integer :: t2
diff --git a/flang/test/Semantics/typeinfo01.f90 b/flang/test/Semantics/typeinfo01.f90
index e29cb022128a..834120ccb430 100644
--- a/flang/test/Semantics/typeinfo01.f90
+++ b/flang/test/Semantics/typeinfo01.f90
@@ -59,7 +59,7 @@ module m05
subroutine s1(x)
class(t), intent(in) :: x
end subroutine
-!CHECK: .dt.t, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t,sizeinbytes=0_8,parent=NULL(),uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=.p.t,special=NULL())
+!CHECK: .dt.t, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t,sizeinbytes=24_8,parent=NULL(),uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=.p.t,special=NULL())
!CHECK: .p.t, SAVE, TARGET: ObjectEntity type: TYPE(procptrcomponent) shape: 0_8:0_8 init:[procptrcomponent::procptrcomponent(name=.n.p1,offset=0_8,initialization=s1)]
end module
More information about the flang-commits
mailing list