]>
git.ipfire.org Git - thirdparty/gcc.git/blob - libgfortran/generated/minval_i8.c
1 /* Implementation of the MINVAL intrinsic
2 Copyright 2002 Free Software Foundation, Inc.
3 Contributed by Paul Brook <paul@nowt.org>
5 This file is part of the GNU Fortran 95 runtime library (libgfortran).
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.
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
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.
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., 51 Franklin Street, Fifth Floor,
29 Boston, MA 02110-1301, USA. */
35 #include "libgfortran.h"
38 #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8)
41 extern void minval_i8 (gfc_array_i8
*, gfc_array_i8
*, index_type
*);
42 export_proto(minval_i8
);
45 minval_i8 (gfc_array_i8
*retarray
, gfc_array_i8
*array
, index_type
*pdim
)
47 index_type count
[GFC_MAX_DIMENSIONS
];
48 index_type extent
[GFC_MAX_DIMENSIONS
];
49 index_type sstride
[GFC_MAX_DIMENSIONS
];
50 index_type dstride
[GFC_MAX_DIMENSIONS
];
59 /* Make dim zero based to avoid confusion. */
61 rank
= GFC_DESCRIPTOR_RANK (array
) - 1;
63 /* TODO: It should be a front end job to correctly set the strides. */
65 if (array
->dim
[0].stride
== 0)
66 array
->dim
[0].stride
= 1;
68 len
= array
->dim
[dim
].ubound
+ 1 - array
->dim
[dim
].lbound
;
69 delta
= array
->dim
[dim
].stride
;
71 for (n
= 0; n
< dim
; n
++)
73 sstride
[n
] = array
->dim
[n
].stride
;
74 extent
[n
] = array
->dim
[n
].ubound
+ 1 - array
->dim
[n
].lbound
;
76 for (n
= dim
; n
< rank
; n
++)
78 sstride
[n
] = array
->dim
[n
+ 1].stride
;
80 array
->dim
[n
+ 1].ubound
+ 1 - array
->dim
[n
+ 1].lbound
;
83 if (retarray
->data
== NULL
)
85 for (n
= 0; n
< rank
; n
++)
87 retarray
->dim
[n
].lbound
= 0;
88 retarray
->dim
[n
].ubound
= extent
[n
]-1;
90 retarray
->dim
[n
].stride
= 1;
92 retarray
->dim
[n
].stride
= retarray
->dim
[n
-1].stride
* extent
[n
-1];
96 = internal_malloc_size (sizeof (GFC_INTEGER_8
)
97 * retarray
->dim
[rank
-1].stride
100 retarray
->dtype
= (array
->dtype
& ~GFC_DTYPE_RANK_MASK
) | rank
;
104 if (retarray
->dim
[0].stride
== 0)
105 retarray
->dim
[0].stride
= 1;
107 if (rank
!= GFC_DESCRIPTOR_RANK (retarray
))
108 runtime_error ("rank of return array incorrect");
111 for (n
= 0; n
< rank
; n
++)
114 dstride
[n
] = retarray
->dim
[n
].stride
;
120 dest
= retarray
->data
;
125 GFC_INTEGER_8 result
;
129 result
= GFC_INTEGER_8_HUGE
;
131 *dest
= GFC_INTEGER_8_HUGE
;
134 for (n
= 0; n
< len
; n
++, src
+= delta
)
143 /* Advance to the next element. */
148 while (count
[n
] == extent
[n
])
150 /* When we get to the end of a dimension, reset it and increment
151 the next dimension. */
153 /* We could precalculate these products, but this is a less
154 frequently used path so proabably not worth it. */
155 base
-= sstride
[n
] * extent
[n
];
156 dest
-= dstride
[n
] * extent
[n
];
160 /* Break out of the look. */
175 extern void mminval_i8 (gfc_array_i8
*, gfc_array_i8
*, index_type
*,
177 export_proto(mminval_i8
);
180 mminval_i8 (gfc_array_i8
* retarray
, gfc_array_i8
* array
,
181 index_type
*pdim
, gfc_array_l4
* mask
)
183 index_type count
[GFC_MAX_DIMENSIONS
];
184 index_type extent
[GFC_MAX_DIMENSIONS
];
185 index_type sstride
[GFC_MAX_DIMENSIONS
];
186 index_type dstride
[GFC_MAX_DIMENSIONS
];
187 index_type mstride
[GFC_MAX_DIMENSIONS
];
190 GFC_LOGICAL_4
*mbase
;
199 rank
= GFC_DESCRIPTOR_RANK (array
) - 1;
201 /* TODO: It should be a front end job to correctly set the strides. */
203 if (array
->dim
[0].stride
== 0)
204 array
->dim
[0].stride
= 1;
206 if (mask
->dim
[0].stride
== 0)
207 mask
->dim
[0].stride
= 1;
209 len
= array
->dim
[dim
].ubound
+ 1 - array
->dim
[dim
].lbound
;
212 delta
= array
->dim
[dim
].stride
;
213 mdelta
= mask
->dim
[dim
].stride
;
215 for (n
= 0; n
< dim
; n
++)
217 sstride
[n
] = array
->dim
[n
].stride
;
218 mstride
[n
] = mask
->dim
[n
].stride
;
219 extent
[n
] = array
->dim
[n
].ubound
+ 1 - array
->dim
[n
].lbound
;
221 for (n
= dim
; n
< rank
; n
++)
223 sstride
[n
] = array
->dim
[n
+ 1].stride
;
224 mstride
[n
] = mask
->dim
[n
+ 1].stride
;
226 array
->dim
[n
+ 1].ubound
+ 1 - array
->dim
[n
+ 1].lbound
;
229 if (retarray
->data
== NULL
)
231 for (n
= 0; n
< rank
; n
++)
233 retarray
->dim
[n
].lbound
= 0;
234 retarray
->dim
[n
].ubound
= extent
[n
]-1;
236 retarray
->dim
[n
].stride
= 1;
238 retarray
->dim
[n
].stride
= retarray
->dim
[n
-1].stride
* extent
[n
-1];
242 = internal_malloc_size (sizeof (GFC_INTEGER_8
)
243 * retarray
->dim
[rank
-1].stride
245 retarray
->offset
= 0;
246 retarray
->dtype
= (array
->dtype
& ~GFC_DTYPE_RANK_MASK
) | rank
;
250 if (retarray
->dim
[0].stride
== 0)
251 retarray
->dim
[0].stride
= 1;
253 if (rank
!= GFC_DESCRIPTOR_RANK (retarray
))
254 runtime_error ("rank of return array incorrect");
257 for (n
= 0; n
< rank
; n
++)
260 dstride
[n
] = retarray
->dim
[n
].stride
;
265 dest
= retarray
->data
;
269 if (GFC_DESCRIPTOR_SIZE (mask
) != 4)
271 /* This allows the same loop to be used for all logical types. */
272 assert (GFC_DESCRIPTOR_SIZE (mask
) == 8);
273 for (n
= 0; n
< rank
; n
++)
276 mbase
= (GFOR_POINTER_L8_TO_L4 (mbase
));
283 GFC_INTEGER_8 result
;
288 result
= GFC_INTEGER_8_HUGE
;
290 *dest
= GFC_INTEGER_8_HUGE
;
293 for (n
= 0; n
< len
; n
++, src
+= delta
, msrc
+= mdelta
)
296 if (*msrc
&& *src
< result
)
302 /* Advance to the next element. */
308 while (count
[n
] == extent
[n
])
310 /* When we get to the end of a dimension, reset it and increment
311 the next dimension. */
313 /* We could precalculate these products, but this is a less
314 frequently used path so proabably not worth it. */
315 base
-= sstride
[n
] * extent
[n
];
316 mbase
-= mstride
[n
] * extent
[n
];
317 dest
-= dstride
[n
] * extent
[n
];
321 /* Break out of the look. */