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