flang/runtime/array-constructor.cpp

   1 //===-- runtime/array-constructor.cpp -------------------------------------===//
   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 "flang/Runtime/array-constructor.h"
  10 #include "derived.h"
  11 #include "terminator.h"
  12 #include "tools.h"
  13 #include "type-info.h"
  14 #include "flang/Runtime/allocatable.h"
  15 #include "flang/Runtime/assign.h"
  16 #include "flang/Runtime/descriptor.h"
  17
  18 namespace Fortran::runtime {
  19
  20 // Initial allocation size for an array constructor temporary whose extent
  21 // cannot be pre-computed. This could be fined tuned if needed based on actual
  22 // program performance.
  23 //  REAL(4), INTEGER(4), COMPLEX(2), ...   -> 32 elements.
  24 //  REAL(8), INTEGER(8), COMPLEX(4), ...   -> 16 elements.
  25 //  REAL(16), INTEGER(16), COMPLEX(8), ... -> 8 elements.
  26 //  Bigger types -> 4 elements.
  27 static RT_API_ATTRS SubscriptValue initialAllocationSize(
  28     SubscriptValue initialNumberOfElements, SubscriptValue elementBytes) {
  29   // Try to guess an optimal initial allocation size in number of elements to
  30   // avoid doing too many reallocation.
  31   static constexpr SubscriptValue minNumberOfBytes{128};
  32   static constexpr SubscriptValue minNumberOfElements{4};
  33   SubscriptValue numberOfElements{initialNumberOfElements > minNumberOfElements
  34           ? initialNumberOfElements
  35           : minNumberOfElements};
  36   SubscriptValue elementsForMinBytes{minNumberOfBytes / elementBytes};
  37   return std::max(numberOfElements, elementsForMinBytes);
  38 }
  39
  40 static RT_API_ATTRS void AllocateOrReallocateVectorIfNeeded(
  41     ArrayConstructorVector &vector, Terminator &terminator,
  42     SubscriptValue previousToElements, SubscriptValue fromElements) {
  43   Descriptor &to{vector.to};
  44   if (to.IsAllocatable() && !to.IsAllocated()) {
  45     // The descriptor bounds may already be set here if the array constructor
  46     // extent could be pre-computed, but information about length parameters
  47     // was missing and required evaluating the first array constructor value.
  48     if (previousToElements == 0) {
  49       SubscriptValue allocationSize{
  50           initialAllocationSize(fromElements, to.ElementBytes())};
  51       to.GetDimension(0).SetBounds(1, allocationSize);
  52       RTNAME(AllocatableAllocate)
  53       (to, /*hasStat=*/false, /*errMsg=*/nullptr, vector.sourceFile,
  54           vector.sourceLine);
  55       to.GetDimension(0).SetBounds(1, fromElements);
  56       vector.actualAllocationSize = allocationSize;
  57     } else {
  58       // Do not over-allocate if the final extent was known before pushing the
  59       // first value: there should be no reallocation.
  60       RUNTIME_CHECK(terminator, previousToElements >= fromElements);
  61       RTNAME(AllocatableAllocate)
  62       (to, /*hasStat=*/false, /*errMsg=*/nullptr, vector.sourceFile,
  63           vector.sourceLine);
  64       vector.actualAllocationSize = previousToElements;
  65     }
  66   } else {
  67     SubscriptValue newToElements{vector.nextValuePosition + fromElements};
  68     if (to.IsAllocatable() && vector.actualAllocationSize < newToElements) {
  69       // Reallocate. Ensure the current storage is at least doubled to avoid
  70       // doing too many reallocations.
  71       SubscriptValue requestedAllocationSize{
  72           std::max(newToElements, vector.actualAllocationSize * 2)};
  73       std::size_t newByteSize{requestedAllocationSize * to.ElementBytes()};
  74       // realloc is undefined with zero new size and ElementBytes() may be null
  75       // if the character length is null, or if "from" is a zero sized array.
  76       if (newByteSize > 0) {
  77         void *p{ReallocateMemoryOrCrash(
  78             terminator, to.raw().base_addr, newByteSize)};
  79         to.set_base_addr(p);
  80       }
  81       vector.actualAllocationSize = requestedAllocationSize;
  82       to.GetDimension(0).SetBounds(1, newToElements);
  83     } else if (previousToElements < newToElements) {
  84       // Storage is big enough, but descriptor extent must be increased because
  85       // the final extent was not known before pushing array constructor values.
  86       to.GetDimension(0).SetBounds(1, newToElements);
  87     }
  88   }
  89 }
  90
  91 extern "C" {
  92 RT_EXT_API_GROUP_BEGIN
  93
  94 void RTDEF(InitArrayConstructorVector)(ArrayConstructorVector &vector,
  95     Descriptor &to, bool useValueLengthParameters, int vectorClassSize,
  96     const char *sourceFile, int sourceLine) {
  97   Terminator terminator{vector.sourceFile, vector.sourceLine};
  98   RUNTIME_CHECK(terminator,
  99       to.rank() == 1 &&
 100           sizeof(ArrayConstructorVector) <=
 101               static_cast<std::size_t>(vectorClassSize));
 102   SubscriptValue actualAllocationSize{
 103       to.IsAllocated() ? static_cast<SubscriptValue>(to.Elements()) : 0};
 104   (void)new (&vector) ArrayConstructorVector{to, /*nextValuePosition=*/0,
 105       actualAllocationSize, sourceFile, sourceLine, useValueLengthParameters};
 106 }
 107
 108 void RTDEF(PushArrayConstructorValue)(
 109     ArrayConstructorVector &vector, const Descriptor &from) {
 110   Terminator terminator{vector.sourceFile, vector.sourceLine};
 111   Descriptor &to{vector.to};
 112   SubscriptValue fromElements{static_cast<SubscriptValue>(from.Elements())};
 113   SubscriptValue previousToElements{static_cast<SubscriptValue>(to.Elements())};
 114   if (vector.useValueLengthParameters()) {
 115     // Array constructor with no type spec.
 116     if (to.IsAllocatable() && !to.IsAllocated()) {
 117       // Takes length parameters, if any, from the first value.
 118       // Note that "to" type must already be set by the caller of this API since
 119       // it cannot be taken from "from" here: "from" may be polymorphic (have a
 120       // dynamic type that differs from its declared type) and Fortran 2018 7.8
 121       // point 4. says that the dynamic type of an array constructor is its
 122       // declared type: it does not inherit the dynamic type of its ac-value
 123       // even if if there is no type-spec.
 124       if (to.type().IsCharacter()) {
 125         to.raw().elem_len = from.ElementBytes();
 126       } else if (auto *toAddendum{to.Addendum()}) {
 127         if (const auto *fromAddendum{from.Addendum()}) {
 128           if (const auto *toDerived{toAddendum->derivedType()}) {
 129             std::size_t lenParms{toDerived->LenParameters()};
 130             for (std::size_t j{0}; j < lenParms; ++j) {
 131               toAddendum->SetLenParameterValue(
 132                   j, fromAddendum->LenParameterValue(j));
 133             }
 134           }
 135         }
 136       }
 137     } else if (to.type().IsCharacter()) {
 138       // Fortran 2018 7.8 point 2.
 139       if (to.ElementBytes() != from.ElementBytes()) {
 140         terminator.Crash("Array constructor: mismatched character lengths (%d "
 141                          "!= %d) between "
 142                          "values of an array constructor without type-spec",
 143             to.ElementBytes() / to.type().GetCategoryAndKind()->second,
 144             from.ElementBytes() / from.type().GetCategoryAndKind()->second);
 145       }
 146     }
 147   }
 148   // Otherwise, the array constructor had a type-spec and the length
 149   // parameters are already in the "to" descriptor.
 150
 151   AllocateOrReallocateVectorIfNeeded(
 152       vector, terminator, previousToElements, fromElements);
 153
 154   // Create descriptor for "to" element or section being copied to.
 155   SubscriptValue lower[1]{
 156       to.GetDimension(0).LowerBound() + vector.nextValuePosition};
 157   SubscriptValue upper[1]{lower[0] + fromElements - 1};
 158   SubscriptValue stride[1]{from.rank() == 0 ? 0 : 1};
 159   StaticDescriptor<maxRank, true, 1> staticDesc;
 160   Descriptor &toCurrentElement{staticDesc.descriptor()};
 161   toCurrentElement.EstablishPointerSection(to, lower, upper, stride);
 162   // Note: toCurrentElement and from have the same number of elements
 163   // and "toCurrentElement" is not an allocatable so AssignTemporary
 164   // below works even if "from" rank is bigger than one (and differs
 165   // from "toCurrentElement") and not time is wasted reshaping
 166   // "toCurrentElement" to "from" shape.
 167   RTNAME(AssignTemporary)
 168   (toCurrentElement, from, vector.sourceFile, vector.sourceLine);
 169   vector.nextValuePosition += fromElements;
 170 }
 171
 172 void RTDEF(PushArrayConstructorSimpleScalar)(
 173     ArrayConstructorVector &vector, void *from) {
 174   Terminator terminator{vector.sourceFile, vector.sourceLine};
 175   Descriptor &to{vector.to};
 176   AllocateOrReallocateVectorIfNeeded(vector, terminator, to.Elements(), 1);
 177   SubscriptValue subscript[1]{
 178       to.GetDimension(0).LowerBound() + vector.nextValuePosition};
 179   std::memcpy(to.Element<char>(subscript), from, to.ElementBytes());
 180   ++vector.nextValuePosition;
 181 }
 182
 183 RT_EXT_API_GROUP_END
 184 } // extern "C"
 185 } // namespace Fortran::runtime