Mercurial > hg > CbC > CbC_gcc

comparison libgfortran/generated/maxloc1_4_s1.c @ 145:1830386684a0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc-9.2.0
author anatofuz
date Thu, 13 Feb 2020 11:34:05 +0900
parents 84e7813d76e9
children
comparison
equal deleted inserted replaced
131:84e7813d76e9 145:1830386684a0
1 /* Implementation of the MAXLOC intrinsic 1 /* Implementation of the MAXLOC intrinsic
2 Copyright (C) 2017-2018 Free Software Foundation, Inc. 2 Copyright (C) 2017-2020 Free Software Foundation, Inc.
3 Contributed by Thomas Koenig 3 Contributed by Thomas Koenig
4 4
5 This file is part of the GNU Fortran runtime library (libgfortran). 5 This file is part of the GNU Fortran runtime library (libgfortran).
6 6
7 Libgfortran is free software; you can redistribute it and/or 7 Libgfortran is free software; you can redistribute it and/or
24 <http://www.gnu.org/licenses/>. */ 24 <http://www.gnu.org/licenses/>. */
25 25
26 #include "libgfortran.h" 26 #include "libgfortran.h"
27 27
28 28
29 #if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_4) 29 #if defined (HAVE_GFC_UINTEGER_1) && defined (HAVE_GFC_INTEGER_4)
30 30
31 #define HAVE_BACK_ARG 1 31 #define HAVE_BACK_ARG 1
32 32
33 #include <string.h> 33 #include <string.h>
34 #include <assert.h> 34 #include <assert.h>
35 35
36 static inline int 36 static inline int
37 compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, gfc_charlen_type n) 37 compare_fcn (const GFC_UINTEGER_1 *a, const GFC_UINTEGER_1 *b, gfc_charlen_type n)
38 { 38 {
39 if (sizeof (GFC_INTEGER_1) == 1) 39 if (sizeof (GFC_UINTEGER_1) == 1)
40 return memcmp (a, b, n); 40 return memcmp (a, b, n);
41 else 41 else
42 return memcmp_char4 (a, b, n); 42 return memcmp_char4 (a, b, n);
43 } 43 }
44 44
55 { 55 {
56 index_type count[GFC_MAX_DIMENSIONS]; 56 index_type count[GFC_MAX_DIMENSIONS];
57 index_type extent[GFC_MAX_DIMENSIONS]; 57 index_type extent[GFC_MAX_DIMENSIONS];
58 index_type sstride[GFC_MAX_DIMENSIONS]; 58 index_type sstride[GFC_MAX_DIMENSIONS];
59 index_type dstride[GFC_MAX_DIMENSIONS]; 59 index_type dstride[GFC_MAX_DIMENSIONS];
60 const GFC_INTEGER_1 * restrict base; 60 const GFC_UINTEGER_1 * restrict base;
61 GFC_INTEGER_4 * restrict dest; 61 GFC_INTEGER_4 * restrict dest;
62 index_type rank; 62 index_type rank;
63 index_type n; 63 index_type n;
64 index_type len; 64 index_type len;
65 index_type delta; 65 index_type delta;
153 dest = retarray->base_addr; 153 dest = retarray->base_addr;
154 154
155 continue_loop = 1; 155 continue_loop = 1;
156 while (continue_loop) 156 while (continue_loop)
157 { 157 {
158 const GFC_INTEGER_1 * restrict src; 158 const GFC_UINTEGER_1 * restrict src;
159 GFC_INTEGER_4 result; 159 GFC_INTEGER_4 result;
160 src = base; 160 src = base;
161 { 161 {
162 162
163 const GFC_INTEGER_1 *maxval; 163 const GFC_UINTEGER_1 *maxval;
164 maxval = NULL; 164 maxval = NULL;
165 result = 0; 165 result = 0;
166 if (len <= 0) 166 if (len <= 0)
167 *dest = 0; 167 *dest = 0;
168 else 168 else
229 index_type extent[GFC_MAX_DIMENSIONS]; 229 index_type extent[GFC_MAX_DIMENSIONS];
230 index_type sstride[GFC_MAX_DIMENSIONS]; 230 index_type sstride[GFC_MAX_DIMENSIONS];
231 index_type dstride[GFC_MAX_DIMENSIONS]; 231 index_type dstride[GFC_MAX_DIMENSIONS];
232 index_type mstride[GFC_MAX_DIMENSIONS]; 232 index_type mstride[GFC_MAX_DIMENSIONS];
233 GFC_INTEGER_4 * restrict dest; 233 GFC_INTEGER_4 * restrict dest;
234 const GFC_INTEGER_1 * restrict base; 234 const GFC_UINTEGER_1 * restrict base;
235 const GFC_LOGICAL_1 * restrict mbase; 235 const GFC_LOGICAL_1 * restrict mbase;
236 index_type rank; 236 index_type rank;
237 index_type dim; 237 index_type dim;
238 index_type n; 238 index_type n;
239 index_type len; 239 index_type len;
240 index_type delta; 240 index_type delta;
241 index_type mdelta; 241 index_type mdelta;
242 int mask_kind; 242 int mask_kind;
243 243
244 if (mask == NULL)
245 {
246 #ifdef HAVE_BACK_ARG
247 maxloc1_4_s1 (retarray, array, pdim, back, string_len);
248 #else
249 maxloc1_4_s1 (retarray, array, pdim, string_len);
250 #endif
251 return;
252 }
253
244 dim = (*pdim) - 1; 254 dim = (*pdim) - 1;
245 rank = GFC_DESCRIPTOR_RANK (array) - 1; 255 rank = GFC_DESCRIPTOR_RANK (array) - 1;
246 256
247 257
248 if (unlikely (dim < 0 || dim > rank)) 258 if (unlikely (dim < 0 || dim > rank))
347 dest = retarray->base_addr; 357 dest = retarray->base_addr;
348 base = array->base_addr; 358 base = array->base_addr;
349 359
350 while (base) 360 while (base)
351 { 361 {
352 const GFC_INTEGER_1 * restrict src; 362 const GFC_UINTEGER_1 * restrict src;
353 const GFC_LOGICAL_1 * restrict msrc; 363 const GFC_LOGICAL_1 * restrict msrc;
354 GFC_INTEGER_4 result; 364 GFC_INTEGER_4 result;
355 src = base; 365 src = base;
356 msrc = mbase; 366 msrc = mbase;
357 { 367 {
358 368
359 const GFC_INTEGER_1 *maxval; 369 const GFC_UINTEGER_1 *maxval;
360 maxval = base; 370 maxval = base;
361 result = 0; 371 result = 0;
362 for (n = 0; n < len; n++, src += delta, msrc += mdelta) 372 for (n = 0; n < len; n++, src += delta, msrc += mdelta)
363 { 373 {
364 374
434 index_type rank; 444 index_type rank;
435 index_type n; 445 index_type n;
436 index_type dim; 446 index_type dim;
437 447
438 448
439 if (*mask) 449 if (mask == NULL || *mask)
440 { 450 {
441 #ifdef HAVE_BACK_ARG 451 #ifdef HAVE_BACK_ARG
442 maxloc1_4_s1 (retarray, array, pdim, back, string_len); 452 maxloc1_4_s1 (retarray, array, pdim, back, string_len);
443 #else 453 #else
444 maxloc1_4_s1 (retarray, array, pdim, string_len); 454 maxloc1_4_s1 (retarray, array, pdim, string_len);