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