OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [libgfortran/] [generated/] [minval_i4.c] - Blame information for rev 775

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 733 jeremybenn
/* Implementation of the MINVAL intrinsic
2
   Copyright 2002, 2007, 2009, 2010 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_4) && defined (HAVE_GFC_INTEGER_4)
32
 
33
 
34
extern void minval_i4 (gfc_array_i4 * const restrict,
35
        gfc_array_i4 * const restrict, const index_type * const restrict);
36
export_proto(minval_i4);
37
 
38
void
39
minval_i4 (gfc_array_i4 * const restrict retarray,
40
        gfc_array_i4 * 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_4 * restrict base;
48
  GFC_INTEGER_4 * 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->data == 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_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
101
                   * extent[rank-1];
102
 
103
      retarray->data = internal_malloc_size (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
                       " MINVAL 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", "MINVAL");
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->data;
134
  dest = retarray->data;
135
 
136
  continue_loop = 1;
137
  while (continue_loop)
138
    {
139
      const GFC_INTEGER_4 * restrict src;
140
      GFC_INTEGER_4 result;
141
      src = base;
142
      {
143
 
144
#if defined (GFC_INTEGER_4_INFINITY)
145
        result = GFC_INTEGER_4_INFINITY;
146
#else
147
        result = GFC_INTEGER_4_HUGE;
148
#endif
149
        if (len <= 0)
150
          *dest = GFC_INTEGER_4_HUGE;
151
        else
152
          {
153
            for (n = 0; n < len; n++, src += delta)
154
              {
155
 
156
#if defined (GFC_INTEGER_4_QUIET_NAN)
157
                if (*src <= result)
158
                  break;
159
              }
160
            if (unlikely (n >= len))
161
              result = GFC_INTEGER_4_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 mminval_i4 (gfc_array_i4 * const restrict,
205
        gfc_array_i4 * const restrict, const index_type * const restrict,
206
        gfc_array_l1 * const restrict);
207
export_proto(mminval_i4);
208
 
209
void
210
mminval_i4 (gfc_array_i4 * const restrict retarray,
211
        gfc_array_i4 * 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_4 * restrict dest;
221
  const GFC_INTEGER_4 * 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->data;
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->data == 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_4) * 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->data = internal_malloc_size (alloc_size);
303
 
304
    }
305
  else
306
    {
307
      if (rank != GFC_DESCRIPTOR_RANK (retarray))
308
        runtime_error ("rank of return array incorrect in MINVAL intrinsic");
309
 
310
      if (unlikely (compile_options.bounds_check))
311
        {
312
          bounds_ifunction_return ((array_t *) retarray, extent,
313
                                   "return value", "MINVAL");
314
          bounds_equal_extents ((array_t *) mask, (array_t *) array,
315
                                "MASK argument", "MINVAL");
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->data;
328
  base = array->data;
329
 
330
  while (base)
331
    {
332
      const GFC_INTEGER_4 * restrict src;
333
      const GFC_LOGICAL_1 * restrict msrc;
334
      GFC_INTEGER_4 result;
335
      src = base;
336
      msrc = mbase;
337
      {
338
 
339
#if defined (GFC_INTEGER_4_INFINITY)
340
        result = GFC_INTEGER_4_INFINITY;
341
#else
342
        result = GFC_INTEGER_4_HUGE;
343
#endif
344
#if defined (GFC_INTEGER_4_QUIET_NAN)
345
        int non_empty_p = 0;
346
#endif
347
        if (len <= 0)
348
          *dest = GFC_INTEGER_4_HUGE;
349
        else
350
          {
351
            for (n = 0; n < len; n++, src += delta, msrc += mdelta)
352
              {
353
 
354
#if defined (GFC_INTEGER_4_INFINITY) || defined (GFC_INTEGER_4_QUIET_NAN)
355
                if (*msrc)
356
                  {
357
#if defined (GFC_INTEGER_4_QUIET_NAN)
358
                    non_empty_p = 1;
359
                    if (*src <= result)
360
#endif
361
                      break;
362
                  }
363
              }
364
            if (unlikely (n >= len))
365
              {
366
#if defined (GFC_INTEGER_4_QUIET_NAN)
367
                result = non_empty_p ? GFC_INTEGER_4_QUIET_NAN : GFC_INTEGER_4_HUGE;
368
#else
369
                result = GFC_INTEGER_4_HUGE;
370
#endif
371
              }
372
            else for (; n < len; n++, src += delta, msrc += mdelta)
373
              {
374
#endif
375
                if (*msrc && *src < result)
376
                  result = *src;
377
              }
378
            *dest = result;
379
          }
380
      }
381
      /* Advance to the next element.  */
382
      count[0]++;
383
      base += sstride[0];
384
      mbase += mstride[0];
385
      dest += dstride[0];
386
      n = 0;
387
      while (count[n] == extent[n])
388
        {
389
          /* When we get to the end of a dimension, reset it and increment
390
             the next dimension.  */
391
          count[n] = 0;
392
          /* We could precalculate these products, but this is a less
393
             frequently used path so probably not worth it.  */
394
          base -= sstride[n] * extent[n];
395
          mbase -= mstride[n] * extent[n];
396
          dest -= dstride[n] * extent[n];
397
          n++;
398
          if (n == rank)
399
            {
400
              /* Break out of the look.  */
401
              base = NULL;
402
              break;
403
            }
404
          else
405
            {
406
              count[n]++;
407
              base += sstride[n];
408
              mbase += mstride[n];
409
              dest += dstride[n];
410
            }
411
        }
412
    }
413
}
414
 
415
 
416
extern void sminval_i4 (gfc_array_i4 * const restrict,
417
        gfc_array_i4 * const restrict, const index_type * const restrict,
418
        GFC_LOGICAL_4 *);
419
export_proto(sminval_i4);
420
 
421
void
422
sminval_i4 (gfc_array_i4 * const restrict retarray,
423
        gfc_array_i4 * const restrict array,
424
        const index_type * const restrict pdim,
425
        GFC_LOGICAL_4 * mask)
426
{
427
  index_type count[GFC_MAX_DIMENSIONS];
428
  index_type extent[GFC_MAX_DIMENSIONS];
429
  index_type dstride[GFC_MAX_DIMENSIONS];
430
  GFC_INTEGER_4 * restrict dest;
431
  index_type rank;
432
  index_type n;
433
  index_type dim;
434
 
435
 
436
  if (*mask)
437
    {
438
      minval_i4 (retarray, array, pdim);
439
      return;
440
    }
441
  /* Make dim zero based to avoid confusion.  */
442
  dim = (*pdim) - 1;
443
  rank = GFC_DESCRIPTOR_RANK (array) - 1;
444
 
445
  for (n = 0; n < dim; n++)
446
    {
447
      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
448
 
449
      if (extent[n] <= 0)
450
        extent[n] = 0;
451
    }
452
 
453
  for (n = dim; n < rank; n++)
454
    {
455
      extent[n] =
456
        GFC_DESCRIPTOR_EXTENT(array,n + 1);
457
 
458
      if (extent[n] <= 0)
459
        extent[n] = 0;
460
    }
461
 
462
  if (retarray->data == NULL)
463
    {
464
      size_t alloc_size, str;
465
 
466
      for (n = 0; n < rank; n++)
467
        {
468
          if (n == 0)
469
            str = 1;
470
          else
471
            str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
472
 
473
          GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
474
 
475
        }
476
 
477
      retarray->offset = 0;
478
      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
479
 
480
      alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
481
                   * extent[rank-1];
482
 
483
      if (alloc_size == 0)
484
        {
485
          /* Make sure we have a zero-sized array.  */
486
          GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
487
          return;
488
        }
489
      else
490
        retarray->data = internal_malloc_size (alloc_size);
491
    }
492
  else
493
    {
494
      if (rank != GFC_DESCRIPTOR_RANK (retarray))
495
        runtime_error ("rank of return array incorrect in"
496
                       " MINVAL intrinsic: is %ld, should be %ld",
497
                       (long int) (GFC_DESCRIPTOR_RANK (retarray)),
498
                       (long int) rank);
499
 
500
      if (unlikely (compile_options.bounds_check))
501
        {
502
          for (n=0; n < rank; n++)
503
            {
504
              index_type ret_extent;
505
 
506
              ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
507
              if (extent[n] != ret_extent)
508
                runtime_error ("Incorrect extent in return value of"
509
                               " MINVAL intrinsic in dimension %ld:"
510
                               " is %ld, should be %ld", (long int) n + 1,
511
                               (long int) ret_extent, (long int) extent[n]);
512
            }
513
        }
514
    }
515
 
516
  for (n = 0; n < rank; n++)
517
    {
518
      count[n] = 0;
519
      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
520
    }
521
 
522
  dest = retarray->data;
523
 
524
  while(1)
525
    {
526
      *dest = GFC_INTEGER_4_HUGE;
527
      count[0]++;
528
      dest += dstride[0];
529
      n = 0;
530
      while (count[n] == extent[n])
531
        {
532
          /* When we get to the end of a dimension, reset it and increment
533
             the next dimension.  */
534
          count[n] = 0;
535
          /* We could precalculate these products, but this is a less
536
             frequently used path so probably not worth it.  */
537
          dest -= dstride[n] * extent[n];
538
          n++;
539
          if (n == rank)
540
            return;
541
          else
542
            {
543
              count[n]++;
544
              dest += dstride[n];
545
            }
546
        }
547
    }
548
}
549
 
550
#endif

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.