1/* Helper function for repacking arrays.
2   Copyright (C) 2003-2022 Free Software Foundation, Inc.
3   Contributed by Paul Brook <paul@nowt.org>
4
5This file is part of the GNU Fortran runtime library (libgfortran).
6
7Libgfortran is free software; you can redistribute it and/or
8modify it under the terms of the GNU General Public
9License as published by the Free Software Foundation; either
10version 3 of the License, or (at your option) any later version.
11
12Libgfortran is distributed in the hope that it will be useful,
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15GNU General Public License for more details.
16
17Under Section 7 of GPL version 3, you are granted additional
18permissions described in the GCC Runtime Library Exception, version
193.1, as published by the Free Software Foundation.
20
21You should have received a copy of the GNU General Public License and
22a copy of the GCC Runtime Library Exception along with this program;
23see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
24<http://www.gnu.org/licenses/>.  */
25
26#include "libgfortran.h"
27
28
29#if defined (HAVE_GFC_REAL_16)
30
31/* Allocates a block of memory with internal_malloc if the array needs
32   repacking.  */
33
34GFC_REAL_16 *
35internal_pack_r16 (gfc_array_r16 * source)
36{
37  index_type count[GFC_MAX_DIMENSIONS];
38  index_type extent[GFC_MAX_DIMENSIONS];
39  index_type stride[GFC_MAX_DIMENSIONS];
40  index_type stride0;
41  index_type dim;
42  index_type ssize;
43  const GFC_REAL_16 *src;
44  GFC_REAL_16 * restrict dest;
45  GFC_REAL_16 *destptr;
46  int packed;
47
48  /* TODO: Investigate how we can figure out if this is a temporary
49     since the stride=0 thing has been removed from the frontend.  */
50
51  dim = GFC_DESCRIPTOR_RANK (source);
52  ssize = 1;
53  packed = 1;
54  for (index_type n = 0; n < dim; n++)
55    {
56      count[n] = 0;
57      stride[n] = GFC_DESCRIPTOR_STRIDE(source,n);
58      extent[n] = GFC_DESCRIPTOR_EXTENT(source,n);
59      if (extent[n] <= 0)
60        {
61          /* Do nothing.  */
62          packed = 1;
63          break;
64        }
65
66      if (ssize != stride[n])
67        packed = 0;
68
69      ssize *= extent[n];
70    }
71
72  if (packed)
73    return source->base_addr;
74
75  /* Allocate storage for the destination.  */
76  destptr = xmallocarray (ssize, sizeof (GFC_REAL_16));
77  dest = destptr;
78  src = source->base_addr;
79  stride0 = stride[0];
80
81
82  while (src)
83    {
84      /* Copy the data.  */
85      *(dest++) = *src;
86      /* Advance to the next element.  */
87      src += stride0;
88      count[0]++;
89      /* Advance to the next source element.  */
90      index_type n = 0;
91      while (count[n] == extent[n])
92        {
93          /* When we get to the end of a dimension, reset it and increment
94             the next dimension.  */
95          count[n] = 0;
96          /* We could precalculate these products, but this is a less
97             frequently used path so probably not worth it.  */
98          src -= stride[n] * extent[n];
99          n++;
100          if (n == dim)
101            {
102              src = NULL;
103              break;
104            }
105          else
106            {
107              count[n]++;
108              src += stride[n];
109            }
110        }
111    }
112  return destptr;
113}
114
115#endif
116
117