[ARM] Set mode for success result of atomic compare and swap
[official-gcc.git] / libgfortran / m4 / eoshift3.m4
blobb29fbccf8d3c7c84c951ecd77dd51523bfd26cb1
1 `/* Implementation of the EOSHIFT intrinsic
2    Copyright (C) 2002-2017 Free Software Foundation, Inc.
3    Contributed by Paul Brook <paul@nowt.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_'atype_name`)
33 static void
34 eoshift3 (gfc_array_char * const restrict ret, 
35         const gfc_array_char * const restrict array, 
36         const 'atype` * const restrict h,
37         const gfc_array_char * const restrict bound, 
38         const 'atype_name` * const restrict pwhich,
39         const char * filler, index_type filler_len)
41   /* r.* indicates the return array.  */
42   index_type rstride[GFC_MAX_DIMENSIONS];
43   index_type rstride0;
44   index_type roffset;
45   char *rptr;
46   char * restrict dest;
47   /* s.* indicates the source array.  */
48   index_type sstride[GFC_MAX_DIMENSIONS];
49   index_type sstride0;
50   index_type soffset;
51   const char *sptr;
52   const char *src;
53   /* h.* indicates the shift array.  */
54   index_type hstride[GFC_MAX_DIMENSIONS];
55   index_type hstride0;
56   const 'atype_name` *hptr;
57   /* b.* indicates the bound array.  */
58   index_type bstride[GFC_MAX_DIMENSIONS];
59   index_type bstride0;
60   const char *bptr;
62   index_type count[GFC_MAX_DIMENSIONS];
63   index_type extent[GFC_MAX_DIMENSIONS];
64   index_type dim;
65   index_type len;
66   index_type n;
67   index_type size;
68   index_type arraysize;
69   int which;
70   'atype_name` sh;
71   'atype_name` delta;
73   /* The compiler cannot figure out that these are set, initialize
74      them to avoid warnings.  */
75   len = 0;
76   soffset = 0;
77   roffset = 0;
79   arraysize = size0 ((array_t *) array);
80   size = GFC_DESCRIPTOR_SIZE(array);
82   if (pwhich)
83     which = *pwhich - 1;
84   else
85     which = 0;
87   if (ret->base_addr == NULL)
88     {
89       int i;
91       ret->base_addr = xmallocarray (arraysize, size);
92       ret->offset = 0;
93       ret->dtype = array->dtype;
94       for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
95         {
96           index_type ub, str;
98           ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1;
100           if (i == 0)
101             str = 1;
102           else
103             str = GFC_DESCRIPTOR_EXTENT(ret,i-1)
104               * GFC_DESCRIPTOR_STRIDE(ret,i-1);
106           GFC_DIMENSION_SET(ret->dim[i], 0, ub, str);
108         }
109       /* xmallocarray allocates a single byte for zero size.  */
110       ret->base_addr = xmallocarray (arraysize, size);
112     }
113   else if (unlikely (compile_options.bounds_check))
114     {
115       bounds_equal_extents ((array_t *) ret, (array_t *) array,
116                                  "return value", "EOSHIFT");
117     }
119   if (unlikely (compile_options.bounds_check))
120     {
121       bounds_reduced_extents ((array_t *) h, (array_t *) array, which,
122                               "SHIFT argument", "EOSHIFT");
123     }
125   if (arraysize == 0)
126     return;
128   extent[0] = 1;
129   count[0] = 0;
130   n = 0;
131   for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
132     {
133       if (dim == which)
134         {
135           roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
136           if (roffset == 0)
137             roffset = size;
138           soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
139           if (soffset == 0)
140             soffset = size;
141           len = GFC_DESCRIPTOR_EXTENT(array,dim);
142         }
143       else
144         {
145           count[n] = 0;
146           extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
147           rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);
148           sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);
150           hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n);
151           if (bound)
152             bstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(bound,n);
153           else
154             bstride[n] = 0;
155           n++;
156         }
157     }
158   if (sstride[0] == 0)
159     sstride[0] = size;
160   if (rstride[0] == 0)
161     rstride[0] = size;
162   if (hstride[0] == 0)
163     hstride[0] = 1;
164   if (bound && bstride[0] == 0)
165     bstride[0] = size;
167   dim = GFC_DESCRIPTOR_RANK (array);
168   rstride0 = rstride[0];
169   sstride0 = sstride[0];
170   hstride0 = hstride[0];
171   bstride0 = bstride[0];
172   rptr = ret->base_addr;
173   sptr = array->base_addr;
174   hptr = h->base_addr;
175   if (bound)
176     bptr = bound->base_addr;
177   else
178     bptr = NULL;
180   while (rptr)
181     {
182       /* Do the shift for this dimension.  */
183       sh = *hptr;
184       if (( sh >= 0 ? sh : -sh ) > len)
185         {
186           delta = len;
187           sh = len;
188         }
189       else
190         delta = (sh >= 0) ? sh: -sh;
192       if (sh > 0)
193         {
194           src = &sptr[delta * soffset];
195           dest = rptr;
196         }
197       else
198         {
199           src = sptr;
200           dest = &rptr[delta * roffset];
201         }
202       for (n = 0; n < len - delta; n++)
203         {
204           memcpy (dest, src, size);
205           dest += roffset;
206           src += soffset;
207         }
208       if (sh < 0)
209         dest = rptr;
210       n = delta;
212       if (bptr)
213         while (n--)
214           {
215             memcpy (dest, bptr, size);
216             dest += roffset;
217           }
218       else
219         while (n--)
220           {
221             index_type i;
223             if (filler_len == 1)
224               memset (dest, filler[0], size);
225             else
226               for (i = 0; i < size; i += filler_len)
227                 memcpy (&dest[i], filler, filler_len);
229             dest += roffset;
230           }
232       /* Advance to the next section.  */
233       rptr += rstride0;
234       sptr += sstride0;
235       hptr += hstride0;
236       bptr += bstride0;
237       count[0]++;
238       n = 0;
239       while (count[n] == extent[n])
240         {
241           /* When we get to the end of a dimension, reset it and increment
242              the next dimension.  */
243           count[n] = 0;
244           /* We could precalculate these products, but this is a less
245              frequently used path so probably not worth it.  */
246           rptr -= rstride[n] * extent[n];
247           sptr -= sstride[n] * extent[n];
248           hptr -= hstride[n] * extent[n];
249           bptr -= bstride[n] * extent[n];
250           n++;
251           if (n >= dim - 1)
252             {
253               /* Break out of the loop.  */
254               rptr = NULL;
255               break;
256             }
257           else
258             {
259               count[n]++;
260               rptr += rstride[n];
261               sptr += sstride[n];
262               hptr += hstride[n];
263               bptr += bstride[n];
264             }
265         }
266     }
269 extern void eoshift3_'atype_kind` (gfc_array_char * const restrict, 
270         const gfc_array_char * const restrict,
271         const 'atype` * const restrict, 
272         const gfc_array_char * const restrict,
273         const 'atype_name` *);
274 export_proto(eoshift3_'atype_kind`);
276 void
277 eoshift3_'atype_kind` (gfc_array_char * const restrict ret, 
278         const gfc_array_char * const restrict array,
279         const 'atype` * const restrict h, 
280         const gfc_array_char * const restrict bound,
281         const 'atype_name` * const restrict pwhich)
283   eoshift3 (ret, array, h, bound, pwhich, "\0", 1);
287 extern void eoshift3_'atype_kind`_char (gfc_array_char * const restrict, 
288         GFC_INTEGER_4,
289         const gfc_array_char * const restrict,
290         const 'atype` * const restrict,
291         const gfc_array_char * const restrict,
292         const 'atype_name` * const restrict, 
293         GFC_INTEGER_4, GFC_INTEGER_4);
294 export_proto(eoshift3_'atype_kind`_char);
296 void
297 eoshift3_'atype_kind`_char (gfc_array_char * const restrict ret,
298         GFC_INTEGER_4 ret_length __attribute__((unused)),
299         const gfc_array_char * const restrict array, 
300         const 'atype` *  const restrict h,
301         const gfc_array_char * const restrict bound,
302         const 'atype_name` * const restrict pwhich,
303         GFC_INTEGER_4 array_length __attribute__((unused)),
304         GFC_INTEGER_4 bound_length __attribute__((unused)))
306   eoshift3 (ret, array, h, bound, pwhich, " ", 1);
310 extern void eoshift3_'atype_kind`_char4 (gfc_array_char * const restrict, 
311         GFC_INTEGER_4,
312         const gfc_array_char * const restrict,
313         const 'atype` * const restrict,
314         const gfc_array_char * const restrict,
315         const 'atype_name` * const restrict, 
316         GFC_INTEGER_4, GFC_INTEGER_4);
317 export_proto(eoshift3_'atype_kind`_char4);
319 void
320 eoshift3_'atype_kind`_char4 (gfc_array_char * const restrict ret,
321         GFC_INTEGER_4 ret_length __attribute__((unused)),
322         const gfc_array_char * const restrict array, 
323         const 'atype` *  const restrict h,
324         const gfc_array_char * const restrict bound,
325         const 'atype_name` * const restrict pwhich,
326         GFC_INTEGER_4 array_length __attribute__((unused)),
327         GFC_INTEGER_4 bound_length __attribute__((unused)))
329   static const gfc_char4_t space = (unsigned char) ''` ''`;
330   eoshift3 (ret, array, h, bound, pwhich,
331             (const char *) &space, sizeof (gfc_char4_t));
334 #endif'