]> git.ipfire.org Git - thirdparty/gcc.git/blame - libgfortran/m4/in_unpack.m4
Update copyright years.
[thirdparty/gcc.git] / libgfortran / m4 / in_unpack.m4
CommitLineData
6de9cd9a 1`/* Helper function for repacking arrays.
7adcbafe 2 Copyright (C) 2003-2022 Free Software Foundation, Inc.
6de9cd9a
DN
3 Contributed by Paul Brook <paul@nowt.org>
4
21d1335b 5This file is part of the GNU Fortran runtime library (libgfortran).
6de9cd9a 6
57dea9f6
TM
7Libgfortran is free software; you can redistribute it and/or
8modify it under the terms of the GNU General Public
6de9cd9a 9License as published by the Free Software Foundation; either
748086b7 10version 3 of the License, or (at your option) any later version.
57dea9f6
TM
11
12Libgfortran is distributed in the hope that it will be useful,
6de9cd9a
DN
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
57dea9f6 15GNU General Public License for more details.
6de9cd9a 16
748086b7
JJ
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/>. */
6de9cd9a 25
36ae8a61 26#include "libgfortran.h"
36ae8a61
FXC
27#include <string.h>'
28
c9e66eda 29include(iparm.m4)dnl
6de9cd9a 30
644cb69f
FXC
31`#if defined (HAVE_'rtype_name`)'
32
39328081
TK
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.
adea5e16
TK
35`void
36internal_unpack_'rtype_ccode` ('rtype` * d, const 'rtype_name` * src)
6de9cd9a 37{
e33e218b
TK
38 index_type count[GFC_MAX_DIMENSIONS];
39 index_type extent[GFC_MAX_DIMENSIONS];
40 index_type stride[GFC_MAX_DIMENSIONS];
6de9cd9a
DN
41 index_type stride0;
42 index_type dim;
43 index_type dsize;
5863aacf 44 'rtype_name` * restrict dest;
6de9cd9a 45
21d1335b 46 dest = d->base_addr;
6de9cd9a
DN
47 if (src == dest || !src)
48 return;
49
6de9cd9a
DN
50 dim = GFC_DESCRIPTOR_RANK (d);
51 dsize = 1;
7a157266 52 for (index_type n = 0; n < dim; n++)
6de9cd9a
DN
53 {
54 count[n] = 0;
dfb55fdc
TK
55 stride[n] = GFC_DESCRIPTOR_STRIDE(d,n);
56 extent[n] = GFC_DESCRIPTOR_EXTENT(d,n);
6de9cd9a 57 if (extent[n] <= 0)
210879b8 58 return;
6de9cd9a
DN
59
60 if (dsize == stride[n])
210879b8 61 dsize *= extent[n];
6de9cd9a 62 else
210879b8 63 dsize = 0;
6de9cd9a
DN
64 }
65
66 if (dsize != 0)
67 {
adea5e16 68 memcpy (dest, src, dsize * sizeof ('rtype_name`));
6de9cd9a
DN
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. */
7a157266 82 index_type n = 0;
6de9cd9a
DN
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
8b6dba81 89 frequently used path so probably not worth it. */
6de9cd9a
DN
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
644cb69f 106#endif
36ae8a61 107'