]>
Commit | Line | Data |
---|---|---|
6de9cd9a | 1 | /* Generic helper function for repacking arrays. |
36ae8a61 | 2 | Copyright 2003, 2004, 2005, 2007 Free Software Foundation, Inc. |
6de9cd9a DN |
3 | Contributed by Paul Brook <paul@nowt.org> |
4 | ||
57dea9f6 | 5 | This file is part of the GNU Fortran 95 runtime library (libgfortran). |
6de9cd9a | 6 | |
57dea9f6 TM |
7 | Libgfortran is free software; you can redistribute it and/or |
8 | modify it under the terms of the GNU General Public | |
6de9cd9a | 9 | License as published by the Free Software Foundation; either |
57dea9f6 | 10 | version 2 of the License, or (at your option) any later version. |
6de9cd9a | 11 | |
57dea9f6 TM |
12 | In addition to the permissions in the GNU General Public License, the |
13 | Free Software Foundation gives you unlimited permission to link the | |
14 | compiled version of this file into combinations with other programs, | |
15 | and to distribute those combinations without any restriction coming | |
16 | from the use of this file. (The General Public License restrictions | |
17 | do apply in other respects; for example, they cover modification of | |
18 | the file, and distribution when not linked into a combine | |
19 | executable.) | |
20 | ||
21 | Libgfortran is distributed in the hope that it will be useful, | |
6de9cd9a DN |
22 | but WITHOUT ANY WARRANTY; without even the implied warranty of |
23 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
57dea9f6 | 24 | GNU General Public License for more details. |
6de9cd9a | 25 | |
57dea9f6 TM |
26 | You should have received a copy of the GNU General Public |
27 | License along with libgfortran; see the file COPYING. If not, | |
fe2ae685 KC |
28 | write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
29 | Boston, MA 02110-1301, USA. */ | |
6de9cd9a | 30 | |
36ae8a61 | 31 | #include "libgfortran.h" |
6de9cd9a DN |
32 | #include <stdlib.h> |
33 | #include <assert.h> | |
34 | #include <string.h> | |
6de9cd9a | 35 | |
7d7b8bfe RH |
36 | extern void internal_unpack (gfc_array_char *, const void *); |
37 | export_proto(internal_unpack); | |
38 | ||
6de9cd9a DN |
39 | void |
40 | internal_unpack (gfc_array_char * d, const void * s) | |
41 | { | |
f827a7d0 TK |
42 | index_type count[GFC_MAX_DIMENSIONS]; |
43 | index_type extent[GFC_MAX_DIMENSIONS]; | |
44 | index_type stride[GFC_MAX_DIMENSIONS]; | |
6de9cd9a DN |
45 | index_type stride0; |
46 | index_type dim; | |
47 | index_type dsize; | |
48 | char *dest; | |
49 | const char *src; | |
50 | int n; | |
51 | int size; | |
c7d0f4d5 | 52 | int type_size; |
6de9cd9a DN |
53 | |
54 | dest = d->data; | |
55 | /* This check may be redundant, but do it anyway. */ | |
56 | if (s == dest || !s) | |
57 | return; | |
58 | ||
c7d0f4d5 TK |
59 | type_size = GFC_DTYPE_TYPE_SIZE (d); |
60 | switch (type_size) | |
6de9cd9a | 61 | { |
c7d0f4d5 TK |
62 | case GFC_DTYPE_INTEGER_1: |
63 | case GFC_DTYPE_LOGICAL_1: | |
64 | case GFC_DTYPE_DERIVED_1: | |
65 | internal_unpack_1 ((gfc_array_i1 *) d, (const GFC_INTEGER_1 *) s); | |
66 | return; | |
67 | ||
68 | case GFC_DTYPE_INTEGER_2: | |
69 | case GFC_DTYPE_LOGICAL_2: | |
70 | internal_unpack_2 ((gfc_array_i2 *) d, (const GFC_INTEGER_2 *) s); | |
71 | return; | |
72 | ||
73 | case GFC_DTYPE_INTEGER_4: | |
74 | case GFC_DTYPE_LOGICAL_4: | |
75 | internal_unpack_4 ((gfc_array_i4 *) d, (const GFC_INTEGER_4 *) s); | |
76 | return; | |
77 | ||
78 | case GFC_DTYPE_INTEGER_8: | |
79 | case GFC_DTYPE_LOGICAL_8: | |
80 | internal_unpack_8 ((gfc_array_i8 *) d, (const GFC_INTEGER_8 *) s); | |
81 | return; | |
6de9cd9a | 82 | |
8e1d7686 | 83 | #if defined (HAVE_GFC_INTEGER_16) |
c7d0f4d5 TK |
84 | case GFC_DTYPE_INTEGER_16: |
85 | case GFC_DTYPE_LOGICAL_16: | |
86 | internal_unpack_16 ((gfc_array_i16 *) d, (const GFC_INTEGER_16 *) s); | |
87 | return; | |
8e1d7686 | 88 | #endif |
c7d0f4d5 TK |
89 | case GFC_DTYPE_REAL_4: |
90 | internal_unpack_r4 ((gfc_array_r4 *) d, (const GFC_REAL_4 *) s); | |
91 | return; | |
39328081 | 92 | |
c7d0f4d5 TK |
93 | case GFC_DTYPE_REAL_8: |
94 | internal_unpack_r8 ((gfc_array_r8 *) d, (const GFC_REAL_8 *) s); | |
95 | return; | |
8e1d7686 TK |
96 | |
97 | #if defined(HAVE_GFC_REAL_10) | |
c7d0f4d5 TK |
98 | case GFC_DTYPE_REAL_10: |
99 | internal_unpack_r10 ((gfc_array_r10 *) d, (const GFC_REAL_10 *) s); | |
100 | return; | |
8e1d7686 TK |
101 | #endif |
102 | ||
103 | #if defined(HAVE_GFC_REAL_16) | |
c7d0f4d5 TK |
104 | case GFC_DTYPE_REAL_16: |
105 | internal_unpack_r16 ((gfc_array_r16 *) d, (const GFC_REAL_16 *) s); | |
106 | return; | |
8e1d7686 | 107 | #endif |
c7d0f4d5 TK |
108 | case GFC_DTYPE_COMPLEX_4: |
109 | internal_unpack_c4 ((gfc_array_c4 *)d, (const GFC_COMPLEX_4 *)s); | |
110 | return; | |
8e1d7686 | 111 | |
c7d0f4d5 TK |
112 | case GFC_DTYPE_COMPLEX_8: |
113 | internal_unpack_c8 ((gfc_array_c8 *)d, (const GFC_COMPLEX_8 *)s); | |
114 | return; | |
8e1d7686 | 115 | |
c7d0f4d5 TK |
116 | #if defined(HAVE_GFC_COMPLEX_10) |
117 | case GFC_DTYPE_COMPLEX_10: | |
118 | internal_unpack_c10 ((gfc_array_c10 *) d, (const GFC_COMPLEX_10 *) s); | |
119 | return; | |
120 | #endif | |
121 | ||
122 | #if defined(HAVE_GFC_COMPLEX_16) | |
123 | case GFC_DTYPE_COMPLEX_16: | |
124 | internal_unpack_c16 ((gfc_array_c16 *) d, (const GFC_COMPLEX_16 *) s); | |
125 | return; | |
126 | #endif | |
127 | case GFC_DTYPE_DERIVED_2: | |
128 | if (GFC_UNALIGNED_2(d->data) || GFC_UNALIGNED_2(s)) | |
129 | break; | |
130 | else | |
39328081 | 131 | { |
c7d0f4d5 | 132 | internal_unpack_2 ((gfc_array_i2 *) d, (const GFC_INTEGER_2 *) s); |
39328081 | 133 | return; |
c7d0f4d5 TK |
134 | } |
135 | case GFC_DTYPE_DERIVED_4: | |
136 | if (GFC_UNALIGNED_4(d->data) || GFC_UNALIGNED_4(s)) | |
137 | break; | |
138 | else | |
139 | { | |
140 | internal_unpack_4 ((gfc_array_i4 *) d, (const GFC_INTEGER_4 *) s); | |
39328081 | 141 | return; |
c7d0f4d5 | 142 | } |
8e1d7686 | 143 | |
c7d0f4d5 TK |
144 | case GFC_DTYPE_DERIVED_8: |
145 | if (GFC_UNALIGNED_8(d->data) || GFC_UNALIGNED_8(s)) | |
146 | break; | |
147 | else | |
148 | { | |
149 | internal_unpack_8 ((gfc_array_i8 *) d, (const GFC_INTEGER_8 *) s); | |
8e1d7686 | 150 | return; |
c7d0f4d5 | 151 | } |
8e1d7686 | 152 | |
c7d0f4d5 TK |
153 | #ifdef HAVE_GFC_INTEGER_16 |
154 | case GFC_DTYPE_DERIVED_16: | |
155 | if (GFC_UNALIGNED_16(d->data) || GFC_UNALIGNED_16(s)) | |
156 | break; | |
157 | else | |
158 | { | |
159 | internal_unpack_16 ((gfc_array_i16 *) d, (const GFC_INTEGER_16 *) s); | |
8e1d7686 | 160 | return; |
c7d0f4d5 | 161 | } |
8e1d7686 TK |
162 | #endif |
163 | ||
39328081 TK |
164 | default: |
165 | break; | |
6de9cd9a DN |
166 | } |
167 | ||
c7d0f4d5 TK |
168 | size = GFC_DESCRIPTOR_SIZE (d); |
169 | ||
6de9cd9a DN |
170 | if (d->dim[0].stride == 0) |
171 | d->dim[0].stride = 1; | |
172 | ||
173 | dim = GFC_DESCRIPTOR_RANK (d); | |
174 | dsize = 1; | |
175 | for (n = 0; n < dim; n++) | |
176 | { | |
177 | count[n] = 0; | |
178 | stride[n] = d->dim[n].stride; | |
179 | extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound; | |
180 | if (extent[n] <= 0) | |
181 | abort (); | |
182 | ||
183 | if (dsize == stride[n]) | |
184 | dsize *= extent[n]; | |
185 | else | |
186 | dsize = 0; | |
187 | } | |
188 | ||
189 | src = s; | |
190 | ||
191 | if (dsize != 0) | |
192 | { | |
193 | memcpy (dest, src, dsize * size); | |
194 | return; | |
195 | } | |
196 | ||
197 | stride0 = stride[0] * size; | |
198 | ||
199 | while (dest) | |
200 | { | |
201 | /* Copy the data. */ | |
202 | memcpy (dest, src, size); | |
203 | /* Advance to the next element. */ | |
204 | src += size; | |
205 | dest += stride0; | |
206 | count[0]++; | |
207 | /* Advance to the next source element. */ | |
208 | n = 0; | |
209 | while (count[n] == extent[n]) | |
210 | { | |
211 | /* When we get to the end of a dimension, reset it and increment | |
212 | the next dimension. */ | |
213 | count[n] = 0; | |
214 | /* We could precalculate these products, but this is a less | |
8b6dba81 | 215 | frequently used path so probably not worth it. */ |
6de9cd9a DN |
216 | dest -= stride[n] * extent[n] * size; |
217 | n++; | |
218 | if (n == dim) | |
219 | { | |
220 | dest = NULL; | |
221 | break; | |
222 | } | |
223 | else | |
224 | { | |
225 | count[n]++; | |
226 | dest += stride[n] * size; | |
227 | } | |
228 | } | |
229 | } | |
230 | } |