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>
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>
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>
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>
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>
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>
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>
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>
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>
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>
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>
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>
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 
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 
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 
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 
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 
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 
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 
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 
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 
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 
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 
613 void RTNAME(AdjustL)(Descriptor &result, const Descriptor &string,
614     const char *sourceFile, int sourceLine) {
615   AdjustLR<false>(result, string, sourceFile, sourceLine);
616 }
617 
618 void RTNAME(AdjustR)(Descriptor &result, const Descriptor &string,
619     const char *sourceFile, int sourceLine) {
620   AdjustLR<true>(result, string, sourceFile, sourceLine);
621 }
622 
623 std::size_t RTNAME(LenTrim1)(const char *x, std::size_t chars) {
624   return LenTrim(x, chars);
625 }
626 std::size_t RTNAME(LenTrim2)(const char16_t *x, std::size_t chars) {
627   return LenTrim(x, chars);
628 }
629 std::size_t RTNAME(LenTrim4)(const char32_t *x, std::size_t chars) {
630   return LenTrim(x, chars);
631 }
632 
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 
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 
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 
694 void RTNAME(CharacterMax)(Descriptor &accumulator, const Descriptor &x,
695     const char *sourceFile, int sourceLine) {
696   MaxMin<false>(accumulator, x, sourceFile, sourceLine);
697 }
698 
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