OSDN Git Service

* intrinsics/cshift0.c, intrinsics/eoshift0.c, intrinsics/eoshift2.c,
[pf3gnuchains/gcc-fork.git] / libgfortran / intrinsics / eoshift0.c
1 /* Generic implementation of the EOSHIFT intrinsic
2    Copyright 2002 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 (libgfor).
6
7 Libgfor is free software; you can redistribute it and/or
8 modify it under the terms of the GNU Lesser General Public
9 License as published by the Free Software Foundation; either
10 version 2.1 of the License, or (at your option) any later version.
11
12 Ligbfor is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15 GNU Lesser General Public License for more details.
16
17 You should have received a copy of the GNU Lesser General Public
18 License along with libgfor; see the file COPYING.LIB.  If not,
19 write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA.  */
21
22 #include "config.h"
23 #include <stdlib.h>
24 #include <assert.h>
25 #include <string.h>
26 #include "libgfortran.h"
27
28 static const char zeros[16] =
29   {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0};
30
31 /* TODO: make this work for large shifts when
32    sizeof(int) < sizeof (index_type).  */
33
34 static void
35 __eoshift0 (gfc_array_char * ret, const gfc_array_char * array,
36     int shift, const char * pbound, int which)
37 {
38   /* r.* indicates the return array.  */
39   index_type rstride[GFC_MAX_DIMENSIONS - 1];
40   index_type rstride0;
41   index_type roffset;
42   char *rptr;
43   char *dest;
44   /* s.* indicates the source array.  */
45   index_type sstride[GFC_MAX_DIMENSIONS - 1];
46   index_type sstride0;
47   index_type soffset;
48   const char *sptr;
49   const char *src;
50
51   index_type count[GFC_MAX_DIMENSIONS - 1];
52   index_type extent[GFC_MAX_DIMENSIONS - 1];
53   index_type dim;
54   index_type size;
55   index_type len;
56   index_type n;
57
58   if (!pbound)
59     pbound = zeros;
60
61   size = GFC_DESCRIPTOR_SIZE (ret);
62
63   if (ret->data == NULL)
64     {
65       int i;
66
67       ret->data = internal_malloc_size (size * size0 ((array_t *)array));
68       ret->base = 0;
69       ret->dtype = array->dtype;
70       for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
71         {
72           ret->dim[i].lbound = 0;
73           ret->dim[i].ubound = array->dim[i].ubound - array->dim[i].lbound;
74
75           if (i == 0)
76             ret->dim[i].stride = 1;
77           else
78             ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride;
79         }
80     }
81
82   which = which - 1;
83
84   extent[0] = 1;
85   count[0] = 0;
86   size = GFC_DESCRIPTOR_SIZE (array);
87   n = 0;
88   for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
89     {
90       if (dim == which)
91         {
92           roffset = ret->dim[dim].stride * size;
93           if (roffset == 0)
94             roffset = size;
95           soffset = array->dim[dim].stride * size;
96           if (soffset == 0)
97             soffset = size;
98           len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
99         }
100       else
101         {
102           count[n] = 0;
103           extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
104           rstride[n] = ret->dim[dim].stride * size;
105           sstride[n] = array->dim[dim].stride * size;
106           n++;
107         }
108     }
109   if (sstride[0] == 0)
110     sstride[0] = size;
111   if (rstride[0] == 0)
112     rstride[0] = size;
113
114   dim = GFC_DESCRIPTOR_RANK (array);
115   rstride0 = rstride[0];
116   sstride0 = sstride[0];
117   rptr = ret->data;
118   sptr = array->data;
119   if (shift > 0)
120     len = len - shift;
121   else
122     len = len + shift;
123
124   while (rptr)
125     {
126       /* Do the shift for this dimension.  */
127       if (shift > 0)
128         {
129           src = &sptr[shift * soffset];
130           dest = rptr;
131         }
132       else
133         {
134           src = sptr;
135           dest = &rptr[-shift * roffset];
136         }
137       for (n = 0; n < len; n++)
138         {
139           memcpy (dest, src, size);
140           dest += roffset;
141           src += soffset;
142         }
143       if (shift >= 0)
144         {
145           n = shift;
146         }
147       else
148         {
149           dest = rptr;
150           n = -shift;
151         }
152
153       while (n--)
154         {
155           memcpy (dest, pbound, size);
156           dest += roffset;
157         }
158
159       /* Advance to the next section.  */
160       rptr += rstride0;
161       sptr += sstride0;
162       count[0]++;
163       n = 0;
164       while (count[n] == extent[n])
165         {
166           /* When we get to the end of a dimension, reset it and increment
167              the next dimension.  */
168           count[n] = 0;
169           /* We could precalculate these products, but this is a less
170              frequently used path so proabably not worth it.  */
171           rptr -= rstride[n] * extent[n];
172           sptr -= sstride[n] * extent[n];
173           n++;
174           if (n >= dim - 1)
175             {
176               /* Break out of the loop.  */
177               rptr = NULL;
178               break;
179             }
180           else
181             {
182               count[n]++;
183               rptr += rstride[n];
184               sptr += sstride[n];
185             }
186         }
187     }
188 }
189
190
191 void
192 __eoshift0_4 (gfc_array_char * ret, const gfc_array_char * array,
193     const GFC_INTEGER_4 * pshift, const char * pbound,
194     const GFC_INTEGER_4 * pdim)
195 {
196   __eoshift0 (ret, array, *pshift, pbound, pdim ? *pdim : 1);
197 }
198
199
200 void
201 __eoshift0_8 (gfc_array_char * ret, const gfc_array_char * array,
202     const GFC_INTEGER_8 * pshift, const char * pbound,
203     const GFC_INTEGER_8 * pdim)
204 {
205   __eoshift0 (ret, array, *pshift, pbound, pdim ? *pdim : 1);
206 }