1 //===-- runtime/character.cpp -----------------------------------*- C++ -*-===//
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
9 #include "character.h"
10 #include "descriptor.h"
11 #include "terminator.h"
12 #include "flang/Common/bit-population-count.h"
13 #include "flang/Common/uint128.h"
14 #include <algorithm>
15 #include <cstring>
16
17 namespace Fortran::runtime {
18
19 template <typename CHAR>
CompareToBlankPadding(const CHAR * x,std::size_t chars)20 inline int CompareToBlankPadding(const CHAR *x, std::size_t chars) {
21 for (; chars-- > 0; ++x) {
22 if (*x < ' ') {
23 return -1;
24 }
25 if (*x > ' ') {
26 return 1;
27 }
28 }
29 return 0;
30 }
31
32 template <typename CHAR>
Compare(const CHAR * x,const CHAR * y,std::size_t xChars,std::size_t yChars)33 static int Compare(
34 const CHAR *x, const CHAR *y, std::size_t xChars, std::size_t yChars) {
35 auto minChars{std::min(xChars, yChars)};
36 if constexpr (sizeof(CHAR) == 1) {
37 // don't use for kind=2 or =4, that would fail on little-endian machines
38 int cmp{std::memcmp(x, y, minChars)};
39 if (cmp < 0) {
40 return -1;
41 }
42 if (cmp > 0) {
43 return 1;
44 }
45 if (xChars == yChars) {
46 return 0;
47 }
48 x += minChars;
49 y += minChars;
50 } else {
51 for (std::size_t n{minChars}; n-- > 0; ++x, ++y) {
52 if (*x < *y) {
53 return -1;
54 }
55 if (*x > *y) {
56 return 1;
57 }
58 }
59 }
60 if (int cmp{CompareToBlankPadding(x, xChars - minChars)}) {
61 return cmp;
62 }
63 return -CompareToBlankPadding(y, yChars - minChars);
64 }
65
66 // Shift count to use when converting between character lengths
67 // and byte counts.
68 template <typename CHAR>
69 constexpr int shift{common::TrailingZeroBitCount(sizeof(CHAR))};
70
71 template <typename CHAR>
Compare(Descriptor & result,const Descriptor & x,const Descriptor & y,const Terminator & terminator)72 static void Compare(Descriptor &result, const Descriptor &x,
73 const Descriptor &y, const Terminator &terminator) {
74 RUNTIME_CHECK(
75 terminator, x.rank() == y.rank() || x.rank() == 0 || y.rank() == 0);
76 int rank{std::max(x.rank(), y.rank())};
77 SubscriptValue lb[maxRank], ub[maxRank], xAt[maxRank], yAt[maxRank];
78 SubscriptValue elements{1};
79 for (int j{0}; j < rank; ++j) {
80 lb[j] = 1;
81 if (x.rank() > 0 && y.rank() > 0) {
82 SubscriptValue xUB{x.GetDimension(j).Extent()};
83 SubscriptValue yUB{y.GetDimension(j).Extent()};
84 if (xUB != yUB) {
85 terminator.Crash("Character array comparison: operands are not "
86 "conforming on dimension %d (%jd != %jd)",
87 j + 1, static_cast<std::intmax_t>(xUB),
88 static_cast<std::intmax_t>(yUB));
89 }
90 ub[j] = xUB;
91 } else {
92 ub[j] = (x.rank() ? x : y).GetDimension(j).Extent();
93 }
94 elements *= ub[j];
95 xAt[j] = yAt[j] = 1;
96 }
97 result.Establish(TypeCategory::Logical, 1, ub, rank);
98 if (result.Allocate(lb, ub) != CFI_SUCCESS) {
99 terminator.Crash("Compare: could not allocate storage for result");
100 }
101 std::size_t xChars{x.ElementBytes() >> shift<CHAR>};
102 std::size_t yChars{y.ElementBytes() >> shift<char>};
103 for (SubscriptValue resultAt{0}; elements-- > 0;
104 ++resultAt, x.IncrementSubscripts(xAt), y.IncrementSubscripts(yAt)) {
105 *result.OffsetElement<char>(resultAt) =
106 Compare(x.Element<CHAR>(xAt), y.Element<CHAR>(yAt), xChars, yChars);
107 }
108 }
109
110 template <typename CHAR, bool ADJUSTR>
Adjust(CHAR * to,const CHAR * from,std::size_t chars)111 static void Adjust(CHAR *to, const CHAR *from, std::size_t chars) {
112 if constexpr (ADJUSTR) {
113 std::size_t j{chars}, k{chars};
114 for (; k > 0 && from[k - 1] == ' '; --k) {
115 }
116 while (k > 0) {
117 to[--j] = from[--k];
118 }
119 while (j > 0) {
120 to[--j] = ' ';
121 }
122 } else { // ADJUSTL
123 std::size_t j{0}, k{0};
124 for (; k < chars && from[k] == ' '; ++k) {
125 }
126 while (k < chars) {
127 to[j++] = from[k++];
128 }
129 while (j < chars) {
130 to[j++] = ' ';
131 }
132 }
133 }
134
135 template <typename CHAR, bool ADJUSTR>
AdjustLRHelper(Descriptor & result,const Descriptor & string,const Terminator & terminator)136 static void AdjustLRHelper(Descriptor &result, const Descriptor &string,
137 const Terminator &terminator) {
138 int rank{string.rank()};
139 SubscriptValue lb[maxRank], ub[maxRank], stringAt[maxRank];
140 SubscriptValue elements{1};
141 for (int j{0}; j < rank; ++j) {
142 lb[j] = 1;
143 ub[j] = string.GetDimension(j).Extent();
144 elements *= ub[j];
145 stringAt[j] = 1;
146 }
147 std::size_t elementBytes{string.ElementBytes()};
148 result.Establish(string.type(), elementBytes, ub, rank);
149 if (result.Allocate(lb, ub) != CFI_SUCCESS) {
150 terminator.Crash("ADJUSTL/R: could not allocate storage for result");
151 }
152 for (SubscriptValue resultAt{0}; elements-- > 0;
153 resultAt += elementBytes, string.IncrementSubscripts(stringAt)) {
154 Adjust<CHAR, ADJUSTR>(result.OffsetElement<CHAR>(resultAt),
155 string.Element<const CHAR>(stringAt), elementBytes >> shift<CHAR>);
156 }
157 }
158
159 template <bool ADJUSTR>
AdjustLR(Descriptor & result,const Descriptor & string,const char * sourceFile,int sourceLine)160 void AdjustLR(Descriptor &result, const Descriptor &string,
161 const char *sourceFile, int sourceLine) {
162 Terminator terminator{sourceFile, sourceLine};
163 switch (string.raw().type) {
164 case CFI_type_char:
165 AdjustLRHelper<char, ADJUSTR>(result, string, terminator);
166 break;
167 case CFI_type_char16_t:
168 AdjustLRHelper<char16_t, ADJUSTR>(result, string, terminator);
169 break;
170 case CFI_type_char32_t:
171 AdjustLRHelper<char32_t, ADJUSTR>(result, string, terminator);
172 break;
173 default:
174 terminator.Crash("ADJUSTL/R: bad string type code %d",
175 static_cast<int>(string.raw().type));
176 }
177 }
178
179 template <typename CHAR>
LenTrim(const CHAR * x,std::size_t chars)180 inline std::size_t LenTrim(const CHAR *x, std::size_t chars) {
181 while (chars > 0 && x[chars - 1] == ' ') {
182 --chars;
183 }
184 return chars;
185 }
186
187 template <typename INT, typename CHAR>
LenTrim(Descriptor & result,const Descriptor & string,const Terminator & terminator)188 static void LenTrim(Descriptor &result, const Descriptor &string,
189 const Terminator &terminator) {
190 int rank{string.rank()};
191 SubscriptValue lb[maxRank], ub[maxRank], stringAt[maxRank];
192 SubscriptValue elements{1};
193 for (int j{0}; j < rank; ++j) {
194 lb[j] = 1;
195 ub[j] = string.GetDimension(j).Extent();
196 elements *= ub[j];
197 stringAt[j] = 1;
198 }
199 result.Establish(TypeCategory::Integer, sizeof(INT), ub, rank);
200 if (result.Allocate(lb, ub) != CFI_SUCCESS) {
201 terminator.Crash("LEN_TRIM: could not allocate storage for result");
202 }
203 std::size_t stringElementChars{string.ElementBytes() >> shift<CHAR>};
204 for (SubscriptValue resultAt{0}; elements-- > 0;
205 resultAt += sizeof(INT), string.IncrementSubscripts(stringAt)) {
206 *result.OffsetElement<INT>(resultAt) =
207 LenTrim(string.Element<CHAR>(stringAt), stringElementChars);
208 }
209 }
210
211 template <typename CHAR>
LenTrimKind(Descriptor & result,const Descriptor & string,int kind,const Terminator & terminator)212 static void LenTrimKind(Descriptor &result, const Descriptor &string, int kind,
213 const Terminator &terminator) {
214 switch (kind) {
215 case 1:
216 LenTrim<std::int8_t, CHAR>(result, string, terminator);
217 break;
218 case 2:
219 LenTrim<std::int16_t, CHAR>(result, string, terminator);
220 break;
221 case 4:
222 LenTrim<std::int32_t, CHAR>(result, string, terminator);
223 break;
224 case 8:
225 LenTrim<std::int64_t, CHAR>(result, string, terminator);
226 break;
227 case 16:
228 LenTrim<common::uint128_t, CHAR>(result, string, terminator);
229 break;
230 default:
231 terminator.Crash("LEN_TRIM: bad KIND=%d", kind);
232 }
233 }
234
235 template <typename TO, typename FROM>
CopyAndPad(TO * to,const FROM * from,std::size_t toChars,std::size_t fromChars)236 static void CopyAndPad(
237 TO *to, const FROM *from, std::size_t toChars, std::size_t fromChars) {
238 if constexpr (sizeof(TO) != sizeof(FROM)) {
239 std::size_t copyChars{std::min(toChars, fromChars)};
240 for (std::size_t j{0}; j < copyChars; ++j) {
241 to[j] = from[j];
242 }
243 for (std::size_t j{copyChars}; j < toChars; ++j) {
244 to[j] = static_cast<TO>(' ');
245 }
246 } else if (toChars <= fromChars) {
247 std::memcpy(to, from, toChars * shift<TO>);
248 } else {
249 std::memcpy(to, from, fromChars * shift<TO>);
250 for (std::size_t j{fromChars}; j < toChars; ++j) {
251 to[j] = static_cast<TO>(' ');
252 }
253 }
254 }
255
256 template <typename CHAR, bool ISMIN>
MaxMinHelper(Descriptor & accumulator,const Descriptor & x,const Terminator & terminator)257 static void MaxMinHelper(Descriptor &accumulator, const Descriptor &x,
258 const Terminator &terminator) {
259 RUNTIME_CHECK(terminator,
260 accumulator.rank() == 0 || x.rank() == 0 ||
261 accumulator.rank() == x.rank());
262 SubscriptValue lb[maxRank], ub[maxRank], xAt[maxRank];
263 SubscriptValue elements{1};
264 std::size_t accumChars{accumulator.ElementBytes() >> shift<CHAR>};
265 std::size_t xChars{x.ElementBytes() >> shift<CHAR>};
266 std::size_t chars{std::max(accumChars, xChars)};
267 bool reallocate{accumulator.raw().base_addr == nullptr ||
268 accumChars != xChars || (accumulator.rank() == 0 && x.rank() > 0)};
269 int rank{std::max(accumulator.rank(), x.rank())};
270 for (int j{0}; j < rank; ++j) {
271 lb[j] = 1;
272 if (x.rank() > 0) {
273 ub[j] = x.GetDimension(j).Extent();
274 xAt[j] = x.GetDimension(j).LowerBound();
275 if (accumulator.rank() > 0) {
276 SubscriptValue accumExt{accumulator.GetDimension(j).Extent()};
277 if (accumExt != ub[j]) {
278 terminator.Crash("Character MAX/MIN: operands are not "
279 "conforming on dimension %d (%jd != %jd)",
280 j + 1, static_cast<std::intmax_t>(accumExt),
281 static_cast<std::intmax_t>(ub[j]));
282 }
283 }
284 } else {
285 ub[j] = accumulator.GetDimension(j).Extent();
286 xAt[j] = 1;
287 }
288 elements *= ub[j];
289 }
290 void *old{nullptr};
291 const CHAR *accumData{accumulator.OffsetElement<CHAR>()};
292 if (reallocate) {
293 old = accumulator.raw().base_addr;
294 accumulator.set_base_addr(nullptr);
295 accumulator.raw().elem_len = chars << shift<CHAR>;
296 RUNTIME_CHECK(terminator, accumulator.Allocate(lb, ub) == CFI_SUCCESS);
297 }
298 for (CHAR *result{accumulator.OffsetElement<CHAR>()}; elements-- > 0;
299 accumData += accumChars, result += chars, x.IncrementSubscripts(xAt)) {
300 const CHAR *xData{x.Element<CHAR>(xAt)};
301 int cmp{Compare(accumData, xData, accumChars, xChars)};
302 if constexpr (ISMIN) {
303 cmp = -cmp;
304 }
305 if (cmp < 0) {
306 CopyAndPad(result, xData, chars, xChars);
307 } else if (result != accumData) {
308 CopyAndPad(result, accumData, chars, accumChars);
309 }
310 }
311 FreeMemory(old);
312 }
313
314 template <bool ISMIN>
MaxMin(Descriptor & accumulator,const Descriptor & x,const char * sourceFile,int sourceLine)315 static void MaxMin(Descriptor &accumulator, const Descriptor &x,
316 const char *sourceFile, int sourceLine) {
317 Terminator terminator{sourceFile, sourceLine};
318 RUNTIME_CHECK(terminator, accumulator.raw().type == x.raw().type);
319 switch (accumulator.raw().type) {
320 case CFI_type_char:
321 MaxMinHelper<char, ISMIN>(accumulator, x, terminator);
322 break;
323 case CFI_type_char16_t:
324 MaxMinHelper<char16_t, ISMIN>(accumulator, x, terminator);
325 break;
326 case CFI_type_char32_t:
327 MaxMinHelper<char32_t, ISMIN>(accumulator, x, terminator);
328 break;
329 default:
330 terminator.Crash(
331 "Character MAX/MIN: result does not have a character type");
332 }
333 }
334
335 extern "C" {
336
RTNAME(CharacterConcatenate)337 void RTNAME(CharacterConcatenate)(Descriptor &accumulator,
338 const Descriptor &from, const char *sourceFile, int sourceLine) {
339 Terminator terminator{sourceFile, sourceLine};
340 RUNTIME_CHECK(terminator,
341 accumulator.rank() == 0 || from.rank() == 0 ||
342 accumulator.rank() == from.rank());
343 int rank{std::max(accumulator.rank(), from.rank())};
344 SubscriptValue lb[maxRank], ub[maxRank], fromAt[maxRank];
345 SubscriptValue elements{1};
346 for (int j{0}; j < rank; ++j) {
347 lb[j] = 1;
348 if (accumulator.rank() > 0 && from.rank() > 0) {
349 ub[j] = accumulator.GetDimension(j).Extent();
350 SubscriptValue fromUB{from.GetDimension(j).Extent()};
351 if (ub[j] != fromUB) {
352 terminator.Crash("Character array concatenation: operands are not "
353 "conforming on dimension %d (%jd != %jd)",
354 j + 1, static_cast<std::intmax_t>(ub[j]),
355 static_cast<std::intmax_t>(fromUB));
356 }
357 } else {
358 ub[j] =
359 (accumulator.rank() ? accumulator : from).GetDimension(j).Extent();
360 }
361 elements *= ub[j];
362 fromAt[j] = 1;
363 }
364 std::size_t oldBytes{accumulator.ElementBytes()};
365 void *old{accumulator.raw().base_addr};
366 accumulator.set_base_addr(nullptr);
367 std::size_t fromBytes{from.ElementBytes()};
368 accumulator.raw().elem_len += fromBytes;
369 std::size_t newBytes{accumulator.ElementBytes()};
370 if (accumulator.Allocate(lb, ub) != CFI_SUCCESS) {
371 terminator.Crash(
372 "CharacterConcatenate: could not allocate storage for result");
373 }
374 const char *p{static_cast<const char *>(old)};
375 char *to{static_cast<char *>(accumulator.raw().base_addr)};
376 for (; elements-- > 0;
377 to += newBytes, p += oldBytes, from.IncrementSubscripts(fromAt)) {
378 std::memcpy(to, p, oldBytes);
379 std::memcpy(to + oldBytes, from.Element<char>(fromAt), fromBytes);
380 }
381 FreeMemory(old);
382 }
383
RTNAME(CharacterConcatenateScalar1)384 void RTNAME(CharacterConcatenateScalar1)(
385 Descriptor &accumulator, const char *from, std::size_t chars) {
386 Terminator terminator{__FILE__, __LINE__};
387 RUNTIME_CHECK(terminator, accumulator.rank() == 0);
388 void *old{accumulator.raw().base_addr};
389 accumulator.set_base_addr(nullptr);
390 std::size_t oldLen{accumulator.ElementBytes()};
391 accumulator.raw().elem_len += chars;
392 RUNTIME_CHECK(
393 terminator, accumulator.Allocate(nullptr, nullptr) == CFI_SUCCESS);
394 std::memcpy(accumulator.OffsetElement<char>(oldLen), from, chars);
395 FreeMemory(old);
396 }
397
RTNAME(CharacterAssign)398 void RTNAME(CharacterAssign)(Descriptor &lhs, const Descriptor &rhs,
399 const char *sourceFile, int sourceLine) {
400 Terminator terminator{sourceFile, sourceLine};
401 int rank{lhs.rank()};
402 RUNTIME_CHECK(terminator, rhs.rank() == 0 || rhs.rank() == rank);
403 SubscriptValue ub[maxRank], lhsAt[maxRank], rhsAt[maxRank];
404 SubscriptValue elements{1};
405 std::size_t lhsBytes{lhs.ElementBytes()};
406 std::size_t rhsBytes{rhs.ElementBytes()};
407 bool reallocate{lhs.IsAllocatable() &&
408 (lhs.raw().base_addr == nullptr || lhsBytes != rhsBytes)};
409 for (int j{0}; j < rank; ++j) {
410 lhsAt[j] = lhs.GetDimension(j).LowerBound();
411 if (rhs.rank() > 0) {
412 SubscriptValue lhsExt{lhs.GetDimension(j).Extent()};
413 SubscriptValue rhsExt{rhs.GetDimension(j).Extent()};
414 ub[j] = lhsAt[j] + rhsExt - 1;
415 if (lhsExt != rhsExt) {
416 if (lhs.IsAllocatable()) {
417 reallocate = true;
418 } else {
419 terminator.Crash("Character array assignment: operands are not "
420 "conforming on dimension %d (%jd != %jd)",
421 j + 1, static_cast<std::intmax_t>(lhsExt),
422 static_cast<std::intmax_t>(rhsExt));
423 }
424 }
425 rhsAt[j] = rhs.GetDimension(j).LowerBound();
426 } else {
427 ub[j] = lhs.GetDimension(j).UpperBound();
428 }
429 elements *= ub[j] - lhsAt[j] + 1;
430 }
431 void *old{nullptr};
432 if (reallocate) {
433 old = lhs.raw().base_addr;
434 lhs.set_base_addr(nullptr);
435 lhs.raw().elem_len = lhsBytes = rhsBytes;
436 if (rhs.rank() > 0) {
437 // When the RHS is not scalar, the LHS acquires its bounds.
438 for (int j{0}; j < rank; ++j) {
439 lhsAt[j] = rhsAt[j];
440 ub[j] = rhs.GetDimension(j).UpperBound();
441 }
442 }
443 RUNTIME_CHECK(terminator, lhs.Allocate(lhsAt, ub) == CFI_SUCCESS);
444 }
445 switch (lhs.raw().type) {
446 case CFI_type_char:
447 switch (rhs.raw().type) {
448 case CFI_type_char:
449 for (; elements-- > 0;
450 lhs.IncrementSubscripts(lhsAt), rhs.IncrementSubscripts(rhsAt)) {
451 CopyAndPad(lhs.Element<char>(lhsAt), rhs.Element<char>(rhsAt), lhsBytes,
452 rhsBytes);
453 }
454 break;
455 case CFI_type_char16_t:
456 for (; elements-- > 0;
457 lhs.IncrementSubscripts(lhsAt), rhs.IncrementSubscripts(rhsAt)) {
458 CopyAndPad(lhs.Element<char>(lhsAt), rhs.Element<char16_t>(rhsAt),
459 lhsBytes, rhsBytes >> 1);
460 }
461 break;
462 case CFI_type_char32_t:
463 for (; elements-- > 0;
464 lhs.IncrementSubscripts(lhsAt), rhs.IncrementSubscripts(rhsAt)) {
465 CopyAndPad(lhs.Element<char>(lhsAt), rhs.Element<char32_t>(rhsAt),
466 lhsBytes, rhsBytes >> 2);
467 }
468 break;
469 default:
470 terminator.Crash(
471 "RHS of character assignment does not have a character type");
472 }
473 break;
474 case CFI_type_char16_t:
475 switch (rhs.raw().type) {
476 case CFI_type_char:
477 for (; elements-- > 0;
478 lhs.IncrementSubscripts(lhsAt), rhs.IncrementSubscripts(rhsAt)) {
479 CopyAndPad(lhs.Element<char16_t>(lhsAt), rhs.Element<char>(rhsAt),
480 lhsBytes >> 1, rhsBytes);
481 }
482 break;
483 case CFI_type_char16_t:
484 for (; elements-- > 0;
485 lhs.IncrementSubscripts(lhsAt), rhs.IncrementSubscripts(rhsAt)) {
486 CopyAndPad(lhs.Element<char16_t>(lhsAt), rhs.Element<char16_t>(rhsAt),
487 lhsBytes >> 1, rhsBytes >> 1);
488 }
489 break;
490 case CFI_type_char32_t:
491 for (; elements-- > 0;
492 lhs.IncrementSubscripts(lhsAt), rhs.IncrementSubscripts(rhsAt)) {
493 CopyAndPad(lhs.Element<char16_t>(lhsAt), rhs.Element<char32_t>(rhsAt),
494 lhsBytes >> 1, rhsBytes >> 2);
495 }
496 break;
497 default:
498 terminator.Crash(
499 "RHS of character assignment does not have a character type");
500 }
501 break;
502 case CFI_type_char32_t:
503 switch (rhs.raw().type) {
504 case CFI_type_char:
505 for (; elements-- > 0;
506 lhs.IncrementSubscripts(lhsAt), rhs.IncrementSubscripts(rhsAt)) {
507 CopyAndPad(lhs.Element<char32_t>(lhsAt), rhs.Element<char>(rhsAt),
508 lhsBytes >> 2, rhsBytes);
509 }
510 break;
511 case CFI_type_char16_t:
512 for (; elements-- > 0;
513 lhs.IncrementSubscripts(lhsAt), rhs.IncrementSubscripts(rhsAt)) {
514 CopyAndPad(lhs.Element<char32_t>(lhsAt), rhs.Element<char16_t>(rhsAt),
515 lhsBytes >> 2, rhsBytes >> 1);
516 }
517 break;
518 case CFI_type_char32_t:
519 for (; elements-- > 0;
520 lhs.IncrementSubscripts(lhsAt), rhs.IncrementSubscripts(rhsAt)) {
521 CopyAndPad(lhs.Element<char32_t>(lhsAt), rhs.Element<char32_t>(rhsAt),
522 lhsBytes >> 2, rhsBytes >> 2);
523 }
524 break;
525 default:
526 terminator.Crash(
527 "RHS of character assignment does not have a character type");
528 }
529 break;
530 default:
531 terminator.Crash(
532 "LHS of character assignment does not have a character type");
533 }
534 if (reallocate) {
535 FreeMemory(old);
536 }
537 }
538
RTNAME(CharacterCompareScalar)539 int RTNAME(CharacterCompareScalar)(const Descriptor &x, const Descriptor &y) {
540 Terminator terminator{__FILE__, __LINE__};
541 RUNTIME_CHECK(terminator, x.rank() == 0);
542 RUNTIME_CHECK(terminator, y.rank() == 0);
543 RUNTIME_CHECK(terminator, x.raw().type == y.raw().type);
544 switch (x.raw().type) {
545 case CFI_type_char:
546 return Compare(x.OffsetElement<char>(), y.OffsetElement<char>(),
547 x.ElementBytes(), y.ElementBytes());
548 case CFI_type_char16_t:
549 return Compare(x.OffsetElement<char16_t>(), y.OffsetElement<char16_t>(),
550 x.ElementBytes() >> 1, y.ElementBytes() >> 1);
551 case CFI_type_char32_t:
552 return Compare(x.OffsetElement<char32_t>(), y.OffsetElement<char32_t>(),
553 x.ElementBytes() >> 2, y.ElementBytes() >> 2);
554 default:
555 terminator.Crash("CharacterCompareScalar: bad string type code %d",
556 static_cast<int>(x.raw().type));
557 }
558 return 0;
559 }
560
RTNAME(CharacterCompareScalar1)561 int RTNAME(CharacterCompareScalar1)(
562 const char *x, const char *y, std::size_t xChars, std::size_t yChars) {
563 return Compare(x, y, xChars, yChars);
564 }
565
RTNAME(CharacterCompareScalar2)566 int RTNAME(CharacterCompareScalar2)(const char16_t *x, const char16_t *y,
567 std::size_t xChars, std::size_t yChars) {
568 return Compare(x, y, xChars, yChars);
569 }
570
RTNAME(CharacterCompareScalar4)571 int RTNAME(CharacterCompareScalar4)(const char32_t *x, const char32_t *y,
572 std::size_t xChars, std::size_t yChars) {
573 return Compare(x, y, xChars, yChars);
574 }
575
RTNAME(CharacterCompare)576 void RTNAME(CharacterCompare)(
577 Descriptor &result, const Descriptor &x, const Descriptor &y) {
578 Terminator terminator{__FILE__, __LINE__};
579 RUNTIME_CHECK(terminator, x.raw().type == y.raw().type);
580 switch (x.raw().type) {
581 case CFI_type_char:
582 Compare<char>(result, x, y, terminator);
583 break;
584 case CFI_type_char16_t:
585 Compare<char16_t>(result, x, y, terminator);
586 break;
587 case CFI_type_char32_t:
588 Compare<char32_t>(result, x, y, terminator);
589 break;
590 default:
591 terminator.Crash("CharacterCompareScalar: bad string type code %d",
592 static_cast<int>(x.raw().type));
593 }
594 }
595
RTNAME(CharacterAppend1)596 std::size_t RTNAME(CharacterAppend1)(char *lhs, std::size_t lhsBytes,
597 std::size_t offset, const char *rhs, std::size_t rhsBytes) {
598 if (auto n{std::min(lhsBytes - offset, rhsBytes)}) {
599 std::memcpy(lhs + offset, rhs, n);
600 offset += n;
601 }
602 return offset;
603 }
604
RTNAME(CharacterPad1)605 void RTNAME(CharacterPad1)(char *lhs, std::size_t bytes, std::size_t offset) {
606 if (bytes > offset) {
607 std::memset(lhs + offset, ' ', bytes - offset);
608 }
609 }
610
611 // Intrinsic functions
612
RTNAME(AdjustL)613 void RTNAME(AdjustL)(Descriptor &result, const Descriptor &string,
614 const char *sourceFile, int sourceLine) {
615 AdjustLR<false>(result, string, sourceFile, sourceLine);
616 }
617
RTNAME(AdjustR)618 void RTNAME(AdjustR)(Descriptor &result, const Descriptor &string,
619 const char *sourceFile, int sourceLine) {
620 AdjustLR<true>(result, string, sourceFile, sourceLine);
621 }
622
RTNAME(LenTrim1)623 std::size_t RTNAME(LenTrim1)(const char *x, std::size_t chars) {
624 return LenTrim(x, chars);
625 }
RTNAME(LenTrim2)626 std::size_t RTNAME(LenTrim2)(const char16_t *x, std::size_t chars) {
627 return LenTrim(x, chars);
628 }
RTNAME(LenTrim4)629 std::size_t RTNAME(LenTrim4)(const char32_t *x, std::size_t chars) {
630 return LenTrim(x, chars);
631 }
632
RTNAME(LenTrim)633 void RTNAME(LenTrim)(Descriptor &result, const Descriptor &string, int kind,
634 const char *sourceFile, int sourceLine) {
635 Terminator terminator{sourceFile, sourceLine};
636 switch (string.raw().type) {
637 case CFI_type_char:
638 LenTrimKind<char>(result, string, kind, terminator);
639 break;
640 case CFI_type_char16_t:
641 LenTrimKind<char16_t>(result, string, kind, terminator);
642 break;
643 case CFI_type_char32_t:
644 LenTrimKind<char32_t>(result, string, kind, terminator);
645 break;
646 default:
647 terminator.Crash("LEN_TRIM: bad string type code %d",
648 static_cast<int>(string.raw().type));
649 }
650 }
651
RTNAME(Repeat)652 void RTNAME(Repeat)(Descriptor &result, const Descriptor &string,
653 std::size_t ncopies, const char *sourceFile, int sourceLine) {
654 Terminator terminator{sourceFile, sourceLine};
655 std::size_t origBytes{string.ElementBytes()};
656 result.Establish(string.type(), origBytes * ncopies, nullptr, 0);
657 if (result.Allocate(nullptr, nullptr) != CFI_SUCCESS) {
658 terminator.Crash("REPEAT could not allocate storage for result");
659 }
660 const char *from{string.OffsetElement()};
661 for (char *to{result.OffsetElement()}; ncopies-- > 0; to += origBytes) {
662 std::memcpy(to, from, origBytes);
663 }
664 }
665
RTNAME(Trim)666 void RTNAME(Trim)(Descriptor &result, const Descriptor &string,
667 const char *sourceFile, int sourceLine) {
668 Terminator terminator{sourceFile, sourceLine};
669 std::size_t resultBytes{0};
670 switch (string.raw().type) {
671 case CFI_type_char:
672 resultBytes =
673 LenTrim(string.OffsetElement<const char>(), string.ElementBytes());
674 break;
675 case CFI_type_char16_t:
676 resultBytes = LenTrim(string.OffsetElement<const char16_t>(),
677 string.ElementBytes() >> 1)
678 << 1;
679 break;
680 case CFI_type_char32_t:
681 resultBytes = LenTrim(string.OffsetElement<const char32_t>(),
682 string.ElementBytes() >> 2)
683 << 2;
684 break;
685 default:
686 terminator.Crash(
687 "TRIM: bad string type code %d", static_cast<int>(string.raw().type));
688 }
689 result.Establish(string.type(), resultBytes, nullptr, 0);
690 RUNTIME_CHECK(terminator, result.Allocate(nullptr, nullptr) == CFI_SUCCESS);
691 std::memcpy(result.OffsetElement(), string.OffsetElement(), resultBytes);
692 }
693
RTNAME(CharacterMax)694 void RTNAME(CharacterMax)(Descriptor &accumulator, const Descriptor &x,
695 const char *sourceFile, int sourceLine) {
696 MaxMin<false>(accumulator, x, sourceFile, sourceLine);
697 }
698
RTNAME(CharacterMin)699 void RTNAME(CharacterMin)(Descriptor &accumulator, const Descriptor &x,
700 const char *sourceFile, int sourceLine) {
701 MaxMin<true>(accumulator, x, sourceFile, sourceLine);
702 }
703
704 // TODO: Character MAXVAL/MINVAL
705 // TODO: Character MAXLOC/MINLOC
706 }
707 } // namespace Fortran::runtime
708