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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

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