1760c2415Smrg /* Helper function for repacking arrays.
2*0bfacb9bSmrg Copyright (C) 2003-2020 Free Software Foundation, Inc.
3760c2415Smrg Contributed by Paul Brook <paul@nowt.org>
4760c2415Smrg
5760c2415Smrg This file is part of the GNU Fortran runtime library (libgfortran).
6760c2415Smrg
7760c2415Smrg Libgfortran is free software; you can redistribute it and/or
8760c2415Smrg modify it under the terms of the GNU General Public
9760c2415Smrg License as published by the Free Software Foundation; either
10760c2415Smrg version 3 of the License, or (at your option) any later version.
11760c2415Smrg
12760c2415Smrg Libgfortran is distributed in the hope that it will be useful,
13760c2415Smrg but WITHOUT ANY WARRANTY; without even the implied warranty of
14760c2415Smrg MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15760c2415Smrg GNU General Public License for more details.
16760c2415Smrg
17760c2415Smrg Under Section 7 of GPL version 3, you are granted additional
18760c2415Smrg permissions described in the GCC Runtime Library Exception, version
19760c2415Smrg 3.1, as published by the Free Software Foundation.
20760c2415Smrg
21760c2415Smrg You should have received a copy of the GNU General Public License and
22760c2415Smrg a copy of the GCC Runtime Library Exception along with this program;
23760c2415Smrg see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
24760c2415Smrg <http://www.gnu.org/licenses/>. */
25760c2415Smrg
26760c2415Smrg #include "libgfortran.h"
27760c2415Smrg #include <string.h>
28760c2415Smrg
29760c2415Smrg
30760c2415Smrg #if defined (HAVE_GFC_INTEGER_16)
31760c2415Smrg
32760c2415Smrg void
internal_unpack_16(gfc_array_i16 * d,const GFC_INTEGER_16 * src)33760c2415Smrg internal_unpack_16 (gfc_array_i16 * d, const GFC_INTEGER_16 * src)
34760c2415Smrg {
35760c2415Smrg index_type count[GFC_MAX_DIMENSIONS];
36760c2415Smrg index_type extent[GFC_MAX_DIMENSIONS];
37760c2415Smrg index_type stride[GFC_MAX_DIMENSIONS];
38760c2415Smrg index_type stride0;
39760c2415Smrg index_type dim;
40760c2415Smrg index_type dsize;
41760c2415Smrg GFC_INTEGER_16 * restrict dest;
42760c2415Smrg
43760c2415Smrg dest = d->base_addr;
44760c2415Smrg if (src == dest || !src)
45760c2415Smrg return;
46760c2415Smrg
47760c2415Smrg dim = GFC_DESCRIPTOR_RANK (d);
48760c2415Smrg dsize = 1;
49760c2415Smrg for (index_type n = 0; n < dim; n++)
50760c2415Smrg {
51760c2415Smrg count[n] = 0;
52760c2415Smrg stride[n] = GFC_DESCRIPTOR_STRIDE(d,n);
53760c2415Smrg extent[n] = GFC_DESCRIPTOR_EXTENT(d,n);
54760c2415Smrg if (extent[n] <= 0)
55760c2415Smrg return;
56760c2415Smrg
57760c2415Smrg if (dsize == stride[n])
58760c2415Smrg dsize *= extent[n];
59760c2415Smrg else
60760c2415Smrg dsize = 0;
61760c2415Smrg }
62760c2415Smrg
63760c2415Smrg if (dsize != 0)
64760c2415Smrg {
65760c2415Smrg memcpy (dest, src, dsize * sizeof (GFC_INTEGER_16));
66760c2415Smrg return;
67760c2415Smrg }
68760c2415Smrg
69760c2415Smrg stride0 = stride[0];
70760c2415Smrg
71760c2415Smrg while (dest)
72760c2415Smrg {
73760c2415Smrg /* Copy the data. */
74760c2415Smrg *dest = *(src++);
75760c2415Smrg /* Advance to the next element. */
76760c2415Smrg dest += stride0;
77760c2415Smrg count[0]++;
78760c2415Smrg /* Advance to the next source element. */
79760c2415Smrg index_type n = 0;
80760c2415Smrg while (count[n] == extent[n])
81760c2415Smrg {
82760c2415Smrg /* When we get to the end of a dimension, reset it and increment
83760c2415Smrg the next dimension. */
84760c2415Smrg count[n] = 0;
85760c2415Smrg /* We could precalculate these products, but this is a less
86760c2415Smrg frequently used path so probably not worth it. */
87760c2415Smrg dest -= stride[n] * extent[n];
88760c2415Smrg n++;
89760c2415Smrg if (n == dim)
90760c2415Smrg {
91760c2415Smrg dest = NULL;
92760c2415Smrg break;
93760c2415Smrg }
94760c2415Smrg else
95760c2415Smrg {
96760c2415Smrg count[n]++;
97760c2415Smrg dest += stride[n];
98760c2415Smrg }
99760c2415Smrg }
100760c2415Smrg }
101760c2415Smrg }
102760c2415Smrg
103760c2415Smrg #endif
104760c2415Smrg
105