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
23namespace Fortran::semantics {
24
25class ComputeOffsetsHelper {
26public:
27 ComputeOffsetsHelper(SemanticsContext &context) : context_{context} {}
28 void Compute(Scope &);
29
30private:
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
68void 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 (!FindCommonBlockContaining(*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 (!FindCommonBlockContaining(*symbol) &&
114 dependents_.find(symbol) == dependents_.end() &&
115 equivalenceBlock_.find(symbol) == equivalenceBlock_.end()) {
116 DoSymbol(*symbol);
117 }
118 }
119 // Ensure that the size is a multiple of the alignment
120 offset_ = Align(offset_, alignment_);
121 scope.set_size(offset_);
122 scope.SetAlignment(alignment_);
123 // Assign offsets in COMMON blocks, unless this scope is a BLOCK construct,
124 // where COMMON blocks are illegal (C1107 and C1108).
125 if (scope.kind() != Scope::Kind::BlockConstruct) {
126 for (auto &pair : scope.commonBlocks()) {
127 DoCommonBlock(*pair.second);
128 }
129 }
130 for (auto &[symbol, dep] : dependents_) {
131 symbol->set_offset(dep.symbol->offset() + dep.offset);
132 if (const auto *block{FindCommonBlockContaining(*dep.symbol)}) {
133 symbol->get<ObjectEntityDetails>().set_commonBlock(*block);
134 }
135 }
136}
137
138auto ComputeOffsetsHelper::Resolve(const SymbolAndOffset &dep)
139 -> SymbolAndOffset {
140 auto it{dependents_.find(*dep.symbol)};
141 if (it == dependents_.end()) {
142 return dep;
143 } else {
144 SymbolAndOffset result{Resolve(dep: it->second)};
145 result.offset += dep.offset;
146 result.object = dep.object;
147 return result;
148 }
149}
150
151void ComputeOffsetsHelper::DoCommonBlock(Symbol &commonBlock) {
152 auto &details{commonBlock.get<CommonBlockDetails>()};
153 offset_ = 0;
154 alignment_ = 0;
155 std::size_t minSize{0};
156 std::size_t minAlignment{0};
157 UnorderedSymbolSet previous;
158 for (auto object : details.objects()) {
159 Symbol &symbol{*object};
160 auto errorSite{
161 commonBlock.name().empty() ? symbol.name() : commonBlock.name()};
162 if (std::size_t padding{DoSymbol(symbol.GetUltimate())}) {
163 if (context_.ShouldWarn(common::UsageWarning::CommonBlockPadding)) {
164 context_.Say(errorSite,
165 "COMMON block /%s/ requires %zd bytes of padding before '%s' for alignment"_port_en_US,
166 commonBlock.name(), padding, symbol.name());
167 }
168 }
169 previous.emplace(symbol);
170 auto eqIter{equivalenceBlock_.end()};
171 auto iter{dependents_.find(symbol)};
172 if (iter == dependents_.end()) {
173 eqIter = equivalenceBlock_.find(symbol);
174 if (eqIter != equivalenceBlock_.end()) {
175 DoEquivalenceBlockBase(symbol, eqIter->second);
176 }
177 } else {
178 SymbolAndOffset &dep{iter->second};
179 Symbol &base{*dep.symbol};
180 if (const auto *baseBlock{FindCommonBlockContaining(base)}) {
181 if (baseBlock == &commonBlock) {
182 if (previous.find(SymbolRef{base}) == previous.end() ||
183 base.offset() != symbol.offset() - dep.offset) {
184 context_.Say(errorSite,
185 "'%s' is storage associated with '%s' by EQUIVALENCE elsewhere in COMMON block /%s/"_err_en_US,
186 symbol.name(), base.name(), commonBlock.name());
187 }
188 } else { // F'2023 8.10.3 p1
189 context_.Say(errorSite,
190 "'%s' in COMMON block /%s/ must not be storage associated with '%s' in COMMON block /%s/ by EQUIVALENCE"_err_en_US,
191 symbol.name(), commonBlock.name(), base.name(),
192 baseBlock->name());
193 }
194 } else if (dep.offset > symbol.offset()) { // 8.10.3(3)
195 context_.Say(errorSite,
196 "'%s' cannot backward-extend COMMON block /%s/ via EQUIVALENCE with '%s'"_err_en_US,
197 symbol.name(), commonBlock.name(), base.name());
198 } else {
199 eqIter = equivalenceBlock_.find(base);
200 base.get<ObjectEntityDetails>().set_commonBlock(commonBlock);
201 base.set_offset(symbol.offset() - dep.offset);
202 previous.emplace(base);
203 }
204 }
205 // Get full extent of any EQUIVALENCE block into size of COMMON ( see
206 // 8.10.2.2 point 1 (2))
207 if (eqIter != equivalenceBlock_.end()) {
208 SizeAndAlignment &blockInfo{eqIter->second};
209 minSize = std::max(
210 minSize, std::max(offset_, eqIter->first->offset() + blockInfo.size));
211 minAlignment = std::max(minAlignment, blockInfo.alignment);
212 }
213 }
214 commonBlock.set_size(std::max(a: minSize, b: offset_));
215 details.set_alignment(std::max(a: minAlignment, b: alignment_));
216 context_.MapCommonBlockAndCheckConflicts(commonBlock);
217}
218
219void ComputeOffsetsHelper::DoEquivalenceBlockBase(
220 Symbol &symbol, SizeAndAlignment &blockInfo) {
221 if (symbol.size() > blockInfo.size) {
222 blockInfo.size = symbol.size();
223 }
224}
225
226void ComputeOffsetsHelper::DoEquivalenceSet(const EquivalenceSet &set) {
227 std::vector<SymbolAndOffset> symbolOffsets;
228 std::optional<std::size_t> representative;
229 for (const EquivalenceObject &object : set) {
230 std::size_t offset{ComputeOffset(object)};
231 SymbolAndOffset resolved{
232 Resolve(SymbolAndOffset{object.symbol, offset, object})};
233 symbolOffsets.push_back(resolved);
234 if (!representative ||
235 resolved.offset >= symbolOffsets[*representative].offset) {
236 // The equivalenced object with the largest offset from its resolved
237 // symbol will be the representative of this set, since the offsets
238 // of the other objects will be positive relative to it.
239 representative = symbolOffsets.size() - 1;
240 }
241 }
242 CHECK(representative);
243 const SymbolAndOffset &base{symbolOffsets[*representative]};
244 for (const auto &[symbol, offset, object] : symbolOffsets) {
245 if (symbol == base.symbol) {
246 if (offset != base.offset) {
247 auto x{evaluate::OffsetToDesignator(
248 context_.foldingContext(), *symbol, base.offset, 1)};
249 auto y{evaluate::OffsetToDesignator(
250 context_.foldingContext(), *symbol, offset, 1)};
251 if (x && y) {
252 context_
253 .Say(base.object->source,
254 "'%s' and '%s' cannot have the same first storage unit"_err_en_US,
255 x->AsFortran(), y->AsFortran())
256 .Attach(object->source, "Incompatible reference to '%s'"_en_US,
257 y->AsFortran());
258 } else { // error recovery
259 context_
260 .Say(base.object->source,
261 "'%s' (offset %zd bytes and %zd bytes) cannot have the same first storage unit"_err_en_US,
262 symbol->name(), base.offset, offset)
263 .Attach(object->source,
264 "Incompatible reference to '%s' offset %zd bytes"_en_US,
265 symbol->name(), offset);
266 }
267 }
268 } else {
269 dependents_.emplace(*symbol,
270 SymbolAndOffset{*base.symbol, base.offset - offset, *object});
271 }
272 }
273}
274
275// Offset of this equivalence object from the start of its variable.
276std::size_t ComputeOffsetsHelper::ComputeOffset(
277 const EquivalenceObject &object) {
278 std::size_t offset{0};
279 if (!object.subscripts.empty()) {
280 const ArraySpec &shape{object.symbol.get<ObjectEntityDetails>().shape()};
281 auto lbound{[&](std::size_t i) {
282 return *ToInt64(shape[i].lbound().GetExplicit());
283 }};
284 auto ubound{[&](std::size_t i) {
285 return *ToInt64(shape[i].ubound().GetExplicit());
286 }};
287 for (std::size_t i{object.subscripts.size() - 1};;) {
288 offset += object.subscripts[i] - lbound(i);
289 if (i == 0) {
290 break;
291 }
292 --i;
293 offset *= ubound(i) - lbound(i) + 1;
294 }
295 }
296 auto result{offset * GetSizeAndAlignment(object.symbol, false).size};
297 if (object.substringStart) {
298 int kind{context_.defaultKinds().GetDefaultKind(TypeCategory::Character)};
299 if (const DeclTypeSpec * type{object.symbol.GetType()}) {
300 if (const IntrinsicTypeSpec * intrinsic{type->AsIntrinsic()}) {
301 kind = ToInt64(intrinsic->kind()).value_or(kind);
302 }
303 }
304 result += kind * (*object.substringStart - 1);
305 }
306 return result;
307}
308
309std::size_t ComputeOffsetsHelper::DoSymbol(Symbol &symbol) {
310 if (!symbol.has<ObjectEntityDetails>() && !symbol.has<ProcEntityDetails>()) {
311 return 0;
312 }
313 SizeAndAlignment s{GetSizeAndAlignment(symbol, true)};
314 if (s.size == 0) {
315 return 0;
316 }
317 std::size_t previousOffset{offset_};
318 offset_ = Align(offset_, s.alignment);
319 std::size_t padding{offset_ - previousOffset};
320 symbol.set_size(s.size);
321 symbol.set_offset(offset_);
322 offset_ += s.size;
323 alignment_ = std::max(a: alignment_, b: s.alignment);
324 return padding;
325}
326
327auto ComputeOffsetsHelper::GetSizeAndAlignment(
328 const Symbol &symbol, bool entire) -> SizeAndAlignment {
329 auto &targetCharacteristics{context_.targetCharacteristics()};
330 if (IsDescriptor(symbol)) {
331 auto dyType{evaluate::DynamicType::From(symbol)};
332 const auto *derived{evaluate::GetDerivedTypeSpec(dyType)};
333 int lenParams{derived ? CountLenParameters(*derived) : 0};
334 bool needAddendum{derived || (dyType && dyType->IsUnlimitedPolymorphic())};
335 std::size_t size{runtime::Descriptor::SizeInBytes(
336 symbol.Rank(), needAddendum, lenParams)};
337 return {size, targetCharacteristics.descriptorAlignment()};
338 }
339 if (IsProcedurePointer(symbol)) {
340 return {targetCharacteristics.procedurePointerByteSize(),
341 targetCharacteristics.procedurePointerAlignment()};
342 }
343 if (IsProcedure(symbol)) {
344 return {};
345 }
346 auto &foldingContext{context_.foldingContext()};
347 if (auto chars{evaluate::characteristics::TypeAndShape::Characterize(
348 symbol, foldingContext)}) {
349 if (entire) {
350 if (auto size{ToInt64(chars->MeasureSizeInBytes(foldingContext))}) {
351 return {static_cast<std::size_t>(*size),
352 chars->type().GetAlignment(targetCharacteristics)};
353 }
354 } else { // element size only
355 if (auto size{ToInt64(chars->MeasureElementSizeInBytes(
356 foldingContext, true /*aligned*/))}) {
357 return {static_cast<std::size_t>(*size),
358 chars->type().GetAlignment(targetCharacteristics)};
359 }
360 }
361 }
362 return {};
363}
364
365// Align a size to its natural alignment, up to maxAlignment.
366std::size_t ComputeOffsetsHelper::Align(std::size_t x, std::size_t alignment) {
367 alignment =
368 std::min(alignment, context_.targetCharacteristics().maxAlignment());
369 return (x + alignment - 1) & -alignment;
370}
371
372void ComputeOffsets(SemanticsContext &context, Scope &scope) {
373 ComputeOffsetsHelper{context}.Compute(scope);
374}
375
376} // namespace Fortran::semantics
377

source code of flang/lib/Semantics/compute-offsets.cpp