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
Add(ConstantSubscript offset,std::size_t bytes,const Constant<SomeDerived> & x)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
AddPointer(ConstantSubscript offset,const Expr<SomeType> & pointer)52 void InitialImage::AddPointer(
53 ConstantSubscript offset, const Expr<SomeType> &pointer) {
54 pointers_.emplace(offset, pointer);
55 }
56
Incorporate(ConstantSubscript offset,const InitialImage & that)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;
AsConstantHelper(FoldingContext & context,const DynamicType & type,const ConstantSubscripts & extents,const InitialImage & image,ConstantSubscript offset=0)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 }
Test()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
AsConstant(FoldingContext & context,const DynamicType & type,const ConstantSubscripts & extents,ConstantSubscript offset) const154 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;
AsConstantDataPointerHelper(const DynamicType & type,const InitialImage & image,ConstantSubscript offset=0)165 AsConstantDataPointerHelper(const DynamicType &type,
166 const InitialImage &image, ConstantSubscript offset = 0)
167 : type_{type}, image_{image}, offset_{offset} {}
Test()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
AsConstantDataPointer(const DynamicType & type,ConstantSubscript offset) const190 std::optional<Expr<SomeType>> InitialImage::AsConstantDataPointer(
191 const DynamicType &type, ConstantSubscript offset) const {
192 return common::SearchTypes(AsConstantDataPointerHelper{type, *this, offset});
193 }
194
AsConstantProcPointer(ConstantSubscript offset) const195 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