1627f7eb2Smrg /* Helper function for repacking arrays.
2*4c3eb207Smrg Copyright (C) 2003-2020 Free Software Foundation, Inc.
3627f7eb2Smrg Contributed by Paul Brook <paul@nowt.org>
4627f7eb2Smrg
5627f7eb2Smrg This file is part of the GNU Fortran runtime library (libgfortran).
6627f7eb2Smrg
7627f7eb2Smrg Libgfortran is free software; you can redistribute it and/or
8627f7eb2Smrg modify it under the terms of the GNU General Public
9627f7eb2Smrg License as published by the Free Software Foundation; either
10627f7eb2Smrg version 3 of the License, or (at your option) any later version.
11627f7eb2Smrg
12627f7eb2Smrg Libgfortran is distributed in the hope that it will be useful,
13627f7eb2Smrg but WITHOUT ANY WARRANTY; without even the implied warranty of
14627f7eb2Smrg MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15627f7eb2Smrg GNU General Public License for more details.
16627f7eb2Smrg
17627f7eb2Smrg Under Section 7 of GPL version 3, you are granted additional
18627f7eb2Smrg permissions described in the GCC Runtime Library Exception, version
19627f7eb2Smrg 3.1, as published by the Free Software Foundation.
20627f7eb2Smrg
21627f7eb2Smrg You should have received a copy of the GNU General Public License and
22627f7eb2Smrg a copy of the GCC Runtime Library Exception along with this program;
23627f7eb2Smrg see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
24627f7eb2Smrg <http://www.gnu.org/licenses/>. */
25627f7eb2Smrg
26627f7eb2Smrg #include "libgfortran.h"
27627f7eb2Smrg #include <string.h>
28627f7eb2Smrg
29627f7eb2Smrg
30627f7eb2Smrg #if defined (HAVE_GFC_INTEGER_8)
31627f7eb2Smrg
32627f7eb2Smrg void
internal_unpack_8(gfc_array_i8 * d,const GFC_INTEGER_8 * src)33627f7eb2Smrg internal_unpack_8 (gfc_array_i8 * d, const GFC_INTEGER_8 * src)
34627f7eb2Smrg {
35627f7eb2Smrg index_type count[GFC_MAX_DIMENSIONS];
36627f7eb2Smrg index_type extent[GFC_MAX_DIMENSIONS];
37627f7eb2Smrg index_type stride[GFC_MAX_DIMENSIONS];
38627f7eb2Smrg index_type stride0;
39627f7eb2Smrg index_type dim;
40627f7eb2Smrg index_type dsize;
41627f7eb2Smrg GFC_INTEGER_8 * restrict dest;
42627f7eb2Smrg
43627f7eb2Smrg dest = d->base_addr;
44627f7eb2Smrg if (src == dest || !src)
45627f7eb2Smrg return;
46627f7eb2Smrg
47627f7eb2Smrg dim = GFC_DESCRIPTOR_RANK (d);
48627f7eb2Smrg dsize = 1;
49627f7eb2Smrg for (index_type n = 0; n < dim; n++)
50627f7eb2Smrg {
51627f7eb2Smrg count[n] = 0;
52627f7eb2Smrg stride[n] = GFC_DESCRIPTOR_STRIDE(d,n);
53627f7eb2Smrg extent[n] = GFC_DESCRIPTOR_EXTENT(d,n);
54627f7eb2Smrg if (extent[n] <= 0)
55627f7eb2Smrg return;
56627f7eb2Smrg
57627f7eb2Smrg if (dsize == stride[n])
58627f7eb2Smrg dsize *= extent[n];
59627f7eb2Smrg else
60627f7eb2Smrg dsize = 0;
61627f7eb2Smrg }
62627f7eb2Smrg
63627f7eb2Smrg if (dsize != 0)
64627f7eb2Smrg {
65627f7eb2Smrg memcpy (dest, src, dsize * sizeof (GFC_INTEGER_8));
66627f7eb2Smrg return;
67627f7eb2Smrg }
68627f7eb2Smrg
69627f7eb2Smrg stride0 = stride[0];
70627f7eb2Smrg
71627f7eb2Smrg while (dest)
72627f7eb2Smrg {
73627f7eb2Smrg /* Copy the data. */
74627f7eb2Smrg *dest = *(src++);
75627f7eb2Smrg /* Advance to the next element. */
76627f7eb2Smrg dest += stride0;
77627f7eb2Smrg count[0]++;
78627f7eb2Smrg /* Advance to the next source element. */
79627f7eb2Smrg index_type n = 0;
80627f7eb2Smrg while (count[n] == extent[n])
81627f7eb2Smrg {
82627f7eb2Smrg /* When we get to the end of a dimension, reset it and increment
83627f7eb2Smrg the next dimension. */
84627f7eb2Smrg count[n] = 0;
85627f7eb2Smrg /* We could precalculate these products, but this is a less
86627f7eb2Smrg frequently used path so probably not worth it. */
87627f7eb2Smrg dest -= stride[n] * extent[n];
88627f7eb2Smrg n++;
89627f7eb2Smrg if (n == dim)
90627f7eb2Smrg {
91627f7eb2Smrg dest = NULL;
92627f7eb2Smrg break;
93627f7eb2Smrg }
94627f7eb2Smrg else
95627f7eb2Smrg {
96627f7eb2Smrg count[n]++;
97627f7eb2Smrg dest += stride[n];
98627f7eb2Smrg }
99627f7eb2Smrg }
100627f7eb2Smrg }
101627f7eb2Smrg }
102627f7eb2Smrg
103627f7eb2Smrg #endif
104627f7eb2Smrg
105