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

Subversion Repositories openrisc

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

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

Line No. Rev Author Line
1 733 jeremybenn 
/* Implementation of the MINLOC 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 minloc0_4_r4 (gfc_array_i4 * const restrict retarray,
36 
        gfc_array_r4 * const restrict array);
37 
export_proto(minloc0_4_r4);
38 
 
39 
void
40 
minloc0_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 
                                "MINLOC");
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 minval;
94 
#if defined(GFC_REAL_4_QUIET_NAN)
95 
    int fast = 0;
96 
#endif
97 
 
98 
#if defined(GFC_REAL_4_INFINITY)
99 
    minval = GFC_REAL_4_INFINITY;
100 
#else
101 
    minval = 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 <= minval)
117 
                {
118 
                  fast = 1;
119 
                  minval = *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 < minval)
134 
            {
135 
              minval = *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 mminloc0_4_r4 (gfc_array_i4 * const restrict,
173 
        gfc_array_r4 * const restrict, gfc_array_l1 * const restrict);
174 
export_proto(mminloc0_4_r4);
175 
 
176 
void
177 
mminloc0_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 
                                  "MINLOC");
211 
          bounds_equal_extents ((array_t *) mask, (array_t *) array,
212 
                                  "MASK argument", "MINLOC");
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 minval;
254 
   int fast = 0;
255 
 
256 
#if defined(GFC_REAL_4_INFINITY)
257 
    minval = GFC_REAL_4_INFINITY;
258 
#else
259 
    minval = 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 <= minval)
280 
#endif
281 
                    {
282 
                      fast = 1;
283 
                      minval = *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 < minval)
299 
            {
300 
              minval = *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 sminloc0_4_r4 (gfc_array_i4 * const restrict,
341 
        gfc_array_r4 * const restrict, GFC_LOGICAL_4 *);
342 
export_proto(sminloc0_4_r4);
343 
 
344 
void
345 
sminloc0_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 
      minloc0_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 
                               "MINLOC");
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.