OSDN Git Service

d0a8a5ea4ad77b7fc55b7af0d32e47f36efadaf8
[pf3gnuchains/gcc-fork.git] / libgfortran / generated / minval_i4.c
1 /* Implementation of the MINVAL intrinsic
2    Copyright 2002 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 2 of the License, or (at your option) any later version.
11
12 In addition to the permissions in the GNU General Public License, the
13 Free Software Foundation gives you unlimited permission to link the
14 compiled version of this file into combinations with other programs,
15 and to distribute those combinations without any restriction coming
16 from the use of this file.  (The General Public License restrictions
17 do apply in other respects; for example, they cover modification of
18 the file, and distribution when not linked into a combine
19 executable.)
20
21 Libgfortran is distributed in the hope that it will be useful,
22 but WITHOUT ANY WARRANTY; without even the implied warranty of
23 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
24 GNU General Public License for more details.
25
26 You should have received a copy of the GNU General Public
27 License along with libgfortran; see the file COPYING.  If not,
28 write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
29 Boston, MA 02111-1307, USA.  */
30
31 #include "config.h"
32 #include <stdlib.h>
33 #include <assert.h>
34 #include <float.h>
35 #include "libgfortran.h"
36
37
38 extern void minval_i4 (gfc_array_i4 *, gfc_array_i4 *, index_type *);
39 export_proto(minval_i4);
40
41 void
42 minval_i4 (gfc_array_i4 *retarray, gfc_array_i4 *array, index_type *pdim)
43 {
44   index_type count[GFC_MAX_DIMENSIONS - 1];
45   index_type extent[GFC_MAX_DIMENSIONS - 1];
46   index_type sstride[GFC_MAX_DIMENSIONS - 1];
47   index_type dstride[GFC_MAX_DIMENSIONS - 1];
48   GFC_INTEGER_4 *base;
49   GFC_INTEGER_4 *dest;
50   index_type rank;
51   index_type n;
52   index_type len;
53   index_type delta;
54   index_type dim;
55
56   /* Make dim zero based to avoid confusion.  */
57   dim = (*pdim) - 1;
58   rank = GFC_DESCRIPTOR_RANK (array) - 1;
59   if (array->dim[0].stride == 0)
60     array->dim[0].stride = 1;
61
62   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
63   delta = array->dim[dim].stride;
64
65   for (n = 0; n < dim; n++)
66     {
67       sstride[n] = array->dim[n].stride;
68       extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
69     }
70   for (n = dim; n < rank; n++)
71     {
72       sstride[n] = array->dim[n + 1].stride;
73       extent[n] =
74         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
75     }
76
77   if (retarray->data == NULL)
78     {
79       for (n = 0; n < rank; n++)
80         {
81           retarray->dim[n].lbound = 0;
82           retarray->dim[n].ubound = extent[n]-1;
83           if (n == 0)
84             retarray->dim[n].stride = 1;
85           else
86             retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
87         }
88
89       retarray->data
90          = internal_malloc_size (sizeof (GFC_INTEGER_4)
91                                  * retarray->dim[rank-1].stride
92                                  * extent[rank-1]);
93       retarray->base = 0;
94       retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
95     }
96   else
97     {
98       if (retarray->dim[0].stride == 0)
99         retarray->dim[0].stride = 1;
100
101       if (rank != GFC_DESCRIPTOR_RANK (retarray))
102         runtime_error ("rank of return array incorrect");
103     }
104
105   for (n = 0; n < rank; n++)
106     {
107       count[n] = 0;
108       dstride[n] = retarray->dim[n].stride;
109       if (extent[n] <= 0)
110         len = 0;
111     }
112
113   base = array->data;
114   dest = retarray->data;
115
116   while (base)
117     {
118       GFC_INTEGER_4 *src;
119       GFC_INTEGER_4 result;
120       src = base;
121       {
122
123   result = GFC_INTEGER_4_HUGE;
124         if (len <= 0)
125           *dest = GFC_INTEGER_4_HUGE;
126         else
127           {
128             for (n = 0; n < len; n++, src += delta)
129               {
130
131   if (*src < result)
132     result = *src;
133           }
134             *dest = result;
135           }
136       }
137       /* Advance to the next element.  */
138       count[0]++;
139       base += sstride[0];
140       dest += dstride[0];
141       n = 0;
142       while (count[n] == extent[n])
143         {
144           /* When we get to the end of a dimension, reset it and increment
145              the next dimension.  */
146           count[n] = 0;
147           /* We could precalculate these products, but this is a less
148              frequently used path so proabably not worth it.  */
149           base -= sstride[n] * extent[n];
150           dest -= dstride[n] * extent[n];
151           n++;
152           if (n == rank)
153             {
154               /* Break out of the look.  */
155               base = NULL;
156               break;
157             }
158           else
159             {
160               count[n]++;
161               base += sstride[n];
162               dest += dstride[n];
163             }
164         }
165     }
166 }
167
168
169 extern void mminval_i4 (gfc_array_i4 *, gfc_array_i4 *, index_type *,
170                                                gfc_array_l4 *);
171 export_proto(mminval_i4);
172
173 void
174 mminval_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array,
175                                   index_type *pdim, gfc_array_l4 * mask)
176 {
177   index_type count[GFC_MAX_DIMENSIONS - 1];
178   index_type extent[GFC_MAX_DIMENSIONS - 1];
179   index_type sstride[GFC_MAX_DIMENSIONS - 1];
180   index_type dstride[GFC_MAX_DIMENSIONS - 1];
181   index_type mstride[GFC_MAX_DIMENSIONS - 1];
182   GFC_INTEGER_4 *dest;
183   GFC_INTEGER_4 *base;
184   GFC_LOGICAL_4 *mbase;
185   int rank;
186   int dim;
187   index_type n;
188   index_type len;
189   index_type delta;
190   index_type mdelta;
191
192   dim = (*pdim) - 1;
193   rank = GFC_DESCRIPTOR_RANK (array) - 1;
194   if (array->dim[0].stride == 0)
195     array->dim[0].stride = 1;
196
197   if (mask->dim[0].stride == 0)
198     mask->dim[0].stride = 1;
199
200   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
201   if (len <= 0)
202     return;
203   delta = array->dim[dim].stride;
204   mdelta = mask->dim[dim].stride;
205
206   for (n = 0; n < dim; n++)
207     {
208       sstride[n] = array->dim[n].stride;
209       mstride[n] = mask->dim[n].stride;
210       extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
211     }
212   for (n = dim; n < rank; n++)
213     {
214       sstride[n] = array->dim[n + 1].stride;
215       mstride[n] = mask->dim[n + 1].stride;
216       extent[n] =
217         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
218     }
219
220   if (retarray->data == NULL)
221     {
222       for (n = 0; n < rank; n++)
223         {
224           retarray->dim[n].lbound = 0;
225           retarray->dim[n].ubound = extent[n]-1;
226           if (n == 0)
227             retarray->dim[n].stride = 1;
228           else
229             retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
230         }
231
232       retarray->data
233          = internal_malloc_size (sizeof (GFC_INTEGER_4)
234                                  * retarray->dim[rank-1].stride
235                                  * extent[rank-1]);
236       retarray->base = 0;
237       retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
238     }
239   else
240     {
241       if (retarray->dim[0].stride == 0)
242         retarray->dim[0].stride = 1;
243
244       if (rank != GFC_DESCRIPTOR_RANK (retarray))
245         runtime_error ("rank of return array incorrect");
246     }
247
248   for (n = 0; n < rank; n++)
249     {
250       count[n] = 0;
251       dstride[n] = retarray->dim[n].stride;
252       if (extent[n] <= 0)
253         return;
254     }
255
256   dest = retarray->data;
257   base = array->data;
258   mbase = mask->data;
259
260   if (GFC_DESCRIPTOR_SIZE (mask) != 4)
261     {
262       /* This allows the same loop to be used for all logical types.  */
263       assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
264       for (n = 0; n < rank; n++)
265         mstride[n] <<= 1;
266       mdelta <<= 1;
267       mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
268     }
269
270   while (base)
271     {
272       GFC_INTEGER_4 *src;
273       GFC_LOGICAL_4 *msrc;
274       GFC_INTEGER_4 result;
275       src = base;
276       msrc = mbase;
277       {
278
279   result = GFC_INTEGER_4_HUGE;
280         if (len <= 0)
281           *dest = GFC_INTEGER_4_HUGE;
282         else
283           {
284             for (n = 0; n < len; n++, src += delta, msrc += mdelta)
285               {
286
287   if (*msrc && *src < result)
288     result = *src;
289               }
290             *dest = result;
291           }
292       }
293       /* Advance to the next element.  */
294       count[0]++;
295       base += sstride[0];
296       mbase += mstride[0];
297       dest += dstride[0];
298       n = 0;
299       while (count[n] == extent[n])
300         {
301           /* When we get to the end of a dimension, reset it and increment
302              the next dimension.  */
303           count[n] = 0;
304           /* We could precalculate these products, but this is a less
305              frequently used path so proabably not worth it.  */
306           base -= sstride[n] * extent[n];
307           mbase -= mstride[n] * extent[n];
308           dest -= dstride[n] * extent[n];
309           n++;
310           if (n == rank)
311             {
312               /* Break out of the look.  */
313               base = NULL;
314               break;
315             }
316           else
317             {
318               count[n]++;
319               base += sstride[n];
320               mbase += mstride[n];
321               dest += dstride[n];
322             }
323         }
324     }
325 }
326