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