1 /********************************************************************/
2 /* */
3 /* s7 Seed7 interpreter */
4 /* Copyright (C) 1990 - 2019 Thomas Mertes */
5 /* */
6 /* This program is free software; you can redistribute it and/or */
7 /* modify it under the terms of the GNU General Public License as */
8 /* published by the Free Software Foundation; either version 2 of */
9 /* the License, or (at your option) any later version. */
10 /* */
11 /* This program is distributed in the hope that it will be useful, */
12 /* but WITHOUT ANY WARRANTY; without even the implied warranty of */
13 /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
14 /* GNU General Public License for more details. */
15 /* */
16 /* You should have received a copy of the GNU General Public */
17 /* License along with this program; if not, write to the */
18 /* Free Software Foundation, Inc., 51 Franklin Street, */
19 /* Fifth Floor, Boston, MA 02110-1301, USA. */
20 /* */
21 /* Module: Library */
22 /* File: seed7/src/strlib.c */
23 /* Changes: 1991 - 1994, 2008, 2010, 2013 - 2019 Thomas Mertes */
24 /* Content: All primitive actions for the string type. */
25 /* */
26 /********************************************************************/
27
28 #define LOG_FUNCTIONS 0
29 #define VERBOSE_EXCEPTIONS 0
30
31 #include "version.h"
32
33 #include "stdlib.h"
34 #include "stdio.h"
35 #include "string.h"
36 #include "wchar.h"
37
38 #include "common.h"
39 #include "data.h"
40 #include "heaputl.h"
41 #include "flistutl.h"
42 #include "chclsutl.h"
43 #include "syvarutl.h"
44 #include "striutl.h"
45 #include "objutl.h"
46 #include "exec.h"
47 #include "runerr.h"
48 #include "str_rtl.h"
49 #include "rtl_err.h"
50
51 #undef EXTERN
52 #define EXTERN
53 #include "strlib.h"
54
55
56 #define INITIAL_ARRAY_SIZE 256
57 #define ARRAY_SIZE_FACTOR 2
58
59
60
61 #if HAS_WMEMCMP && WCHAR_T_SIZE == 32
62 #define memcmp_strelem(mem1, mem2, len) \
63 wmemcmp((const wchar_t *) mem1, (const wchar_t *) mem2, (size_t) len)
64 #else
65
66
67
memcmp_strelem(register const strElemType * mem1,register const strElemType * mem2,memSizeType len)68 static inline int memcmp_strelem (register const strElemType *mem1,
69 register const strElemType *mem2, memSizeType len)
70
71 { /* memcmp_strelem */
72 for (; len > 0; mem1++, mem2++, len--) {
73 if (*mem1 != *mem2) {
74 return *mem1 < *mem2 ? -1 : 1;
75 } /* if */
76 } /* for */
77 return 0;
78 } /* memcmp_strelem */
79
80 #endif
81
82
83
freeStriArray(arrayType work_array,intType used_max_position)84 static void freeStriArray (arrayType work_array, intType used_max_position)
85
86 {
87 memSizeType position;
88
89 /* freeStriArray */
90 for (position = 0; position < (uintType) used_max_position; position++) {
91 FREE_STRI(work_array->arr[position].value.striValue,
92 work_array->arr[position].value.striValue->size);
93 } /* for */
94 FREE_ARRAY(work_array, (uintType) work_array->max_position);
95 } /* freeStriArray */
96
97
98
addCopiedStriToArray(const strElemType * stri_elems,memSizeType length,arrayType work_array,intType used_max_position)99 static arrayType addCopiedStriToArray (const strElemType *stri_elems,
100 memSizeType length, arrayType work_array, intType used_max_position)
101
102 {
103 striType new_stri;
104 arrayType resized_work_array;
105
106 /* addCopiedStriToArray */
107 if (ALLOC_STRI_SIZE_OK(new_stri, length)) {
108 new_stri->size = length;
109 memcpy(new_stri->mem, stri_elems, length * sizeof(strElemType));
110 if (used_max_position >= work_array->max_position) {
111 if (unlikely(work_array->max_position > (intType) (MAX_ARR_INDEX / ARRAY_SIZE_FACTOR) ||
112 (resized_work_array = REALLOC_ARRAY(work_array,
113 (uintType) work_array->max_position,
114 (uintType) work_array->max_position * ARRAY_SIZE_FACTOR)) == NULL)) {
115 FREE_STRI(new_stri, new_stri->size);
116 freeStriArray(work_array, used_max_position);
117 work_array = NULL;
118 } else {
119 work_array = resized_work_array;
120 COUNT3_ARRAY((uintType) work_array->max_position,
121 (uintType) work_array->max_position * ARRAY_SIZE_FACTOR);
122 work_array->max_position *= ARRAY_SIZE_FACTOR;
123 } /* if */
124 } /* if */
125 if (likely(work_array != NULL)) {
126 work_array->arr[used_max_position].type_of = take_type(SYS_STRI_TYPE);
127 work_array->arr[used_max_position].descriptor.property = NULL;
128 work_array->arr[used_max_position].value.striValue = new_stri;
129 INIT_CATEGORY_OF_VAR(&work_array->arr[used_max_position], STRIOBJECT);
130 } /* if */
131 } else {
132 freeStriArray(work_array, used_max_position);
133 work_array = NULL;
134 } /* if */
135 return work_array;
136 } /* addCopiedStriToArray */
137
138
139
completeStriArray(arrayType work_array,intType used_max_position)140 static inline arrayType completeStriArray (arrayType work_array,
141 intType used_max_position)
142
143 {
144 arrayType resized_work_array;
145
146 /* completeStriArray */
147 if (work_array != NULL) {
148 resized_work_array = REALLOC_ARRAY(work_array,
149 (uintType) work_array->max_position,
150 (uintType) used_max_position);
151 if (resized_work_array == NULL) {
152 freeStriArray(work_array, used_max_position);
153 work_array = NULL;
154 } else {
155 work_array = resized_work_array;
156 COUNT3_ARRAY((uintType) work_array->max_position,
157 (uintType) used_max_position);
158 work_array->max_position = used_max_position;
159 } /* if */
160 } /* if */
161 return work_array;
162 } /* completeStriArray */
163
164
165
strChSplit(const const_striType mainStri,const charType delimiter)166 static arrayType strChSplit (const const_striType mainStri,
167 const charType delimiter)
168
169 {
170 intType used_max_position;
171 const strElemType *search_start;
172 const strElemType *search_end;
173 const strElemType *found_pos;
174 arrayType result_array;
175
176 /* strChSplit */
177 logFunction(printf("strChSplit(\"%s\", '\\" FMT_U32 ";')\n",
178 striAsUnquotedCStri(mainStri), delimiter););
179 if (ALLOC_ARRAY(result_array, INITIAL_ARRAY_SIZE)) {
180 result_array->min_position = 1;
181 result_array->max_position = INITIAL_ARRAY_SIZE;
182 used_max_position = 0;
183 search_start = mainStri->mem;
184 search_end = &mainStri->mem[mainStri->size];
185 while ((found_pos = memchr_strelem(search_start, delimiter,
186 (memSizeType) (search_end - search_start))) != NULL &&
187 result_array != NULL) {
188 result_array = addCopiedStriToArray(search_start,
189 (memSizeType) (found_pos - search_start), result_array,
190 used_max_position);
191 used_max_position++;
192 search_start = found_pos + 1;
193 } /* while */
194 if (likely(result_array != NULL)) {
195 result_array = addCopiedStriToArray(search_start,
196 (memSizeType) (search_end - search_start), result_array,
197 used_max_position);
198 used_max_position++;
199 result_array = completeStriArray(result_array, used_max_position);
200 } /* if */
201 } /* if */
202 if (unlikely(result_array == NULL)) {
203 raise_error(MEMORY_ERROR);
204 } /* if */
205 logFunction(printf("strChSplit -->\n"););
206 return result_array;
207 } /* strChSplit */
208
209
210
strSplit(const const_striType mainStri,const const_striType delimiter)211 static arrayType strSplit (const const_striType mainStri,
212 const const_striType delimiter)
213
214 {
215 memSizeType delimiter_size;
216 const strElemType *delimiter_mem;
217 strElemType ch_1;
218 intType used_max_position;
219 const strElemType *search_start;
220 const strElemType *segment_start;
221 const strElemType *search_end;
222 const strElemType *found_pos;
223 arrayType result_array;
224
225 /* strSplit */
226 logFunction(printf("strChSplit(\"%s\", ",
227 striAsUnquotedCStri(mainStri));
228 printf("\"%s\")\n", striAsUnquotedCStri(delimiter)););
229 if (ALLOC_ARRAY(result_array, INITIAL_ARRAY_SIZE)) {
230 result_array->min_position = 1;
231 result_array->max_position = INITIAL_ARRAY_SIZE;
232 used_max_position = 0;
233 delimiter_size = delimiter->size;
234 delimiter_mem = delimiter->mem;
235 search_start = mainStri->mem;
236 segment_start = search_start;
237 if (delimiter_size != 0 && mainStri->size >= delimiter_size) {
238 ch_1 = delimiter_mem[0];
239 search_end = &mainStri->mem[mainStri->size - delimiter_size + 1];
240 while ((found_pos = memchr_strelem(search_start, ch_1,
241 (memSizeType) (search_end - search_start))) != NULL &&
242 result_array != NULL) {
243 if (memcmp(found_pos, delimiter_mem,
244 delimiter_size * sizeof(strElemType)) == 0) {
245 result_array = addCopiedStriToArray(segment_start,
246 (memSizeType) (found_pos - segment_start), result_array,
247 used_max_position);
248 used_max_position++;
249 search_start = found_pos + delimiter_size;
250 segment_start = search_start;
251 if (search_start > search_end) {
252 search_start = search_end;
253 } /* if */
254 } else {
255 search_start = found_pos + 1;
256 } /* if */
257 } /* while */
258 } /* if */
259 if (likely(result_array != NULL)) {
260 result_array = addCopiedStriToArray(segment_start,
261 (memSizeType) (&mainStri->mem[mainStri->size] - segment_start),
262 result_array, used_max_position);
263 used_max_position++;
264 result_array = completeStriArray(result_array, used_max_position);
265 } /* if */
266 } /* if */
267 if (unlikely(result_array == NULL)) {
268 raise_error(MEMORY_ERROR);
269 } /* if */
270 logFunction(printf("strSplit -->\n"););
271 return result_array;
272 } /* strSplit */
273
274
275
276 /**
277 * Append the string 'extension' to 'destination'.
278 * @exception MEMORY_ERROR Not enough memory for the concatenated
279 * string.
280 */
str_append(listType arguments)281 objectType str_append (listType arguments)
282
283 {
284 objectType str_variable;
285 striType str_to;
286 striType str_from;
287 striType new_str;
288 memSizeType new_size;
289 memSizeType str_to_size;
290
291 /* str_append */
292 str_variable = arg_1(arguments);
293 isit_stri(str_variable);
294 is_variable(str_variable);
295 str_to = take_stri(str_variable);
296 isit_stri(arg_3(arguments));
297 str_from = take_stri(arg_3(arguments));
298 if (str_from->size != 0) {
299 str_to_size = str_to->size;
300 if (unlikely(str_to_size > MAX_STRI_LEN - str_from->size)) {
301 /* number of bytes does not fit into memSizeType */
302 return raise_exception(SYS_MEM_EXCEPTION);
303 } else {
304 new_size = str_to_size + str_from->size;
305 GROW_STRI(new_str, str_to, str_to_size, new_size);
306 if (unlikely(new_str == NULL)) {
307 return raise_exception(SYS_MEM_EXCEPTION);
308 } else {
309 if (str_to == str_from) {
310 /* It is possible that str_to == str_from holds. */
311 /* In this case 'str_from' must be corrected */
312 /* after realloc() enlarged 'str_to'. */
313 str_from = new_str;
314 } /* if */
315 COUNT_GROW_STRI(str_to_size, new_size);
316 memcpy(&new_str->mem[str_to_size], str_from->mem,
317 str_from->size * sizeof(strElemType));
318 new_str->size = new_size;
319 str_variable->value.striValue = new_str;
320 } /* if */
321 } /* if */
322 } /* if */
323 return SYS_EMPTY_OBJECT;
324 } /* str_append */
325
326
327
328 /**
329 * Concatenate two strings.
330 * @return the result of the concatenation.
331 */
str_cat(listType arguments)332 objectType str_cat (listType arguments)
333
334 {
335 striType stri1;
336 striType stri2;
337 memSizeType stri1_size;
338 memSizeType result_size;
339 striType result;
340
341 /* str_cat */
342 isit_stri(arg_1(arguments));
343 isit_stri(arg_3(arguments));
344 stri1 = take_stri(arg_1(arguments));
345 stri2 = take_stri(arg_3(arguments));
346 logFunction(printf("str_cat(\"%s\", ",
347 striAsUnquotedCStri(stri1));
348 printf("\"%s\")\n",
349 striAsUnquotedCStri(stri2)););
350 stri1_size = stri1->size;
351 if (unlikely(stri1_size > MAX_STRI_LEN - stri2->size)) {
352 /* number of bytes does not fit into memSizeType */
353 return raise_exception(SYS_MEM_EXCEPTION);
354 } else {
355 result_size = stri1_size + stri2->size;
356 if (TEMP_OBJECT(arg_1(arguments))) {
357 GROW_STRI(result, stri1, stri1_size, result_size);
358 if (unlikely(result == NULL)) {
359 return raise_exception(SYS_MEM_EXCEPTION);
360 } else {
361 COUNT_GROW_STRI(stri1_size, result_size);
362 result->size = result_size;
363 memcpy(&result->mem[stri1_size], stri2->mem,
364 stri2->size * sizeof(strElemType));
365 arg_1(arguments)->value.striValue = NULL;
366 return bld_stri_temp(result);
367 } /* if */
368 } else {
369 if (unlikely(!ALLOC_STRI_SIZE_OK(result, result_size))) {
370 return raise_exception(SYS_MEM_EXCEPTION);
371 } else {
372 result->size = result_size;
373 memcpy(result->mem, stri1->mem,
374 stri1_size * sizeof(strElemType));
375 memcpy(&result->mem[stri1_size], stri2->mem,
376 stri2->size * sizeof(strElemType));
377 return bld_stri_temp(result);
378 } /* if */
379 } /* if */
380 } /* if */
381 } /* str_cat */
382
383
384
385 /**
386 * Search char 'searched' in 'mainStri' at or after 'fromIndex'.
387 * The search starts at 'fromIndex' and proceeds to the right.
388 * The first character in a string has the position 1.
389 * @return the position of 'searched' or 0 if 'mainStri'
390 * does not contain 'searched' at or after 'fromIndex'.
391 * @exception RANGE_ERROR 'fromIndex' <= 0 holds.
392 */
str_chipos(listType arguments)393 objectType str_chipos (listType arguments)
394
395 { /* str_chipos */
396 isit_stri(arg_1(arguments));
397 isit_char(arg_2(arguments));
398 isit_int(arg_3(arguments));
399 return bld_int_temp(
400 strChIPos(take_stri(arg_1(arguments)), take_char(arg_2(arguments)),
401 take_int(arg_3(arguments))));
402 } /* str_chipos */
403
404
405
406 /**
407 * Determine leftmost position of char 'searched' in 'mainStri'.
408 * The first character in a string has the position 1.
409 * @return the position of 'searched' or 0 if 'mainStri'
410 * does not contain 'searched'.
411 */
str_chpos(listType arguments)412 objectType str_chpos (listType arguments)
413
414 { /* str_chpos */
415 isit_stri(arg_1(arguments));
416 isit_char(arg_2(arguments));
417 return bld_int_temp(
418 strChPos(take_stri(arg_1(arguments)), take_char(arg_2(arguments))));
419 } /* str_chpos */
420
421
422
str_chsplit(listType arguments)423 objectType str_chsplit (listType arguments)
424
425 { /* str_chsplit */
426 isit_stri(arg_1(arguments));
427 isit_char(arg_2(arguments));
428 return bld_array_temp(
429 strChSplit(take_stri(arg_1(arguments)), take_char(arg_2(arguments))));
430 } /* str_chsplit */
431
432
433
str_clit(listType arguments)434 objectType str_clit (listType arguments)
435
436 { /* str_clit */
437 isit_stri(arg_1(arguments));
438 return bld_stri_temp(
439 strCLit(take_stri(arg_1(arguments))));
440 } /* str_clit */
441
442
443
444 /**
445 * Compare two strings.
446 * @return -1, 0 or 1 if the first argument is considered to be
447 * respectively less than, equal to, or greater than the
448 * second.
449 */
str_cmp(listType arguments)450 objectType str_cmp (listType arguments)
451
452 {
453 striType stri1;
454 striType stri2;
455 intType signumValue;
456
457 /* str_cmp */
458 isit_stri(arg_1(arguments));
459 isit_stri(arg_2(arguments));
460 stri1 = take_stri(arg_1(arguments));
461 stri2 = take_stri(arg_2(arguments));
462 #if !HAS_WMEMCMP || WCHAR_T_SIZE != 32 || WMEMCMP_RETURNS_SIGNUM
463 if (stri1->size < stri2->size) {
464 signumValue = memcmp_strelem(stri1->mem, stri2->mem, stri1->size);
465 if (signumValue == 0) {
466 signumValue = -1;
467 } /* if */
468 } else {
469 signumValue = memcmp_strelem(stri1->mem, stri2->mem, stri2->size);
470 if (signumValue == 0 && stri1->size > stri2->size) {
471 signumValue = 1;
472 } /* if */
473 } /* if */
474 #else
475 if (stri1->size < stri2->size) {
476 if (memcmp_strelem(stri1->mem, stri2->mem, stri1->size) <= 0) {
477 signumValue = -1;
478 } else {
479 signumValue = 1;
480 } /* if */
481 } else {
482 signumValue = memcmp_strelem(stri1->mem, stri2->mem, stri2->size);
483 if (signumValue == 0) {
484 if (stri1->size > stri2->size) {
485 signumValue = 1;
486 } /* if */
487 } else if (signumValue > 0) {
488 signumValue = 1;
489 } else {
490 signumValue = -1;
491 } /* if */
492 } /* if */
493 #endif
494 return bld_int_temp(signumValue);
495 } /* str_cmp */
496
497
498
499 /**
500 * Assign source/arg_3 to dest/arg_1.
501 * A copy function assumes that dest/arg_1 contains a legal value.
502 */
str_cpy(listType arguments)503 objectType str_cpy (listType arguments)
504
505 {
506 objectType dest;
507 objectType source;
508 memSizeType new_size;
509 striType stri_dest;
510
511 /* str_cpy */
512 dest = arg_1(arguments);
513 source = arg_3(arguments);
514 isit_stri(dest);
515 isit_stri(source);
516 logFunction(printf("str_cpy(\"%s\", ",
517 striAsUnquotedCStri(take_stri(dest)));
518 printf("\"%s\")",
519 striAsUnquotedCStri(take_stri(source)));
520 fflush(stdout););
521 is_variable(dest);
522 stri_dest = take_stri(dest);
523 if (TEMP_OBJECT(source)) {
524 FREE_STRI(stri_dest, stri_dest->size);
525 dest->value.striValue = take_stri(source);
526 source->value.striValue = NULL;
527 } else {
528 new_size = take_stri(source)->size;
529 if (stri_dest->size == new_size) {
530 if (stri_dest != take_stri(source)) {
531 /* It is possible that dest == source holds. The */
532 /* behavior of memcpy() is undefined if source and */
533 /* destination areas overlap (or are identical). */
534 /* Therefore a check for this case is necessary. */
535 memcpy(stri_dest->mem, take_stri(source)->mem,
536 new_size * sizeof(strElemType));
537 } /* if */
538 } else {
539 if (unlikely(!ALLOC_STRI_SIZE_OK(stri_dest, new_size))) {
540 return raise_exception(SYS_MEM_EXCEPTION);
541 } else {
542 FREE_STRI(take_stri(dest), take_stri(dest)->size);
543 dest->value.striValue = stri_dest;
544 stri_dest->size = new_size;
545 } /* if */
546 memcpy(stri_dest->mem, take_stri(source)->mem,
547 new_size * sizeof(strElemType));
548 } /* if */
549 } /* if */
550 logFunctionResult(printf(FMT_X_MEM "\n",
551 (memSizeType) take_stri(dest)););
552 return SYS_EMPTY_OBJECT;
553 } /* str_cpy */
554
555
556
557 /**
558 * Initialize dest/arg_1 and assign source/arg_3 to it.
559 * A create function assumes that the contents of dest/arg_1
560 * is undefined. Create functions can be used to initialize
561 * constants.
562 */
str_create(listType arguments)563 objectType str_create (listType arguments)
564
565 {
566 objectType dest;
567 objectType source;
568 memSizeType new_size;
569 striType new_str;
570
571 /* str_create */
572 dest = arg_1(arguments);
573 source = arg_3(arguments);
574 isit_stri(source);
575 logFunction(printf("str_create(*, \"%s\")",
576 striAsUnquotedCStri(take_stri(source)));
577 fflush(stdout););
578 SET_CATEGORY_OF_OBJ(dest, STRIOBJECT);
579 if (TEMP_OBJECT(source)) {
580 dest->value.striValue = take_stri(source);
581 source->value.striValue = NULL;
582 } else {
583 /* printf("str_create %d !!!\n", in_file.line); */
584 new_size = take_stri(source)->size;
585 if (unlikely(!ALLOC_STRI_SIZE_OK(new_str, new_size))) {
586 dest->value.striValue = NULL;
587 return raise_exception(SYS_MEM_EXCEPTION);
588 } /* if */
589 dest->value.striValue = new_str;
590 new_str->size = new_size;
591 memcpy(new_str->mem, take_stri(source)->mem,
592 new_size * sizeof(strElemType));
593 } /* if */
594 logFunctionResult(printf(FMT_X_MEM "\n",
595 (memSizeType) take_stri(dest)););
596 return SYS_EMPTY_OBJECT;
597 } /* str_create */
598
599
600
601 /**
602 * Free the memory referred by 'old_string/arg_1'.
603 * After str_destr is left 'old_string/arg_1' is NULL.
604 * The memory where 'old_string/arg_1' is stored can be
605 * freed afterwards.
606 */
str_destr(listType arguments)607 objectType str_destr (listType arguments)
608
609 {
610 striType old_string;
611
612 /* str_destr */
613 isit_stri(arg_1(arguments));
614 old_string = take_stri(arg_1(arguments));
615 logFunction(printf("str_destr(\"%s\")\n",
616 striAsUnquotedCStri(old_string)););
617 if (old_string != NULL) {
618 FREE_STRI(old_string, old_string->size);
619 arg_1(arguments)->value.striValue = NULL;
620 } /* if */
621 SET_UNUSED_FLAG(arg_1(arguments));
622 return SYS_EMPTY_OBJECT;
623 } /* str_destr */
624
625
626
627 /**
628 * Assign char 'source' to the 'position' of the 'destination'.
629 * A @:= [B] C;
630 * is equivalent to
631 * A := A[..pred(B)] & str(C) & A[succ(B)..];
632 * @exception INDEX_ERROR If 'position' is negative or zero, or
633 * a character beyond 'destination' would be overwritten
634 * ('position' > length('destination') holds).
635 */
str_elemcpy(listType arguments)636 objectType str_elemcpy (listType arguments)
637
638 {
639 striType stri;
640 intType position;
641
642 /* str_elemcpy */
643 isit_stri(arg_1(arguments));
644 isit_int(arg_4(arguments));
645 isit_char(arg_6(arguments));
646 is_variable(arg_1(arguments));
647 stri = take_stri(arg_1(arguments));
648 position = take_int(arg_4(arguments));
649 if (unlikely(position <= 0 || (uintType) position > stri->size)) {
650 logError(printf("str_elemcpy(\"%s\", " FMT_D ", '\\" FMT_U32 ";'): "
651 "Position %s.\n",
652 striAsUnquotedCStri(stri), position,
653 take_char(arg_6(arguments)),
654 position <= 0 ? "<= 0" : "> length(destination)"););
655 return raise_exception(SYS_IDX_EXCEPTION);
656 } else {
657 stri->mem[position - 1] = (strElemType) take_char(arg_6(arguments));
658 } /* if */
659 return SYS_EMPTY_OBJECT;
660 } /* str_elemcpy */
661
662
663
664 /**
665 * Check if two strings are equal.
666 * @return TRUE if both strings are equal,
667 * FALSE otherwise.
668 */
str_eq(listType arguments)669 objectType str_eq (listType arguments)
670
671 {
672 striType stri1;
673 striType stri2;
674
675 /* str_eq */
676 isit_stri(arg_1(arguments));
677 isit_stri(arg_3(arguments));
678 stri1 = take_stri(arg_1(arguments));
679 stri2 = take_stri(arg_3(arguments));
680 if (stri1->size == stri2->size && memcmp(stri1->mem, stri2->mem,
681 stri1->size * sizeof(strElemType)) == 0) {
682 return SYS_TRUE_OBJECT;
683 } else {
684 return SYS_FALSE_OBJECT;
685 } /* if */
686 } /* str_eq */
687
688
689
690 /**
691 * For-loop which loops over the characters of a 'string'.
692 */
str_for(listType arguments)693 objectType str_for (listType arguments)
694
695 {
696 objectType for_variable;
697 striType stri;
698 objectType statement;
699 memSizeType pos;
700
701 /* str_for */
702 for_variable = arg_2(arguments);
703 isit_char(for_variable);
704 is_variable(for_variable);
705 isit_stri(arg_4(arguments));
706 stri = take_stri(arg_4(arguments));
707 statement = arg_6(arguments);
708 for (pos = 0; pos < stri->size && !fail_flag; pos++) {
709 for_variable->value.charValue = stri->mem[pos];
710 evaluate(statement);
711 } /* for */
712 return SYS_EMPTY_OBJECT;
713 } /* str_for */
714
715
716
717 /**
718 * For-loop which loops over the keys (indices) of a 'string'.
719 */
str_for_key(listType arguments)720 objectType str_for_key (listType arguments)
721
722 {
723 objectType key_variable;
724 striType stri;
725 objectType statement;
726 memSizeType pos;
727
728 /* str_for_key */
729 key_variable = arg_3(arguments);
730 is_variable(key_variable);
731 isit_int(key_variable);
732 isit_stri(arg_5(arguments));
733 stri = take_stri(arg_5(arguments));
734 statement = arg_7(arguments);
735 for (pos = 0; pos < stri->size && !fail_flag; pos++) {
736 key_variable->value.intValue = (intType) (pos + 1);
737 evaluate(statement);
738 } /* for */
739 return SYS_EMPTY_OBJECT;
740 } /* str_for_key */
741
742
743
744 /**
745 * For-loop which loops over characters and keys (indices) of a 'string'.
746 */
str_for_var_key(listType arguments)747 objectType str_for_var_key (listType arguments)
748
749 {
750 objectType for_variable;
751 objectType key_variable;
752 striType stri;
753 objectType statement;
754 memSizeType pos;
755
756 /* str_for_var_key */
757 for_variable = arg_2(arguments);
758 isit_char(for_variable);
759 is_variable(for_variable);
760 key_variable = arg_4(arguments);
761 is_variable(key_variable);
762 isit_int(key_variable);
763 isit_stri(arg_6(arguments));
764 stri = take_stri(arg_6(arguments));
765 statement = arg_8(arguments);
766 for (pos = 0; pos < stri->size && !fail_flag; pos++) {
767 for_variable->value.charValue = stri->mem[pos];
768 key_variable->value.intValue = (intType) (pos + 1);
769 evaluate(statement);
770 } /* for */
771 return SYS_EMPTY_OBJECT;
772 } /* str_for_var_key */
773
774
775
776 /**
777 * Check if stri1 is greater than or equal to stri2.
778 * @return TRUE if stri1 is greater than or equal to stri2,
779 * FALSE otherwise.
780 */
str_ge(listType arguments)781 objectType str_ge (listType arguments)
782
783 {
784 striType stri1;
785 striType stri2;
786 objectType result;
787
788 /* str_ge */
789 isit_stri(arg_1(arguments));
790 isit_stri(arg_3(arguments));
791 stri1 = take_stri(arg_1(arguments));
792 stri2 = take_stri(arg_3(arguments));
793 if (stri1->size >= stri2->size) {
794 if (memcmp_strelem(stri1->mem, stri2->mem, stri2->size) >= 0) {
795 result = SYS_TRUE_OBJECT;
796 } else {
797 result = SYS_FALSE_OBJECT;
798 } /* if */
799 } else {
800 if (memcmp_strelem(stri1->mem, stri2->mem, stri1->size) > 0) {
801 result = SYS_TRUE_OBJECT;
802 } else {
803 result = SYS_FALSE_OBJECT;
804 } /* if */
805 } /* if */
806 return result;
807 } /* str_ge */
808
809
810
811 /**
812 * Check if stri1 is greater than stri2.
813 * @return TRUE if stri1 is greater than stri2,
814 * FALSE otherwise.
815 */
str_gt(listType arguments)816 objectType str_gt (listType arguments)
817
818 {
819 striType stri1;
820 striType stri2;
821 objectType result;
822
823 /* str_gt */
824 isit_stri(arg_1(arguments));
825 isit_stri(arg_3(arguments));
826 stri1 = take_stri(arg_1(arguments));
827 stri2 = take_stri(arg_3(arguments));
828 if (stri1->size > stri2->size) {
829 if (memcmp_strelem(stri1->mem, stri2->mem, stri2->size) >= 0) {
830 result = SYS_TRUE_OBJECT;
831 } else {
832 result = SYS_FALSE_OBJECT;
833 } /* if */
834 } else {
835 if (memcmp_strelem(stri1->mem, stri2->mem, stri1->size) > 0) {
836 result = SYS_TRUE_OBJECT;
837 } else {
838 result = SYS_FALSE_OBJECT;
839 } /* if */
840 } /* if */
841 return result;
842 } /* str_gt */
843
844
845
846 /**
847 * Compute the hash value of a string.
848 * @return the hash value.
849 */
str_hashcode(listType arguments)850 objectType str_hashcode (listType arguments)
851
852 {
853 striType stri;
854
855 /* str_hashcode */
856 isit_stri(arg_1(arguments));
857 stri = take_stri(arg_1(arguments));
858 return bld_int_temp(hashCode(stri));
859 } /* str_hashcode */
860
861
862
863 /**
864 * Get a substring ending at a stop position.
865 * The first character in a string has the position 1.
866 * @return the substring ending at the stop position.
867 * @exception INDEX_ERROR The stop position is negative.
868 * @exception MEMORY_ERROR Not enough memory to represent the result.
869 */
str_head(listType arguments)870 objectType str_head (listType arguments)
871
872 {
873 striType stri;
874 intType stop;
875 memSizeType striSize;
876 memSizeType result_size;
877 striType result;
878
879 /* str_head */
880 isit_stri(arg_1(arguments));
881 isit_int(arg_4(arguments));
882 stri = take_stri(arg_1(arguments));
883 stop = take_int(arg_4(arguments));
884 striSize = stri->size;
885 if (stop >= 1 && striSize >= 1) {
886 if (striSize <= (uintType) stop) {
887 result_size = striSize;
888 } else {
889 result_size = (memSizeType) stop;
890 } /* if */
891 if (TEMP_OBJECT(arg_1(arguments))) {
892 SHRINK_STRI(result, stri, striSize, result_size);
893 if (unlikely(result == NULL)) {
894 return raise_exception(SYS_MEM_EXCEPTION);
895 } /* if */
896 COUNT_SHRINK_STRI(striSize, result_size);
897 result->size = result_size;
898 arg_1(arguments)->value.striValue = NULL;
899 } else {
900 if (unlikely(!ALLOC_STRI_SIZE_OK(result, result_size))) {
901 return raise_exception(SYS_MEM_EXCEPTION);
902 } /* if */
903 result->size = result_size;
904 memcpy(result->mem, stri->mem,
905 result_size * sizeof(strElemType));
906 } /* if */
907 } else if (unlikely(stop < 0)) {
908 return raise_exception(SYS_IDX_EXCEPTION);
909 } else {
910 if (unlikely(!ALLOC_STRI_SIZE_OK(result, (memSizeType) 0))) {
911 return raise_exception(SYS_MEM_EXCEPTION);
912 } /* if */
913 /* Note that the size of the allocated memory is smaller, */
914 /* than the struct. But this is okay, because the element */
915 /* 'mem' respectively 'mem1' is not used. */
916 result->size = 0;
917 } /* if */
918 return bld_stri_temp(result);
919 } /* str_head */
920
921
922
923 /**
924 * Get a character, identified by an index, from a 'string'.
925 * The first character has the index 1.
926 * @return the character specified with the index.
927 * @exception INDEX_ERROR If the index is less than 1 or
928 * greater than the length of the 'string'.
929 */
str_idx(listType arguments)930 objectType str_idx (listType arguments)
931
932 {
933 striType stri;
934 intType position;
935
936 /* str_idx */
937 isit_stri(arg_1(arguments));
938 isit_int(arg_3(arguments));
939 stri = take_stri(arg_1(arguments));
940 position = take_int(arg_3(arguments));
941 if (unlikely(position <= 0 || (uintType) position > stri->size)) {
942 logError(printf("str_idx(\"%s\", " FMT_D "): Position %s.\n",
943 striAsUnquotedCStri(stri), position,
944 position <= 0 ? "<= 0" : "> length(string)"););
945 return raise_exception(SYS_IDX_EXCEPTION);
946 } else {
947 return bld_char_temp((charType) stri->mem[position - 1]);
948 } /* if */
949 } /* str_idx */
950
951
952
953 /**
954 * Search string 'searched' in 'mainStri' at or after 'fromIndex'.
955 * The search starts at 'fromIndex' and proceeds to the right.
956 * The first character in a string has the position 1.
957 * @return the position of 'searched' or 0 if 'mainStri'
958 * does not contain 'searched' at or after 'fromIndex'.
959 * @exception RANGE_ERROR 'fromIndex' <= 0 holds.
960 */
str_ipos(listType arguments)961 objectType str_ipos (listType arguments)
962
963 { /* str_ipos */
964 isit_stri(arg_1(arguments));
965 isit_stri(arg_2(arguments));
966 isit_int(arg_3(arguments));
967 return bld_int_temp(
968 strIPos(take_stri(arg_1(arguments)), take_stri(arg_2(arguments)),
969 take_int(arg_3(arguments))));
970 } /* str_ipos */
971
972
973
974 /**
975 * Check if stri1 is less than or equal to stri2.
976 * @return TRUE if stri1 is less than or equal to stri2,
977 * FALSE otherwise.
978 */
str_le(listType arguments)979 objectType str_le (listType arguments)
980
981 {
982 striType stri1;
983 striType stri2;
984 objectType result;
985
986 /* str_le */
987 isit_stri(arg_1(arguments));
988 isit_stri(arg_3(arguments));
989 stri1 = take_stri(arg_1(arguments));
990 stri2 = take_stri(arg_3(arguments));
991 if (stri1->size <= stri2->size) {
992 if (memcmp_strelem(stri1->mem, stri2->mem, stri1->size) <= 0) {
993 result = SYS_TRUE_OBJECT;
994 } else {
995 result = SYS_FALSE_OBJECT;
996 } /* if */
997 } else {
998 if (memcmp_strelem(stri1->mem, stri2->mem, stri2->size) < 0) {
999 result = SYS_TRUE_OBJECT;
1000 } else {
1001 result = SYS_FALSE_OBJECT;
1002 } /* if */
1003 } /* if */
1004 return result;
1005 } /* str_le */
1006
1007
1008
str_lit(listType arguments)1009 objectType str_lit (listType arguments)
1010
1011 { /* str_lit */
1012 isit_stri(arg_1(arguments));
1013 return bld_stri_temp(
1014 strLit(take_stri(arg_1(arguments))));
1015 } /* str_lit */
1016
1017
1018
1019 /**
1020 * Determine the length of a 'string'.
1021 * @return the length of the 'string'.
1022 */
str_lng(listType arguments)1023 objectType str_lng (listType arguments)
1024
1025 {
1026 striType stri;
1027
1028 /* str_lng */
1029 isit_stri(arg_1(arguments));
1030 stri = take_stri(arg_1(arguments));
1031 #if POINTER_SIZE > INTTYPE_SIZE
1032 if (unlikely(stri->size > MAX_MEM_INDEX)) {
1033 logError(printf("str_lng(\"%s\"): Length does not fit into integer.\n",
1034 striAsUnquotedCStri(stri)););
1035 return raise_exception(SYS_RNG_EXCEPTION);
1036 } /* if */
1037 #endif
1038 return bld_int_temp((intType) stri->size);
1039 } /* str_lng */
1040
1041
1042
1043 /**
1044 * Convert a string to lower case.
1045 * The conversion uses the default Unicode case mapping,
1046 * where each character is considered in isolation.
1047 * Characters without case mapping are left unchanged.
1048 * The mapping is independent from the locale. Individual
1049 * character case mappings cannot be reversed, because some
1050 * characters have multiple characters that map to them.
1051 * @return the string converted to lower case.
1052 */
str_low(listType arguments)1053 objectType str_low (listType arguments)
1054
1055 { /* str_low */
1056 isit_stri(arg_1(arguments));
1057 return bld_stri_temp(
1058 strLow(take_stri(arg_1(arguments))));
1059 } /* str_low */
1060
1061
1062
1063 /**
1064 * Pad a string with spaces at the left side up to pad_size.
1065 * @return the string left padded with spaces.
1066 */
str_lpad(listType arguments)1067 objectType str_lpad (listType arguments)
1068
1069 {
1070 striType stri;
1071 intType pad_size;
1072 memSizeType striSize;
1073 striType result;
1074
1075 /* str_lpad */
1076 isit_stri(arg_1(arguments));
1077 isit_int(arg_3(arguments));
1078 stri = take_stri(arg_1(arguments));
1079 pad_size = take_int(arg_3(arguments));
1080 striSize = stri->size;
1081 if (pad_size > 0 && (uintType) pad_size > striSize) {
1082 if (unlikely((uintType) pad_size > MAX_STRI_LEN ||
1083 !ALLOC_STRI_SIZE_OK(result, (memSizeType) pad_size))) {
1084 return raise_exception(SYS_MEM_EXCEPTION);
1085 } else {
1086 result->size = (memSizeType) pad_size;
1087 {
1088 strElemType *elem = result->mem;
1089 memSizeType idx = (memSizeType) pad_size - striSize - 1;
1090
1091 do {
1092 elem[idx] = (strElemType) ' ';
1093 } while (idx-- != 0);
1094 }
1095 memcpy(&result->mem[(memSizeType) pad_size - striSize], stri->mem,
1096 striSize * sizeof(strElemType));
1097 } /* if */
1098 } else {
1099 if (TEMP_OBJECT(arg_1(arguments))) {
1100 result = stri;
1101 arg_1(arguments)->value.striValue = NULL;
1102 } else {
1103 if (unlikely(!ALLOC_STRI_SIZE_OK(result, striSize))) {
1104 return raise_exception(SYS_MEM_EXCEPTION);
1105 } /* if */
1106 result->size = striSize;
1107 memcpy(result->mem, stri->mem,
1108 striSize * sizeof(strElemType));
1109 } /* if */
1110 } /* if */
1111 return bld_stri_temp(result);
1112 } /* str_lpad */
1113
1114
1115
1116 /**
1117 * Pad a string with zeroes at the left side up to pad_size.
1118 * @return the string left padded with zeroes.
1119 */
str_lpad0(listType arguments)1120 objectType str_lpad0 (listType arguments)
1121
1122 {
1123 striType stri;
1124 intType pad_size;
1125 memSizeType striSize;
1126 strElemType *sourceElem;
1127 strElemType *destElem;
1128 memSizeType len;
1129 striType result;
1130
1131 /* str_lpad0 */
1132 isit_stri(arg_1(arguments));
1133 isit_int(arg_3(arguments));
1134 stri = take_stri(arg_1(arguments));
1135 pad_size = take_int(arg_3(arguments));
1136 striSize = stri->size;
1137 if (pad_size > 0 && (uintType) pad_size > striSize) {
1138 if (unlikely((uintType) pad_size > MAX_STRI_LEN ||
1139 !ALLOC_STRI_SIZE_OK(result, (memSizeType) pad_size))) {
1140 return raise_exception(SYS_MEM_EXCEPTION);
1141 } else {
1142 result->size = (memSizeType) pad_size;
1143 sourceElem = stri->mem;
1144 destElem = result->mem;
1145 len = (memSizeType) pad_size - striSize;
1146 if (striSize != 0 && (sourceElem[0] == '-' || sourceElem[0] == '+')) {
1147 *destElem++ = sourceElem[0];
1148 sourceElem++;
1149 striSize--;
1150 } /* if */
1151 while (len--) {
1152 *destElem++ = (strElemType) '0';
1153 } /* while */
1154 memcpy(destElem, sourceElem, striSize * sizeof(strElemType));
1155 } /* if */
1156 } else {
1157 if (TEMP_OBJECT(arg_1(arguments))) {
1158 result = stri;
1159 arg_1(arguments)->value.striValue = NULL;
1160 } else {
1161 if (unlikely(!ALLOC_STRI_SIZE_OK(result, striSize))) {
1162 return raise_exception(SYS_MEM_EXCEPTION);
1163 } /* if */
1164 result->size = striSize;
1165 memcpy(result->mem, stri->mem,
1166 striSize * sizeof(strElemType));
1167 } /* if */
1168 } /* if */
1169 return bld_stri_temp(result);
1170 } /* str_lpad0 */
1171
1172
1173
1174 /**
1175 * Check if stri1 is less than stri2.
1176 * @return TRUE if stri1 is less than stri2,
1177 * FALSE otherwise.
1178 */
str_lt(listType arguments)1179 objectType str_lt (listType arguments)
1180
1181 {
1182 striType stri1;
1183 striType stri2;
1184 objectType result;
1185
1186 /* str_lt */
1187 isit_stri(arg_1(arguments));
1188 isit_stri(arg_3(arguments));
1189 stri1 = take_stri(arg_1(arguments));
1190 stri2 = take_stri(arg_3(arguments));
1191 if (stri1->size < stri2->size) {
1192 if (memcmp_strelem(stri1->mem, stri2->mem, stri1->size) <= 0) {
1193 result = SYS_TRUE_OBJECT;
1194 } else {
1195 result = SYS_FALSE_OBJECT;
1196 } /* if */
1197 } else {
1198 if (memcmp_strelem(stri1->mem, stri2->mem, stri2->size) < 0) {
1199 result = SYS_TRUE_OBJECT;
1200 } else {
1201 result = SYS_FALSE_OBJECT;
1202 } /* if */
1203 } /* if */
1204 return result;
1205 } /* str_lt */
1206
1207
1208
1209 /**
1210 * Return string with leading whitespace omitted.
1211 * All characters less than or equal to ' ' (space) count as whitespace.
1212 * @return string with leading whitespace omitted.
1213 */
str_ltrim(listType arguments)1214 objectType str_ltrim (listType arguments)
1215
1216 {
1217 striType stri;
1218 memSizeType start;
1219 memSizeType striSize;
1220 striType result;
1221
1222 /* str_ltrim */
1223 isit_stri(arg_1(arguments));
1224 stri = take_stri(arg_1(arguments));
1225 start = 0;
1226 striSize = stri->size;
1227 if (striSize >= 1) {
1228 while (start < striSize && stri->mem[start] <= ' ') {
1229 start++;
1230 } /* while */
1231 striSize -= start;
1232 } /* if */
1233 if (unlikely(!ALLOC_STRI_SIZE_OK(result, striSize))) {
1234 return raise_exception(SYS_MEM_EXCEPTION);
1235 } else {
1236 result->size = striSize;
1237 memcpy(result->mem, &stri->mem[start],
1238 striSize * sizeof(strElemType));
1239 return bld_stri_temp(result);
1240 } /* if */
1241 } /* str_ltrim */
1242
1243
1244
1245 /**
1246 * String multiplication.
1247 * The string 'stri' is concatenated to itself such that in total
1248 * 'factor' strings are concatenated.
1249 * "LA" mult 3 returns "LALALA"
1250 * "WORD" mult 0 returns ""
1251 * @return the result of the string multiplication.
1252 * @exception RANGE_ERROR If the factor is negative.
1253 */
str_mult(listType arguments)1254 objectType str_mult (listType arguments)
1255
1256 { /* str_mult */
1257 isit_stri(arg_1(arguments));
1258 isit_int(arg_3(arguments));
1259 return bld_stri_temp(
1260 strMult(take_stri(arg_1(arguments)), take_int(arg_3(arguments))));
1261 } /* str_mult */
1262
1263
1264
1265 /**
1266 * Check if two strings are not equal.
1267 * @return FALSE if both strings are equal,
1268 * TRUE otherwise.
1269 */
str_ne(listType arguments)1270 objectType str_ne (listType arguments)
1271
1272 {
1273 striType stri1;
1274 striType stri2;
1275
1276 /* str_ne */
1277 isit_stri(arg_1(arguments));
1278 isit_stri(arg_3(arguments));
1279 stri1 = take_stri(arg_1(arguments));
1280 stri2 = take_stri(arg_3(arguments));
1281 if (stri1->size != stri2->size || memcmp(stri1->mem, stri2->mem,
1282 stri1->size * sizeof(strElemType)) != 0) {
1283 return SYS_TRUE_OBJECT;
1284 } else {
1285 return SYS_FALSE_OBJECT;
1286 } /* if */
1287 } /* str_ne */
1288
1289
1290
1291 /**
1292 * Determine leftmost position of string 'searched' in 'mainStri'.
1293 * If the string is found the position of its first character
1294 * is the result. The first character in a string has the position 1.
1295 * @return the position of 'searched' or 0 if 'mainStri'
1296 * does not contain 'searched'.
1297 */
str_pos(listType arguments)1298 objectType str_pos (listType arguments)
1299
1300 { /* str_pos */
1301 isit_stri(arg_1(arguments));
1302 isit_stri(arg_2(arguments));
1303 return bld_int_temp(
1304 strPos(take_stri(arg_1(arguments)), take_stri(arg_2(arguments))));
1305 } /* str_pos */
1306
1307
1308
1309 /**
1310 * Assign string 'source' to the 'position' of the 'destination'.
1311 * A @:= [B] C;
1312 * is equivalent to
1313 * A := A[..pred(B)] & C & A[B+length(C)..];
1314 * @exception INDEX_ERROR If 'position' is negative or zero, or
1315 * if 'destination' is smaller than 'source', or
1316 * characters beyond 'destination' would be overwritten
1317 * ('position' + length('source') > succ(length('destination'))
1318 * holds).
1319 */
str_poscpy(listType arguments)1320 objectType str_poscpy (listType arguments)
1321
1322 {
1323 striType destStri;
1324 striType sourceStri;
1325 intType position;
1326
1327 /* str_poscpy */
1328 isit_stri(arg_1(arguments));
1329 isit_int(arg_4(arguments));
1330 isit_stri(arg_6(arguments));
1331 is_variable(arg_1(arguments));
1332 destStri = take_stri(arg_1(arguments));
1333 position = take_int(arg_4(arguments));
1334 sourceStri = take_stri(arg_6(arguments));
1335 if (unlikely(position <= 0 || destStri->size < sourceStri->size ||
1336 (uintType) position > destStri->size - sourceStri->size + 1)) {
1337 logError(printf("str_poscpy(\"%s\", " FMT_D ", ",
1338 striAsUnquotedCStri(destStri), position);
1339 printf("\"%s\"): Position not in allowed range.\n",
1340 striAsUnquotedCStri(sourceStri)););
1341 return raise_exception(SYS_IDX_EXCEPTION);
1342 } else {
1343 /* It is possible that destStri and sourceStri overlap. */
1344 /* E.g. for the expression: stri @:= [idx] stri; */
1345 /* The behavior of memcpy() is undefined if source */
1346 /* and destination areas overlap (or are identical). */
1347 /* Therefore memmove() is used instead of memcpy(). */
1348 memmove(&destStri->mem[position - 1], sourceStri->mem,
1349 sourceStri->size * sizeof(strElemType));
1350 } /* if */
1351 return SYS_EMPTY_OBJECT;
1352 } /* str_poscpy */
1353
1354
1355
1356 /**
1357 * Append the char 'extension' to 'destination'.
1358 * @exception MEMORY_ERROR Not enough memory for the concatenated
1359 * string.
1360 */
str_push(listType arguments)1361 objectType str_push (listType arguments)
1362
1363 {
1364 objectType str_variable;
1365 striType str_to;
1366 charType char_from;
1367 memSizeType new_size;
1368
1369 /* str_push */
1370 str_variable = arg_1(arguments);
1371 isit_stri(str_variable);
1372 is_variable(str_variable);
1373 str_to = take_stri(str_variable);
1374 isit_char(arg_3(arguments));
1375 char_from = take_char(arg_3(arguments));
1376 new_size = str_to->size + 1;
1377 GROW_STRI(str_to, str_to, str_to->size, new_size);
1378 if (unlikely(str_to == NULL)) {
1379 return raise_exception(SYS_MEM_EXCEPTION);
1380 } else {
1381 COUNT_GROW_STRI(str_to->size, new_size);
1382 str_to->mem[str_to->size] = char_from;
1383 str_to->size = new_size;
1384 str_variable->value.striValue = str_to;
1385 } /* if */
1386 return SYS_EMPTY_OBJECT;
1387 } /* str_push */
1388
1389
1390
1391 /**
1392 * Get a substring from a start position to a stop position.
1393 * The first character in a string has the position 1.
1394 * @return the substring from position start to stop.
1395 * @exception INDEX_ERROR The start position is negative or zero, or
1396 * the stop position is less than pred(start).
1397 * @exception MEMORY_ERROR Not enough memory to represent the result.
1398 */
str_range(listType arguments)1399 objectType str_range (listType arguments)
1400
1401 {
1402 striType stri;
1403 intType start;
1404 intType stop;
1405 memSizeType striSize;
1406 memSizeType result_size;
1407 striType result;
1408
1409 /* str_range */
1410 isit_stri(arg_1(arguments));
1411 isit_int(arg_3(arguments));
1412 isit_int(arg_5(arguments));
1413 stri = take_stri(arg_1(arguments));
1414 start = take_int(arg_3(arguments));
1415 stop = take_int(arg_5(arguments));
1416 striSize = stri->size;
1417 if (unlikely(start < 1)) {
1418 return raise_exception(SYS_IDX_EXCEPTION);
1419 } else if (stop >= start && (uintType) start <= striSize) {
1420 if ((uintType) stop > striSize) {
1421 result_size = striSize - (memSizeType) start + 1;
1422 } else {
1423 result_size = (memSizeType) stop - (memSizeType) start + 1;
1424 } /* if */
1425 if (unlikely(!ALLOC_STRI_SIZE_OK(result, result_size))) {
1426 return raise_exception(SYS_MEM_EXCEPTION);
1427 } /* if */
1428 /* Reversing the order of the following two statements */
1429 /* causes an "Internal Compiler Error" with MSC 6.0 */
1430 /* if using the -Ozacegilt optimisation option in the */
1431 /* large memory model (-AL). Note that the order of the */
1432 /* two statements make no difference to the logic of the */
1433 /* program. */
1434 memcpy(result->mem, &stri->mem[start - 1],
1435 result_size * sizeof(strElemType));
1436 result->size = result_size;
1437 } else if (unlikely(stop < start - 1)) {
1438 return raise_exception(SYS_IDX_EXCEPTION);
1439 } else {
1440 if (unlikely(!ALLOC_STRI_SIZE_OK(result, (memSizeType) 0))) {
1441 return raise_exception(SYS_MEM_EXCEPTION);
1442 } /* if */
1443 /* Note that the size of the allocated memory is smaller, */
1444 /* than the struct. But this is okay, because the element */
1445 /* 'mem' respectively 'mem1' is not used. */
1446 result->size = 0;
1447 } /* if */
1448 return bld_stri_temp(result);
1449 } /* str_range */
1450
1451
1452
1453 /**
1454 * Search char 'searched' in 'mainStri' at or before 'fromIndex'.
1455 * The search starts at 'fromIndex' and proceeds to the left.
1456 * The first character in a string has the position 1.
1457 * @return the position of 'searched' or 0 if 'mainStri'
1458 * does not contain 'searched' at or before 'fromIndex'.
1459 * @exception RANGE_ERROR 'fromIndex' > length(stri) holds.
1460 */
str_rchipos(listType arguments)1461 objectType str_rchipos (listType arguments)
1462
1463 { /* str_rchipos */
1464 isit_stri(arg_1(arguments));
1465 isit_char(arg_2(arguments));
1466 isit_int(arg_3(arguments));
1467 return bld_int_temp(
1468 strRChIPos(take_stri(arg_1(arguments)), take_char(arg_2(arguments)),
1469 take_int(arg_3(arguments))));
1470 } /* str_rchipos */
1471
1472
1473
1474 /**
1475 * Determine rightmost position of char 'searched' in 'mainStri'.
1476 * The first character in a string has the position 1.
1477 * @return the position of 'searched' or 0 if 'mainStri'
1478 * does not contain 'searched'.
1479 */
str_rchpos(listType arguments)1480 objectType str_rchpos (listType arguments)
1481
1482 { /* str_rchpos */
1483 isit_stri(arg_1(arguments));
1484 isit_char(arg_2(arguments));
1485 return bld_int_temp(
1486 strRChPos(take_stri(arg_1(arguments)), take_char(arg_2(arguments))));
1487 } /* str_rchpos */
1488
1489
1490
1491 /**
1492 * Replace all occurrences of 'searched' in 'mainStri' by 'replacement'.
1493 * @return the result of the replacement.
1494 */
str_repl(listType arguments)1495 objectType str_repl (listType arguments)
1496
1497 { /* str_repl */
1498 isit_stri(arg_1(arguments));
1499 isit_stri(arg_2(arguments));
1500 isit_stri(arg_3(arguments));
1501 return bld_stri_temp(
1502 strRepl(take_stri(arg_1(arguments)), take_stri(arg_2(arguments)),
1503 take_stri(arg_3(arguments))));
1504 } /* str_repl */
1505
1506
1507
1508 /**
1509 * Search string 'searched' in 'mainStri' at or before 'fromIndex'.
1510 * The search starts at 'fromIndex' and proceeds to the left.
1511 * The first character in a string has the position 1.
1512 * @return the position of 'searched' or 0 if 'mainStri'
1513 * does not contain 'searched' at or before 'fromIndex'.
1514 * @exception RANGE_ERROR 'fromIndex' > length(stri) holds.
1515 */
str_ripos(listType arguments)1516 objectType str_ripos (listType arguments)
1517
1518 { /* str_ripos */
1519 isit_stri(arg_1(arguments));
1520 isit_stri(arg_2(arguments));
1521 isit_int(arg_3(arguments));
1522 return bld_int_temp(
1523 strRIPos(take_stri(arg_1(arguments)), take_stri(arg_2(arguments)),
1524 take_int(arg_3(arguments))));
1525 } /* str_ripos */
1526
1527
1528
1529 /**
1530 * Pad a string with spaces at the right side up to pad_size.
1531 * @return the string right padded with spaces.
1532 */
str_rpad(listType arguments)1533 objectType str_rpad (listType arguments)
1534
1535 {
1536 striType stri;
1537 intType pad_size;
1538 memSizeType striSize;
1539 striType result;
1540
1541 /* str_rpad */
1542 isit_stri(arg_1(arguments));
1543 isit_int(arg_3(arguments));
1544 stri = take_stri(arg_1(arguments));
1545 pad_size = take_int(arg_3(arguments));
1546 striSize = stri->size;
1547 if (pad_size > 0 && (uintType) pad_size > striSize) {
1548 if (unlikely((uintType) pad_size > MAX_STRI_LEN ||
1549 !ALLOC_STRI_SIZE_OK(result, (memSizeType) pad_size))) {
1550 return raise_exception(SYS_MEM_EXCEPTION);
1551 } else {
1552 result->size = (memSizeType) pad_size;
1553 memcpy(result->mem, stri->mem, striSize * sizeof(strElemType));
1554 {
1555 strElemType *elem = &result->mem[striSize];
1556 memSizeType len = (memSizeType) pad_size - striSize;
1557
1558 while (len--) {
1559 *elem++ = (strElemType) ' ';
1560 } /* while */
1561 }
1562 } /* if */
1563 } else {
1564 if (TEMP_OBJECT(arg_1(arguments))) {
1565 result = stri;
1566 arg_1(arguments)->value.striValue = NULL;
1567 } else {
1568 if (unlikely(!ALLOC_STRI_SIZE_OK(result, striSize))) {
1569 return raise_exception(SYS_MEM_EXCEPTION);
1570 } /* if */
1571 result->size = striSize;
1572 memcpy(result->mem, stri->mem,
1573 striSize * sizeof(strElemType));
1574 } /* if */
1575 } /* if */
1576 return bld_stri_temp(result);
1577 } /* str_rpad */
1578
1579
1580
1581 /**
1582 * Determine rightmost position of string 'searched' in 'mainStri'.
1583 * If the string is found the position of its first character
1584 * is the result. The first character in a string has the position 1.
1585 * @return the position of 'searched' or 0 if 'mainStri'
1586 * does not contain 'searched'.
1587 */
str_rpos(listType arguments)1588 objectType str_rpos (listType arguments)
1589
1590 { /* str_rpos */
1591 isit_stri(arg_1(arguments));
1592 isit_stri(arg_2(arguments));
1593 return bld_int_temp(
1594 strRPos(take_stri(arg_1(arguments)), take_stri(arg_2(arguments))));
1595 } /* str_rpos */
1596
1597
1598
1599 /**
1600 * Return string with trailing whitespace omitted.
1601 * All characters less than or equal to ' ' (space) count as whitespace.
1602 * @return string with trailing whitespace omitted.
1603 */
str_rtrim(listType arguments)1604 objectType str_rtrim (listType arguments)
1605
1606 {
1607 striType stri;
1608 memSizeType striSize;
1609 memSizeType result_size;
1610 striType result;
1611
1612 /* str_rtrim */
1613 isit_stri(arg_1(arguments));
1614 stri = take_stri(arg_1(arguments));
1615 result_size = stri->size;
1616 while (result_size > 0 && stri->mem[result_size - 1] <= ' ') {
1617 result_size--;
1618 } /* while */
1619 if (TEMP_OBJECT(arg_1(arguments))) {
1620 striSize = stri->size;
1621 SHRINK_STRI(result, stri, striSize, result_size);
1622 if (unlikely(result == NULL)) {
1623 return raise_exception(SYS_MEM_EXCEPTION);
1624 } /* if */
1625 COUNT_SHRINK_STRI(striSize, result_size);
1626 result->size = result_size;
1627 arg_1(arguments)->value.striValue = NULL;
1628 } else {
1629 if (unlikely(!ALLOC_STRI_SIZE_OK(result, result_size))) {
1630 return raise_exception(SYS_MEM_EXCEPTION);
1631 } /* if */
1632 result->size = result_size;
1633 memcpy(result->mem, stri->mem,
1634 result_size * sizeof(strElemType));
1635 } /* if */
1636 return bld_stri_temp(result);
1637 } /* str_rtrim */
1638
1639
1640
str_split(listType arguments)1641 objectType str_split (listType arguments)
1642
1643 { /* str_split */
1644 isit_stri(arg_1(arguments));
1645 isit_stri(arg_2(arguments));
1646 return bld_array_temp(
1647 strSplit(take_stri(arg_1(arguments)), take_stri(arg_2(arguments))));
1648 } /* str_split */
1649
1650
1651
1652 /**
1653 * Convert to a string.
1654 * @return its parameter unchanged.
1655 */
str_str(listType arguments)1656 objectType str_str (listType arguments)
1657
1658 {
1659 striType stri;
1660 striType result;
1661
1662 /* str_str */
1663 isit_stri(arg_1(arguments));
1664 stri = take_stri(arg_1(arguments));
1665 if (TEMP_OBJECT(arg_1(arguments))) {
1666 result = stri;
1667 arg_1(arguments)->value.striValue = NULL;
1668 return bld_stri_temp(result);
1669 } else {
1670 if (unlikely(!ALLOC_STRI_SIZE_OK(result, stri->size))) {
1671 return raise_exception(SYS_MEM_EXCEPTION);
1672 } else {
1673 result->size = stri->size;
1674 memcpy(result->mem, stri->mem,
1675 stri->size * sizeof(strElemType));
1676 return bld_stri_temp(result);
1677 } /* if */
1678 } /* if */
1679 } /* str_str */
1680
1681
1682
1683 /**
1684 * Get a substring from a start position with a given length.
1685 * The first character in a string has the position 1.
1686 * @return the substring from the start position with a given length.
1687 * @exception INDEX_ERROR The start position is negative or zero, or
1688 * the length is negative.
1689 * @exception MEMORY_ERROR Not enough memory to represent the result.
1690 */
str_substr(listType arguments)1691 objectType str_substr (listType arguments)
1692
1693 {
1694 striType stri;
1695 intType start;
1696 intType length;
1697 memSizeType striSize;
1698 memSizeType result_size;
1699 striType result;
1700
1701 /* str_substr */
1702 isit_stri(arg_1(arguments));
1703 isit_int(arg_3(arguments));
1704 isit_int(arg_5(arguments));
1705 stri = take_stri(arg_1(arguments));
1706 start = take_int(arg_3(arguments));
1707 length = take_int(arg_5(arguments));
1708 if (unlikely(start < 1 || length < 0)) {
1709 return raise_exception(SYS_IDX_EXCEPTION);
1710 } /* if */
1711 striSize = stri->size;
1712 if (length != 0 && (uintType) start <= striSize) {
1713 if ((uintType) length > striSize - (memSizeType) start + 1) {
1714 result_size = striSize - (memSizeType) start + 1;
1715 } else {
1716 result_size = (memSizeType) length;
1717 } /* if */
1718 if (unlikely(!ALLOC_STRI_SIZE_OK(result, result_size))) {
1719 return raise_exception(SYS_MEM_EXCEPTION);
1720 } /* if */
1721 memcpy(result->mem, &stri->mem[start - 1],
1722 result_size * sizeof(strElemType));
1723 result->size = result_size;
1724 } else {
1725 if (unlikely(!ALLOC_STRI_SIZE_OK(result, (memSizeType) 0))) {
1726 return raise_exception(SYS_MEM_EXCEPTION);
1727 } /* if */
1728 /* Note that the size of the allocated memory is smaller, */
1729 /* than the struct. But this is okay, because the element */
1730 /* 'mem' respectively 'mem1' is not used. */
1731 result->size = 0;
1732 } /* if */
1733 return bld_stri_temp(result);
1734 } /* str_substr */
1735
1736
1737
1738 /**
1739 * Get a substring beginning at a start position.
1740 * The first character in a 'string' has the position 1.
1741 * @return the substring beginning at the start position.
1742 * @exception INDEX_ERROR The start position is negative or zero.
1743 * @exception MEMORY_ERROR Not enough memory to represent the result.
1744 */
str_tail(listType arguments)1745 objectType str_tail (listType arguments)
1746
1747 {
1748 striType stri;
1749 intType start;
1750 memSizeType striSize;
1751 memSizeType result_size;
1752 striType result;
1753
1754 /* str_tail */
1755 isit_stri(arg_1(arguments));
1756 isit_int(arg_3(arguments));
1757 stri = take_stri(arg_1(arguments));
1758 start = take_int(arg_3(arguments));
1759 striSize = stri->size;
1760 if (unlikely(start < 1)) {
1761 return raise_exception(SYS_IDX_EXCEPTION);
1762 } else if ((uintType) start <= striSize && striSize >= 1) {
1763 result_size = striSize - (memSizeType) start + 1;
1764 if (unlikely(!ALLOC_STRI_SIZE_OK(result, result_size))) {
1765 return raise_exception(SYS_MEM_EXCEPTION);
1766 } /* if */
1767 /* Reversing the order of the following two statements */
1768 /* causes an "Internal Compiler Error" with MSC 6.0 */
1769 /* if using the -Ozacegilt optimisation option in the */
1770 /* large memory model (-AL). Note that the order of the */
1771 /* two statements make no difference to the logic of the */
1772 /* program. */
1773 memcpy(result->mem, &stri->mem[start - 1],
1774 result_size * sizeof(strElemType));
1775 result->size = result_size;
1776 } else {
1777 if (unlikely(!ALLOC_STRI_SIZE_OK(result, (memSizeType) 0))) {
1778 return raise_exception(SYS_MEM_EXCEPTION);
1779 } /* if */
1780 /* Note that the size of the allocated memory is smaller, */
1781 /* than the struct. But this is okay, because the element */
1782 /* 'mem' respectively 'mem1' is not used. */
1783 result->size = 0;
1784 } /* if */
1785 return bld_stri_temp(result);
1786 } /* str_tail */
1787
1788
1789
1790 /**
1791 * Convert a string to an UTF-8 encoded string of bytes.
1792 * @param stri/arg_1 Normal (UTF-32) string to be converted to UTF-8.
1793 * @return 'stri' converted to a string of bytes with UTF-8 encoding.
1794 */
str_toutf8(listType arguments)1795 objectType str_toutf8 (listType arguments)
1796
1797 { /* str_toutf8 */
1798 isit_stri(arg_1(arguments));
1799 return bld_stri_temp(
1800 strToUtf8(take_stri(arg_1(arguments))));
1801 } /* str_toutf8 */
1802
1803
1804
1805 /**
1806 * Return string with leading and trailing whitespace omitted.
1807 * All characters less than or equal to ' ' (space) count as whitespace.
1808 * @return string with leading and trailing whitespace omitted.
1809 */
str_trim(listType arguments)1810 objectType str_trim (listType arguments)
1811
1812 {
1813 striType stri;
1814 memSizeType start;
1815 memSizeType striSize;
1816 striType result;
1817
1818 /* str_trim */
1819 isit_stri(arg_1(arguments));
1820 stri = take_stri(arg_1(arguments));
1821 start = 0;
1822 striSize = stri->size;
1823 if (striSize >= 1) {
1824 while (start < striSize && stri->mem[start] <= ' ') {
1825 start++;
1826 } /* while */
1827 while (striSize > start && stri->mem[striSize - 1] <= ' ') {
1828 striSize--;
1829 } /* while */
1830 striSize -= start;
1831 } /* if */
1832 if (unlikely(!ALLOC_STRI_SIZE_OK(result, striSize))) {
1833 return raise_exception(SYS_MEM_EXCEPTION);
1834 } else {
1835 result->size = striSize;
1836 memcpy(result->mem, &stri->mem[start],
1837 striSize * sizeof(strElemType));
1838 return bld_stri_temp(result);
1839 } /* if */
1840 } /* str_trim */
1841
1842
1843
1844 /**
1845 * Convert a string to upper case.
1846 * The conversion uses the default Unicode case mapping,
1847 * where each character is considered in isolation.
1848 * Characters without case mapping are left unchanged.
1849 * The mapping is independent from the locale. Individual
1850 * character case mappings cannot be reversed, because some
1851 * characters have multiple characters that map to them.
1852 * @return the string converted to upper case.
1853 */
str_up(listType arguments)1854 objectType str_up (listType arguments)
1855
1856 { /* str_up */
1857 isit_stri(arg_1(arguments));
1858 return bld_stri_temp(
1859 strUp(take_stri(arg_1(arguments))));
1860 } /* str_up */
1861
1862
1863
1864 /**
1865 * Convert a string with bytes in UTF-8 encoding to UTF-32.
1866 * @param utf8/arg_1 String of bytes encoded with UTF-8.
1867 * @return 'utf8' converted to a normal (UTF-32) string.
1868 * @exception RANGE_ERROR If characters beyond '\255;' are present or
1869 * if 'utf8' is not encoded with UTF-8.
1870 */
str_utf8tostri(listType arguments)1871 objectType str_utf8tostri (listType arguments)
1872
1873 { /* str_utf8tostri */
1874 isit_stri(arg_1(arguments));
1875 return bld_stri_temp(
1876 strUtf8ToStri(take_stri(arg_1(arguments))));
1877 } /* str_utf8tostri */
1878
1879
1880
1881 /**
1882 * Get 'string' value of the object referenced by 'aReference/arg_1'.
1883 * @return the 'string' value of the referenced object.
1884 * @exception RANGE_ERROR If 'aReference/arg_1' is NIL or
1885 * category(aReference) <> STRIOBJECT holds.
1886 */
str_value(listType arguments)1887 objectType str_value (listType arguments)
1888
1889 {
1890 objectType aReference;
1891 striType stri;
1892 striType result;
1893
1894 /* str_value */
1895 isit_reference(arg_1(arguments));
1896 aReference = take_reference(arg_1(arguments));
1897 if (unlikely(aReference == NULL ||
1898 CATEGORY_OF_OBJ(aReference) != STRIOBJECT ||
1899 take_stri(aReference) == NULL)) {
1900 logError(printf("str_value(");
1901 trace1(aReference);
1902 printf("): Category is not STRIOBJECT.\n"););
1903 return raise_exception(SYS_RNG_EXCEPTION);
1904 } else {
1905 stri = take_stri(aReference);
1906 if (unlikely(!ALLOC_STRI_SIZE_OK(result, stri->size))) {
1907 return raise_exception(SYS_MEM_EXCEPTION);
1908 } else {
1909 result->size = stri->size;
1910 memcpy(result->mem, stri->mem,
1911 result->size * sizeof(strElemType));
1912 return bld_stri_temp(result);
1913 } /* if */
1914 } /* if */
1915 } /* str_value */
1916