Imported Upstream version 4.8.1
[platform/upstream/gcc48.git] / libgfortran / generated / maxval_i8.c
1 /* Implementation of the MAXVAL intrinsic
2    Copyright (C) 2002-2013 Free Software Foundation, Inc.
3    Contributed by Paul Brook <paul@nowt.org>
4
5 This file is part of the GNU Fortran 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 3 of the License, or (at your option) any later version.
11
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.
16
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.
20
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/>.  */
25
26 #include "libgfortran.h"
27 #include <stdlib.h>
28 #include <assert.h>
29
30
31 #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8)
32
33
34 extern void maxval_i8 (gfc_array_i8 * const restrict, 
35         gfc_array_i8 * const restrict, const index_type * const restrict);
36 export_proto(maxval_i8);
37
38 void
39 maxval_i8 (gfc_array_i8 * const restrict retarray, 
40         gfc_array_i8 * const restrict array, 
41         const index_type * const restrict pdim)
42 {
43   index_type count[GFC_MAX_DIMENSIONS];
44   index_type extent[GFC_MAX_DIMENSIONS];
45   index_type sstride[GFC_MAX_DIMENSIONS];
46   index_type dstride[GFC_MAX_DIMENSIONS];
47   const GFC_INTEGER_8 * restrict base;
48   GFC_INTEGER_8 * restrict dest;
49   index_type rank;
50   index_type n;
51   index_type len;
52   index_type delta;
53   index_type dim;
54   int continue_loop;
55
56   /* Make dim zero based to avoid confusion.  */
57   dim = (*pdim) - 1;
58   rank = GFC_DESCRIPTOR_RANK (array) - 1;
59
60   len = GFC_DESCRIPTOR_EXTENT(array,dim);
61   if (len < 0)
62     len = 0;
63   delta = GFC_DESCRIPTOR_STRIDE(array,dim);
64
65   for (n = 0; n < dim; n++)
66     {
67       sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
68       extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
69
70       if (extent[n] < 0)
71         extent[n] = 0;
72     }
73   for (n = dim; n < rank; n++)
74     {
75       sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
76       extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
77
78       if (extent[n] < 0)
79         extent[n] = 0;
80     }
81
82   if (retarray->base_addr == NULL)
83     {
84       size_t alloc_size, str;
85
86       for (n = 0; n < rank; n++)
87         {
88           if (n == 0)
89             str = 1;
90           else
91             str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
92
93           GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
94
95         }
96
97       retarray->offset = 0;
98       retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
99
100       alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
101                    * extent[rank-1];
102
103       retarray->base_addr = xmalloc (alloc_size);
104       if (alloc_size == 0)
105         {
106           /* Make sure we have a zero-sized array.  */
107           GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
108           return;
109
110         }
111     }
112   else
113     {
114       if (rank != GFC_DESCRIPTOR_RANK (retarray))
115         runtime_error ("rank of return array incorrect in"
116                        " MAXVAL intrinsic: is %ld, should be %ld",
117                        (long int) (GFC_DESCRIPTOR_RANK (retarray)),
118                        (long int) rank);
119
120       if (unlikely (compile_options.bounds_check))
121         bounds_ifunction_return ((array_t *) retarray, extent,
122                                  "return value", "MAXVAL");
123     }
124
125   for (n = 0; n < rank; n++)
126     {
127       count[n] = 0;
128       dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
129       if (extent[n] <= 0)
130         return;
131     }
132
133   base = array->base_addr;
134   dest = retarray->base_addr;
135
136   continue_loop = 1;
137   while (continue_loop)
138     {
139       const GFC_INTEGER_8 * restrict src;
140       GFC_INTEGER_8 result;
141       src = base;
142       {
143
144 #if defined (GFC_INTEGER_8_INFINITY)
145         result = -GFC_INTEGER_8_INFINITY;
146 #else
147         result = (-GFC_INTEGER_8_HUGE-1);
148 #endif
149         if (len <= 0)
150           *dest = (-GFC_INTEGER_8_HUGE-1);
151         else
152           {
153             for (n = 0; n < len; n++, src += delta)
154               {
155
156 #if defined (GFC_INTEGER_8_QUIET_NAN)
157                 if (*src >= result)
158                   break;
159               }
160             if (unlikely (n >= len))
161               result = GFC_INTEGER_8_QUIET_NAN;
162             else for (; n < len; n++, src += delta)
163               {
164 #endif
165                 if (*src > result)
166                   result = *src;
167               }
168             
169             *dest = result;
170           }
171       }
172       /* Advance to the next element.  */
173       count[0]++;
174       base += sstride[0];
175       dest += dstride[0];
176       n = 0;
177       while (count[n] == extent[n])
178         {
179           /* When we get to the end of a dimension, reset it and increment
180              the next dimension.  */
181           count[n] = 0;
182           /* We could precalculate these products, but this is a less
183              frequently used path so probably not worth it.  */
184           base -= sstride[n] * extent[n];
185           dest -= dstride[n] * extent[n];
186           n++;
187           if (n == rank)
188             {
189               /* Break out of the look.  */
190               continue_loop = 0;
191               break;
192             }
193           else
194             {
195               count[n]++;
196               base += sstride[n];
197               dest += dstride[n];
198             }
199         }
200     }
201 }
202
203
204 extern void mmaxval_i8 (gfc_array_i8 * const restrict, 
205         gfc_array_i8 * const restrict, const index_type * const restrict,
206         gfc_array_l1 * const restrict);
207 export_proto(mmaxval_i8);
208
209 void
210 mmaxval_i8 (gfc_array_i8 * const restrict retarray, 
211         gfc_array_i8 * const restrict array, 
212         const index_type * const restrict pdim, 
213         gfc_array_l1 * const restrict mask)
214 {
215   index_type count[GFC_MAX_DIMENSIONS];
216   index_type extent[GFC_MAX_DIMENSIONS];
217   index_type sstride[GFC_MAX_DIMENSIONS];
218   index_type dstride[GFC_MAX_DIMENSIONS];
219   index_type mstride[GFC_MAX_DIMENSIONS];
220   GFC_INTEGER_8 * restrict dest;
221   const GFC_INTEGER_8 * restrict base;
222   const GFC_LOGICAL_1 * restrict mbase;
223   int rank;
224   int dim;
225   index_type n;
226   index_type len;
227   index_type delta;
228   index_type mdelta;
229   int mask_kind;
230
231   dim = (*pdim) - 1;
232   rank = GFC_DESCRIPTOR_RANK (array) - 1;
233
234   len = GFC_DESCRIPTOR_EXTENT(array,dim);
235   if (len <= 0)
236     return;
237
238   mbase = mask->base_addr;
239
240   mask_kind = GFC_DESCRIPTOR_SIZE (mask);
241
242   if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
243 #ifdef HAVE_GFC_LOGICAL_16
244       || mask_kind == 16
245 #endif
246       )
247     mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
248   else
249     runtime_error ("Funny sized logical array");
250
251   delta = GFC_DESCRIPTOR_STRIDE(array,dim);
252   mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
253
254   for (n = 0; n < dim; n++)
255     {
256       sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
257       mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
258       extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
259
260       if (extent[n] < 0)
261         extent[n] = 0;
262
263     }
264   for (n = dim; n < rank; n++)
265     {
266       sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
267       mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
268       extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
269
270       if (extent[n] < 0)
271         extent[n] = 0;
272     }
273
274   if (retarray->base_addr == NULL)
275     {
276       size_t alloc_size, str;
277
278       for (n = 0; n < rank; n++)
279         {
280           if (n == 0)
281             str = 1;
282           else
283             str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
284
285           GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
286
287         }
288
289       alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
290                    * extent[rank-1];
291
292       retarray->offset = 0;
293       retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
294
295       if (alloc_size == 0)
296         {
297           /* Make sure we have a zero-sized array.  */
298           GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
299           return;
300         }
301       else
302         retarray->base_addr = xmalloc (alloc_size);
303
304     }
305   else
306     {
307       if (rank != GFC_DESCRIPTOR_RANK (retarray))
308         runtime_error ("rank of return array incorrect in MAXVAL intrinsic");
309
310       if (unlikely (compile_options.bounds_check))
311         {
312           bounds_ifunction_return ((array_t *) retarray, extent,
313                                    "return value", "MAXVAL");
314           bounds_equal_extents ((array_t *) mask, (array_t *) array,
315                                 "MASK argument", "MAXVAL");
316         }
317     }
318
319   for (n = 0; n < rank; n++)
320     {
321       count[n] = 0;
322       dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
323       if (extent[n] <= 0)
324         return;
325     }
326
327   dest = retarray->base_addr;
328   base = array->base_addr;
329
330   while (base)
331     {
332       const GFC_INTEGER_8 * restrict src;
333       const GFC_LOGICAL_1 * restrict msrc;
334       GFC_INTEGER_8 result;
335       src = base;
336       msrc = mbase;
337       {
338
339 #if defined (GFC_INTEGER_8_INFINITY)
340         result = -GFC_INTEGER_8_INFINITY;
341 #else
342         result = (-GFC_INTEGER_8_HUGE-1);
343 #endif
344 #if defined (GFC_INTEGER_8_QUIET_NAN)
345         int non_empty_p = 0;
346 #endif
347         for (n = 0; n < len; n++, src += delta, msrc += mdelta)
348           {
349
350 #if defined (GFC_INTEGER_8_INFINITY) || defined (GFC_INTEGER_8_QUIET_NAN)
351                 if (*msrc)
352                   {
353 #if defined (GFC_INTEGER_8_QUIET_NAN)
354                     non_empty_p = 1;
355                     if (*src >= result)
356 #endif
357                       break;
358                   }
359               }
360             if (unlikely (n >= len))
361               {
362 #if defined (GFC_INTEGER_8_QUIET_NAN)
363                 result = non_empty_p ? GFC_INTEGER_8_QUIET_NAN : (-GFC_INTEGER_8_HUGE-1);
364 #else
365                 result = (-GFC_INTEGER_8_HUGE-1);
366 #endif
367               }
368             else for (; n < len; n++, src += delta, msrc += mdelta)
369               {
370 #endif
371                 if (*msrc && *src > result)
372                   result = *src;
373           }
374         *dest = result;
375       }
376       /* Advance to the next element.  */
377       count[0]++;
378       base += sstride[0];
379       mbase += mstride[0];
380       dest += dstride[0];
381       n = 0;
382       while (count[n] == extent[n])
383         {
384           /* When we get to the end of a dimension, reset it and increment
385              the next dimension.  */
386           count[n] = 0;
387           /* We could precalculate these products, but this is a less
388              frequently used path so probably not worth it.  */
389           base -= sstride[n] * extent[n];
390           mbase -= mstride[n] * extent[n];
391           dest -= dstride[n] * extent[n];
392           n++;
393           if (n == rank)
394             {
395               /* Break out of the look.  */
396               base = NULL;
397               break;
398             }
399           else
400             {
401               count[n]++;
402               base += sstride[n];
403               mbase += mstride[n];
404               dest += dstride[n];
405             }
406         }
407     }
408 }
409
410
411 extern void smaxval_i8 (gfc_array_i8 * const restrict, 
412         gfc_array_i8 * const restrict, const index_type * const restrict,
413         GFC_LOGICAL_4 *);
414 export_proto(smaxval_i8);
415
416 void
417 smaxval_i8 (gfc_array_i8 * const restrict retarray, 
418         gfc_array_i8 * const restrict array, 
419         const index_type * const restrict pdim, 
420         GFC_LOGICAL_4 * mask)
421 {
422   index_type count[GFC_MAX_DIMENSIONS];
423   index_type extent[GFC_MAX_DIMENSIONS];
424   index_type dstride[GFC_MAX_DIMENSIONS];
425   GFC_INTEGER_8 * restrict dest;
426   index_type rank;
427   index_type n;
428   index_type dim;
429
430
431   if (*mask)
432     {
433       maxval_i8 (retarray, array, pdim);
434       return;
435     }
436   /* Make dim zero based to avoid confusion.  */
437   dim = (*pdim) - 1;
438   rank = GFC_DESCRIPTOR_RANK (array) - 1;
439
440   for (n = 0; n < dim; n++)
441     {
442       extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
443
444       if (extent[n] <= 0)
445         extent[n] = 0;
446     }
447
448   for (n = dim; n < rank; n++)
449     {
450       extent[n] =
451         GFC_DESCRIPTOR_EXTENT(array,n + 1);
452
453       if (extent[n] <= 0)
454         extent[n] = 0;
455     }
456
457   if (retarray->base_addr == NULL)
458     {
459       size_t alloc_size, str;
460
461       for (n = 0; n < rank; n++)
462         {
463           if (n == 0)
464             str = 1;
465           else
466             str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
467
468           GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
469
470         }
471
472       retarray->offset = 0;
473       retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
474
475       alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
476                    * extent[rank-1];
477
478       if (alloc_size == 0)
479         {
480           /* Make sure we have a zero-sized array.  */
481           GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
482           return;
483         }
484       else
485         retarray->base_addr = xmalloc (alloc_size);
486     }
487   else
488     {
489       if (rank != GFC_DESCRIPTOR_RANK (retarray))
490         runtime_error ("rank of return array incorrect in"
491                        " MAXVAL intrinsic: is %ld, should be %ld",
492                        (long int) (GFC_DESCRIPTOR_RANK (retarray)),
493                        (long int) rank);
494
495       if (unlikely (compile_options.bounds_check))
496         {
497           for (n=0; n < rank; n++)
498             {
499               index_type ret_extent;
500
501               ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
502               if (extent[n] != ret_extent)
503                 runtime_error ("Incorrect extent in return value of"
504                                " MAXVAL intrinsic in dimension %ld:"
505                                " is %ld, should be %ld", (long int) n + 1,
506                                (long int) ret_extent, (long int) extent[n]);
507             }
508         }
509     }
510
511   for (n = 0; n < rank; n++)
512     {
513       count[n] = 0;
514       dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
515     }
516
517   dest = retarray->base_addr;
518
519   while(1)
520     {
521       *dest = (-GFC_INTEGER_8_HUGE-1);
522       count[0]++;
523       dest += dstride[0];
524       n = 0;
525       while (count[n] == extent[n])
526         {
527           /* When we get to the end of a dimension, reset it and increment
528              the next dimension.  */
529           count[n] = 0;
530           /* We could precalculate these products, but this is a less
531              frequently used path so probably not worth it.  */
532           dest -= dstride[n] * extent[n];
533           n++;
534           if (n == rank)
535             return;
536           else
537             {
538               count[n]++;
539               dest += dstride[n];
540             }
541         }
542     }
543 }
544
545 #endif