468 lines · cpp
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-exception6//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 alignment56 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 EQUIVALENCE67 std::map<MutableSymbolRef, SymbolAndOffset, SymbolAddressCompare> dependents_;68 // base symbol -> SizeAndAlignment for each distinct EQUIVALENCE block69 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 derived82// 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(max_align, 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 type115// 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 is119 // 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 types142 }143 if (scope.alignment().has_value()) {144 return; // prevent infinite recursion in error cases145 }146 scope.SetAlignment(0);147 // Build dependents_ from equivalences: symbol -> symbol+offset148 for (const EquivalenceSet &set : scope.equivalenceSets()) {149 DoEquivalenceSet(set);150 }151 // Compute a base symbol and overall block size for each152 // 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 blocks171 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 there179 // 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 AIX187 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 pointer197 DoSymbol(*specific);198 }199 }200 }201 }202 // Ensure that the size is a multiple of the alignment203 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(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 // Allow for host association when the common block is243 // OpenMP firstprivate.244 Symbol &symbol{object->GetUltimate()};245 auto errorSite{246 commonBlock.name().empty() ? symbol.name() : commonBlock.name()};247 if (std::size_t padding{DoSymbol(symbol.GetUltimate())}) {248 context_.Warn(common::UsageWarning::CommonBlockPadding, errorSite,249 "COMMON block /%s/ requires %zd bytes of padding before '%s' for alignment"_port_en_US,250 commonBlock.name(), padding, symbol.name());251 }252 previous.emplace(symbol);253 auto eqIter{equivalenceBlock_.end()};254 auto iter{dependents_.find(symbol)};255 if (iter == dependents_.end()) {256 eqIter = equivalenceBlock_.find(symbol);257 if (eqIter != equivalenceBlock_.end()) {258 DoEquivalenceBlockBase(symbol, eqIter->second);259 }260 } else {261 SymbolAndOffset &dep{iter->second};262 Symbol &base{*dep.symbol};263 if (const auto *baseBlock{FindCommonBlockContaining(base)}) {264 if (baseBlock == &commonBlock) {265 if (previous.find(SymbolRef{base}) == previous.end() ||266 base.offset() != symbol.offset() - dep.offset) {267 context_.Say(errorSite,268 "'%s' is storage associated with '%s' by EQUIVALENCE elsewhere in COMMON block /%s/"_err_en_US,269 symbol.name(), base.name(), commonBlock.name());270 }271 } else { // F'2023 8.10.3 p1272 context_.Say(errorSite,273 "'%s' in COMMON block /%s/ must not be storage associated with '%s' in COMMON block /%s/ by EQUIVALENCE"_err_en_US,274 symbol.name(), commonBlock.name(), base.name(),275 baseBlock->name());276 }277 } else if (dep.offset > symbol.offset()) { // 8.10.3(3)278 context_.Say(errorSite,279 "'%s' cannot backward-extend COMMON block /%s/ via EQUIVALENCE with '%s'"_err_en_US,280 symbol.name(), commonBlock.name(), base.name());281 } else {282 eqIter = equivalenceBlock_.find(base);283 base.get<ObjectEntityDetails>().set_commonBlock(commonBlock);284 base.set_offset(symbol.offset() - dep.offset);285 previous.emplace(base);286 }287 }288 // Get full extent of any EQUIVALENCE block into size of COMMON ( see289 // 8.10.2.2 point 1 (2))290 if (eqIter != equivalenceBlock_.end()) {291 SizeAndAlignment &blockInfo{eqIter->second};292 minSize = std::max(293 minSize, std::max(offset_, eqIter->first->offset() + blockInfo.size));294 minAlignment = std::max(minAlignment, blockInfo.alignment);295 }296 }297 commonBlock.set_size(std::max(minSize, offset_));298 details.set_alignment(std::max(minAlignment, alignment_));299 context_.MapCommonBlockAndCheckConflicts(commonBlock);300}301 302void ComputeOffsetsHelper::DoEquivalenceBlockBase(303 Symbol &symbol, SizeAndAlignment &blockInfo) {304 if (symbol.size() > blockInfo.size) {305 blockInfo.size = symbol.size();306 }307}308 309void ComputeOffsetsHelper::DoEquivalenceSet(const EquivalenceSet &set) {310 std::vector<SymbolAndOffset> symbolOffsets;311 std::optional<std::size_t> representative;312 for (const EquivalenceObject &object : set) {313 std::size_t offset{ComputeOffset(object)};314 SymbolAndOffset resolved{315 Resolve(SymbolAndOffset{object.symbol, offset, object})};316 symbolOffsets.push_back(resolved);317 if (!representative ||318 resolved.offset >= symbolOffsets[*representative].offset) {319 // The equivalenced object with the largest offset from its resolved320 // symbol will be the representative of this set, since the offsets321 // of the other objects will be positive relative to it.322 representative = symbolOffsets.size() - 1;323 }324 }325 CHECK(representative);326 const SymbolAndOffset &base{symbolOffsets[*representative]};327 for (const auto &[symbol, offset, object] : symbolOffsets) {328 if (symbol == base.symbol) {329 if (offset != base.offset) {330 auto x{evaluate::OffsetToDesignator(331 context_.foldingContext(), *symbol, base.offset, 1)};332 auto y{evaluate::OffsetToDesignator(333 context_.foldingContext(), *symbol, offset, 1)};334 if (x && y) {335 context_336 .Say(base.object->source,337 "'%s' and '%s' cannot have the same first storage unit"_err_en_US,338 x->AsFortran(), y->AsFortran())339 .Attach(object->source, "Incompatible reference to '%s'"_en_US,340 y->AsFortran());341 } else { // error recovery342 context_343 .Say(base.object->source,344 "'%s' (offset %zd bytes and %zd bytes) cannot have the same first storage unit"_err_en_US,345 symbol->name(), base.offset, offset)346 .Attach(object->source,347 "Incompatible reference to '%s' offset %zd bytes"_en_US,348 symbol->name(), offset);349 }350 }351 } else {352 dependents_.emplace(*symbol,353 SymbolAndOffset{*base.symbol, base.offset - offset, *object});354 }355 }356}357 358// Offset of this equivalence object from the start of its variable.359std::size_t ComputeOffsetsHelper::ComputeOffset(360 const EquivalenceObject &object) {361 std::size_t offset{0};362 if (!object.subscripts.empty()) {363 if (const auto *details{object.symbol.detailsIf<ObjectEntityDetails>()}) {364 const ArraySpec &shape{details->shape()};365 auto lbound{[&](std::size_t i) {366 return *ToInt64(shape[i].lbound().GetExplicit());367 }};368 auto ubound{[&](std::size_t i) {369 return *ToInt64(shape[i].ubound().GetExplicit());370 }};371 for (std::size_t i{object.subscripts.size() - 1};;) {372 offset += object.subscripts[i] - lbound(i);373 if (i == 0) {374 break;375 }376 --i;377 offset *= ubound(i) - lbound(i) + 1;378 }379 }380 }381 auto result{offset * GetSizeAndAlignment(object.symbol, false).size};382 if (object.substringStart) {383 int kind{context_.defaultKinds().GetDefaultKind(TypeCategory::Character)};384 if (const DeclTypeSpec * type{object.symbol.GetType()}) {385 if (const IntrinsicTypeSpec * intrinsic{type->AsIntrinsic()}) {386 kind = ToInt64(intrinsic->kind()).value_or(kind);387 }388 }389 result += kind * (*object.substringStart - 1);390 }391 return result;392}393 394std::size_t ComputeOffsetsHelper::DoSymbol(395 Symbol &symbol, std::optional<const size_t> newAlign) {396 if (!symbol.has<ObjectEntityDetails>() && !symbol.has<ProcEntityDetails>()) {397 return 0;398 }399 SizeAndAlignment s{GetSizeAndAlignment(symbol, true)};400 if (s.size == 0) {401 return 0;402 }403 std::size_t previousOffset{offset_};404 size_t alignVal{newAlign.value_or(s.alignment)};405 offset_ = Align(offset_, alignVal);406 std::size_t padding{offset_ - previousOffset};407 symbol.set_size(s.size);408 symbol.set_offset(offset_);409 offset_ += s.size;410 alignment_ = std::max(alignment_, alignVal);411 return padding;412}413 414auto ComputeOffsetsHelper::GetSizeAndAlignment(415 const Symbol &symbol, bool entire) -> SizeAndAlignment {416 auto &targetCharacteristics{context_.targetCharacteristics()};417 if (IsDescriptor(symbol)) {418 auto dyType{evaluate::DynamicType::From(symbol)};419 const auto *derived{evaluate::GetDerivedTypeSpec(dyType)};420 int lenParams{derived ? CountLenParameters(*derived) : 0};421 bool needAddendum{derived || (dyType && dyType->IsUnlimitedPolymorphic())};422 423 // FIXME: Get descriptor size from targetCharacteristics instead424 // overapproximation425 std::size_t size{runtime::MaxDescriptorSizeInBytes(426 symbol.Rank(), needAddendum, lenParams)};427 428 return {size, targetCharacteristics.descriptorAlignment()};429 }430 if (IsProcedurePointer(symbol)) {431 return {targetCharacteristics.procedurePointerByteSize(),432 targetCharacteristics.procedurePointerAlignment()};433 }434 if (IsProcedure(symbol)) {435 return {};436 }437 auto &foldingContext{context_.foldingContext()};438 if (auto chars{evaluate::characteristics::TypeAndShape::Characterize(439 symbol, foldingContext)}) {440 if (entire) {441 if (auto size{ToInt64(chars->MeasureSizeInBytes(foldingContext))}) {442 return {static_cast<std::size_t>(*size),443 chars->type().GetAlignment(targetCharacteristics)};444 }445 } else { // element size only446 if (auto size{ToInt64(chars->MeasureElementSizeInBytes(447 foldingContext, true /*aligned*/))}) {448 return {static_cast<std::size_t>(*size),449 chars->type().GetAlignment(targetCharacteristics)};450 }451 }452 }453 return {};454}455 456// Align a size to its natural alignment, up to maxAlignment.457std::size_t ComputeOffsetsHelper::Align(std::size_t x, std::size_t alignment) {458 alignment =459 std::min(alignment, context_.targetCharacteristics().maxAlignment());460 return (x + alignment - 1) & -alignment;461}462 463void ComputeOffsets(SemanticsContext &context, Scope &scope) {464 ComputeOffsetsHelper{context}.Compute(scope);465}466 467} // namespace Fortran::semantics468