4739c883fd
…nversion As requested by people working on lowering: when semantics converts the contents of DATA statements into explicit object initializers, ensure that structure constructors for derived types contain explicit NULL() values for their allocatable components.
220 lines
8.4 KiB
C++
220 lines
8.4 KiB
C++
//===-- lib/Evaluate/initial-image.cpp ------------------------------------===//
|
|
//
|
|
// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
|
|
// See https://llvm.org/LICENSE.txt for license information.
|
|
// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
|
|
//
|
|
//===----------------------------------------------------------------------===//
|
|
|
|
#include "flang/Evaluate/initial-image.h"
|
|
#include "flang/Semantics/scope.h"
|
|
#include "flang/Semantics/tools.h"
|
|
#include <cstring>
|
|
|
|
namespace Fortran::evaluate {
|
|
|
|
auto InitialImage::Add(ConstantSubscript offset, std::size_t bytes,
|
|
const Constant<SomeDerived> &x, FoldingContext &context) -> Result {
|
|
if (offset < 0 || offset + bytes > data_.size()) {
|
|
return OutOfRange;
|
|
} else {
|
|
auto optElements{TotalElementCount(x.shape())};
|
|
if (!optElements) {
|
|
return TooManyElems;
|
|
}
|
|
auto elements{*optElements};
|
|
auto elementBytes{bytes > 0 ? bytes / elements : 0};
|
|
if (elements * elementBytes != bytes) {
|
|
return SizeMismatch;
|
|
} else {
|
|
auto at{x.lbounds()};
|
|
for (; elements-- > 0; x.IncrementSubscripts(at)) {
|
|
auto scalar{x.At(at)};
|
|
// TODO: length type parameter values?
|
|
for (const auto &[symbolRef, indExpr] : scalar) {
|
|
const Symbol &component{*symbolRef};
|
|
if (component.offset() + component.size() > elementBytes) {
|
|
return SizeMismatch;
|
|
} else if (IsPointer(component)) {
|
|
AddPointer(offset + component.offset(), indExpr.value());
|
|
} else if (IsAllocatable(component) || IsAutomatic(component)) {
|
|
return NotAConstant;
|
|
} else if (auto result{Add(offset + component.offset(),
|
|
component.size(), indExpr.value(), context)};
|
|
result != Ok) {
|
|
return result;
|
|
}
|
|
}
|
|
offset += elementBytes;
|
|
}
|
|
}
|
|
return Ok;
|
|
}
|
|
}
|
|
|
|
void InitialImage::AddPointer(
|
|
ConstantSubscript offset, const Expr<SomeType> &pointer) {
|
|
pointers_.emplace(offset, pointer);
|
|
}
|
|
|
|
void InitialImage::Incorporate(ConstantSubscript toOffset,
|
|
const InitialImage &from, ConstantSubscript fromOffset,
|
|
ConstantSubscript bytes) {
|
|
CHECK(from.pointers_.empty()); // pointers are not allowed in EQUIVALENCE
|
|
CHECK(fromOffset >= 0 && bytes >= 0 &&
|
|
static_cast<std::size_t>(fromOffset + bytes) <= from.size());
|
|
CHECK(static_cast<std::size_t>(toOffset + bytes) <= size());
|
|
std::memcpy(&data_[toOffset], &from.data_[fromOffset], bytes);
|
|
}
|
|
|
|
// Classes used with common::SearchTypes() to (re)construct Constant<> values
|
|
// of the right type to initialize each symbol from the values that have
|
|
// been placed into its initialization image by DATA statements.
|
|
class AsConstantHelper {
|
|
public:
|
|
using Result = std::optional<Expr<SomeType>>;
|
|
using Types = AllTypes;
|
|
AsConstantHelper(FoldingContext &context, const DynamicType &type,
|
|
std::optional<std::int64_t> charLength, const ConstantSubscripts &extents,
|
|
const InitialImage &image, bool padWithZero = false,
|
|
ConstantSubscript offset = 0)
|
|
: context_{context}, type_{type}, charLength_{charLength}, image_{image},
|
|
extents_{extents}, padWithZero_{padWithZero}, offset_{offset} {
|
|
CHECK(!type.IsPolymorphic());
|
|
}
|
|
template <typename T> Result Test() {
|
|
if (T::category != type_.category()) {
|
|
return std::nullopt;
|
|
}
|
|
if constexpr (T::category != TypeCategory::Derived) {
|
|
if (T::kind != type_.kind()) {
|
|
return std::nullopt;
|
|
}
|
|
}
|
|
using Const = Constant<T>;
|
|
using Scalar = typename Const::Element;
|
|
std::optional<uint64_t> optElements{TotalElementCount(extents_)};
|
|
CHECK(optElements);
|
|
uint64_t elements{*optElements};
|
|
std::vector<Scalar> typedValue(elements);
|
|
auto elemBytes{ToInt64(type_.MeasureSizeInBytes(
|
|
context_, GetRank(extents_) > 0, charLength_))};
|
|
CHECK(elemBytes && *elemBytes >= 0);
|
|
std::size_t stride{static_cast<std::size_t>(*elemBytes)};
|
|
CHECK(offset_ + elements * stride <= image_.data_.size() || padWithZero_);
|
|
if constexpr (T::category == TypeCategory::Derived) {
|
|
const semantics::DerivedTypeSpec &derived{type_.GetDerivedTypeSpec()};
|
|
for (auto iter : DEREF(derived.scope())) {
|
|
const Symbol &component{*iter.second};
|
|
bool isProcPtr{IsProcedurePointer(component)};
|
|
if (isProcPtr || component.has<semantics::ObjectEntityDetails>()) {
|
|
auto at{offset_ + component.offset()};
|
|
if (isProcPtr) {
|
|
for (std::size_t j{0}; j < elements; ++j, at += stride) {
|
|
if (Result value{image_.AsConstantPointer(at)}) {
|
|
typedValue[j].emplace(component, std::move(*value));
|
|
}
|
|
}
|
|
} else if (IsPointer(component)) {
|
|
for (std::size_t j{0}; j < elements; ++j, at += stride) {
|
|
if (Result value{image_.AsConstantPointer(at)}) {
|
|
typedValue[j].emplace(component, std::move(*value));
|
|
} else {
|
|
typedValue[j].emplace(component, Expr<SomeType>{NullPointer{}});
|
|
}
|
|
}
|
|
} else if (IsAllocatable(component)) {
|
|
// Lowering needs an explicit NULL() for allocatables
|
|
for (std::size_t j{0}; j < elements; ++j, at += stride) {
|
|
typedValue[j].emplace(component, Expr<SomeType>{NullPointer{}});
|
|
}
|
|
} else {
|
|
auto componentType{DynamicType::From(component)};
|
|
CHECK(componentType.has_value());
|
|
auto componentExtents{GetConstantExtents(context_, component)};
|
|
CHECK(componentExtents.has_value());
|
|
for (std::size_t j{0}; j < elements; ++j, at += stride) {
|
|
if (Result value{image_.AsConstant(context_, *componentType,
|
|
std::nullopt, *componentExtents, padWithZero_, at)}) {
|
|
typedValue[j].emplace(component, std::move(*value));
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
return AsGenericExpr(
|
|
Const{derived, std::move(typedValue), std::move(extents_)});
|
|
} else if constexpr (T::category == TypeCategory::Character) {
|
|
auto length{static_cast<ConstantSubscript>(stride) / T::kind};
|
|
for (std::size_t j{0}; j < elements; ++j) {
|
|
using Char = typename Scalar::value_type;
|
|
auto at{static_cast<std::size_t>(offset_ + j * stride)};
|
|
auto chunk{length};
|
|
if (at + chunk > image_.data_.size()) {
|
|
CHECK(padWithZero_);
|
|
if (at >= image_.data_.size()) {
|
|
chunk = 0;
|
|
} else {
|
|
chunk = image_.data_.size() - at;
|
|
}
|
|
}
|
|
if (chunk > 0) {
|
|
const Char *data{reinterpret_cast<const Char *>(&image_.data_[at])};
|
|
typedValue[j].assign(data, chunk);
|
|
}
|
|
if (chunk < length && padWithZero_) {
|
|
typedValue[j].append(length - chunk, Char{});
|
|
}
|
|
}
|
|
return AsGenericExpr(
|
|
Const{length, std::move(typedValue), std::move(extents_)});
|
|
} else {
|
|
// Lengthless intrinsic type
|
|
CHECK(sizeof(Scalar) <= stride);
|
|
for (std::size_t j{0}; j < elements; ++j) {
|
|
auto at{static_cast<std::size_t>(offset_ + j * stride)};
|
|
std::size_t chunk{sizeof(Scalar)};
|
|
if (at + chunk > image_.data_.size()) {
|
|
CHECK(padWithZero_);
|
|
if (at >= image_.data_.size()) {
|
|
chunk = 0;
|
|
} else {
|
|
chunk = image_.data_.size() - at;
|
|
}
|
|
}
|
|
// TODO endianness
|
|
if (chunk > 0) {
|
|
std::memcpy(&typedValue[j], &image_.data_[at], chunk);
|
|
}
|
|
}
|
|
return AsGenericExpr(Const{std::move(typedValue), std::move(extents_)});
|
|
}
|
|
}
|
|
|
|
private:
|
|
FoldingContext &context_;
|
|
const DynamicType &type_;
|
|
std::optional<std::int64_t> charLength_;
|
|
const InitialImage &image_;
|
|
ConstantSubscripts extents_; // a copy
|
|
bool padWithZero_;
|
|
ConstantSubscript offset_;
|
|
};
|
|
|
|
std::optional<Expr<SomeType>> InitialImage::AsConstant(FoldingContext &context,
|
|
const DynamicType &type, std::optional<std::int64_t> charLength,
|
|
const ConstantSubscripts &extents, bool padWithZero,
|
|
ConstantSubscript offset) const {
|
|
return common::SearchTypes(AsConstantHelper{
|
|
context, type, charLength, extents, *this, padWithZero, offset});
|
|
}
|
|
|
|
std::optional<Expr<SomeType>> InitialImage::AsConstantPointer(
|
|
ConstantSubscript offset) const {
|
|
auto iter{pointers_.find(offset)};
|
|
return iter == pointers_.end() ? std::optional<Expr<SomeType>>{}
|
|
: iter->second;
|
|
}
|
|
|
|
} // namespace Fortran::evaluate
|