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