lib/Evaluate/initial-image.cpp

//===-- 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