Mercurial > hg > CbC > CbC_gcc
comparison libgfortran/generated/maxval0_s1.c @ 145:1830386684a0
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_1) && defined (HAVE_GFC_INTEGER_1) | 33 #if defined (HAVE_GFC_UINTEGER_1) && defined (HAVE_GFC_UINTEGER_1) |
34 | 34 |
35 static inline int | 35 static inline int |
36 compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, gfc_charlen_type n) | 36 compare_fcn (const GFC_UINTEGER_1 *a, const GFC_UINTEGER_1 *b, gfc_charlen_type n) |
37 { | 37 { |
38 if (sizeof (GFC_INTEGER_1) == 1) | 38 if (sizeof (GFC_UINTEGER_1) == 1) |
39 return memcmp (a, b, n); | 39 return memcmp (a, b, n); |
40 else | 40 else |
41 return memcmp_char4 (a, b, n); | 41 return memcmp_char4 (a, b, n); |
42 | 42 |
43 } | 43 } |
44 | 44 |
45 #define INITVAL 0 | 45 #define INITVAL 0 |
46 | 46 |
47 extern void maxval0_s1 (GFC_INTEGER_1 * restrict, | 47 extern void maxval0_s1 (GFC_UINTEGER_1 * restrict, |
48 gfc_charlen_type, | 48 gfc_charlen_type, |
49 gfc_array_s1 * const restrict array, gfc_charlen_type); | 49 gfc_array_s1 * const restrict array, gfc_charlen_type); |
50 export_proto(maxval0_s1); | 50 export_proto(maxval0_s1); |
51 | 51 |
52 void | 52 void |
53 maxval0_s1 (GFC_INTEGER_1 * restrict ret, | 53 maxval0_s1 (GFC_UINTEGER_1 * restrict ret, |
54 gfc_charlen_type xlen, | 54 gfc_charlen_type xlen, |
55 gfc_array_s1 * const restrict array, gfc_charlen_type len) | 55 gfc_array_s1 * const restrict array, gfc_charlen_type len) |
56 { | 56 { |
57 index_type count[GFC_MAX_DIMENSIONS]; | 57 index_type count[GFC_MAX_DIMENSIONS]; |
58 index_type extent[GFC_MAX_DIMENSIONS]; | 58 index_type extent[GFC_MAX_DIMENSIONS]; |
59 index_type sstride[GFC_MAX_DIMENSIONS]; | 59 index_type sstride[GFC_MAX_DIMENSIONS]; |
60 const GFC_INTEGER_1 *base; | 60 const GFC_UINTEGER_1 *base; |
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); |
65 if (rank <= 0) | 65 if (rank <= 0) |
81 | 81 |
82 base = array->base_addr; | 82 base = array->base_addr; |
83 | 83 |
84 { | 84 { |
85 | 85 |
86 const GFC_INTEGER_1 *retval; | 86 const GFC_UINTEGER_1 *retval; |
87 retval = ret; | 87 retval = ret; |
88 | 88 |
89 while (base) | 89 while (base) |
90 { | 90 { |
91 do | 91 do |
128 memcpy (ret, retval, len * sizeof (*ret)); | 128 memcpy (ret, retval, len * sizeof (*ret)); |
129 } | 129 } |
130 } | 130 } |
131 | 131 |
132 | 132 |
133 extern void mmaxval0_s1 (GFC_INTEGER_1 * restrict, | 133 extern void mmaxval0_s1 (GFC_UINTEGER_1 * restrict, |
134 gfc_charlen_type, gfc_array_s1 * const restrict array, | 134 gfc_charlen_type, gfc_array_s1 * const restrict array, |
135 gfc_array_l1 * const restrict mask, gfc_charlen_type len); | 135 gfc_array_l1 * const restrict mask, gfc_charlen_type len); |
136 export_proto(mmaxval0_s1); | 136 export_proto(mmaxval0_s1); |
137 | 137 |
138 void | 138 void |
139 mmaxval0_s1 (GFC_INTEGER_1 * const restrict ret, | 139 mmaxval0_s1 (GFC_UINTEGER_1 * const restrict ret, |
140 gfc_charlen_type xlen, gfc_array_s1 * const restrict array, | 140 gfc_charlen_type xlen, gfc_array_s1 * const restrict array, |
141 gfc_array_l1 * const restrict mask, gfc_charlen_type len) | 141 gfc_array_l1 * const restrict mask, gfc_charlen_type len) |
142 { | 142 { |
143 index_type count[GFC_MAX_DIMENSIONS]; | 143 index_type count[GFC_MAX_DIMENSIONS]; |
144 index_type extent[GFC_MAX_DIMENSIONS]; | 144 index_type extent[GFC_MAX_DIMENSIONS]; |
145 index_type sstride[GFC_MAX_DIMENSIONS]; | 145 index_type sstride[GFC_MAX_DIMENSIONS]; |
146 index_type mstride[GFC_MAX_DIMENSIONS]; | 146 index_type mstride[GFC_MAX_DIMENSIONS]; |
147 const GFC_INTEGER_1 *base; | 147 const GFC_UINTEGER_1 *base; |
148 GFC_LOGICAL_1 *mbase; | 148 GFC_LOGICAL_1 *mbase; |
149 int rank; | 149 int rank; |
150 index_type n; | 150 index_type n; |
151 int mask_kind; | 151 int mask_kind; |
152 | |
153 if (mask == NULL) | |
154 { | |
155 maxval0_s1 (ret, xlen, array, len); | |
156 return; | |
157 } | |
152 | 158 |
153 rank = GFC_DESCRIPTOR_RANK (array); | 159 rank = GFC_DESCRIPTOR_RANK (array); |
154 if (rank <= 0) | 160 if (rank <= 0) |
155 runtime_error ("Rank of array needs to be > 0"); | 161 runtime_error ("Rank of array needs to be > 0"); |
156 | 162 |
183 } | 189 } |
184 | 190 |
185 base = array->base_addr; | 191 base = array->base_addr; |
186 { | 192 { |
187 | 193 |
188 const GFC_INTEGER_1 *retval; | 194 const GFC_UINTEGER_1 *retval; |
189 | 195 |
190 retval = ret; | 196 retval = ret; |
191 | 197 |
192 while (base) | 198 while (base) |
193 { | 199 { |
234 memcpy (ret, retval, len * sizeof (*ret)); | 240 memcpy (ret, retval, len * sizeof (*ret)); |
235 } | 241 } |
236 } | 242 } |
237 | 243 |
238 | 244 |
239 extern void smaxval0_s1 (GFC_INTEGER_1 * restrict, | 245 extern void smaxval0_s1 (GFC_UINTEGER_1 * restrict, |
240 gfc_charlen_type, | 246 gfc_charlen_type, |
241 gfc_array_s1 * const restrict array, GFC_LOGICAL_4 *, gfc_charlen_type); | 247 gfc_array_s1 * const restrict array, GFC_LOGICAL_4 *, gfc_charlen_type); |
242 export_proto(smaxval0_s1); | 248 export_proto(smaxval0_s1); |
243 | 249 |
244 void | 250 void |
245 smaxval0_s1 (GFC_INTEGER_1 * restrict ret, | 251 smaxval0_s1 (GFC_UINTEGER_1 * restrict ret, |
246 gfc_charlen_type xlen, gfc_array_s1 * const restrict array, | 252 gfc_charlen_type xlen, gfc_array_s1 * const restrict array, |
247 GFC_LOGICAL_4 *mask, gfc_charlen_type len) | 253 GFC_LOGICAL_4 *mask, gfc_charlen_type len) |
248 | 254 |
249 { | 255 { |
250 if (*mask) | 256 if (mask == NULL || *mask) |
251 { | 257 { |
252 maxval0_s1 (ret, xlen, array, len); | 258 maxval0_s1 (ret, xlen, array, len); |
253 return; | 259 return; |
254 } | 260 } |
255 memset (ret, INITVAL, sizeof (*ret) * len); | 261 memset (ret, INITVAL, sizeof (*ret) * len); |