183 lines · cpp
1//===-- lib/runtime/array-constructor.cpp -----------------------*- C++ -*-===//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-exception6//7//===----------------------------------------------------------------------===//8 9#include "flang-rt/runtime/array-constructor.h"10#include "flang-rt/runtime/derived.h"11#include "flang-rt/runtime/descriptor.h"12#include "flang-rt/runtime/terminator.h"13#include "flang-rt/runtime/tools.h"14#include "flang-rt/runtime/type-info.h"15#include "flang/Runtime/allocatable.h"16#include "flang/Runtime/assign.h"17 18namespace Fortran::runtime {19 20// Initial allocation size for an array constructor temporary whose extent21// cannot be pre-computed. This could be fined tuned if needed based on actual22// 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 to30 // avoid doing too many reallocation.31 static constexpr SubscriptValue minNumberOfBytes{128};32 static constexpr SubscriptValue minNumberOfElements{4};33 SubscriptValue numberOfElements{initialNumberOfElements > minNumberOfElements34 ? initialNumberOfElements35 : 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 constructor46 // extent could be pre-computed, but information about length parameters47 // 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, /*asyncObject=*/nullptr, /*hasStat=*/false, /*errMsg=*/nullptr,54 vector.sourceFile, 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 the59 // first value: there should be no reallocation.60 RUNTIME_CHECK(terminator, previousToElements >= fromElements);61 RTNAME(AllocatableAllocate)62 (to, /*asyncObject=*/nullptr, /*hasStat=*/false, /*errMsg=*/nullptr,63 vector.sourceFile, 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 avoid70 // 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 null75 // 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 because85 // 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_BEGIN93 94void 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 105void 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 since116 // it cannot be taken from "from" here: "from" may be polymorphic (have a117 // dynamic type that differs from its declared type) and Fortran 2018 7.8118 // point 4. says that the dynamic type of an array constructor is its119 // declared type: it does not inherit the dynamic type of its ac-value120 // 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 length146 // 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 elements160 // and "toCurrentElement" is not an allocatable so AssignTemporary161 // below works even if "from" rank is bigger than one (and differs162 // from "toCurrentElement") and not time is wasted reshaping163 // "toCurrentElement" to "from" shape.164 RTNAME(AssignTemporary)165 (toCurrentElement, from, vector.sourceFile, vector.sourceLine);166 vector.nextValuePosition += fromElements;167}168 169void 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 runtime::memcpy(to.Element<char>(subscript), from, to.ElementBytes());177 ++vector.nextValuePosition;178}179 180RT_EXT_API_GROUP_END181} // extern "C"182} // namespace Fortran::runtime183