]> git.ipfire.org Git - thirdparty/gcc.git/blame - libgfortran/generated/in_pack_c4.c
Update copyright years.
[thirdparty/gcc.git] / libgfortran / generated / in_pack_c4.c
CommitLineData
f27ef643 1/* Helper function for repacking arrays.
f1717362 2 Copyright (C) 2003-2016 Free Software Foundation, Inc.
f27ef643 3 Contributed by Paul Brook <paul@nowt.org>
4
553877d9 5This file is part of the GNU Fortran runtime library (libgfortran).
f27ef643 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
6bc9506f 10version 3 of the License, or (at your option) any later version.
f27ef643 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
6bc9506f 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/>. */
f27ef643 25
41f2d5e8 26#include "libgfortran.h"
f27ef643 27#include <stdlib.h>
28#include <assert.h>
41f2d5e8 29
f27ef643 30
920e54ef 31#if defined (HAVE_GFC_COMPLEX_4)
32
f27ef643 33/* Allocates a block of memory with internal_malloc if the array needs
34 repacking. */
35
36GFC_COMPLEX_4 *
37internal_pack_c4 (gfc_array_c4 * source)
38{
39 index_type count[GFC_MAX_DIMENSIONS];
40 index_type extent[GFC_MAX_DIMENSIONS];
41 index_type stride[GFC_MAX_DIMENSIONS];
42 index_type stride0;
43 index_type dim;
44 index_type ssize;
45 const GFC_COMPLEX_4 *src;
9d259edf 46 GFC_COMPLEX_4 * restrict dest;
f27ef643 47 GFC_COMPLEX_4 *destptr;
48 int n;
49 int packed;
50
fff369f2 51 /* TODO: Investigate how we can figure out if this is a temporary
52 since the stride=0 thing has been removed from the frontend. */
f27ef643 53
54 dim = GFC_DESCRIPTOR_RANK (source);
55 ssize = 1;
56 packed = 1;
57 for (n = 0; n < dim; n++)
58 {
59 count[n] = 0;
827aef63 60 stride[n] = GFC_DESCRIPTOR_STRIDE(source,n);
61 extent[n] = GFC_DESCRIPTOR_EXTENT(source,n);
f27ef643 62 if (extent[n] <= 0)
63 {
64 /* Do nothing. */
65 packed = 1;
66 break;
67 }
68
69 if (ssize != stride[n])
70 packed = 0;
71
72 ssize *= extent[n];
73 }
74
75 if (packed)
553877d9 76 return source->base_addr;
f27ef643 77
78 /* Allocate storage for the destination. */
af1e9051 79 destptr = xmallocarray (ssize, sizeof (GFC_COMPLEX_4));
f27ef643 80 dest = destptr;
553877d9 81 src = source->base_addr;
f27ef643 82 stride0 = stride[0];
83
84
85 while (src)
86 {
87 /* Copy the data. */
88 *(dest++) = *src;
89 /* Advance to the next element. */
90 src += stride0;
91 count[0]++;
92 /* Advance to the next source element. */
93 n = 0;
94 while (count[n] == extent[n])
95 {
96 /* When we get to the end of a dimension, reset it and increment
97 the next dimension. */
98 count[n] = 0;
99 /* We could precalculate these products, but this is a less
e4f51eaa 100 frequently used path so probably not worth it. */
f27ef643 101 src -= stride[n] * extent[n];
102 n++;
103 if (n == dim)
104 {
105 src = NULL;
106 break;
107 }
108 else
109 {
110 count[n]++;
111 src += stride[n];
112 }
113 }
114 }
115 return destptr;
116}
117
920e54ef 118#endif
41f2d5e8 119