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> dependents_;
62 // base symbol -> SizeAndAlignment for each distinct EQUIVALENCE block
63 std::map<MutableSymbolRef, SizeAndAlignment> equivalenceBlock_;
64 };
65
Compute(Scope & scope)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
Resolve(const SymbolAndOffset & dep)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
DoCommonBlock(Symbol & commonBlock)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
DoEquivalenceBlockBase(Symbol & symbol,SizeAndAlignment & blockInfo)194 void ComputeOffsetsHelper::DoEquivalenceBlockBase(
195 Symbol &symbol, SizeAndAlignment &blockInfo) {
196 if (symbol.size() > blockInfo.size) {
197 blockInfo.size = symbol.size();
198 }
199 }
200
DoEquivalenceSet(const EquivalenceSet & set)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.
ComputeOffset(const EquivalenceObject & object)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
DoSymbol(Symbol & symbol)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
GetSizeAndAlignment(const Symbol & symbol,bool entire)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->type().MeasureSizeInBytes(
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.
Align(std::size_t x,std::size_t alignment)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
ComputeOffsets(SemanticsContext & context,Scope & scope)342 void ComputeOffsets(SemanticsContext &context, Scope &scope) {
343 ComputeOffsetsHelper{context}.Compute(scope);
344 }
345
346 } // namespace Fortran::semantics
347