1 //===-- lib/Semantics/compute-offsets.cpp -----------------------*- C++ -*-===//
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 "compute-offsets.h"
10 #include "../../runtime/descriptor.h"
11 #include "flang/Evaluate/fold-designator.h"
12 #include "flang/Evaluate/fold.h"
13 #include "flang/Evaluate/shape.h"
14 #include "flang/Evaluate/type.h"
15 #include "flang/Semantics/scope.h"
16 #include "flang/Semantics/semantics.h"
17 #include "flang/Semantics/symbol.h"
18 #include "flang/Semantics/tools.h"
19 #include "flang/Semantics/type.h"
20 #include <algorithm>
21 #include <vector>
22
23 namespace Fortran::semantics {
24
25 class ComputeOffsetsHelper {
26 public:
ComputeOffsetsHelper(SemanticsContext & context)27 ComputeOffsetsHelper(SemanticsContext &context) : context_{context} {}
28 void Compute(Scope &);
29
30 private:
31 struct SizeAndAlignment {
SizeAndAlignmentFortran::semantics::ComputeOffsetsHelper::SizeAndAlignment32 SizeAndAlignment() {}
SizeAndAlignmentFortran::semantics::ComputeOffsetsHelper::SizeAndAlignment33 SizeAndAlignment(std::size_t bytes) : size{bytes}, alignment{bytes} {}
SizeAndAlignmentFortran::semantics::ComputeOffsetsHelper::SizeAndAlignment34 SizeAndAlignment(std::size_t bytes, std::size_t align)
35 : size{bytes}, alignment{align} {}
36 std::size_t size{0};
37 std::size_t alignment{0};
38 };
39 struct SymbolAndOffset {
SymbolAndOffsetFortran::semantics::ComputeOffsetsHelper::SymbolAndOffset40 SymbolAndOffset(Symbol &s, std::size_t off, const EquivalenceObject &obj)
41 : symbol{&s}, offset{off}, object{&obj} {}
42 SymbolAndOffset(const SymbolAndOffset &) = default;
43 Symbol *symbol;
44 std::size_t offset;
45 const EquivalenceObject *object;
46 };
47
48 void DoCommonBlock(Symbol &);
49 void DoEquivalenceBlockBase(Symbol &, SizeAndAlignment &);
50 void DoEquivalenceSet(const EquivalenceSet &);
51 SymbolAndOffset Resolve(const SymbolAndOffset &);
52 std::size_t ComputeOffset(const EquivalenceObject &);
53 void DoSymbol(Symbol &);
54 SizeAndAlignment GetSizeAndAlignment(const Symbol &, bool entire);
55 std::size_t Align(std::size_t, std::size_t);
56
57 SemanticsContext &context_;
58 std::size_t offset_{0};
59 std::size_t alignment_{1};
60 // symbol -> symbol+offset that determines its location, from EQUIVALENCE
61 std::map<MutableSymbolRef, SymbolAndOffset, SymbolAddressCompare> dependents_;
62 // base symbol -> SizeAndAlignment for each distinct EQUIVALENCE block
63 std::map<MutableSymbolRef, SizeAndAlignment, SymbolAddressCompare>
64 equivalenceBlock_;
65 };
66
Compute(Scope & scope)67 void ComputeOffsetsHelper::Compute(Scope &scope) {
68 for (Scope &child : scope.children()) {
69 ComputeOffsets(context_, child);
70 }
71 if (scope.symbol() && scope.IsParameterizedDerivedType()) {
72 return; // only process instantiations of parameterized derived types
73 }
74 if (scope.alignment().has_value()) {
75 return; // prevent infinite recursion in error cases
76 }
77 scope.SetAlignment(0);
78 // Build dependents_ from equivalences: symbol -> symbol+offset
79 for (const EquivalenceSet &set : scope.equivalenceSets()) {
80 DoEquivalenceSet(set);
81 }
82 // Compute a base symbol and overall block size for each
83 // disjoint EQUIVALENCE storage sequence.
84 for (auto &[symbol, dep] : dependents_) {
85 dep = Resolve(dep);
86 CHECK(symbol->size() == 0);
87 auto symInfo{GetSizeAndAlignment(*symbol, true)};
88 symbol->set_size(symInfo.size);
89 Symbol &base{*dep.symbol};
90 auto iter{equivalenceBlock_.find(base)};
91 std::size_t minBlockSize{dep.offset + symInfo.size};
92 if (iter == equivalenceBlock_.end()) {
93 equivalenceBlock_.emplace(
94 base, SizeAndAlignment{minBlockSize, symInfo.alignment});
95 } else {
96 SizeAndAlignment &blockInfo{iter->second};
97 blockInfo.size = std::max(blockInfo.size, minBlockSize);
98 blockInfo.alignment = std::max(blockInfo.alignment, symInfo.alignment);
99 }
100 }
101 // Assign offsets for non-COMMON EQUIVALENCE blocks
102 for (auto &[symbol, blockInfo] : equivalenceBlock_) {
103 if (!InCommonBlock(*symbol)) {
104 DoSymbol(*symbol);
105 DoEquivalenceBlockBase(*symbol, blockInfo);
106 offset_ = std::max(offset_, symbol->offset() + blockInfo.size);
107 }
108 }
109 // Process remaining non-COMMON symbols; this is all of them if there
110 // was no use of EQUIVALENCE in the scope.
111 for (auto &symbol : scope.GetSymbols()) {
112 if (!InCommonBlock(*symbol) &&
113 dependents_.find(symbol) == dependents_.end() &&
114 equivalenceBlock_.find(symbol) == equivalenceBlock_.end()) {
115 DoSymbol(*symbol);
116 }
117 }
118 scope.set_size(offset_);
119 scope.SetAlignment(alignment_);
120 // Assign offsets in COMMON blocks.
121 for (auto &pair : scope.commonBlocks()) {
122 DoCommonBlock(*pair.second);
123 }
124 for (auto &[symbol, dep] : dependents_) {
125 symbol->set_offset(dep.symbol->offset() + dep.offset);
126 if (const auto *block{FindCommonBlockContaining(*dep.symbol)}) {
127 symbol->get<ObjectEntityDetails>().set_commonBlock(*block);
128 }
129 }
130 }
131
Resolve(const SymbolAndOffset & dep)132 auto ComputeOffsetsHelper::Resolve(const SymbolAndOffset &dep)
133 -> SymbolAndOffset {
134 auto it{dependents_.find(*dep.symbol)};
135 if (it == dependents_.end()) {
136 return dep;
137 } else {
138 SymbolAndOffset result{Resolve(it->second)};
139 result.offset += dep.offset;
140 result.object = dep.object;
141 return result;
142 }
143 }
144
DoCommonBlock(Symbol & commonBlock)145 void ComputeOffsetsHelper::DoCommonBlock(Symbol &commonBlock) {
146 auto &details{commonBlock.get<CommonBlockDetails>()};
147 offset_ = 0;
148 alignment_ = 0;
149 std::size_t minSize{0};
150 std::size_t minAlignment{0};
151 for (auto &object : details.objects()) {
152 Symbol &symbol{*object};
153 DoSymbol(symbol);
154 auto iter{dependents_.find(symbol)};
155 if (iter == dependents_.end()) {
156 // Get full extent of any EQUIVALENCE block into size of COMMON
157 auto eqIter{equivalenceBlock_.find(symbol)};
158 if (eqIter != equivalenceBlock_.end()) {
159 SizeAndAlignment &blockInfo{eqIter->second};
160 DoEquivalenceBlockBase(symbol, blockInfo);
161 minSize = std::max(
162 minSize, std::max(offset_, symbol.offset() + blockInfo.size));
163 minAlignment = std::max(minAlignment, blockInfo.alignment);
164 }
165 } else {
166 SymbolAndOffset &dep{iter->second};
167 Symbol &base{*dep.symbol};
168 auto errorSite{
169 commonBlock.name().empty() ? symbol.name() : commonBlock.name()};
170 if (const auto *baseBlock{FindCommonBlockContaining(base)}) {
171 if (baseBlock == &commonBlock) {
172 context_.Say(errorSite,
173 "'%s' is storage associated with '%s' by EQUIVALENCE elsewhere in COMMON block /%s/"_err_en_US,
174 symbol.name(), base.name(), commonBlock.name());
175 } else { // 8.10.3(1)
176 context_.Say(errorSite,
177 "'%s' in COMMON block /%s/ must not be storage associated with '%s' in COMMON block /%s/ by EQUIVALENCE"_err_en_US,
178 symbol.name(), commonBlock.name(), base.name(),
179 baseBlock->name());
180 }
181 } else if (dep.offset > symbol.offset()) { // 8.10.3(3)
182 context_.Say(errorSite,
183 "'%s' cannot backward-extend COMMON block /%s/ via EQUIVALENCE with '%s'"_err_en_US,
184 symbol.name(), commonBlock.name(), base.name());
185 } else {
186 base.get<ObjectEntityDetails>().set_commonBlock(commonBlock);
187 base.set_offset(symbol.offset() - dep.offset);
188 }
189 }
190 }
191 commonBlock.set_size(std::max(minSize, offset_));
192 details.set_alignment(std::max(minAlignment, alignment_));
193 }
194
DoEquivalenceBlockBase(Symbol & symbol,SizeAndAlignment & blockInfo)195 void ComputeOffsetsHelper::DoEquivalenceBlockBase(
196 Symbol &symbol, SizeAndAlignment &blockInfo) {
197 if (symbol.size() > blockInfo.size) {
198 blockInfo.size = symbol.size();
199 }
200 }
201
DoEquivalenceSet(const EquivalenceSet & set)202 void ComputeOffsetsHelper::DoEquivalenceSet(const EquivalenceSet &set) {
203 std::vector<SymbolAndOffset> symbolOffsets;
204 std::optional<std::size_t> representative;
205 for (const EquivalenceObject &object : set) {
206 std::size_t offset{ComputeOffset(object)};
207 SymbolAndOffset resolved{
208 Resolve(SymbolAndOffset{object.symbol, offset, object})};
209 symbolOffsets.push_back(resolved);
210 if (!representative ||
211 resolved.offset >= symbolOffsets[*representative].offset) {
212 // The equivalenced object with the largest offset from its resolved
213 // symbol will be the representative of this set, since the offsets
214 // of the other objects will be positive relative to it.
215 representative = symbolOffsets.size() - 1;
216 }
217 }
218 CHECK(representative);
219 const SymbolAndOffset &base{symbolOffsets[*representative]};
220 for (const auto &[symbol, offset, object] : symbolOffsets) {
221 if (symbol == base.symbol) {
222 if (offset != base.offset) {
223 auto x{evaluate::OffsetToDesignator(
224 context_.foldingContext(), *symbol, base.offset, 1)};
225 auto y{evaluate::OffsetToDesignator(
226 context_.foldingContext(), *symbol, offset, 1)};
227 if (x && y) {
228 context_
229 .Say(base.object->source,
230 "'%s' and '%s' cannot have the same first storage unit"_err_en_US,
231 x->AsFortran(), y->AsFortran())
232 .Attach(object->source, "Incompatible reference to '%s'"_en_US,
233 y->AsFortran());
234 } else { // error recovery
235 context_
236 .Say(base.object->source,
237 "'%s' (offset %zd bytes and %zd bytes) cannot have the same first storage unit"_err_en_US,
238 symbol->name(), base.offset, offset)
239 .Attach(object->source,
240 "Incompatible reference to '%s' offset %zd bytes"_en_US,
241 symbol->name(), offset);
242 }
243 }
244 } else {
245 dependents_.emplace(*symbol,
246 SymbolAndOffset{*base.symbol, base.offset - offset, *object});
247 }
248 }
249 }
250
251 // Offset of this equivalence object from the start of its variable.
ComputeOffset(const EquivalenceObject & object)252 std::size_t ComputeOffsetsHelper::ComputeOffset(
253 const EquivalenceObject &object) {
254 std::size_t offset{0};
255 if (!object.subscripts.empty()) {
256 const ArraySpec &shape{object.symbol.get<ObjectEntityDetails>().shape()};
257 auto lbound{[&](std::size_t i) {
258 return *ToInt64(shape[i].lbound().GetExplicit());
259 }};
260 auto ubound{[&](std::size_t i) {
261 return *ToInt64(shape[i].ubound().GetExplicit());
262 }};
263 for (std::size_t i{object.subscripts.size() - 1};;) {
264 offset += object.subscripts[i] - lbound(i);
265 if (i == 0) {
266 break;
267 }
268 --i;
269 offset *= ubound(i) - lbound(i) + 1;
270 }
271 }
272 auto result{offset * GetSizeAndAlignment(object.symbol, false).size};
273 if (object.substringStart) {
274 int kind{context_.defaultKinds().GetDefaultKind(TypeCategory::Character)};
275 if (const DeclTypeSpec * type{object.symbol.GetType()}) {
276 if (const IntrinsicTypeSpec * intrinsic{type->AsIntrinsic()}) {
277 kind = ToInt64(intrinsic->kind()).value_or(kind);
278 }
279 }
280 result += kind * (*object.substringStart - 1);
281 }
282 return result;
283 }
284
DoSymbol(Symbol & symbol)285 void ComputeOffsetsHelper::DoSymbol(Symbol &symbol) {
286 if (!symbol.has<ObjectEntityDetails>() && !symbol.has<ProcEntityDetails>()) {
287 return;
288 }
289 SizeAndAlignment s{GetSizeAndAlignment(symbol, true)};
290 if (s.size == 0) {
291 return;
292 }
293 offset_ = Align(offset_, s.alignment);
294 symbol.set_size(s.size);
295 symbol.set_offset(offset_);
296 offset_ += s.size;
297 alignment_ = std::max(alignment_, s.alignment);
298 }
299
GetSizeAndAlignment(const Symbol & symbol,bool entire)300 auto ComputeOffsetsHelper::GetSizeAndAlignment(
301 const Symbol &symbol, bool entire) -> SizeAndAlignment {
302 // TODO: The size of procedure pointers is not yet known
303 // and is independent of rank (and probably also the number
304 // of length type parameters).
305 auto &foldingContext{context_.foldingContext()};
306 if (IsDescriptor(symbol) || IsProcedurePointer(symbol)) {
307 const auto *derived{
308 evaluate::GetDerivedTypeSpec(evaluate::DynamicType::From(symbol))};
309 int lenParams{derived ? CountLenParameters(*derived) : 0};
310 std::size_t size{runtime::Descriptor::SizeInBytes(
311 symbol.Rank(), derived != nullptr, lenParams)};
312 return {size, foldingContext.maxAlignment()};
313 }
314 if (IsProcedure(symbol)) {
315 return {};
316 }
317 if (auto chars{evaluate::characteristics::TypeAndShape::Characterize(
318 symbol, foldingContext)}) {
319 if (entire) {
320 if (auto size{ToInt64(chars->MeasureSizeInBytes(foldingContext))}) {
321 return {static_cast<std::size_t>(*size),
322 chars->type().GetAlignment(foldingContext)};
323 }
324 } else { // element size only
325 if (auto size{ToInt64(chars->MeasureElementSizeInBytes(
326 foldingContext, true /*aligned*/))}) {
327 return {static_cast<std::size_t>(*size),
328 chars->type().GetAlignment(foldingContext)};
329 }
330 }
331 }
332 return {};
333 }
334
335 // Align a size to its natural alignment, up to maxAlignment.
Align(std::size_t x,std::size_t alignment)336 std::size_t ComputeOffsetsHelper::Align(std::size_t x, std::size_t alignment) {
337 alignment = std::min(alignment, context_.foldingContext().maxAlignment());
338 return (x + alignment - 1) & -alignment;
339 }
340
ComputeOffsets(SemanticsContext & context,Scope & scope)341 void ComputeOffsets(SemanticsContext &context, Scope &scope) {
342 ComputeOffsetsHelper{context}.Compute(scope);
343 }
344
345 } // namespace Fortran::semantics
346