1`/* Helper function for repacking arrays.
2   Copyright (C) 2003-2019 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#include <string.h>'
28
29include(iparm.m4)dnl
30
31`#if defined (HAVE_'rtype_name`)'
32
33dnl Only the kind (ie size) is used to name the function for integers,
34dnl reals and logicals.  For complex, it's c4 and c8.
35`void
36internal_unpack_'rtype_ccode` ('rtype` * d, const 'rtype_name` * src)
37{
38  index_type count[GFC_MAX_DIMENSIONS];
39  index_type extent[GFC_MAX_DIMENSIONS];
40  index_type stride[GFC_MAX_DIMENSIONS];
41  index_type stride0;
42  index_type dim;
43  index_type dsize;
44  'rtype_name` * restrict dest;
45
46  dest = d->base_addr;
47  if (src == dest || !src)
48    return;
49
50  dim = GFC_DESCRIPTOR_RANK (d);
51  dsize = 1;
52  for (index_type n = 0; n < dim; n++)
53    {
54      count[n] = 0;
55      stride[n] = GFC_DESCRIPTOR_STRIDE(d,n);
56      extent[n] = GFC_DESCRIPTOR_EXTENT(d,n);
57      if (extent[n] <= 0)
58	return;
59
60      if (dsize == stride[n])
61	dsize *= extent[n];
62      else
63	dsize = 0;
64    }
65
66  if (dsize != 0)
67    {
68      memcpy (dest, src, dsize * sizeof ('rtype_name`));
69      return;
70    }
71
72  stride0 = stride[0];
73
74  while (dest)
75    {
76      /* Copy the data.  */
77      *dest = *(src++);
78      /* Advance to the next element.  */
79      dest += stride0;
80      count[0]++;
81      /* Advance to the next source element.  */
82      index_type n = 0;
83      while (count[n] == extent[n])
84        {
85          /* When we get to the end of a dimension, reset it and increment
86             the next dimension.  */
87          count[n] = 0;
88          /* We could precalculate these products, but this is a less
89             frequently used path so probably not worth it.  */
90          dest -= stride[n] * extent[n];
91          n++;
92          if (n == dim)
93            {
94              dest = NULL;
95              break;
96            }
97          else
98            {
99              count[n]++;
100              dest += stride[n];
101            }
102        }
103    }
104}
105
106#endif
107'
108