|
236
|
1 //===-- runtime/character.cpp ---------------------------------------------===//
|
|
173
|
2 //
|
|
|
3 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
|
|
|
4 // See https://llvm.org/LICENSE.txt for license information.
|
|
|
5 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
|
|
|
6 //
|
|
|
7 //===----------------------------------------------------------------------===//
|
|
|
8
|
|
236
|
9 #include "flang/Runtime/character.h"
|
|
173
|
10 #include "terminator.h"
|
|
221
|
11 #include "tools.h"
|
|
|
12 #include "flang/Common/bit-population-count.h"
|
|
|
13 #include "flang/Common/uint128.h"
|
|
236
|
14 #include "flang/Runtime/cpp-type.h"
|
|
|
15 #include "flang/Runtime/descriptor.h"
|
|
173
|
16 #include <algorithm>
|
|
|
17 #include <cstring>
|
|
|
18
|
|
|
19 namespace Fortran::runtime {
|
|
|
20
|
|
221
|
21 template <typename CHAR>
|
|
|
22 inline int CompareToBlankPadding(const CHAR *x, std::size_t chars) {
|
|
236
|
23 using UNSIGNED_CHAR = std::make_unsigned_t<CHAR>;
|
|
|
24 const auto blank{static_cast<UNSIGNED_CHAR>(' ')};
|
|
173
|
25 for (; chars-- > 0; ++x) {
|
|
236
|
26 const UNSIGNED_CHAR ux{*reinterpret_cast<const UNSIGNED_CHAR *>(x)};
|
|
|
27 if (ux < blank) {
|
|
173
|
28 return -1;
|
|
|
29 }
|
|
236
|
30 if (ux > blank) {
|
|
173
|
31 return 1;
|
|
|
32 }
|
|
|
33 }
|
|
|
34 return 0;
|
|
|
35 }
|
|
|
36
|
|
221
|
37 template <typename CHAR>
|
|
|
38 int CharacterScalarCompare(
|
|
|
39 const CHAR *x, const CHAR *y, std::size_t xChars, std::size_t yChars) {
|
|
|
40 auto minChars{std::min(xChars, yChars)};
|
|
|
41 if constexpr (sizeof(CHAR) == 1) {
|
|
173
|
42 // don't use for kind=2 or =4, that would fail on little-endian machines
|
|
221
|
43 int cmp{std::memcmp(x, y, minChars)};
|
|
173
|
44 if (cmp < 0) {
|
|
|
45 return -1;
|
|
|
46 }
|
|
|
47 if (cmp > 0) {
|
|
|
48 return 1;
|
|
|
49 }
|
|
221
|
50 if (xChars == yChars) {
|
|
173
|
51 return 0;
|
|
|
52 }
|
|
221
|
53 x += minChars;
|
|
|
54 y += minChars;
|
|
173
|
55 } else {
|
|
221
|
56 for (std::size_t n{minChars}; n-- > 0; ++x, ++y) {
|
|
173
|
57 if (*x < *y) {
|
|
|
58 return -1;
|
|
|
59 }
|
|
|
60 if (*x > *y) {
|
|
|
61 return 1;
|
|
|
62 }
|
|
|
63 }
|
|
|
64 }
|
|
221
|
65 if (int cmp{CompareToBlankPadding(x, xChars - minChars)}) {
|
|
173
|
66 return cmp;
|
|
|
67 }
|
|
221
|
68 return -CompareToBlankPadding(y, yChars - minChars);
|
|
|
69 }
|
|
|
70
|
|
|
71 template int CharacterScalarCompare<char>(
|
|
|
72 const char *x, const char *y, std::size_t xChars, std::size_t yChars);
|
|
|
73 template int CharacterScalarCompare<char16_t>(const char16_t *x,
|
|
|
74 const char16_t *y, std::size_t xChars, std::size_t yChars);
|
|
|
75 template int CharacterScalarCompare<char32_t>(const char32_t *x,
|
|
|
76 const char32_t *y, std::size_t xChars, std::size_t yChars);
|
|
|
77
|
|
|
78 // Shift count to use when converting between character lengths
|
|
|
79 // and byte counts.
|
|
|
80 template <typename CHAR>
|
|
|
81 constexpr int shift{common::TrailingZeroBitCount(sizeof(CHAR))};
|
|
|
82
|
|
|
83 template <typename CHAR>
|
|
|
84 static void Compare(Descriptor &result, const Descriptor &x,
|
|
|
85 const Descriptor &y, const Terminator &terminator) {
|
|
|
86 RUNTIME_CHECK(
|
|
|
87 terminator, x.rank() == y.rank() || x.rank() == 0 || y.rank() == 0);
|
|
|
88 int rank{std::max(x.rank(), y.rank())};
|
|
223
|
89 SubscriptValue ub[maxRank], xAt[maxRank], yAt[maxRank];
|
|
221
|
90 SubscriptValue elements{1};
|
|
|
91 for (int j{0}; j < rank; ++j) {
|
|
|
92 if (x.rank() > 0 && y.rank() > 0) {
|
|
|
93 SubscriptValue xUB{x.GetDimension(j).Extent()};
|
|
|
94 SubscriptValue yUB{y.GetDimension(j).Extent()};
|
|
|
95 if (xUB != yUB) {
|
|
|
96 terminator.Crash("Character array comparison: operands are not "
|
|
|
97 "conforming on dimension %d (%jd != %jd)",
|
|
|
98 j + 1, static_cast<std::intmax_t>(xUB),
|
|
|
99 static_cast<std::intmax_t>(yUB));
|
|
|
100 }
|
|
|
101 ub[j] = xUB;
|
|
|
102 } else {
|
|
|
103 ub[j] = (x.rank() ? x : y).GetDimension(j).Extent();
|
|
|
104 }
|
|
|
105 elements *= ub[j];
|
|
|
106 }
|
|
223
|
107 x.GetLowerBounds(xAt);
|
|
|
108 y.GetLowerBounds(yAt);
|
|
221
|
109 result.Establish(
|
|
|
110 TypeCategory::Logical, 1, nullptr, rank, ub, CFI_attribute_allocatable);
|
|
223
|
111 for (int j{0}; j < rank; ++j) {
|
|
|
112 result.GetDimension(j).SetBounds(1, ub[j]);
|
|
|
113 }
|
|
|
114 if (result.Allocate() != CFI_SUCCESS) {
|
|
221
|
115 terminator.Crash("Compare: could not allocate storage for result");
|
|
|
116 }
|
|
|
117 std::size_t xChars{x.ElementBytes() >> shift<CHAR>};
|
|
|
118 std::size_t yChars{y.ElementBytes() >> shift<char>};
|
|
|
119 for (SubscriptValue resultAt{0}; elements-- > 0;
|
|
|
120 ++resultAt, x.IncrementSubscripts(xAt), y.IncrementSubscripts(yAt)) {
|
|
|
121 *result.OffsetElement<char>(resultAt) = CharacterScalarCompare<CHAR>(
|
|
|
122 x.Element<CHAR>(xAt), y.Element<CHAR>(yAt), xChars, yChars);
|
|
|
123 }
|
|
|
124 }
|
|
|
125
|
|
|
126 template <typename CHAR, bool ADJUSTR>
|
|
|
127 static void Adjust(CHAR *to, const CHAR *from, std::size_t chars) {
|
|
|
128 if constexpr (ADJUSTR) {
|
|
|
129 std::size_t j{chars}, k{chars};
|
|
|
130 for (; k > 0 && from[k - 1] == ' '; --k) {
|
|
|
131 }
|
|
|
132 while (k > 0) {
|
|
|
133 to[--j] = from[--k];
|
|
|
134 }
|
|
|
135 while (j > 0) {
|
|
|
136 to[--j] = ' ';
|
|
|
137 }
|
|
|
138 } else { // ADJUSTL
|
|
|
139 std::size_t j{0}, k{0};
|
|
|
140 for (; k < chars && from[k] == ' '; ++k) {
|
|
|
141 }
|
|
|
142 while (k < chars) {
|
|
|
143 to[j++] = from[k++];
|
|
|
144 }
|
|
|
145 while (j < chars) {
|
|
|
146 to[j++] = ' ';
|
|
|
147 }
|
|
|
148 }
|
|
|
149 }
|
|
|
150
|
|
|
151 template <typename CHAR, bool ADJUSTR>
|
|
|
152 static void AdjustLRHelper(Descriptor &result, const Descriptor &string,
|
|
|
153 const Terminator &terminator) {
|
|
|
154 int rank{string.rank()};
|
|
223
|
155 SubscriptValue ub[maxRank], stringAt[maxRank];
|
|
221
|
156 SubscriptValue elements{1};
|
|
|
157 for (int j{0}; j < rank; ++j) {
|
|
|
158 ub[j] = string.GetDimension(j).Extent();
|
|
|
159 elements *= ub[j];
|
|
|
160 stringAt[j] = 1;
|
|
|
161 }
|
|
223
|
162 string.GetLowerBounds(stringAt);
|
|
221
|
163 std::size_t elementBytes{string.ElementBytes()};
|
|
|
164 result.Establish(string.type(), elementBytes, nullptr, rank, ub,
|
|
|
165 CFI_attribute_allocatable);
|
|
223
|
166 for (int j{0}; j < rank; ++j) {
|
|
|
167 result.GetDimension(j).SetBounds(1, ub[j]);
|
|
|
168 }
|
|
|
169 if (result.Allocate() != CFI_SUCCESS) {
|
|
221
|
170 terminator.Crash("ADJUSTL/R: could not allocate storage for result");
|
|
|
171 }
|
|
|
172 for (SubscriptValue resultAt{0}; elements-- > 0;
|
|
|
173 resultAt += elementBytes, string.IncrementSubscripts(stringAt)) {
|
|
|
174 Adjust<CHAR, ADJUSTR>(result.OffsetElement<CHAR>(resultAt),
|
|
|
175 string.Element<const CHAR>(stringAt), elementBytes >> shift<CHAR>);
|
|
|
176 }
|
|
|
177 }
|
|
|
178
|
|
|
179 template <bool ADJUSTR>
|
|
|
180 void AdjustLR(Descriptor &result, const Descriptor &string,
|
|
|
181 const char *sourceFile, int sourceLine) {
|
|
|
182 Terminator terminator{sourceFile, sourceLine};
|
|
|
183 switch (string.raw().type) {
|
|
|
184 case CFI_type_char:
|
|
|
185 AdjustLRHelper<char, ADJUSTR>(result, string, terminator);
|
|
|
186 break;
|
|
|
187 case CFI_type_char16_t:
|
|
|
188 AdjustLRHelper<char16_t, ADJUSTR>(result, string, terminator);
|
|
|
189 break;
|
|
|
190 case CFI_type_char32_t:
|
|
|
191 AdjustLRHelper<char32_t, ADJUSTR>(result, string, terminator);
|
|
|
192 break;
|
|
|
193 default:
|
|
|
194 terminator.Crash("ADJUSTL/R: bad string type code %d",
|
|
|
195 static_cast<int>(string.raw().type));
|
|
|
196 }
|
|
|
197 }
|
|
|
198
|
|
|
199 template <typename CHAR>
|
|
|
200 inline std::size_t LenTrim(const CHAR *x, std::size_t chars) {
|
|
|
201 while (chars > 0 && x[chars - 1] == ' ') {
|
|
|
202 --chars;
|
|
|
203 }
|
|
|
204 return chars;
|
|
|
205 }
|
|
|
206
|
|
|
207 template <typename INT, typename CHAR>
|
|
|
208 static void LenTrim(Descriptor &result, const Descriptor &string,
|
|
|
209 const Terminator &terminator) {
|
|
|
210 int rank{string.rank()};
|
|
223
|
211 SubscriptValue ub[maxRank], stringAt[maxRank];
|
|
221
|
212 SubscriptValue elements{1};
|
|
|
213 for (int j{0}; j < rank; ++j) {
|
|
|
214 ub[j] = string.GetDimension(j).Extent();
|
|
|
215 elements *= ub[j];
|
|
|
216 }
|
|
223
|
217 string.GetLowerBounds(stringAt);
|
|
221
|
218 result.Establish(TypeCategory::Integer, sizeof(INT), nullptr, rank, ub,
|
|
|
219 CFI_attribute_allocatable);
|
|
223
|
220 for (int j{0}; j < rank; ++j) {
|
|
|
221 result.GetDimension(j).SetBounds(1, ub[j]);
|
|
|
222 }
|
|
|
223 if (result.Allocate() != CFI_SUCCESS) {
|
|
221
|
224 terminator.Crash("LEN_TRIM: could not allocate storage for result");
|
|
|
225 }
|
|
|
226 std::size_t stringElementChars{string.ElementBytes() >> shift<CHAR>};
|
|
|
227 for (SubscriptValue resultAt{0}; elements-- > 0;
|
|
|
228 resultAt += sizeof(INT), string.IncrementSubscripts(stringAt)) {
|
|
|
229 *result.OffsetElement<INT>(resultAt) =
|
|
|
230 LenTrim(string.Element<CHAR>(stringAt), stringElementChars);
|
|
|
231 }
|
|
|
232 }
|
|
|
233
|
|
|
234 template <typename CHAR>
|
|
|
235 static void LenTrimKind(Descriptor &result, const Descriptor &string, int kind,
|
|
|
236 const Terminator &terminator) {
|
|
|
237 switch (kind) {
|
|
|
238 case 1:
|
|
|
239 LenTrim<CppTypeFor<TypeCategory::Integer, 1>, CHAR>(
|
|
|
240 result, string, terminator);
|
|
|
241 break;
|
|
|
242 case 2:
|
|
|
243 LenTrim<CppTypeFor<TypeCategory::Integer, 2>, CHAR>(
|
|
|
244 result, string, terminator);
|
|
|
245 break;
|
|
|
246 case 4:
|
|
|
247 LenTrim<CppTypeFor<TypeCategory::Integer, 4>, CHAR>(
|
|
|
248 result, string, terminator);
|
|
|
249 break;
|
|
|
250 case 8:
|
|
|
251 LenTrim<CppTypeFor<TypeCategory::Integer, 8>, CHAR>(
|
|
|
252 result, string, terminator);
|
|
|
253 break;
|
|
|
254 case 16:
|
|
|
255 LenTrim<CppTypeFor<TypeCategory::Integer, 16>, CHAR>(
|
|
|
256 result, string, terminator);
|
|
|
257 break;
|
|
|
258 default:
|
|
236
|
259 terminator.Crash("not yet implemented: LEN_TRIM: KIND=%d", kind);
|
|
221
|
260 }
|
|
|
261 }
|
|
|
262
|
|
|
263 // INDEX implementation
|
|
|
264 template <typename CHAR>
|
|
|
265 inline std::size_t Index(const CHAR *x, std::size_t xLen, const CHAR *want,
|
|
|
266 std::size_t wantLen, bool back) {
|
|
|
267 if (xLen < wantLen) {
|
|
|
268 return 0;
|
|
|
269 }
|
|
|
270 if (xLen == 0) {
|
|
|
271 return 1; // wantLen is also 0, so trivial match
|
|
|
272 }
|
|
|
273 if (back) {
|
|
|
274 // If wantLen==0, returns xLen + 1 per standard (and all other compilers)
|
|
|
275 std::size_t at{xLen - wantLen + 1};
|
|
|
276 for (; at > 0; --at) {
|
|
|
277 std::size_t j{1};
|
|
|
278 for (; j <= wantLen; ++j) {
|
|
|
279 if (x[at + j - 2] != want[j - 1]) {
|
|
|
280 break;
|
|
|
281 }
|
|
|
282 }
|
|
|
283 if (j > wantLen) {
|
|
|
284 return at;
|
|
|
285 }
|
|
|
286 }
|
|
|
287 return 0;
|
|
|
288 }
|
|
|
289 // Non-trivial forward substring search: use a simplified form of
|
|
|
290 // Boyer-Moore substring searching.
|
|
|
291 for (std::size_t at{1}; at + wantLen - 1 <= xLen;) {
|
|
|
292 // Compare x(at:at+wantLen-1) with want(1:wantLen).
|
|
|
293 // The comparison proceeds from the ends of the substrings forward
|
|
|
294 // so that we can skip ahead by multiple positions on a miss.
|
|
|
295 std::size_t j{wantLen};
|
|
|
296 CHAR ch;
|
|
|
297 for (; j > 0; --j) {
|
|
|
298 ch = x[at + j - 2];
|
|
|
299 if (ch != want[j - 1]) {
|
|
|
300 break;
|
|
|
301 }
|
|
|
302 }
|
|
|
303 if (j == 0) {
|
|
|
304 return at; // found a match
|
|
|
305 }
|
|
|
306 // Suppose we have at==2:
|
|
|
307 // "THAT FORTRAN THAT I RAN" <- the string (x) in which we search
|
|
|
308 // "THAT I RAN" <- the string (want) for which we search
|
|
|
309 // ^------------------ j==7, ch=='T'
|
|
|
310 // We can shift ahead 3 positions to at==5 to align the 'T's:
|
|
|
311 // "THAT FORTRAN THAT I RAN"
|
|
|
312 // "THAT I RAN"
|
|
|
313 std::size_t shift{1};
|
|
|
314 for (; shift < j; ++shift) {
|
|
|
315 if (want[j - shift - 1] == ch) {
|
|
|
316 break;
|
|
|
317 }
|
|
|
318 }
|
|
|
319 at += shift;
|
|
|
320 }
|
|
|
321 return 0;
|
|
|
322 }
|
|
|
323
|
|
|
324 // SCAN and VERIFY implementation help. These intrinsic functions
|
|
|
325 // do pretty much the same thing, so they're templatized with a
|
|
|
326 // distinguishing flag.
|
|
|
327
|
|
|
328 enum class CharFunc { Index, Scan, Verify };
|
|
|
329
|
|
|
330 template <typename CHAR, CharFunc FUNC>
|
|
|
331 inline std::size_t ScanVerify(const CHAR *x, std::size_t xLen, const CHAR *set,
|
|
|
332 std::size_t setLen, bool back) {
|
|
|
333 std::size_t at{back ? xLen : 1};
|
|
|
334 int increment{back ? -1 : 1};
|
|
|
335 for (; xLen-- > 0; at += increment) {
|
|
|
336 CHAR ch{x[at - 1]};
|
|
|
337 bool inSet{false};
|
|
|
338 // TODO: If set is sorted, could use binary search
|
|
|
339 for (std::size_t j{0}; j < setLen; ++j) {
|
|
|
340 if (set[j] == ch) {
|
|
|
341 inSet = true;
|
|
|
342 break;
|
|
|
343 }
|
|
|
344 }
|
|
|
345 if (inSet != (FUNC == CharFunc::Verify)) {
|
|
|
346 return at;
|
|
|
347 }
|
|
|
348 }
|
|
|
349 return 0;
|
|
|
350 }
|
|
|
351
|
|
|
352 // Specialization for one-byte characters
|
|
|
353 template <bool IS_VERIFY = false>
|
|
|
354 inline std::size_t ScanVerify(const char *x, std::size_t xLen, const char *set,
|
|
|
355 std::size_t setLen, bool back) {
|
|
|
356 std::size_t at{back ? xLen : 1};
|
|
|
357 int increment{back ? -1 : 1};
|
|
|
358 if (xLen > 0) {
|
|
|
359 std::uint64_t bitSet[256 / 64]{0};
|
|
|
360 std::uint64_t one{1};
|
|
|
361 for (std::size_t j{0}; j < setLen; ++j) {
|
|
|
362 unsigned setCh{static_cast<unsigned char>(set[j])};
|
|
|
363 bitSet[setCh / 64] |= one << (setCh % 64);
|
|
|
364 }
|
|
|
365 for (; xLen-- > 0; at += increment) {
|
|
|
366 unsigned ch{static_cast<unsigned char>(x[at - 1])};
|
|
|
367 bool inSet{((bitSet[ch / 64] >> (ch % 64)) & 1) != 0};
|
|
|
368 if (inSet != IS_VERIFY) {
|
|
|
369 return at;
|
|
|
370 }
|
|
|
371 }
|
|
|
372 }
|
|
|
373 return 0;
|
|
|
374 }
|
|
|
375
|
|
|
376 template <typename INT, typename CHAR, CharFunc FUNC>
|
|
|
377 static void GeneralCharFunc(Descriptor &result, const Descriptor &string,
|
|
|
378 const Descriptor &arg, const Descriptor *back,
|
|
|
379 const Terminator &terminator) {
|
|
|
380 int rank{string.rank() ? string.rank()
|
|
|
381 : arg.rank() ? arg.rank()
|
|
|
382 : back ? back->rank()
|
|
|
383 : 0};
|
|
223
|
384 SubscriptValue ub[maxRank], stringAt[maxRank], argAt[maxRank],
|
|
221
|
385 backAt[maxRank];
|
|
|
386 SubscriptValue elements{1};
|
|
|
387 for (int j{0}; j < rank; ++j) {
|
|
|
388 ub[j] = string.rank() ? string.GetDimension(j).Extent()
|
|
|
389 : arg.rank() ? arg.GetDimension(j).Extent()
|
|
|
390 : back ? back->GetDimension(j).Extent()
|
|
|
391 : 1;
|
|
|
392 elements *= ub[j];
|
|
223
|
393 }
|
|
|
394 string.GetLowerBounds(stringAt);
|
|
|
395 arg.GetLowerBounds(argAt);
|
|
|
396 if (back) {
|
|
|
397 back->GetLowerBounds(backAt);
|
|
221
|
398 }
|
|
|
399 result.Establish(TypeCategory::Integer, sizeof(INT), nullptr, rank, ub,
|
|
|
400 CFI_attribute_allocatable);
|
|
223
|
401 for (int j{0}; j < rank; ++j) {
|
|
|
402 result.GetDimension(j).SetBounds(1, ub[j]);
|
|
|
403 }
|
|
|
404 if (result.Allocate() != CFI_SUCCESS) {
|
|
221
|
405 terminator.Crash("SCAN/VERIFY: could not allocate storage for result");
|
|
|
406 }
|
|
|
407 std::size_t stringElementChars{string.ElementBytes() >> shift<CHAR>};
|
|
|
408 std::size_t argElementChars{arg.ElementBytes() >> shift<CHAR>};
|
|
|
409 for (SubscriptValue resultAt{0}; elements-- > 0; resultAt += sizeof(INT),
|
|
|
410 string.IncrementSubscripts(stringAt), arg.IncrementSubscripts(argAt),
|
|
|
411 back && back->IncrementSubscripts(backAt)) {
|
|
|
412 if constexpr (FUNC == CharFunc::Index) {
|
|
|
413 *result.OffsetElement<INT>(resultAt) =
|
|
|
414 Index<CHAR>(string.Element<CHAR>(stringAt), stringElementChars,
|
|
|
415 arg.Element<CHAR>(argAt), argElementChars,
|
|
|
416 back && IsLogicalElementTrue(*back, backAt));
|
|
|
417 } else if constexpr (FUNC == CharFunc::Scan) {
|
|
|
418 *result.OffsetElement<INT>(resultAt) =
|
|
|
419 ScanVerify<CHAR, CharFunc::Scan>(string.Element<CHAR>(stringAt),
|
|
|
420 stringElementChars, arg.Element<CHAR>(argAt), argElementChars,
|
|
|
421 back && IsLogicalElementTrue(*back, backAt));
|
|
|
422 } else if constexpr (FUNC == CharFunc::Verify) {
|
|
|
423 *result.OffsetElement<INT>(resultAt) =
|
|
|
424 ScanVerify<CHAR, CharFunc::Verify>(string.Element<CHAR>(stringAt),
|
|
|
425 stringElementChars, arg.Element<CHAR>(argAt), argElementChars,
|
|
|
426 back && IsLogicalElementTrue(*back, backAt));
|
|
|
427 } else {
|
|
|
428 static_assert(FUNC == CharFunc::Index || FUNC == CharFunc::Scan ||
|
|
|
429 FUNC == CharFunc::Verify);
|
|
|
430 }
|
|
|
431 }
|
|
|
432 }
|
|
|
433
|
|
|
434 template <typename CHAR, CharFunc FUNC>
|
|
|
435 static void GeneralCharFuncKind(Descriptor &result, const Descriptor &string,
|
|
|
436 const Descriptor &arg, const Descriptor *back, int kind,
|
|
|
437 const Terminator &terminator) {
|
|
|
438 switch (kind) {
|
|
|
439 case 1:
|
|
|
440 GeneralCharFunc<CppTypeFor<TypeCategory::Integer, 1>, CHAR, FUNC>(
|
|
|
441 result, string, arg, back, terminator);
|
|
|
442 break;
|
|
|
443 case 2:
|
|
|
444 GeneralCharFunc<CppTypeFor<TypeCategory::Integer, 2>, CHAR, FUNC>(
|
|
|
445 result, string, arg, back, terminator);
|
|
|
446 break;
|
|
|
447 case 4:
|
|
|
448 GeneralCharFunc<CppTypeFor<TypeCategory::Integer, 4>, CHAR, FUNC>(
|
|
|
449 result, string, arg, back, terminator);
|
|
|
450 break;
|
|
|
451 case 8:
|
|
|
452 GeneralCharFunc<CppTypeFor<TypeCategory::Integer, 8>, CHAR, FUNC>(
|
|
|
453 result, string, arg, back, terminator);
|
|
|
454 break;
|
|
|
455 case 16:
|
|
|
456 GeneralCharFunc<CppTypeFor<TypeCategory::Integer, 16>, CHAR, FUNC>(
|
|
|
457 result, string, arg, back, terminator);
|
|
|
458 break;
|
|
|
459 default:
|
|
236
|
460 terminator.Crash("not yet implemented: INDEX/SCAN/VERIFY: KIND=%d", kind);
|
|
221
|
461 }
|
|
|
462 }
|
|
|
463
|
|
|
464 template <typename TO, typename FROM>
|
|
|
465 static void CopyAndPad(
|
|
|
466 TO *to, const FROM *from, std::size_t toChars, std::size_t fromChars) {
|
|
|
467 if constexpr (sizeof(TO) != sizeof(FROM)) {
|
|
|
468 std::size_t copyChars{std::min(toChars, fromChars)};
|
|
|
469 for (std::size_t j{0}; j < copyChars; ++j) {
|
|
|
470 to[j] = from[j];
|
|
|
471 }
|
|
|
472 for (std::size_t j{copyChars}; j < toChars; ++j) {
|
|
|
473 to[j] = static_cast<TO>(' ');
|
|
|
474 }
|
|
|
475 } else if (toChars <= fromChars) {
|
|
|
476 std::memcpy(to, from, toChars * sizeof(TO));
|
|
|
477 } else {
|
|
|
478 std::memcpy(to, from, fromChars * sizeof(TO));
|
|
|
479 for (std::size_t j{fromChars}; j < toChars; ++j) {
|
|
|
480 to[j] = static_cast<TO>(' ');
|
|
|
481 }
|
|
|
482 }
|
|
|
483 }
|
|
|
484
|
|
|
485 template <typename CHAR, bool ISMIN>
|
|
|
486 static void MaxMinHelper(Descriptor &accumulator, const Descriptor &x,
|
|
|
487 const Terminator &terminator) {
|
|
|
488 RUNTIME_CHECK(terminator,
|
|
|
489 accumulator.rank() == 0 || x.rank() == 0 ||
|
|
|
490 accumulator.rank() == x.rank());
|
|
223
|
491 SubscriptValue ub[maxRank], xAt[maxRank];
|
|
221
|
492 SubscriptValue elements{1};
|
|
|
493 std::size_t accumChars{accumulator.ElementBytes() >> shift<CHAR>};
|
|
|
494 std::size_t xChars{x.ElementBytes() >> shift<CHAR>};
|
|
|
495 std::size_t chars{std::max(accumChars, xChars)};
|
|
|
496 bool reallocate{accumulator.raw().base_addr == nullptr ||
|
|
|
497 accumChars != chars || (accumulator.rank() == 0 && x.rank() > 0)};
|
|
|
498 int rank{std::max(accumulator.rank(), x.rank())};
|
|
|
499 for (int j{0}; j < rank; ++j) {
|
|
|
500 if (x.rank() > 0) {
|
|
|
501 ub[j] = x.GetDimension(j).Extent();
|
|
|
502 if (accumulator.rank() > 0) {
|
|
|
503 SubscriptValue accumExt{accumulator.GetDimension(j).Extent()};
|
|
|
504 if (accumExt != ub[j]) {
|
|
|
505 terminator.Crash("Character MAX/MIN: operands are not "
|
|
|
506 "conforming on dimension %d (%jd != %jd)",
|
|
|
507 j + 1, static_cast<std::intmax_t>(accumExt),
|
|
|
508 static_cast<std::intmax_t>(ub[j]));
|
|
|
509 }
|
|
|
510 }
|
|
|
511 } else {
|
|
|
512 ub[j] = accumulator.GetDimension(j).Extent();
|
|
|
513 }
|
|
|
514 elements *= ub[j];
|
|
|
515 }
|
|
223
|
516 x.GetLowerBounds(xAt);
|
|
221
|
517 void *old{nullptr};
|
|
|
518 const CHAR *accumData{accumulator.OffsetElement<CHAR>()};
|
|
|
519 if (reallocate) {
|
|
|
520 old = accumulator.raw().base_addr;
|
|
|
521 accumulator.set_base_addr(nullptr);
|
|
|
522 accumulator.raw().elem_len = chars << shift<CHAR>;
|
|
223
|
523 for (int j{0}; j < rank; ++j) {
|
|
|
524 accumulator.GetDimension(j).SetBounds(1, ub[j]);
|
|
|
525 }
|
|
|
526 RUNTIME_CHECK(terminator, accumulator.Allocate() == CFI_SUCCESS);
|
|
221
|
527 }
|
|
|
528 for (CHAR *result{accumulator.OffsetElement<CHAR>()}; elements-- > 0;
|
|
|
529 accumData += accumChars, result += chars, x.IncrementSubscripts(xAt)) {
|
|
|
530 const CHAR *xData{x.Element<CHAR>(xAt)};
|
|
|
531 int cmp{CharacterScalarCompare(accumData, xData, accumChars, xChars)};
|
|
|
532 if constexpr (ISMIN) {
|
|
|
533 cmp = -cmp;
|
|
|
534 }
|
|
|
535 if (cmp < 0) {
|
|
|
536 CopyAndPad(result, xData, chars, xChars);
|
|
|
537 } else if (result != accumData) {
|
|
|
538 CopyAndPad(result, accumData, chars, accumChars);
|
|
|
539 }
|
|
|
540 }
|
|
|
541 FreeMemory(old);
|
|
|
542 }
|
|
|
543
|
|
|
544 template <bool ISMIN>
|
|
|
545 static void MaxMin(Descriptor &accumulator, const Descriptor &x,
|
|
|
546 const char *sourceFile, int sourceLine) {
|
|
|
547 Terminator terminator{sourceFile, sourceLine};
|
|
|
548 RUNTIME_CHECK(terminator, accumulator.raw().type == x.raw().type);
|
|
|
549 switch (accumulator.raw().type) {
|
|
|
550 case CFI_type_char:
|
|
|
551 MaxMinHelper<char, ISMIN>(accumulator, x, terminator);
|
|
|
552 break;
|
|
|
553 case CFI_type_char16_t:
|
|
|
554 MaxMinHelper<char16_t, ISMIN>(accumulator, x, terminator);
|
|
|
555 break;
|
|
|
556 case CFI_type_char32_t:
|
|
|
557 MaxMinHelper<char32_t, ISMIN>(accumulator, x, terminator);
|
|
|
558 break;
|
|
|
559 default:
|
|
|
560 terminator.Crash(
|
|
|
561 "Character MAX/MIN: result does not have a character type");
|
|
|
562 }
|
|
173
|
563 }
|
|
|
564
|
|
|
565 extern "C" {
|
|
|
566
|
|
221
|
567 void RTNAME(CharacterConcatenate)(Descriptor &accumulator,
|
|
|
568 const Descriptor &from, const char *sourceFile, int sourceLine) {
|
|
|
569 Terminator terminator{sourceFile, sourceLine};
|
|
|
570 RUNTIME_CHECK(terminator,
|
|
|
571 accumulator.rank() == 0 || from.rank() == 0 ||
|
|
|
572 accumulator.rank() == from.rank());
|
|
|
573 int rank{std::max(accumulator.rank(), from.rank())};
|
|
223
|
574 SubscriptValue ub[maxRank], fromAt[maxRank];
|
|
221
|
575 SubscriptValue elements{1};
|
|
|
576 for (int j{0}; j < rank; ++j) {
|
|
|
577 if (accumulator.rank() > 0 && from.rank() > 0) {
|
|
|
578 ub[j] = accumulator.GetDimension(j).Extent();
|
|
|
579 SubscriptValue fromUB{from.GetDimension(j).Extent()};
|
|
|
580 if (ub[j] != fromUB) {
|
|
|
581 terminator.Crash("Character array concatenation: operands are not "
|
|
|
582 "conforming on dimension %d (%jd != %jd)",
|
|
|
583 j + 1, static_cast<std::intmax_t>(ub[j]),
|
|
|
584 static_cast<std::intmax_t>(fromUB));
|
|
|
585 }
|
|
|
586 } else {
|
|
|
587 ub[j] =
|
|
|
588 (accumulator.rank() ? accumulator : from).GetDimension(j).Extent();
|
|
|
589 }
|
|
|
590 elements *= ub[j];
|
|
|
591 }
|
|
|
592 std::size_t oldBytes{accumulator.ElementBytes()};
|
|
|
593 void *old{accumulator.raw().base_addr};
|
|
|
594 accumulator.set_base_addr(nullptr);
|
|
|
595 std::size_t fromBytes{from.ElementBytes()};
|
|
|
596 accumulator.raw().elem_len += fromBytes;
|
|
|
597 std::size_t newBytes{accumulator.ElementBytes()};
|
|
223
|
598 for (int j{0}; j < rank; ++j) {
|
|
|
599 accumulator.GetDimension(j).SetBounds(1, ub[j]);
|
|
|
600 }
|
|
|
601 if (accumulator.Allocate() != CFI_SUCCESS) {
|
|
221
|
602 terminator.Crash(
|
|
|
603 "CharacterConcatenate: could not allocate storage for result");
|
|
|
604 }
|
|
|
605 const char *p{static_cast<const char *>(old)};
|
|
|
606 char *to{static_cast<char *>(accumulator.raw().base_addr)};
|
|
223
|
607 from.GetLowerBounds(fromAt);
|
|
221
|
608 for (; elements-- > 0;
|
|
|
609 to += newBytes, p += oldBytes, from.IncrementSubscripts(fromAt)) {
|
|
|
610 std::memcpy(to, p, oldBytes);
|
|
|
611 std::memcpy(to + oldBytes, from.Element<char>(fromAt), fromBytes);
|
|
|
612 }
|
|
|
613 FreeMemory(old);
|
|
|
614 }
|
|
|
615
|
|
|
616 void RTNAME(CharacterConcatenateScalar1)(
|
|
|
617 Descriptor &accumulator, const char *from, std::size_t chars) {
|
|
|
618 Terminator terminator{__FILE__, __LINE__};
|
|
|
619 RUNTIME_CHECK(terminator, accumulator.rank() == 0);
|
|
|
620 void *old{accumulator.raw().base_addr};
|
|
|
621 accumulator.set_base_addr(nullptr);
|
|
|
622 std::size_t oldLen{accumulator.ElementBytes()};
|
|
|
623 accumulator.raw().elem_len += chars;
|
|
223
|
624 RUNTIME_CHECK(terminator, accumulator.Allocate() == CFI_SUCCESS);
|
|
221
|
625 std::memcpy(accumulator.OffsetElement<char>(oldLen), from, chars);
|
|
|
626 FreeMemory(old);
|
|
173
|
627 }
|
|
|
628
|
|
221
|
629 void RTNAME(CharacterAssign)(Descriptor &lhs, const Descriptor &rhs,
|
|
|
630 const char *sourceFile, int sourceLine) {
|
|
|
631 Terminator terminator{sourceFile, sourceLine};
|
|
|
632 int rank{lhs.rank()};
|
|
|
633 RUNTIME_CHECK(terminator, rhs.rank() == 0 || rhs.rank() == rank);
|
|
|
634 SubscriptValue ub[maxRank], lhsAt[maxRank], rhsAt[maxRank];
|
|
|
635 SubscriptValue elements{1};
|
|
|
636 std::size_t lhsBytes{lhs.ElementBytes()};
|
|
|
637 std::size_t rhsBytes{rhs.ElementBytes()};
|
|
|
638 bool reallocate{lhs.IsAllocatable() &&
|
|
|
639 (lhs.raw().base_addr == nullptr || lhsBytes != rhsBytes)};
|
|
|
640 for (int j{0}; j < rank; ++j) {
|
|
|
641 lhsAt[j] = lhs.GetDimension(j).LowerBound();
|
|
|
642 if (rhs.rank() > 0) {
|
|
|
643 SubscriptValue lhsExt{lhs.GetDimension(j).Extent()};
|
|
|
644 SubscriptValue rhsExt{rhs.GetDimension(j).Extent()};
|
|
|
645 ub[j] = lhsAt[j] + rhsExt - 1;
|
|
|
646 if (lhsExt != rhsExt) {
|
|
|
647 if (lhs.IsAllocatable()) {
|
|
|
648 reallocate = true;
|
|
|
649 } else {
|
|
|
650 terminator.Crash("Character array assignment: operands are not "
|
|
|
651 "conforming on dimension %d (%jd != %jd)",
|
|
|
652 j + 1, static_cast<std::intmax_t>(lhsExt),
|
|
|
653 static_cast<std::intmax_t>(rhsExt));
|
|
|
654 }
|
|
|
655 }
|
|
|
656 rhsAt[j] = rhs.GetDimension(j).LowerBound();
|
|
|
657 } else {
|
|
|
658 ub[j] = lhs.GetDimension(j).UpperBound();
|
|
|
659 }
|
|
|
660 elements *= ub[j] - lhsAt[j] + 1;
|
|
|
661 }
|
|
|
662 void *old{nullptr};
|
|
|
663 if (reallocate) {
|
|
|
664 old = lhs.raw().base_addr;
|
|
|
665 lhs.set_base_addr(nullptr);
|
|
|
666 lhs.raw().elem_len = lhsBytes = rhsBytes;
|
|
|
667 if (rhs.rank() > 0) {
|
|
|
668 // When the RHS is not scalar, the LHS acquires its bounds.
|
|
|
669 for (int j{0}; j < rank; ++j) {
|
|
|
670 lhsAt[j] = rhsAt[j];
|
|
|
671 ub[j] = rhs.GetDimension(j).UpperBound();
|
|
223
|
672 lhs.GetDimension(j).SetBounds(lhsAt[j], ub[j]);
|
|
221
|
673 }
|
|
|
674 }
|
|
223
|
675 RUNTIME_CHECK(terminator, lhs.Allocate() == CFI_SUCCESS);
|
|
221
|
676 }
|
|
|
677 switch (lhs.raw().type) {
|
|
|
678 case CFI_type_char:
|
|
|
679 switch (rhs.raw().type) {
|
|
|
680 case CFI_type_char:
|
|
|
681 for (; elements-- > 0;
|
|
|
682 lhs.IncrementSubscripts(lhsAt), rhs.IncrementSubscripts(rhsAt)) {
|
|
|
683 CopyAndPad(lhs.Element<char>(lhsAt), rhs.Element<char>(rhsAt), lhsBytes,
|
|
|
684 rhsBytes);
|
|
|
685 }
|
|
|
686 break;
|
|
|
687 case CFI_type_char16_t:
|
|
|
688 for (; elements-- > 0;
|
|
|
689 lhs.IncrementSubscripts(lhsAt), rhs.IncrementSubscripts(rhsAt)) {
|
|
|
690 CopyAndPad(lhs.Element<char>(lhsAt), rhs.Element<char16_t>(rhsAt),
|
|
|
691 lhsBytes, rhsBytes >> 1);
|
|
|
692 }
|
|
|
693 break;
|
|
|
694 case CFI_type_char32_t:
|
|
|
695 for (; elements-- > 0;
|
|
|
696 lhs.IncrementSubscripts(lhsAt), rhs.IncrementSubscripts(rhsAt)) {
|
|
|
697 CopyAndPad(lhs.Element<char>(lhsAt), rhs.Element<char32_t>(rhsAt),
|
|
|
698 lhsBytes, rhsBytes >> 2);
|
|
|
699 }
|
|
|
700 break;
|
|
|
701 default:
|
|
|
702 terminator.Crash(
|
|
|
703 "RHS of character assignment does not have a character type");
|
|
|
704 }
|
|
|
705 break;
|
|
|
706 case CFI_type_char16_t:
|
|
|
707 switch (rhs.raw().type) {
|
|
|
708 case CFI_type_char:
|
|
|
709 for (; elements-- > 0;
|
|
|
710 lhs.IncrementSubscripts(lhsAt), rhs.IncrementSubscripts(rhsAt)) {
|
|
|
711 CopyAndPad(lhs.Element<char16_t>(lhsAt), rhs.Element<char>(rhsAt),
|
|
|
712 lhsBytes >> 1, rhsBytes);
|
|
|
713 }
|
|
|
714 break;
|
|
|
715 case CFI_type_char16_t:
|
|
|
716 for (; elements-- > 0;
|
|
|
717 lhs.IncrementSubscripts(lhsAt), rhs.IncrementSubscripts(rhsAt)) {
|
|
|
718 CopyAndPad(lhs.Element<char16_t>(lhsAt), rhs.Element<char16_t>(rhsAt),
|
|
|
719 lhsBytes >> 1, rhsBytes >> 1);
|
|
|
720 }
|
|
|
721 break;
|
|
|
722 case CFI_type_char32_t:
|
|
|
723 for (; elements-- > 0;
|
|
|
724 lhs.IncrementSubscripts(lhsAt), rhs.IncrementSubscripts(rhsAt)) {
|
|
|
725 CopyAndPad(lhs.Element<char16_t>(lhsAt), rhs.Element<char32_t>(rhsAt),
|
|
|
726 lhsBytes >> 1, rhsBytes >> 2);
|
|
|
727 }
|
|
|
728 break;
|
|
|
729 default:
|
|
|
730 terminator.Crash(
|
|
|
731 "RHS of character assignment does not have a character type");
|
|
|
732 }
|
|
|
733 break;
|
|
|
734 case CFI_type_char32_t:
|
|
|
735 switch (rhs.raw().type) {
|
|
|
736 case CFI_type_char:
|
|
|
737 for (; elements-- > 0;
|
|
|
738 lhs.IncrementSubscripts(lhsAt), rhs.IncrementSubscripts(rhsAt)) {
|
|
|
739 CopyAndPad(lhs.Element<char32_t>(lhsAt), rhs.Element<char>(rhsAt),
|
|
|
740 lhsBytes >> 2, rhsBytes);
|
|
|
741 }
|
|
|
742 break;
|
|
|
743 case CFI_type_char16_t:
|
|
|
744 for (; elements-- > 0;
|
|
|
745 lhs.IncrementSubscripts(lhsAt), rhs.IncrementSubscripts(rhsAt)) {
|
|
|
746 CopyAndPad(lhs.Element<char32_t>(lhsAt), rhs.Element<char16_t>(rhsAt),
|
|
|
747 lhsBytes >> 2, rhsBytes >> 1);
|
|
|
748 }
|
|
|
749 break;
|
|
|
750 case CFI_type_char32_t:
|
|
|
751 for (; elements-- > 0;
|
|
|
752 lhs.IncrementSubscripts(lhsAt), rhs.IncrementSubscripts(rhsAt)) {
|
|
|
753 CopyAndPad(lhs.Element<char32_t>(lhsAt), rhs.Element<char32_t>(rhsAt),
|
|
|
754 lhsBytes >> 2, rhsBytes >> 2);
|
|
|
755 }
|
|
|
756 break;
|
|
|
757 default:
|
|
|
758 terminator.Crash(
|
|
|
759 "RHS of character assignment does not have a character type");
|
|
|
760 }
|
|
|
761 break;
|
|
|
762 default:
|
|
|
763 terminator.Crash(
|
|
|
764 "LHS of character assignment does not have a character type");
|
|
|
765 }
|
|
|
766 if (reallocate) {
|
|
|
767 FreeMemory(old);
|
|
|
768 }
|
|
173
|
769 }
|
|
|
770
|
|
221
|
771 int RTNAME(CharacterCompareScalar)(const Descriptor &x, const Descriptor &y) {
|
|
|
772 Terminator terminator{__FILE__, __LINE__};
|
|
|
773 RUNTIME_CHECK(terminator, x.rank() == 0);
|
|
|
774 RUNTIME_CHECK(terminator, y.rank() == 0);
|
|
|
775 RUNTIME_CHECK(terminator, x.raw().type == y.raw().type);
|
|
|
776 switch (x.raw().type) {
|
|
|
777 case CFI_type_char:
|
|
|
778 return CharacterScalarCompare<char>(x.OffsetElement<char>(),
|
|
|
779 y.OffsetElement<char>(), x.ElementBytes(), y.ElementBytes());
|
|
|
780 case CFI_type_char16_t:
|
|
|
781 return CharacterScalarCompare<char16_t>(x.OffsetElement<char16_t>(),
|
|
|
782 y.OffsetElement<char16_t>(), x.ElementBytes() >> 1,
|
|
|
783 y.ElementBytes() >> 1);
|
|
|
784 case CFI_type_char32_t:
|
|
|
785 return CharacterScalarCompare<char32_t>(x.OffsetElement<char32_t>(),
|
|
|
786 y.OffsetElement<char32_t>(), x.ElementBytes() >> 2,
|
|
|
787 y.ElementBytes() >> 2);
|
|
|
788 default:
|
|
|
789 terminator.Crash("CharacterCompareScalar: bad string type code %d",
|
|
|
790 static_cast<int>(x.raw().type));
|
|
|
791 }
|
|
173
|
792 return 0;
|
|
|
793 }
|
|
|
794
|
|
|
795 int RTNAME(CharacterCompareScalar1)(
|
|
221
|
796 const char *x, const char *y, std::size_t xChars, std::size_t yChars) {
|
|
|
797 return CharacterScalarCompare(x, y, xChars, yChars);
|
|
173
|
798 }
|
|
|
799
|
|
|
800 int RTNAME(CharacterCompareScalar2)(const char16_t *x, const char16_t *y,
|
|
221
|
801 std::size_t xChars, std::size_t yChars) {
|
|
|
802 return CharacterScalarCompare(x, y, xChars, yChars);
|
|
173
|
803 }
|
|
|
804
|
|
|
805 int RTNAME(CharacterCompareScalar4)(const char32_t *x, const char32_t *y,
|
|
221
|
806 std::size_t xChars, std::size_t yChars) {
|
|
|
807 return CharacterScalarCompare(x, y, xChars, yChars);
|
|
173
|
808 }
|
|
|
809
|
|
|
810 void RTNAME(CharacterCompare)(
|
|
221
|
811 Descriptor &result, const Descriptor &x, const Descriptor &y) {
|
|
|
812 Terminator terminator{__FILE__, __LINE__};
|
|
|
813 RUNTIME_CHECK(terminator, x.raw().type == y.raw().type);
|
|
|
814 switch (x.raw().type) {
|
|
|
815 case CFI_type_char:
|
|
|
816 Compare<char>(result, x, y, terminator);
|
|
|
817 break;
|
|
|
818 case CFI_type_char16_t:
|
|
|
819 Compare<char16_t>(result, x, y, terminator);
|
|
|
820 break;
|
|
|
821 case CFI_type_char32_t:
|
|
|
822 Compare<char32_t>(result, x, y, terminator);
|
|
|
823 break;
|
|
|
824 default:
|
|
|
825 terminator.Crash("CharacterCompareScalar: bad string type code %d",
|
|
|
826 static_cast<int>(x.raw().type));
|
|
|
827 }
|
|
173
|
828 }
|
|
|
829
|
|
|
830 std::size_t RTNAME(CharacterAppend1)(char *lhs, std::size_t lhsBytes,
|
|
|
831 std::size_t offset, const char *rhs, std::size_t rhsBytes) {
|
|
|
832 if (auto n{std::min(lhsBytes - offset, rhsBytes)}) {
|
|
|
833 std::memcpy(lhs + offset, rhs, n);
|
|
|
834 offset += n;
|
|
|
835 }
|
|
|
836 return offset;
|
|
|
837 }
|
|
|
838
|
|
|
839 void RTNAME(CharacterPad1)(char *lhs, std::size_t bytes, std::size_t offset) {
|
|
|
840 if (bytes > offset) {
|
|
|
841 std::memset(lhs + offset, ' ', bytes - offset);
|
|
|
842 }
|
|
|
843 }
|
|
221
|
844
|
|
|
845 // Intrinsic function entry points
|
|
|
846
|
|
|
847 void RTNAME(Adjustl)(Descriptor &result, const Descriptor &string,
|
|
|
848 const char *sourceFile, int sourceLine) {
|
|
|
849 AdjustLR<false>(result, string, sourceFile, sourceLine);
|
|
|
850 }
|
|
|
851
|
|
|
852 void RTNAME(Adjustr)(Descriptor &result, const Descriptor &string,
|
|
|
853 const char *sourceFile, int sourceLine) {
|
|
|
854 AdjustLR<true>(result, string, sourceFile, sourceLine);
|
|
|
855 }
|
|
|
856
|
|
|
857 std::size_t RTNAME(Index1)(const char *x, std::size_t xLen, const char *set,
|
|
|
858 std::size_t setLen, bool back) {
|
|
|
859 return Index<char>(x, xLen, set, setLen, back);
|
|
|
860 }
|
|
|
861 std::size_t RTNAME(Index2)(const char16_t *x, std::size_t xLen,
|
|
|
862 const char16_t *set, std::size_t setLen, bool back) {
|
|
|
863 return Index<char16_t>(x, xLen, set, setLen, back);
|
|
|
864 }
|
|
|
865 std::size_t RTNAME(Index4)(const char32_t *x, std::size_t xLen,
|
|
|
866 const char32_t *set, std::size_t setLen, bool back) {
|
|
|
867 return Index<char32_t>(x, xLen, set, setLen, back);
|
|
|
868 }
|
|
|
869
|
|
|
870 void RTNAME(Index)(Descriptor &result, const Descriptor &string,
|
|
|
871 const Descriptor &substring, const Descriptor *back, int kind,
|
|
|
872 const char *sourceFile, int sourceLine) {
|
|
|
873 Terminator terminator{sourceFile, sourceLine};
|
|
|
874 switch (string.raw().type) {
|
|
|
875 case CFI_type_char:
|
|
|
876 GeneralCharFuncKind<char, CharFunc::Index>(
|
|
|
877 result, string, substring, back, kind, terminator);
|
|
|
878 break;
|
|
|
879 case CFI_type_char16_t:
|
|
|
880 GeneralCharFuncKind<char16_t, CharFunc::Index>(
|
|
|
881 result, string, substring, back, kind, terminator);
|
|
|
882 break;
|
|
|
883 case CFI_type_char32_t:
|
|
|
884 GeneralCharFuncKind<char32_t, CharFunc::Index>(
|
|
|
885 result, string, substring, back, kind, terminator);
|
|
|
886 break;
|
|
|
887 default:
|
|
|
888 terminator.Crash(
|
|
|
889 "INDEX: bad string type code %d", static_cast<int>(string.raw().type));
|
|
|
890 }
|
|
|
891 }
|
|
|
892
|
|
|
893 std::size_t RTNAME(LenTrim1)(const char *x, std::size_t chars) {
|
|
|
894 return LenTrim(x, chars);
|
|
|
895 }
|
|
|
896 std::size_t RTNAME(LenTrim2)(const char16_t *x, std::size_t chars) {
|
|
|
897 return LenTrim(x, chars);
|
|
|
898 }
|
|
|
899 std::size_t RTNAME(LenTrim4)(const char32_t *x, std::size_t chars) {
|
|
|
900 return LenTrim(x, chars);
|
|
|
901 }
|
|
|
902
|
|
|
903 void RTNAME(LenTrim)(Descriptor &result, const Descriptor &string, int kind,
|
|
|
904 const char *sourceFile, int sourceLine) {
|
|
|
905 Terminator terminator{sourceFile, sourceLine};
|
|
|
906 switch (string.raw().type) {
|
|
|
907 case CFI_type_char:
|
|
|
908 LenTrimKind<char>(result, string, kind, terminator);
|
|
|
909 break;
|
|
|
910 case CFI_type_char16_t:
|
|
|
911 LenTrimKind<char16_t>(result, string, kind, terminator);
|
|
|
912 break;
|
|
|
913 case CFI_type_char32_t:
|
|
|
914 LenTrimKind<char32_t>(result, string, kind, terminator);
|
|
|
915 break;
|
|
|
916 default:
|
|
|
917 terminator.Crash("LEN_TRIM: bad string type code %d",
|
|
|
918 static_cast<int>(string.raw().type));
|
|
|
919 }
|
|
|
920 }
|
|
|
921
|
|
|
922 std::size_t RTNAME(Scan1)(const char *x, std::size_t xLen, const char *set,
|
|
|
923 std::size_t setLen, bool back) {
|
|
|
924 return ScanVerify<char, CharFunc::Scan>(x, xLen, set, setLen, back);
|
|
|
925 }
|
|
|
926 std::size_t RTNAME(Scan2)(const char16_t *x, std::size_t xLen,
|
|
|
927 const char16_t *set, std::size_t setLen, bool back) {
|
|
|
928 return ScanVerify<char16_t, CharFunc::Scan>(x, xLen, set, setLen, back);
|
|
|
929 }
|
|
|
930 std::size_t RTNAME(Scan4)(const char32_t *x, std::size_t xLen,
|
|
|
931 const char32_t *set, std::size_t setLen, bool back) {
|
|
|
932 return ScanVerify<char32_t, CharFunc::Scan>(x, xLen, set, setLen, back);
|
|
|
933 }
|
|
|
934
|
|
|
935 void RTNAME(Scan)(Descriptor &result, const Descriptor &string,
|
|
|
936 const Descriptor &set, const Descriptor *back, int kind,
|
|
|
937 const char *sourceFile, int sourceLine) {
|
|
|
938 Terminator terminator{sourceFile, sourceLine};
|
|
|
939 switch (string.raw().type) {
|
|
|
940 case CFI_type_char:
|
|
|
941 GeneralCharFuncKind<char, CharFunc::Scan>(
|
|
|
942 result, string, set, back, kind, terminator);
|
|
|
943 break;
|
|
|
944 case CFI_type_char16_t:
|
|
|
945 GeneralCharFuncKind<char16_t, CharFunc::Scan>(
|
|
|
946 result, string, set, back, kind, terminator);
|
|
|
947 break;
|
|
|
948 case CFI_type_char32_t:
|
|
|
949 GeneralCharFuncKind<char32_t, CharFunc::Scan>(
|
|
|
950 result, string, set, back, kind, terminator);
|
|
|
951 break;
|
|
|
952 default:
|
|
|
953 terminator.Crash(
|
|
|
954 "SCAN: bad string type code %d", static_cast<int>(string.raw().type));
|
|
|
955 }
|
|
|
956 }
|
|
|
957
|
|
|
958 void RTNAME(Repeat)(Descriptor &result, const Descriptor &string,
|
|
236
|
959 std::int64_t ncopies, const char *sourceFile, int sourceLine) {
|
|
221
|
960 Terminator terminator{sourceFile, sourceLine};
|
|
236
|
961 if (ncopies < 0) {
|
|
|
962 terminator.Crash(
|
|
|
963 "REPEAT has negative NCOPIES=%jd", static_cast<std::intmax_t>(ncopies));
|
|
|
964 }
|
|
221
|
965 std::size_t origBytes{string.ElementBytes()};
|
|
|
966 result.Establish(string.type(), origBytes * ncopies, nullptr, 0, nullptr,
|
|
|
967 CFI_attribute_allocatable);
|
|
223
|
968 if (result.Allocate() != CFI_SUCCESS) {
|
|
221
|
969 terminator.Crash("REPEAT could not allocate storage for result");
|
|
|
970 }
|
|
|
971 const char *from{string.OffsetElement()};
|
|
|
972 for (char *to{result.OffsetElement()}; ncopies-- > 0; to += origBytes) {
|
|
|
973 std::memcpy(to, from, origBytes);
|
|
|
974 }
|
|
|
975 }
|
|
|
976
|
|
|
977 void RTNAME(Trim)(Descriptor &result, const Descriptor &string,
|
|
|
978 const char *sourceFile, int sourceLine) {
|
|
|
979 Terminator terminator{sourceFile, sourceLine};
|
|
|
980 std::size_t resultBytes{0};
|
|
|
981 switch (string.raw().type) {
|
|
|
982 case CFI_type_char:
|
|
|
983 resultBytes =
|
|
|
984 LenTrim(string.OffsetElement<const char>(), string.ElementBytes());
|
|
|
985 break;
|
|
|
986 case CFI_type_char16_t:
|
|
|
987 resultBytes = LenTrim(string.OffsetElement<const char16_t>(),
|
|
|
988 string.ElementBytes() >> 1)
|
|
|
989 << 1;
|
|
|
990 break;
|
|
|
991 case CFI_type_char32_t:
|
|
|
992 resultBytes = LenTrim(string.OffsetElement<const char32_t>(),
|
|
|
993 string.ElementBytes() >> 2)
|
|
|
994 << 2;
|
|
|
995 break;
|
|
|
996 default:
|
|
|
997 terminator.Crash(
|
|
|
998 "TRIM: bad string type code %d", static_cast<int>(string.raw().type));
|
|
|
999 }
|
|
|
1000 result.Establish(string.type(), resultBytes, nullptr, 0, nullptr,
|
|
|
1001 CFI_attribute_allocatable);
|
|
223
|
1002 RUNTIME_CHECK(terminator, result.Allocate() == CFI_SUCCESS);
|
|
221
|
1003 std::memcpy(result.OffsetElement(), string.OffsetElement(), resultBytes);
|
|
|
1004 }
|
|
|
1005
|
|
|
1006 std::size_t RTNAME(Verify1)(const char *x, std::size_t xLen, const char *set,
|
|
|
1007 std::size_t setLen, bool back) {
|
|
|
1008 return ScanVerify<char, CharFunc::Verify>(x, xLen, set, setLen, back);
|
|
|
1009 }
|
|
|
1010 std::size_t RTNAME(Verify2)(const char16_t *x, std::size_t xLen,
|
|
|
1011 const char16_t *set, std::size_t setLen, bool back) {
|
|
|
1012 return ScanVerify<char16_t, CharFunc::Verify>(x, xLen, set, setLen, back);
|
|
|
1013 }
|
|
|
1014 std::size_t RTNAME(Verify4)(const char32_t *x, std::size_t xLen,
|
|
|
1015 const char32_t *set, std::size_t setLen, bool back) {
|
|
|
1016 return ScanVerify<char32_t, CharFunc::Verify>(x, xLen, set, setLen, back);
|
|
|
1017 }
|
|
|
1018
|
|
|
1019 void RTNAME(Verify)(Descriptor &result, const Descriptor &string,
|
|
|
1020 const Descriptor &set, const Descriptor *back, int kind,
|
|
|
1021 const char *sourceFile, int sourceLine) {
|
|
|
1022 Terminator terminator{sourceFile, sourceLine};
|
|
|
1023 switch (string.raw().type) {
|
|
|
1024 case CFI_type_char:
|
|
|
1025 GeneralCharFuncKind<char, CharFunc::Verify>(
|
|
|
1026 result, string, set, back, kind, terminator);
|
|
|
1027 break;
|
|
|
1028 case CFI_type_char16_t:
|
|
|
1029 GeneralCharFuncKind<char16_t, CharFunc::Verify>(
|
|
|
1030 result, string, set, back, kind, terminator);
|
|
|
1031 break;
|
|
|
1032 case CFI_type_char32_t:
|
|
|
1033 GeneralCharFuncKind<char32_t, CharFunc::Verify>(
|
|
|
1034 result, string, set, back, kind, terminator);
|
|
|
1035 break;
|
|
|
1036 default:
|
|
|
1037 terminator.Crash(
|
|
|
1038 "VERIFY: bad string type code %d", static_cast<int>(string.raw().type));
|
|
|
1039 }
|
|
|
1040 }
|
|
|
1041
|
|
|
1042 void RTNAME(CharacterMax)(Descriptor &accumulator, const Descriptor &x,
|
|
|
1043 const char *sourceFile, int sourceLine) {
|
|
|
1044 MaxMin<false>(accumulator, x, sourceFile, sourceLine);
|
|
|
1045 }
|
|
|
1046
|
|
|
1047 void RTNAME(CharacterMin)(Descriptor &accumulator, const Descriptor &x,
|
|
|
1048 const char *sourceFile, int sourceLine) {
|
|
|
1049 MaxMin<true>(accumulator, x, sourceFile, sourceLine);
|
|
|
1050 }
|
|
173
|
1051 }
|
|
|
1052 } // namespace Fortran::runtime
|
