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
18namespace 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.
27static 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
40static 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
91extern "C" {
92RT_EXT_API_GROUP_BEGIN
93
94void 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
108void 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
172void 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
183RT_EXT_API_GROUP_END
184} // extern "C"
185} // namespace Fortran::runtime
186

source code of flang/runtime/array-constructor.cpp