xref: /netbsd-src/external/gpl3/gcc.old/dist/libgfortran/generated/in_unpack_i8.c (revision 4c3eb207d36f67d31994830c0a694161fc1ca39b)
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