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