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