1 /*
2 Copyright (C) 2004-2017,2018 John E. Davis
3
4 This file is part of the S-Lang Library.
5
6 The S-Lang Library 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 the
9 License, or (at your option) any later version.
10
11 The S-Lang Library 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 GNU
14 General Public License for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with this library; if not, write to the Free Software
18 Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
19 USA.
20 */
21
22 #include "slinclud.h"
23
24 #include "slang.h"
25 #include "_slang.h"
26
27 typedef struct _pSLstring_Type
28 {
29 struct _pSLstring_Type *next;
30 unsigned int ref_count;
31 SLstr_Hash_Type hash;
32 size_t len;
33 char bytes [1];
34 }
35 SLstring_Type;
36
37 #define MAP_HASH_TO_INDEX(hash) ((hash) % SLSTRING_HASH_TABLE_SIZE)
38
39 static SLstring_Type *String_Hash_Table [SLSTRING_HASH_TABLE_SIZE];
40 static char Single_Char_Strings [256 * 2];
41
42 #if SLANG_OPTIMIZE_FOR_SPEED
43 #define MAX_FREE_STORE_LEN 32
44 static SLstring_Type *SLS_Free_Store [MAX_FREE_STORE_LEN];
45
46 # define NUM_CACHED_STRINGS 601
47 typedef struct
48 {
49 SLstring_Type *sls;
50 SLCONST char *str;
51 }
52 Cached_String_Type;
53 static SLCONST char *Deleted_String = "*deleted*";
54 static Cached_String_Type Cached_Strings [NUM_CACHED_STRINGS];
55
56 #define GET_CACHED_STRING(s) \
57 (Cached_Strings + (unsigned int)(((size_t) (s)) % NUM_CACHED_STRINGS))
58
59 _INLINE_
cache_string(SLstring_Type * sls)60 static void cache_string (SLstring_Type *sls)
61 {
62 Cached_String_Type *cs;
63
64 cs = GET_CACHED_STRING(sls->bytes);
65 cs->str = sls->bytes;
66 cs->sls = sls;
67 }
68
69 _INLINE_
uncache_string(SLCONST char * s)70 static void uncache_string (SLCONST char *s)
71 {
72 Cached_String_Type *cs;
73
74 cs = GET_CACHED_STRING(s);
75 if (cs->str == s)
76 {
77 cs->sls = NULL;
78 cs->str = Deleted_String;
79 }
80 }
81 #endif
82
83 #if USE_NEW_HASH_CODE
84 /* This hash algorithm comes from:
85 *
86 * Bob Jenkins, 1996. bob_jenkins@burtleburtle.net.
87 * You may use this code any way you wish, private, educational, or commercial. It's free.
88 * See http://burtleburtle.net/bob/hash/evahash.html
89 */
90
91 #define mix(a,b,c) \
92 { \
93 a -= b; a -= c; a ^= (c>>13); \
94 b -= c; b -= a; b ^= (a<<8); \
95 c -= a; c -= b; c ^= (b>>13); \
96 a -= b; a -= c; a ^= (c>>12); \
97 b -= c; b -= a; b ^= (a<<16); \
98 c -= a; c -= b; c ^= (b>>5); \
99 a -= b; a -= c; a ^= (c>>3); \
100 b -= c; b -= a; b ^= (a<<10); \
101 c -= a; c -= b; c ^= (b>>15); \
102 }
103
104 _INLINE_
_pSLstring_hash(SLCONST unsigned char * s,SLCONST unsigned char * smax)105 SLstr_Hash_Type _pSLstring_hash (SLCONST unsigned char *s, SLCONST unsigned char *smax)
106 {
107 register _pSLuint32_Type a,b,c;
108 unsigned int length = (unsigned int)(smax - s);
109 unsigned int len = length;
110
111 a = b = 0x9e3779b9; /* the golden ratio; an arbitrary value */
112 c = 0;
113
114 /*---------------------------------------- handle most of the key */
115 while (len >= 12)
116 {
117 a += (s[0] +((_pSLuint32_Type)s[1]<<8) +((_pSLuint32_Type)s[2]<<16) +((_pSLuint32_Type)s[3]<<24));
118 b += (s[4] +((_pSLuint32_Type)s[5]<<8) +((_pSLuint32_Type)s[6]<<16) +((_pSLuint32_Type)s[7]<<24));
119 c += (s[8] +((_pSLuint32_Type)s[9]<<8) +((_pSLuint32_Type)s[10]<<16)+((_pSLuint32_Type)s[11]<<24));
120 mix(a,b,c);
121 s += 12; len -= 12;
122 }
123
124 /*------------------------------------- handle the last 11 bytes */
125 c += length;
126 switch(len) /* all the case statements fall through */
127 {
128 case 11: c+=((_pSLuint32_Type)s[10]<<24);
129 case 10: c+=((_pSLuint32_Type)s[9]<<16);
130 case 9 : c+=((_pSLuint32_Type)s[8]<<8);
131 /* the first byte of c is reserved for the length */
132 case 8 : b+=((_pSLuint32_Type)s[7]<<24);
133 case 7 : b+=((_pSLuint32_Type)s[6]<<16);
134 case 6 : b+=((_pSLuint32_Type)s[5]<<8);
135 case 5 : b+=s[4];
136 case 4 : a+=((_pSLuint32_Type)s[3]<<24);
137 case 3 : a+=((_pSLuint32_Type)s[2]<<16);
138 case 2 : a+=((_pSLuint32_Type)s[1]<<8);
139 case 1 : a+=s[0];
140 /* case 0: nothing left to add */
141 }
142 mix(a,b,c);
143
144 /*-------------------------------------------- report the result */
145 return (SLstr_Hash_Type) c;
146 }
147 #else
148 _INLINE_
_pSLstring_hash(SLCONST unsigned char * s,SLCONST unsigned char * smax)149 unsigned long _pSLstring_hash (SLCONST unsigned char *s, SLCONST unsigned char *smax)
150 {
151 register unsigned long h = 0;
152 register unsigned long sum = 0;
153 unsigned char *smax4;
154
155 smax4 = smax - 4;
156
157 while (s < smax4)
158 {
159 sum += s[0];
160 h = sum + (h << 1);
161 sum += s[1];
162 h = sum + (h << 1);
163 sum += s[2];
164 h = sum + (h << 1);
165 sum += s[3];
166 h = sum + (h << 1);
167
168 s += 4;
169 }
170
171 while (s < smax)
172 {
173 sum += *s++;
174 h ^= sum + (h << 3); /* slightly different */
175 }
176
177 return h;
178 }
179 #endif
SLcompute_string_hash(SLCONST char * s)180 SLstr_Hash_Type SLcompute_string_hash (SLCONST char *s)
181 {
182 #if SLANG_OPTIMIZE_FOR_SPEED
183 Cached_String_Type *cs;
184
185 cs = GET_CACHED_STRING(s);
186 if (cs->str == s)
187 return cs->sls->hash;
188 #endif
189 return _pSLstring_hash ((unsigned char *) s, (unsigned char *) s + strlen (s));
190 }
191
192 _INLINE_
find_slstring(SLCONST char * s,SLstr_Hash_Type hash)193 static SLstring_Type *find_slstring (SLCONST char *s, SLstr_Hash_Type hash)
194 {
195 SLstring_Type *sls, *prev;
196 size_t idx = MAP_HASH_TO_INDEX(hash);
197
198 sls = String_Hash_Table [idx];
199 if ((sls == NULL) || (sls->bytes == s)) return sls;
200
201 sls = sls->next;
202 if ((sls == NULL) || (sls->bytes == s)) return sls;
203
204 sls = sls->next;
205 if ((sls == NULL) || (sls->bytes == s)) return sls;
206
207 prev = sls;
208 sls = sls->next;
209 while (sls != NULL)
210 {
211 if (s == sls->bytes)
212 {
213 SLstring_Type *sls0;
214 prev->next = sls->next;
215 sls0 = String_Hash_Table[idx];
216 String_Hash_Table[idx] = sls;
217 sls->next = sls0;
218 return sls;
219 }
220 prev = sls;
221 sls = sls->next;
222 }
223 return sls;
224 }
225
226 _INLINE_
227 /* This routine works with any (long) string */
find_string(SLCONST char * s,unsigned int len,SLstr_Hash_Type hash)228 static SLstring_Type *find_string (SLCONST char *s, unsigned int len, SLstr_Hash_Type hash)
229 {
230 SLstring_Type *sls;
231
232 /* Assume it is an slstring */
233 sls = find_slstring (s, hash);
234 if (sls != NULL)
235 {
236 /* This means that sls->bytes == s. But the string that we are looking
237 * for consists of just the first len bytes. Check that too.
238 */
239 if (sls->len == len)
240 return sls;
241 }
242
243 /* Ok, not an slstring. Try to find a matching one */
244 sls = String_Hash_Table [(unsigned int) MAP_HASH_TO_INDEX(hash)];
245
246 if (sls == NULL)
247 return NULL;
248
249 do
250 {
251 /* Note that we need to actually make sure that bytes[len] == 0.
252 * In this case, it is not enough to just compare pointers. In fact,
253 * this is called from create_nstring, etc... It is unlikely that the
254 * pointer is a slstring
255 */
256 if ((sls->hash == hash)
257 && (sls->len == len)
258 && (0 == strncmp (s, sls->bytes, len)))
259 break;
260
261 sls = sls->next;
262 }
263 while (sls != NULL);
264
265 return sls;
266 }
267
268 _INLINE_
allocate_sls(unsigned int len)269 static SLstring_Type *allocate_sls (unsigned int len)
270 {
271 SLstring_Type *sls;
272 #if SLANG_OPTIMIZE_FOR_SPEED
273
274 if ((len < MAX_FREE_STORE_LEN)
275 && (NULL != (sls = SLS_Free_Store [len])))
276 {
277 SLS_Free_Store[len] = NULL;
278 return sls;
279 }
280 #endif
281 /* FIXME: use structure padding */
282 sls = (SLstring_Type *) SLmalloc (len + sizeof (SLstring_Type));
283 if (sls != NULL)
284 sls->len = len;
285 return sls;
286 }
287
288 _INLINE_
free_sls(SLstring_Type * sls)289 static void free_sls (SLstring_Type *sls)
290 {
291 #if SLANG_OPTIMIZE_FOR_SPEED
292 size_t len = sls->len;
293 if ((len < MAX_FREE_STORE_LEN)
294 && (SLS_Free_Store[len] == NULL))
295 {
296 SLS_Free_Store [len] = sls;
297 return;
298 }
299 #endif
300 SLfree ((char *)sls);
301 }
302
303 _INLINE_
create_long_string(SLCONST char * s,size_t len,SLstr_Hash_Type hash)304 static char *create_long_string (SLCONST char *s, size_t len, SLstr_Hash_Type hash)
305 {
306 SLstring_Type *sls;
307
308 sls = find_string (s, len, hash);
309
310 if (sls != NULL)
311 {
312 sls->ref_count++;
313 #if SLANG_OPTIMIZE_FOR_SPEED
314 cache_string (sls);
315 #endif
316 return sls->bytes;
317 }
318
319 sls = allocate_sls (len);
320 if (sls == NULL)
321 return NULL;
322
323 strncpy (sls->bytes, s, len);
324 sls->bytes[len] = 0;
325 sls->ref_count = 1;
326 sls->hash = hash;
327 #if SLANG_OPTIMIZE_FOR_SPEED
328 cache_string (sls);
329 #endif
330
331 hash = MAP_HASH_TO_INDEX(hash);
332 sls->next = String_Hash_Table [(unsigned int)hash];
333 String_Hash_Table [(unsigned int)hash] = sls;
334
335 return sls->bytes;
336 }
337
338 _INLINE_
create_short_string(SLCONST char * s,unsigned int len)339 static char *create_short_string (SLCONST char *s, unsigned int len)
340 {
341 char ch;
342
343 /* Note: if len is 0, then it does not matter what *s is. This is
344 * important for SLang_create_nslstring.
345 */
346 if (len) ch = *s; else ch = 0;
347
348 len = 2 * (unsigned int) ((unsigned char) ch);
349 Single_Char_Strings [len] = ch;
350 Single_Char_Strings [len + 1] = 0;
351 return Single_Char_Strings + len;
352 }
353
354 /* s cannot be NULL */
355 _INLINE_
create_nstring(SLCONST char * s,size_t len,SLstr_Hash_Type * hash_ptr)356 static SLstr_Type *create_nstring (SLCONST char *s, size_t len, SLstr_Hash_Type *hash_ptr)
357 {
358 SLstr_Hash_Type hash;
359
360 if (len < 2)
361 return create_short_string (s, len);
362
363 hash = _pSLstring_hash ((unsigned char *) s, (unsigned char *) (s + len));
364 *hash_ptr = hash;
365
366 return create_long_string (s, len, hash);
367 }
368
SLang_create_nslstring(SLFUTURE_CONST char * s,SLstrlen_Type len)369 SLstr_Type *SLang_create_nslstring (SLFUTURE_CONST char *s, SLstrlen_Type len)
370 {
371 SLstr_Hash_Type hash;
372 if (s == NULL)
373 return NULL;
374 return create_nstring (s, len, &hash);
375 }
376
_pSLstring_make_hashed_string(SLCONST char * s,SLstrlen_Type len,SLstr_Hash_Type * hashptr)377 char *_pSLstring_make_hashed_string (SLCONST char *s, SLstrlen_Type len, SLstr_Hash_Type *hashptr)
378 {
379 SLstr_Hash_Type hash;
380
381 if (s == NULL) return NULL;
382
383 hash = _pSLstring_hash ((unsigned char *) s, (unsigned char *) s + len);
384 *hashptr = hash;
385
386 if (len < 2)
387 return create_short_string (s, len);
388
389 return create_long_string (s, len, hash);
390 }
391
_pSLstring_dup_hashed_string(SLCONST char * s,SLstr_Hash_Type hash)392 char *_pSLstring_dup_hashed_string (SLCONST char *s, SLstr_Hash_Type hash)
393 {
394 size_t len;
395 #if SLANG_OPTIMIZE_FOR_SPEED
396 Cached_String_Type *cs;
397
398 if (s == NULL) return NULL;
399 if (s[0] == 0)
400 return create_short_string (s, 0);
401 if (s[1] == 0)
402 return create_short_string (s, 1);
403
404 cs = GET_CACHED_STRING(s);
405 if (cs->str == s)
406 {
407 cs->sls->ref_count += 1;
408 return (char *) s;
409 }
410 #else
411 if (s == NULL) return NULL;
412 #endif
413
414 len = strlen (s);
415 #if !SLANG_OPTIMIZE_FOR_SPEED
416 if (len < 2) return create_short_string (s, len);
417 #endif
418
419 return create_long_string (s, len, hash);
420 }
421
422 /* This function requires an slstring!!! */
_pSLstring_dup_slstring(SLCONST char * s)423 SLCONST char *_pSLstring_dup_slstring (SLCONST char *s)
424 {
425 SLstring_Type *sls;
426 #if SLANG_OPTIMIZE_FOR_SPEED
427 Cached_String_Type *cs;
428 #endif
429
430 if (s == NULL)
431 return s;
432 #if SLANG_OPTIMIZE_FOR_SPEED
433 cs = GET_CACHED_STRING(s);
434 if (cs->str == s)
435 {
436 cs->sls->ref_count += 1;
437 return s;
438 }
439 #endif
440 if ((s[0] == 0) || (s[1] == 0))
441 return s;
442
443 sls = (SLstring_Type *) (s - offsetof(SLstring_Type,bytes[0]));
444 sls->ref_count++;
445 #if SLANG_OPTIMIZE_FOR_SPEED
446 cache_string (sls);
447 #endif
448 return s;
449 }
450
free_sls_string(SLstring_Type * sls)451 static void free_sls_string (SLstring_Type *sls)
452 {
453 SLstring_Type *sls1, *prev;
454 SLstr_Hash_Type hash = sls->hash;
455
456 hash = MAP_HASH_TO_INDEX(hash);
457
458 sls1 = String_Hash_Table [(unsigned int) hash];
459
460 prev = NULL;
461
462 /* This should not fail. */
463 while (sls1 != sls)
464 {
465 prev = sls1;
466 sls1 = sls1->next;
467 }
468
469 if (prev != NULL)
470 prev->next = sls->next;
471 else
472 String_Hash_Table [(unsigned int) hash] = sls->next;
473
474 free_sls (sls);
475 }
476
477 _INLINE_
free_long_string(SLCONST char * s,SLstr_Hash_Type hash)478 static void free_long_string (SLCONST char *s, SLstr_Hash_Type hash)
479 {
480 SLstring_Type *sls;
481
482 if (NULL == (sls = find_slstring (s, hash)))
483 {
484 _pSLang_verror (SL_APPLICATION_ERROR, "invalid attempt to free string:%s", s);
485 return;
486 }
487
488 sls->ref_count--;
489 if (sls->ref_count != 0)
490 {
491 #if SLANG_OPTIMIZE_FOR_SPEED
492 /* cache_string (sls, len, hash); */
493 #endif
494 return;
495 }
496 #if SLANG_OPTIMIZE_FOR_SPEED
497 uncache_string (s);
498 #endif
499 free_sls_string (sls);
500 }
501
502 /* This routine may be passed NULL-- it is not an error. */
SLang_free_slstring(SLCONST char * s)503 void SLang_free_slstring (SLCONST char *s)
504 {
505 SLstr_Hash_Type hash;
506 size_t len;
507 #if SLANG_OPTIMIZE_FOR_SPEED
508 Cached_String_Type *cs;
509 #endif
510
511 if (s == NULL) return;
512
513 #if SLANG_OPTIMIZE_FOR_SPEED
514 cs = GET_CACHED_STRING(s);
515 if (cs->str == s)
516 {
517 SLstring_Type *sls = cs->sls;
518 if (sls->ref_count <= 1)
519 {
520 #if SLANG_OPTIMIZE_FOR_SPEED
521 cs->sls = NULL;
522 cs->str = Deleted_String;
523 #endif
524 free_sls_string (sls);
525 }
526 else
527 sls->ref_count -= 1;
528 return;
529 }
530 #endif
531
532 if ((len = strlen (s)) < 2)
533 return;
534
535 hash = _pSLstring_hash ((unsigned char *)s, (unsigned char *) s + len);
536 free_long_string (s, hash);
537 }
538
SLang_create_slstring(SLFUTURE_CONST char * s)539 char *SLang_create_slstring (SLFUTURE_CONST char *s)
540 {
541 SLstr_Hash_Type hash;
542 #if SLANG_OPTIMIZE_FOR_SPEED
543 Cached_String_Type *cs;
544 #endif
545
546 if (s == NULL) return NULL;
547 #if SLANG_OPTIMIZE_FOR_SPEED
548 cs = GET_CACHED_STRING(s);
549 if (cs->str == s)
550 {
551 cs->sls->ref_count += 1;
552 return (char *) s;
553 }
554 #endif
555
556 return create_nstring (s, strlen (s), &hash);
557 }
558
_pSLfree_hashed_string(SLCONST char * s,size_t len,SLstr_Hash_Type hash)559 void _pSLfree_hashed_string (SLCONST char *s, size_t len, SLstr_Hash_Type hash)
560 {
561 if ((s == NULL) || (len < 2)) return;
562 free_long_string (s, hash);
563 }
564
_pSLallocate_slstring(size_t len)565 char *_pSLallocate_slstring (size_t len)
566 {
567 SLstring_Type *sls = allocate_sls (len);
568 if (sls == NULL)
569 return NULL;
570
571 sls->hash = 0;
572 return sls->bytes;
573 }
574
_pSLunallocate_slstring(char * s,size_t len)575 void _pSLunallocate_slstring (char *s, size_t len)
576 {
577 SLstring_Type *sls;
578
579 (void) len;
580 if (s == NULL)
581 return;
582
583 sls = (SLstring_Type *) (s - offsetof(SLstring_Type,bytes[0]));
584 free_sls (sls);
585 }
586
587 /* frees s upon error */
_pSLcreate_via_alloced_slstring(char * s,size_t len)588 char *_pSLcreate_via_alloced_slstring (char *s, size_t len)
589 {
590 SLstr_Hash_Type hash;
591 SLstring_Type *sls;
592
593 if (s == NULL)
594 return NULL;
595
596 if (len < 2)
597 {
598 char *s1 = create_short_string (s, len);
599 _pSLunallocate_slstring (s, len);
600 return s1;
601 }
602
603 /* s is not going to be in the cache because when it was malloced, its
604 * value was unknown. This simplifies the coding.
605 */
606 hash = _pSLstring_hash ((unsigned char *)s, (unsigned char *)s + len);
607 sls = find_string (s, len, hash);
608 if (sls != NULL)
609 {
610 sls->ref_count++;
611 _pSLunallocate_slstring (s, len);
612 s = sls->bytes;
613
614 #if SLANG_OPTIMIZE_FOR_SPEED
615 cache_string (sls);
616 #endif
617 return s;
618 }
619
620 sls = (SLstring_Type *) (s - offsetof(SLstring_Type,bytes[0]));
621 sls->ref_count = 1;
622 sls->hash = hash;
623
624 #if SLANG_OPTIMIZE_FOR_SPEED
625 cache_string (sls);
626 #endif
627
628 hash = MAP_HASH_TO_INDEX(hash);
629 sls->next = String_Hash_Table [(unsigned int)hash];
630 String_Hash_Table [(unsigned int)hash] = sls;
631
632 return s;
633 }
634
635 /* Note, a and b may be ordinary strings. The result is an slstring */
SLang_concat_slstrings(char * a,char * b)636 char *SLang_concat_slstrings (char *a, char *b)
637 {
638 unsigned int lena, lenb, len;
639 char *c;
640
641 lena = _pSLstring_bytelen (a);
642 lenb = _pSLstring_bytelen (b);
643 len = lena + lenb;
644
645 c = _pSLallocate_slstring (len);
646 if (c == NULL)
647 return NULL;
648
649 memcpy (c, a, lena);
650 memcpy (c + lena, b, lenb);
651 c[len] = 0;
652
653 return _pSLcreate_via_alloced_slstring (c, len);
654 }
655
656 /* This routine is assumed to work even if s is not an slstring */
_pSLstring_bytelen(SLCONST SLstr_Type * s)657 size_t _pSLstring_bytelen (SLCONST SLstr_Type *s)
658 {
659 #if SLANG_OPTIMIZE_FOR_SPEED
660 Cached_String_Type *cs;
661
662 cs = GET_CACHED_STRING(s);
663 if (cs->str == s)
664 return cs->sls->len;
665 #endif
666 return strlen (s);
667 }
668
669 /* The caller must ensure that this is an slstring */
_pSLang_free_slstring(SLstr_Type * s)670 void _pSLang_free_slstring (SLstr_Type *s)
671 {
672 #if SLANG_OPTIMIZE_FOR_SPEED
673 Cached_String_Type *cs;
674 #endif
675 SLstring_Type *sls;
676
677 if (s == NULL) return;
678
679 #if SLANG_OPTIMIZE_FOR_SPEED
680 cs = GET_CACHED_STRING(s);
681 if (cs->str == s)
682 {
683 sls = cs->sls;
684 if (sls->ref_count <= 1)
685 {
686 #if SLANG_OPTIMIZE_FOR_SPEED
687 cs->sls = NULL;
688 cs->str = Deleted_String;
689 #endif
690 free_sls_string (sls);
691 }
692 else
693 sls->ref_count -= 1;
694 return;
695 }
696 #endif
697
698 if ((s[0] == 0) || (s[1] == 0))
699 return;
700
701 sls = (SLstring_Type *) (s - offsetof(SLstring_Type,bytes[0]));
702 if (sls->ref_count > 1)
703 {
704 sls->ref_count--;
705 return;
706 }
707 free_long_string (s, sls->hash);
708 }
709
710 /* An SLstring is required */
_pSLstring_get_hash(SLstr_Type * s)711 SLstr_Hash_Type _pSLstring_get_hash (SLstr_Type *s)
712 {
713 SLstring_Type *sls;
714
715 if (s[0] == 0)
716 return _pSLstring_hash ((unsigned char*)s, (unsigned char *)s);
717 if (s[1] == 0)
718 return _pSLstring_hash ((unsigned char *)s, (unsigned char *)s+1);
719
720 sls = (SLstring_Type *) (s - offsetof(SLstring_Type,bytes[0]));
721 return sls->hash;
722 }
723