Mercurial > hg > CbC > CbC_gcc

comparison libgfortran/generated/maxloc0_8_s4.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
28 #include <string.h> 28 #include <string.h>
29 #include <assert.h> 29 #include <assert.h>
30 #include <limits.h> 30 #include <limits.h>
31 31
32 32
33 #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_8) 33 #if defined (HAVE_GFC_UINTEGER_4) && defined (HAVE_GFC_INTEGER_8)
34 34
35 #define HAVE_BACK_ARG 1 35 #define HAVE_BACK_ARG 1
36 36
37 static inline int 37 static inline int
38 compare_fcn (const GFC_INTEGER_4 *a, const GFC_INTEGER_4 *b, gfc_charlen_type n) 38 compare_fcn (const GFC_UINTEGER_4 *a, const GFC_UINTEGER_4 *b, gfc_charlen_type n)
39 { 39 {
40 if (sizeof (GFC_INTEGER_4) == 1) 40 if (sizeof (GFC_UINTEGER_4) == 1)
41 return memcmp (a, b, n); 41 return memcmp (a, b, n);
42 else 42 else
43 return memcmp_char4 (a, b, n); 43 return memcmp_char4 (a, b, n);
44 44
45 } 45 }
54 { 54 {
55 index_type count[GFC_MAX_DIMENSIONS]; 55 index_type count[GFC_MAX_DIMENSIONS];
56 index_type extent[GFC_MAX_DIMENSIONS]; 56 index_type extent[GFC_MAX_DIMENSIONS];
57 index_type sstride[GFC_MAX_DIMENSIONS]; 57 index_type sstride[GFC_MAX_DIMENSIONS];
58 index_type dstride; 58 index_type dstride;
59 const GFC_INTEGER_4 *base; 59 const GFC_UINTEGER_4 *base;
60 GFC_INTEGER_8 * restrict dest; 60 GFC_INTEGER_8 * restrict dest;
61 index_type rank; 61 index_type rank;
62 index_type n; 62 index_type n;
63 63
64 rank = GFC_DESCRIPTOR_RANK (array); 64 rank = GFC_DESCRIPTOR_RANK (array);
100 /* Initialize the return value. */ 100 /* Initialize the return value. */
101 for (n = 0; n < rank; n++) 101 for (n = 0; n < rank; n++)
102 dest[n * dstride] = 1; 102 dest[n * dstride] = 1;
103 { 103 {
104 104
105 const GFC_INTEGER_4 *maxval; 105 const GFC_UINTEGER_4 *maxval;
106 maxval = NULL; 106 maxval = NULL;
107 107
108 while (base) 108 while (base)
109 { 109 {
110 do 110 do
166 index_type extent[GFC_MAX_DIMENSIONS]; 166 index_type extent[GFC_MAX_DIMENSIONS];
167 index_type sstride[GFC_MAX_DIMENSIONS]; 167 index_type sstride[GFC_MAX_DIMENSIONS];
168 index_type mstride[GFC_MAX_DIMENSIONS]; 168 index_type mstride[GFC_MAX_DIMENSIONS];
169 index_type dstride; 169 index_type dstride;
170 GFC_INTEGER_8 *dest; 170 GFC_INTEGER_8 *dest;
171 const GFC_INTEGER_4 *base; 171 const GFC_UINTEGER_4 *base;
172 GFC_LOGICAL_1 *mbase; 172 GFC_LOGICAL_1 *mbase;
173 int rank; 173 int rank;
174 index_type n; 174 index_type n;
175 int mask_kind; 175 int mask_kind;
176
177 if (mask == NULL)
178 {
179 #ifdef HAVE_BACK_ARG
180 maxloc0_8_s4 (retarray, array, back, len);
181 #else
182 maxloc0_8_s4 (retarray, array, len);
183 #endif
184 return;
185 }
176 186
177 rank = GFC_DESCRIPTOR_RANK (array); 187 rank = GFC_DESCRIPTOR_RANK (array);
178 if (rank <= 0) 188 if (rank <= 0)
179 runtime_error ("Rank of array needs to be > 0"); 189 runtime_error ("Rank of array needs to be > 0");
180 190
232 /* Initialize the return value. */ 242 /* Initialize the return value. */
233 for (n = 0; n < rank; n++) 243 for (n = 0; n < rank; n++)
234 dest[n * dstride] = 0; 244 dest[n * dstride] = 0;
235 { 245 {
236 246
237 const GFC_INTEGER_4 *maxval; 247 const GFC_UINTEGER_4 *maxval;
238 248
239 maxval = NULL; 249 maxval = NULL;
240 250
241 while (base) 251 while (base)
242 { 252 {
302 index_type rank; 312 index_type rank;
303 index_type dstride; 313 index_type dstride;
304 index_type n; 314 index_type n;
305 GFC_INTEGER_8 *dest; 315 GFC_INTEGER_8 *dest;
306 316
307 if (*mask) 317 if (mask == NULL || *mask)
308 { 318 {
309 #ifdef HAVE_BACK_ARG 319 #ifdef HAVE_BACK_ARG
310 maxloc0_8_s4 (retarray, array, back, len); 320 maxloc0_8_s4 (retarray, array, back, len);
311 #else 321 #else
312 maxloc0_8_s4 (retarray, array, len); 322 maxloc0_8_s4 (retarray, array, len);