]> git.ipfire.org Git - thirdparty/gcc.git/blame - libgfortran/generated/in_pack_i2.c
PR 78534 Reinstate better string copy algorithm
[thirdparty/gcc.git] / libgfortran / generated / in_pack_i2.c
CommitLineData
8e1d7686 1/* Helper function for repacking arrays.
85ec4feb 2 Copyright (C) 2003-2018 Free Software Foundation, Inc.
8e1d7686
TK
3 Contributed by Paul Brook <paul@nowt.org>
4
21d1335b 5This file is part of the GNU Fortran runtime library (libgfortran).
8e1d7686
TK
6
7Libgfortran is free software; you can redistribute it and/or
8modify it under the terms of the GNU General Public
9License as published by the Free Software Foundation; either
748086b7 10version 3 of the License, or (at your option) any later version.
8e1d7686
TK
11
12Libgfortran is distributed in the hope that it will be useful,
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15GNU General Public License for more details.
16
748086b7
JJ
17Under Section 7 of GPL version 3, you are granted additional
18permissions described in the GCC Runtime Library Exception, version
193.1, as published by the Free Software Foundation.
20
21You should have received a copy of the GNU General Public License and
22a copy of the GCC Runtime Library Exception along with this program;
23see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
24<http://www.gnu.org/licenses/>. */
8e1d7686
TK
25
26#include "libgfortran.h"
8e1d7686
TK
27
28
29#if defined (HAVE_GFC_INTEGER_2)
30
31/* Allocates a block of memory with internal_malloc if the array needs
32 repacking. */
33
34GFC_INTEGER_2 *
35internal_pack_2 (gfc_array_i2 * source)
36{
37 index_type count[GFC_MAX_DIMENSIONS];
38 index_type extent[GFC_MAX_DIMENSIONS];
39 index_type stride[GFC_MAX_DIMENSIONS];
40 index_type stride0;
41 index_type dim;
42 index_type ssize;
43 const GFC_INTEGER_2 *src;
5863aacf 44 GFC_INTEGER_2 * restrict dest;
8e1d7686
TK
45 GFC_INTEGER_2 *destptr;
46 int n;
47 int packed;
48
49 /* TODO: Investigate how we can figure out if this is a temporary
50 since the stride=0 thing has been removed from the frontend. */
51
52 dim = GFC_DESCRIPTOR_RANK (source);
53 ssize = 1;
54 packed = 1;
55 for (n = 0; n < dim; n++)
56 {
57 count[n] = 0;
dfb55fdc
TK
58 stride[n] = GFC_DESCRIPTOR_STRIDE(source,n);
59 extent[n] = GFC_DESCRIPTOR_EXTENT(source,n);
8e1d7686
TK
60 if (extent[n] <= 0)
61 {
62 /* Do nothing. */
63 packed = 1;
64 break;
65 }
66
67 if (ssize != stride[n])
68 packed = 0;
69
70 ssize *= extent[n];
71 }
72
73 if (packed)
21d1335b 74 return source->base_addr;
8e1d7686
TK
75
76 /* Allocate storage for the destination. */
92e6f3a4 77 destptr = xmallocarray (ssize, sizeof (GFC_INTEGER_2));
8e1d7686 78 dest = destptr;
21d1335b 79 src = source->base_addr;
8e1d7686
TK
80 stride0 = stride[0];
81
82
83 while (src)
84 {
85 /* Copy the data. */
86 *(dest++) = *src;
87 /* Advance to the next element. */
88 src += stride0;
89 count[0]++;
90 /* Advance to the next source element. */
91 n = 0;
92 while (count[n] == extent[n])
93 {
94 /* When we get to the end of a dimension, reset it and increment
95 the next dimension. */
96 count[n] = 0;
97 /* We could precalculate these products, but this is a less
98 frequently used path so probably not worth it. */
99 src -= stride[n] * extent[n];
100 n++;
101 if (n == dim)
102 {
103 src = NULL;
104 break;
105 }
106 else
107 {
108 count[n]++;
109 src += stride[n];
110 }
111 }
112 }
113 return destptr;
114}
115
116#endif
117