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 25 namespace Fortran::semantics { 26 27 class ComputeOffsetsHelper { 28 public: 29 ComputeOffsetsHelper(SemanticsContext &context) : context_{context} {} 30 void Compute(Scope &); 31 32 private: 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. 74 static 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. 83 std::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 type 115 // and contain real type components that have larger than 4 bytes. 116 std::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 136 void 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 221 auto 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 234 void 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(minSize, offset_)); 296 details.set_alignment(std::max(minAlignment, alignment_)); 297 context_.MapCommonBlockAndCheckConflicts(commonBlock); 298 } 299 300 void ComputeOffsetsHelper::DoEquivalenceBlockBase( 301 Symbol &symbol, SizeAndAlignment &blockInfo) { 302 if (symbol.size() > blockInfo.size) { 303 blockInfo.size = symbol.size(); 304 } 305 } 306 307 void 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. 357 std::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 392 std::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(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(alignment_, alignVal); 409 return padding; 410 } 411 412 auto 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. 455 std::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 461 void ComputeOffsets(SemanticsContext &context, Scope &scope) { 462 ComputeOffsetsHelper{context}.Compute(scope); 463 } 464 465 } // namespace Fortran::semantics 466