PR target/84226
[official-gcc.git] / libgfortran / m4 / cshift0.m4
blob9fe3ebfaee4f4dda6574c07d836c2439e6a7fcd1
1 `/* Helper function for cshift functions.
2    Copyright (C) 2008-2018 Free Software Foundation, Inc.
3    Contributed by Thomas Koenig <tkoenig@gcc.gnu.org>
5 This file is part of the GNU Fortran runtime library (libgfortran).
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 3 of the License, or (at your option) any later version.
12 Libgfortran 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 General Public License for more details.
17 Under Section 7 of GPL version 3, you are granted additional
18 permissions described in the GCC Runtime Library Exception, version
19 3.1, as published by the Free Software Foundation.
21 You should have received a copy of the GNU General Public License and
22 a copy of the GCC Runtime Library Exception along with this program;
23 see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
24 <http://www.gnu.org/licenses/>.  */
26 #include "libgfortran.h"
27 #include <string.h>'
29 include(iparm.m4)dnl
31 `#if defined (HAVE_'rtype_name`)
33 void
34 cshift0_'rtype_code` ('rtype` *ret, const 'rtype` *array, ptrdiff_t shift,
35                      int which)
37   /* r.* indicates the return array.  */
38   index_type rstride[GFC_MAX_DIMENSIONS];
39   index_type rstride0;
40   index_type roffset;
41   'rtype_name` *rptr;
43   /* s.* indicates the source array.  */
44   index_type sstride[GFC_MAX_DIMENSIONS];
45   index_type sstride0;
46   index_type soffset;
47   const 'rtype_name` *sptr;
49   index_type count[GFC_MAX_DIMENSIONS];
50   index_type extent[GFC_MAX_DIMENSIONS];
51   index_type dim;
52   index_type len;
53   index_type n;
55   bool do_blocked;
56   index_type r_ex, a_ex;
58   which = which - 1;
59   sstride[0] = 0;
60   rstride[0] = 0;
62   extent[0] = 1;
63   count[0] = 0;
64   n = 0;
65   /* Initialized for avoiding compiler warnings.  */
66   roffset = 1;
67   soffset = 1;
68   len = 0;
70   r_ex = 1;
71   a_ex = 1;
73   if (which > 0)
74     {
75       /* Test if both ret and array are contiguous.  */
76       do_blocked = true;
77       dim = GFC_DESCRIPTOR_RANK (array);
78       for (n = 0; n < dim; n ++)
79         {
80           index_type rs, as;
81           rs = GFC_DESCRIPTOR_STRIDE (ret, n);
82           if (rs != r_ex)
83             {
84               do_blocked = false;
85               break;
86             }
87           as = GFC_DESCRIPTOR_STRIDE (array, n);
88           if (as != a_ex)
89             {
90               do_blocked = false;
91               break;
92             }
93           r_ex *= GFC_DESCRIPTOR_EXTENT (ret, n);
94           a_ex *= GFC_DESCRIPTOR_EXTENT (array, n);
95         }
96     }
97   else
98     do_blocked = false;
100   n = 0;
102   if (do_blocked)
103     {
104       /* For contiguous arrays, use the relationship that
106          dimension(n1,n2,n3) :: a, b
107          b = cshift(a,sh,3)
109          can be dealt with as if
111          dimension(n1*n2*n3) :: an, bn
112          bn = cshift(a,sh*n1*n2,1)
114          we can used a more blocked algorithm for dim>1.  */
115       sstride[0] = 1;
116       rstride[0] = 1;
117       roffset = 1;
118       soffset = 1;
119       len = GFC_DESCRIPTOR_STRIDE(array, which)
120         * GFC_DESCRIPTOR_EXTENT(array, which);      
121       shift *= GFC_DESCRIPTOR_STRIDE(array, which);
122       for (dim = which + 1; dim < GFC_DESCRIPTOR_RANK (array); dim++)
123         {
124           count[n] = 0;
125           extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
126           rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
127           sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
128           n++;
129         }
130       dim = GFC_DESCRIPTOR_RANK (array) - which;
131     }
132   else
133     {
134       for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
135         {
136           if (dim == which)
137             {
138               roffset = GFC_DESCRIPTOR_STRIDE(ret,dim);
139               if (roffset == 0)
140                 roffset = 1;
141               soffset = GFC_DESCRIPTOR_STRIDE(array,dim);
142               if (soffset == 0)
143                 soffset = 1;
144               len = GFC_DESCRIPTOR_EXTENT(array,dim);
145             }
146           else
147             {
148               count[n] = 0;
149               extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
150               rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
151               sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
152               n++;
153             }
154         }
155       if (sstride[0] == 0)
156         sstride[0] = 1;
157       if (rstride[0] == 0)
158         rstride[0] = 1;
160       dim = GFC_DESCRIPTOR_RANK (array);
161     }
163   rstride0 = rstride[0];
164   sstride0 = sstride[0];
165   rptr = ret->base_addr;
166   sptr = array->base_addr;
168   /* Avoid the costly modulo for trivially in-bound shifts.  */
169   if (shift < 0 || shift >= len)
170     {
171       shift = len == 0 ? 0 : shift % (ptrdiff_t)len;
172       if (shift < 0)
173         shift += len;
174     }
176   while (rptr)
177     {
178       /* Do the shift for this dimension.  */
180       /* If elements are contiguous, perform the operation
181          in two block moves.  */
182       if (soffset == 1 && roffset == 1)
183         {
184           size_t len1 = shift * sizeof ('rtype_name`);
185           size_t len2 = (len - shift) * sizeof ('rtype_name`);
186           memcpy (rptr, sptr + shift, len2);
187           memcpy (rptr + (len - shift), sptr, len1);
188         }
189       else
190         {
191           /* Otherwise, we will have to perform the copy one element at
192              a time.  */
193           'rtype_name` *dest = rptr;
194           const 'rtype_name` *src = &sptr[shift * soffset];
196           for (n = 0; n < len - shift; n++)
197             {
198               *dest = *src;
199               dest += roffset;
200               src += soffset;
201             }
202           for (src = sptr, n = 0; n < shift; n++)
203             {
204               *dest = *src;
205               dest += roffset;
206               src += soffset;
207             }
208         }
210       /* Advance to the next section.  */
211       rptr += rstride0;
212       sptr += sstride0;
213       count[0]++;
214       n = 0;
215       while (count[n] == extent[n])
216         {
217           /* When we get to the end of a dimension, reset it and increment
218              the next dimension.  */
219           count[n] = 0;
220           /* We could precalculate these products, but this is a less
221              frequently used path so probably not worth it.  */
222           rptr -= rstride[n] * extent[n];
223           sptr -= sstride[n] * extent[n];
224           n++;
225           if (n >= dim - 1)
226             {
227               /* Break out of the loop.  */
228               rptr = NULL;
229               break;
230             }
231           else
232             {
233               count[n]++;
234               rptr += rstride[n];
235               sptr += sstride[n];
236             }
237         }
238     }
240   return;
243 #endif'