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