OSDN Git Service

2005-06-12 Thomas Koenig <Thomas.Koenig@online.de>
[pf3gnuchains/gcc-fork.git] / libgfortran / intrinsics / eoshift0.c
1 /* Generic implementation of the EOSHIFT intrinsic
2    Copyright 2002, 2005 Free Software Foundation, Inc.
3    Contributed by Paul Brook <paul@nowt.org>
4
5 This file is part of the GNU Fortran 95 runtime library (libgfortran).
6
7 Libgfortran is free software; you can redistribute it and/or
8 modify it under the terms of the GNU General Public
9 License as published by the Free Software Foundation; either
10 version 2 of the License, or (at your option) any later version.
11
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,
22 but WITHOUT ANY WARRANTY; without even the implied warranty of
23 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
24 GNU General Public License for more details.
25
26 You should have received a copy of the GNU General Public
27 License along with libgfortran; see the file COPYING.  If not,
28 write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
29 Boston, MA 02111-1307, USA.  */
30
31 #include "config.h"
32 #include <stdlib.h>
33 #include <assert.h>
34 #include <string.h>
35 #include "libgfortran.h"
36
37 static const char zeros[16] =
38   {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0};
39
40 /* TODO: make this work for large shifts when
41    sizeof(int) < sizeof (index_type).  */
42
43 static void
44 eoshift0 (gfc_array_char * , const gfc_array_char *,
45           int, const char *, int);
46
47 static void
48 eoshift0 (gfc_array_char * ret, const gfc_array_char * array,
49           int shift, const char * pbound, int which)
50 {
51   /* r.* indicates the return array.  */
52   index_type rstride[GFC_MAX_DIMENSIONS];
53   index_type rstride0;
54   index_type roffset;
55   char *rptr;
56   char *dest;
57   /* s.* indicates the source array.  */
58   index_type sstride[GFC_MAX_DIMENSIONS];
59   index_type sstride0;
60   index_type soffset;
61   const char *sptr;
62   const char *src;
63
64   index_type count[GFC_MAX_DIMENSIONS];
65   index_type extent[GFC_MAX_DIMENSIONS];
66   index_type dim;
67   index_type size;
68   index_type len;
69   index_type n;
70
71   /* The compiler cannot figure out that these are set, initialize
72      them to avoid warnings.  */
73   len = 0;
74   soffset = 0;
75   roffset = 0;
76
77   if (!pbound)
78     pbound = zeros;
79
80   size = GFC_DESCRIPTOR_SIZE (ret);
81
82   if (ret->data == NULL)
83     {
84       int i;
85
86       ret->data = internal_malloc_size (size * size0 ((array_t *)array));
87       ret->base = 0;
88       ret->dtype = array->dtype;
89       for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
90         {
91           ret->dim[i].lbound = 0;
92           ret->dim[i].ubound = array->dim[i].ubound - array->dim[i].lbound;
93
94           if (i == 0)
95             ret->dim[i].stride = 1;
96           else
97             ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride;
98         }
99     }
100
101   which = which - 1;
102
103   extent[0] = 1;
104   count[0] = 0;
105   size = GFC_DESCRIPTOR_SIZE (array);
106   n = 0;
107   for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
108     {
109       if (dim == which)
110         {
111           roffset = ret->dim[dim].stride * size;
112           if (roffset == 0)
113             roffset = size;
114           soffset = array->dim[dim].stride * size;
115           if (soffset == 0)
116             soffset = size;
117           len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
118         }
119       else
120         {
121           count[n] = 0;
122           extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
123           rstride[n] = ret->dim[dim].stride * size;
124           sstride[n] = array->dim[dim].stride * size;
125           n++;
126         }
127     }
128   if (sstride[0] == 0)
129     sstride[0] = size;
130   if (rstride[0] == 0)
131     rstride[0] = size;
132
133   dim = GFC_DESCRIPTOR_RANK (array);
134   rstride0 = rstride[0];
135   sstride0 = sstride[0];
136   rptr = ret->data;
137   sptr = array->data;
138   if (shift > 0)
139     len = len - shift;
140   else
141     len = len + shift;
142
143   while (rptr)
144     {
145       /* Do the shift for this dimension.  */
146       if (shift > 0)
147         {
148           src = &sptr[shift * soffset];
149           dest = rptr;
150         }
151       else
152         {
153           src = sptr;
154           dest = &rptr[-shift * roffset];
155         }
156       for (n = 0; n < len; n++)
157         {
158           memcpy (dest, src, size);
159           dest += roffset;
160           src += soffset;
161         }
162       if (shift >= 0)
163         {
164           n = shift;
165         }
166       else
167         {
168           dest = rptr;
169           n = -shift;
170         }
171
172       while (n--)
173         {
174           memcpy (dest, pbound, size);
175           dest += roffset;
176         }
177
178       /* Advance to the next section.  */
179       rptr += rstride0;
180       sptr += sstride0;
181       count[0]++;
182       n = 0;
183       while (count[n] == extent[n])
184         {
185           /* When we get to the end of a dimension, reset it and increment
186              the next dimension.  */
187           count[n] = 0;
188           /* We could precalculate these products, but this is a less
189              frequently used path so proabably not worth it.  */
190           rptr -= rstride[n] * extent[n];
191           sptr -= sstride[n] * extent[n];
192           n++;
193           if (n >= dim - 1)
194             {
195               /* Break out of the loop.  */
196               rptr = NULL;
197               break;
198             }
199           else
200             {
201               count[n]++;
202               rptr += rstride[n];
203               sptr += sstride[n];
204             }
205         }
206     }
207 }
208
209
210 extern void eoshift0_1 (gfc_array_char *, const gfc_array_char *,
211                         const GFC_INTEGER_1 *, const char *,
212                         const GFC_INTEGER_1 *);
213 export_proto(eoshift0_1);
214
215 void
216 eoshift0_1 (gfc_array_char *ret, const gfc_array_char *array,
217             const GFC_INTEGER_1 *pshift, const char *pbound,
218             const GFC_INTEGER_1 *pdim)
219 {
220   eoshift0 (ret, array, *pshift, pbound, pdim ? *pdim : 1);
221 }
222
223
224 extern void eoshift0_2 (gfc_array_char *, const gfc_array_char *,
225                         const GFC_INTEGER_2 *, const char *,
226                         const GFC_INTEGER_2 *);
227 export_proto(eoshift0_2);
228
229 void
230 eoshift0_2 (gfc_array_char *ret, const gfc_array_char *array,
231             const GFC_INTEGER_2 *pshift, const char *pbound,
232             const GFC_INTEGER_2 *pdim)
233 {
234   eoshift0 (ret, array, *pshift, pbound, pdim ? *pdim : 1);
235 }
236
237
238 extern void eoshift0_4 (gfc_array_char *, const gfc_array_char *,
239                         const GFC_INTEGER_4 *, const char *,
240                         const GFC_INTEGER_4 *);
241 export_proto(eoshift0_4);
242
243 void
244 eoshift0_4 (gfc_array_char *ret, const gfc_array_char *array,
245             const GFC_INTEGER_4 *pshift, const char *pbound,
246             const GFC_INTEGER_4 *pdim)
247 {
248   eoshift0 (ret, array, *pshift, pbound, pdim ? *pdim : 1);
249 }
250
251
252 extern void eoshift0_8 (gfc_array_char *, const gfc_array_char *,
253                         const GFC_INTEGER_8 *, const char *,
254                         const GFC_INTEGER_8 *);
255 export_proto(eoshift0_8);
256
257 void
258 eoshift0_8 (gfc_array_char *ret, const gfc_array_char *array,
259             const GFC_INTEGER_8 *pshift, const char *pbound,
260             const GFC_INTEGER_8 *pdim)
261 {
262   eoshift0 (ret, array, *pshift, pbound, pdim ? *pdim : 1);
263 }