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