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 {
37             Result added{Add(offset + component.offset(), component.size(),
38                 indExpr.value(), context)};
39             if (added != Ok) {
40               return added;
41             }
42           }
43         }
44         offset += elementBytes;
45       }
46     }
47     return Ok;
48   }
49 }
50 
51 void InitialImage::AddPointer(
52     ConstantSubscript offset, const Expr<SomeType> &pointer) {
53   pointers_.emplace(offset, pointer);
54 }
55 
56 void InitialImage::Incorporate(ConstantSubscript toOffset,
57     const InitialImage &from, ConstantSubscript fromOffset,
58     ConstantSubscript bytes) {
59   CHECK(from.pointers_.empty()); // pointers are not allowed in EQUIVALENCE
60   CHECK(fromOffset >= 0 && bytes >= 0 &&
61       static_cast<std::size_t>(fromOffset + bytes) <= from.size());
62   CHECK(static_cast<std::size_t>(toOffset + bytes) <= size());
63   std::memcpy(&data_[toOffset], &from.data_[fromOffset], bytes);
64 }
65 
66 // Classes used with common::SearchTypes() to (re)construct Constant<> values
67 // of the right type to initialize each symbol from the values that have
68 // been placed into its initialization image by DATA statements.
69 class AsConstantHelper {
70 public:
71   using Result = std::optional<Expr<SomeType>>;
72   using Types = AllTypes;
73   AsConstantHelper(FoldingContext &context, const DynamicType &type,
74       const ConstantSubscripts &extents, const InitialImage &image,
75       ConstantSubscript offset = 0)
76       : context_{context}, type_{type}, image_{image}, extents_{extents},
77         offset_{offset} {
78     CHECK(!type.IsPolymorphic());
79   }
80   template <typename T> Result Test() {
81     if (T::category != type_.category()) {
82       return std::nullopt;
83     }
84     if constexpr (T::category != TypeCategory::Derived) {
85       if (T::kind != type_.kind()) {
86         return std::nullopt;
87       }
88     }
89     using Const = Constant<T>;
90     using Scalar = typename Const::Element;
91     std::size_t elements{TotalElementCount(extents_)};
92     std::vector<Scalar> typedValue(elements);
93     auto elemBytes{
94         ToInt64(type_.MeasureSizeInBytes(context_, GetRank(extents_) > 0))};
95     CHECK(elemBytes && *elemBytes >= 0);
96     std::size_t stride{static_cast<std::size_t>(*elemBytes)};
97     CHECK(offset_ + elements * stride <= image_.data_.size());
98     if constexpr (T::category == TypeCategory::Derived) {
99       const semantics::DerivedTypeSpec &derived{type_.GetDerivedTypeSpec()};
100       for (auto iter : DEREF(derived.scope())) {
101         const Symbol &component{*iter.second};
102         bool isProcPtr{IsProcedurePointer(component)};
103         if (isProcPtr || component.has<semantics::ObjectEntityDetails>()) {
104           auto at{offset_ + component.offset()};
105           if (isProcPtr) {
106             for (std::size_t j{0}; j < elements; ++j, at += stride) {
107               if (Result value{image_.AsConstantPointer(at)}) {
108                 typedValue[j].emplace(component, std::move(*value));
109               }
110             }
111           } else if (IsPointer(component)) {
112             for (std::size_t j{0}; j < elements; ++j, at += stride) {
113               if (Result value{image_.AsConstantPointer(at)}) {
114                 typedValue[j].emplace(component, std::move(*value));
115               }
116             }
117           } else if (!IsAllocatable(component)) {
118             auto componentType{DynamicType::From(component)};
119             CHECK(componentType.has_value());
120             auto componentExtents{GetConstantExtents(context_, component)};
121             CHECK(componentExtents.has_value());
122             for (std::size_t j{0}; j < elements; ++j, at += stride) {
123               if (Result value{image_.AsConstant(
124                       context_, *componentType, *componentExtents, at)}) {
125                 typedValue[j].emplace(component, std::move(*value));
126               }
127             }
128           }
129         }
130       }
131       return AsGenericExpr(
132           Const{derived, std::move(typedValue), std::move(extents_)});
133     } else if constexpr (T::category == TypeCategory::Character) {
134       auto length{static_cast<ConstantSubscript>(stride) / T::kind};
135       for (std::size_t j{0}; j < elements; ++j) {
136         using Char = typename Scalar::value_type;
137         const Char *data{reinterpret_cast<const Char *>(
138             &image_.data_[offset_ + j * stride])};
139         typedValue[j].assign(data, length);
140       }
141       return AsGenericExpr(
142           Const{length, std::move(typedValue), std::move(extents_)});
143     } else {
144       // Lengthless intrinsic type
145       CHECK(sizeof(Scalar) <= stride);
146       for (std::size_t j{0}; j < elements; ++j) {
147         std::memcpy(&typedValue[j], &image_.data_[offset_ + j * stride],
148             sizeof(Scalar));
149       }
150       return AsGenericExpr(Const{std::move(typedValue), std::move(extents_)});
151     }
152   }
153 
154 private:
155   FoldingContext &context_;
156   const DynamicType &type_;
157   const InitialImage &image_;
158   ConstantSubscripts extents_; // a copy
159   ConstantSubscript offset_;
160 };
161 
162 std::optional<Expr<SomeType>> InitialImage::AsConstant(FoldingContext &context,
163     const DynamicType &type, const ConstantSubscripts &extents,
164     ConstantSubscript offset) const {
165   return common::SearchTypes(
166       AsConstantHelper{context, type, extents, *this, offset});
167 }
168 
169 std::optional<Expr<SomeType>> InitialImage::AsConstantPointer(
170     ConstantSubscript offset) const {
171   auto iter{pointers_.find(offset)};
172   return iter == pointers_.end() ? std::optional<Expr<SomeType>>{}
173                                  : iter->second;
174 }
175 
176 } // namespace Fortran::evaluate
177