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);