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

Subversion Repositories openrisc

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

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

Line No. Rev Author Line
1 733 jeremybenn
/* Implementation of the IALL intrinsic
2
   Copyright 2010 Free Software Foundation, Inc.
3
   Contributed by Tobias Burnus <burnus@net-b.de>
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 iall_i4 (gfc_array_i4 * const restrict,
35
        gfc_array_i4 * const restrict, const index_type * const restrict);
36
export_proto(iall_i4);
37
 
38
void
39
iall_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
      if (alloc_size == 0)
104
        {
105
          /* Make sure we have a zero-sized array.  */
106
          GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
107
          return;
108
 
109
        }
110
      else
111
        retarray->data = internal_malloc_size (alloc_size);
112
    }
113
  else
114
    {
115
      if (rank != GFC_DESCRIPTOR_RANK (retarray))
116
        runtime_error ("rank of return array incorrect in"
117
                       " IALL intrinsic: is %ld, should be %ld",
118
                       (long int) (GFC_DESCRIPTOR_RANK (retarray)),
119
                       (long int) rank);
120
 
121
      if (unlikely (compile_options.bounds_check))
122
        bounds_ifunction_return ((array_t *) retarray, extent,
123
                                 "return value", "IALL");
124
    }
125
 
126
  for (n = 0; n < rank; n++)
127
    {
128
      count[n] = 0;
129
      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
130
      if (extent[n] <= 0)
131
        return;
132
    }
133
 
134
  base = array->data;
135
  dest = retarray->data;
136
 
137
  continue_loop = 1;
138
  while (continue_loop)
139
    {
140
      const GFC_INTEGER_4 * restrict src;
141
      GFC_INTEGER_4 result;
142
      src = base;
143
      {
144
 
145
  result = (GFC_INTEGER_4) -1;
146
        if (len <= 0)
147
          *dest = 0;
148
        else
149
          {
150
            for (n = 0; n < len; n++, src += delta)
151
              {
152
 
153
  result &= *src;
154
              }
155
 
156
            *dest = result;
157
          }
158
      }
159
      /* Advance to the next element.  */
160
      count[0]++;
161
      base += sstride[0];
162
      dest += dstride[0];
163
      n = 0;
164
      while (count[n] == extent[n])
165
        {
166
          /* When we get to the end of a dimension, reset it and increment
167
             the next dimension.  */
168
          count[n] = 0;
169
          /* We could precalculate these products, but this is a less
170
             frequently used path so probably not worth it.  */
171
          base -= sstride[n] * extent[n];
172
          dest -= dstride[n] * extent[n];
173
          n++;
174
          if (n == rank)
175
            {
176
              /* Break out of the look.  */
177
              continue_loop = 0;
178
              break;
179
            }
180
          else
181
            {
182
              count[n]++;
183
              base += sstride[n];
184
              dest += dstride[n];
185
            }
186
        }
187
    }
188
}
189
 
190
 
191
extern void miall_i4 (gfc_array_i4 * const restrict,
192
        gfc_array_i4 * const restrict, const index_type * const restrict,
193
        gfc_array_l1 * const restrict);
194
export_proto(miall_i4);
195
 
196
void
197
miall_i4 (gfc_array_i4 * const restrict retarray,
198
        gfc_array_i4 * const restrict array,
199
        const index_type * const restrict pdim,
200
        gfc_array_l1 * const restrict mask)
201
{
202
  index_type count[GFC_MAX_DIMENSIONS];
203
  index_type extent[GFC_MAX_DIMENSIONS];
204
  index_type sstride[GFC_MAX_DIMENSIONS];
205
  index_type dstride[GFC_MAX_DIMENSIONS];
206
  index_type mstride[GFC_MAX_DIMENSIONS];
207
  GFC_INTEGER_4 * restrict dest;
208
  const GFC_INTEGER_4 * restrict base;
209
  const GFC_LOGICAL_1 * restrict mbase;
210
  int rank;
211
  int dim;
212
  index_type n;
213
  index_type len;
214
  index_type delta;
215
  index_type mdelta;
216
  int mask_kind;
217
 
218
  dim = (*pdim) - 1;
219
  rank = GFC_DESCRIPTOR_RANK (array) - 1;
220
 
221
  len = GFC_DESCRIPTOR_EXTENT(array,dim);
222
  if (len <= 0)
223
    return;
224
 
225
  mbase = mask->data;
226
 
227
  mask_kind = GFC_DESCRIPTOR_SIZE (mask);
228
 
229
  if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
230
#ifdef HAVE_GFC_LOGICAL_16
231
      || mask_kind == 16
232
#endif
233
      )
234
    mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
235
  else
236
    runtime_error ("Funny sized logical array");
237
 
238
  delta = GFC_DESCRIPTOR_STRIDE(array,dim);
239
  mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
240
 
241
  for (n = 0; n < dim; n++)
242
    {
243
      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
244
      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
245
      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
246
 
247
      if (extent[n] < 0)
248
        extent[n] = 0;
249
 
250
    }
251
  for (n = dim; n < rank; n++)
252
    {
253
      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
254
      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
255
      extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
256
 
257
      if (extent[n] < 0)
258
        extent[n] = 0;
259
    }
260
 
261
  if (retarray->data == NULL)
262
    {
263
      size_t alloc_size, str;
264
 
265
      for (n = 0; n < rank; n++)
266
        {
267
          if (n == 0)
268
            str = 1;
269
          else
270
            str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
271
 
272
          GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
273
 
274
        }
275
 
276
      alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
277
                   * extent[rank-1];
278
 
279
      retarray->offset = 0;
280
      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
281
 
282
      if (alloc_size == 0)
283
        {
284
          /* Make sure we have a zero-sized array.  */
285
          GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
286
          return;
287
        }
288
      else
289
        retarray->data = internal_malloc_size (alloc_size);
290
 
291
    }
292
  else
293
    {
294
      if (rank != GFC_DESCRIPTOR_RANK (retarray))
295
        runtime_error ("rank of return array incorrect in IALL intrinsic");
296
 
297
      if (unlikely (compile_options.bounds_check))
298
        {
299
          bounds_ifunction_return ((array_t *) retarray, extent,
300
                                   "return value", "IALL");
301
          bounds_equal_extents ((array_t *) mask, (array_t *) array,
302
                                "MASK argument", "IALL");
303
        }
304
    }
305
 
306
  for (n = 0; n < rank; n++)
307
    {
308
      count[n] = 0;
309
      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
310
      if (extent[n] <= 0)
311
        return;
312
    }
313
 
314
  dest = retarray->data;
315
  base = array->data;
316
 
317
  while (base)
318
    {
319
      const GFC_INTEGER_4 * restrict src;
320
      const GFC_LOGICAL_1 * restrict msrc;
321
      GFC_INTEGER_4 result;
322
      src = base;
323
      msrc = mbase;
324
      {
325
 
326
  result = 0;
327
        if (len <= 0)
328
          *dest = 0;
329
        else
330
          {
331
            for (n = 0; n < len; n++, src += delta, msrc += mdelta)
332
              {
333
 
334
  if (*msrc)
335
    result &= *src;
336
              }
337
            *dest = result;
338
          }
339
      }
340
      /* Advance to the next element.  */
341
      count[0]++;
342
      base += sstride[0];
343
      mbase += mstride[0];
344
      dest += dstride[0];
345
      n = 0;
346
      while (count[n] == extent[n])
347
        {
348
          /* When we get to the end of a dimension, reset it and increment
349
             the next dimension.  */
350
          count[n] = 0;
351
          /* We could precalculate these products, but this is a less
352
             frequently used path so probably not worth it.  */
353
          base -= sstride[n] * extent[n];
354
          mbase -= mstride[n] * extent[n];
355
          dest -= dstride[n] * extent[n];
356
          n++;
357
          if (n == rank)
358
            {
359
              /* Break out of the look.  */
360
              base = NULL;
361
              break;
362
            }
363
          else
364
            {
365
              count[n]++;
366
              base += sstride[n];
367
              mbase += mstride[n];
368
              dest += dstride[n];
369
            }
370
        }
371
    }
372
}
373
 
374
 
375
extern void siall_i4 (gfc_array_i4 * const restrict,
376
        gfc_array_i4 * const restrict, const index_type * const restrict,
377
        GFC_LOGICAL_4 *);
378
export_proto(siall_i4);
379
 
380
void
381
siall_i4 (gfc_array_i4 * const restrict retarray,
382
        gfc_array_i4 * const restrict array,
383
        const index_type * const restrict pdim,
384
        GFC_LOGICAL_4 * mask)
385
{
386
  index_type count[GFC_MAX_DIMENSIONS];
387
  index_type extent[GFC_MAX_DIMENSIONS];
388
  index_type dstride[GFC_MAX_DIMENSIONS];
389
  GFC_INTEGER_4 * restrict dest;
390
  index_type rank;
391
  index_type n;
392
  index_type dim;
393
 
394
 
395
  if (*mask)
396
    {
397
      iall_i4 (retarray, array, pdim);
398
      return;
399
    }
400
  /* Make dim zero based to avoid confusion.  */
401
  dim = (*pdim) - 1;
402
  rank = GFC_DESCRIPTOR_RANK (array) - 1;
403
 
404
  for (n = 0; n < dim; n++)
405
    {
406
      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
407
 
408
      if (extent[n] <= 0)
409
        extent[n] = 0;
410
    }
411
 
412
  for (n = dim; n < rank; n++)
413
    {
414
      extent[n] =
415
        GFC_DESCRIPTOR_EXTENT(array,n + 1);
416
 
417
      if (extent[n] <= 0)
418
        extent[n] = 0;
419
    }
420
 
421
  if (retarray->data == NULL)
422
    {
423
      size_t alloc_size, str;
424
 
425
      for (n = 0; n < rank; n++)
426
        {
427
          if (n == 0)
428
            str = 1;
429
          else
430
            str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
431
 
432
          GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
433
 
434
        }
435
 
436
      retarray->offset = 0;
437
      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
438
 
439
      alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
440
                   * extent[rank-1];
441
 
442
      if (alloc_size == 0)
443
        {
444
          /* Make sure we have a zero-sized array.  */
445
          GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
446
          return;
447
        }
448
      else
449
        retarray->data = internal_malloc_size (alloc_size);
450
    }
451
  else
452
    {
453
      if (rank != GFC_DESCRIPTOR_RANK (retarray))
454
        runtime_error ("rank of return array incorrect in"
455
                       " IALL intrinsic: is %ld, should be %ld",
456
                       (long int) (GFC_DESCRIPTOR_RANK (retarray)),
457
                       (long int) rank);
458
 
459
      if (unlikely (compile_options.bounds_check))
460
        {
461
          for (n=0; n < rank; n++)
462
            {
463
              index_type ret_extent;
464
 
465
              ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
466
              if (extent[n] != ret_extent)
467
                runtime_error ("Incorrect extent in return value of"
468
                               " IALL intrinsic in dimension %ld:"
469
                               " is %ld, should be %ld", (long int) n + 1,
470
                               (long int) ret_extent, (long int) extent[n]);
471
            }
472
        }
473
    }
474
 
475
  for (n = 0; n < rank; n++)
476
    {
477
      count[n] = 0;
478
      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
479
    }
480
 
481
  dest = retarray->data;
482
 
483
  while(1)
484
    {
485
      *dest = 0;
486
      count[0]++;
487
      dest += dstride[0];
488
      n = 0;
489
      while (count[n] == extent[n])
490
        {
491
          /* When we get to the end of a dimension, reset it and increment
492
             the next dimension.  */
493
          count[n] = 0;
494
          /* We could precalculate these products, but this is a less
495
             frequently used path so probably not worth it.  */
496
          dest -= dstride[n] * extent[n];
497
          n++;
498
          if (n == rank)
499
            return;
500
          else
501
            {
502
              count[n]++;
503
              dest += dstride[n];
504
            }
505
        }
506
    }
507
}
508
 
509
#endif

powered by: WebSVN 2.1.0

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