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
14namespace Fortran::evaluate {
15
16auto 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
55void InitialImage::AddPointer(
56 ConstantSubscript offset, const Expr<SomeType> &pointer) {
57 pointers_.emplace(offset, pointer);
58}
59
60void 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.
73class AsConstantHelper {
74public:
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
194private:
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
204std::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
212std::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
220

source code of flang/lib/Evaluate/initial-image.cpp