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