libgfortran/generated/minloc0_16_i8.c

   1 /* Implementation of the MINLOC intrinsic
   2    Copyright (C) 2002-2016 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 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 <limits.h>
  28
  29
  30 #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_16)
  31
  32
  33 extern void minloc0_16_i8 (gfc_array_i16 * const restrict retarray,
  34         gfc_array_i8 * const restrict array);
  35 export_proto(minloc0_16_i8);
  36
  37 void
  38 minloc0_16_i8 (gfc_array_i16 * const restrict retarray,
  39         gfc_array_i8 * const restrict array)
  40 {
  41   index_type count[GFC_MAX_DIMENSIONS];
  42   index_type extent[GFC_MAX_DIMENSIONS];
  43   index_type sstride[GFC_MAX_DIMENSIONS];
  44   index_type dstride;
  45   const GFC_INTEGER_8 *base;
  46   GFC_INTEGER_16 * restrict dest;
  47   index_type rank;
  48   index_type n;
  49
  50   rank = GFC_DESCRIPTOR_RANK (array);
  51   if (rank <= 0)
  52     runtime_error ("Rank of array needs to be > 0");
  53
  54   if (retarray->base_addr == NULL)
  55     {
  56       GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
  57       retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
  58       retarray->offset = 0;
  59       retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16));
  60     }
  61   else
  62     {
  63       if (unlikely (compile_options.bounds_check))
  64         bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
  65                                 "MINLOC");
  66     }
  67
  68   dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
  69   dest = retarray->base_addr;
  70   for (n = 0; n < rank; n++)
  71     {
  72       sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
  73       extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
  74       count[n] = 0;
  75       if (extent[n] <= 0)
  76         {
  77           /* Set the return value.  */
  78           for (n = 0; n < rank; n++)
  79             dest[n * dstride] = 0;
  80           return;
  81         }
  82     }
  83
  84   base = array->base_addr;
  85
  86   /* Initialize the return value.  */
  87   for (n = 0; n < rank; n++)
  88     dest[n * dstride] = 1;
  89   {
  90
  91     GFC_INTEGER_8 minval;
  92 #if defined(GFC_INTEGER_8_QUIET_NAN)
  93     int fast = 0;
  94 #endif
  95
  96 #if defined(GFC_INTEGER_8_INFINITY)
  97     minval = GFC_INTEGER_8_INFINITY;
  98 #else
  99     minval = GFC_INTEGER_8_HUGE;
 100 #endif
 101   while (base)
 102     {
 103       do
 104         {
 105           /* Implementation start.  */
 106
 107 #if defined(GFC_INTEGER_8_QUIET_NAN)
 108         }
 109       while (0);
 110       if (unlikely (!fast))
 111         {
 112           do
 113             {
 114               if (*base <= minval)
 115                 {
 116                   fast = 1;
 117                   minval = *base;
 118                   for (n = 0; n < rank; n++)
 119                     dest[n * dstride] = count[n] + 1;
 120                   break;
 121                 }
 122               base += sstride[0];
 123             }
 124           while (++count[0] != extent[0]);
 125           if (likely (fast))
 126             continue;
 127         }
 128       else do
 129         {
 130 #endif
 131           if (*base < minval)
 132             {
 133               minval = *base;
 134               for (n = 0; n < rank; n++)
 135                 dest[n * dstride] = count[n] + 1;
 136             }
 137           /* Implementation end.  */
 138           /* Advance to the next element.  */
 139           base += sstride[0];
 140         }
 141       while (++count[0] != extent[0]);
 142       n = 0;
 143       do
 144         {
 145           /* When we get to the end of a dimension, reset it and increment
 146              the next dimension.  */
 147           count[n] = 0;
 148           /* We could precalculate these products, but this is a less
 149              frequently used path so probably not worth it.  */
 150           base -= sstride[n] * extent[n];
 151           n++;
 152           if (n == rank)
 153             {
 154               /* Break out of the loop.  */
 155               base = NULL;
 156               break;
 157             }
 158           else
 159             {
 160               count[n]++;
 161               base += sstride[n];
 162             }
 163         }
 164       while (count[n] == extent[n]);
 165     }
 166   }
 167 }
 168
 169
 170 extern void mminloc0_16_i8 (gfc_array_i16 * const restrict,
 171         gfc_array_i8 * const restrict, gfc_array_l1 * const restrict);
 172 export_proto(mminloc0_16_i8);
 173
 174 void
 175 mminloc0_16_i8 (gfc_array_i16 * const restrict retarray,
 176         gfc_array_i8 * const restrict array,
 177         gfc_array_l1 * const restrict mask)
 178 {
 179   index_type count[GFC_MAX_DIMENSIONS];
 180   index_type extent[GFC_MAX_DIMENSIONS];
 181   index_type sstride[GFC_MAX_DIMENSIONS];
 182   index_type mstride[GFC_MAX_DIMENSIONS];
 183   index_type dstride;
 184   GFC_INTEGER_16 *dest;
 185   const GFC_INTEGER_8 *base;
 186   GFC_LOGICAL_1 *mbase;
 187   int rank;
 188   index_type n;
 189   int mask_kind;
 190
 191   rank = GFC_DESCRIPTOR_RANK (array);
 192   if (rank <= 0)
 193     runtime_error ("Rank of array needs to be > 0");
 194
 195   if (retarray->base_addr == NULL)
 196     {
 197       GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
 198       retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
 199       retarray->offset = 0;
 200       retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16));
 201     }
 202   else
 203     {
 204       if (unlikely (compile_options.bounds_check))
 205         {
 206
 207           bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
 208                                   "MINLOC");
 209           bounds_equal_extents ((array_t *) mask, (array_t *) array,
 210                                   "MASK argument", "MINLOC");
 211         }
 212     }
 213
 214   mask_kind = GFC_DESCRIPTOR_SIZE (mask);
 215
 216   mbase = mask->base_addr;
 217
 218   if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
 219 #ifdef HAVE_GFC_LOGICAL_16
 220       || mask_kind == 16
 221 #endif
 222       )
 223     mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
 224   else
 225     runtime_error ("Funny sized logical array");
 226
 227   dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
 228   dest = retarray->base_addr;
 229   for (n = 0; n < rank; n++)
 230     {
 231       sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
 232       mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
 233       extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
 234       count[n] = 0;
 235       if (extent[n] <= 0)
 236         {
 237           /* Set the return value.  */
 238           for (n = 0; n < rank; n++)
 239             dest[n * dstride] = 0;
 240           return;
 241         }
 242     }
 243
 244   base = array->base_addr;
 245
 246   /* Initialize the return value.  */
 247   for (n = 0; n < rank; n++)
 248     dest[n * dstride] = 0;
 249   {
 250
 251   GFC_INTEGER_8 minval;
 252    int fast = 0;
 253
 254 #if defined(GFC_INTEGER_8_INFINITY)
 255     minval = GFC_INTEGER_8_INFINITY;
 256 #else
 257     minval = GFC_INTEGER_8_HUGE;
 258 #endif
 259   while (base)
 260     {
 261       do
 262         {
 263           /* Implementation start.  */
 264
 265         }
 266       while (0);
 267       if (unlikely (!fast))
 268         {
 269           do
 270             {
 271               if (*mbase)
 272                 {
 273 #if defined(GFC_INTEGER_8_QUIET_NAN)
 274                   if (unlikely (dest[0] == 0))
 275                     for (n = 0; n < rank; n++)
 276                       dest[n * dstride] = count[n] + 1;
 277                   if (*base <= minval)
 278 #endif
 279                     {
 280                       fast = 1;
 281                       minval = *base;
 282                       for (n = 0; n < rank; n++)
 283                         dest[n * dstride] = count[n] + 1;
 284                       break;
 285                     }
 286                 }
 287               base += sstride[0];
 288               mbase += mstride[0];
 289             }
 290           while (++count[0] != extent[0]);
 291           if (likely (fast))
 292             continue;
 293         }
 294       else do
 295         {
 296           if (*mbase && *base < minval)
 297             {
 298               minval = *base;
 299               for (n = 0; n < rank; n++)
 300                 dest[n * dstride] = count[n] + 1;
 301             }
 302           /* Implementation end.  */
 303           /* Advance to the next element.  */
 304           base += sstride[0];
 305           mbase += mstride[0];
 306         }
 307       while (++count[0] != extent[0]);
 308       n = 0;
 309       do
 310         {
 311           /* When we get to the end of a dimension, reset it and increment
 312              the next dimension.  */
 313           count[n] = 0;
 314           /* We could precalculate these products, but this is a less
 315              frequently used path so probably not worth it.  */
 316           base -= sstride[n] * extent[n];
 317           mbase -= mstride[n] * extent[n];
 318           n++;
 319           if (n == rank)
 320             {
 321               /* Break out of the loop.  */
 322               base = NULL;
 323               break;
 324             }
 325           else
 326             {
 327               count[n]++;
 328               base += sstride[n];
 329               mbase += mstride[n];
 330             }
 331         }
 332       while (count[n] == extent[n]);
 333     }
 334   }
 335 }
 336
 337
 338 extern void sminloc0_16_i8 (gfc_array_i16 * const restrict,
 339         gfc_array_i8 * const restrict, GFC_LOGICAL_4 *);
 340 export_proto(sminloc0_16_i8);
 341
 342 void
 343 sminloc0_16_i8 (gfc_array_i16 * const restrict retarray,
 344         gfc_array_i8 * const restrict array,
 345         GFC_LOGICAL_4 * mask)
 346 {
 347   index_type rank;
 348   index_type dstride;
 349   index_type n;
 350   GFC_INTEGER_16 *dest;
 351
 352   if (*mask)
 353     {
 354       minloc0_16_i8 (retarray, array);
 355       return;
 356     }
 357
 358   rank = GFC_DESCRIPTOR_RANK (array);
 359
 360   if (rank <= 0)
 361     runtime_error ("Rank of array needs to be > 0");
 362
 363   if (retarray->base_addr == NULL)
 364     {
 365       GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
 366       retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
 367       retarray->offset = 0;
 368       retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16));
 369     }
 370   else if (unlikely (compile_options.bounds_check))
 371     {
 372        bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
 373                                "MINLOC");
 374     }
 375
 376   dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
 377   dest = retarray->base_addr;
 378   for (n = 0; n<rank; n++)
 379     dest[n * dstride] = 0 ;
 380 }
 381 #endif