sync up to latest jim tcl
[openocd.git] / src / helper / jim.c
1 /* Jim - A small embeddable Tcl interpreter
2 *
3 * Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
4 * Copyright 2005 Clemens Hintze <c.hintze@gmx.net>
5 * Copyright 2005 patthoyts - Pat Thoyts <patthoyts@users.sf.net>
6 * Copyright 2008 oharboe - √ėyvind Harboe - oyvind.harboe@zylin.com
7 * Copyright 2008 Andrew Lunn <andrew@lunn.ch>
8 * Copyright 2008 Duane Ellis <openocd@duaneellis.com>
9 * Copyright 2008 Uwe Klein <uklein@klein-messgeraete.de>
10 * Copyright 2008 Steve Bennett <steveb@workware.net.au>
11 *
12 * The FreeBSD license
13 *
14 * Redistribution and use in source and binary forms, with or without
15 * modification, are permitted provided that the following conditions
16 * are met:
17 *
18 * 1. Redistributions of source code must retain the above copyright
19 * notice, this list of conditions and the following disclaimer.
20 * 2. Redistributions in binary form must reproduce the above
21 * copyright notice, this list of conditions and the following
22 * disclaimer in the documentation and/or other materials
23 * provided with the distribution.
24 *
25 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
26 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
27 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
28 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
29 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
30 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
31 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
32 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
33 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
34 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
35 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
36 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
37 *
38 * The views and conclusions contained in the software and documentation
39 * are those of the authors and should not be interpreted as representing
40 * official policies, either expressed or implied, of the Jim Tcl Project.
41 **/
42 #define __JIM_CORE__
43 #define JIM_OPTIMIZATION /* comment to avoid optimizations and reduce size */
44
45 #ifdef __ECOS
46 #include <pkgconf/jimtcl.h>
47 #endif
48 #ifndef JIM_ANSIC
49 #define JIM_DYNLIB /* Dynamic library support for UNIX and WIN32 */
50 #endif /* JIM_ANSIC */
51
52 #include <stdio.h>
53 #include <stdlib.h>
54 #include <string.h>
55 #include <stdarg.h>
56 #include <ctype.h>
57 #include <limits.h>
58 #include <assert.h>
59 #include <errno.h>
60 #include <time.h>
61 #if defined(WIN32)
62 /* sys/time - need is different */
63 #else
64 #include <sys/time.h> // for gettimeofday()
65 #endif
66
67 #include "replacements.h"
68
69 /* Include the platform dependent libraries for
70 * dynamic loading of libraries. */
71 #ifdef JIM_DYNLIB
72 #if defined(_WIN32) || defined(WIN32)
73 #ifndef WIN32
74 #define WIN32 1
75 #endif
76 #ifndef STRICT
77 #define STRICT
78 #endif
79 #define WIN32_LEAN_AND_MEAN
80 #include <windows.h>
81 #if _MSC_VER >= 1000
82 #pragma warning(disable:4146)
83 #endif /* _MSC_VER */
84 #else
85 #include <dlfcn.h>
86 #endif /* WIN32 */
87 #endif /* JIM_DYNLIB */
88
89 #ifndef WIN32
90 #include <unistd.h>
91 #endif
92
93 #ifdef __ECOS
94 #include <cyg/jimtcl/jim.h>
95 #else
96 #include "jim.h"
97 #endif
98
99 #ifdef HAVE_BACKTRACE
100 #include <execinfo.h>
101 #endif
102
103 /* -----------------------------------------------------------------------------
104 * Global variables
105 * ---------------------------------------------------------------------------*/
106
107 /* A shared empty string for the objects string representation.
108 * Jim_InvalidateStringRep knows about it and don't try to free. */
109 static char *JimEmptyStringRep = (char*) "";
110
111 /* -----------------------------------------------------------------------------
112 * Required prototypes of not exported functions
113 * ---------------------------------------------------------------------------*/
114 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf);
115 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int flags);
116 static void JimRegisterCoreApi(Jim_Interp *interp);
117
118 static Jim_HashTableType JimVariablesHashTableType;
119
120 /* -----------------------------------------------------------------------------
121 * Utility functions
122 * ---------------------------------------------------------------------------*/
123
124 static char *
125 jim_vasprintf( const char *fmt, va_list ap )
126 {
127 #ifndef HAVE_VASPRINTF
128 /* yucky way */
129 static char buf[2048];
130 vsnprintf( buf, sizeof(buf), fmt, ap );
131 /* garentee termination */
132 buf[sizeof(buf)-1] = 0;
133 #else
134 char *buf;
135 vasprintf( &buf, fmt, ap );
136 #endif
137 return buf;
138 }
139
140 static void
141 jim_vasprintf_done( void *buf )
142 {
143 #ifndef HAVE_VASPRINTF
144 (void)(buf);
145 #else
146 free(buf);
147 #endif
148 }
149
150
151 /*
152 * Convert a string to a jim_wide INTEGER.
153 * This function originates from BSD.
154 *
155 * Ignores `locale' stuff. Assumes that the upper and lower case
156 * alphabets and digits are each contiguous.
157 */
158 #ifdef HAVE_LONG_LONG
159 #define JimIsAscii(c) (((c) & ~0x7f) == 0)
160 static jim_wide JimStrtoll(const char *nptr, char **endptr, register int base)
161 {
162 register const char *s;
163 register unsigned jim_wide acc;
164 register unsigned char c;
165 register unsigned jim_wide qbase, cutoff;
166 register int neg, any, cutlim;
167
168 /*
169 * Skip white space and pick up leading +/- sign if any.
170 * If base is 0, allow 0x for hex and 0 for octal, else
171 * assume decimal; if base is already 16, allow 0x.
172 */
173 s = nptr;
174 do {
175 c = *s++;
176 } while (isspace(c));
177 if (c == '-') {
178 neg = 1;
179 c = *s++;
180 } else {
181 neg = 0;
182 if (c == '+')
183 c = *s++;
184 }
185 if ((base == 0 || base == 16) &&
186 c == '0' && (*s == 'x' || *s == 'X')) {
187 c = s[1];
188 s += 2;
189 base = 16;
190 }
191 if (base == 0)
192 base = c == '0' ? 8 : 10;
193
194 /*
195 * Compute the cutoff value between legal numbers and illegal
196 * numbers. That is the largest legal value, divided by the
197 * base. An input number that is greater than this value, if
198 * followed by a legal input character, is too big. One that
199 * is equal to this value may be valid or not; the limit
200 * between valid and invalid numbers is then based on the last
201 * digit. For instance, if the range for quads is
202 * [-9223372036854775808..9223372036854775807] and the input base
203 * is 10, cutoff will be set to 922337203685477580 and cutlim to
204 * either 7 (neg==0) or 8 (neg==1), meaning that if we have
205 * accumulated a value > 922337203685477580, or equal but the
206 * next digit is > 7 (or 8), the number is too big, and we will
207 * return a range error.
208 *
209 * Set any if any `digits' consumed; make it negative to indicate
210 * overflow.
211 */
212 qbase = (unsigned)base;
213 cutoff = neg ? (unsigned jim_wide)-(LLONG_MIN + LLONG_MAX) + LLONG_MAX
214 : LLONG_MAX;
215 cutlim = (int)(cutoff % qbase);
216 cutoff /= qbase;
217 for (acc = 0, any = 0;; c = *s++) {
218 if (!JimIsAscii(c))
219 break;
220 if (isdigit(c))
221 c -= '0';
222 else if (isalpha(c))
223 c -= isupper(c) ? 'A' - 10 : 'a' - 10;
224 else
225 break;
226 if (c >= base)
227 break;
228 if (any < 0 || acc > cutoff || (acc == cutoff && c > cutlim))
229 any = -1;
230 else {
231 any = 1;
232 acc *= qbase;
233 acc += c;
234 }
235 }
236 if (any < 0) {
237 acc = neg ? LLONG_MIN : LLONG_MAX;
238 errno = ERANGE;
239 } else if (neg)
240 acc = -acc;
241 if (endptr != 0)
242 *endptr = (char *)(any ? s - 1 : nptr);
243 return (acc);
244 }
245 #endif
246
247 /* Glob-style pattern matching. */
248 static int JimStringMatch(const char *pattern, int patternLen,
249 const char *string, int stringLen, int nocase)
250 {
251 while(patternLen) {
252 switch(pattern[0]) {
253 case '*':
254 while (pattern[1] == '*') {
255 pattern++;
256 patternLen--;
257 }
258 if (patternLen == 1)
259 return 1; /* match */
260 while(stringLen) {
261 if (JimStringMatch(pattern+1, patternLen-1,
262 string, stringLen, nocase))
263 return 1; /* match */
264 string++;
265 stringLen--;
266 }
267 return 0; /* no match */
268 break;
269 case '?':
270 if (stringLen == 0)
271 return 0; /* no match */
272 string++;
273 stringLen--;
274 break;
275 case '[':
276 {
277 int not, match;
278
279 pattern++;
280 patternLen--;
281 not = pattern[0] == '^';
282 if (not) {
283 pattern++;
284 patternLen--;
285 }
286 match = 0;
287 while(1) {
288 if (pattern[0] == '\\') {
289 pattern++;
290 patternLen--;
291 if (pattern[0] == string[0])
292 match = 1;
293 } else if (pattern[0] == ']') {
294 break;
295 } else if (patternLen == 0) {
296 pattern--;
297 patternLen++;
298 break;
299 } else if (pattern[1] == '-' && patternLen >= 3) {
300 int start = pattern[0];
301 int end = pattern[2];
302 int c = string[0];
303 if (start > end) {
304 int t = start;
305 start = end;
306 end = t;
307 }
308 if (nocase) {
309 start = tolower(start);
310 end = tolower(end);
311 c = tolower(c);
312 }
313 pattern += 2;
314 patternLen -= 2;
315 if (c >= start && c <= end)
316 match = 1;
317 } else {
318 if (!nocase) {
319 if (pattern[0] == string[0])
320 match = 1;
321 } else {
322 if (tolower((int)pattern[0]) == tolower((int)string[0]))
323 match = 1;
324 }
325 }
326 pattern++;
327 patternLen--;
328 }
329 if (not)
330 match = !match;
331 if (!match)
332 return 0; /* no match */
333 string++;
334 stringLen--;
335 break;
336 }
337 case '\\':
338 if (patternLen >= 2) {
339 pattern++;
340 patternLen--;
341 }
342 /* fall through */
343 default:
344 if (!nocase) {
345 if (pattern[0] != string[0])
346 return 0; /* no match */
347 } else {
348 if (tolower((int)pattern[0]) != tolower((int)string[0]))
349 return 0; /* no match */
350 }
351 string++;
352 stringLen--;
353 break;
354 }
355 pattern++;
356 patternLen--;
357 if (stringLen == 0) {
358 while(*pattern == '*') {
359 pattern++;
360 patternLen--;
361 }
362 break;
363 }
364 }
365 if (patternLen == 0 && stringLen == 0)
366 return 1;
367 return 0;
368 }
369
370 int JimStringCompare(const char *s1, int l1, const char *s2, int l2,
371 int nocase)
372 {
373 unsigned char *u1 = (unsigned char*) s1, *u2 = (unsigned char*) s2;
374
375 if (nocase == 0) {
376 while(l1 && l2) {
377 if (*u1 != *u2)
378 return (int)*u1-*u2;
379 u1++; u2++; l1--; l2--;
380 }
381 if (!l1 && !l2) return 0;
382 return l1-l2;
383 } else {
384 while(l1 && l2) {
385 if (tolower((int)*u1) != tolower((int)*u2))
386 return tolower((int)*u1)-tolower((int)*u2);
387 u1++; u2++; l1--; l2--;
388 }
389 if (!l1 && !l2) return 0;
390 return l1-l2;
391 }
392 }
393
394 /* Search 's1' inside 's2', starting to search from char 'index' of 's2'.
395 * The index of the first occurrence of s1 in s2 is returned.
396 * If s1 is not found inside s2, -1 is returned. */
397 int JimStringFirst(const char *s1, int l1, const char *s2, int l2, int index)
398 {
399 int i;
400
401 if (!l1 || !l2 || l1 > l2) return -1;
402 if (index < 0) index = 0;
403 s2 += index;
404 for (i = index; i <= l2-l1; i++) {
405 if (memcmp(s2, s1, l1) == 0)
406 return i;
407 s2++;
408 }
409 return -1;
410 }
411
412 int Jim_WideToString(char *buf, jim_wide wideValue)
413 {
414 const char *fmt = "%" JIM_WIDE_MODIFIER;
415 return sprintf(buf, fmt, wideValue);
416 }
417
418 int Jim_StringToWide(const char *str, jim_wide *widePtr, int base)
419 {
420 char *endptr;
421
422 #ifdef HAVE_LONG_LONG
423 *widePtr = JimStrtoll(str, &endptr, base);
424 #else
425 *widePtr = strtol(str, &endptr, base);
426 #endif
427 if ((str[0] == '\0') || (str == endptr) )
428 return JIM_ERR;
429 if (endptr[0] != '\0') {
430 while(*endptr) {
431 if (!isspace((int)*endptr))
432 return JIM_ERR;
433 endptr++;
434 }
435 }
436 return JIM_OK;
437 }
438
439 int Jim_StringToIndex(const char *str, int *intPtr)
440 {
441 char *endptr;
442
443 *intPtr = strtol(str, &endptr, 10);
444 if ( (str[0] == '\0') || (str == endptr) )
445 return JIM_ERR;
446 if (endptr[0] != '\0') {
447 while(*endptr) {
448 if (!isspace((int)*endptr))
449 return JIM_ERR;
450 endptr++;
451 }
452 }
453 return JIM_OK;
454 }
455
456 /* The string representation of references has two features in order
457 * to make the GC faster. The first is that every reference starts
458 * with a non common character '~', in order to make the string matching
459 * fater. The second is that the reference string rep his 32 characters
460 * in length, this allows to avoid to check every object with a string
461 * repr < 32, and usually there are many of this objects. */
462
463 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
464
465 static int JimFormatReference(char *buf, Jim_Reference *refPtr, jim_wide id)
466 {
467 const char *fmt = "<reference.<%s>.%020" JIM_WIDE_MODIFIER ">";
468 sprintf(buf, fmt, refPtr->tag, id);
469 return JIM_REFERENCE_SPACE;
470 }
471
472 int Jim_DoubleToString(char *buf, double doubleValue)
473 {
474 char *s;
475 int len;
476
477 len = sprintf(buf, "%.17g", doubleValue);
478 s = buf;
479 while(*s) {
480 if (*s == '.') return len;
481 s++;
482 }
483 /* Add a final ".0" if it's a number. But not
484 * for NaN or InF */
485 if (isdigit((int)buf[0])
486 || ((buf[0] == '-' || buf[0] == '+')
487 && isdigit((int)buf[1]))) {
488 s[0] = '.';
489 s[1] = '0';
490 s[2] = '\0';
491 return len+2;
492 }
493 return len;
494 }
495
496 int Jim_StringToDouble(const char *str, double *doublePtr)
497 {
498 char *endptr;
499
500 *doublePtr = strtod(str, &endptr);
501 if (str[0] == '\0' || endptr[0] != '\0' || (str == endptr) )
502 return JIM_ERR;
503 return JIM_OK;
504 }
505
506 static jim_wide JimPowWide(jim_wide b, jim_wide e)
507 {
508 jim_wide i, res = 1;
509 if ((b==0 && e!=0) || (e<0)) return 0;
510 for(i=0; i<e; i++) {res *= b;}
511 return res;
512 }
513
514 /* -----------------------------------------------------------------------------
515 * Special functions
516 * ---------------------------------------------------------------------------*/
517
518 /* Note that 'interp' may be NULL if not available in the
519 * context of the panic. It's only useful to get the error
520 * file descriptor, it will default to stderr otherwise. */
521 void Jim_Panic(Jim_Interp *interp, const char *fmt, ...)
522 {
523 va_list ap;
524
525 va_start(ap, fmt);
526 /*
527 * Send it here first.. Assuming STDIO still works
528 */
529 fprintf(stderr, JIM_NL "JIM INTERPRETER PANIC: ");
530 vfprintf(stderr, fmt, ap);
531 fprintf(stderr, JIM_NL JIM_NL);
532 va_end(ap);
533
534 #ifdef HAVE_BACKTRACE
535 {
536 void *array[40];
537 int size, i;
538 char **strings;
539
540 size = backtrace(array, 40);
541 strings = backtrace_symbols(array, size);
542 for (i = 0; i < size; i++)
543 fprintf(fp,"[backtrace] %s" JIM_NL, strings[i]);
544 fprintf(fp,"[backtrace] Include the above lines and the output" JIM_NL);
545 fprintf(fp,"[backtrace] of 'nm <executable>' in the bug report." JIM_NL);
546 }
547 #endif
548
549 /* This may actually crash... we do it last */
550 if( interp && interp->cookie_stderr ){
551 Jim_fprintf( interp, interp->cookie_stderr, JIM_NL "JIM INTERPRETER PANIC: ");
552 Jim_vfprintf( interp, interp->cookie_stderr, fmt, ap );
553 Jim_fprintf( interp, interp->cookie_stderr, JIM_NL JIM_NL );
554 }
555 abort();
556 }
557
558 /* -----------------------------------------------------------------------------
559 * Memory allocation
560 * ---------------------------------------------------------------------------*/
561
562 /* Macro used for memory debugging.
563 * In order for they to work you have to rename Jim_Alloc into _Jim_Alloc
564 * and similary for Jim_Realloc and Jim_Free */
565 #if 0
566 #define Jim_Alloc(s) (printf("%s %d: Jim_Alloc(%d)\n",__FILE__,__LINE__,s),_Jim_Alloc(s))
567 #define Jim_Free(p) (printf("%s %d: Jim_Free(%p)\n",__FILE__,__LINE__,p),_Jim_Free(p))
568 #define Jim_Realloc(p,s) (printf("%s %d: Jim_Realloc(%p,%d)\n",__FILE__,__LINE__,p,s),_Jim_Realloc(p,s))
569 #endif
570
571 void *Jim_Alloc(int size)
572 {
573 /* We allocate zero length arrayes, etc. to use a single orthogonal codepath */
574 if (size==0)
575 size=1;
576 void *p = malloc(size);
577 if (p == NULL)
578 Jim_Panic(NULL,"malloc: Out of memory");
579 return p;
580 }
581
582 void Jim_Free(void *ptr) {
583 free(ptr);
584 }
585
586 void *Jim_Realloc(void *ptr, int size)
587 {
588 /* We allocate zero length arrayes, etc. to use a single orthogonal codepath */
589 if (size==0)
590 size=1;
591 void *p = realloc(ptr, size);
592 if (p == NULL)
593 Jim_Panic(NULL,"realloc: Out of memory");
594 return p;
595 }
596
597 char *Jim_StrDup(const char *s)
598 {
599 int l = strlen(s);
600 char *copy = Jim_Alloc(l+1);
601
602 memcpy(copy, s, l+1);
603 return copy;
604 }
605
606 char *Jim_StrDupLen(const char *s, int l)
607 {
608 char *copy = Jim_Alloc(l+1);
609
610 memcpy(copy, s, l+1);
611 copy[l] = 0; /* Just to be sure, original could be substring */
612 return copy;
613 }
614
615 /* -----------------------------------------------------------------------------
616 * Time related functions
617 * ---------------------------------------------------------------------------*/
618 /* Returns microseconds of CPU used since start. */
619 static jim_wide JimClock(void)
620 {
621 #if (defined WIN32) && !(defined JIM_ANSIC)
622 LARGE_INTEGER t, f;
623 QueryPerformanceFrequency(&f);
624 QueryPerformanceCounter(&t);
625 return (long)((t.QuadPart * 1000000) / f.QuadPart);
626 #else /* !WIN32 */
627 clock_t clocks = clock();
628
629 return (long)(clocks*(1000000/CLOCKS_PER_SEC));
630 #endif /* WIN32 */
631 }
632
633 /* -----------------------------------------------------------------------------
634 * Hash Tables
635 * ---------------------------------------------------------------------------*/
636
637 /* -------------------------- private prototypes ---------------------------- */
638 static int JimExpandHashTableIfNeeded(Jim_HashTable *ht);
639 static unsigned int JimHashTableNextPower(unsigned int size);
640 static int JimInsertHashEntry(Jim_HashTable *ht, const void *key);
641
642 /* -------------------------- hash functions -------------------------------- */
643
644 /* Thomas Wang's 32 bit Mix Function */
645 unsigned int Jim_IntHashFunction(unsigned int key)
646 {
647 key += ~(key << 15);
648 key ^= (key >> 10);
649 key += (key << 3);
650 key ^= (key >> 6);
651 key += ~(key << 11);
652 key ^= (key >> 16);
653 return key;
654 }
655
656 /* Identity hash function for integer keys */
657 unsigned int Jim_IdentityHashFunction(unsigned int key)
658 {
659 return key;
660 }
661
662 /* Generic hash function (we are using to multiply by 9 and add the byte
663 * as Tcl) */
664 unsigned int Jim_GenHashFunction(const unsigned char *buf, int len)
665 {
666 unsigned int h = 0;
667 while(len--)
668 h += (h<<3)+*buf++;
669 return h;
670 }
671
672 /* ----------------------------- API implementation ------------------------- */
673 /* reset an hashtable already initialized with ht_init().
674 * NOTE: This function should only called by ht_destroy(). */
675 static void JimResetHashTable(Jim_HashTable *ht)
676 {
677 ht->table = NULL;
678 ht->size = 0;
679 ht->sizemask = 0;
680 ht->used = 0;
681 ht->collisions = 0;
682 }
683
684 /* Initialize the hash table */
685 int Jim_InitHashTable(Jim_HashTable *ht, Jim_HashTableType *type,
686 void *privDataPtr)
687 {
688 JimResetHashTable(ht);
689 ht->type = type;
690 ht->privdata = privDataPtr;
691 return JIM_OK;
692 }
693
694 /* Resize the table to the minimal size that contains all the elements,
695 * but with the invariant of a USER/BUCKETS ration near to <= 1 */
696 int Jim_ResizeHashTable(Jim_HashTable *ht)
697 {
698 int minimal = ht->used;
699
700 if (minimal < JIM_HT_INITIAL_SIZE)
701 minimal = JIM_HT_INITIAL_SIZE;
702 return Jim_ExpandHashTable(ht, minimal);
703 }
704
705 /* Expand or create the hashtable */
706 int Jim_ExpandHashTable(Jim_HashTable *ht, unsigned int size)
707 {
708 Jim_HashTable n; /* the new hashtable */
709 unsigned int realsize = JimHashTableNextPower(size), i;
710
711 /* the size is invalid if it is smaller than the number of
712 * elements already inside the hashtable */
713 if (ht->used >= size)
714 return JIM_ERR;
715
716 Jim_InitHashTable(&n, ht->type, ht->privdata);
717 n.size = realsize;
718 n.sizemask = realsize-1;
719 n.table = Jim_Alloc(realsize*sizeof(Jim_HashEntry*));
720
721 /* Initialize all the pointers to NULL */
722 memset(n.table, 0, realsize*sizeof(Jim_HashEntry*));
723
724 /* Copy all the elements from the old to the new table:
725 * note that if the old hash table is empty ht->size is zero,
726 * so Jim_ExpandHashTable just creates an hash table. */
727 n.used = ht->used;
728 for (i = 0; i < ht->size && ht->used > 0; i++) {
729 Jim_HashEntry *he, *nextHe;
730
731 if (ht->table[i] == NULL) continue;
732
733 /* For each hash entry on this slot... */
734 he = ht->table[i];
735 while(he) {
736 unsigned int h;
737
738 nextHe = he->next;
739 /* Get the new element index */
740 h = Jim_HashKey(ht, he->key) & n.sizemask;
741 he->next = n.table[h];
742 n.table[h] = he;
743 ht->used--;
744 /* Pass to the next element */
745 he = nextHe;
746 }
747 }
748 assert(ht->used == 0);
749 Jim_Free(ht->table);
750
751 /* Remap the new hashtable in the old */
752 *ht = n;
753 return JIM_OK;
754 }
755
756 /* Add an element to the target hash table */
757 int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val)
758 {
759 int index;
760 Jim_HashEntry *entry;
761
762 /* Get the index of the new element, or -1 if
763 * the element already exists. */
764 if ((index = JimInsertHashEntry(ht, key)) == -1)
765 return JIM_ERR;
766
767 /* Allocates the memory and stores key */
768 entry = Jim_Alloc(sizeof(*entry));
769 entry->next = ht->table[index];
770 ht->table[index] = entry;
771
772 /* Set the hash entry fields. */
773 Jim_SetHashKey(ht, entry, key);
774 Jim_SetHashVal(ht, entry, val);
775 ht->used++;
776 return JIM_OK;
777 }
778
779 /* Add an element, discarding the old if the key already exists */
780 int Jim_ReplaceHashEntry(Jim_HashTable *ht, const void *key, void *val)
781 {
782 Jim_HashEntry *entry;
783
784 /* Try to add the element. If the key
785 * does not exists Jim_AddHashEntry will suceed. */
786 if (Jim_AddHashEntry(ht, key, val) == JIM_OK)
787 return JIM_OK;
788 /* It already exists, get the entry */
789 entry = Jim_FindHashEntry(ht, key);
790 /* Free the old value and set the new one */
791 Jim_FreeEntryVal(ht, entry);
792 Jim_SetHashVal(ht, entry, val);
793 return JIM_OK;
794 }
795
796 /* Search and remove an element */
797 int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key)
798 {
799 unsigned int h;
800 Jim_HashEntry *he, *prevHe;
801
802 if (ht->size == 0)
803 return JIM_ERR;
804 h = Jim_HashKey(ht, key) & ht->sizemask;
805 he = ht->table[h];
806
807 prevHe = NULL;
808 while(he) {
809 if (Jim_CompareHashKeys(ht, key, he->key)) {
810 /* Unlink the element from the list */
811 if (prevHe)
812 prevHe->next = he->next;
813 else
814 ht->table[h] = he->next;
815 Jim_FreeEntryKey(ht, he);
816 Jim_FreeEntryVal(ht, he);
817 Jim_Free(he);
818 ht->used--;
819 return JIM_OK;
820 }
821 prevHe = he;
822 he = he->next;
823 }
824 return JIM_ERR; /* not found */
825 }
826
827 /* Destroy an entire hash table */
828 int Jim_FreeHashTable(Jim_HashTable *ht)
829 {
830 unsigned int i;
831
832 /* Free all the elements */
833 for (i = 0; i < ht->size && ht->used > 0; i++) {
834 Jim_HashEntry *he, *nextHe;
835
836 if ((he = ht->table[i]) == NULL) continue;
837 while(he) {
838 nextHe = he->next;
839 Jim_FreeEntryKey(ht, he);
840 Jim_FreeEntryVal(ht, he);
841 Jim_Free(he);
842 ht->used--;
843 he = nextHe;
844 }
845 }
846 /* Free the table and the allocated cache structure */
847 Jim_Free(ht->table);
848 /* Re-initialize the table */
849 JimResetHashTable(ht);
850 return JIM_OK; /* never fails */
851 }
852
853 Jim_HashEntry *Jim_FindHashEntry(Jim_HashTable *ht, const void *key)
854 {
855 Jim_HashEntry *he;
856 unsigned int h;
857
858 if (ht->size == 0) return NULL;
859 h = Jim_HashKey(ht, key) & ht->sizemask;
860 he = ht->table[h];
861 while(he) {
862 if (Jim_CompareHashKeys(ht, key, he->key))
863 return he;
864 he = he->next;
865 }
866 return NULL;
867 }
868
869 Jim_HashTableIterator *Jim_GetHashTableIterator(Jim_HashTable *ht)
870 {
871 Jim_HashTableIterator *iter = Jim_Alloc(sizeof(*iter));
872
873 iter->ht = ht;
874 iter->index = -1;
875 iter->entry = NULL;
876 iter->nextEntry = NULL;
877 return iter;
878 }
879
880 Jim_HashEntry *Jim_NextHashEntry(Jim_HashTableIterator *iter)
881 {
882 while (1) {
883 if (iter->entry == NULL) {
884 iter->index++;
885 if (iter->index >=
886 (signed)iter->ht->size) break;
887 iter->entry = iter->ht->table[iter->index];
888 } else {
889 iter->entry = iter->nextEntry;
890 }
891 if (iter->entry) {
892 /* We need to save the 'next' here, the iterator user
893 * may delete the entry we are returning. */
894 iter->nextEntry = iter->entry->next;
895 return iter->entry;
896 }
897 }
898 return NULL;
899 }
900
901 /* ------------------------- private functions ------------------------------ */
902
903 /* Expand the hash table if needed */
904 static int JimExpandHashTableIfNeeded(Jim_HashTable *ht)
905 {
906 /* If the hash table is empty expand it to the intial size,
907 * if the table is "full" dobule its size. */
908 if (ht->size == 0)
909 return Jim_ExpandHashTable(ht, JIM_HT_INITIAL_SIZE);
910 if (ht->size == ht->used)
911 return Jim_ExpandHashTable(ht, ht->size*2);
912 return JIM_OK;
913 }
914
915 /* Our hash table capability is a power of two */
916 static unsigned int JimHashTableNextPower(unsigned int size)
917 {
918 unsigned int i = JIM_HT_INITIAL_SIZE;
919
920 if (size >= 2147483648U)
921 return 2147483648U;
922 while(1) {
923 if (i >= size)
924 return i;
925 i *= 2;
926 }
927 }
928
929 /* Returns the index of a free slot that can be populated with
930 * an hash entry for the given 'key'.
931 * If the key already exists, -1 is returned. */
932 static int JimInsertHashEntry(Jim_HashTable *ht, const void *key)
933 {
934 unsigned int h;
935 Jim_HashEntry *he;
936
937 /* Expand the hashtable if needed */
938 if (JimExpandHashTableIfNeeded(ht) == JIM_ERR)
939 return -1;
940 /* Compute the key hash value */
941 h = Jim_HashKey(ht, key) & ht->sizemask;
942 /* Search if this slot does not already contain the given key */
943 he = ht->table[h];
944 while(he) {
945 if (Jim_CompareHashKeys(ht, key, he->key))
946 return -1;
947 he = he->next;
948 }
949 return h;
950 }
951
952 /* ----------------------- StringCopy Hash Table Type ------------------------*/
953
954 static unsigned int JimStringCopyHTHashFunction(const void *key)
955 {
956 return Jim_GenHashFunction(key, strlen(key));
957 }
958
959 static const void *JimStringCopyHTKeyDup(void *privdata, const void *key)
960 {
961 int len = strlen(key);
962 char *copy = Jim_Alloc(len+1);
963 JIM_NOTUSED(privdata);
964
965 memcpy(copy, key, len);
966 copy[len] = '\0';
967 return copy;
968 }
969
970 static void *JimStringKeyValCopyHTValDup(void *privdata, const void *val)
971 {
972 int len = strlen(val);
973 char *copy = Jim_Alloc(len+1);
974 JIM_NOTUSED(privdata);
975
976 memcpy(copy, val, len);
977 copy[len] = '\0';
978 return copy;
979 }
980
981 static int JimStringCopyHTKeyCompare(void *privdata, const void *key1,
982 const void *key2)
983 {
984 JIM_NOTUSED(privdata);
985
986 return strcmp(key1, key2) == 0;
987 }
988
989 static void JimStringCopyHTKeyDestructor(void *privdata, const void *key)
990 {
991 JIM_NOTUSED(privdata);
992
993 Jim_Free((void*)key); /* ATTENTION: const cast */
994 }
995
996 static void JimStringKeyValCopyHTValDestructor(void *privdata, void *val)
997 {
998 JIM_NOTUSED(privdata);
999
1000 Jim_Free((void*)val); /* ATTENTION: const cast */
1001 }
1002
1003 static Jim_HashTableType JimStringCopyHashTableType = {
1004 JimStringCopyHTHashFunction, /* hash function */
1005 JimStringCopyHTKeyDup, /* key dup */
1006 NULL, /* val dup */
1007 JimStringCopyHTKeyCompare, /* key compare */
1008 JimStringCopyHTKeyDestructor, /* key destructor */
1009 NULL /* val destructor */
1010 };
1011
1012 /* This is like StringCopy but does not auto-duplicate the key.
1013 * It's used for intepreter's shared strings. */
1014 static Jim_HashTableType JimSharedStringsHashTableType = {
1015 JimStringCopyHTHashFunction, /* hash function */
1016 NULL, /* key dup */
1017 NULL, /* val dup */
1018 JimStringCopyHTKeyCompare, /* key compare */
1019 JimStringCopyHTKeyDestructor, /* key destructor */
1020 NULL /* val destructor */
1021 };
1022
1023 /* This is like StringCopy but also automatically handle dynamic
1024 * allocated C strings as values. */
1025 static Jim_HashTableType JimStringKeyValCopyHashTableType = {
1026 JimStringCopyHTHashFunction, /* hash function */
1027 JimStringCopyHTKeyDup, /* key dup */
1028 JimStringKeyValCopyHTValDup, /* val dup */
1029 JimStringCopyHTKeyCompare, /* key compare */
1030 JimStringCopyHTKeyDestructor, /* key destructor */
1031 JimStringKeyValCopyHTValDestructor, /* val destructor */
1032 };
1033
1034 typedef struct AssocDataValue {
1035 Jim_InterpDeleteProc *delProc;
1036 void *data;
1037 } AssocDataValue;
1038
1039 static void JimAssocDataHashTableValueDestructor(void *privdata, void *data)
1040 {
1041 AssocDataValue *assocPtr = (AssocDataValue *)data;
1042 if (assocPtr->delProc != NULL)
1043 assocPtr->delProc((Jim_Interp *)privdata, assocPtr->data);
1044 Jim_Free(data);
1045 }
1046
1047 static Jim_HashTableType JimAssocDataHashTableType = {
1048 JimStringCopyHTHashFunction, /* hash function */
1049 JimStringCopyHTKeyDup, /* key dup */
1050 NULL, /* val dup */
1051 JimStringCopyHTKeyCompare, /* key compare */
1052 JimStringCopyHTKeyDestructor, /* key destructor */
1053 JimAssocDataHashTableValueDestructor /* val destructor */
1054 };
1055
1056 /* -----------------------------------------------------------------------------
1057 * Stack - This is a simple generic stack implementation. It is used for
1058 * example in the 'expr' expression compiler.
1059 * ---------------------------------------------------------------------------*/
1060 void Jim_InitStack(Jim_Stack *stack)
1061 {
1062 stack->len = 0;
1063 stack->maxlen = 0;
1064 stack->vector = NULL;
1065 }
1066
1067 void Jim_FreeStack(Jim_Stack *stack)
1068 {
1069 Jim_Free(stack->vector);
1070 }
1071
1072 int Jim_StackLen(Jim_Stack *stack)
1073 {
1074 return stack->len;
1075 }
1076
1077 void Jim_StackPush(Jim_Stack *stack, void *element) {
1078 int neededLen = stack->len+1;
1079 if (neededLen > stack->maxlen) {
1080 stack->maxlen = neededLen*2;
1081 stack->vector = Jim_Realloc(stack->vector, sizeof(void*)*stack->maxlen);
1082 }
1083 stack->vector[stack->len] = element;
1084 stack->len++;
1085 }
1086
1087 void *Jim_StackPop(Jim_Stack *stack)
1088 {
1089 if (stack->len == 0) return NULL;
1090 stack->len--;
1091 return stack->vector[stack->len];
1092 }
1093
1094 void *Jim_StackPeek(Jim_Stack *stack)
1095 {
1096 if (stack->len == 0) return NULL;
1097 return stack->vector[stack->len-1];
1098 }
1099
1100 void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc)(void *ptr))
1101 {
1102 int i;
1103
1104 for (i = 0; i < stack->len; i++)
1105 freeFunc(stack->vector[i]);
1106 }
1107
1108 /* -----------------------------------------------------------------------------
1109 * Parser
1110 * ---------------------------------------------------------------------------*/
1111
1112 /* Token types */
1113 #define JIM_TT_NONE -1 /* No token returned */
1114 #define JIM_TT_STR 0 /* simple string */
1115 #define JIM_TT_ESC 1 /* string that needs escape chars conversion */
1116 #define JIM_TT_VAR 2 /* var substitution */
1117 #define JIM_TT_DICTSUGAR 3 /* Syntax sugar for [dict get], $foo(bar) */
1118 #define JIM_TT_CMD 4 /* command substitution */
1119 #define JIM_TT_SEP 5 /* word separator */
1120 #define JIM_TT_EOL 6 /* line separator */
1121
1122 /* Additional token types needed for expressions */
1123 #define JIM_TT_SUBEXPR_START 7
1124 #define JIM_TT_SUBEXPR_END 8
1125 #define JIM_TT_EXPR_NUMBER 9
1126 #define JIM_TT_EXPR_OPERATOR 10
1127
1128 /* Parser states */
1129 #define JIM_PS_DEF 0 /* Default state */
1130 #define JIM_PS_QUOTE 1 /* Inside "" */
1131
1132 /* Parser context structure. The same context is used both to parse
1133 * Tcl scripts and lists. */
1134 struct JimParserCtx {
1135 const char *prg; /* Program text */
1136 const char *p; /* Pointer to the point of the program we are parsing */
1137 int len; /* Left length of 'prg' */
1138 int linenr; /* Current line number */
1139 const char *tstart;
1140 const char *tend; /* Returned token is at tstart-tend in 'prg'. */
1141 int tline; /* Line number of the returned token */
1142 int tt; /* Token type */
1143 int eof; /* Non zero if EOF condition is true. */
1144 int state; /* Parser state */
1145 int comment; /* Non zero if the next chars may be a comment. */
1146 };
1147
1148 #define JimParserEof(c) ((c)->eof)
1149 #define JimParserTstart(c) ((c)->tstart)
1150 #define JimParserTend(c) ((c)->tend)
1151 #define JimParserTtype(c) ((c)->tt)
1152 #define JimParserTline(c) ((c)->tline)
1153
1154 static int JimParseScript(struct JimParserCtx *pc);
1155 static int JimParseSep(struct JimParserCtx *pc);
1156 static int JimParseEol(struct JimParserCtx *pc);
1157 static int JimParseCmd(struct JimParserCtx *pc);
1158 static int JimParseVar(struct JimParserCtx *pc);
1159 static int JimParseBrace(struct JimParserCtx *pc);
1160 static int JimParseStr(struct JimParserCtx *pc);
1161 static int JimParseComment(struct JimParserCtx *pc);
1162 static char *JimParserGetToken(struct JimParserCtx *pc,
1163 int *lenPtr, int *typePtr, int *linePtr);
1164
1165 /* Initialize a parser context.
1166 * 'prg' is a pointer to the program text, linenr is the line
1167 * number of the first line contained in the program. */
1168 void JimParserInit(struct JimParserCtx *pc, const char *prg,
1169 int len, int linenr)
1170 {
1171 pc->prg = prg;
1172 pc->p = prg;
1173 pc->len = len;
1174 pc->tstart = NULL;
1175 pc->tend = NULL;
1176 pc->tline = 0;
1177 pc->tt = JIM_TT_NONE;
1178 pc->eof = 0;
1179 pc->state = JIM_PS_DEF;
1180 pc->linenr = linenr;
1181 pc->comment = 1;
1182 }
1183
1184 int JimParseScript(struct JimParserCtx *pc)
1185 {
1186 while(1) { /* the while is used to reiterate with continue if needed */
1187 if (!pc->len) {
1188 pc->tstart = pc->p;
1189 pc->tend = pc->p-1;
1190 pc->tline = pc->linenr;
1191 pc->tt = JIM_TT_EOL;
1192 pc->eof = 1;
1193 return JIM_OK;
1194 }
1195 switch(*(pc->p)) {
1196 case '\\':
1197 if (*(pc->p+1) == '\n')
1198 return JimParseSep(pc);
1199 else {
1200 pc->comment = 0;
1201 return JimParseStr(pc);
1202 }
1203 break;
1204 case ' ':
1205 case '\t':
1206 case '\r':
1207 if (pc->state == JIM_PS_DEF)
1208 return JimParseSep(pc);
1209 else {
1210 pc->comment = 0;
1211 return JimParseStr(pc);
1212 }
1213 break;
1214 case '\n':
1215 case ';':
1216 pc->comment = 1;
1217 if (pc->state == JIM_PS_DEF)
1218 return JimParseEol(pc);
1219 else
1220 return JimParseStr(pc);
1221 break;
1222 case '[':
1223 pc->comment = 0;
1224 return JimParseCmd(pc);
1225 break;
1226 case '$':
1227 pc->comment = 0;
1228 if (JimParseVar(pc) == JIM_ERR) {
1229 pc->tstart = pc->tend = pc->p++; pc->len--;
1230 pc->tline = pc->linenr;
1231 pc->tt = JIM_TT_STR;
1232 return JIM_OK;
1233 } else
1234 return JIM_OK;
1235 break;
1236 case '#':
1237 if (pc->comment) {
1238 JimParseComment(pc);
1239 continue;
1240 } else {
1241 return JimParseStr(pc);
1242 }
1243 default:
1244 pc->comment = 0;
1245 return JimParseStr(pc);
1246 break;
1247 }
1248 return JIM_OK;
1249 }
1250 }
1251
1252 int JimParseSep(struct JimParserCtx *pc)
1253 {
1254 pc->tstart = pc->p;
1255 pc->tline = pc->linenr;
1256 while (*pc->p == ' ' || *pc->p == '\t' || *pc->p == '\r' ||
1257 (*pc->p == '\\' && *(pc->p+1) == '\n')) {
1258 if (*pc->p == '\\') {
1259 pc->p++; pc->len--;
1260 pc->linenr++;
1261 }
1262 pc->p++; pc->len--;
1263 }
1264 pc->tend = pc->p-1;
1265 pc->tt = JIM_TT_SEP;
1266 return JIM_OK;
1267 }
1268
1269 int JimParseEol(struct JimParserCtx *pc)
1270 {
1271 pc->tstart = pc->p;
1272 pc->tline = pc->linenr;
1273 while (*pc->p == ' ' || *pc->p == '\n' ||
1274 *pc->p == '\t' || *pc->p == '\r' || *pc->p == ';') {
1275 if (*pc->p == '\n')
1276 pc->linenr++;
1277 pc->p++; pc->len--;
1278 }
1279 pc->tend = pc->p-1;
1280 pc->tt = JIM_TT_EOL;
1281 return JIM_OK;
1282 }
1283
1284 /* Todo. Don't stop if ']' appears inside {} or quoted.
1285 * Also should handle the case of puts [string length "]"] */
1286 int JimParseCmd(struct JimParserCtx *pc)
1287 {
1288 int level = 1;
1289 int blevel = 0;
1290
1291 pc->tstart = ++pc->p; pc->len--;
1292 pc->tline = pc->linenr;
1293 while (1) {
1294 if (pc->len == 0) {
1295 break;
1296 } else if (*pc->p == '[' && blevel == 0) {
1297 level++;
1298 } else if (*pc->p == ']' && blevel == 0) {
1299 level--;
1300 if (!level) break;
1301 } else if (*pc->p == '\\') {
1302 pc->p++; pc->len--;
1303 } else if (*pc->p == '{') {
1304 blevel++;
1305 } else if (*pc->p == '}') {
1306 if (blevel != 0)
1307 blevel--;
1308 } else if (*pc->p == '\n')
1309 pc->linenr++;
1310 pc->p++; pc->len--;
1311 }
1312 pc->tend = pc->p-1;
1313 pc->tt = JIM_TT_CMD;
1314 if (*pc->p == ']') {
1315 pc->p++; pc->len--;
1316 }
1317 return JIM_OK;
1318 }
1319
1320 int JimParseVar(struct JimParserCtx *pc)
1321 {
1322 int brace = 0, stop = 0, ttype = JIM_TT_VAR;
1323
1324 pc->tstart = ++pc->p; pc->len--; /* skip the $ */
1325 pc->tline = pc->linenr;
1326 if (*pc->p == '{') {
1327 pc->tstart = ++pc->p; pc->len--;
1328 brace = 1;
1329 }
1330 if (brace) {
1331 while (!stop) {
1332 if (*pc->p == '}' || pc->len == 0) {
1333 pc->tend = pc->p-1;
1334 stop = 1;
1335 if (pc->len == 0)
1336 break;
1337 }
1338 else if (*pc->p == '\n')
1339 pc->linenr++;
1340 pc->p++; pc->len--;
1341 }
1342 } else {
1343 /* Include leading colons */
1344 while (*pc->p == ':') {
1345 pc->p++;
1346 pc->len--;
1347 }
1348 while (!stop) {
1349 if (!((*pc->p >= 'a' && *pc->p <= 'z') ||
1350 (*pc->p >= 'A' && *pc->p <= 'Z') ||
1351 (*pc->p >= '0' && *pc->p <= '9') || *pc->p == '_'))
1352 stop = 1;
1353 else {
1354 pc->p++; pc->len--;
1355 }
1356 }
1357 /* Parse [dict get] syntax sugar. */
1358 if (*pc->p == '(') {
1359 while (*pc->p != ')' && pc->len) {
1360 pc->p++; pc->len--;
1361 if (*pc->p == '\\' && pc->len >= 2) {
1362 pc->p += 2; pc->len -= 2;
1363 }
1364 }
1365 if (*pc->p != '\0') {
1366 pc->p++; pc->len--;
1367 }
1368 ttype = JIM_TT_DICTSUGAR;
1369 }
1370 pc->tend = pc->p-1;
1371 }
1372 /* Check if we parsed just the '$' character.
1373 * That's not a variable so an error is returned
1374 * to tell the state machine to consider this '$' just
1375 * a string. */
1376 if (pc->tstart == pc->p) {
1377 pc->p--; pc->len++;
1378 return JIM_ERR;
1379 }
1380 pc->tt = ttype;
1381 return JIM_OK;
1382 }
1383
1384 int JimParseBrace(struct JimParserCtx *pc)
1385 {
1386 int level = 1;
1387
1388 pc->tstart = ++pc->p; pc->len--;
1389 pc->tline = pc->linenr;
1390 while (1) {
1391 if (*pc->p == '\\' && pc->len >= 2) {
1392 pc->p++; pc->len--;
1393 if (*pc->p == '\n')
1394 pc->linenr++;
1395 } else if (*pc->p == '{') {
1396 level++;
1397 } else if (pc->len == 0 || *pc->p == '}') {
1398 level--;
1399 if (pc->len == 0 || level == 0) {
1400 pc->tend = pc->p-1;
1401 if (pc->len != 0) {
1402 pc->p++; pc->len--;
1403 }
1404 pc->tt = JIM_TT_STR;
1405 return JIM_OK;
1406 }
1407 } else if (*pc->p == '\n') {
1408 pc->linenr++;
1409 }
1410 pc->p++; pc->len--;
1411 }
1412 return JIM_OK; /* unreached */
1413 }
1414
1415 int JimParseStr(struct JimParserCtx *pc)
1416 {
1417 int newword = (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1418 pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR);
1419 if (newword && *pc->p == '{') {
1420 return JimParseBrace(pc);
1421 } else if (newword && *pc->p == '"') {
1422 pc->state = JIM_PS_QUOTE;
1423 pc->p++; pc->len--;
1424 }
1425 pc->tstart = pc->p;
1426 pc->tline = pc->linenr;
1427 while (1) {
1428 if (pc->len == 0) {
1429 pc->tend = pc->p-1;
1430 pc->tt = JIM_TT_ESC;
1431 return JIM_OK;
1432 }
1433 switch(*pc->p) {
1434 case '\\':
1435 if (pc->state == JIM_PS_DEF &&
1436 *(pc->p+1) == '\n') {
1437 pc->tend = pc->p-1;
1438 pc->tt = JIM_TT_ESC;
1439 return JIM_OK;
1440 }
1441 if (pc->len >= 2) {
1442 pc->p++; pc->len--;
1443 }
1444 break;
1445 case '$':
1446 case '[':
1447 pc->tend = pc->p-1;
1448 pc->tt = JIM_TT_ESC;
1449 return JIM_OK;
1450 case ' ':
1451 case '\t':
1452 case '\n':
1453 case '\r':
1454 case ';':
1455 if (pc->state == JIM_PS_DEF) {
1456 pc->tend = pc->p-1;
1457 pc->tt = JIM_TT_ESC;
1458 return JIM_OK;
1459 } else if (*pc->p == '\n') {
1460 pc->linenr++;
1461 }
1462 break;
1463 case '"':
1464 if (pc->state == JIM_PS_QUOTE) {
1465 pc->tend = pc->p-1;
1466 pc->tt = JIM_TT_ESC;
1467 pc->p++; pc->len--;
1468 pc->state = JIM_PS_DEF;
1469 return JIM_OK;
1470 }
1471 break;
1472 }
1473 pc->p++; pc->len--;
1474 }
1475 return JIM_OK; /* unreached */
1476 }
1477
1478 int JimParseComment(struct JimParserCtx *pc)
1479 {
1480 while (*pc->p) {
1481 if (*pc->p == '\n') {
1482 pc->linenr++;
1483 if (*(pc->p-1) != '\\') {
1484 pc->p++; pc->len--;
1485 return JIM_OK;
1486 }
1487 }
1488 pc->p++; pc->len--;
1489 }
1490 return JIM_OK;
1491 }
1492
1493 /* xdigitval and odigitval are helper functions for JimParserGetToken() */
1494 static int xdigitval(int c)
1495 {
1496 if (c >= '0' && c <= '9') return c-'0';
1497 if (c >= 'a' && c <= 'f') return c-'a'+10;
1498 if (c >= 'A' && c <= 'F') return c-'A'+10;
1499 return -1;
1500 }
1501
1502 static int odigitval(int c)
1503 {
1504 if (c >= '0' && c <= '7') return c-'0';
1505 return -1;
1506 }
1507
1508 /* Perform Tcl escape substitution of 's', storing the result
1509 * string into 'dest'. The escaped string is guaranteed to
1510 * be the same length or shorted than the source string.
1511 * Slen is the length of the string at 's', if it's -1 the string
1512 * length will be calculated by the function.
1513 *
1514 * The function returns the length of the resulting string. */
1515 static int JimEscape(char *dest, const char *s, int slen)
1516 {
1517 char *p = dest;
1518 int i, len;
1519
1520 if (slen == -1)
1521 slen = strlen(s);
1522
1523 for (i = 0; i < slen; i++) {
1524 switch(s[i]) {
1525 case '\\':
1526 switch(s[i+1]) {
1527 case 'a': *p++ = 0x7; i++; break;
1528 case 'b': *p++ = 0x8; i++; break;
1529 case 'f': *p++ = 0xc; i++; break;
1530 case 'n': *p++ = 0xa; i++; break;
1531 case 'r': *p++ = 0xd; i++; break;
1532 case 't': *p++ = 0x9; i++; break;
1533 case 'v': *p++ = 0xb; i++; break;
1534 case '\0': *p++ = '\\'; i++; break;
1535 case '\n': *p++ = ' '; i++; break;
1536 default:
1537 if (s[i+1] == 'x') {
1538 int val = 0;
1539 int c = xdigitval(s[i+2]);
1540 if (c == -1) {
1541 *p++ = 'x';
1542 i++;
1543 break;
1544 }
1545 val = c;
1546 c = xdigitval(s[i+3]);
1547 if (c == -1) {
1548 *p++ = val;
1549 i += 2;
1550 break;
1551 }
1552 val = (val*16)+c;
1553 *p++ = val;
1554 i += 3;
1555 break;
1556 } else if (s[i+1] >= '0' && s[i+1] <= '7')
1557 {
1558 int val = 0;
1559 int c = odigitval(s[i+1]);
1560 val = c;
1561 c = odigitval(s[i+2]);
1562 if (c == -1) {
1563 *p++ = val;
1564 i ++;
1565 break;
1566 }
1567 val = (val*8)+c;
1568 c = odigitval(s[i+3]);
1569 if (c == -1) {
1570 *p++ = val;
1571 i += 2;
1572 break;
1573 }
1574 val = (val*8)+c;
1575 *p++ = val;
1576 i += 3;
1577 } else {
1578 *p++ = s[i+1];
1579 i++;
1580 }
1581 break;
1582 }
1583 break;
1584 default:
1585 *p++ = s[i];
1586 break;
1587 }
1588 }
1589 len = p-dest;
1590 *p++ = '\0';
1591 return len;
1592 }
1593
1594 /* Returns a dynamically allocated copy of the current token in the
1595 * parser context. The function perform conversion of escapes if
1596 * the token is of type JIM_TT_ESC.
1597 *
1598 * Note that after the conversion, tokens that are grouped with
1599 * braces in the source code, are always recognizable from the
1600 * identical string obtained in a different way from the type.
1601 *
1602 * For exmple the string:
1603 *
1604 * {expand}$a
1605 *
1606 * will return as first token "expand", of type JIM_TT_STR
1607 *
1608 * While the string:
1609 *
1610 * expand$a
1611 *
1612 * will return as first token "expand", of type JIM_TT_ESC
1613 */
1614 char *JimParserGetToken(struct JimParserCtx *pc,
1615 int *lenPtr, int *typePtr, int *linePtr)
1616 {
1617 const char *start, *end;
1618 char *token;
1619 int len;
1620
1621 start = JimParserTstart(pc);
1622 end = JimParserTend(pc);
1623 if (start > end) {
1624 if (lenPtr) *lenPtr = 0;
1625 if (typePtr) *typePtr = JimParserTtype(pc);
1626 if (linePtr) *linePtr = JimParserTline(pc);
1627 token = Jim_Alloc(1);
1628 token[0] = '\0';
1629 return token;
1630 }
1631 len = (end-start)+1;
1632 token = Jim_Alloc(len+1);
1633 if (JimParserTtype(pc) != JIM_TT_ESC) {
1634 /* No escape conversion needed? Just copy it. */
1635 memcpy(token, start, len);
1636 token[len] = '\0';
1637 } else {
1638 /* Else convert the escape chars. */
1639 len = JimEscape(token, start, len);
1640 }
1641 if (lenPtr) *lenPtr = len;
1642 if (typePtr) *typePtr = JimParserTtype(pc);
1643 if (linePtr) *linePtr = JimParserTline(pc);
1644 return token;
1645 }
1646
1647 /* The following functin is not really part of the parsing engine of Jim,
1648 * but it somewhat related. Given an string and its length, it tries
1649 * to guess if the script is complete or there are instead " " or { }
1650 * open and not completed. This is useful for interactive shells
1651 * implementation and for [info complete].
1652 *
1653 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
1654 * '{' on scripts incomplete missing one or more '}' to be balanced.
1655 * '"' on scripts incomplete missing a '"' char.
1656 *
1657 * If the script is complete, 1 is returned, otherwise 0. */
1658 int Jim_ScriptIsComplete(const char *s, int len, char *stateCharPtr)
1659 {
1660 int level = 0;
1661 int state = ' ';
1662
1663 while(len) {
1664 switch (*s) {
1665 case '\\':
1666 if (len > 1)
1667 s++;
1668 break;
1669 case '"':
1670 if (state == ' ') {
1671 state = '"';
1672 } else if (state == '"') {
1673 state = ' ';
1674 }
1675 break;
1676 case '{':
1677 if (state == '{') {
1678 level++;
1679 } else if (state == ' ') {
1680 state = '{';
1681 level++;
1682 }
1683 break;
1684 case '}':
1685 if (state == '{') {
1686 level--;
1687 if (level == 0)
1688 state = ' ';
1689 }
1690 break;
1691 }
1692 s++;
1693 len--;
1694 }
1695 if (stateCharPtr)
1696 *stateCharPtr = state;
1697 return state == ' ';
1698 }
1699
1700 /* -----------------------------------------------------------------------------
1701 * Tcl Lists parsing
1702 * ---------------------------------------------------------------------------*/
1703 static int JimParseListSep(struct JimParserCtx *pc);
1704 static int JimParseListStr(struct JimParserCtx *pc);
1705
1706 int JimParseList(struct JimParserCtx *pc)
1707 {
1708 if (pc->len == 0) {
1709 pc->tstart = pc->tend = pc->p;
1710 pc->tline = pc->linenr;
1711 pc->tt = JIM_TT_EOL;
1712 pc->eof = 1;
1713 return JIM_OK;
1714 }
1715 switch(*pc->p) {
1716 case ' ':
1717 case '\n':
1718 case '\t':
1719 case '\r':
1720 if (pc->state == JIM_PS_DEF)
1721 return JimParseListSep(pc);
1722 else
1723 return JimParseListStr(pc);
1724 break;
1725 default:
1726 return JimParseListStr(pc);
1727 break;
1728 }
1729 return JIM_OK;
1730 }
1731
1732 int JimParseListSep(struct JimParserCtx *pc)
1733 {
1734 pc->tstart = pc->p;
1735 pc->tline = pc->linenr;
1736 while (*pc->p == ' ' || *pc->p == '\t' || *pc->p == '\r' || *pc->p == '\n')
1737 {
1738 pc->p++; pc->len--;
1739 }
1740 pc->tend = pc->p-1;
1741 pc->tt = JIM_TT_SEP;
1742 return JIM_OK;
1743 }
1744
1745 int JimParseListStr(struct JimParserCtx *pc)
1746 {
1747 int newword = (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1748 pc->tt == JIM_TT_NONE);
1749 if (newword && *pc->p == '{') {
1750 return JimParseBrace(pc);
1751 } else if (newword && *pc->p == '"') {
1752 pc->state = JIM_PS_QUOTE;
1753 pc->p++; pc->len--;
1754 }
1755 pc->tstart = pc->p;
1756 pc->tline = pc->linenr;
1757 while (1) {
1758 if (pc->len == 0) {
1759 pc->tend = pc->p-1;
1760 pc->tt = JIM_TT_ESC;
1761 return JIM_OK;
1762 }
1763 switch(*pc->p) {
1764 case '\\':
1765 pc->p++; pc->len--;
1766 break;
1767 case ' ':
1768 case '\t':
1769 case '\n':
1770 case '\r':
1771 if (pc->state == JIM_PS_DEF) {
1772 pc->tend = pc->p-1;
1773 pc->tt = JIM_TT_ESC;
1774 return JIM_OK;
1775 } else if (*pc->p == '\n') {
1776 pc->linenr++;
1777 }
1778 break;
1779 case '"':
1780 if (pc->state == JIM_PS_QUOTE) {
1781 pc->tend = pc->p-1;
1782 pc->tt = JIM_TT_ESC;
1783 pc->p++; pc->len--;
1784 pc->state = JIM_PS_DEF;
1785 return JIM_OK;
1786 }
1787 break;
1788 }
1789 pc->p++; pc->len--;
1790 }
1791 return JIM_OK; /* unreached */
1792 }
1793
1794 /* -----------------------------------------------------------------------------
1795 * Jim_Obj related functions
1796 * ---------------------------------------------------------------------------*/
1797
1798 /* Return a new initialized object. */
1799 Jim_Obj *Jim_NewObj(Jim_Interp *interp)
1800 {
1801 Jim_Obj *objPtr;
1802
1803 /* -- Check if there are objects in the free list -- */
1804 if (interp->freeList != NULL) {
1805 /* -- Unlink the object from the free list -- */
1806 objPtr = interp->freeList;
1807 interp->freeList = objPtr->nextObjPtr;
1808 } else {
1809 /* -- No ready to use objects: allocate a new one -- */
1810 objPtr = Jim_Alloc(sizeof(*objPtr));
1811 }
1812
1813 /* Object is returned with refCount of 0. Every
1814 * kind of GC implemented should take care to don't try
1815 * to scan objects with refCount == 0. */
1816 objPtr->refCount = 0;
1817 /* All the other fields are left not initialized to save time.
1818 * The caller will probably want set they to the right
1819 * value anyway. */
1820
1821 /* -- Put the object into the live list -- */
1822 objPtr->prevObjPtr = NULL;
1823 objPtr->nextObjPtr = interp->liveList;
1824 if (interp->liveList)
1825 interp->liveList->prevObjPtr = objPtr;
1826 interp->liveList = objPtr;
1827
1828 return objPtr;
1829 }
1830
1831 /* Free an object. Actually objects are never freed, but
1832 * just moved to the free objects list, where they will be
1833 * reused by Jim_NewObj(). */
1834 void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr)
1835 {
1836 /* Check if the object was already freed, panic. */
1837 if (objPtr->refCount != 0) {
1838 Jim_Panic(interp,"!!!Object %p freed with bad refcount %d", objPtr,
1839 objPtr->refCount);
1840 }
1841 /* Free the internal representation */
1842 Jim_FreeIntRep(interp, objPtr);
1843 /* Free the string representation */
1844 if (objPtr->bytes != NULL) {
1845 if (objPtr->bytes != JimEmptyStringRep)
1846 Jim_Free(objPtr->bytes);
1847 }
1848 /* Unlink the object from the live objects list */
1849 if (objPtr->prevObjPtr)
1850 objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr;
1851 if (objPtr->nextObjPtr)
1852 objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr;
1853 if (interp->liveList == objPtr)
1854 interp->liveList = objPtr->nextObjPtr;
1855 /* Link the object into the free objects list */
1856 objPtr->prevObjPtr = NULL;
1857 objPtr->nextObjPtr = interp->freeList;
1858 if (interp->freeList)
1859 interp->freeList->prevObjPtr = objPtr;
1860 interp->freeList = objPtr;
1861 objPtr->refCount = -1;
1862 }
1863
1864 /* Invalidate the string representation of an object. */
1865 void Jim_InvalidateStringRep(Jim_Obj *objPtr)
1866 {
1867 if (objPtr->bytes != NULL) {
1868 if (objPtr->bytes != JimEmptyStringRep)
1869 Jim_Free(objPtr->bytes);
1870 }
1871 objPtr->bytes = NULL;
1872 }
1873
1874 #define Jim_SetStringRep(o, b, l) \
1875 do { (o)->bytes = b; (o)->length = l; } while (0)
1876
1877 /* Set the initial string representation for an object.
1878 * Does not try to free an old one. */
1879 void Jim_InitStringRep(Jim_Obj *objPtr, const char *bytes, int length)
1880 {
1881 if (length == 0) {
1882 objPtr->bytes = JimEmptyStringRep;
1883 objPtr->length = 0;
1884 } else {
1885 objPtr->bytes = Jim_Alloc(length+1);
1886 objPtr->length = length;
1887 memcpy(objPtr->bytes, bytes, length);
1888 objPtr->bytes[length] = '\0';
1889 }
1890 }
1891
1892 /* Duplicate an object. The returned object has refcount = 0. */
1893 Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
1894 {
1895 Jim_Obj *dupPtr;
1896
1897 dupPtr = Jim_NewObj(interp);
1898 if (objPtr->bytes == NULL) {
1899 /* Object does not have a valid string representation. */
1900 dupPtr->bytes = NULL;
1901 } else {
1902 Jim_InitStringRep(dupPtr, objPtr->bytes, objPtr->length);
1903 }
1904 if (objPtr->typePtr != NULL) {
1905 if (objPtr->typePtr->dupIntRepProc == NULL) {
1906 dupPtr->internalRep = objPtr->internalRep;
1907 } else {
1908 objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr);
1909 }
1910 dupPtr->typePtr = objPtr->typePtr;
1911 } else {
1912 dupPtr->typePtr = NULL;
1913 }
1914 return dupPtr;
1915 }
1916
1917 /* Return the string representation for objPtr. If the object
1918 * string representation is invalid, calls the method to create
1919 * a new one starting from the internal representation of the object. */
1920 const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr)
1921 {
1922 if (objPtr->bytes == NULL) {
1923 /* Invalid string repr. Generate it. */
1924 if (objPtr->typePtr->updateStringProc == NULL) {
1925 Jim_Panic(NULL,"UpdataStringProc called against '%s' type.",
1926 objPtr->typePtr->name);
1927 }
1928 objPtr->typePtr->updateStringProc(objPtr);
1929 }
1930 if (lenPtr)
1931 *lenPtr = objPtr->length;
1932 return objPtr->bytes;
1933 }
1934
1935 /* Just returns the length of the object's string rep */
1936 int Jim_Length(Jim_Obj *objPtr)
1937 {
1938 int len;
1939
1940 Jim_GetString(objPtr, &len);
1941 return len;
1942 }
1943
1944 /* -----------------------------------------------------------------------------
1945 * String Object
1946 * ---------------------------------------------------------------------------*/
1947 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
1948 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
1949
1950 static Jim_ObjType stringObjType = {
1951 "string",
1952 NULL,
1953 DupStringInternalRep,
1954 NULL,
1955 JIM_TYPE_REFERENCES,
1956 };
1957
1958 void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
1959 {
1960 JIM_NOTUSED(interp);
1961
1962 /* This is a bit subtle: the only caller of this function
1963 * should be Jim_DuplicateObj(), that will copy the
1964 * string representaion. After the copy, the duplicated
1965 * object will not have more room in teh buffer than
1966 * srcPtr->length bytes. So we just set it to length. */
1967 dupPtr->internalRep.strValue.maxLength = srcPtr->length;
1968 }
1969
1970 int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
1971 {
1972 /* Get a fresh string representation. */
1973 (void) Jim_GetString(objPtr, NULL);
1974 /* Free any other internal representation. */
1975 Jim_FreeIntRep(interp, objPtr);
1976 /* Set it as string, i.e. just set the maxLength field. */
1977 objPtr->typePtr = &stringObjType;
1978 objPtr->internalRep.strValue.maxLength = objPtr->length;
1979 return JIM_OK;
1980 }
1981
1982 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
1983 {
1984 Jim_Obj *objPtr = Jim_NewObj(interp);
1985
1986 if (len == -1)
1987 len = strlen(s);
1988 /* Alloc/Set the string rep. */
1989 if (len == 0) {
1990 objPtr->bytes = JimEmptyStringRep;
1991 objPtr->length = 0;
1992 } else {
1993 objPtr->bytes = Jim_Alloc(len+1);
1994 objPtr->length = len;
1995 memcpy(objPtr->bytes, s, len);
1996 objPtr->bytes[len] = '\0';
1997 }
1998
1999 /* No typePtr field for the vanilla string object. */
2000 objPtr->typePtr = NULL;
2001 return objPtr;
2002 }
2003
2004 /* This version does not try to duplicate the 's' pointer, but
2005 * use it directly. */
2006 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
2007 {
2008 Jim_Obj *objPtr = Jim_NewObj(interp);
2009
2010 if (len == -1)
2011 len = strlen(s);
2012 Jim_SetStringRep(objPtr, s, len);
2013 objPtr->typePtr = NULL;
2014 return objPtr;
2015 }
2016
2017 /* Low-level string append. Use it only against objects
2018 * of type "string". */
2019 void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
2020 {
2021 int needlen;
2022
2023 if (len == -1)
2024 len = strlen(str);
2025 needlen = objPtr->length + len;
2026 if (objPtr->internalRep.strValue.maxLength < needlen ||
2027 objPtr->internalRep.strValue.maxLength == 0) {
2028 if (objPtr->bytes == JimEmptyStringRep) {
2029 objPtr->bytes = Jim_Alloc((needlen*2)+1);
2030 } else {
2031 objPtr->bytes = Jim_Realloc(objPtr->bytes, (needlen*2)+1);
2032 }
2033 objPtr->internalRep.strValue.maxLength = needlen*2;
2034 }
2035 memcpy(objPtr->bytes + objPtr->length, str, len);
2036 objPtr->bytes[objPtr->length+len] = '\0';
2037 objPtr->length += len;
2038 }
2039
2040 /* Low-level wrapper to append an object. */
2041 void StringAppendObj(Jim_Obj *objPtr, Jim_Obj *appendObjPtr)
2042 {
2043 int len;
2044 const char *str;
2045
2046 str = Jim_GetString(appendObjPtr, &len);
2047 StringAppendString(objPtr, str, len);
2048 }
2049
2050 /* Higher level API to append strings to objects. */
2051 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str,
2052 int len)
2053 {
2054 if (Jim_IsShared(objPtr))
2055 Jim_Panic(interp,"Jim_AppendString called with shared object");
2056 if (objPtr->typePtr != &stringObjType)
2057 SetStringFromAny(interp, objPtr);
2058 StringAppendString(objPtr, str, len);
2059 }
2060
2061 void Jim_AppendString_sprintf( Jim_Interp *interp, Jim_Obj *objPtr, const char *fmt, ... )
2062 {
2063 char *buf;
2064 va_list ap;
2065
2066 va_start( ap, fmt );
2067 buf = jim_vasprintf( fmt, ap );
2068 va_end(ap);
2069
2070 if( buf ){
2071 Jim_AppendString( interp, objPtr, buf, -1 );
2072 jim_vasprintf_done(buf);
2073 }
2074 }
2075
2076
2077 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr,
2078 Jim_Obj *appendObjPtr)
2079 {
2080 int len;
2081 const char *str;
2082
2083 str = Jim_GetString(appendObjPtr, &len);
2084 Jim_AppendString(interp, objPtr, str, len);
2085 }
2086
2087 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2088 {
2089 va_list ap;
2090
2091 if (objPtr->typePtr != &stringObjType)
2092 SetStringFromAny(interp, objPtr);
2093 va_start(ap, objPtr);
2094 while (1) {
2095 char *s = va_arg(ap, char*);
2096
2097 if (s == NULL) break;
2098 Jim_AppendString(interp, objPtr, s, -1);
2099 }
2100 va_end(ap);
2101 }
2102
2103 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr, int nocase)
2104 {
2105 const char *aStr, *bStr;
2106 int aLen, bLen, i;
2107
2108 if (aObjPtr == bObjPtr) return 1;
2109 aStr = Jim_GetString(aObjPtr, &aLen);
2110 bStr = Jim_GetString(bObjPtr, &bLen);
2111 if (aLen != bLen) return 0;
2112 if (nocase == 0)
2113 return memcmp(aStr, bStr, aLen) == 0;
2114 for (i = 0; i < aLen; i++) {
2115 if (tolower((int)aStr[i]) != tolower((int)bStr[i]))
2116 return 0;
2117 }
2118 return 1;
2119 }
2120
2121 int Jim_StringMatchObj(Jim_Obj *patternObjPtr, Jim_Obj *objPtr,
2122 int nocase)
2123 {
2124 const char *pattern, *string;
2125 int patternLen, stringLen;
2126
2127 pattern = Jim_GetString(patternObjPtr, &patternLen);
2128 string = Jim_GetString(objPtr, &stringLen);
2129 return JimStringMatch(pattern, patternLen, string, stringLen, nocase);
2130 }
2131
2132 int Jim_StringCompareObj(Jim_Obj *firstObjPtr,
2133 Jim_Obj *secondObjPtr, int nocase)
2134 {
2135 const char *s1, *s2;
2136 int l1, l2;
2137
2138 s1 = Jim_GetString(firstObjPtr, &l1);
2139 s2 = Jim_GetString(secondObjPtr, &l2);
2140 return JimStringCompare(s1, l1, s2, l2, nocase);
2141 }
2142
2143 /* Convert a range, as returned by Jim_GetRange(), into
2144 * an absolute index into an object of the specified length.
2145 * This function may return negative values, or values
2146 * bigger or equal to the length of the list if the index
2147 * is out of range. */
2148 static int JimRelToAbsIndex(int len, int index)
2149 {
2150 if (index < 0)
2151 return len + index;
2152 return index;
2153 }
2154
2155 /* Convert a pair of index as normalize by JimRelToAbsIndex(),
2156 * into a range stored in *firstPtr, *lastPtr, *rangeLenPtr, suitable
2157 * for implementation of commands like [string range] and [lrange].
2158 *
2159 * The resulting range is guaranteed to address valid elements of
2160 * the structure. */
2161 static void JimRelToAbsRange(int len, int first, int last,
2162 int *firstPtr, int *lastPtr, int *rangeLenPtr)
2163 {
2164 int rangeLen;
2165
2166 if (first > last) {
2167 rangeLen = 0;
2168 } else {
2169 rangeLen = last-first+1;
2170 if (rangeLen) {
2171 if (first < 0) {
2172 rangeLen += first;
2173 first = 0;
2174 }
2175 if (last >= len) {
2176 rangeLen -= (last-(len-1));
2177 last = len-1;
2178 }
2179 }
2180 }
2181 if (rangeLen < 0) rangeLen = 0;
2182
2183 *firstPtr = first;
2184 *lastPtr = last;
2185 *rangeLenPtr = rangeLen;
2186 }
2187
2188 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2189 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2190 {
2191 int first, last;
2192 const char *str;
2193 int len, rangeLen;
2194
2195 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
2196 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
2197 return NULL;
2198 str = Jim_GetString(strObjPtr, &len);
2199 first = JimRelToAbsIndex(len, first);
2200 last = JimRelToAbsIndex(len, last);
2201 JimRelToAbsRange(len, first, last, &first, &last, &rangeLen);
2202 return Jim_NewStringObj(interp, str+first, rangeLen);
2203 }
2204
2205 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2206 {
2207 char *buf;
2208 int i;
2209 if (strObjPtr->typePtr != &stringObjType) {
2210 SetStringFromAny(interp, strObjPtr);
2211 }
2212
2213 buf = Jim_Alloc(strObjPtr->length+1);
2214
2215 memcpy(buf, strObjPtr->bytes, strObjPtr->length+1);
2216 for (i = 0; i < strObjPtr->length; i++)
2217 buf[i] = tolower(buf[i]);
2218 return Jim_NewStringObjNoAlloc(interp, buf, strObjPtr->length);
2219 }
2220
2221 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2222 {
2223 char *buf;
2224 int i;
2225 if (strObjPtr->typePtr != &stringObjType) {
2226 SetStringFromAny(interp, strObjPtr);
2227 }
2228
2229 buf = Jim_Alloc(strObjPtr->length+1);
2230
2231 memcpy(buf, strObjPtr->bytes, strObjPtr->length+1);
2232 for (i = 0; i < strObjPtr->length; i++)
2233 buf[i] = toupper(buf[i]);
2234 return Jim_NewStringObjNoAlloc(interp, buf, strObjPtr->length);
2235 }
2236
2237 /* This is the core of the [format] command.
2238 * TODO: Lots of things work - via a hack
2239 * However, no format item can be >= JIM_MAX_FMT
2240 */
2241 #define JIM_MAX_FMT 2048
2242 static Jim_Obj *Jim_FormatString_Inner(Jim_Interp *interp, Jim_Obj *fmtObjPtr,
2243 int objc, Jim_Obj *const *objv, char *sprintf_buf)
2244 {
2245 const char *fmt, *_fmt;
2246 int fmtLen;
2247 Jim_Obj *resObjPtr;
2248
2249
2250 fmt = Jim_GetString(fmtObjPtr, &fmtLen);
2251 _fmt = fmt;
2252 resObjPtr = Jim_NewStringObj(interp, "", 0);
2253 while (fmtLen) {
2254 const char *p = fmt;
2255 char spec[2], c;
2256 jim_wide wideValue;
2257 double doubleValue;
2258 /* we cheat and use Sprintf()! */
2259 char fmt_str[100];
2260 char *cp;
2261 int width;
2262 int ljust;
2263 int zpad;
2264 int spad;
2265 int altfm;
2266 int forceplus;
2267 int prec;
2268 int inprec;
2269 int haveprec;
2270 int accum;
2271
2272 while (*fmt != '%' && fmtLen) {
2273 fmt++; fmtLen--;
2274 }
2275 Jim_AppendString(interp, resObjPtr, p, fmt-p);
2276 if (fmtLen == 0)
2277 break;
2278 fmt++; fmtLen--; /* skip '%' */
2279 zpad = 0;
2280 spad = 0;
2281 width = -1;
2282 ljust = 0;
2283 altfm = 0;
2284 forceplus = 0;
2285 inprec = 0;
2286 haveprec = 0;
2287 prec = -1; /* not found yet */
2288 next_fmt:
2289 if( fmtLen <= 0 ){
2290 break;
2291 }
2292 switch( *fmt ){
2293 /* terminals */
2294 case 'b': /* binary - not all printfs() do this */
2295 case 's': /* string */
2296 case 'i': /* integer */
2297 case 'd': /* decimal */
2298 case 'x': /* hex */
2299 case 'X': /* CAP hex */
2300 case 'c': /* char */
2301 case 'o': /* octal */
2302 case 'u': /* unsigned */
2303 case 'f': /* float */
2304 break;
2305
2306 /* non-terminals */
2307 case '0': /* zero pad */
2308 zpad = 1;
2309 fmt++; fmtLen--;
2310 goto next_fmt;
2311 break;
2312 case '+':
2313 forceplus = 1;
2314 fmt++; fmtLen--;
2315 goto next_fmt;
2316 break;
2317 case ' ': /* sign space */
2318 spad = 1;
2319 fmt++; fmtLen--;
2320 goto next_fmt;
2321 break;
2322 case '-':
2323 ljust = 1;
2324 fmt++; fmtLen--;
2325 goto next_fmt;
2326 break;
2327 case '#':
2328 altfm = 1;
2329 fmt++; fmtLen--;
2330 goto next_fmt;
2331
2332 case '.':
2333 inprec = 1;
2334 fmt++; fmtLen--;
2335 goto next_fmt;
2336 break;
2337 case '1':
2338 case '2':
2339 case '3':
2340 case '4':
2341 case '5':
2342 case '6':
2343 case '7':
2344 case '8':
2345 case '9':
2346 accum = 0;
2347 while( isdigit(*fmt) && (fmtLen > 0) ){
2348 accum = (accum * 10) + (*fmt - '0');
2349 fmt++; fmtLen--;
2350 }
2351 if( inprec ){
2352 haveprec = 1;
2353 prec = accum;
2354 } else {
2355 width = accum;
2356 }
2357 goto next_fmt;
2358 case '*':
2359 /* suck up the next item as an integer */
2360 fmt++; fmtLen--;
2361 objc--;
2362 if( objc <= 0 ){
2363 goto not_enough_args;
2364 }
2365 if( Jim_GetWide(interp,objv[0],&wideValue )== JIM_ERR ){
2366 Jim_FreeNewObj(interp, resObjPtr );
2367 return NULL;
2368 }
2369 if( inprec ){
2370 haveprec = 1;
2371 prec = wideValue;
2372 if( prec < 0 ){
2373 /* man 3 printf says */
2374 /* if prec is negative, it is zero */
2375 prec = 0;
2376 }
2377 } else {
2378 width = wideValue;
2379 if( width < 0 ){
2380 ljust = 1;
2381 width = -width;
2382 }
2383 }
2384 objv++;
2385 goto next_fmt;
2386 break;
2387 }
2388
2389
2390 if (*fmt != '%') {
2391 if (objc == 0) {
2392 not_enough_args:
2393 Jim_FreeNewObj(interp, resObjPtr);
2394 Jim_SetResultString(interp,
2395 "not enough arguments for all format specifiers", -1);
2396 return NULL;
2397 } else {
2398 objc--;
2399 }
2400 }
2401
2402 /*
2403 * Create the formatter
2404 * cause we cheat and use sprintf()
2405 */
2406 cp = fmt_str;
2407 *cp++ = '%';
2408 if( altfm ){
2409 *cp++ = '#';
2410 }
2411 if( forceplus ){
2412 *cp++ = '+';
2413 } else if( spad ){
2414 /* PLUS overrides */
2415 *cp++ = ' ';
2416 }
2417 if( ljust ){
2418 *cp++ = '-';
2419 }
2420 if( zpad ){
2421 *cp++ = '0';
2422 }
2423 if( width > 0 ){
2424 sprintf( cp, "%d", width );
2425 /* skip ahead */
2426 cp = strchr(cp,0);
2427 }
2428 /* did we find a period? */
2429 if( inprec ){
2430 /* then add it */
2431 *cp++ = '.';
2432 /* did something occur after the period? */
2433 if( haveprec ){
2434 sprintf( cp, "%d", prec );
2435 }
2436 cp = strchr(cp,0);
2437 }
2438 *cp = 0;
2439
2440 /* here we do the work */
2441 /* actually - we make sprintf() do it for us */
2442 switch(*fmt) {
2443 case 's':
2444 *cp++ = 's';
2445 *cp = 0;
2446 /* BUG: we do not handled embeded NULLs */
2447 snprintf( sprintf_buf, JIM_MAX_FMT, fmt_str, Jim_GetString( objv[0], NULL ));
2448 break;
2449 case 'c':
2450 *cp++ = 'c';
2451 *cp = 0;
2452 if (Jim_GetWide(interp, objv[0], &wideValue) == JIM_ERR) {
2453 Jim_FreeNewObj(interp, resObjPtr);
2454 return NULL;
2455 }
2456 c = (char) wideValue;
2457 snprintf( sprintf_buf, JIM_MAX_FMT, fmt_str, c );
2458 break;
2459 case 'f':
2460 case 'F':
2461 case 'g':
2462 case 'G':
2463 case 'e':
2464 case 'E':
2465 *cp++ = *fmt;
2466 *cp = 0;
2467 if( Jim_GetDouble( interp, objv[0], &doubleValue ) == JIM_ERR ){
2468 Jim_FreeNewObj( interp, resObjPtr );
2469 return NULL;
2470 }
2471 snprintf( sprintf_buf, JIM_MAX_FMT, fmt_str, doubleValue );
2472 break;
2473 case 'b':
2474 case 'd':
2475 case 'o':
2476 case 'i':
2477 case 'u':
2478 case 'x':
2479 case 'X':
2480 /* jim widevaluse are 64bit */
2481 if( sizeof(jim_wide) == sizeof(long long) ){
2482 *cp++ = 'l';
2483 *cp++ = 'l';
2484 } else {
2485 *cp++ = 'l';
2486 }
2487 *cp++ = *fmt;
2488 *cp = 0;
2489 if (Jim_GetWide(interp, objv[0], &wideValue) == JIM_ERR) {
2490 Jim_FreeNewObj(interp, resObjPtr);
2491 return NULL;
2492 }
2493 snprintf(sprintf_buf, JIM_MAX_FMT, fmt_str, wideValue );
2494 break;
2495 case '%':
2496 sprintf_buf[0] = '%';
2497 sprintf_buf[1] = 0;
2498 objv--; /* undo the objv++ below */
2499 break;
2500 default:
2501 spec[0] = *fmt; spec[1] = '\0';
2502 Jim_FreeNewObj(interp, resObjPtr);
2503 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
2504 Jim_AppendStrings(interp, Jim_GetResult(interp),
2505 "bad field specifier \"", spec, "\"", NULL);
2506 return NULL;
2507 }
2508 /* force terminate */
2509 #if 0
2510 printf("FMT was: %s\n", fmt_str );
2511 printf("RES was: |%s|\n", sprintf_buf );
2512 #endif
2513
2514 sprintf_buf[ JIM_MAX_FMT - 1] = 0;
2515 Jim_AppendString( interp, resObjPtr, sprintf_buf, strlen(sprintf_buf) );
2516 /* next obj */
2517 objv++;
2518 fmt++;
2519 fmtLen--;
2520 }
2521 return resObjPtr;
2522 }
2523
2524 Jim_Obj *Jim_FormatString(Jim_Interp *interp, Jim_Obj *fmtObjPtr,
2525 int objc, Jim_Obj *const *objv)
2526 {
2527 char *sprintf_buf=malloc(JIM_MAX_FMT);
2528 Jim_Obj *t=Jim_FormatString_Inner(interp, fmtObjPtr, objc, objv, sprintf_buf);
2529 free(sprintf_buf);
2530 return t;
2531 }
2532
2533 /* -----------------------------------------------------------------------------
2534 * Compared String Object
2535 * ---------------------------------------------------------------------------*/
2536
2537 /* This is strange object that allows to compare a C literal string
2538 * with a Jim object in very short time if the same comparison is done
2539 * multiple times. For example every time the [if] command is executed,
2540 * Jim has to check if a given argument is "else". This comparions if
2541 * the code has no errors are true most of the times, so we can cache
2542 * inside the object the pointer of the string of the last matching
2543 * comparison. Because most C compilers perform literal sharing,
2544 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
2545 * this works pretty well even if comparisons are at different places
2546 * inside the C code. */
2547
2548 static Jim_ObjType comparedStringObjType = {
2549 "compared-string",
2550 NULL,
2551 NULL,
2552 NULL,
2553 JIM_TYPE_REFERENCES,
2554 };
2555
2556 /* The only way this object is exposed to the API is via the following
2557 * function. Returns true if the string and the object string repr.
2558 * are the same, otherwise zero is returned.
2559 *
2560 * Note: this isn't binary safe, but it hardly needs to be.*/
2561 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr,
2562 const char *str)
2563 {
2564 if (objPtr->typePtr == &comparedStringObjType &&
2565 objPtr->internalRep.ptr == str)
2566 return 1;
2567 else {
2568 const char *objStr = Jim_GetString(objPtr, NULL);
2569 if (strcmp(str, objStr) != 0) return 0;
2570 if (objPtr->typePtr != &comparedStringObjType) {
2571 Jim_FreeIntRep(interp, objPtr);
2572 objPtr->typePtr = &comparedStringObjType;
2573 }
2574 objPtr->internalRep.ptr = (char*)str; /*ATTENTION: const cast */
2575 return 1;
2576 }
2577 }
2578
2579 int qsortCompareStringPointers(const void *a, const void *b)
2580 {
2581 char * const *sa = (char * const *)a;
2582 char * const *sb = (char * const *)b;
2583 return strcmp(*sa, *sb);
2584 }
2585
2586 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
2587 const char * const *tablePtr, int *indexPtr, const char *name, int flags)
2588 {
2589 const char * const *entryPtr = NULL;
2590 char **tablePtrSorted;
2591 int i, count = 0;
2592
2593 *indexPtr = -1;
2594 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
2595 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
2596 *indexPtr = i;
2597 return JIM_OK;
2598 }
2599 count++; /* If nothing matches, this will reach the len of tablePtr */
2600 }
2601 if (flags & JIM_ERRMSG) {
2602 if (name == NULL)
2603 name = "option";
2604 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
2605 Jim_AppendStrings(interp, Jim_GetResult(interp),
2606 "bad ", name, " \"", Jim_GetString(objPtr, NULL), "\": must be one of ",
2607 NULL);
2608 tablePtrSorted = Jim_Alloc(sizeof(char*)*count);
2609 memcpy(tablePtrSorted, tablePtr, sizeof(char*)*count);
2610 qsort(tablePtrSorted, count, sizeof(char*), qsortCompareStringPointers);
2611 for (i = 0; i < count; i++) {
2612 if (i+1 == count && count > 1)
2613 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
2614 Jim_AppendString(interp, Jim_GetResult(interp),
2615 tablePtrSorted[i], -1);
2616 if (i+1 != count)
2617 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
2618 }
2619 Jim_Free(tablePtrSorted);
2620 }
2621 return JIM_ERR;
2622 }
2623
2624 int Jim_GetNvp(Jim_Interp *interp,
2625 Jim_Obj *objPtr,
2626 const Jim_Nvp *nvp_table,
2627 const Jim_Nvp ** result)
2628 {
2629 Jim_Nvp *n;
2630 int e;
2631
2632 e = Jim_Nvp_name2value_obj( interp, nvp_table, objPtr, &n );
2633 if( e == JIM_ERR ){
2634 return e;
2635 }
2636
2637 /* Success? found? */
2638 if( n->name ){
2639 /* remove const */
2640 *result = (Jim_Nvp *)n;
2641 return JIM_OK;
2642 } else {
2643 return JIM_ERR;
2644 }
2645 }
2646
2647 /* -----------------------------------------------------------------------------
2648 * Source Object
2649 *
2650 * This object is just a string from the language point of view, but
2651 * in the internal representation it contains the filename and line number
2652 * where this given token was read. This information is used by
2653 * Jim_EvalObj() if the object passed happens to be of type "source".
2654 *
2655 * This allows to propagate the information about line numbers and file
2656 * names and give error messages with absolute line numbers.
2657 *
2658 * Note that this object uses shared strings for filenames, and the
2659 * pointer to the filename together with the line number is taken into
2660 * the space for the "inline" internal represenation of the Jim_Object,
2661 * so there is almost memory zero-overhead.
2662 *
2663 * Also the object will be converted to something else if the given
2664 * token it represents in the source file is not something to be
2665 * evaluated (not a script), and will be specialized in some other way,
2666 * so the time overhead is alzo null.
2667 * ---------------------------------------------------------------------------*/
2668
2669 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2670 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2671
2672 static Jim_ObjType sourceObjType = {
2673 "source",
2674 FreeSourceInternalRep,
2675 DupSourceInternalRep,
2676 NULL,
2677 JIM_TYPE_REFERENCES,
2678 };
2679
2680 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2681 {
2682 Jim_ReleaseSharedString(interp,
2683 objPtr->internalRep.sourceValue.fileName);
2684 }
2685
2686 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2687 {
2688 dupPtr->internalRep.sourceValue.fileName =
2689 Jim_GetSharedString(interp,
2690 srcPtr->internalRep.sourceValue.fileName);
2691 dupPtr->internalRep.sourceValue.lineNumber =
2692 dupPtr->internalRep.sourceValue.lineNumber;
2693 dupPtr->typePtr = &sourceObjType;
2694 }
2695
2696 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
2697 const char *fileName, int lineNumber)
2698 {
2699 if (Jim_IsShared(objPtr))
2700 Jim_Panic(interp,"JimSetSourceInfo called with shared object");
2701 if (objPtr->typePtr != NULL)
2702 Jim_Panic(interp,"JimSetSourceInfo called with typePtr != NULL");
2703 objPtr->internalRep.sourceValue.fileName =
2704 Jim_GetSharedString(interp, fileName);
2705 objPtr->internalRep.sourceValue.lineNumber = lineNumber;
2706 objPtr->typePtr = &sourceObjType;
2707 }
2708
2709 /* -----------------------------------------------------------------------------
2710 * Script Object
2711 * ---------------------------------------------------------------------------*/
2712
2713 #define JIM_CMDSTRUCT_EXPAND -1
2714
2715 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2716 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2717 static int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2718
2719 static Jim_ObjType scriptObjType = {
2720 "script",
2721 FreeScriptInternalRep,
2722 DupScriptInternalRep,
2723 NULL,
2724 JIM_TYPE_REFERENCES,
2725 };
2726
2727 /* The ScriptToken structure represents every token into a scriptObj.
2728 * Every token contains an associated Jim_Obj that can be specialized
2729 * by commands operating on it. */
2730 typedef struct ScriptToken {
2731 int type;
2732 Jim_Obj *objPtr;
2733 int linenr;
2734 } ScriptToken;
2735
2736 /* This is the script object internal representation. An array of
2737 * ScriptToken structures, with an associated command structure array.
2738 * The command structure is a pre-computed representation of the
2739 * command length and arguments structure as a simple liner array
2740 * of integers.
2741 *
2742 * For example the script:
2743 *
2744 * puts hello
2745 * set $i $x$y [foo]BAR
2746 *
2747 * will produce a ScriptObj with the following Tokens:
2748 *
2749 * ESC puts
2750 * SEP
2751 * ESC hello
2752 * EOL
2753 * ESC set
2754 * EOL
2755 * VAR i
2756 * SEP
2757 * VAR x
2758 * VAR y
2759 * SEP
2760 * CMD foo
2761 * ESC BAR
2762 * EOL
2763 *
2764 * This is a description of the tokens, separators, and of lines.
2765 * The command structure instead represents the number of arguments
2766 * of every command, followed by the tokens of which every argument
2767 * is composed. So for the example script, the cmdstruct array will
2768 * contain:
2769 *
2770 * 2 1 1 4 1 1 2 2
2771 *
2772 * Because "puts hello" has two args (2), composed of single tokens (1 1)
2773 * While "set $i $x$y [foo]BAR" has four (4) args, the first two
2774 * composed of single tokens (1 1) and the last two of double tokens
2775 * (2 2).
2776 *
2777 * The precomputation of the command structure makes Jim_Eval() faster,
2778 * and simpler because there aren't dynamic lengths / allocations.
2779 *
2780 * -- {expand} handling --
2781 *
2782 * Expand is handled in a special way. When a command
2783 * contains at least an argument with the {expand} prefix,
2784 * the command structure presents a -1 before the integer
2785 * describing the number of arguments. This is used in order
2786 * to send the command exection to a different path in case
2787 * of {expand} and guarantee a fast path for the more common
2788 * case. Also, the integers describing the number of tokens
2789 * are expressed with negative sign, to allow for fast check
2790 * of what's an {expand}-prefixed argument and what not.
2791 *
2792 * For example the command:
2793 *
2794 * list {expand}{1 2}
2795 *
2796 * Will produce the following cmdstruct array:
2797 *
2798 * -1 2 1 -2
2799 *
2800 * -- the substFlags field of the structure --
2801 *
2802 * The scriptObj structure is used to represent both "script" objects
2803 * and "subst" objects. In the second case, the cmdStruct related
2804 * fields are not used at all, but there is an additional field used
2805 * that is 'substFlags': this represents the flags used to turn
2806 * the string into the intenral representation used to perform the
2807 * substitution. If this flags are not what the application requires
2808 * the scriptObj is created again. For example the script:
2809 *
2810 * subst -nocommands $string
2811 * subst -novariables $string
2812 *
2813 * Will recreate the internal representation of the $string object
2814 * two times.
2815 */
2816 typedef struct ScriptObj {
2817 int len; /* Length as number of tokens. */
2818 int commands; /* number of top-level commands in script. */
2819 ScriptToken *token; /* Tokens array. */
2820 int *cmdStruct; /* commands structure */
2821 int csLen; /* length of the cmdStruct array. */
2822 int substFlags; /* flags used for the compilation of "subst" objects */
2823 int inUse; /* Used to share a ScriptObj. Currently
2824 only used by Jim_EvalObj() as protection against
2825 shimmering of the currently evaluated object. */
2826 char *fileName;
2827 } ScriptObj;
2828
2829 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2830 {
2831 int i;
2832 struct ScriptObj *script = (void*) objPtr->internalRep.ptr;
2833
2834 script->inUse--;
2835 if (script->inUse != 0) return;
2836 for (i = 0; i < script->len; i++) {
2837 if (script->token[i].objPtr != NULL)
2838 Jim_DecrRefCount(interp, script->token[i].objPtr);
2839 }
2840 Jim_Free(script->token);
2841 Jim_Free(script->cmdStruct);
2842 Jim_Free(script->fileName);
2843 Jim_Free(script);
2844 }
2845
2846 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2847 {
2848 JIM_NOTUSED(interp);
2849 JIM_NOTUSED(srcPtr);
2850
2851 /* Just returns an simple string. */
2852 dupPtr->typePtr = NULL;
2853 }
2854
2855 /* Add a new token to the internal repr of a script object */
2856 static void ScriptObjAddToken(Jim_Interp *interp, struct ScriptObj *script,
2857 char *strtoken, int len, int type, char *filename, int linenr)
2858 {
2859 int prevtype;
2860 struct ScriptToken *token;
2861
2862 prevtype = (script->len == 0) ? JIM_TT_EOL : \
2863 script->token[script->len-1].type;
2864 /* Skip tokens without meaning, like words separators
2865 * following a word separator or an end of command and
2866 * so on. */
2867 if (prevtype == JIM_TT_EOL) {
2868 if (type == JIM_TT_EOL || type == JIM_TT_SEP) {
2869 Jim_Free(strtoken);
2870 return;
2871 }
2872 } else if (prevtype == JIM_TT_SEP) {
2873 if (type == JIM_TT_SEP) {
2874 Jim_Free(strtoken);
2875 return;
2876 } else if (type == JIM_TT_EOL) {
2877 /* If an EOL is following by a SEP, drop the previous
2878 * separator. */
2879 script->len--;
2880 Jim_DecrRefCount(interp, script->token[script->len].objPtr);
2881 }
2882 } else if (prevtype != JIM_TT_EOL && prevtype != JIM_TT_SEP &&
2883 type == JIM_TT_ESC && len == 0)
2884 {
2885 /* Don't add empty tokens used in interpolation */
2886 Jim_Free(strtoken);
2887 return;
2888 }
2889 /* Make space for a new istruction */
2890 script->len++;
2891 script->token = Jim_Realloc(script->token,
2892 sizeof(ScriptToken)*script->len);
2893 /* Initialize the new token */
2894 token = script->token+(script->len-1);
2895 token->type = type;
2896 /* Every object is intially as a string, but the
2897 * internal type may be specialized during execution of the
2898 * script. */
2899 token->objPtr = Jim_NewStringObjNoAlloc(interp, strtoken, len);
2900 /* To add source info to SEP and EOL tokens is useless because
2901 * they will never by called as arguments of Jim_EvalObj(). */
2902 if (filename && type != JIM_TT_SEP && type != JIM_TT_EOL)
2903 JimSetSourceInfo(interp, token->objPtr, filename, linenr);
2904 Jim_IncrRefCount(token->objPtr);
2905 token->linenr = linenr;
2906 }
2907
2908 /* Add an integer into the command structure field of the script object. */
2909 static void ScriptObjAddInt(struct ScriptObj *script, int val)
2910 {
2911 script->csLen++;
2912 script->cmdStruct = Jim_Realloc(script->cmdStruct,
2913 sizeof(int)*script->csLen);
2914 script->cmdStruct[script->csLen-1] = val;
2915 }
2916
2917 /* Search a Jim_Obj contained in 'script' with the same stinrg repr.
2918 * of objPtr. Search nested script objects recursively. */
2919 static Jim_Obj *ScriptSearchLiteral(Jim_Interp *interp, ScriptObj *script,
2920 ScriptObj *scriptBarrier, Jim_Obj *objPtr)
2921 {
2922 int i;
2923
2924 for (i = 0; i < script->len; i++) {
2925 if (script->token[i].objPtr != objPtr &&
2926 Jim_StringEqObj(script->token[i].objPtr, objPtr, 0)) {
2927 return script->token[i].objPtr;
2928 }
2929 /* Enter recursively on scripts only if the object
2930 * is not the same as the one we are searching for
2931 * shared occurrences. */
2932 if (script->token[i].objPtr->typePtr == &scriptObjType &&
2933 script->token[i].objPtr != objPtr) {
2934 Jim_Obj *foundObjPtr;
2935
2936 ScriptObj *subScript =
2937 script->token[i].objPtr->internalRep.ptr;
2938 /* Don't recursively enter the script we are trying
2939 * to make shared to avoid circular references. */
2940 if (subScript == scriptBarrier) continue;
2941 if (subScript != script) {
2942 foundObjPtr =
2943 ScriptSearchLiteral(interp, subScript,
2944 scriptBarrier, objPtr);
2945 if (foundObjPtr != NULL)
2946 return foundObjPtr;
2947 }
2948 }
2949 }
2950 return NULL;
2951 }
2952
2953 /* Share literals of a script recursively sharing sub-scripts literals. */
2954 static void ScriptShareLiterals(Jim_Interp *interp, ScriptObj *script,
2955 ScriptObj *topLevelScript)
2956 {
2957 int i, j;
2958
2959 return;
2960 /* Try to share with toplevel object. */
2961 if (topLevelScript != NULL) {
2962 for (i = 0; i < script->len; i++) {
2963 Jim_Obj *foundObjPtr;
2964 char *str = script->token[i].objPtr->bytes;
2965
2966 if (script->token[i].objPtr->refCount != 1) continue;
2967 if (script->token[i].objPtr->typePtr == &scriptObjType) continue;
2968 if (strchr(str, ' ') || strchr(str, '\n')) continue;
2969 foundObjPtr = ScriptSearchLiteral(interp,
2970 topLevelScript,
2971 script, /* barrier */
2972 script->token[i].objPtr);
2973 if (foundObjPtr != NULL) {
2974 Jim_IncrRefCount(foundObjPtr);
2975 Jim_DecrRefCount(interp,
2976 script->token[i].objPtr);
2977 script->token[i].objPtr = foundObjPtr;
2978 }
2979 }
2980 }
2981 /* Try to share locally */
2982 for (i = 0; i < script->len; i++) {
2983 char *str = script->token[i].objPtr->bytes;
2984
2985 if (script->token[i].objPtr->refCount != 1) continue;
2986 if (strchr(str, ' ') || strchr(str, '\n')) continue;
2987 for (j = 0; j < script->len; j++) {
2988 if (script->token[i].objPtr !=
2989 script->token[j].objPtr &&
2990 Jim_StringEqObj(script->token[i].objPtr,
2991 script->token[j].objPtr, 0))
2992 {
2993 Jim_IncrRefCount(script->token[j].objPtr);
2994 Jim_DecrRefCount(interp,
2995 script->token[i].objPtr);
2996 script->token[i].objPtr =
2997 script->token[j].objPtr;
2998 }
2999 }
3000 }
3001 }
3002
3003 /* This method takes the string representation of an object
3004 * as a Tcl script, and generates the pre-parsed internal representation
3005 * of the script. */
3006 int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3007 {
3008 int scriptTextLen;
3009 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
3010 struct JimParserCtx parser;
3011 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
3012 ScriptToken *token;
3013 int args, tokens, start, end, i;
3014 int initialLineNumber;
3015 int propagateSourceInfo = 0;
3016
3017 script->len = 0;
3018 script->csLen = 0;
3019 script->commands = 0;
3020 script->token = NULL;
3021 script->cmdStruct = NULL;
3022 script->inUse = 1;
3023 /* Try to get information about filename / line number */
3024 if (objPtr->typePtr == &sourceObjType) {
3025 script->fileName =
3026 Jim_StrDup(objPtr->internalRep.sourceValue.fileName);
3027 initialLineNumber = objPtr->internalRep.sourceValue.lineNumber;
3028 propagateSourceInfo = 1;
3029 } else {
3030 script->fileName = Jim_StrDup("");
3031 initialLineNumber = 1;
3032 }
3033
3034 JimParserInit(&parser, scriptText, scriptTextLen, initialLineNumber);
3035 while(!JimParserEof(&parser)) {
3036 char *token;
3037 int len, type, linenr;
3038
3039 JimParseScript(&parser);
3040 token = JimParserGetToken(&parser, &len, &type, &linenr);
3041 ScriptObjAddToken(interp, script, token, len, type,
3042 propagateSourceInfo ? script->fileName : NULL,
3043 linenr);
3044 }
3045 token = script->token;
3046
3047 /* Compute the command structure array
3048 * (see the ScriptObj struct definition for more info) */
3049 start = 0; /* Current command start token index */
3050 end = -1; /* Current command end token index */
3051 while (1) {
3052 int expand = 0; /* expand flag. set to 1 on {expand} form. */
3053 int interpolation = 0; /* set to 1 if there is at least one
3054 argument of the command obtained via
3055 interpolation of more tokens. */
3056 /* Search for the end of command, while
3057 * count the number of args. */
3058 start = ++end;
3059 if (start >= script->len) break;
3060 args = 1; /* Number of args in current command */
3061 while (token[end].type != JIM_TT_EOL) {
3062 if (end == 0 || token[end-1].type == JIM_TT_SEP ||
3063 token[end-1].type == JIM_TT_EOL)
3064 {
3065 if (token[end].type == JIM_TT_STR &&
3066 token[end+1].type != JIM_TT_SEP &&
3067 token[end+1].type != JIM_TT_EOL &&
3068 (!strcmp(token[end].objPtr->bytes, "expand") ||
3069 !strcmp(token[end].objPtr->bytes, "*")))
3070 expand++;
3071 }
3072 if (token[end].type == JIM_TT_SEP)
3073 args++;
3074 end++;
3075 }
3076 interpolation = !((end-start+1) == args*2);
3077 /* Add the 'number of arguments' info into cmdstruct.
3078 * Negative value if there is list expansion involved. */
3079 if (expand)
3080 ScriptObjAddInt(script, -1);
3081 ScriptObjAddInt(script, args);
3082 /* Now add info about the number of tokens. */
3083 tokens = 0; /* Number of tokens in current argument. */
3084 expand = 0;
3085 for (i = start; i <= end; i++) {
3086 if (token[i].type == JIM_TT_SEP ||
3087 token[i].type == JIM_TT_EOL)
3088 {
3089 if (tokens == 1 && expand)
3090 expand = 0;
3091 ScriptObjAddInt(script,
3092 expand ? -tokens : tokens);
3093
3094 expand = 0;
3095 tokens = 0;
3096 continue;
3097 } else if (tokens == 0 && token[i].type == JIM_TT_STR &&
3098 (!strcmp(token[i].objPtr->bytes, "expand") ||
3099 !strcmp(token[i].objPtr->bytes, "*")))
3100 {
3101 expand++;
3102 }
3103 tokens++;
3104 }
3105 }
3106 /* Perform literal sharing, but only for objects that appear
3107 * to be scripts written as literals inside the source code,
3108 * and not computed at runtime. Literal sharing is a costly
3109 * operation that should be done only against objects that
3110 * are likely to require compilation only the first time, and
3111 * then are executed multiple times. */
3112 if (propagateSourceInfo && interp->framePtr->procBodyObjPtr) {
3113 Jim_Obj *bodyObjPtr = interp->framePtr->procBodyObjPtr;
3114 if (bodyObjPtr->typePtr == &scriptObjType) {
3115 ScriptObj *bodyScript =
3116 bodyObjPtr->internalRep.ptr;
3117 ScriptShareLiterals(interp, script, bodyScript);
3118 }
3119 } else if (propagateSourceInfo) {
3120 ScriptShareLiterals(interp, script, NULL);
3121 }
3122 /* Free the old internal rep and set the new one. */
3123 Jim_FreeIntRep(interp, objPtr);
3124 Jim_SetIntRepPtr(objPtr, script);
3125 objPtr->typePtr = &scriptObjType;
3126 return JIM_OK;
3127 }
3128
3129 ScriptObj *Jim_GetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3130 {
3131 if (objPtr->typePtr != &scriptObjType) {
3132 SetScriptFromAny(interp, objPtr);
3133 }
3134 return (ScriptObj*) Jim_GetIntRepPtr(objPtr);
3135 }
3136
3137 /* -----------------------------------------------------------------------------
3138 * Commands
3139 * ---------------------------------------------------------------------------*/
3140
3141 /* Commands HashTable Type.
3142 *
3143 * Keys are dynamic allocated strings, Values are Jim_Cmd structures. */
3144 static void Jim_CommandsHT_ValDestructor(void *interp, void *val)
3145 {
3146 Jim_Cmd *cmdPtr = (void*) val;
3147
3148 if (cmdPtr->cmdProc == NULL) {
3149 Jim_DecrRefCount(interp, cmdPtr->argListObjPtr);
3150 Jim_DecrRefCount(interp, cmdPtr->bodyObjPtr);
3151 if (cmdPtr->staticVars) {
3152 Jim_FreeHashTable(cmdPtr->staticVars);
3153 Jim_Free(cmdPtr->staticVars);
3154 }
3155 } else if (cmdPtr->delProc != NULL) {
3156 /* If it was a C coded command, call the delProc if any */
3157 cmdPtr->delProc(interp, cmdPtr->privData);
3158 }
3159 Jim_Free(val);
3160 }
3161
3162 static Jim_HashTableType JimCommandsHashTableType = {
3163 JimStringCopyHTHashFunction, /* hash function */
3164 JimStringCopyHTKeyDup, /* key dup */
3165 NULL, /* val dup */
3166 JimStringCopyHTKeyCompare, /* key compare */
3167 JimStringCopyHTKeyDestructor, /* key destructor */
3168 Jim_CommandsHT_ValDestructor /* val destructor */
3169 };
3170
3171 /* ------------------------- Commands related functions --------------------- */
3172
3173 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdName,
3174 Jim_CmdProc cmdProc, void *privData, Jim_DelCmdProc delProc)
3175 {
3176 Jim_HashEntry *he;
3177 Jim_Cmd *cmdPtr;
3178
3179 he = Jim_FindHashEntry(&interp->commands, cmdName);
3180 if (he == NULL) { /* New command to create */
3181 cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3182 Jim_AddHashEntry(&interp->commands, cmdName, cmdPtr);
3183 } else {
3184 Jim_InterpIncrProcEpoch(interp);
3185 /* Free the arglist/body objects if it was a Tcl procedure */
3186 cmdPtr = he->val;
3187 if (cmdPtr->cmdProc == NULL) {
3188 Jim_DecrRefCount(interp, cmdPtr->argListObjPtr);
3189 Jim_DecrRefCount(interp, cmdPtr->bodyObjPtr);
3190 if (cmdPtr->staticVars) {
3191 Jim_FreeHashTable(cmdPtr->staticVars);
3192 Jim_Free(cmdPtr->staticVars);
3193 }
3194 cmdPtr->staticVars = NULL;
3195 } else if (cmdPtr->delProc != NULL) {
3196 /* If it was a C coded command, call the delProc if any */
3197 cmdPtr->delProc(interp, cmdPtr->privData);
3198 }
3199 }
3200
3201 /* Store the new details for this proc */
3202 cmdPtr->delProc = delProc;
3203 cmdPtr->cmdProc = cmdProc;
3204 cmdPtr->privData = privData;
3205
3206 /* There is no need to increment the 'proc epoch' because
3207 * creation of a new procedure can never affect existing
3208 * cached commands. We don't do negative caching. */
3209 return JIM_OK;
3210 }
3211
3212 int Jim_CreateProcedure(Jim_Interp *interp, const char *cmdName,
3213 Jim_Obj *argListObjPtr, Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr,
3214 int arityMin, int arityMax)
3215 {
3216 Jim_Cmd *cmdPtr;
3217
3218 cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3219 cmdPtr->cmdProc = NULL; /* Not a C coded command */
3220 cmdPtr->argListObjPtr = argListObjPtr;
3221 cmdPtr->bodyObjPtr = bodyObjPtr;
3222 Jim_IncrRefCount(argListObjPtr);
3223 Jim_IncrRefCount(bodyObjPtr);
3224 cmdPtr->arityMin = arityMin;