]> git.ipfire.org Git - thirdparty/gcc.git/blame - libgfortran/generated/in_pack_c10.c
in_pack.m4 (internal_pack_'rtype_code`): Destination pointer is restrict.
[thirdparty/gcc.git] / libgfortran / generated / in_pack_c10.c
CommitLineData
644cb69f 1/* Helper function for repacking arrays.
36ae8a61 2 Copyright 2003, 2006, 2007 Free Software Foundation, Inc.
644cb69f
FXC
3 Contributed by Paul Brook <paul@nowt.org>
4
5This file is part of the GNU Fortran 95 runtime library (libgfortran).
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
10version 2 of the License, or (at your option) any later version.
11
12In addition to the permissions in the GNU General Public License, the
13Free Software Foundation gives you unlimited permission to link the
14compiled version of this file into combinations with other programs,
15and to distribute those combinations without any restriction coming
16from the use of this file. (The General Public License restrictions
17do apply in other respects; for example, they cover modification of
18the file, and distribution when not linked into a combine
19executable.)
20
21Libgfortran is distributed in the hope that it will be useful,
22but WITHOUT ANY WARRANTY; without even the implied warranty of
23MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24GNU General Public License for more details.
25
26You should have received a copy of the GNU General Public
27License along with libgfortran; see the file COPYING. If not,
28write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
29Boston, MA 02110-1301, USA. */
30
36ae8a61 31#include "libgfortran.h"
644cb69f
FXC
32#include <stdlib.h>
33#include <assert.h>
36ae8a61 34
644cb69f
FXC
35
36#if defined (HAVE_GFC_COMPLEX_10)
37
38/* Allocates a block of memory with internal_malloc if the array needs
39 repacking. */
40
41GFC_COMPLEX_10 *
42internal_pack_c10 (gfc_array_c10 * source)
43{
44 index_type count[GFC_MAX_DIMENSIONS];
45 index_type extent[GFC_MAX_DIMENSIONS];
46 index_type stride[GFC_MAX_DIMENSIONS];
47 index_type stride0;
48 index_type dim;
49 index_type ssize;
50 const GFC_COMPLEX_10 *src;
5863aacf 51 GFC_COMPLEX_10 * restrict dest;
644cb69f
FXC
52 GFC_COMPLEX_10 *destptr;
53 int n;
54 int packed;
55
6ff24d45
JB
56 /* TODO: Investigate how we can figure out if this is a temporary
57 since the stride=0 thing has been removed from the frontend. */
644cb69f
FXC
58
59 dim = GFC_DESCRIPTOR_RANK (source);
60 ssize = 1;
61 packed = 1;
62 for (n = 0; n < dim; n++)
63 {
64 count[n] = 0;
65 stride[n] = source->dim[n].stride;
66 extent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound;
67 if (extent[n] <= 0)
68 {
69 /* Do nothing. */
70 packed = 1;
71 break;
72 }
73
74 if (ssize != stride[n])
75 packed = 0;
76
77 ssize *= extent[n];
78 }
79
80 if (packed)
81 return source->data;
82
83 /* Allocate storage for the destination. */
84 destptr = (GFC_COMPLEX_10 *)internal_malloc_size (ssize * sizeof (GFC_COMPLEX_10));
85 dest = destptr;
86 src = source->data;
87 stride0 = stride[0];
88
89
90 while (src)
91 {
92 /* Copy the data. */
93 *(dest++) = *src;
94 /* Advance to the next element. */
95 src += stride0;
96 count[0]++;
97 /* Advance to the next source element. */
98 n = 0;
99 while (count[n] == extent[n])
100 {
101 /* When we get to the end of a dimension, reset it and increment
102 the next dimension. */
103 count[n] = 0;
104 /* We could precalculate these products, but this is a less
5d7adf7a 105 frequently used path so probably not worth it. */
644cb69f
FXC
106 src -= stride[n] * extent[n];
107 n++;
108 if (n == dim)
109 {
110 src = NULL;
111 break;
112 }
113 else
114 {
115 count[n]++;
116 src += stride[n];
117 }
118 }
119 }
120 return destptr;
121}
122
123#endif
36ae8a61 124