flang/lib/Evaluate/initial-image.cpp

   1 //===-- lib/Evaluate/initial-image.cpp ------------------------------------===//
   2 //
   3 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
   4 // See https://llvm.org/LICENSE.txt for license information.
   5 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
   6 //
   7 //===----------------------------------------------------------------------===//
   8
   9 #include "flang/Evaluate/initial-image.h"
  10 #include "flang/Semantics/scope.h"
  11 #include "flang/Semantics/tools.h"
  12 #include <cstring>
  13
  14 namespace Fortran::evaluate {
  15
  16 auto InitialImage::Add(ConstantSubscript offset, std::size_t bytes,
  17     const Constant<SomeDerived> &x, FoldingContext &context) -> Result {
  18   if (offset < 0 || offset + bytes > data_.size()) {
  19     return OutOfRange;
  20   } else {
  21     auto elements{TotalElementCount(x.shape())};
  22     auto elementBytes{bytes > 0 ? bytes / elements : 0};
  23     if (elements * elementBytes != bytes) {
  24       return SizeMismatch;
  25     } else {
  26       auto at{x.lbounds()};
  27       for (; elements-- > 0; x.IncrementSubscripts(at)) {
  28         auto scalar{x.At(at)};
  29         // TODO: length type parameter values?
  30         for (const auto &[symbolRef, indExpr] : scalar) {
  31           const Symbol &component{*symbolRef};
  32           if (component.offset() + component.size() > elementBytes) {
  33             return SizeMismatch;
  34           } else if (IsPointer(component)) {
  35             AddPointer(offset + component.offset(), indExpr.value());
  36           } else if (IsAllocatable(component) || IsAutomatic(component)) {
  37             return NotAConstant;
  38           } else {
  39             Result added{Add(offset + component.offset(), component.size(),
  40                 indExpr.value(), context)};
  41             if (added != Ok) {
  42               return added;
  43             }
  44           }
  45         }
  46         offset += elementBytes;
  47       }
  48     }
  49     return Ok;
  50   }
  51 }
  52
  53 void InitialImage::AddPointer(
  54     ConstantSubscript offset, const Expr<SomeType> &pointer) {
  55   pointers_.emplace(offset, pointer);
  56 }
  57
  58 void InitialImage::Incorporate(ConstantSubscript toOffset,
  59     const InitialImage &from, ConstantSubscript fromOffset,
  60     ConstantSubscript bytes) {
  61   CHECK(from.pointers_.empty()); // pointers are not allowed in EQUIVALENCE
  62   CHECK(fromOffset >= 0 && bytes >= 0 &&
  63       static_cast<std::size_t>(fromOffset + bytes) <= from.size());
  64   CHECK(static_cast<std::size_t>(toOffset + bytes) <= size());
  65   std::memcpy(&data_[toOffset], &from.data_[fromOffset], bytes);
  66 }
  67
  68 // Classes used with common::SearchTypes() to (re)construct Constant<> values
  69 // of the right type to initialize each symbol from the values that have
  70 // been placed into its initialization image by DATA statements.
  71 class AsConstantHelper {
  72 public:
  73   using Result = std::optional<Expr<SomeType>>;
  74   using Types = AllTypes;
  75   AsConstantHelper(FoldingContext &context, const DynamicType &type,
  76       const ConstantSubscripts &extents, const InitialImage &image,
  77       bool padWithZero = false, ConstantSubscript offset = 0)
  78       : context_{context}, type_{type}, image_{image}, extents_{extents},
  79         padWithZero_{padWithZero}, offset_{offset} {
  80     CHECK(!type.IsPolymorphic());
  81   }
  82   template <typename T> Result Test() {
  83     if (T::category != type_.category()) {
  84       return std::nullopt;
  85     }
  86     if constexpr (T::category != TypeCategory::Derived) {
  87       if (T::kind != type_.kind()) {
  88         return std::nullopt;
  89       }
  90     }
  91     using Const = Constant<T>;
  92     using Scalar = typename Const::Element;
  93     std::size_t elements{TotalElementCount(extents_)};
  94     std::vector<Scalar> typedValue(elements);
  95     auto elemBytes{
  96         ToInt64(type_.MeasureSizeInBytes(context_, GetRank(extents_) > 0))};
  97     CHECK(elemBytes && *elemBytes >= 0);
  98     std::size_t stride{static_cast<std::size_t>(*elemBytes)};
  99     CHECK(offset_ + elements * stride <= image_.data_.size() || padWithZero_);
 100     if constexpr (T::category == TypeCategory::Derived) {
 101       const semantics::DerivedTypeSpec &derived{type_.GetDerivedTypeSpec()};
 102       for (auto iter : DEREF(derived.scope())) {
 103         const Symbol &component{*iter.second};
 104         bool isProcPtr{IsProcedurePointer(component)};
 105         if (isProcPtr || component.has<semantics::ObjectEntityDetails>()) {
 106           auto at{offset_ + component.offset()};
 107           if (isProcPtr) {
 108             for (std::size_t j{0}; j < elements; ++j, at += stride) {
 109               if (Result value{image_.AsConstantPointer(at)}) {
 110                 typedValue[j].emplace(component, std::move(*value));
 111               }
 112             }
 113           } else if (IsPointer(component)) {
 114             for (std::size_t j{0}; j < elements; ++j, at += stride) {
 115               if (Result value{image_.AsConstantPointer(at)}) {
 116                 typedValue[j].emplace(component, std::move(*value));
 117               }
 118             }
 119           } else if (!IsAllocatable(component)) {
 120             auto componentType{DynamicType::From(component)};
 121             CHECK(componentType.has_value());
 122             auto componentExtents{GetConstantExtents(context_, component)};
 123             CHECK(componentExtents.has_value());
 124             for (std::size_t j{0}; j < elements; ++j, at += stride) {
 125               if (Result value{image_.AsConstant(context_, *componentType,
 126                       *componentExtents, padWithZero_, at)}) {
 127                 typedValue[j].emplace(component, std::move(*value));
 128               }
 129             }
 130           }
 131         }
 132       }
 133       return AsGenericExpr(
 134           Const{derived, std::move(typedValue), std::move(extents_)});
 135     } else if constexpr (T::category == TypeCategory::Character) {
 136       auto length{static_cast<ConstantSubscript>(stride) / T::kind};
 137       for (std::size_t j{0}; j < elements; ++j) {
 138         using Char = typename Scalar::value_type;
 139         auto at{static_cast<std::size_t>(offset_ + j * stride)};
 140         auto chunk{length};
 141         if (at + chunk > image_.data_.size()) {
 142           CHECK(padWithZero_);
 143           if (at >= image_.data_.size()) {
 144             chunk = 0;
 145           } else {
 146             chunk = image_.data_.size() - at;
 147           }
 148         }
 149         if (chunk > 0) {
 150           const Char *data{reinterpret_cast<const Char *>(&image_.data_[at])};
 151           typedValue[j].assign(data, chunk);
 152         }
 153         if (chunk < length && padWithZero_) {
 154           typedValue[j].append(length - chunk, Char{});
 155         }
 156       }
 157       return AsGenericExpr(
 158           Const{length, std::move(typedValue), std::move(extents_)});
 159     } else {
 160       // Lengthless intrinsic type
 161       CHECK(sizeof(Scalar) <= stride);
 162       for (std::size_t j{0}; j < elements; ++j) {
 163         auto at{static_cast<std::size_t>(offset_ + j * stride)};
 164         std::size_t chunk{sizeof(Scalar)};
 165         if (at + chunk > image_.data_.size()) {
 166           CHECK(padWithZero_);
 167           if (at >= image_.data_.size()) {
 168             chunk = 0;
 169           } else {
 170             chunk = image_.data_.size() - at;
 171           }
 172         }
 173         // TODO endianness
 174         if (chunk > 0) {
 175           std::memcpy(&typedValue[j], &image_.data_[at], chunk);
 176         }
 177       }
 178       return AsGenericExpr(Const{std::move(typedValue), std::move(extents_)});
 179     }
 180   }
 181
 182 private:
 183   FoldingContext &context_;
 184   const DynamicType &type_;
 185   const InitialImage &image_;
 186   ConstantSubscripts extents_; // a copy
 187   bool padWithZero_;
 188   ConstantSubscript offset_;
 189 };
 190
 191 std::optional<Expr<SomeType>> InitialImage::AsConstant(FoldingContext &context,
 192     const DynamicType &type, const ConstantSubscripts &extents,
 193     bool padWithZero, ConstantSubscript offset) const {
 194   return common::SearchTypes(
 195       AsConstantHelper{context, type, extents, *this, padWithZero, offset});
 196 }
 197
 198 std::optional<Expr<SomeType>> InitialImage::AsConstantPointer(
 199     ConstantSubscript offset) const {
 200   auto iter{pointers_.find(offset)};
 201   return iter == pointers_.end() ? std::optional<Expr<SomeType>>{}
 202                                  : iter->second;
 203 }
 204
 205 } // namespace Fortran::evaluate