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, const char *sourceFile, 96 int sourceLine) { 97 Terminator terminator{vector.sourceFile, vector.sourceLine}; 98 RUNTIME_CHECK(terminator, to.rank() == 1); 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 RTDEF(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 RTDEF(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 180 RT_EXT_API_GROUP_END 181 } // extern "C" 182 } // namespace Fortran::runtime 183