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