1181254a7Smrg /* Helper function for repacking arrays.
2*b1e83836Smrg Copyright (C) 2003-2022 Free Software Foundation, Inc.
3181254a7Smrg Contributed by Paul Brook <paul@nowt.org>
4181254a7Smrg
5181254a7Smrg This file is part of the GNU Fortran runtime library (libgfortran).
6181254a7Smrg
7181254a7Smrg Libgfortran is free software; you can redistribute it and/or
8181254a7Smrg modify it under the terms of the GNU General Public
9181254a7Smrg License as published by the Free Software Foundation; either
10181254a7Smrg version 3 of the License, or (at your option) any later version.
11181254a7Smrg
12181254a7Smrg Libgfortran is distributed in the hope that it will be useful,
13181254a7Smrg but WITHOUT ANY WARRANTY; without even the implied warranty of
14181254a7Smrg MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15181254a7Smrg GNU General Public License for more details.
16181254a7Smrg
17181254a7Smrg Under Section 7 of GPL version 3, you are granted additional
18181254a7Smrg permissions described in the GCC Runtime Library Exception, version
19181254a7Smrg 3.1, as published by the Free Software Foundation.
20181254a7Smrg
21181254a7Smrg You should have received a copy of the GNU General Public License and
22181254a7Smrg a copy of the GCC Runtime Library Exception along with this program;
23181254a7Smrg see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
24181254a7Smrg <http://www.gnu.org/licenses/>. */
25181254a7Smrg
26181254a7Smrg #include "libgfortran.h"
27181254a7Smrg #include <string.h>
28181254a7Smrg
29181254a7Smrg
30181254a7Smrg #if defined (HAVE_GFC_INTEGER_8)
31181254a7Smrg
32181254a7Smrg void
internal_unpack_8(gfc_array_i8 * d,const GFC_INTEGER_8 * src)33181254a7Smrg internal_unpack_8 (gfc_array_i8 * d, const GFC_INTEGER_8 * src)
34181254a7Smrg {
35181254a7Smrg index_type count[GFC_MAX_DIMENSIONS];
36181254a7Smrg index_type extent[GFC_MAX_DIMENSIONS];
37181254a7Smrg index_type stride[GFC_MAX_DIMENSIONS];
38181254a7Smrg index_type stride0;
39181254a7Smrg index_type dim;
40181254a7Smrg index_type dsize;
41181254a7Smrg GFC_INTEGER_8 * restrict dest;
42181254a7Smrg
43181254a7Smrg dest = d->base_addr;
44181254a7Smrg if (src == dest || !src)
45181254a7Smrg return;
46181254a7Smrg
47181254a7Smrg dim = GFC_DESCRIPTOR_RANK (d);
48181254a7Smrg dsize = 1;
49181254a7Smrg for (index_type n = 0; n < dim; n++)
50181254a7Smrg {
51181254a7Smrg count[n] = 0;
52181254a7Smrg stride[n] = GFC_DESCRIPTOR_STRIDE(d,n);
53181254a7Smrg extent[n] = GFC_DESCRIPTOR_EXTENT(d,n);
54181254a7Smrg if (extent[n] <= 0)
55181254a7Smrg return;
56181254a7Smrg
57181254a7Smrg if (dsize == stride[n])
58181254a7Smrg dsize *= extent[n];
59181254a7Smrg else
60181254a7Smrg dsize = 0;
61181254a7Smrg }
62181254a7Smrg
63181254a7Smrg if (dsize != 0)
64181254a7Smrg {
65181254a7Smrg memcpy (dest, src, dsize * sizeof (GFC_INTEGER_8));
66181254a7Smrg return;
67181254a7Smrg }
68181254a7Smrg
69181254a7Smrg stride0 = stride[0];
70181254a7Smrg
71181254a7Smrg while (dest)
72181254a7Smrg {
73181254a7Smrg /* Copy the data. */
74181254a7Smrg *dest = *(src++);
75181254a7Smrg /* Advance to the next element. */
76181254a7Smrg dest += stride0;
77181254a7Smrg count[0]++;
78181254a7Smrg /* Advance to the next source element. */
79181254a7Smrg index_type n = 0;
80181254a7Smrg while (count[n] == extent[n])
81181254a7Smrg {
82181254a7Smrg /* When we get to the end of a dimension, reset it and increment
83181254a7Smrg the next dimension. */
84181254a7Smrg count[n] = 0;
85181254a7Smrg /* We could precalculate these products, but this is a less
86181254a7Smrg frequently used path so probably not worth it. */
87181254a7Smrg dest -= stride[n] * extent[n];
88181254a7Smrg n++;
89181254a7Smrg if (n == dim)
90181254a7Smrg {
91181254a7Smrg dest = NULL;
92181254a7Smrg break;
93181254a7Smrg }
94181254a7Smrg else
95181254a7Smrg {
96181254a7Smrg count[n]++;
97181254a7Smrg dest += stride[n];
98181254a7Smrg }
99181254a7Smrg }
100181254a7Smrg }
101181254a7Smrg }
102181254a7Smrg
103181254a7Smrg #endif
104181254a7Smrg
105