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-consts.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 "llvm/TargetParser/Host.h"
21#include "llvm/TargetParser/Triple.h"
22#include <algorithm>
23#include <vector>
24
25namespace Fortran::semantics {
26
27class ComputeOffsetsHelper {
28public:
29 ComputeOffsetsHelper(SemanticsContext &context) : context_{context} {}
30 void Compute(Scope &);
31
32private:
33 struct SizeAndAlignment {
34 SizeAndAlignment() {}
35 SizeAndAlignment(std::size_t bytes) : size{bytes}, alignment{bytes} {}
36 SizeAndAlignment(std::size_t bytes, std::size_t align)
37 : size{bytes}, alignment{align} {}
38 std::size_t size{0};
39 std::size_t alignment{0};
40 };
41 struct SymbolAndOffset {
42 SymbolAndOffset(Symbol &s, std::size_t off, const EquivalenceObject &obj)
43 : symbol{s}, offset{off}, object{&obj} {}
44 SymbolAndOffset(const SymbolAndOffset &) = default;
45 MutableSymbolRef symbol;
46 std::size_t offset;
47 const EquivalenceObject *object;
48 };
49
50 void DoCommonBlock(Symbol &);
51 void DoEquivalenceBlockBase(Symbol &, SizeAndAlignment &);
52 void DoEquivalenceSet(const EquivalenceSet &);
53 SymbolAndOffset Resolve(const SymbolAndOffset &);
54 std::size_t ComputeOffset(const EquivalenceObject &);
55 // Returns amount of padding that was needed for alignment
56 std::size_t DoSymbol(
57 Symbol &, std::optional<const size_t> newAlign = std::nullopt);
58 SizeAndAlignment GetSizeAndAlignment(const Symbol &, bool entire);
59 std::size_t Align(std::size_t, std::size_t);
60 std::optional<size_t> CompAlignment(const Symbol &);
61 std::optional<size_t> HasSpecialAlign(const Symbol &, Scope &);
62
63 SemanticsContext &context_;
64 std::size_t offset_{0};
65 std::size_t alignment_{1};
66 // symbol -> symbol+offset that determines its location, from EQUIVALENCE
67 std::map<MutableSymbolRef, SymbolAndOffset, SymbolAddressCompare> dependents_;
68 // base symbol -> SizeAndAlignment for each distinct EQUIVALENCE block
69 std::map<MutableSymbolRef, SizeAndAlignment, SymbolAddressCompare>
70 equivalenceBlock_;
71};
72
73// This function is only called if the target platform is AIX.
74static bool isReal8OrLarger(const Fortran::semantics::DeclTypeSpec *type) {
75 return ((type->IsNumeric(common::TypeCategory::Real) ||
76 type->IsNumeric(common::TypeCategory::Complex)) &&
77 evaluate::ToInt64(type->numericTypeSpec().kind()) > 4);
78}
79
80// This function is only called if the target platform is AIX.
81// It determines the alignment of a component. If the component is a derived
82// type, the alignment is computed accordingly.
83std::optional<size_t> ComputeOffsetsHelper::CompAlignment(const Symbol &sym) {
84 size_t max_align{0};
85 constexpr size_t fourByteAlign{4};
86 bool contain_double{false};
87 auto derivedTypeSpec{sym.GetType()->AsDerived()};
88 DirectComponentIterator directs{*derivedTypeSpec};
89 for (auto it{directs.begin()}; it != directs.end(); ++it) {
90 auto type{it->GetType()};
91 auto s{GetSizeAndAlignment(*it, true)};
92 if (isReal8OrLarger(type)) {
93 max_align = std::max(a: max_align, b: fourByteAlign);
94 contain_double = true;
95 } else if (type->AsDerived()) {
96 if (const auto newAlgin{CompAlignment(*it)}) {
97 max_align = std::max(max_align, s.alignment);
98 } else {
99 return std::nullopt;
100 }
101 } else {
102 max_align = std::max(max_align, s.alignment);
103 }
104 }
105
106 if (contain_double) {
107 return max_align;
108 } else {
109 return std::nullopt;
110 }
111}
112
113// This function is only called if the target platform is AIX.
114// Special alignment is needed only if it is a bind(c) derived type
115// and contain real type components that have larger than 4 bytes.
116std::optional<size_t> ComputeOffsetsHelper::HasSpecialAlign(
117 const Symbol &sym, Scope &scope) {
118 // On AIX, if the component that is not the first component and is
119 // a float of 8 bytes or larger, it has the 4-byte alignment.
120 // Only set the special alignment for bind(c) derived type on that platform.
121 if (const auto type{sym.GetType()}) {
122 auto &symOwner{sym.owner()};
123 if (symOwner.symbol() && symOwner.IsDerivedType() &&
124 symOwner.symbol()->attrs().HasAny({semantics::Attr::BIND_C}) &&
125 &sym != &(*scope.GetSymbols().front())) {
126 if (isReal8OrLarger(type)) {
127 return 4UL;
128 } else if (type->AsDerived()) {
129 return CompAlignment(sym);
130 }
131 }
132 }
133 return std::nullopt;
134}
135
136void ComputeOffsetsHelper::Compute(Scope &scope) {
137 for (Scope &child : scope.children()) {
138 ComputeOffsets(context_, child);
139 }
140 if (scope.symbol() && scope.IsDerivedTypeWithKindParameter()) {
141 return; // only process instantiations of kind parameterized derived types
142 }
143 if (scope.alignment().has_value()) {
144 return; // prevent infinite recursion in error cases
145 }
146 scope.SetAlignment(0);
147 // Build dependents_ from equivalences: symbol -> symbol+offset
148 for (const EquivalenceSet &set : scope.equivalenceSets()) {
149 DoEquivalenceSet(set);
150 }
151 // Compute a base symbol and overall block size for each
152 // disjoint EQUIVALENCE storage sequence.
153 for (auto &[symbol, dep] : dependents_) {
154 dep = Resolve(dep);
155 CHECK(symbol->size() == 0);
156 auto symInfo{GetSizeAndAlignment(*symbol, true)};
157 symbol->set_size(symInfo.size);
158 Symbol &base{*dep.symbol};
159 auto iter{equivalenceBlock_.find(base)};
160 std::size_t minBlockSize{dep.offset + symInfo.size};
161 if (iter == equivalenceBlock_.end()) {
162 equivalenceBlock_.emplace(
163 base, SizeAndAlignment{minBlockSize, symInfo.alignment});
164 } else {
165 SizeAndAlignment &blockInfo{iter->second};
166 blockInfo.size = std::max(blockInfo.size, minBlockSize);
167 blockInfo.alignment = std::max(blockInfo.alignment, symInfo.alignment);
168 }
169 }
170 // Assign offsets for non-COMMON EQUIVALENCE blocks
171 for (auto &[symbol, blockInfo] : equivalenceBlock_) {
172 if (!FindCommonBlockContaining(*symbol)) {
173 DoSymbol(*symbol);
174 DoEquivalenceBlockBase(*symbol, blockInfo);
175 offset_ = std::max(offset_, symbol->offset() + blockInfo.size);
176 }
177 }
178 // Process remaining non-COMMON symbols; this is all of them if there
179 // was no use of EQUIVALENCE in the scope.
180 for (auto &symbol : scope.GetSymbols()) {
181 if (!FindCommonBlockContaining(*symbol) &&
182 dependents_.find(symbol) == dependents_.end() &&
183 equivalenceBlock_.find(symbol) == equivalenceBlock_.end()) {
184
185 std::optional<size_t> newAlign{std::nullopt};
186 // Handle special alignment requirement for AIX
187 auto triple{llvm::Triple(
188 llvm::Triple::normalize(llvm::sys::getDefaultTargetTriple()))};
189 if (triple.getOS() == llvm::Triple::OSType::AIX) {
190 newAlign = HasSpecialAlign(*symbol, scope);
191 }
192 DoSymbol(*symbol, newAlign);
193 if (auto *generic{symbol->detailsIf<GenericDetails>()}) {
194 if (Symbol * specific{generic->specific()};
195 specific && !FindCommonBlockContaining(*specific)) {
196 // might be a shadowed procedure pointer
197 DoSymbol(*specific);
198 }
199 }
200 }
201 }
202 // Ensure that the size is a multiple of the alignment
203 offset_ = Align(offset_, alignment_);
204 scope.set_size(offset_);
205 scope.SetAlignment(alignment_);
206 // Assign offsets in COMMON blocks, unless this scope is a BLOCK construct,
207 // where COMMON blocks are illegal (C1107 and C1108).
208 if (scope.kind() != Scope::Kind::BlockConstruct) {
209 for (auto &pair : scope.commonBlocks()) {
210 DoCommonBlock(*pair.second);
211 }
212 }
213 for (auto &[symbol, dep] : dependents_) {
214 symbol->set_offset(dep.symbol->offset() + dep.offset);
215 if (const auto *block{FindCommonBlockContaining(*dep.symbol)}) {
216 symbol->get<ObjectEntityDetails>().set_commonBlock(*block);
217 }
218 }
219}
220
221auto ComputeOffsetsHelper::Resolve(const SymbolAndOffset &dep)
222 -> SymbolAndOffset {
223 auto it{dependents_.find(*dep.symbol)};
224 if (it == dependents_.end()) {
225 return dep;
226 } else {
227 SymbolAndOffset result{Resolve(dep: it->second)};
228 result.offset += dep.offset;
229 result.object = dep.object;
230 return result;
231 }
232}
233
234void ComputeOffsetsHelper::DoCommonBlock(Symbol &commonBlock) {
235 auto &details{commonBlock.get<CommonBlockDetails>()};
236 offset_ = 0;
237 alignment_ = 0;
238 std::size_t minSize{0};
239 std::size_t minAlignment{0};
240 UnorderedSymbolSet previous;
241 for (auto object : details.objects()) {
242 Symbol &symbol{*object};
243 auto errorSite{
244 commonBlock.name().empty() ? symbol.name() : commonBlock.name()};
245 if (std::size_t padding{DoSymbol(symbol.GetUltimate())}) {
246 context_.Warn(common::UsageWarning::CommonBlockPadding, errorSite,
247 "COMMON block /%s/ requires %zd bytes of padding before '%s' for alignment"_port_en_US,
248 commonBlock.name(), padding, symbol.name());
249 }
250 previous.emplace(symbol);
251 auto eqIter{equivalenceBlock_.end()};
252 auto iter{dependents_.find(symbol)};
253 if (iter == dependents_.end()) {
254 eqIter = equivalenceBlock_.find(symbol);
255 if (eqIter != equivalenceBlock_.end()) {
256 DoEquivalenceBlockBase(symbol, eqIter->second);
257 }
258 } else {
259 SymbolAndOffset &dep{iter->second};
260 Symbol &base{*dep.symbol};
261 if (const auto *baseBlock{FindCommonBlockContaining(base)}) {
262 if (baseBlock == &commonBlock) {
263 if (previous.find(SymbolRef{base}) == previous.end() ||
264 base.offset() != symbol.offset() - dep.offset) {
265 context_.Say(errorSite,
266 "'%s' is storage associated with '%s' by EQUIVALENCE elsewhere in COMMON block /%s/"_err_en_US,
267 symbol.name(), base.name(), commonBlock.name());
268 }
269 } else { // F'2023 8.10.3 p1
270 context_.Say(errorSite,
271 "'%s' in COMMON block /%s/ must not be storage associated with '%s' in COMMON block /%s/ by EQUIVALENCE"_err_en_US,
272 symbol.name(), commonBlock.name(), base.name(),
273 baseBlock->name());
274 }
275 } else if (dep.offset > symbol.offset()) { // 8.10.3(3)
276 context_.Say(errorSite,
277 "'%s' cannot backward-extend COMMON block /%s/ via EQUIVALENCE with '%s'"_err_en_US,
278 symbol.name(), commonBlock.name(), base.name());
279 } else {
280 eqIter = equivalenceBlock_.find(base);
281 base.get<ObjectEntityDetails>().set_commonBlock(commonBlock);
282 base.set_offset(symbol.offset() - dep.offset);
283 previous.emplace(base);
284 }
285 }
286 // Get full extent of any EQUIVALENCE block into size of COMMON ( see
287 // 8.10.2.2 point 1 (2))
288 if (eqIter != equivalenceBlock_.end()) {
289 SizeAndAlignment &blockInfo{eqIter->second};
290 minSize = std::max(
291 minSize, std::max(offset_, eqIter->first->offset() + blockInfo.size));
292 minAlignment = std::max(minAlignment, blockInfo.alignment);
293 }
294 }
295 commonBlock.set_size(std::max(a: minSize, b: offset_));
296 details.set_alignment(std::max(a: minAlignment, b: alignment_));
297 context_.MapCommonBlockAndCheckConflicts(commonBlock);
298}
299
300void ComputeOffsetsHelper::DoEquivalenceBlockBase(
301 Symbol &symbol, SizeAndAlignment &blockInfo) {
302 if (symbol.size() > blockInfo.size) {
303 blockInfo.size = symbol.size();
304 }
305}
306
307void ComputeOffsetsHelper::DoEquivalenceSet(const EquivalenceSet &set) {
308 std::vector<SymbolAndOffset> symbolOffsets;
309 std::optional<std::size_t> representative;
310 for (const EquivalenceObject &object : set) {
311 std::size_t offset{ComputeOffset(object)};
312 SymbolAndOffset resolved{
313 Resolve(SymbolAndOffset{object.symbol, offset, object})};
314 symbolOffsets.push_back(resolved);
315 if (!representative ||
316 resolved.offset >= symbolOffsets[*representative].offset) {
317 // The equivalenced object with the largest offset from its resolved
318 // symbol will be the representative of this set, since the offsets
319 // of the other objects will be positive relative to it.
320 representative = symbolOffsets.size() - 1;
321 }
322 }
323 CHECK(representative);
324 const SymbolAndOffset &base{symbolOffsets[*representative]};
325 for (const auto &[symbol, offset, object] : symbolOffsets) {
326 if (symbol == base.symbol) {
327 if (offset != base.offset) {
328 auto x{evaluate::OffsetToDesignator(
329 context_.foldingContext(), *symbol, base.offset, 1)};
330 auto y{evaluate::OffsetToDesignator(
331 context_.foldingContext(), *symbol, offset, 1)};
332 if (x && y) {
333 context_
334 .Say(base.object->source,
335 "'%s' and '%s' cannot have the same first storage unit"_err_en_US,
336 x->AsFortran(), y->AsFortran())
337 .Attach(object->source, "Incompatible reference to '%s'"_en_US,
338 y->AsFortran());
339 } else { // error recovery
340 context_
341 .Say(base.object->source,
342 "'%s' (offset %zd bytes and %zd bytes) cannot have the same first storage unit"_err_en_US,
343 symbol->name(), base.offset, offset)
344 .Attach(object->source,
345 "Incompatible reference to '%s' offset %zd bytes"_en_US,
346 symbol->name(), offset);
347 }
348 }
349 } else {
350 dependents_.emplace(*symbol,
351 SymbolAndOffset{*base.symbol, base.offset - offset, *object});
352 }
353 }
354}
355
356// Offset of this equivalence object from the start of its variable.
357std::size_t ComputeOffsetsHelper::ComputeOffset(
358 const EquivalenceObject &object) {
359 std::size_t offset{0};
360 if (!object.subscripts.empty()) {
361 if (const auto *details{object.symbol.detailsIf<ObjectEntityDetails>()}) {
362 const ArraySpec &shape{details->shape()};
363 auto lbound{[&](std::size_t i) {
364 return *ToInt64(shape[i].lbound().GetExplicit());
365 }};
366 auto ubound{[&](std::size_t i) {
367 return *ToInt64(shape[i].ubound().GetExplicit());
368 }};
369 for (std::size_t i{object.subscripts.size() - 1};;) {
370 offset += object.subscripts[i] - lbound(i);
371 if (i == 0) {
372 break;
373 }
374 --i;
375 offset *= ubound(i) - lbound(i) + 1;
376 }
377 }
378 }
379 auto result{offset * GetSizeAndAlignment(object.symbol, false).size};
380 if (object.substringStart) {
381 int kind{context_.defaultKinds().GetDefaultKind(TypeCategory::Character)};
382 if (const DeclTypeSpec * type{object.symbol.GetType()}) {
383 if (const IntrinsicTypeSpec * intrinsic{type->AsIntrinsic()}) {
384 kind = ToInt64(intrinsic->kind()).value_or(kind);
385 }
386 }
387 result += kind * (*object.substringStart - 1);
388 }
389 return result;
390}
391
392std::size_t ComputeOffsetsHelper::DoSymbol(
393 Symbol &symbol, std::optional<const size_t> newAlign) {
394 if (!symbol.has<ObjectEntityDetails>() && !symbol.has<ProcEntityDetails>()) {
395 return 0;
396 }
397 SizeAndAlignment s{GetSizeAndAlignment(symbol, true)};
398 if (s.size == 0) {
399 return 0;
400 }
401 std::size_t previousOffset{offset_};
402 size_t alignVal{newAlign.value_or(u&: s.alignment)};
403 offset_ = Align(offset_, alignVal);
404 std::size_t padding{offset_ - previousOffset};
405 symbol.set_size(s.size);
406 symbol.set_offset(offset_);
407 offset_ += s.size;
408 alignment_ = std::max(a: alignment_, b: alignVal);
409 return padding;
410}
411
412auto ComputeOffsetsHelper::GetSizeAndAlignment(
413 const Symbol &symbol, bool entire) -> SizeAndAlignment {
414 auto &targetCharacteristics{context_.targetCharacteristics()};
415 if (IsDescriptor(symbol)) {
416 auto dyType{evaluate::DynamicType::From(symbol)};
417 const auto *derived{evaluate::GetDerivedTypeSpec(dyType)};
418 int lenParams{derived ? CountLenParameters(*derived) : 0};
419 bool needAddendum{derived || (dyType && dyType->IsUnlimitedPolymorphic())};
420
421 // FIXME: Get descriptor size from targetCharacteristics instead
422 // overapproximation
423 std::size_t size{runtime::MaxDescriptorSizeInBytes(
424 symbol.Rank(), needAddendum, lenParams)};
425
426 return {size, targetCharacteristics.descriptorAlignment()};
427 }
428 if (IsProcedurePointer(symbol)) {
429 return {targetCharacteristics.procedurePointerByteSize(),
430 targetCharacteristics.procedurePointerAlignment()};
431 }
432 if (IsProcedure(symbol)) {
433 return {};
434 }
435 auto &foldingContext{context_.foldingContext()};
436 if (auto chars{evaluate::characteristics::TypeAndShape::Characterize(
437 symbol, foldingContext)}) {
438 if (entire) {
439 if (auto size{ToInt64(chars->MeasureSizeInBytes(foldingContext))}) {
440 return {static_cast<std::size_t>(*size),
441 chars->type().GetAlignment(targetCharacteristics)};
442 }
443 } else { // element size only
444 if (auto size{ToInt64(chars->MeasureElementSizeInBytes(
445 foldingContext, true /*aligned*/))}) {
446 return {static_cast<std::size_t>(*size),
447 chars->type().GetAlignment(targetCharacteristics)};
448 }
449 }
450 }
451 return {};
452}
453
454// Align a size to its natural alignment, up to maxAlignment.
455std::size_t ComputeOffsetsHelper::Align(std::size_t x, std::size_t alignment) {
456 alignment =
457 std::min(alignment, context_.targetCharacteristics().maxAlignment());
458 return (x + alignment - 1) & -alignment;
459}
460
461void ComputeOffsets(SemanticsContext &context, Scope &scope) {
462 ComputeOffsetsHelper{context}.Compute(scope);
463}
464
465} // namespace Fortran::semantics
466

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