1 /* -*- mode: C; mode: fold; -*- */
2 /* string manipulation functions for S-Lang. */
3 /*
4 Copyright (C) 2004-2017,2018 John E. Davis
5
6 This file is part of the S-Lang Library.
7
8 The S-Lang Library is free software; you can redistribute it and/or
9 modify it under the terms of the GNU General Public License as
10 published by the Free Software Foundation; either version 2 of the
11 License, or (at your option) any later version.
12
13 The S-Lang Library is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
16 General Public License for more details.
17
18 You should have received a copy of the GNU General Public License
19 along with this library; if not, write to the Free Software
20 Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
21 USA.
22 */
23
24 #include "slinclud.h"
25 /*{{{ Include Files */
26
27 #include <time.h>
28
29 #ifndef __QNX__
30 # if defined(__GO32__) || defined(__WATCOMC__)
31 # include <dos.h>
32 # include <bios.h>
33 # endif
34 #endif
35
36 #if SLANG_HAS_FLOAT
37 #include <math.h>
38 #endif
39
40 #include <string.h>
41 #include <stdarg.h>
42 #include <ctype.h>
43
44 #ifndef isdigit
45 # define isdigit(x) (((x) >= '0') && ((x) <= '9'))
46 #endif
47
48 #include "slang.h"
49 #include "_slang.h"
50
51 /*}}}*/
52
53 #define STRLEN(x,ignore_combining) (_pSLinterp_UTF8_Mode \
54 ? SLutf8_strlen ((SLuchar_Type *)(x), ignore_combining) \
55 : strlen (x))
56 #define SKIP_CHAR(s,smax) (_pSLinterp_UTF8_Mode \
57 ? SLutf8_skip_char ((s),(smax)) : (s)+1)
58
59 static SLwchar_Lut_Type *WhiteSpace_Lut;
60
61 _INLINE_
make_whitespace_lut(void)62 static SLwchar_Lut_Type *make_whitespace_lut (void)
63 {
64 if (WhiteSpace_Lut != NULL)
65 return WhiteSpace_Lut;
66
67 return WhiteSpace_Lut = SLwchar_strtolut ((SLuchar_Type *)"\\s", 1, 1);
68 }
69
pop_lut(int * invertp)70 static SLwchar_Lut_Type *pop_lut (int *invertp)
71 {
72 char *white;
73 int invert;
74 SLwchar_Lut_Type *lut;
75
76 if (-1 == SLang_pop_slstring (&white))
77 return NULL;
78 if (*white == '^')
79 invert = 1;
80 else
81 invert = 0;
82
83 lut = SLwchar_strtolut ((SLuchar_Type *)white+invert, 1, 1);
84 _pSLang_free_slstring (white);
85 *invertp = invert;
86 return lut;
87 }
88
do_trim(SLuchar_Type ** beg,int do_beg,SLuchar_Type ** end,int do_end,SLwchar_Lut_Type * lut,int invert)89 static unsigned int do_trim (SLuchar_Type **beg, int do_beg,
90 SLuchar_Type **end, int do_end,
91 SLwchar_Lut_Type *lut, int invert) /*{{{*/
92 {
93 unsigned int len;
94 SLuchar_Type *a, *b;
95 int ignore_combining = 0;
96
97 a = *beg;
98 len = _pSLstring_bytelen ((char *)a);
99 b = a + len;
100
101 if (do_beg)
102 a = SLwchar_skip_range (lut, a, b, ignore_combining, invert);
103
104 if (do_end)
105 b = SLwchar_bskip_range (lut, a, b, ignore_combining, invert);
106
107 len = (unsigned int) (b - a);
108 *beg = a;
109 *end = b;
110
111 return len;
112 }
113
114 /*}}}*/
115
116 /*}}}*/
117
pop_3_malloced_strings(char ** a,char ** b,char ** c)118 static int pop_3_malloced_strings (char **a, char **b, char **c)
119 {
120 *a = *b = *c = NULL;
121 if (-1 == SLpop_string (c))
122 return -1;
123
124 if (-1 == SLpop_string (b))
125 {
126 SLfree (*c);
127 *c = NULL;
128 return -1;
129 }
130
131 if (-1 == SLpop_string (a))
132 {
133 SLfree (*b);
134 SLfree (*c);
135 *b = *c = NULL;
136 return -1;
137 }
138
139 return 0;
140 }
141
free_3_malloced_strings(char * a,char * b,char * c)142 static void free_3_malloced_strings (char *a, char *b, char *c)
143 {
144 SLfree (a);
145 SLfree (b);
146 SLfree (c);
147 }
148
strcat_cmd(void)149 static void strcat_cmd (void) /*{{{*/
150 {
151 char *c, *c1;
152 int nargs;
153 int i;
154 char **ptrs;
155 unsigned int len;
156 char *ptrs_buf[10];
157
158 nargs = SLang_Num_Function_Args;
159 if (nargs <= 0) nargs = 2;
160
161 if (nargs <= 10)
162 ptrs = ptrs_buf;
163 else if (NULL == (ptrs = (char **)_SLcalloc (nargs, sizeof (char *))))
164 return;
165
166 memset ((char *) ptrs, 0, sizeof (char *) * nargs);
167
168 c = NULL;
169 i = nargs;
170 len = 0;
171 while (i != 0)
172 {
173 char *s;
174
175 i--;
176 if (-1 == SLang_pop_slstring (&s))
177 goto free_and_return;
178 ptrs[i] = s;
179 len += _pSLstring_bytelen (s);
180 }
181 if (NULL == (c = _pSLallocate_slstring (len)))
182 goto free_and_return;
183
184 c1 = c;
185 for (i = 0; i < nargs; i++)
186 {
187 unsigned int len2 = _pSLstring_bytelen (ptrs[i]);
188 memcpy (c1, ptrs[i], len2);
189 c1 += len2; /* c1 does not take advantage of the slstring cache */
190 }
191 *c1 = 0;
192
193 free_and_return:
194 for (i = 0; i < nargs; i++)
195 _pSLang_free_slstring (ptrs[i]);
196 if (ptrs != ptrs_buf)
197 SLfree ((char *) ptrs);
198
199 (void) _pSLpush_alloced_slstring (c, len); /* NULL ok */
200 }
201
202 /*}}}*/
203
204 _INLINE_
_pSLang_push_nstring(char * a,unsigned int len)205 static int _pSLang_push_nstring (char *a, unsigned int len)
206 {
207 a = SLang_create_nslstring (a, len);
208 if (a == NULL)
209 return -1;
210
211 if (0 == SLclass_push_ptr_obj (SLANG_STRING_TYPE, (VOID_STAR)a))
212 return 0;
213
214 SLang_free_slstring (a);
215 return -1;
216 }
217
str_replace_cmd_1(char * orig,char * match,char * rep,unsigned int max_num_replaces,char ** new_strp)218 static int str_replace_cmd_1 (char *orig, char *match, char *rep, unsigned int max_num_replaces,
219 char **new_strp) /*{{{*/
220 {
221 char *s, *t, *new_str;
222 size_t rep_len, match_len, new_len;
223 unsigned int num_replaces;
224
225 *new_strp = NULL;
226
227 match_len = strlen (match);
228
229 if (match_len == 0)
230 return 0;
231
232 num_replaces = 0;
233 s = orig;
234 while (num_replaces < max_num_replaces)
235 {
236 s = strstr (s, match);
237 if (s == NULL)
238 break;
239 s += match_len;
240 num_replaces++;
241 }
242
243 if (num_replaces == 0)
244 return 0;
245
246 max_num_replaces = num_replaces;
247
248 rep_len = strlen (rep);
249
250 new_len = (strlen (orig) - num_replaces * match_len) + num_replaces * rep_len;
251 new_str = (char *)SLmalloc (new_len + 1);
252 if (new_str == NULL)
253 return -1;
254
255 s = orig;
256 t = new_str;
257
258 for (num_replaces = 0; num_replaces < max_num_replaces; num_replaces++)
259 {
260 char *next_s;
261 unsigned int len;
262
263 next_s = strstr (s, match); /* cannot be NULL */
264 len = (unsigned int) (next_s - s);
265 memcpy (t, s, len);
266 t += len;
267 memcpy (t, rep, rep_len);
268 t += rep_len;
269
270 s = next_s + match_len;
271 }
272 strcpy (t, s); /* will \0 terminate t */
273 *new_strp = new_str;
274
275 return (int) num_replaces;
276 }
277
278 /*}}}*/
279
reverse_string(char * a)280 static void reverse_string (char *a)
281 {
282 char *b;
283
284 b = a + strlen (a);
285 while (b > a)
286 {
287 char ch;
288
289 b--;
290 ch = *a;
291 *a++ = *b;
292 *b = ch;
293 }
294 }
295
strreplace_cmd(void)296 static void strreplace_cmd (void)
297 {
298 char *orig, *match, *rep;
299 char *new_str;
300 int max_num_replaces = -1;
301 int ret;
302 int has_max_num_replaces;
303
304 has_max_num_replaces = (SLang_Num_Function_Args == 4);
305 if (has_max_num_replaces
306 && (-1 == SLang_pop_int (&max_num_replaces)))
307 return;
308
309 if (-1 == pop_3_malloced_strings (&orig, &match, &rep))
310 return;
311
312 if (has_max_num_replaces == 0)
313 max_num_replaces = _pSLstring_bytelen (orig);
314
315 if (max_num_replaces < 0)
316 {
317 reverse_string (orig);
318 reverse_string (match);
319 reverse_string (rep);
320 ret = str_replace_cmd_1 (orig, match, rep, -max_num_replaces, &new_str);
321 if (ret > 0) reverse_string (new_str);
322 else if (ret == 0)
323 reverse_string (orig);
324 }
325 else ret = str_replace_cmd_1 (orig, match, rep, max_num_replaces, &new_str);
326
327 if (ret >= 0)
328 {
329 if (ret == 0)
330 {
331 (void) SLang_push_malloced_string (orig); /* Always frees orig */
332 orig = NULL;
333 }
334 else
335 (void) SLang_push_malloced_string (new_str);
336
337 if (has_max_num_replaces)
338 (void) SLang_push_integer (ret);
339 }
340 free_3_malloced_strings (orig, match, rep);
341 }
342
343 /* FIXME: This function is deprecated and should removed */
str_replace_cmd(char * orig,char * match,char * rep)344 static int str_replace_cmd (char *orig, char *match, char *rep)
345 {
346 char *s;
347 int ret;
348
349 ret = str_replace_cmd_1 (orig, match, rep, 1, &s);
350 if (ret == 1)
351 (void) SLang_push_malloced_string (s);
352 return ret;
353 }
354
strtok_cmd(char * str)355 static void strtok_cmd (char *str)
356 {
357 _pSLString_List_Type sl;
358 SLuchar_Type *s, *smax, *white;
359 SLwchar_Lut_Type *lut;
360 int invert;
361 int ignore_combining = 0;
362
363 invert = 0;
364
365 if (SLang_Num_Function_Args == 1)
366 {
367 white = NULL;
368 lut = make_whitespace_lut ();
369 }
370 else
371 {
372 white = (SLuchar_Type *)str;
373 if (-1 == SLang_pop_slstring (&str))
374 return;
375 if (*white == '^')
376 {
377 invert = 1;
378 white++;
379 }
380 lut = SLwchar_strtolut (white, 1, 1);
381 }
382
383 if ((lut == NULL)
384 || (-1 == _pSLstring_list_init (&sl, 256, 1024)))
385 goto the_return;
386
387 s = (SLuchar_Type *)str;
388 smax = s + _pSLstring_bytelen ((SLstr_Type *)s);
389 while (s < smax)
390 {
391 SLuchar_Type *s0;
392 char *new_s;
393
394 /* Skip whitespace */
395 s0 = SLwchar_skip_range (lut, s, smax, ignore_combining, invert);
396
397 if (s0 == smax)
398 break;
399
400 /* skip non-whitespace */
401 s = SLwchar_skip_range (lut, s0, smax, ignore_combining, !invert);
402
403 new_s = SLang_create_nslstring ((char *)s0, (unsigned int) (s - s0));
404 if (new_s == NULL)
405 {
406 _pSLstring_list_delete (&sl);
407 goto the_return;
408 }
409 if (-1 == _pSLstring_list_append (&sl, new_s))
410 {
411 _pSLang_free_slstring (new_s);
412 _pSLstring_list_delete (&sl);
413 goto the_return;
414 }
415 }
416
417 /* Deletes sl */
418 (void) _pSLstring_list_push (&sl, 1);
419
420 the_return:
421 if (white != NULL)
422 {
423 _pSLang_free_slstring (str);
424 SLwchar_free_lut (lut);
425 }
426 }
427
428 /* This routine returns the string with text removed between single character
429 comment delimiters from the set b and e. */
430
str_uncomment_string_cmd(char * str,char * b,char * e)431 static void str_uncomment_string_cmd (char *str, char *b, char *e) /*{{{*/
432 {
433 SLuchar_Type *s, *smax, *bmax, *emax;
434 SLwchar_Lut_Type *lut;
435 size_t len, elen, blen;
436 SLuchar_Type *etable;
437 SLuchar_Type *b1, *e1;
438 int ignore_combining = 0;
439
440 blen = _pSLstring_bytelen (b);
441 elen = _pSLstring_bytelen (e);
442
443 if (((elen != blen) && (_pSLinterp_UTF8_Mode == 0))
444 || (_pSLinterp_UTF8_Mode
445 && SLutf8_strlen ((SLuchar_Type*)b,ignore_combining) != SLutf8_strlen ((SLuchar_Type*)e,ignore_combining)))
446 {
447 _pSLang_verror (SL_INVALID_PARM, "Comment delimiter length mismatch.");
448 return;
449 }
450
451 if (NULL == (etable = (SLuchar_Type *) _SLcalloc (blen, (SLUTF8_MAX_MBLEN+1))))
452 return;
453
454 b1 = (SLuchar_Type *) b;
455 e1 = (SLuchar_Type *) e;
456 emax = e1 + elen;
457 bmax = b1 + blen;
458
459 if (_pSLinterp_UTF8_Mode)
460 {
461 while (b1 < bmax)
462 {
463 SLuchar_Type *et = etable + (SLUTF8_MAX_MBLEN+1)*((char*)b1-b);
464 e1 = SLutf8_extract_utf8_char (e1, emax, et);
465 b1 = SLutf8_skip_char (b1, bmax);
466 }
467 }
468 else
469 {
470 while (b1 < bmax)
471 {
472 SLuchar_Type *et = etable + (SLUTF8_MAX_MBLEN+1)*((char*)b1-b);
473 *et++ = *e1++; *et = 0;
474 b1++;
475 }
476 }
477
478 if (NULL == (lut = SLwchar_strtolut ((SLuchar_Type *)b, 0, 0)))
479 {
480 SLfree ((char *)etable);
481 return;
482 }
483
484 len = strlen (str);
485
486 if (NULL == (str = (char *) SLmake_nstring(str, len)))
487 {
488 SLwchar_free_lut (lut);
489 SLfree ((char *)etable);
490 return;
491 }
492
493 s = (SLuchar_Type *) str;
494 smax = s + len;
495
496 while (s < smax)
497 {
498 SLuchar_Type *s1, *s2;
499 SLuchar_Type buf[SLUTF8_MAX_MBLEN+1];
500
501 s = SLwchar_skip_range (lut, s, smax, ignore_combining, 1);
502 if (s == smax)
503 break;
504
505 /* s is now at the position of the comment-start character.
506 * Skip to the corresponding comment-end character.
507 */
508 if (_pSLinterp_UTF8_Mode)
509 s1 = SLutf8_extract_utf8_char (s, smax, buf);
510 else
511 {
512 s1 = s;
513 buf[0] = *s1++;
514 buf[1] = 0;
515 }
516
517 /* buf contains the comment-start character. Find the corresponding
518 * comment end via the etable constructed above. The use of
519 * strstr should not fail, unless there is an error in the algorithm.
520 */
521 e1 = etable + (strstr (b, (char*)buf) - b) * (SLUTF8_MAX_MBLEN+1);
522
523 s1 = (SLuchar_Type *)strstr ((char*)s1, (char*)e1);
524 if (s1 != NULL)
525 s1 += strlen ((char*)e1);
526 else
527 s1 = smax;
528
529 /* Delete characters between s and s1 */
530 s2 = s;
531 while (s1 < smax)
532 *s2++ = *s1++;
533 *s2 = 0;
534
535 smax = s2;
536 }
537 (void) SLang_push_malloced_string (str); /* frees str */
538 SLwchar_free_lut (lut);
539 SLfree ((char *)etable);
540 return;
541 }
542
543 /*}}}*/
544
str_quote_string_cmd(char * str,char * quotes,SLwchar_Type * slash_ptr)545 static void str_quote_string_cmd (char *str, char *quotes, SLwchar_Type *slash_ptr) /*{{{*/
546 {
547 char *q, *q1;
548 int slash;
549 size_t len;
550 SLwchar_Lut_Type *lut;
551 SLuchar_Type slash_utf8 [SLUTF8_MAX_MBLEN+1];
552 SLuchar_Type *s, *smax;
553 unsigned int slash_len;
554 int ignore_combining = 0;
555
556 slash = *slash_ptr;
557
558 if (NULL == _pSLinterp_encode_wchar (slash, slash_utf8, &slash_len))
559 return;
560
561 lut = SLwchar_strtolut ((SLuchar_Type *)quotes, 0, 0);
562 if (lut == NULL)
563 return;
564
565 /* Make sure slash character gets escaped */
566 if (-1 == SLwchar_add_range_to_lut (lut, slash, slash))
567 {
568 SLwchar_free_lut (lut);
569 return;
570 }
571
572 /* calculate length */
573 s = (SLuchar_Type *) str;
574 len = strlen (str);
575 smax = s + len;
576
577 while (1)
578 {
579 SLuchar_Type *s1;
580
581 s1 = SLwchar_skip_range (lut, s, smax, ignore_combining, 1);
582 if (s1 == smax)
583 break;
584
585 len += slash_len;
586 s = SKIP_CHAR(s1, smax);
587 }
588 len++; /* null terminate */
589
590 if (NULL == (q = (char *)SLmalloc(len)))
591 {
592 SLwchar_free_lut (lut);
593 return;
594 }
595
596 s = (SLuchar_Type *) str; q1 = q;
597 while (1)
598 {
599 SLuchar_Type *s1;
600 unsigned int dlen;
601
602 s1 = SLwchar_skip_range (lut, s, smax, ignore_combining, 1);
603
604 dlen = (unsigned int) (s1 - s);
605 memcpy (q1, (char *)s, dlen);
606 q1 += dlen;
607
608 if (s1 == smax)
609 break;
610
611 memcpy (q1, (char *)slash_utf8, slash_len);
612 q1 += slash_len;
613
614 s = SKIP_CHAR(s1, smax);
615 dlen = (unsigned int) (s - s1);
616 memcpy (q1, s1, dlen);
617 q1 += dlen;
618 }
619 *q1 = 0;
620 (void) SLang_push_malloced_string(q); /* frees q */
621 SLwchar_free_lut (lut);
622 }
623
624 /*}}}*/
625
subbytes_cmd(SLstr_Type * a,int * n_ptr,int * m_ptr)626 static void subbytes_cmd (SLstr_Type *a, int *n_ptr, int *m_ptr) /*{{{*/
627 {
628 int m;
629 size_t n;
630 size_t lena;
631
632 n = (*n_ptr - 1);
633 m = *m_ptr;
634
635 lena = _pSLstring_bytelen (a);
636
637 if (n > lena)
638 n = lena;
639
640 if (m < 0) m = lena;
641 if (n + m > lena) m = lena - n;
642
643 (void) _pSLang_push_nstring (a + n, (unsigned int) m);
644 }
645
646 /*}}}*/
647
substr_cmd(SLstr_Type * a,int * n_ptr,int * m_ptr)648 static void substr_cmd (SLstr_Type *a, int *n_ptr, int *m_ptr) /*{{{*/
649 {
650 int n, m;
651 int lena;
652 int ignore_combining;
653 char *a1;
654
655 if (_pSLinterp_UTF8_Mode == 0)
656 {
657 subbytes_cmd (a, n_ptr, m_ptr);
658 return;
659 }
660
661 ignore_combining = 0;
662
663 n = *n_ptr;
664 m = *m_ptr;
665
666 lena = SLutf8_strlen ((SLuchar_Type *)a, ignore_combining);
667
668 if (n > lena) n = lena + 1;
669 if (n < 1)
670 {
671 SLang_set_error (SL_INVALID_PARM);
672 return;
673 }
674
675 n--;
676 if (m < 0) m = lena;
677 if (n + m > lena) m = lena - n;
678
679 /* FIXME: Are the strlens necessary here? */
680 a = (char *)SLutf8_skip_chars ((SLuchar_Type *)a, (SLuchar_Type*)a + strlen(a),
681 (unsigned int)n, NULL, ignore_combining);
682
683 a1 = (char *)SLutf8_skip_chars ((SLuchar_Type *)a, (SLuchar_Type*)a + strlen(a),
684 (unsigned int)m, NULL, ignore_combining);
685
686 (void) _pSLang_push_nstring (a, (unsigned int)(a1 - a));
687 }
688
689 /*}}}*/
690
691 /* substitute byte ch at byte-position n in string*/
strbytesub_cmd(int * nptr,char * chp)692 static void strbytesub_cmd (int *nptr, char *chp)
693 {
694 char *a;
695 size_t n;
696 size_t lena;
697
698 if (-1 == SLpop_string (&a))
699 return;
700
701 n = (*nptr-1);
702 lena = strlen (a);
703
704 if (n >= lena)
705 {
706 SLang_set_error (SL_INVALID_PARM);
707 SLfree(a);
708 return;
709 }
710
711 a[n] = *chp;
712
713 SLang_push_malloced_string (a);
714 }
715
716 /* substitute char m at position n in string*/
strsub_cmd(int * nptr,SLwchar_Type * mptr)717 static void strsub_cmd (int *nptr, SLwchar_Type *mptr) /*{{{*/
718 {
719 char *a;
720 size_t n;
721 SLwchar_Type m;
722 size_t lena;
723 int ignore_combining = 0;
724
725 if (-1 == SLpop_string (&a))
726 return;
727
728 n = (unsigned int) *nptr;
729 m = (SLwchar_Type) *mptr;
730
731 lena = STRLEN (a, ignore_combining);
732
733 if ((n == 0) || (lena < n))
734 {
735 SLang_set_error (SL_INVALID_PARM);
736 SLfree(a);
737 return;
738 }
739
740 /* The API for this function specifies 1-based indices */
741 n--;
742 if (_pSLinterp_UTF8_Mode)
743 {
744
745 SLstr_Type *b = SLutf8_subst_wchar ((SLuchar_Type *)a,
746 (SLuchar_Type *)a + strlen (a),
747 m, n, ignore_combining);
748 if (b != NULL)
749 _pSLang_push_slstring (b); /* frees b */
750
751 SLfree (a);
752 return;
753 }
754
755 a[n] = (char) m;
756
757 SLang_push_malloced_string (a);
758 }
759
760 /*}}}*/
761
762
pop_wchar(SLwchar_Type * wchp)763 static int pop_wchar (SLwchar_Type *wchp)
764 {
765 if (SLang_peek_at_stack() == SLANG_STRING_TYPE)
766 {
767 char *s;
768 SLwchar_Type wch;
769
770 if (-1 == SLang_pop_slstring (&s))
771 return -1;
772
773 if (_pSLinterp_UTF8_Mode)
774 {
775 if (NULL == SLutf8_decode ((unsigned char *)s, (unsigned char *)s+strlen(s), &wch, NULL))
776 wch = 0;
777 }
778 else wch = s[0];
779
780 _pSLang_free_slstring (s);
781 *wchp = wch;
782 return 0;
783 }
784
785 return _pSLang_pop_wchar (wchp);
786 }
787
788 #define ISXXX_INTRIN(name,isxxx) \
789 static int name (void) \
790 { \
791 SLwchar_Type wch; \
792 if (-1 == pop_wchar (&wch)) \
793 return -1; \
794 return (0 != isxxx (wch)); \
795 }
ISXXX_INTRIN(islower_intrin,SLwchar_islower)796 ISXXX_INTRIN(islower_intrin, SLwchar_islower)
797 ISXXX_INTRIN(isupper_intrin, SLwchar_isupper)
798 ISXXX_INTRIN(isalpha_intrin, SLwchar_isalpha)
799 ISXXX_INTRIN(isxdigit_intrin, SLwchar_isxdigit)
800 ISXXX_INTRIN(isspace_intrin, SLwchar_isspace)
801 ISXXX_INTRIN(isblank_intrin, SLwchar_isblank)
802 ISXXX_INTRIN(iscntrl_intrin, SLwchar_iscntrl)
803 ISXXX_INTRIN(isprint_intrin, SLwchar_isprint)
804 ISXXX_INTRIN(isdigit_intrin, SLwchar_isdigit)
805 ISXXX_INTRIN(isgraph_intrin, SLwchar_isgraph)
806 ISXXX_INTRIN(isalnum_intrin, SLwchar_isalnum)
807 ISXXX_INTRIN(ispunct_intrin, SLwchar_ispunct)
808 static int isascii_fun (SLwchar_Type wch)
809 {
810 return wch < 0x80;
811 }
ISXXX_INTRIN(isascii_intrin,isascii_fun)812 ISXXX_INTRIN(isascii_intrin, isascii_fun)
813
814 static int pop_skipintrin_args (SLuchar_Type **strp, SLstrlen_Type *lenp, SLstrlen_Type *posp, int *skip_combp)
815 {
816 char *str;
817 SLstrlen_Type len, pos;
818
819 *skip_combp = 1;
820 if (SLang_Num_Function_Args == 3)
821 {
822 if (-1 == SLang_pop_int (skip_combp))
823 return -1;
824 }
825 if (-1 == SLang_pop_strlen_type (&pos))
826 return -1;
827 if (-1 == SLang_pop_slstring (&str))
828 return -1;
829 len = _pSLstring_bytelen (str);
830 if (pos > len)
831 {
832 SLang_verror (SL_Index_Error, "%s", "String index lies outside the string");
833 SLang_free_slstring (str);
834 return -1;
835 }
836 *strp = (SLuchar_Type *)str;
837 *lenp = len;
838 *posp = pos;
839 return 0;
840 }
841
842 /* Usage: (wc, pos) = strskipchar (str, pos [,skip_comb]);
843 */
strskipchar_intrin(void)844 static void strskipchar_intrin (void)
845 {
846 SLuchar_Type *str, *str0, *str1, *strmax;
847 int skip_combining;
848 SLstrlen_Type pos, len;
849 SLwchar_Type wch;
850
851 if (-1 == pop_skipintrin_args (&str, &len, &pos, &skip_combining))
852 return;
853
854 str0 = str + pos;
855 strmax = str + len;
856 if (str0 == strmax)
857 {
858 (void) SLang_push_strlen_type (pos);
859 (void) SLang_push_uchar (0);
860 goto free_and_return;
861 }
862 if (_pSLinterp_UTF8_Mode == 0)
863 {
864 (void) SLang_push_strlen_type (pos+1);
865 (void) SLang_push_uchar (*str0);
866 goto free_and_return;
867 }
868 str1 = SLutf8_skip_chars (str0, strmax, 1, NULL, skip_combining);
869 pos = str1 - str;
870 (void) SLang_push_strlen_type (pos);
871
872 if (NULL == SLutf8_decode (str0, str1, &wch, NULL))
873 {
874 (void) SLang_push_integer (-(int)*str0);
875 goto free_and_return;
876 }
877 (void) SLang_push_wchar (wch);
878 /* drop */
879 free_and_return:
880 SLang_free_slstring ((char *)str);
881 }
882
strbskipchar_intrin(void)883 static void strbskipchar_intrin (void)
884 {
885 SLuchar_Type *str, *str0, *str1;
886 int skip_combining;
887 SLstrlen_Type pos, len;
888 SLwchar_Type wch;
889
890 if (-1 == pop_skipintrin_args (&str, &len, &pos, &skip_combining))
891 return;
892
893 str0 = str + pos;
894 if (pos == 0)
895 {
896 (void) SLang_push_strlen_type (pos);
897 (void) SLang_push_uchar (0);
898 goto free_and_return;
899 }
900 if (_pSLinterp_UTF8_Mode == 0)
901 {
902 (void) SLang_push_strlen_type (pos-1);
903 (void) SLang_push_uchar (*(str0-1));
904 goto free_and_return;
905 }
906 str1 = SLutf8_bskip_chars (str, str0, 1, NULL, skip_combining);
907 pos = str1 - str;
908 (void) SLang_push_strlen_type (pos);
909
910 if (NULL == SLutf8_decode (str1, str0, &wch, NULL))
911 {
912 (void) SLang_push_integer (-(int)*str1);
913 goto free_and_return;
914 }
915 (void) SLang_push_wchar (wch);
916 /* drop */
917 free_and_return:
918 SLang_free_slstring ((char *)str);
919 }
920
toupper_cmd(SLwchar_Type * ch)921 static int toupper_cmd (SLwchar_Type *ch) /*{{{*/
922 {
923 if (_pSLinterp_UTF8_Mode)
924 return SLwchar_toupper (*ch);
925
926 return UPPER_CASE(*ch);
927 }
928
929 /*}}}*/
930
tolower_cmd(SLwchar_Type * ch)931 static int tolower_cmd (SLwchar_Type *ch) /*{{{*/
932 {
933 if (_pSLinterp_UTF8_Mode)
934 return SLwchar_tolower (*ch);
935
936 return LOWER_CASE(*ch);
937 }
938
939 /*}}}*/
940
do_strchop(SLuchar_Type * str,SLwchar_Type delim,SLwchar_Type quote)941 static SLang_Array_Type *do_strchop (SLuchar_Type *str, SLwchar_Type delim, SLwchar_Type quote)
942 {
943 SLindex_Type count;
944 SLuchar_Type *s0, *s1;
945 SLang_Array_Type *at;
946 char **data;
947 SLuchar_Type delim_utf8 [SLUTF8_MAX_MBLEN+1];
948 SLuchar_Type quote_utf8 [SLUTF8_MAX_MBLEN+1];
949 unsigned int delim_len, quote_len;
950 SLwchar_Lut_Type *lut;
951 SLuchar_Type *smax;
952 int ignore_combining = 0;
953
954 if (NULL == _pSLinterp_encode_wchar ((SLwchar_Type)delim, delim_utf8, &delim_len))
955 return NULL;
956 if (NULL == _pSLinterp_encode_wchar ((SLwchar_Type)quote, quote_utf8, "e_len))
957 return NULL;
958
959 if (NULL == (lut = SLwchar_create_lut (2)))
960 return NULL;
961
962 if ((-1 == SLwchar_add_range_to_lut (lut, delim, delim))
963 || ((quote != 0)
964 && (-1 == SLwchar_add_range_to_lut (lut, quote, quote))))
965 {
966 SLwchar_free_lut (lut);
967 return NULL;
968 }
969
970 smax = str + strlen ((char *) str);
971 s1 = s0 = str;
972
973 count = 1; /* at least 1 */
974
975 /* Count strings on first pass */
976 while (1)
977 {
978 SLwchar_Type wch;
979
980 /* Look for the delimiter or the quote */
981 s1 = SLwchar_skip_range (lut, s1, smax, ignore_combining, 1);
982
983 if (s1 == smax)
984 break;
985
986 /* Test for quote */
987 if (NULL == (s1 = _pSLinterp_decode_wchar (s1, smax, &wch)))
988 {
989 SLwchar_free_lut (lut);
990 return NULL;
991 }
992
993 if ((wch == quote) && quote)
994 {
995 if (s1 == smax)
996 break;
997
998 s1 = SKIP_CHAR(s1, smax);
999 continue;
1000 }
1001
1002 if (wch == delim)
1003 {
1004 count++;
1005 continue;
1006 }
1007 }
1008
1009 if (NULL == (at = SLang_create_array (SLANG_STRING_TYPE, 0, NULL, &count, 1)))
1010 {
1011 SLwchar_free_lut (lut);
1012 return NULL;
1013 }
1014
1015 data = (char **)at->data;
1016
1017 count = 0;
1018 s1 = str;
1019
1020 while (1)
1021 {
1022 SLwchar_Type wch;
1023 char *elm;
1024
1025 /* Look for the delimiter or the quote */
1026 s1 = SLwchar_skip_range (lut, s1, smax, ignore_combining, 1);
1027
1028 if (s1 != smax)
1029 {
1030 SLuchar_Type *s1_save = s1;
1031
1032 if (NULL == (s1 = _pSLinterp_decode_wchar (s1, smax, &wch)))
1033 break;
1034
1035 if ((wch == quote) && quote)
1036 {
1037 if (s1 != smax)
1038 s1 = SKIP_CHAR (s1, smax);
1039
1040 continue;
1041 }
1042 s1 = s1_save;
1043 /* Otherwise it must be the delim */
1044 }
1045 elm = SLang_create_nslstring ((char *)s0, (unsigned int) (s1 - s0));
1046
1047 if (elm == NULL)
1048 break;
1049
1050 data[count] = elm;
1051 count++;
1052
1053 if (s1 == smax)
1054 {
1055 SLwchar_free_lut (lut);
1056 return at;
1057 }
1058
1059 s1 = SKIP_CHAR(s1, smax); /* skip past delim */
1060 s0 = s1; /* and reset */
1061 }
1062
1063 SLwchar_free_lut (lut);
1064 SLang_free_array (at);
1065 return NULL;
1066 }
1067
strchop_cmd(char * str,SLwchar_Type * q,SLwchar_Type * d)1068 static void strchop_cmd (char *str, SLwchar_Type *q, SLwchar_Type *d)
1069 {
1070 (void) SLang_push_array (do_strchop ((SLuchar_Type *)str, *q, *d), 1);
1071 }
1072
strchopr_cmd(char * str,SLwchar_Type * q,SLwchar_Type * d)1073 static void strchopr_cmd (char *str, SLwchar_Type *q, SLwchar_Type *d)
1074 {
1075 SLang_Array_Type *at;
1076
1077 if (NULL != (at = do_strchop ((SLuchar_Type *)str, *q, *d)))
1078 {
1079 char **d0, **d1;
1080
1081 d0 = (char **) at->data;
1082 d1 = d0 + (at->num_elements - 1);
1083
1084 while (d0 < d1)
1085 {
1086 char *tmp;
1087
1088 tmp = *d0;
1089 *d0 = *d1;
1090 *d1 = tmp;
1091 d0++;
1092 d1--;
1093 }
1094 }
1095 SLang_push_array (at, 1);
1096 }
1097
1098 /*}}}*/
1099
1100 typedef struct
1101 {
1102 SLstr_Type **sp;
1103 SLuindex_Type num;
1104 SLstr_Type *str;
1105 SLang_Array_Type *at;
1106 }
1107 Array_Or_String_Type;
1108
pop_array_or_string(Array_Or_String_Type * aos)1109 static int pop_array_or_string (Array_Or_String_Type *aos)
1110 {
1111 char *str;
1112
1113 if (SLang_peek_at_stack () == SLANG_ARRAY_TYPE)
1114 {
1115 SLang_Array_Type *at;
1116 aos->str = NULL;
1117 if (-1 == SLang_pop_array_of_type (&at, SLANG_STRING_TYPE))
1118 {
1119 aos->at = NULL;
1120 return -1;
1121 }
1122 aos->num = at->num_elements;
1123 aos->sp = (char **)at->data;
1124 aos->at = at;
1125 return 0;
1126 }
1127 aos->at = NULL;
1128 if (-1 == SLang_pop_slstring (&str))
1129 {
1130 aos->str = NULL;
1131 return -1;
1132 }
1133 aos->num = 1;
1134 aos->sp = &str;
1135 aos->str = str;
1136 return 0;
1137 }
1138
free_array_or_string(Array_Or_String_Type * aos)1139 static void free_array_or_string (Array_Or_String_Type *aos)
1140 {
1141 if (aos->str != NULL)
1142 {
1143 SLang_free_slstring (aos->str);
1144 return;
1145 }
1146 if (aos->at != NULL)
1147 {
1148 SLang_free_array (aos->at);
1149 return;
1150 }
1151 }
1152
pop_matched_array_or_string(Array_Or_String_Type * aos,Array_Or_String_Type * bos,int * is_arrayp)1153 static int pop_matched_array_or_string (Array_Or_String_Type *aos, Array_Or_String_Type *bos,
1154 int *is_arrayp)
1155 {
1156 if (-1 == pop_array_or_string (bos))
1157 return -1;
1158 if (-1 == pop_array_or_string (aos))
1159 {
1160 free_array_or_string (bos);
1161 return -1;
1162 }
1163 if (0 == (*is_arrayp = (aos->at != NULL) || (bos->at != NULL)))
1164 return 0;
1165
1166 if ((aos->num != bos->num)
1167 && (aos->at != NULL) && (bos->at != NULL))
1168 {
1169 SLang_verror (SL_InvalidParm_Error, "String arrays must be the same length.");
1170 free_array_or_string (aos);
1171 free_array_or_string (bos);
1172 return -1;
1173 }
1174 return 0;
1175 }
1176
arraymap_int_func_str_str(int (* func)(char *,char *,void *),void * cd)1177 static int arraymap_int_func_str_str (int (*func)(char *, char *, void *), void *cd)
1178 {
1179 int status = -1;
1180 int is_array;
1181 Array_Or_String_Type aos, bos;
1182 SLang_Array_Type *int_at;
1183 int *int_at_data;
1184 SLuindex_Type i, num;
1185
1186 if (-1 == pop_matched_array_or_string (&aos, &bos, &is_array))
1187 return -1;
1188 if (0 == is_array)
1189 {
1190 status = SLang_push_int ((*func)(aos.str, bos.str, cd));
1191 goto free_and_return;
1192 }
1193
1194 if (aos.at != NULL)
1195 {
1196 char **astrs, **bstrs;
1197 if (NULL == (int_at = (SLang_create_array1 (SLANG_INT_TYPE, 0, NULL, aos.at->dims, aos.at->num_dims, 0))))
1198 goto free_and_return;
1199
1200 int_at_data = (int *)int_at->data;
1201 num = aos.num;
1202 astrs = aos.sp;
1203 if (bos.at == NULL)
1204 {
1205 char *b = bos.str;
1206 for (i = 0; i < num; i++)
1207 int_at_data[i] = (*func)(astrs[i], b, cd);
1208 goto push_and_return;
1209 }
1210 bstrs = bos.sp;
1211 for (i = 0; i < num; i++)
1212 int_at_data[i] = (*func)(astrs[i], bstrs[i], cd);
1213 goto push_and_return;
1214 }
1215
1216 if (NULL == (int_at = (SLang_create_array1 (SLANG_INT_TYPE, 0, NULL, bos.at->dims, bos.at->num_dims, 0))))
1217 goto free_and_return;
1218
1219 int_at_data = (int *)int_at->data;
1220 num = bos.num;
1221 for (i = 0; i < num; i++)
1222 int_at_data[i] = (*func)(aos.str, bos.sp[i], cd);
1223
1224 /* drop */
1225
1226 push_and_return:
1227 status = SLang_push_array (int_at, 1);
1228 /* drop */
1229 free_and_return:
1230 free_array_or_string (&aos);
1231 free_array_or_string (&bos);
1232 return status;
1233 }
1234
arraymap_int_func_str(int (* func)(char *,void *),void * cd)1235 static int arraymap_int_func_str (int (*func)(char *, void *), void *cd)
1236 {
1237 SLang_Array_Type *int_at, *at;
1238 SLuindex_Type i, num;
1239 int *int_at_data;
1240 char **at_data;
1241
1242 if (SLang_peek_at_stack () != SLANG_ARRAY_TYPE)
1243 {
1244 int status;
1245 char *str;
1246
1247 if (-1 == SLang_pop_slstring (&str))
1248 return -1;
1249 status = SLang_push_int ((*func)(str, cd));
1250 SLang_free_slstring (str);
1251 return status;
1252 }
1253
1254 if (-1 == SLang_pop_array_of_type (&at, SLANG_STRING_TYPE))
1255 return -1;
1256
1257 if (NULL == (int_at = (SLang_create_array1 (SLANG_INT_TYPE, 0, NULL, at->dims, at->num_dims, 0))))
1258 {
1259 SLang_free_array (at);
1260 return -1;
1261 }
1262
1263 at_data = (char **)at->data;
1264 int_at_data = (int *)int_at->data;
1265 num = at->num_elements;
1266 for (i = 0; i < num; i++)
1267 int_at_data[i] = (*func)(at_data[i], cd);
1268
1269 SLang_free_array (at);
1270 return SLang_push_array (int_at, 1);
1271 }
1272
arraymap_str_func_str(char * (* func)(char *,void *),void * cd)1273 static int arraymap_str_func_str (char *(*func)(char *, void *), void *cd)
1274 {
1275 SLang_Array_Type *at, *bt;
1276 SLuindex_Type i, num;
1277 char **adata, **bdata;
1278
1279 if (SLang_peek_at_stack () != SLANG_ARRAY_TYPE)
1280 {
1281 char *a, *b;
1282
1283 if (-1 == SLang_pop_slstring (&a))
1284 return -1;
1285
1286 b = (*func)(a, cd);
1287 SLang_free_slstring (a);
1288 return _pSLang_push_slstring (b); /* frees string */
1289 }
1290
1291 if (-1 == SLang_pop_array_of_type (&at, SLANG_STRING_TYPE))
1292 return -1;
1293
1294 if (NULL == (bt = SLang_create_array (SLANG_STRING_TYPE, 0, NULL, at->dims, at->num_dims)))
1295 {
1296 SLang_free_array (at);
1297 return -1;
1298 }
1299
1300 adata = (char **)at->data; bdata = (char **)bt->data;
1301 num = bt->num_elements;
1302 for (i = 0; i < num; i++)
1303 {
1304 char *s = adata[i];
1305 if (s != NULL)
1306 {
1307 s = (*func)(s, cd);
1308 if (s == NULL)
1309 {
1310 SLang_free_array (bt);
1311 SLang_free_array (at);
1312 return -1;
1313 }
1314 }
1315 bdata[i] = s;
1316 }
1317 SLang_free_array (at);
1318 return SLang_push_array (bt, 1);
1319 }
1320
func_issubstr(char * a,char * b,void * cd)1321 static int func_issubstr (char *a, char *b, void *cd)
1322 {
1323 SLstrlen_Type n;
1324 char *c;
1325
1326 (void) cd;
1327
1328 if (NULL == (c = strstr(a, b)))
1329 return 0;
1330
1331 if (_pSLinterp_UTF8_Mode == 0)
1332 return 1 + (int) (c - a);
1333
1334 n = (unsigned int) (c - a);
1335 (void) SLutf8_skip_chars ((SLuchar_Type *)a, (SLuchar_Type *)c, n, &n, 0);
1336 return (int) (n+1);
1337 }
1338
issubstr_vintrin(void)1339 static int issubstr_vintrin (void) /*{{{*/
1340 {
1341 return arraymap_int_func_str_str (func_issubstr, NULL);
1342 }
1343
1344
1345 typedef struct
1346 {
1347 int do_beg, do_end;
1348 SLwchar_Lut_Type *lut;
1349 int invert;
1350 }
1351 Strtrim_CD_Type;
1352
func_strtrim(char * str,void * cd)1353 static char *func_strtrim (char *str, void *cd)
1354 {
1355 Strtrim_CD_Type *info;
1356 SLuchar_Type *beg, *end;
1357 unsigned int len;
1358
1359 info = (Strtrim_CD_Type *)cd;
1360
1361 beg = (SLuchar_Type *)str;
1362 len = do_trim (&beg, info->do_beg, &end, info->do_end, info->lut, info->invert);
1363
1364 return SLang_create_nslstring ((char *) beg, len);
1365 }
1366
strtrim_internal(int do_beg,int do_end)1367 static int strtrim_internal (int do_beg, int do_end)
1368 {
1369 Strtrim_CD_Type cd;
1370 int status;
1371 int free_lut;
1372
1373 cd.do_beg = do_beg;
1374 cd.do_end = do_end;
1375 cd.invert = 0;
1376 free_lut = 0;
1377 if (SLang_Num_Function_Args == 2)
1378 {
1379 cd.lut = pop_lut (&cd.invert);
1380 free_lut = 1;
1381 }
1382 else cd.lut = make_whitespace_lut ();
1383
1384 if (cd.lut == NULL)
1385 return -1;
1386
1387 status = arraymap_str_func_str (func_strtrim, &cd);
1388 if (free_lut) SLwchar_free_lut (cd.lut);
1389 return status;
1390 }
1391
strtrim_vintrin(void)1392 static void strtrim_vintrin (void)
1393 {
1394 (void) strtrim_internal (1, 1);
1395 }
1396
strtrim_beg_vintrin(void)1397 static void strtrim_beg_vintrin (void)
1398 {
1399 (void) strtrim_internal (1, 0);
1400 }
1401
strtrim_end_vintrin(void)1402 static void strtrim_end_vintrin (void)
1403 {
1404 (void) strtrim_internal (0, 1);
1405 }
1406
func_strup(char * str,void * cd)1407 static char *func_strup (char *str, void *cd)
1408 {
1409 size_t i, len;
1410 unsigned char *a;
1411
1412 (void) cd;
1413 len = strlen (str);
1414
1415 if (_pSLinterp_UTF8_Mode)
1416 return (char *)SLutf8_strup ((SLuchar_Type *)str, (SLuchar_Type *)str+len);
1417
1418 if (NULL == (a = (unsigned char *)SLmalloc (len+1)))
1419 return NULL;
1420
1421 for (i = 0; i < len; i++)
1422 {
1423 unsigned char c = (unsigned char)str[i];
1424 a[i] = UPPER_CASE(c);
1425 }
1426 a[len] = 0;
1427 str = SLang_create_nslstring ((char *)a, len);
1428 SLfree ((char *)a);
1429 return str;
1430 }
1431
strup_vintrin(void)1432 static void strup_vintrin (void)
1433 {
1434 (void) arraymap_str_func_str (&func_strup, NULL);
1435 }
1436
func_strlow(char * str,void * cd)1437 static char *func_strlow (char *str, void *cd)
1438 {
1439 size_t i, len;
1440 unsigned char *a;
1441
1442 (void) cd;
1443 len = strlen (str);
1444
1445 if (_pSLinterp_UTF8_Mode)
1446 return (char *)SLutf8_strlo ((SLuchar_Type *)str, (SLuchar_Type *)str+len);
1447
1448 if (NULL == (a = (unsigned char *)SLmalloc (len+1)))
1449 return NULL;
1450
1451 for (i = 0; i < len; i++)
1452 {
1453 unsigned char c = (unsigned char)str[i];
1454 a[i] = LOWER_CASE(c);
1455 }
1456 a[len] = 0;
1457 str = SLang_create_nslstring ((char *)a, len);
1458 SLfree ((char *)a);
1459 return str;
1460 }
1461
strlow_vintrin(void)1462 static void strlow_vintrin (void)
1463 {
1464 (void) arraymap_str_func_str (&func_strlow, NULL);
1465 }
1466
func_strcmp(char * a,char * b,void * cd)1467 static int func_strcmp (char *a, char *b, void *cd)
1468 {
1469 (void) cd;
1470
1471 if (a == b)
1472 return 0;
1473
1474 if ((a != NULL) && (b != NULL))
1475 return strcmp(a, b);
1476
1477 if (a == NULL)
1478 return -1;
1479
1480 return 1;
1481 }
strcmp_vintrin(void)1482 static void strcmp_vintrin (void)
1483 {
1484 (void) arraymap_int_func_str_str (func_strcmp, NULL);
1485 }
1486
func_strnbytecmp(char * a,char * b,void * cd)1487 static int func_strnbytecmp (char *a, char *b, void *cd)
1488 {
1489 if ((a != NULL) && (b != NULL))
1490 return strncmp (a, b, *(unsigned int *)cd);
1491 if (a == NULL)
1492 return b == NULL ? 0 : -1;
1493 return 1;
1494 }
1495
strnbytecmp_vintrin(void)1496 static void strnbytecmp_vintrin (void)
1497 {
1498 unsigned int n;
1499 if (0 == SLang_pop_uint (&n))
1500 (void) arraymap_int_func_str_str (func_strnbytecmp, (void *)&n);
1501 }
1502
1503 typedef struct
1504 {
1505 unsigned int n;
1506 int skip_combining;
1507 }
1508 Strncmp_CD_Type;
1509
func_strncmp(char * a,char * b,void * cd)1510 static int func_strncmp (char *a, char *b, void *cd)
1511 {
1512 int skip_combining;
1513 unsigned int n;
1514 char *p;
1515 unsigned int na, nb;
1516 unsigned int lena, lenb;
1517 int cmp;
1518
1519 if (a == NULL)
1520 return b == NULL ? 0 : -1;
1521 if (b == NULL)
1522 return 1;
1523
1524 skip_combining = ((Strncmp_CD_Type *)cd)->skip_combining;
1525 n = ((Strncmp_CD_Type *)cd)->n;
1526
1527 lena = _pSLstring_bytelen (a);
1528 lenb = _pSLstring_bytelen (b);
1529
1530 p = (char *)SLutf8_skip_chars ((SLuchar_Type *)a, (SLuchar_Type *)(a + lena),
1531 (unsigned int) n, NULL, skip_combining);
1532 na = (unsigned int) (p - a);
1533
1534 p = (char *)SLutf8_skip_chars ((SLuchar_Type *)b, (SLuchar_Type *)(b + lenb),
1535 (unsigned int) n, NULL, skip_combining);
1536 nb = (unsigned int) (p - b);
1537
1538 if (na > nb)
1539 {
1540 cmp = strncmp (a, b, nb);
1541 if (cmp == 0)
1542 return (int) (unsigned char) a[nb];
1543 return cmp;
1544 }
1545
1546 if (na == nb)
1547 return strncmp (a, b, nb);
1548
1549 /* nb > na */
1550 cmp = strncmp (a, b, na);
1551 if (cmp == 0)
1552 return -(int)(unsigned char) b[na];
1553
1554 return cmp;
1555 }
1556
strncmp_vintrin(void)1557 static void strncmp_vintrin (void)
1558 {
1559 Strncmp_CD_Type cd;
1560
1561 if (_pSLinterp_UTF8_Mode == 0)
1562 {
1563 strnbytecmp_vintrin ();
1564 return;
1565 }
1566 if (-1 == SLang_pop_uint (&cd.n))
1567 return;
1568 cd.skip_combining = 1;
1569
1570 (void) arraymap_int_func_str_str (func_strncmp, (void *)&cd);
1571 }
1572
strncharcmp_vintrin(void)1573 static void strncharcmp_vintrin (void)
1574 {
1575 Strncmp_CD_Type cd;
1576
1577 if (_pSLinterp_UTF8_Mode == 0)
1578 {
1579 strnbytecmp_vintrin ();
1580 return;
1581 }
1582 if (-1 == SLang_pop_uint (&cd.n))
1583 return;
1584 cd.skip_combining = 0;
1585
1586 (void) arraymap_int_func_str_str (func_strncmp, (void *)&cd);
1587 }
1588
func_utf8_strlen(char * s,void * cd)1589 static int func_utf8_strlen (char *s, void *cd)
1590 {
1591 if (s == NULL)
1592 return 0;
1593 return (int) SLutf8_strlen ((SLuchar_Type *)s, *(int *)cd);
1594 }
1595
func_bytelen(char * s,void * cd)1596 static int func_bytelen (char *s, void *cd)
1597 {
1598 (void) cd;
1599 if (s == NULL)
1600 return 0;
1601 return (int) _pSLstring_bytelen (s);
1602 }
1603
strlen_vintrin(void)1604 static void strlen_vintrin (void)
1605 {
1606 int ignore_combining = 1;
1607
1608 if (_pSLinterp_UTF8_Mode == 0)
1609 {
1610 (void) arraymap_int_func_str (&func_bytelen, NULL);
1611 return;
1612 }
1613 (void) arraymap_int_func_str (&func_utf8_strlen, (void *)&ignore_combining);
1614 }
1615
strcharlen_vintrin(void)1616 static void strcharlen_vintrin (void)
1617 {
1618 int ignore_combining = 0;
1619
1620 if (_pSLinterp_UTF8_Mode == 0)
1621 {
1622 (void) arraymap_int_func_str (&func_bytelen, NULL);
1623 return;
1624 }
1625 (void) arraymap_int_func_str (&func_utf8_strlen, (void *)&ignore_combining);
1626 }
1627
strbytelen_vintrin(void)1628 static void strbytelen_vintrin (void)
1629 {
1630 (void) arraymap_int_func_str (&func_bytelen, NULL);
1631 }
1632
1633 /*}}}*/
1634
1635 typedef struct
1636 {
1637 SLwchar_Lut_Type *lut;
1638 int invert;
1639 }
1640 Str_Delete_Chars_CD_Type;
1641
func_str_delete_chars(char * str,void * cd)1642 static char *func_str_delete_chars (char *str, void *cd)
1643 {
1644 SLwchar_Lut_Type *lut;
1645 SLuchar_Type *s1;
1646 SLuchar_Type *t, *tmax;
1647 int invert, ignore_combining = 0;
1648 SLuchar_Type *s;
1649
1650 lut = ((Str_Delete_Chars_CD_Type *)cd)->lut;
1651 invert = ((Str_Delete_Chars_CD_Type *)cd)->invert;
1652
1653 /* Assume that the number of characters to be deleted is smaller then
1654 * the number not to be deleted. In this case, it is better to
1655 * skip past call characters not in the set to be deleted. Hence,
1656 * we want to invert the deletion set.
1657 */
1658 invert = !invert;
1659
1660 if ((str == NULL)
1661 || (NULL == (s = (SLuchar_Type *)SLmake_string (str))))
1662 return NULL;
1663
1664 s1 = s;
1665 t = s;
1666 tmax = t + strlen((char *)t);
1667 while (t != tmax)
1668 {
1669 SLuchar_Type *t1;
1670 size_t len;
1671
1672 t1 = SLwchar_skip_range (lut, t, tmax, ignore_combining, invert);
1673 if (t1 == NULL)
1674 break;
1675
1676 len = t1 - t;
1677 if (len)
1678 {
1679 if (t != s1)
1680 {
1681 /* strncpy ((char *)s1, (char *)t, len); */
1682 while (t < t1)
1683 *s1++ = *t++;
1684 }
1685 else s1 += len;
1686 }
1687 t = SLwchar_skip_range (lut, t1, tmax, ignore_combining, !invert);
1688 if (t == NULL)
1689 break;
1690 }
1691 *s1 = 0;
1692 str = SLang_create_slstring ((char *)s);
1693 SLfree ((char *)s);
1694 return str;
1695 }
1696
str_delete_chars_vintrin(void)1697 static void str_delete_chars_vintrin (void)
1698 {
1699 Str_Delete_Chars_CD_Type cd;
1700 int free_lut;
1701
1702 cd.invert = 0;
1703 free_lut = 0;
1704
1705 /* This function may also be called by strtrans_vintrin, with some of its
1706 * args on the stack.
1707 */
1708 if (SLang_Num_Function_Args > 1)
1709 {
1710 cd.lut = pop_lut (&cd.invert);
1711 free_lut = 1;
1712 }
1713 else
1714 cd.lut = make_whitespace_lut ();
1715
1716 if (cd.lut == NULL)
1717 return;
1718
1719 (void) arraymap_str_func_str (&func_str_delete_chars, (void *)&cd);
1720
1721 if (free_lut)
1722 SLwchar_free_lut (cd.lut);
1723 }
1724
func_strtrans(char * s,void * cd)1725 static char *func_strtrans (char *s, void *cd)
1726 {
1727 SLuchar_Type *u;
1728
1729 if (s == NULL)
1730 return NULL;
1731
1732 u = SLuchar_apply_char_map ((SLwchar_Map_Type *)cd, (SLuchar_Type *)s);
1733 s = SLang_create_slstring ((char *) u);
1734 SLfree ((char *)u);
1735 return s;
1736 }
1737
strtrans_vintrin(char * to)1738 static void strtrans_vintrin (char *to)
1739 {
1740 SLwchar_Map_Type *map;
1741 char *from;
1742
1743 if (*to == 0)
1744 {
1745 str_delete_chars_vintrin ();
1746 return;
1747 }
1748
1749 if (-1 == SLang_pop_slstring (&from))
1750 return;
1751
1752 if (NULL == (map = SLwchar_allocate_char_map ((SLuchar_Type *)from, (SLuchar_Type *)to)))
1753 return;
1754
1755 _pSLang_free_slstring (from);
1756
1757 (void) arraymap_str_func_str (&func_strtrans, (void *)map);
1758 SLwchar_free_char_map (map);
1759 }
1760
1761 typedef struct
1762 {
1763 SLwchar_Lut_Type *lut;
1764 SLuchar_Type pref_char_buf[SLUTF8_MAX_MBLEN+1];
1765 unsigned int pref_len;
1766 }
1767 Strcompress_CD_Type;
1768
func_strcompress(char * str,void * cd)1769 static char *func_strcompress (char *str, void *cd) /*{{{*/
1770 {
1771 char *c;
1772 Strcompress_CD_Type *info;
1773 SLuchar_Type *s, *beg, *end;
1774 size_t len, pref_len;
1775 SLwchar_Lut_Type *lut;
1776 int ignore_combining = 0;
1777
1778 if (str == NULL)
1779 return str;
1780
1781 info = (Strcompress_CD_Type *)cd;
1782 pref_len = info->pref_len;
1783 lut = info->lut;
1784
1785 beg = (SLuchar_Type *) str;
1786 (void) do_trim (&beg, 1, &end, 1, lut, 0);
1787
1788 /* Determine the effective length */
1789 len = 0;
1790 s = (unsigned char *) beg;
1791 while (1)
1792 {
1793 SLuchar_Type *s1;
1794
1795 s1 = SLwchar_skip_range (lut, s, end, ignore_combining, 1);
1796 len += (s1 - s);
1797 s = s1;
1798
1799 if (s == end)
1800 break;
1801
1802 len += pref_len;
1803
1804 s = SLwchar_skip_range (lut, s, end, ignore_combining, 0);
1805 }
1806
1807 c = _pSLallocate_slstring (len);
1808 if (c == NULL)
1809 return NULL;
1810
1811 s = (unsigned char *) c;
1812
1813 while (1)
1814 {
1815 SLuchar_Type *beg1;
1816 unsigned int dlen;
1817
1818 beg1 = SLwchar_skip_range (lut, beg, end, ignore_combining, 1);
1819 dlen = (unsigned int) (beg1 - beg);
1820
1821 memcpy ((char *)s, beg, dlen);
1822 beg = beg1;
1823 s += dlen;
1824
1825 if (beg == end)
1826 break;
1827
1828 memcpy (s, info->pref_char_buf, pref_len);
1829 s += pref_len;
1830
1831 beg = SLwchar_skip_range (lut, beg, end, ignore_combining, 0);
1832 }
1833 *s = 0;
1834
1835 return _pSLcreate_via_alloced_slstring (c, len);
1836 }
1837
strcompress_vintrin(char * white)1838 static void strcompress_vintrin (char *white) /*{{{*/
1839 {
1840 char *white_max;
1841 SLuchar_Type *s;
1842 SLwchar_Type pref_char;
1843 Strcompress_CD_Type cd;
1844
1845 /* The first character of white is the preferred whitespace character */
1846 white_max = white + strlen (white);
1847 if (NULL == (s = _pSLinterp_decode_wchar ((SLuchar_Type *)white, (SLuchar_Type *)white_max,
1848 &pref_char)))
1849 return;
1850
1851 /* This cannot overflow since _pSLinterp_decode_wchar will not return an
1852 * offset of more than SLUTF8_MAX_BLEN bytes.
1853 */
1854 cd.pref_len = (unsigned int)(s - (SLuchar_Type*)white);
1855 memcpy ((char *)cd.pref_char_buf, white, cd.pref_len);
1856 cd.pref_char_buf[cd.pref_len] = 0;
1857
1858 /* No ranges and no character classes in white */
1859 if (NULL == (cd.lut = SLwchar_strtolut ((SLuchar_Type *)white, 0, 0)))
1860 return;
1861
1862 (void) arraymap_str_func_str (&func_strcompress, (void *)&cd);
1863
1864 SLwchar_free_lut (cd.lut);
1865 }
1866
1867 /*}}}*/
1868
1869 #if defined(__GNUC__)
1870 # pragma GCC diagnostic ignored "-Wformat-nonliteral"
1871 #endif
SLdo_sprintf(char * fmt)1872 static char *SLdo_sprintf (char *fmt) /*{{{*/
1873 {
1874 register char *p = fmt;
1875 char *out = NULL, *outp = NULL;
1876 char dfmt[1024]; /* used to hold part of format */
1877 char *f, *f1;
1878 char *str;
1879 unsigned int want_width, width, precis;
1880 int int_var, use_string;
1881 long long_var;
1882 #ifdef HAVE_LONG_LONG
1883 long long llong_var;
1884 #endif
1885 size_t len = 0, malloc_len = 0, dlen;
1886 int do_free;
1887 unsigned int guess_size;
1888 #if SLANG_HAS_FLOAT
1889 int use_double;
1890 double x;
1891 #endif
1892 unsigned char uch;
1893 int use_long = 0, use_alt_format = 0;
1894 SLuchar_Type utf8_buf[SLUTF8_MAX_MBLEN+1];
1895
1896 while (1)
1897 {
1898 char ch;
1899
1900 while ((ch = *p) != 0)
1901 {
1902 if (ch == '%')
1903 break;
1904 p++;
1905 }
1906
1907 /* p points at '%' or 0 */
1908
1909 dlen = (unsigned int) (p - fmt);
1910
1911 if (len + dlen >= malloc_len)
1912 {
1913 malloc_len = len + dlen + 512;
1914 if (out == NULL) outp = (char *)SLmalloc(malloc_len + 1);
1915 else outp = (char *)SLrealloc(out, malloc_len + 1);
1916 if (NULL == outp)
1917 return out;
1918 out = outp;
1919 outp = out + len;
1920 }
1921
1922 strncpy(outp, fmt, dlen);
1923 len += dlen;
1924 outp = out + len;
1925 *outp = 0;
1926 if (ch == 0) break;
1927
1928 /* bump it beyond '%' */
1929 ++p;
1930 fmt = p;
1931
1932 f = dfmt;
1933 *f++ = ch;
1934 /* handle flag char */
1935 ch = *p++;
1936
1937 /* Make sure cases such as "% #g" can be handled. */
1938 if ((ch == '-') || (ch == '+') || (ch == ' ') || (ch == '#'))
1939 {
1940 if (ch == '#')
1941 use_alt_format = 1;
1942 *f++ = ch;
1943 ch = *p++;
1944 if ((ch == '-') || (ch == '+') || (ch == ' ') || (ch == '#'))
1945 {
1946 if (ch == '#')
1947 use_alt_format = 1;
1948 *f++ = ch;
1949 ch = *p++;
1950 }
1951 }
1952
1953 /* width */
1954 /* I have got to parse it myself so that I can see how big it needs
1955 * to be.
1956 */
1957 want_width = width = 0;
1958 if (ch == '*')
1959 {
1960 if (SLang_pop_uinteger(&width)) return (out);
1961 want_width = 1;
1962 ch = *p++;
1963 }
1964 else
1965 {
1966 if (ch == '0')
1967 {
1968 *f++ = '0';
1969 ch = *p++;
1970 }
1971
1972 while ((ch <= '9') && (ch >= '0'))
1973 {
1974 width = width * 10 + (ch - '0');
1975 ch = *p++;
1976 want_width = 1;
1977 }
1978 }
1979
1980 if (want_width)
1981 {
1982 sprintf(f, "%u", width);
1983 f += strlen (f);
1984 }
1985 precis = 0;
1986 /* precision -- also indicates max number of chars from string */
1987 if (ch == '.')
1988 {
1989 *f++ = ch;
1990 ch = *p++;
1991 want_width = 0;
1992 if (ch == '*')
1993 {
1994 if (SLang_pop_uinteger(&precis)) return (out);
1995 ch = *p++;
1996 want_width = 1;
1997 }
1998 else while ((ch <= '9') && (ch >= '0'))
1999 {
2000 precis = precis * 10 + (ch - '0');
2001 ch = *p++;
2002 want_width = 1;
2003 }
2004 if (want_width)
2005 {
2006 sprintf(f, "%u", precis);
2007 f += strlen (f);
2008 }
2009 else precis = 0;
2010 }
2011
2012 long_var = 0;
2013 int_var = 0;
2014 #ifdef HAVE_LONG_LONG
2015 llong_var = 0;
2016 #endif
2017 str = NULL;
2018 guess_size = 32;
2019 #if SLANG_HAS_FLOAT
2020 use_double = 0;
2021 #endif
2022 use_long = 0;
2023 use_string = 0;
2024 do_free = 0;
2025
2026 if (ch == 'l')
2027 {
2028 use_long = 1;
2029 ch = *p++;
2030 if (ch == 'l')
2031 {
2032 use_long = 2; /* long long */
2033 ch = *p++;
2034 }
2035 }
2036 else if (ch == 'h') ch = *p++; /* not supported */
2037
2038 /* Now the actual format specifier */
2039 switch (ch)
2040 {
2041 case 'B':
2042 if (-1 == _pSLformat_as_binary (precis, use_alt_format))
2043 return out;
2044 /* Remove the precision value from the format string */
2045 f1 = f-1;
2046 while (f1 > dfmt)
2047 {
2048 if (*f1 == '.')
2049 {
2050 *f1 = 0;
2051 f = f1;
2052 break;
2053 }
2054 f1--;
2055 }
2056
2057 /* drop */
2058 case 'S':
2059 if (ch == 'S')
2060 _pSLstring_intrinsic ();
2061 ch = 's';
2062 /* drop */
2063 case 's':
2064 if (-1 == SLang_pop_slstring(&str))
2065 return (out);
2066 do_free = 1;
2067 guess_size = strlen(str);
2068 use_string = 1;
2069 break;
2070
2071 case '%':
2072 guess_size = 1;
2073 do_free = 0;
2074 use_string = 1;
2075 str = (char *) "%";
2076 break;
2077
2078 case 'c':
2079 #if 0
2080 if (use_long)
2081 #endif
2082 {
2083 SLwchar_Type wc;
2084
2085 if (-1 == _pSLang_pop_wchar (&wc))
2086 return out;
2087 if ((_pSLinterp_UTF8_Mode == 0) && (wc <= 0xFF))
2088 {
2089 utf8_buf[0] = (unsigned char)wc;
2090 utf8_buf[1] = 0;
2091 }
2092 else if (NULL == SLutf8_encode_null_terminate (wc, utf8_buf))
2093 return out;
2094 ch = 's';
2095 str = (char *)utf8_buf;
2096 use_string = 1;
2097 }
2098 break;
2099
2100 case 'b':
2101 use_long = 0;
2102 guess_size = 1;
2103 if (-1 == SLang_pop_uchar (&uch))
2104 return out;
2105 int_var = (int) uch;
2106 ch = 'c';
2107 break;
2108
2109 case 'd':
2110 case 'i':
2111 case 'o':
2112 case 'u':
2113 case 'X':
2114 case 'x':
2115 #ifdef HAVE_LONG_LONG
2116 if (use_long > 1)
2117 {
2118 if (-1 == SLang_pop_long_long (&llong_var))
2119 return out;
2120 # ifdef __WIN32__
2121 *f++ = 'I'; *f++ = '6'; *f++ = '4';
2122 # else
2123 *f++ = 'l'; *f++ = 'l';
2124 # endif
2125 }
2126 else
2127 #endif /* HAVE_LONG_LONG */
2128 if (use_long)
2129 {
2130 if (-1 == SLang_pop_long (&long_var))
2131 return out;
2132 *f++ = 'l';
2133 }
2134 else if (-1 == SLang_pop_int (&int_var))
2135 return out;
2136 break;
2137
2138 case 'f':
2139 case 'e':
2140 case 'g':
2141 case 'E':
2142 case 'G':
2143 #if SLANG_HAS_FLOAT
2144 if (SLang_pop_double(&x)) return (out);
2145 use_double = 1;
2146 guess_size = 256;
2147 if (fabs(x) > 1e38)
2148 {
2149 if (0 == _pSLmath_isinf (x))
2150 {
2151 double expon = log10 (fabs(x));
2152 if (expon > (double) 0xFFFF)
2153 ch = 'E';
2154 else
2155 guess_size += (unsigned int) expon;
2156 }
2157 else ch = 'E';
2158 }
2159 use_long = 0;
2160 break;
2161 #endif
2162 case 'p':
2163 guess_size = 32;
2164 /* Pointer type?? Why?? */
2165 if (-1 == SLdo_pop ())
2166 return out;
2167 str = (char *) _pSLang_get_run_stack_pointer ();
2168 use_string = 1;
2169 use_long = 0;
2170 break;
2171
2172 default:
2173 _pSLang_verror (SL_INVALID_PARM, "Invalid printf format");
2174 return(out);
2175 }
2176 *f++ = ch; *f = 0;
2177
2178 width = width + precis;
2179 if (width > guess_size) guess_size = width;
2180
2181 if (len + guess_size > malloc_len)
2182 {
2183 guess_size += 512;
2184 outp = (char *) SLrealloc(out, len + guess_size + 1);
2185 if (outp == NULL)
2186 {
2187 SLang_set_error (SL_MALLOC_ERROR);
2188 return (out);
2189 }
2190 out = outp;
2191 outp = out + len;
2192 malloc_len = len + guess_size;
2193 }
2194
2195 if (use_string)
2196 {
2197 sprintf(outp, dfmt, str);
2198 if (do_free) _pSLang_free_slstring (str);
2199 }
2200 #if SLANG_HAS_FLOAT
2201 else if (use_double) sprintf(outp, dfmt, x);
2202 #endif
2203 else if (use_long)
2204 {
2205 #ifdef HAVE_LONG_LONG
2206 if (use_long > 1)
2207 sprintf (outp, dfmt, llong_var);
2208 else
2209 #endif
2210 sprintf (outp, dfmt, long_var);
2211 }
2212 else sprintf(outp, dfmt, int_var);
2213
2214 len += strlen(outp);
2215 outp = out + len;
2216 fmt = p;
2217 }
2218
2219 if (out != NULL)
2220 {
2221 outp = (char *)SLrealloc (out, (unsigned int) (outp - out) + 1);
2222 if (outp != NULL) out = outp;
2223 }
2224
2225 return (out);
2226 }
2227 #if defined(__GNUC__)
2228 # pragma GCC diagnostic warning "-Wformat-nonliteral"
2229 #endif
2230
2231 /*}}}*/
2232
_pSLstrops_do_sprintf_n(int n)2233 int _pSLstrops_do_sprintf_n (int n) /*{{{*/
2234 {
2235 char *p;
2236 char *fmt;
2237 SLang_Object_Type *ptr;
2238 int ofs;
2239
2240 if (-1 == (ofs = SLreverse_stack (n + 1)))
2241 return -1;
2242
2243 ptr = _pSLang_get_run_stack_base () + ofs;
2244
2245 if (SLang_pop_slstring(&fmt))
2246 return -1;
2247
2248 p = SLdo_sprintf (fmt);
2249 _pSLang_free_slstring (fmt);
2250
2251 SLdo_pop_n (_pSLang_get_run_stack_pointer () - ptr);
2252
2253 if (_pSLang_Error)
2254 {
2255 SLfree (p);
2256 return -1;
2257 }
2258
2259 return SLang_push_malloced_string (p);
2260 }
2261
2262 /*}}}*/
2263
sprintf_n_cmd(int * n)2264 static void sprintf_n_cmd (int *n)
2265 {
2266 _pSLstrops_do_sprintf_n (*n);
2267 }
2268
sprintf_cmd(void)2269 static void sprintf_cmd (void)
2270 {
2271 _pSLstrops_do_sprintf_n (SLang_Num_Function_Args - 1); /* do not include format */
2272 }
2273
2274 /* converts string s to a form that can be used in an eval */
2275 /* UTF-8 ok */
make_printable_string(unsigned char * s)2276 static void make_printable_string(unsigned char *s) /*{{{*/
2277 {
2278 unsigned int len;
2279 unsigned char *s1 = s, ch, *ss1;
2280 unsigned char *ss;
2281
2282 /* compute length */
2283 len = 3;
2284 while ((ch = *s1++) != 0)
2285 {
2286 if ((ch == '\n') || (ch == '\\') || (ch == '"'))
2287 {
2288 len += 2;
2289 continue;
2290 }
2291 ch &= 0x7F;
2292 if ((ch == 127) || (ch < 32))
2293 {
2294 len += 4;
2295 continue;
2296 }
2297 len++;
2298 }
2299
2300 if (NULL == (ss = (unsigned char *) SLmalloc(len)))
2301 return;
2302
2303 s1 = s;
2304 ss1 = ss;
2305 *ss1++ = '"';
2306 while ((ch = *s1++) != 0)
2307 {
2308 if (ch == '\n')
2309 {
2310 *ss1++ = '\\';
2311 *ss1++ = 'n';
2312 continue;
2313 }
2314 if ((ch == '\\') || (ch == '"'))
2315 {
2316 *ss1++ = '\\';
2317 *ss1++ = ch;
2318 continue;
2319 }
2320
2321 if ((ch == 127) || ((ch & 0x7F) < 32))
2322 {
2323 sprintf ((char *)ss1, "\\x%02X", ch);
2324 ss1 += 4;
2325 continue;
2326 }
2327 *ss1++ = ch;
2328 }
2329 *ss1++ = '"';
2330 *ss1 = 0;
2331 (void) SLang_push_malloced_string ((char *)ss);
2332 }
2333
2334 /*}}}*/
2335
extract_element_cmd(char * list,int * nth_ptr,SLwchar_Type * delim_ptr)2336 static void extract_element_cmd (char *list, int *nth_ptr, SLwchar_Type *delim_ptr)
2337 {
2338 SLwchar_Type delim = *delim_ptr;
2339 SLuchar_Type delim_utf8[SLUTF8_MAX_MBLEN+1];
2340 unsigned int delim_len;
2341 char *list1;
2342 int n;
2343
2344 n = *nth_ptr;
2345 if (n < 0)
2346 {
2347 SLang_push_null ();
2348 return;
2349 }
2350
2351 if (NULL == _pSLinterp_encode_wchar (delim, delim_utf8, &delim_len))
2352 return;
2353
2354 while (n > 0)
2355 {
2356 list = strstr (list, (char *)delim_utf8);
2357 if (list == NULL)
2358 {
2359 (void) SLang_push_null();
2360 return;
2361 }
2362 list += delim_len;
2363 n--;
2364 }
2365
2366 list1 = strstr (list, (char *)delim_utf8);
2367 if (list1 == NULL)
2368 {
2369 SLang_push_string (list);
2370 return;
2371 }
2372
2373 (void) _pSLang_push_nstring (list, (unsigned int)(list1 - list));
2374 }
2375
is_list_element_cmd(char * list,char * elem,SLwchar_Type * delim_ptr)2376 static int is_list_element_cmd (char *list, char *elem, SLwchar_Type *delim_ptr)
2377 {
2378 SLuchar_Type delim_utf8[SLUTF8_MAX_MBLEN+1];
2379 unsigned int delim_len;
2380 size_t elem_len;
2381 int n;
2382
2383 if (NULL == _pSLinterp_encode_wchar (*delim_ptr, delim_utf8, &delim_len))
2384 return 0;
2385
2386 if (delim_len == 0)
2387 return (list == elem);
2388
2389 n = 0;
2390 elem_len = strlen (elem);
2391
2392 while (1)
2393 {
2394 size_t len;
2395 char *list_end = strstr (list, (char *)delim_utf8);
2396
2397 if (list_end == NULL)
2398 {
2399 if (0 == strcmp (list, elem))
2400 return n + 1;
2401 return 0;
2402 }
2403 len = list_end - list;
2404 if ((len == elem_len)
2405 && (0 == strncmp (list, elem, len)))
2406 return n + 1;
2407
2408 list += len + delim_len;
2409 n++;
2410 }
2411 }
2412
2413 /*}}}*/
2414
2415 /* Regular expression routines for strings */
2416 static SLRegexp_Type *Regexp;
2417 static unsigned int Regexp_Match_Byte_Offset;
2418
string_match_internal(char * str,char * pat,int n)2419 static int string_match_internal (char *str, char *pat, int n) /*{{{*/
2420 {
2421 char *match;
2422 size_t len;
2423 size_t byte_offset;
2424
2425 if (Regexp != NULL)
2426 {
2427 SLregexp_free (Regexp);
2428 Regexp = NULL;
2429 }
2430
2431 byte_offset = (unsigned int) (n - 1);
2432 len = strlen(str);
2433
2434 if (byte_offset > len)
2435 return 0;
2436
2437 if (NULL == (Regexp = SLregexp_compile (pat, 0)))
2438 return -1;
2439 Regexp_Match_Byte_Offset = byte_offset;
2440
2441 if (NULL == (match = SLregexp_match (Regexp, str+byte_offset, len-byte_offset)))
2442 return 0;
2443
2444 return 1 + (int) (match - str);
2445 }
2446
2447 /*}}}*/
2448
2449
pop_string_match_args(int nargs,char ** strp,char ** patp,int * np)2450 static int pop_string_match_args (int nargs, char **strp, char **patp, int *np)
2451 {
2452 *strp = *patp = NULL;
2453
2454 if (nargs == 2)
2455 *np = 1;
2456 else if (-1 == SLang_pop_int (np))
2457 return -1;
2458
2459 if (-1 == SLang_pop_slstring (patp))
2460 return -1;
2461
2462 if (0 == SLang_pop_slstring (strp))
2463 return 0;
2464
2465 SLang_free_slstring (*patp);
2466 *patp = NULL;
2467 return -1;
2468 }
2469
string_match_cmd(void)2470 static int string_match_cmd (void)
2471 {
2472 char *str, *pat;
2473 int n, status;
2474
2475 if (-1 == pop_string_match_args (SLang_Num_Function_Args, &str, &pat, &n))
2476 return -1;
2477
2478 status = string_match_internal (str, pat, n);
2479 SLang_free_slstring (str);
2480 SLang_free_slstring (pat);
2481 return status;
2482 }
2483
string_match_nth_cmd(int * nptr)2484 static int string_match_nth_cmd (int *nptr) /*{{{*/
2485 {
2486 SLuindex_Type ofs, len;
2487
2488 if (Regexp == NULL)
2489 {
2490 _pSLang_verror (SL_RunTime_Error, "A successful call to string_match was not made");
2491 return -1;
2492 }
2493
2494 if (-1 == SLregexp_nth_match (Regexp, (unsigned int) *nptr, &ofs, &len))
2495 {
2496 _pSLang_verror (0, "SLregexp_nth_match failed");
2497 return -1;
2498 }
2499
2500 ofs += Regexp_Match_Byte_Offset;
2501
2502 /* zero based return value */
2503 SLang_push_integer((int) ofs);
2504 return (int) len;
2505 }
2506
2507 /*}}}*/
2508
string_matches_internal(char * str,char * pat,int n)2509 static int string_matches_internal (char *str, char *pat, int n)
2510 {
2511 int status;
2512 SLuindex_Type i;
2513 SLstrlen_Type lens[10];
2514 SLstrlen_Type offsets[10];
2515 char **strs;
2516 SLindex_Type num;
2517 SLang_Array_Type *at;
2518
2519 status = string_match_internal (str, pat, n);
2520 if (status <= 0)
2521 {
2522 SLang_push_null ();
2523 return -1;
2524 }
2525
2526 for (i = 0; i < 10; i++)
2527 {
2528 if (-1 == SLregexp_nth_match (Regexp, i, offsets+i, lens+i))
2529 break;
2530 offsets[i] += Regexp_Match_Byte_Offset;
2531 }
2532
2533 num = (SLindex_Type)i;
2534
2535 if (NULL == (at = SLang_create_array (SLANG_STRING_TYPE, 0, NULL, &num, 1)))
2536 return -1;
2537
2538 strs = (char **) at->data;
2539 for (i = 0; i < (unsigned int) num; i++)
2540 {
2541 if (NULL == (strs[i] = SLang_create_nslstring (str+offsets[i], lens[i])))
2542 {
2543 SLang_free_array (at);
2544 return -1;
2545 }
2546 }
2547
2548 return SLang_push_array (at, 1);
2549 }
2550
string_matches_cmd(void)2551 static void string_matches_cmd (void)
2552 {
2553 char *str, *pat;
2554 int n;
2555
2556 if (-1 == pop_string_match_args (SLang_Num_Function_Args, &str, &pat, &n))
2557 return;
2558
2559 (void) string_matches_internal (str, pat, n);
2560 SLang_free_slstring (str);
2561 SLang_free_slstring (pat);
2562 }
2563
2564 /* UTF-8 ok */
create_delimited_string(char ** list,size_t n,char * delim)2565 static char *create_delimited_string (char **list, size_t n,
2566 char *delim)
2567 {
2568 size_t len, dlen;
2569 size_t i;
2570 size_t num;
2571 char *str, *s;
2572
2573 len = 1; /* allow room for \0 char */
2574 num = 0;
2575 for (i = 0; i < n; i++)
2576 {
2577 if (list[i] == NULL) continue;
2578 len += strlen (list[i]);
2579 num++;
2580 }
2581
2582 dlen = strlen (delim);
2583 if (num > 1)
2584 len += (num - 1) * dlen;
2585
2586 if (NULL == (str = (char *)SLmalloc (len)))
2587 return NULL;
2588
2589 *str = 0;
2590 s = str;
2591 i = 0;
2592
2593 while (num > 1)
2594 {
2595 size_t len2;
2596
2597 while (list[i] == NULL)
2598 i++;
2599
2600 len2 = strlen (list[i]);
2601 memcpy (s, list[i], len2);
2602 s += len2;
2603 strcpy (s, delim); /* \0 terminates s */
2604 s += dlen;
2605 i++;
2606 num--;
2607 }
2608
2609 if (num)
2610 {
2611 while (list[i] == NULL)
2612 i++;
2613
2614 strcpy (s, list[i]);
2615 }
2616
2617 return str;
2618 }
2619
2620 /* UTF-8 ok */
create_delimited_string_cmd(int * nptr)2621 static void create_delimited_string_cmd (int *nptr)
2622 {
2623 unsigned int n, i;
2624 char **strings;
2625 char *str;
2626
2627 str = NULL;
2628
2629 n = 1 + (unsigned int) *nptr; /* n includes delimiter */
2630
2631 if (NULL == (strings = (char **)_SLcalloc (n, sizeof (char *))))
2632 {
2633 SLdo_pop_n (n);
2634 return;
2635 }
2636 memset((char *)strings, 0, n * sizeof (char *));
2637
2638 i = n;
2639 while (i != 0)
2640 {
2641 i--;
2642 if (-1 == SLang_pop_slstring (strings + i))
2643 goto return_error;
2644 }
2645
2646 str = create_delimited_string (strings + 1, (n - 1), strings[0]);
2647 /* drop */
2648 return_error:
2649 for (i = 0; i < n; i++) _pSLang_free_slstring (strings[i]);
2650 SLfree ((char *)strings);
2651
2652 (void) SLang_push_malloced_string (str); /* NULL Ok */
2653 }
2654
2655 /* UTF-8 ok */
strjoin_cmd(void)2656 static void strjoin_cmd (void)
2657 {
2658 SLang_Array_Type *at;
2659 char *str;
2660 char *delim;
2661 int free_delim;
2662
2663 if (SLang_Num_Function_Args == 1)
2664 {
2665 free_delim = 0;
2666 delim = (char *)"";
2667 }
2668 else
2669 {
2670 if (-1 == SLang_pop_slstring (&delim))
2671 return;
2672 free_delim = 1;
2673 }
2674
2675 if (-1 == SLang_pop_array_of_type (&at, SLANG_STRING_TYPE))
2676 return;
2677
2678 str = create_delimited_string ((char **)at->data, at->num_elements, delim);
2679 SLang_free_array (at);
2680 if (free_delim)
2681 SLang_free_slstring (delim);
2682
2683 (void) SLang_push_malloced_string (str); /* NULL Ok */
2684 }
2685
count_char_occurrences(char * str,SLwchar_Type * wchp)2686 static unsigned int count_char_occurrences (char *str, SLwchar_Type *wchp)
2687 {
2688 SLwchar_Type wch = *wchp;
2689 SLuchar_Type wch_utf8[SLUTF8_MAX_MBLEN+1];
2690 unsigned int wch_utf8_len;
2691 unsigned int n = 0;
2692 int is_byte;
2693
2694 if (wch < 0x80)
2695 is_byte = 1;
2696 else
2697 {
2698 if (_pSLinterp_UTF8_Mode == 0)
2699 {
2700 if (wch >= 256)
2701 {
2702 _pSLang_verror (SL_InvalidParm_Error, "Character is invalid in non-UTF-8 mode");
2703 return 0;
2704 }
2705 is_byte = 1;
2706 }
2707 else
2708 is_byte = 0;
2709 }
2710
2711 if (is_byte)
2712 {
2713 unsigned char byte = (unsigned char) wch;
2714 while (*str != 0)
2715 {
2716 if (*str == byte) n++;
2717 str++;
2718 }
2719 return n;
2720 }
2721
2722 if (NULL == _pSLinterp_encode_wchar (wch, wch_utf8, &wch_utf8_len))
2723 return 0;
2724
2725 while (NULL != (str = strstr (str, (char *)wch_utf8)))
2726 {
2727 n++;
2728 str += wch_utf8_len;
2729 }
2730
2731 return n;
2732 }
2733
glob_to_regexp(char * glob)2734 static void glob_to_regexp (char *glob)
2735 {
2736 unsigned int len;
2737 char *pat, *p;
2738 char ch;
2739
2740 len = _pSLstring_bytelen (glob);
2741 pat = (char *)SLmalloc (2*len + 8);
2742 if (pat == NULL)
2743 return;
2744
2745 p = pat;
2746 *p++ = '^';
2747
2748 /* If the first character of a file is '.', it must be explicitly matched. */
2749 /*
2750 * This will not work until | is supported in REs. Then if the glob
2751 * pattern is *X, the RE will be ^([^.].*X | ^X)$
2752 *
2753 if ((*glob == '?') || (*glob == '*'))
2754 {
2755 *p++ = '[';
2756 *p++ = '^';
2757 *p++ = '.';
2758 *p++ = ']';
2759 if (*glob == '?')
2760 glob++;
2761 }
2762 */
2763 while (0 != (ch = *glob++))
2764 {
2765 if ((ch == '.') || (ch == '$') || (ch == '+') || (ch == '\\'))
2766 {
2767 *p++ = '\\';
2768 *p++ = ch;
2769 continue;
2770 }
2771 if (ch == '*')
2772 {
2773 *p++ = '.';
2774 *p++ = '*';
2775 continue;
2776 }
2777 if (ch == '?')
2778 {
2779 *p++ = '.';
2780 continue;
2781 }
2782 if (ch != '[')
2783 {
2784 *p++ = ch;
2785 continue;
2786 }
2787
2788 /* Otherwise ch = '[' */
2789 if (*glob != 0)
2790 {
2791 char *g = glob;
2792 int is_complement = 0;
2793
2794 ch = *g;
2795 if ((ch == '^') || (ch == '!'))
2796 {
2797 is_complement = 1;
2798 g++;
2799 ch = *g;
2800 }
2801 if (ch == ']')
2802 g++;
2803
2804 while (((ch = *g) != 0) && (ch != ']'))
2805 g++;
2806
2807 if (ch == ']')
2808 {
2809 *p++ = '[';
2810 if (is_complement)
2811 {
2812 *p++ = '^';
2813 glob++;
2814 }
2815 while (glob <= g)
2816 *p++ = *glob++;
2817
2818 continue;
2819 }
2820 }
2821
2822 /* failed to find the matching ']'. So quote it */
2823 *p++ = '\\';
2824 *p++ = '[';
2825 }
2826 *p++ = '$';
2827 *p = 0;
2828
2829 (void) SLang_push_malloced_string (pat); /* frees it too */
2830 }
2831
define_case_intrin(int * a,int * b)2832 static void define_case_intrin (int *a, int *b)
2833 {
2834 SLang_define_case (a, b);
2835 }
2836
convert_offset_to_ptr(char * str,unsigned int len,int ofs)2837 static char *convert_offset_to_ptr (char *str, unsigned int len, int ofs)
2838 {
2839 if (ofs < 0)
2840 {
2841 if ((unsigned int) -ofs > len)
2842 {
2843 SLang_verror (SL_InvalidParm_Error, "offset parameter is too large for input string");
2844 return NULL;
2845 }
2846 return (str + len) + ofs;
2847 }
2848
2849 if ((unsigned int) ofs > len)
2850 {
2851 SLang_verror (SL_InvalidParm_Error, "offset parameter is too large for input string");
2852 return NULL;
2853 }
2854 return str + ofs;
2855 }
2856
skip_bytes_intrin(void)2857 static void skip_bytes_intrin (void)
2858 {
2859 int nmax = -1, n0 = 0;
2860 int has_nmax = 0, utf8_mode;
2861 unsigned int len;
2862 char *str, *chars;
2863 SLuchar_Type *strmin, *strmax;
2864 int invert;
2865 int nargs = SLang_Num_Function_Args;
2866 SLwchar_Lut_Type *lut;
2867 int ignore_combining = 0;
2868
2869 switch (nargs)
2870 {
2871 case 4:
2872 if (-1 == SLang_pop_int (&nmax))
2873 return;
2874 has_nmax = 1;
2875 /* drop */
2876 case 3:
2877 if (-1 == SLang_pop_int (&n0))
2878 return;
2879 /* drop */
2880 default:
2881 if (-1 == SLang_pop_slstring (&chars))
2882 return;
2883 if (-1 == SLang_pop_slstring (&str))
2884 {
2885 SLang_free_slstring (chars);
2886 return;
2887 }
2888 }
2889 len = _pSLstring_bytelen (str);
2890 if (has_nmax)
2891 {
2892 strmax = (SLuchar_Type *)convert_offset_to_ptr (str, len, nmax);
2893 if (strmax == NULL)
2894 goto free_and_return;
2895 }
2896 else strmax = (SLuchar_Type *)str + len;
2897
2898 strmin = (SLuchar_Type *)convert_offset_to_ptr (str, len, n0);
2899 if (strmin == NULL)
2900 goto free_and_return;
2901
2902 /* FIXME!! There should be a way of specifying this when making the lut */
2903 utf8_mode = _pSLinterp_UTF8_Mode; _pSLinterp_UTF8_Mode = 0;
2904 invert = (chars[0] == '^');
2905 if (invert)
2906 lut = SLwchar_strtolut ((SLuchar_Type*)chars+1, 1, 1);
2907 else
2908 lut = SLwchar_strtolut ((SLuchar_Type*)chars, 1, 1);
2909 _pSLinterp_UTF8_Mode = utf8_mode;
2910 if (lut == NULL)
2911 goto free_and_return;
2912
2913 strmax = SLwchar_skip_range (lut, strmin, strmax, ignore_combining, invert);
2914 SLwchar_free_lut (lut);
2915 if (strmax == NULL)
2916 goto free_and_return;
2917
2918 (void) SLang_push_integer ((int)((char *)strmax - str));
2919 /* drop */
2920
2921 free_and_return:
2922 SLang_free_slstring (str);
2923 SLang_free_slstring (chars);
2924 }
2925
copy_strlen_type_to_index_type(SLstrlen_Type a,SLindex_Type * bp)2926 static int copy_strlen_type_to_index_type (SLstrlen_Type a, SLindex_Type *bp)
2927 {
2928 *bp = (SLindex_Type) a;
2929 if ((SLstrlen_Type)*bp != a)
2930 {
2931 SLang_verror (SL_TypeMismatch_Error, "%s", "SLstrlen_Type value to large for conversion to SLindex_Type");
2932 return -1;
2933 }
2934 return 0;
2935 }
2936
string_to_wchars(unsigned char * str)2937 static void string_to_wchars (unsigned char *str)
2938 {
2939 SLstrlen_Type i, len;
2940 SLang_Array_Type *at;
2941 _pSLint32_Type *data;
2942 unsigned char *strmax;
2943 SLindex_Type dims[1];
2944
2945 len = SLutf8_strlen (str, 0);
2946 if (-1 == copy_strlen_type_to_index_type (len, dims))
2947 return;
2948
2949 if (NULL == (at = SLang_create_array (_pSLANG_INT32_TYPE, 0, NULL, dims, 1)))
2950 return;
2951
2952 i = 0;
2953 strmax = str + _pSLstring_bytelen ((const char *)str);
2954 data = (_pSLint32_Type *)at->data;
2955 while (str < strmax)
2956 {
2957 unsigned char *s;
2958 SLwchar_Type wch;
2959
2960 if (*str < 0x80)
2961 {
2962 data[i++] = *str++;
2963 continue;
2964 }
2965
2966 s = SLutf8_decode (str, strmax, &wch, NULL);
2967 if (s == NULL)
2968 {
2969 data[i++] = -(int)(*str);
2970 str++;
2971 continue;
2972 }
2973 data[i++] = (_pSLint32_Type)wch;
2974 str = s;
2975 }
2976
2977 (void) SLang_push_array (at, 1);
2978 }
2979
wchars_to_string(void)2980 static void wchars_to_string (void)
2981 {
2982 SLindex_Type i, n;
2983 SLang_Array_Type *at;
2984 _pSLint32_Type *data;
2985 unsigned char *buf, *b, *bmax;
2986 SLstrlen_Type buflen;
2987
2988 if (-1 == SLang_pop_array_of_type (&at, _pSLANG_INT32_TYPE))
2989 return;
2990
2991 buflen = n = at->num_elements;
2992 buf = (unsigned char *)SLmalloc(buflen+1);
2993 if (buf == NULL)
2994 {
2995 SLang_free_array (at);
2996 return;
2997 }
2998
2999 data = (_pSLint32_Type *) at->data;
3000 b = buf;
3001 bmax = b + buflen;
3002
3003 i = 0;
3004 for (i = 0; i < n; i++)
3005 {
3006 SLstrlen_Type dlen;
3007 _pSLint32_Type wch;
3008
3009 wch = data[i];
3010 if ((wch < 0x80) && (b < bmax))
3011 {
3012 if (wch < 0) wch = -wch;
3013 *b++ = (unsigned char)(wch);
3014 continue;
3015 }
3016
3017 dlen = SLUTF8_MAX_MBLEN;
3018 if (b + dlen >= bmax)
3019 {
3020 unsigned char *newbuf;
3021
3022 dlen = 6;
3023 if (NULL == (newbuf = (unsigned char *)SLrealloc ((char *)buf, buflen+dlen+1)))
3024 {
3025 SLfree ((char *)buf);
3026 SLang_free_array (at);
3027 return;
3028 }
3029 b = newbuf + (b-buf);
3030 buf = newbuf;
3031 buflen += dlen;
3032 bmax = b + buflen;
3033 }
3034 b = SLutf8_encode (wch, b, SLUTF8_MAX_MBLEN);
3035 }
3036
3037 if (buf + buflen != b)
3038 {
3039 unsigned char *newbuf;
3040 buflen = b - buf;
3041 newbuf = (unsigned char *)SLrealloc((char *)buf, buflen+1);
3042 if (newbuf == NULL)
3043 {
3044 SLfree ((char *)buf);
3045 SLang_free_array (at);
3046 return;
3047 }
3048 b = newbuf + (b - buf);
3049 buf = newbuf;
3050 }
3051 *b = 0;
3052
3053 (void) SLang_push_malloced_string ((char *)buf); /* frees it, even upon error */
3054 SLang_free_array (at);
3055 }
3056
3057 static SLang_Intrin_Fun_Type Strops_Table [] = /*{{{*/
3058 {
3059 MAKE_INTRINSIC_I("create_delimited_string", create_delimited_string_cmd, SLANG_VOID_TYPE),
3060 MAKE_INTRINSIC_0("strcmp", strcmp_vintrin, SLANG_VOID_TYPE),
3061 MAKE_INTRINSIC_0("strncmp", strncmp_vintrin, SLANG_VOID_TYPE),
3062 MAKE_INTRINSIC_0("strncharcmp", strncharcmp_vintrin, SLANG_VOID_TYPE),
3063 MAKE_INTRINSIC_0("strnbytecmp", strnbytecmp_vintrin, SLANG_VOID_TYPE),
3064 MAKE_INTRINSIC_0("strcat", strcat_cmd, SLANG_VOID_TYPE),
3065 MAKE_INTRINSIC_0("strlen", strlen_vintrin, SLANG_VOID_TYPE),
3066 MAKE_INTRINSIC_0("strcharlen", strcharlen_vintrin, SLANG_VOID_TYPE),
3067 MAKE_INTRINSIC_0("strbytelen", strbytelen_vintrin, SLANG_VOID_TYPE),
3068 MAKE_INTRINSIC_3("strchop", strchop_cmd, SLANG_VOID_TYPE, SLANG_STRING_TYPE, SLANG_WCHAR_TYPE, SLANG_WCHAR_TYPE),
3069 MAKE_INTRINSIC_3("strchopr", strchopr_cmd, SLANG_VOID_TYPE, SLANG_STRING_TYPE, SLANG_WCHAR_TYPE, SLANG_WCHAR_TYPE),
3070 MAKE_INTRINSIC_0("strreplace", strreplace_cmd, SLANG_VOID_TYPE),
3071 MAKE_INTRINSIC_SSS("str_replace", str_replace_cmd, SLANG_INT_TYPE),
3072 MAKE_INTRINSIC_SII("substr", substr_cmd, SLANG_VOID_TYPE),
3073 MAKE_INTRINSIC_SII("substrbytes", subbytes_cmd, SLANG_VOID_TYPE),
3074 MAKE_INTRINSIC_0("is_substr", issubstr_vintrin, SLANG_VOID_TYPE),
3075 MAKE_INTRINSIC_2("strsub", strsub_cmd, SLANG_VOID_TYPE, SLANG_INT_TYPE, SLANG_WCHAR_TYPE),
3076 MAKE_INTRINSIC_2("strbytesub", strbytesub_cmd, SLANG_VOID_TYPE, SLANG_INT_TYPE, SLANG_UCHAR_TYPE),
3077 MAKE_INTRINSIC_3("extract_element", extract_element_cmd, SLANG_VOID_TYPE, SLANG_STRING_TYPE, SLANG_INT_TYPE, SLANG_WCHAR_TYPE),
3078 MAKE_INTRINSIC_3("is_list_element", is_list_element_cmd, SLANG_INT_TYPE, SLANG_STRING_TYPE, SLANG_STRING_TYPE, SLANG_WCHAR_TYPE),
3079 MAKE_INTRINSIC_0("string_match", string_match_cmd, SLANG_INT_TYPE),
3080 MAKE_INTRINSIC_0("string_matches", string_matches_cmd, SLANG_VOID_TYPE),
3081 MAKE_INTRINSIC_I("string_match_nth", string_match_nth_cmd, SLANG_INT_TYPE),
3082 MAKE_INTRINSIC_0("strlow", strlow_vintrin, SLANG_VOID_TYPE),
3083 MAKE_INTRINSIC_1("tolower", tolower_cmd, SLANG_INT_TYPE, SLANG_WCHAR_TYPE),
3084 MAKE_INTRINSIC_1("toupper", toupper_cmd, SLANG_INT_TYPE, SLANG_WCHAR_TYPE),
3085 MAKE_INTRINSIC_0("strup", strup_vintrin, SLANG_VOID_TYPE),
3086 MAKE_INTRINSIC_0("strtrim", strtrim_vintrin, SLANG_VOID_TYPE),
3087 MAKE_INTRINSIC_0("strtrim_end", strtrim_end_vintrin, SLANG_VOID_TYPE),
3088 MAKE_INTRINSIC_0("strtrim_beg", strtrim_beg_vintrin, SLANG_VOID_TYPE),
3089 MAKE_INTRINSIC_S("strcompress", strcompress_vintrin, SLANG_VOID_TYPE),
3090 MAKE_INTRINSIC_I("Sprintf", sprintf_n_cmd, SLANG_VOID_TYPE),
3091 MAKE_INTRINSIC_0("sprintf", sprintf_cmd, SLANG_VOID_TYPE),
3092 MAKE_INTRINSIC_0("sscanf", _pSLang_sscanf, SLANG_INT_TYPE),
3093 MAKE_INTRINSIC_S("make_printable_string", make_printable_string, SLANG_VOID_TYPE),
3094 MAKE_INTRINSIC_3("str_quote_string", str_quote_string_cmd, SLANG_VOID_TYPE, SLANG_STRING_TYPE, SLANG_STRING_TYPE, SLANG_WCHAR_TYPE),
3095 MAKE_INTRINSIC_SSS("str_uncomment_string", str_uncomment_string_cmd, SLANG_VOID_TYPE),
3096 MAKE_INTRINSIC_II("define_case", define_case_intrin, SLANG_VOID_TYPE),
3097 MAKE_INTRINSIC_S("strtok", strtok_cmd, SLANG_VOID_TYPE),
3098 MAKE_INTRINSIC_0("strjoin", strjoin_cmd, SLANG_VOID_TYPE),
3099 MAKE_INTRINSIC_S("strtrans", strtrans_vintrin, SLANG_VOID_TYPE),
3100 MAKE_INTRINSIC_0("str_delete_chars", str_delete_chars_vintrin, SLANG_VOID_TYPE),
3101 MAKE_INTRINSIC_S("glob_to_regexp", glob_to_regexp, SLANG_VOID_TYPE),
3102 MAKE_INTRINSIC_2("count_char_occurrences", count_char_occurrences, SLANG_UINT_TYPE, SLANG_STRING_TYPE, SLANG_WCHAR_TYPE),
3103 MAKE_INTRINSIC_2("count_char_occurances", count_char_occurrences, SLANG_UINT_TYPE, SLANG_STRING_TYPE, SLANG_WCHAR_TYPE),
3104 MAKE_INTRINSIC_0("strskipbytes", skip_bytes_intrin, SLANG_VOID_TYPE),
3105 MAKE_INTRINSIC_0("islower", islower_intrin, SLANG_CHAR_TYPE),
3106 MAKE_INTRINSIC_0("isupper", isupper_intrin, SLANG_CHAR_TYPE),
3107 MAKE_INTRINSIC_0("isalpha", isalpha_intrin, SLANG_CHAR_TYPE),
3108 MAKE_INTRINSIC_0("isxdigit", isxdigit_intrin, SLANG_CHAR_TYPE),
3109 MAKE_INTRINSIC_0("isspace", isspace_intrin, SLANG_CHAR_TYPE),
3110 MAKE_INTRINSIC_0("isblank", isblank_intrin, SLANG_CHAR_TYPE),
3111 MAKE_INTRINSIC_0("iscntrl", iscntrl_intrin, SLANG_CHAR_TYPE),
3112 MAKE_INTRINSIC_0("isprint", isprint_intrin, SLANG_CHAR_TYPE),
3113 MAKE_INTRINSIC_0("isdigit", isdigit_intrin, SLANG_CHAR_TYPE),
3114 MAKE_INTRINSIC_0("isgraph", isgraph_intrin, SLANG_CHAR_TYPE),
3115 MAKE_INTRINSIC_0("isalnum", isalnum_intrin, SLANG_CHAR_TYPE),
3116 MAKE_INTRINSIC_0("ispunct", ispunct_intrin, SLANG_CHAR_TYPE),
3117 MAKE_INTRINSIC_0("isascii", isascii_intrin, SLANG_CHAR_TYPE),
3118 MAKE_INTRINSIC_0("strskipchar", strskipchar_intrin, SLANG_VOID_TYPE),
3119 MAKE_INTRINSIC_0("strbskipchar", strbskipchar_intrin, SLANG_VOID_TYPE),
3120 MAKE_INTRINSIC_S("string_to_wchars", string_to_wchars, SLANG_VOID_TYPE),
3121 MAKE_INTRINSIC_0("wchars_to_string", wchars_to_string, SLANG_VOID_TYPE),
3122 SLANG_END_INTRIN_FUN_TABLE
3123 };
3124
3125 /*}}}*/
3126
_pSLang_init_slstrops(void)3127 int _pSLang_init_slstrops (void)
3128 {
3129 return SLadd_intrin_fun_table (Strops_Table, NULL);
3130 }
3131