]> git.ipfire.org Git - thirdparty/gcc.git/blame - libgfortran/generated/minloc0_4_i8.c
lcm.c (optimize_mode_switching): Free ptr even when mode_set is NULL_RTX.
[thirdparty/gcc.git] / libgfortran / generated / minloc0_4_i8.c
CommitLineData
6de9cd9a
DN
1/* Implementation of the MINLOC intrinsic
2 Copyright 2002 Free Software Foundation, Inc.
3 Contributed by Paul Brook <paul@nowt.org>
4
5This file is part of the GNU Fortran 95 runtime library (libgfor).
6
7Libgfortran is free software; you can redistribute it and/or
8modify it under the terms of the GNU Lesser General Public
9License as published by the Free Software Foundation; either
10version 2.1 of the License, or (at your option) any later version.
11
12Libgfortran is distributed in the hope that it will be useful,
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15GNU Lesser General Public License for more details.
16
17You should have received a copy of the GNU Lesser General Public
18License along with libgfor; see the file COPYING.LIB. If not,
19write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20Boston, MA 02111-1307, USA. */
21
22#include "config.h"
23#include <stdlib.h>
24#include <assert.h>
25#include <float.h>
26#include <limits.h>
27#include "libgfortran.h"
28
29
6de9cd9a
DN
30void
31__minloc0_4_i8 (gfc_array_i4 * retarray, gfc_array_i8 *array)
32{
33 index_type count[GFC_MAX_DIMENSIONS];
34 index_type extent[GFC_MAX_DIMENSIONS];
35 index_type sstride[GFC_MAX_DIMENSIONS];
36 index_type dstride;
37 GFC_INTEGER_8 *base;
38 GFC_INTEGER_4 *dest;
39 index_type rank;
40 index_type n;
41
42 rank = GFC_DESCRIPTOR_RANK (array);
43 assert (rank > 0);
44 assert (GFC_DESCRIPTOR_RANK (retarray) == 1);
45 assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank);
46 if (array->dim[0].stride == 0)
47 array->dim[0].stride = 1;
48 if (retarray->dim[0].stride == 0)
49 retarray->dim[0].stride = 1;
50
51 dstride = retarray->dim[0].stride;
52 dest = retarray->data;
53 for (n = 0; n < rank; n++)
54 {
55 sstride[n] = array->dim[n].stride;
56 extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
57 count[n] = 0;
58 if (extent[n] <= 0)
59 {
60 /* Set the return value. */
61 for (n = 0; n < rank; n++)
62 dest[n * dstride] = 0;
63 return;
64 }
65 }
66
67 base = array->data;
68
69 /* Initialize the return value. */
70 for (n = 0; n < rank; n++)
71 dest[n * dstride] = 1;
72 {
73
74 GFC_INTEGER_8 minval;
75
76 minval = GFC_INTEGER_8_HUGE;
77
78 while (base)
79 {
80 {
81 /* Implementation start. */
82
83 if (*base < minval)
84 {
85 minval = *base;
86 for (n = 0; n < rank; n++)
87 dest[n * dstride] = count[n] + 1;
88 }
89 /* Implementation end. */
90 }
91 /* Advance to the next element. */
92 count[0]++;
93 base += sstride[0];
94 n = 0;
95 while (count[n] == extent[n])
96 {
97 /* When we get to the end of a dimension, reset it and increment
98 the next dimension. */
99 count[n] = 0;
100 /* We could precalculate these products, but this is a less
101 frequently used path so proabably not worth it. */
102 base -= sstride[n] * extent[n];
103 n++;
104 if (n == rank)
105 {
106 /* Break out of the loop. */
107 base = NULL;
108 break;
109 }
110 else
111 {
112 count[n]++;
113 base += sstride[n];
114 }
115 }
116 }
117 }
118}
119
120void
121__mminloc0_4_i8 (gfc_array_i4 * retarray, gfc_array_i8 *array, gfc_array_l4 * mask)
122{
123 index_type count[GFC_MAX_DIMENSIONS];
124 index_type extent[GFC_MAX_DIMENSIONS];
125 index_type sstride[GFC_MAX_DIMENSIONS];
126 index_type mstride[GFC_MAX_DIMENSIONS];
127 index_type dstride;
128 GFC_INTEGER_4 *dest;
129 GFC_INTEGER_8 *base;
130 GFC_LOGICAL_4 *mbase;
131 int rank;
132 index_type n;
133
134 rank = GFC_DESCRIPTOR_RANK (array);
135 assert (rank > 0);
136 assert (GFC_DESCRIPTOR_RANK (retarray) == 1);
137 assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank);
138 assert (GFC_DESCRIPTOR_RANK (mask) == rank);
139
140 if (array->dim[0].stride == 0)
141 array->dim[0].stride = 1;
142 if (retarray->dim[0].stride == 0)
143 retarray->dim[0].stride = 1;
144 if (retarray->dim[0].stride == 0)
145 retarray->dim[0].stride = 1;
146
147 dstride = retarray->dim[0].stride;
148 dest = retarray->data;
149 for (n = 0; n < rank; n++)
150 {
151 sstride[n] = array->dim[n].stride;
152 mstride[n] = mask->dim[n].stride;
153 extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
154 count[n] = 0;
155 if (extent[n] <= 0)
156 {
157 /* Set the return value. */
158 for (n = 0; n < rank; n++)
159 dest[n * dstride] = 0;
160 return;
161 }
162 }
163
164 base = array->data;
165 mbase = mask->data;
166
167 if (GFC_DESCRIPTOR_SIZE (mask) != 4)
168 {
169 /* This allows the same loop to be used for all logical types. */
170 assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
171 for (n = 0; n < rank; n++)
172 mstride[n] <<= 1;
173 mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
174 }
175
176
177 /* Initialize the return value. */
178 for (n = 0; n < rank; n++)
179 dest[n * dstride] = 1;
180 {
181
182 GFC_INTEGER_8 minval;
183
184 minval = GFC_INTEGER_8_HUGE;
185
186 while (base)
187 {
188 {
189 /* Implementation start. */
190
191 if (*mbase && *base < minval)
192 {
193 minval = *base;
194 for (n = 0; n < rank; n++)
195 dest[n * dstride] = count[n] + 1;
196 }
197 /* Implementation end. */
198 }
199 /* Advance to the next element. */
200 count[0]++;
201 base += sstride[0];
202 mbase += mstride[0];
203 n = 0;
204 while (count[n] == extent[n])
205 {
206 /* When we get to the end of a dimension, reset it and increment
207 the next dimension. */
208 count[n] = 0;
209 /* We could precalculate these products, but this is a less
210 frequently used path so proabably not worth it. */
211 base -= sstride[n] * extent[n];
212 mbase -= mstride[n] * extent[n];
213 n++;
214 if (n == rank)
215 {
216 /* Break out of the loop. */
217 base = NULL;
218 break;
219 }
220 else
221 {
222 count[n]++;
223 base += sstride[n];
224 mbase += mstride[n];
225 }
226 }
227 }
228 }
229}