1 //===-- runtime/transformational.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 "transformational.h"
10 #include "terminator.h"
11 #include "tools.h"
12 #include <algorithm>
13 #include <cinttypes>
14 
15 namespace Fortran::runtime {
16 
17 // F2018 16.9.163
18 OwningPtr<Descriptor> RTNAME(Reshape)(const Descriptor &source,
19     const Descriptor &shape, const Descriptor *pad, const Descriptor *order) {
20   // Compute and check the rank of the result.
21   Terminator terminator{__FILE__, __LINE__};
22   RUNTIME_CHECK(terminator, shape.rank() == 1);
23   RUNTIME_CHECK(terminator, shape.type().IsInteger());
24   SubscriptValue resultRank{shape.GetDimension(0).Extent()};
25   RUNTIME_CHECK(terminator,
26       resultRank >= 0 && resultRank <= static_cast<SubscriptValue>(maxRank));
27 
28   // Extract and check the shape of the result; compute its element count.
29   SubscriptValue lowerBound[maxRank]; // all 1's
30   SubscriptValue resultExtent[maxRank];
31   std::size_t shapeElementBytes{shape.ElementBytes()};
32   std::size_t resultElements{1};
33   SubscriptValue shapeSubscript{shape.GetDimension(0).LowerBound()};
34   for (SubscriptValue j{0}; j < resultRank; ++j, ++shapeSubscript) {
35     lowerBound[j] = 1;
36     resultExtent[j] =
37         GetInt64(shape.Element<char>(&shapeSubscript), shapeElementBytes);
38     RUNTIME_CHECK(terminator, resultExtent[j] >= 0);
39     resultElements *= resultExtent[j];
40   }
41 
42   // Check that there are sufficient elements in the SOURCE=, or that
43   // the optional PAD= argument is present and nonempty.
44   std::size_t elementBytes{source.ElementBytes()};
45   std::size_t sourceElements{source.Elements()};
46   std::size_t padElements{pad ? pad->Elements() : 0};
47   if (resultElements < sourceElements) {
48     RUNTIME_CHECK(terminator, padElements > 0);
49     RUNTIME_CHECK(terminator, pad->ElementBytes() == elementBytes);
50   }
51 
52   // Extract and check the optional ORDER= argument, which must be a
53   // permutation of [1..resultRank].
54   int dimOrder[maxRank];
55   if (order) {
56     RUNTIME_CHECK(terminator, order->rank() == 1);
57     RUNTIME_CHECK(terminator, order->type().IsInteger());
58     RUNTIME_CHECK(terminator, order->GetDimension(0).Extent() == resultRank);
59     std::uint64_t values{0};
60     SubscriptValue orderSubscript{order->GetDimension(0).LowerBound()};
61     for (SubscriptValue j{0}; j < resultRank; ++j, ++orderSubscript) {
62       auto k{GetInt64(
63           order->OffsetElement<char>(orderSubscript), shapeElementBytes)};
64       RUNTIME_CHECK(
65           terminator, k >= 1 && k <= resultRank && !((values >> k) & 1));
66       values |= std::uint64_t{1} << k;
67       dimOrder[k - 1] = j;
68     }
69   } else {
70     for (int j{0}; j < resultRank; ++j) {
71       dimOrder[j] = j;
72     }
73   }
74 
75   // Create and populate the result's descriptor.
76   const DescriptorAddendum *sourceAddendum{source.Addendum()};
77   const typeInfo::DerivedType *sourceDerivedType{
78       sourceAddendum ? sourceAddendum->derivedType() : nullptr};
79   OwningPtr<Descriptor> result;
80   if (sourceDerivedType) {
81     result = Descriptor::Create(*sourceDerivedType, nullptr, resultRank,
82         resultExtent, CFI_attribute_allocatable);
83   } else {
84     result = Descriptor::Create(source.type(), elementBytes, nullptr,
85         resultRank, resultExtent,
86         CFI_attribute_allocatable); // TODO rearrange these arguments
87   }
88   DescriptorAddendum *resultAddendum{result->Addendum()};
89   RUNTIME_CHECK(terminator, resultAddendum);
90   resultAddendum->flags() |= DescriptorAddendum::DoNotFinalize;
91   if (sourceDerivedType) {
92     std::size_t lenParameters{sourceAddendum->LenParameters()};
93     for (std::size_t j{0}; j < lenParameters; ++j) {
94       resultAddendum->SetLenParameterValue(
95           j, sourceAddendum->LenParameterValue(j));
96     }
97   }
98   // Allocate storage for the result's data.
99   int status{result->Allocate(lowerBound, resultExtent)};
100   if (status != CFI_SUCCESS) {
101     terminator.Crash("RESHAPE: Allocate failed (error %d)", status);
102   }
103 
104   // Populate the result's elements.
105   SubscriptValue resultSubscript[maxRank];
106   result->GetLowerBounds(resultSubscript);
107   SubscriptValue sourceSubscript[maxRank];
108   source.GetLowerBounds(sourceSubscript);
109   std::size_t resultElement{0};
110   std::size_t elementsFromSource{std::min(resultElements, sourceElements)};
111   for (; resultElement < elementsFromSource; ++resultElement) {
112     std::memcpy(result->Element<void>(resultSubscript),
113         source.Element<const void>(sourceSubscript), elementBytes);
114     source.IncrementSubscripts(sourceSubscript);
115     result->IncrementSubscripts(resultSubscript, dimOrder);
116   }
117   if (resultElement < resultElements) {
118     // Remaining elements come from the optional PAD= argument.
119     SubscriptValue padSubscript[maxRank];
120     pad->GetLowerBounds(padSubscript);
121     for (; resultElement < resultElements; ++resultElement) {
122       std::memcpy(result->Element<void>(resultSubscript),
123           pad->Element<const void>(padSubscript), elementBytes);
124       pad->IncrementSubscripts(padSubscript);
125       result->IncrementSubscripts(resultSubscript, dimOrder);
126     }
127   }
128 
129   return result;
130 }
131 } // namespace Fortran::runtime
132