llvm-project

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
186