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