sync up to latest jim tcl
[openocd.git] / src / helper / jim.c
1 /* Jim - A small embeddable Tcl interpreter
2 *
3 * Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
4 * Copyright 2005 Clemens Hintze <c.hintze@gmx.net>
5 * Copyright 2005 patthoyts - Pat Thoyts <patthoyts@users.sf.net>
6 * Copyright 2008 oharboe - Øyvind Harboe - oyvind.harboe@zylin.com
7 * Copyright 2008 Andrew Lunn <andrew@lunn.ch>
8 * Copyright 2008 Duane Ellis <openocd@duaneellis.com>
9 * Copyright 2008 Uwe Klein <uklein@klein-messgeraete.de>
10 * Copyright 2008 Steve Bennett <steveb@workware.net.au>
11 *
12 * The FreeBSD license
13 *
14 * Redistribution and use in source and binary forms, with or without
15 * modification, are permitted provided that the following conditions
16 * are met:
17 *
18 * 1. Redistributions of source code must retain the above copyright
19 * notice, this list of conditions and the following disclaimer.
20 * 2. Redistributions in binary form must reproduce the above
21 * copyright notice, this list of conditions and the following
22 * disclaimer in the documentation and/or other materials
23 * provided with the distribution.
24 *
25 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
26 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
27 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
28 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
29 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
30 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
31 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
32 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
33 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
34 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
35 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
36 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
37 *
38 * The views and conclusions contained in the software and documentation
39 * are those of the authors and should not be interpreted as representing
40 * official policies, either expressed or implied, of the Jim Tcl Project.
41 **/
42 #define __JIM_CORE__
43 #define JIM_OPTIMIZATION /* comment to avoid optimizations and reduce size */
44
45 #ifdef __ECOS
46 #include <pkgconf/jimtcl.h>
47 #endif
48 #ifndef JIM_ANSIC
49 #define JIM_DYNLIB /* Dynamic library support for UNIX and WIN32 */
50 #endif /* JIM_ANSIC */
51
52 #include <stdio.h>
53 #include <stdlib.h>
54 #include <string.h>
55 #include <stdarg.h>
56 #include <ctype.h>
57 #include <limits.h>
58 #include <assert.h>
59 #include <errno.h>
60 #include <time.h>
61 #if defined(WIN32)
62 /* sys/time - need is different */
63 #else
64 #include <sys/time.h> // for gettimeofday()
65 #endif
66
67 #include "replacements.h"
68
69 /* Include the platform dependent libraries for
70 * dynamic loading of libraries. */
71 #ifdef JIM_DYNLIB
72 #if defined(_WIN32) || defined(WIN32)
73 #ifndef WIN32
74 #define WIN32 1
75 #endif
76 #ifndef STRICT
77 #define STRICT
78 #endif
79 #define WIN32_LEAN_AND_MEAN
80 #include <windows.h>
81 #if _MSC_VER >= 1000
82 #pragma warning(disable:4146)
83 #endif /* _MSC_VER */
84 #else
85 #include <dlfcn.h>
86 #endif /* WIN32 */
87 #endif /* JIM_DYNLIB */
88
89 #ifndef WIN32
90 #include <unistd.h>
91 #endif
92
93 #ifdef __ECOS
94 #include <cyg/jimtcl/jim.h>
95 #else
96 #include "jim.h"
97 #endif
98
99 #ifdef HAVE_BACKTRACE
100 #include <execinfo.h>
101 #endif
102
103 /* -----------------------------------------------------------------------------
104 * Global variables
105 * ---------------------------------------------------------------------------*/
106
107 /* A shared empty string for the objects string representation.
108 * Jim_InvalidateStringRep knows about it and don't try to free. */
109 static char *JimEmptyStringRep = (char*) "";
110
111 /* -----------------------------------------------------------------------------
112 * Required prototypes of not exported functions
113 * ---------------------------------------------------------------------------*/
114 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf);
115 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int flags);
116 static void JimRegisterCoreApi(Jim_Interp *interp);
117
118 static Jim_HashTableType JimVariablesHashTableType;
119
120 /* -----------------------------------------------------------------------------
121 * Utility functions
122 * ---------------------------------------------------------------------------*/
123
124 static char *
125 jim_vasprintf( const char *fmt, va_list ap )
126 {
127 #ifndef HAVE_VASPRINTF
128 /* yucky way */
129 static char buf[2048];
130 vsnprintf( buf, sizeof(buf), fmt, ap );
131 /* garentee termination */
132 buf[sizeof(buf)-1] = 0;
133 #else
134 char *buf;
135 vasprintf( &buf, fmt, ap );
136 #endif
137 return buf;
138 }
139
140 static void
141 jim_vasprintf_done( void *buf )
142 {
143 #ifndef HAVE_VASPRINTF
144 (void)(buf);
145 #else
146 free(buf);
147 #endif
148 }
149
150
151 /*
152 * Convert a string to a jim_wide INTEGER.
153 * This function originates from BSD.
154 *
155 * Ignores `locale' stuff. Assumes that the upper and lower case
156 * alphabets and digits are each contiguous.
157 */
158 #ifdef HAVE_LONG_LONG
159 #define JimIsAscii(c) (((c) & ~0x7f) == 0)
160 static jim_wide JimStrtoll(const char *nptr, char **endptr, register int base)
161 {
162 register const char *s;
163 register unsigned jim_wide acc;
164 register unsigned char c;
165 register unsigned jim_wide qbase, cutoff;
166 register int neg, any, cutlim;
167
168 /*
169 * Skip white space and pick up leading +/- sign if any.
170 * If base is 0, allow 0x for hex and 0 for octal, else
171 * assume decimal; if base is already 16, allow 0x.
172 */
173 s = nptr;
174 do {
175 c = *s++;
176 } while (isspace(c));
177 if (c == '-') {
178 neg = 1;
179 c = *s++;
180 } else {
181 neg = 0;
182 if (c == '+')
183 c = *s++;
184 }
185 if ((base == 0 || base == 16) &&
186 c == '0' && (*s == 'x' || *s == 'X')) {
187 c = s[1];
188 s += 2;
189 base = 16;
190 }
191 if (base == 0)
192 base = c == '0' ? 8 : 10;
193
194 /*
195 * Compute the cutoff value between legal numbers and illegal
196 * numbers. That is the largest legal value, divided by the
197 * base. An input number that is greater than this value, if
198 * followed by a legal input character, is too big. One that
199 * is equal to this value may be valid or not; the limit
200 * between valid and invalid numbers is then based on the last
201 * digit. For instance, if the range for quads is
202 * [-9223372036854775808..9223372036854775807] and the input base
203 * is 10, cutoff will be set to 922337203685477580 and cutlim to
204 * either 7 (neg==0) or 8 (neg==1), meaning that if we have
205 * accumulated a value > 922337203685477580, or equal but the
206 * next digit is > 7 (or 8), the number is too big, and we will
207 * return a range error.
208 *
209 * Set any if any `digits' consumed; make it negative to indicate
210 * overflow.
211 */
212 qbase = (unsigned)base;
213 cutoff = neg ? (unsigned jim_wide)-(LLONG_MIN + LLONG_MAX) + LLONG_MAX
214 : LLONG_MAX;
215 cutlim = (int)(cutoff % qbase);
216 cutoff /= qbase;
217 for (acc = 0, any = 0;; c = *s++) {
218 if (!JimIsAscii(c))
219 break;
220 if (isdigit(c))
221 c -= '0';
222 else if (isalpha(c))
223 c -= isupper(c) ? 'A' - 10 : 'a' - 10;
224 else
225 break;
226 if (c >= base)
227 break;
228 if (any < 0 || acc > cutoff || (acc == cutoff && c > cutlim))
229 any = -1;
230 else {
231 any = 1;
232 acc *= qbase;
233 acc += c;
234 }
235 }
236 if (any < 0) {
237 acc = neg ? LLONG_MIN : LLONG_MAX;
238 errno = ERANGE;
239 } else if (neg)
240 acc = -acc;
241 if (endptr != 0)
242 *endptr = (char *)(any ? s - 1 : nptr);
243 return (acc);
244 }
245 #endif
246
247 /* Glob-style pattern matching. */
248 static int JimStringMatch(const char *pattern, int patternLen,
249 const char *string, int stringLen, int nocase)
250 {
251 while(patternLen) {
252 switch(pattern[0]) {
253 case '*':
254 while (pattern[1] == '*') {
255 pattern++;
256 patternLen--;
257 }
258 if (patternLen == 1)
259 return 1; /* match */
260 while(stringLen) {
261 if (JimStringMatch(pattern+1, patternLen-1,
262 string, stringLen, nocase))
263 return 1; /* match */
264 string++;
265 stringLen--;
266 }
267 return 0; /* no match */
268 break;
269 case '?':
270 if (stringLen == 0)
271 return 0; /* no match */
272 string++;
273 stringLen--;
274 break;
275 case '[':
276 {
277 int not, match;
278
279 pattern++;
280 patternLen--;
281 not = pattern[0] == '^';
282 if (not) {
283 pattern++;
284 patternLen--;
285 }
286 match = 0;
287 while(1) {
288 if (pattern[0] == '\\') {
289 pattern++;
290 patternLen--;
291 if (pattern[0] == string[0])
292 match = 1;
293 } else if (pattern[0] == ']') {
294 break;
295 } else if (patternLen == 0) {
296 pattern--;
297 patternLen++;
298 break;
299 } else if (pattern[1] == '-' && patternLen >= 3) {
300 int start = pattern[0];
301 int end = pattern[2];
302 int c = string[0];
303 if (start > end) {
304 int t = start;
305 start = end;
306 end = t;
307 }
308 if (nocase) {
309 start = tolower(start);
310 end = tolower(end);
311 c = tolower(c);
312 }
313 pattern += 2;
314 patternLen -= 2;
315 if (c >= start && c <= end)
316 match = 1;
317 } else {
318 if (!nocase) {
319 if (pattern[0] == string[0])
320 match = 1;
321 } else {
322 if (tolower((int)pattern[0]) == tolower((int)string[0]))
323 match = 1;
324 }
325 }
326 pattern++;
327 patternLen--;
328 }
329 if (not)
330 match = !match;
331 if (!match)
332 return 0; /* no match */
333 string++;
334 stringLen--;
335 break;
336 }
337 case '\\':
338 if (patternLen >= 2) {
339 pattern++;
340 patternLen--;
341 }
342 /* fall through */
343 default:
344 if (!nocase) {
345 if (pattern[0] != string[0])
346 return 0; /* no match */
347 } else {
348 if (tolower((int)pattern[0]) != tolower((int)string[0]))
349 return 0; /* no match */
350 }
351 string++;
352 stringLen--;
353 break;
354 }
355 pattern++;
356 patternLen--;
357 if (stringLen == 0) {
358 while(*pattern == '*') {
359 pattern++;
360 patternLen--;
361 }
362 break;
363 }
364 }
365 if (patternLen == 0 && stringLen == 0)
366 return 1;
367 return 0;
368 }
369
370 int JimStringCompare(const char *s1, int l1, const char *s2, int l2,
371 int nocase)
372 {
373 unsigned char *u1 = (unsigned char*) s1, *u2 = (unsigned char*) s2;
374
375 if (nocase == 0) {
376 while(l1 && l2) {
377 if (*u1 != *u2)
378 return (int)*u1-*u2;
379 u1++; u2++; l1--; l2--;
380 }
381 if (!l1 && !l2) return 0;
382 return l1-l2;
383 } else {
384 while(l1 && l2) {
385 if (tolower((int)*u1) != tolower((int)*u2))
386 return tolower((int)*u1)-tolower((int)*u2);
387 u1++; u2++; l1--; l2--;
388 }
389 if (!l1 && !l2) return 0;
390 return l1-l2;
391 }
392 }
393
394 /* Search 's1' inside 's2', starting to search from char 'index' of 's2'.
395 * The index of the first occurrence of s1 in s2 is returned.
396 * If s1 is not found inside s2, -1 is returned. */
397 int JimStringFirst(const char *s1, int l1, const char *s2, int l2, int index)
398 {
399 int i;
400
401 if (!l1 || !l2 || l1 > l2) return -1;
402 if (index < 0) index = 0;
403 s2 += index;
404 for (i = index; i <= l2-l1; i++) {
405 if (memcmp(s2, s1, l1) == 0)
406 return i;
407 s2++;
408 }
409 return -1;
410 }
411
412 int Jim_WideToString(char *buf, jim_wide wideValue)
413 {
414 const char *fmt = "%" JIM_WIDE_MODIFIER;
415 return sprintf(buf, fmt, wideValue);
416 }
417
418 int Jim_StringToWide(const char *str, jim_wide *widePtr, int base)
419 {
420 char *endptr;
421
422 #ifdef HAVE_LONG_LONG
423 *widePtr = JimStrtoll(str, &endptr, base);
424 #else
425 *widePtr = strtol(str, &endptr, base);
426 #endif
427 if ((str[0] == '\0') || (str == endptr) )
428 return JIM_ERR;
429 if (endptr[0] != '\0') {
430 while(*endptr) {
431 if (!isspace((int)*endptr))
432 return JIM_ERR;
433 endptr++;
434 }
435 }
436 return JIM_OK;
437 }
438
439 int Jim_StringToIndex(const char *str, int *intPtr)
440 {
441 char *endptr;
442
443 *intPtr = strtol(str, &endptr, 10);
444 if ( (str[0] == '\0') || (str == endptr) )
445 return JIM_ERR;
446 if (endptr[0] != '\0') {
447 while(*endptr) {
448 if (!isspace((int)*endptr))
449 return JIM_ERR;
450 endptr++;
451 }
452 }
453 return JIM_OK;
454 }
455
456 /* The string representation of references has two features in order
457 * to make the GC faster. The first is that every reference starts
458 * with a non common character '~', in order to make the string matching
459 * fater. The second is that the reference string rep his 32 characters
460 * in length, this allows to avoid to check every object with a string
461 * repr < 32, and usually there are many of this objects. */
462
463 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
464
465 static int JimFormatReference(char *buf, Jim_Reference *refPtr, jim_wide id)
466 {
467 const char *fmt = "<reference.<%s>.%020" JIM_WIDE_MODIFIER ">";
468 sprintf(buf, fmt, refPtr->tag, id);
469 return JIM_REFERENCE_SPACE;
470 }
471
472 int Jim_DoubleToString(char *buf, double doubleValue)
473 {
474 char *s;
475 int len;
476
477 len = sprintf(buf, "%.17g", doubleValue);
478 s = buf;
479 while(*s) {
480 if (*s == '.') return len;
481 s++;
482 }
483 /* Add a final ".0" if it's a number. But not
484 * for NaN or InF */
485 if (isdigit((int)buf[0])
486 || ((buf[0] == '-' || buf[0] == '+')
487 && isdigit((int)buf[1]))) {
488 s[0] = '.';
489 s[1] = '0';
490 s[2] = '\0';
491 return len+2;
492 }
493 return len;
494 }
495
496 int Jim_StringToDouble(const char *str, double *doublePtr)
497 {
498 char *endptr;
499
500 *doublePtr = strtod(str, &endptr);
501 if (str[0] == '\0' || endptr[0] != '\0' || (str == endptr) )
502 return JIM_ERR;
503 return JIM_OK;
504 }
505
506 static jim_wide JimPowWide(jim_wide b, jim_wide e)
507 {
508 jim_wide i, res = 1;
509 if ((b==0 && e!=0) || (e<0)) return 0;
510 for(i=0; i<e; i++) {res *= b;}
511 return res;
512 }
513
514 /* -----------------------------------------------------------------------------
515 * Special functions
516 * ---------------------------------------------------------------------------*/
517
518 /* Note that 'interp' may be NULL if not available in the
519 * context of the panic. It's only useful to get the error
520 * file descriptor, it will default to stderr otherwise. */
521 void Jim_Panic(Jim_Interp *interp, const char *fmt, ...)
522 {
523 va_list ap;
524
525 va_start(ap, fmt);
526 /*
527 * Send it here first.. Assuming STDIO still works
528 */
529 fprintf(stderr, JIM_NL "JIM INTERPRETER PANIC: ");
530 vfprintf(stderr, fmt, ap);
531 fprintf(stderr, JIM_NL JIM_NL);
532 va_end(ap);
533
534 #ifdef HAVE_BACKTRACE
535 {
536 void *array[40];
537 int size, i;
538 char **strings;
539
540 size = backtrace(array, 40);
541 strings = backtrace_symbols(array, size);
542 for (i = 0; i < size; i++)
543 fprintf(fp,"[backtrace] %s" JIM_NL, strings[i]);
544 fprintf(fp,"[backtrace] Include the above lines and the output" JIM_NL);
545 fprintf(fp,"[backtrace] of 'nm <executable>' in the bug report." JIM_NL);
546 }
547 #endif
548
549 /* This may actually crash... we do it last */
550 if( interp && interp->cookie_stderr ){
551 Jim_fprintf( interp, interp->cookie_stderr, JIM_NL "JIM INTERPRETER PANIC: ");
552 Jim_vfprintf( interp, interp->cookie_stderr, fmt, ap );
553 Jim_fprintf( interp, interp->cookie_stderr, JIM_NL JIM_NL );
554 }
555 abort();
556 }
557
558 /* -----------------------------------------------------------------------------
559 * Memory allocation
560 * ---------------------------------------------------------------------------*/
561
562 /* Macro used for memory debugging.
563 * In order for they to work you have to rename Jim_Alloc into _Jim_Alloc
564 * and similary for Jim_Realloc and Jim_Free */
565 #if 0
566 #define Jim_Alloc(s) (printf("%s %d: Jim_Alloc(%d)\n",__FILE__,__LINE__,s),_Jim_Alloc(s))
567 #define Jim_Free(p) (printf("%s %d: Jim_Free(%p)\n",__FILE__,__LINE__,p),_Jim_Free(p))
568 #define Jim_Realloc(p,s) (printf("%s %d: Jim_Realloc(%p,%d)\n",__FILE__,__LINE__,p,s),_Jim_Realloc(p,s))
569 #endif
570
571 void *Jim_Alloc(int size)
572 {
573 /* We allocate zero length arrayes, etc. to use a single orthogonal codepath */
574 if (size==0)
575 size=1;
576 void *p = malloc(size);
577 if (p == NULL)
578 Jim_Panic(NULL,"malloc: Out of memory");
579 return p;
580 }
581
582 void Jim_Free(void *ptr) {
583 free(ptr);
584 }
585
586 void *Jim_Realloc(void *ptr, int size)
587 {
588 /* We allocate zero length arrayes, etc. to use a single orthogonal codepath */
589 if (size==0)
590 size=1;
591 void *p = realloc(ptr, size);
592 if (p == NULL)
593 Jim_Panic(NULL,"realloc: Out of memory");
594 return p;
595 }
596
597 char *Jim_StrDup(const char *s)
598 {
599 int l = strlen(s);
600 char *copy = Jim_Alloc(l+1);
601
602 memcpy(copy, s, l+1);
603 return copy;
604 }
605
606 char *Jim_StrDupLen(const char *s, int l)
607 {
608 char *copy = Jim_Alloc(l+1);
609
610 memcpy(copy, s, l+1);
611 copy[l] = 0; /* Just to be sure, original could be substring */
612 return copy;
613 }
614
615 /* -----------------------------------------------------------------------------
616 * Time related functions
617 * ---------------------------------------------------------------------------*/
618 /* Returns microseconds of CPU used since start. */
619 static jim_wide JimClock(void)
620 {
621 #if (defined WIN32) && !(defined JIM_ANSIC)
622 LARGE_INTEGER t, f;
623 QueryPerformanceFrequency(&f);
624 QueryPerformanceCounter(&t);
625 return (long)((t.QuadPart * 1000000) / f.QuadPart);
626 #else /* !WIN32 */
627 clock_t clocks = clock();
628
629 return (long)(clocks*(1000000/CLOCKS_PER_SEC));
630 #endif /* WIN32 */
631 }
632
633 /* -----------------------------------------------------------------------------
634 * Hash Tables
635 * ---------------------------------------------------------------------------*/
636
637 /* -------------------------- private prototypes ---------------------------- */
638 static int JimExpandHashTableIfNeeded(Jim_HashTable *ht);
639 static unsigned int JimHashTableNextPower(unsigned int size);
640 static int JimInsertHashEntry(Jim_HashTable *ht, const void *key);
641
642 /* -------------------------- hash functions -------------------------------- */
643
644 /* Thomas Wang's 32 bit Mix Function */
645 unsigned int Jim_IntHashFunction(unsigned int key)
646 {
647 key += ~(key << 15);
648 key ^= (key >> 10);
649 key += (key << 3);
650 key ^= (key >> 6);
651 key += ~(key << 11);
652 key ^= (key >> 16);
653 return key;
654 }
655
656 /* Identity hash function for integer keys */
657 unsigned int Jim_IdentityHashFunction(unsigned int key)
658 {
659 return key;
660 }
661
662 /* Generic hash function (we are using to multiply by 9 and add the byte
663 * as Tcl) */
664 unsigned int Jim_GenHashFunction(const unsigned char *buf, int len)
665 {
666 unsigned int h = 0;
667 while(len--)
668 h += (h<<3)+*buf++;
669 return h;
670 }
671
672 /* ----------------------------- API implementation ------------------------- */
673 /* reset an hashtable already initialized with ht_init().
674 * NOTE: This function should only called by ht_destroy(). */
675 static void JimResetHashTable(Jim_HashTable *ht)
676 {
677 ht->table = NULL;
678 ht->size = 0;
679 ht->sizemask = 0;
680 ht->used = 0;
681 ht->collisions = 0;
682 }
683
684 /* Initialize the hash table */
685 int Jim_InitHashTable(Jim_HashTable *ht, Jim_HashTableType *type,
686 void *privDataPtr)
687 {
688 JimResetHashTable(ht);
689 ht->type = type;
690 ht->privdata = privDataPtr;
691 return JIM_OK;
692 }
693
694 /* Resize the table to the minimal size that contains all the elements,
695 * but with the invariant of a USER/BUCKETS ration near to <= 1 */
696 int Jim_ResizeHashTable(Jim_HashTable *ht)
697 {
698 int minimal = ht->used;
699
700 if (minimal < JIM_HT_INITIAL_SIZE)
701 minimal = JIM_HT_INITIAL_SIZE;
702 return Jim_ExpandHashTable(ht, minimal);
703 }
704
705 /* Expand or create the hashtable */
706 int Jim_ExpandHashTable(Jim_HashTable *ht, unsigned int size)
707 {
708 Jim_HashTable n; /* the new hashtable */
709 unsigned int realsize = JimHashTableNextPower(size), i;
710
711 /* the size is invalid if it is smaller than the number of
712 * elements already inside the hashtable */
713 if (ht->used >= size)
714 return JIM_ERR;
715
716 Jim_InitHashTable(&n, ht->type, ht->privdata);
717 n.size = realsize;
718 n.sizemask = realsize-1;
719 n.table = Jim_Alloc(realsize*sizeof(Jim_HashEntry*));
720
721 /* Initialize all the pointers to NULL */
722 memset(n.table, 0, realsize*sizeof(Jim_HashEntry*));
723
724 /* Copy all the elements from the old to the new table:
725 * note that if the old hash table is empty ht->size is zero,
726 * so Jim_ExpandHashTable just creates an hash table. */
727 n.used = ht->used;
728 for (i = 0; i < ht->size && ht->used > 0; i++) {
729 Jim_HashEntry *he, *nextHe;
730
731 if (ht->table[i] == NULL) continue;
732
733 /* For each hash entry on this slot... */
734 he = ht->table[i];
735 while(he) {
736 unsigned int h;
737
738 nextHe = he->next;
739 /* Get the new element index */
740 h = Jim_HashKey(ht, he->key) & n.sizemask;
741 he->next = n.table[h];
742 n.table[h] = he;
743 ht->used--;
744 /* Pass to the next element */
745 he = nextHe;
746 }
747 }
748 assert(ht->used == 0);
749 Jim_Free(ht->table);
750
751 /* Remap the new hashtable in the old */
752 *ht = n;
753 return JIM_OK;
754 }
755
756 /* Add an element to the target hash table */
757 int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val)
758 {
759 int index;
760 Jim_HashEntry *entry;
761
762 /* Get the index of the new element, or -1 if
763 * the element already exists. */
764 if ((index = JimInsertHashEntry(ht, key)) == -1)
765 return JIM_ERR;
766
767 /* Allocates the memory and stores key */
768 entry = Jim_Alloc(sizeof(*entry));
769 entry->next = ht->table[index];
770 ht->table[index] = entry;
771
772 /* Set the hash entry fields. */
773 Jim_SetHashKey(ht, entry, key);
774 Jim_SetHashVal(ht, entry, val);
775 ht->used++;
776 return JIM_OK;
777 }
778
779 /* Add an element, discarding the old if the key already exists */
780 int Jim_ReplaceHashEntry(Jim_HashTable *ht, const void *key, void *val)
781 {
782 Jim_HashEntry *entry;
783
784 /* Try to add the element. If the key
785 * does not exists Jim_AddHashEntry will suceed. */
786 if (Jim_AddHashEntry(ht, key, val) == JIM_OK)
787 return JIM_OK;
788 /* It already exists, get the entry */
789 entry = Jim_FindHashEntry(ht, key);
790 /* Free the old value and set the new one */
791 Jim_FreeEntryVal(ht, entry);
792 Jim_SetHashVal(ht, entry, val);
793 return JIM_OK;
794 }
795
796 /* Search and remove an element */
797 int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key)
798 {
799 unsigned int h;
800 Jim_HashEntry *he, *prevHe;
801
802 if (ht->size == 0)
803 return JIM_ERR;
804 h = Jim_HashKey(ht, key) & ht->sizemask;
805 he = ht->table[h];
806
807 prevHe = NULL;
808 while(he) {
809 if (Jim_CompareHashKeys(ht, key, he->key)) {
810 /* Unlink the element from the list */
811 if (prevHe)
812 prevHe->next = he->next;
813 else
814 ht->table[h] = he->next;
815 Jim_FreeEntryKey(ht, he);
816 Jim_FreeEntryVal(ht, he);
817 Jim_Free(he);
818 ht->used--;
819 return JIM_OK;
820 }
821 prevHe = he;
822 he = he->next;
823 }
824 return JIM_ERR; /* not found */
825 }
826
827 /* Destroy an entire hash table */
828 int Jim_FreeHashTable(Jim_HashTable *ht)
829 {
830 unsigned int i;
831
832 /* Free all the elements */
833 for (i = 0; i < ht->size && ht->used > 0; i++) {
834 Jim_HashEntry *he, *nextHe;
835
836 if ((he = ht->table[i]) == NULL) continue;
837 while(he) {
838 nextHe = he->next;
839 Jim_FreeEntryKey(ht, he);
840 Jim_FreeEntryVal(ht, he);
841 Jim_Free(he);
842 ht->used--;
843 he = nextHe;
844 }
845 }
846 /* Free the table and the allocated cache structure */
847 Jim_Free(ht->table);
848 /* Re-initialize the table */
849 JimResetHashTable(ht);
850 return JIM_OK; /* never fails */
851 }
852
853 Jim_HashEntry *Jim_FindHashEntry(Jim_HashTable *ht, const void *key)
854 {
855 Jim_HashEntry *he;
856 unsigned int h;
857
858 if (ht->size == 0) return NULL;
859 h = Jim_HashKey(ht, key) & ht->sizemask;
860 he = ht->table[h];
861 while(he) {
862 if (Jim_CompareHashKeys(ht, key, he->key))
863 return he;
864 he = he->next;
865 }
866 return NULL;
867 }
868
869 Jim_HashTableIterator *Jim_GetHashTableIterator(Jim_HashTable *ht)
870 {
871 Jim_HashTableIterator *iter = Jim_Alloc(sizeof(*iter));
872
873 iter->ht = ht;
874 iter->index = -1;
875 iter->entry = NULL;
876 iter->nextEntry = NULL;
877 return iter;
878 }
879
880 Jim_HashEntry *Jim_NextHashEntry(Jim_HashTableIterator *iter)
881 {
882 while (1) {
883 if (iter->entry == NULL) {
884 iter->index++;
885 if (iter->index >=
886 (signed)iter->ht->size) break;
887 iter->entry = iter->ht->table[iter->index];
888 } else {
889 iter->entry = iter->nextEntry;
890 }
891 if (iter->entry) {
892 /* We need to save the 'next' here, the iterator user
893 * may delete the entry we are returning. */
894 iter->nextEntry = iter->entry->next;
895 return iter->entry;
896 }
897 }
898 return NULL;
899 }
900
901 /* ------------------------- private functions ------------------------------ */
902
903 /* Expand the hash table if needed */
904 static int JimExpandHashTableIfNeeded(Jim_HashTable *ht)
905 {
906 /* If the hash table is empty expand it to the intial size,
907 * if the table is "full" dobule its size. */
908 if (ht->size == 0)
909 return Jim_ExpandHashTable(ht, JIM_HT_INITIAL_SIZE);
910 if (ht->size == ht->used)
911 return Jim_ExpandHashTable(ht, ht->size*2);
912 return JIM_OK;
913 }
914
915 /* Our hash table capability is a power of two */
916 static unsigned int JimHashTableNextPower(unsigned int size)
917 {
918 unsigned int i = JIM_HT_INITIAL_SIZE;
919
920 if (size >= 2147483648U)
921 return 2147483648U;
922 while(1) {
923 if (i >= size)
924 return i;
925 i *= 2;
926 }
927 }
928
929 /* Returns the index of a free slot that can be populated with
930 * an hash entry for the given 'key'.
931 * If the key already exists, -1 is returned. */
932 static int JimInsertHashEntry(Jim_HashTable *ht, const void *key)
933 {
934 unsigned int h;
935 Jim_HashEntry *he;
936
937 /* Expand the hashtable if needed */
938 if (JimExpandHashTableIfNeeded(ht) == JIM_ERR)
939 return -1;
940 /* Compute the key hash value */
941 h = Jim_HashKey(ht, key) & ht->sizemask;
942 /* Search if this slot does not already contain the given key */
943 he = ht->table[h];
944 while(he) {
945 if (Jim_CompareHashKeys(ht, key, he->key))
946 return -1;
947 he = he->next;
948 }
949 return h;
950 }
951
952 /* ----------------------- StringCopy Hash Table Type ------------------------*/
953
954 static unsigned int JimStringCopyHTHashFunction(const void *key)
955 {
956 return Jim_GenHashFunction(key, strlen(key));
957 }
958
959 static const void *JimStringCopyHTKeyDup(void *privdata, const void *key)
960 {
961 int len = strlen(key);
962 char *copy = Jim_Alloc(len+1);
963 JIM_NOTUSED(privdata);
964
965 memcpy(copy, key, len);
966 copy[len] = '\0';
967 return copy;
968 }
969
970 static void *JimStringKeyValCopyHTValDup(void *privdata, const void *val)
971 {
972 int len = strlen(val);
973 char *copy = Jim_Alloc(len+1);
974 JIM_NOTUSED(privdata);
975
976 memcpy(copy, val, len);
977 copy[len] = '\0';
978 return copy;
979 }
980
981 static int JimStringCopyHTKeyCompare(void *privdata, const void *key1,
982 const void *key2)
983 {
984 JIM_NOTUSED(privdata);
985
986 return strcmp(key1, key2) == 0;
987 }
988
989 static void JimStringCopyHTKeyDestructor(void *privdata, const void *key)
990 {
991 JIM_NOTUSED(privdata);
992
993 Jim_Free((void*)key); /* ATTENTION: const cast */
994 }
995
996 static void JimStringKeyValCopyHTValDestructor(void *privdata, void *val)
997 {
998 JIM_NOTUSED(privdata);
999
1000 Jim_Free((void*)val); /* ATTENTION: const cast */
1001 }
1002
1003 static Jim_HashTableType JimStringCopyHashTableType = {
1004 JimStringCopyHTHashFunction, /* hash function */
1005 JimStringCopyHTKeyDup, /* key dup */
1006 NULL, /* val dup */
1007 JimStringCopyHTKeyCompare, /* key compare */
1008 JimStringCopyHTKeyDestructor, /* key destructor */
1009 NULL /* val destructor */
1010 };
1011
1012 /* This is like StringCopy but does not auto-duplicate the key.
1013 * It's used for intepreter's shared strings. */
1014 static Jim_HashTableType JimSharedStringsHashTableType = {
1015 JimStringCopyHTHashFunction, /* hash function */
1016 NULL, /* key dup */
1017 NULL, /* val dup */
1018 JimStringCopyHTKeyCompare, /* key compare */
1019 JimStringCopyHTKeyDestructor, /* key destructor */
1020 NULL /* val destructor */
1021 };
1022
1023 /* This is like StringCopy but also automatically handle dynamic
1024 * allocated C strings as values. */
1025 static Jim_HashTableType JimStringKeyValCopyHashTableType = {
1026 JimStringCopyHTHashFunction, /* hash function */
1027 JimStringCopyHTKeyDup, /* key dup */
1028 JimStringKeyValCopyHTValDup, /* val dup */
1029 JimStringCopyHTKeyCompare, /* key compare */
1030 JimStringCopyHTKeyDestructor, /* key destructor */
1031 JimStringKeyValCopyHTValDestructor, /* val destructor */
1032 };
1033
1034 typedef struct AssocDataValue {
1035 Jim_InterpDeleteProc *delProc;
1036 void *data;
1037 } AssocDataValue;
1038
1039 static void JimAssocDataHashTableValueDestructor(void *privdata, void *data)
1040 {
1041 AssocDataValue *assocPtr = (AssocDataValue *)data;
1042 if (assocPtr->delProc != NULL)
1043 assocPtr->delProc((Jim_Interp *)privdata, assocPtr->data);
1044 Jim_Free(data);
1045 }
1046
1047 static Jim_HashTableType JimAssocDataHashTableType = {
1048 JimStringCopyHTHashFunction, /* hash function */
1049 JimStringCopyHTKeyDup, /* key dup */
1050 NULL, /* val dup */
1051 JimStringCopyHTKeyCompare, /* key compare */
1052 JimStringCopyHTKeyDestructor, /* key destructor */
1053 JimAssocDataHashTableValueDestructor /* val destructor */
1054 };
1055
1056 /* -----------------------------------------------------------------------------
1057 * Stack - This is a simple generic stack implementation. It is used for
1058 * example in the 'expr' expression compiler.
1059 * ---------------------------------------------------------------------------*/
1060 void Jim_InitStack(Jim_Stack *stack)
1061 {
1062 stack->len = 0;
1063 stack->maxlen = 0;
1064 stack->vector = NULL;
1065 }
1066
1067 void Jim_FreeStack(Jim_Stack *stack)
1068 {
1069 Jim_Free(stack->vector);
1070 }
1071
1072 int Jim_StackLen(Jim_Stack *stack)
1073 {
1074 return stack->len;
1075 }
1076
1077 void Jim_StackPush(Jim_Stack *stack, void *element) {
1078 int neededLen = stack->len+1;
1079 if (neededLen > stack->maxlen) {
1080 stack->maxlen = neededLen*2;
1081 stack->vector = Jim_Realloc(stack->vector, sizeof(void*)*stack->maxlen);
1082 }
1083 stack->vector[stack->len] = element;
1084 stack->len++;
1085 }
1086
1087 void *Jim_StackPop(Jim_Stack *stack)
1088 {
1089 if (stack->len == 0) return NULL;
1090 stack->len--;
1091 return stack->vector[stack->len];
1092 }
1093
1094 void *Jim_StackPeek(Jim_Stack *stack)
1095 {
1096 if (stack->len == 0) return NULL;
1097 return stack->vector[stack->len-1];
1098 }
1099
1100 void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc)(void *ptr))
1101 {
1102 int i;
1103
1104 for (i = 0; i < stack->len; i++)
1105 freeFunc(stack->vector[i]);
1106 }
1107
1108 /* -----------------------------------------------------------------------------
1109 * Parser
1110 * ---------------------------------------------------------------------------*/
1111
1112 /* Token types */
1113 #define JIM_TT_NONE -1 /* No token returned */
1114 #define JIM_TT_STR 0 /* simple string */
1115 #define JIM_TT_ESC 1 /* string that needs escape chars conversion */
1116 #define JIM_TT_VAR 2 /* var substitution */
1117 #define JIM_TT_DICTSUGAR 3 /* Syntax sugar for [dict get], $foo(bar) */
1118 #define JIM_TT_CMD 4 /* command substitution */
1119 #define JIM_TT_SEP 5 /* word separator */
1120 #define JIM_TT_EOL 6 /* line separator */
1121
1122 /* Additional token types needed for expressions */
1123 #define JIM_TT_SUBEXPR_START 7
1124 #define JIM_TT_SUBEXPR_END 8
1125 #define JIM_TT_EXPR_NUMBER 9
1126 #define JIM_TT_EXPR_OPERATOR 10
1127
1128 /* Parser states */
1129 #define JIM_PS_DEF 0 /* Default state */
1130 #define JIM_PS_QUOTE 1 /* Inside "" */
1131
1132 /* Parser context structure. The same context is used both to parse
1133 * Tcl scripts and lists. */
1134 struct JimParserCtx {
1135 const char *prg; /* Program text */
1136 const char *p; /* Pointer to the point of the program we are parsing */
1137 int len; /* Left length of 'prg' */
1138 int linenr; /* Current line number */
1139 const char *tstart;
1140 const char *tend; /* Returned token is at tstart-tend in 'prg'. */
1141 int tline; /* Line number of the returned token */
1142 int tt; /* Token type */
1143 int eof; /* Non zero if EOF condition is true. */
1144 int state; /* Parser state */
1145 int comment; /* Non zero if the next chars may be a comment. */
1146 };
1147
1148 #define JimParserEof(c) ((c)->eof)
1149 #define JimParserTstart(c) ((c)->tstart)
1150 #define JimParserTend(c) ((c)->tend)
1151 #define JimParserTtype(c) ((c)->tt)
1152 #define JimParserTline(c) ((c)->tline)
1153
1154 static int JimParseScript(struct JimParserCtx *pc);
1155 static int JimParseSep(struct JimParserCtx *pc);
1156 static int JimParseEol(struct JimParserCtx *pc);
1157 static int JimParseCmd(struct JimParserCtx *pc);
1158 static int JimParseVar(struct JimParserCtx *pc);
1159 static int JimParseBrace(struct JimParserCtx *pc);
1160 static int JimParseStr(struct JimParserCtx *pc);
1161 static int JimParseComment(struct JimParserCtx *pc);
1162 static char *JimParserGetToken(struct JimParserCtx *pc,
1163 int *lenPtr, int *typePtr, int *linePtr);
1164
1165 /* Initialize a parser context.
1166 * 'prg' is a pointer to the program text, linenr is the line
1167 * number of the first line contained in the program. */
1168 void JimParserInit(struct JimParserCtx *pc, const char *prg,
1169 int len, int linenr)
1170 {
1171 pc->prg = prg;
1172 pc->p = prg;
1173 pc->len = len;
1174 pc->tstart = NULL;
1175 pc->tend = NULL;
1176 pc->tline = 0;
1177 pc->tt = JIM_TT_NONE;
1178 pc->eof = 0;
1179 pc->state = JIM_PS_DEF;
1180 pc->linenr = linenr;
1181 pc->comment = 1;
1182 }
1183
1184 int JimParseScript(struct JimParserCtx *pc)
1185 {
1186 while(1) { /* the while is used to reiterate with continue if needed */
1187 if (!pc->len) {
1188 pc->tstart = pc->p;
1189 pc->tend = pc->p-1;
1190 pc->tline = pc->linenr;
1191 pc->tt = JIM_TT_EOL;
1192 pc->eof = 1;
1193 return JIM_OK;
1194 }
1195 switch(*(pc->p)) {
1196 case '\\':
1197 if (*(pc->p+1) == '\n')
1198 return JimParseSep(pc);
1199 else {
1200 pc->comment = 0;
1201 return JimParseStr(pc);
1202 }
1203 break;
1204 case ' ':
1205 case '\t':
1206 case '\r':
1207 if (pc->state == JIM_PS_DEF)
1208 return JimParseSep(pc);
1209 else {
1210 pc->comment = 0;
1211 return JimParseStr(pc);
1212 }
1213 break;
1214 case '\n':
1215 case ';':
1216 pc->comment = 1;
1217 if (pc->state == JIM_PS_DEF)
1218 return JimParseEol(pc);
1219 else
1220 return JimParseStr(pc);
1221 break;
1222 case '[':
1223 pc->comment = 0;
1224 return JimParseCmd(pc);
1225 break;
1226 case '$':
1227 pc->comment = 0;
1228 if (JimParseVar(pc) == JIM_ERR) {
1229 pc->tstart = pc->tend = pc->p++; pc->len--;
1230 pc->tline = pc->linenr;
1231 pc->tt = JIM_TT_STR;
1232 return JIM_OK;
1233 } else
1234 return JIM_OK;
1235 break;
1236 case '#':
1237 if (pc->comment) {
1238 JimParseComment(pc);
1239 continue;
1240 } else {
1241 return JimParseStr(pc);
1242 }
1243 default:
1244 pc->comment = 0;
1245 return JimParseStr(pc);
1246 break;
1247 }
1248 return JIM_OK;
1249 }
1250 }
1251
1252 int JimParseSep(struct JimParserCtx *pc)
1253 {
1254 pc->tstart = pc->p;
1255 pc->tline = pc->linenr;
1256 while (*pc->p == ' ' || *pc->p == '\t' || *pc->p == '\r' ||
1257 (*pc->p == '\\' && *(pc->p+1) == '\n')) {
1258 if (*pc->p == '\\') {
1259 pc->p++; pc->len--;
1260 pc->linenr++;
1261 }
1262 pc->p++; pc->len--;
1263 }
1264 pc->tend = pc->p-1;
1265 pc->tt = JIM_TT_SEP;
1266 return JIM_OK;
1267 }
1268
1269 int JimParseEol(struct JimParserCtx *pc)
1270 {
1271 pc->tstart = pc->p;
1272 pc->tline = pc->linenr;
1273 while (*pc->p == ' ' || *pc->p == '\n' ||
1274 *pc->p == '\t' || *pc->p == '\r' || *pc->p == ';') {
1275 if (*pc->p == '\n')
1276 pc->linenr++;
1277 pc->p++; pc->len--;
1278 }
1279 pc->tend = pc->p-1;
1280 pc->tt = JIM_TT_EOL;
1281 return JIM_OK;
1282 }
1283
1284 /* Todo. Don't stop if ']' appears inside {} or quoted.
1285 * Also should handle the case of puts [string length "]"] */
1286 int JimParseCmd(struct JimParserCtx *pc)
1287 {
1288 int level = 1;
1289 int blevel = 0;
1290
1291 pc->tstart = ++pc->p; pc->len--;
1292 pc->tline = pc->linenr;
1293 while (1) {
1294 if (pc->len == 0) {
1295 break;
1296 } else if (*pc->p == '[' && blevel == 0) {
1297 level++;
1298 } else if (*pc->p == ']' && blevel == 0) {
1299 level--;
1300 if (!level) break;
1301 } else if (*pc->p == '\\') {
1302 pc->p++; pc->len--;
1303 } else if (*pc->p == '{') {
1304 blevel++;
1305 } else if (*pc->p == '}') {
1306 if (blevel != 0)
1307 blevel--;
1308 } else if (*pc->p == '\n')
1309 pc->linenr++;
1310 pc->p++; pc->len--;
1311 }
1312 pc->tend = pc->p-1;
1313 pc->tt = JIM_TT_CMD;
1314 if (*pc->p == ']') {
1315 pc->p++; pc->len--;
1316 }
1317 return JIM_OK;
1318 }
1319
1320 int JimParseVar(struct JimParserCtx *pc)
1321 {
1322 int brace = 0, stop = 0, ttype = JIM_TT_VAR;
1323
1324 pc->tstart = ++pc->p; pc->len--; /* skip the $ */
1325 pc->tline = pc->linenr;
1326 if (*pc->p == '{') {
1327 pc->tstart = ++pc->p; pc->len--;
1328 brace = 1;
1329 }
1330 if (brace) {
1331 while (!stop) {
1332 if (*pc->p == '}' || pc->len == 0) {
1333 pc->tend = pc->p-1;
1334 stop = 1;
1335 if (pc->len == 0)
1336 break;
1337 }
1338 else if (*pc->p == '\n')
1339 pc->linenr++;
1340 pc->p++; pc->len--;
1341 }
1342 } else {
1343 /* Include leading colons */
1344 while (*pc->p == ':') {
1345 pc->p++;
1346 pc->len--;
1347 }
1348 while (!stop) {
1349 if (!((*pc->p >= 'a' && *pc->p <= 'z') ||
1350 (*pc->p >= 'A' && *pc->p <= 'Z') ||
1351 (*pc->p >= '0' && *pc->p <= '9') || *pc->p == '_'))
1352 stop = 1;
1353 else {
1354 pc->p++; pc->len--;
1355 }
1356 }
1357 /* Parse [dict get] syntax sugar. */
1358 if (*pc->p == '(') {
1359 while (*pc->p != ')' && pc->len) {
1360 pc->p++; pc->len--;
1361 if (*pc->p == '\\' && pc->len >= 2) {
1362 pc->p += 2; pc->len -= 2;
1363 }
1364 }
1365 if (*pc->p != '\0') {
1366 pc->p++; pc->len--;
1367 }
1368 ttype = JIM_TT_DICTSUGAR;
1369 }
1370 pc->tend = pc->p-1;
1371 }
1372 /* Check if we parsed just the '$' character.
1373 * That's not a variable so an error is returned
1374 * to tell the state machine to consider this '$' just
1375 * a string. */
1376 if (pc->tstart == pc->p) {
1377 pc->p--; pc->len++;
1378 return JIM_ERR;
1379 }
1380 pc->tt = ttype;
1381 return JIM_OK;
1382 }
1383
1384 int JimParseBrace(struct JimParserCtx *pc)
1385 {
1386 int level = 1;
1387
1388 pc->tstart = ++pc->p; pc->len--;
1389 pc->tline = pc->linenr;
1390 while (1) {
1391 if (*pc->p == '\\' && pc->len >= 2) {
1392 pc->p++; pc->len--;
1393 if (*pc->p == '\n')
1394 pc->linenr++;
1395 } else if (*pc->p == '{') {
1396 level++;
1397 } else if (pc->len == 0 || *pc->p == '}') {
1398 level--;
1399 if (pc->len == 0 || level == 0) {
1400 pc->tend = pc->p-1;
1401 if (pc->len != 0) {
1402 pc->p++; pc->len--;
1403 }
1404 pc->tt = JIM_TT_STR;
1405 return JIM_OK;
1406 }
1407 } else if (*pc->p == '\n') {
1408 pc->linenr++;
1409 }
1410 pc->p++; pc->len--;
1411 }
1412 return JIM_OK; /* unreached */
1413 }
1414
1415 int JimParseStr(struct JimParserCtx *pc)
1416 {
1417 int newword = (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1418 pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR);
1419 if (newword && *pc->p == '{') {
1420 return JimParseBrace(pc);
1421 } else if (newword && *pc->p == '"') {
1422 pc->state = JIM_PS_QUOTE;
1423 pc->p++; pc->len--;
1424 }
1425 pc->tstart = pc->p;
1426 pc->tline = pc->linenr;
1427 while (1) {
1428 if (pc->len == 0) {
1429 pc->tend = pc->p-1;
1430 pc->tt = JIM_TT_ESC;
1431 return JIM_OK;
1432 }
1433 switch(*pc->p) {
1434 case '\\':
1435 if (pc->state == JIM_PS_DEF &&
1436 *(pc->p+1) == '\n') {
1437 pc->tend = pc->p-1;
1438 pc->tt = JIM_TT_ESC;
1439 return JIM_OK;
1440 }
1441 if (pc->len >= 2) {
1442 pc->p++; pc->len--;
1443 }
1444 break;
1445 case '$':
1446 case '[':
1447 pc->tend = pc->p-1;
1448 pc->tt = JIM_TT_ESC;
1449 return JIM_OK;
1450 case ' ':
1451 case '\t':
1452 case '\n':
1453 case '\r':
1454 case ';':
1455 if (pc->state == JIM_PS_DEF) {
1456 pc->tend = pc->p-1;
1457 pc->tt = JIM_TT_ESC;
1458 return JIM_OK;
1459 } else if (*pc->p == '\n') {
1460 pc->linenr++;
1461 }
1462 break;
1463 case '"':
1464 if (pc->state == JIM_PS_QUOTE) {
1465 pc->tend = pc->p-1;
1466 pc->tt = JIM_TT_ESC;
1467 pc->p++; pc->len--;
1468 pc->state = JIM_PS_DEF;
1469 return JIM_OK;
1470 }
1471 break;
1472 }
1473 pc->p++; pc->len--;
1474 }
1475 return JIM_OK; /* unreached */
1476 }
1477
1478 int JimParseComment(struct JimParserCtx *pc)
1479 {
1480 while (*pc->p) {
1481 if (*pc->p == '\n') {
1482 pc->linenr++;
1483 if (*(pc->p-1) != '\\') {
1484 pc->p++; pc->len--;
1485 return JIM_OK;
1486 }
1487 }
1488 pc->p++; pc->len--;
1489 }
1490 return JIM_OK;
1491 }
1492
1493 /* xdigitval and odigitval are helper functions for JimParserGetToken() */
1494 static int xdigitval(int c)
1495 {
1496 if (c >= '0' && c <= '9') return c-'0';
1497 if (c >= 'a' && c <= 'f') return c-'a'+10;
1498 if (c >= 'A' && c <= 'F') return c-'A'+10;
1499 return -1;
1500 }
1501
1502 static int odigitval(int c)
1503 {
1504 if (c >= '0' && c <= '7') return c-'0';
1505 return -1;
1506 }
1507
1508 /* Perform Tcl escape substitution of 's', storing the result
1509 * string into 'dest'. The escaped string is guaranteed to
1510 * be the same length or shorted than the source string.
1511 * Slen is the length of the string at 's', if it's -1 the string
1512 * length will be calculated by the function.
1513 *
1514 * The function returns the length of the resulting string. */
1515 static int JimEscape(char *dest, const char *s, int slen)
1516 {
1517 char *p = dest;
1518 int i, len;
1519
1520 if (slen == -1)
1521 slen = strlen(s);
1522
1523 for (i = 0; i < slen; i++) {
1524 switch(s[i]) {
1525 case '\\':
1526 switch(s[i+1]) {
1527 case 'a': *p++ = 0x7; i++; break;
1528 case 'b': *p++ = 0x8; i++; break;
1529 case 'f': *p++ = 0xc; i++; break;
1530 case 'n': *p++ = 0xa; i++; break;
1531 case 'r': *p++ = 0xd; i++; break;
1532 case 't': *p++ = 0x9; i++; break;
1533 case 'v': *p++ = 0xb; i++; break;
1534 case '\0': *p++ = '\\'; i++; break;
1535 case '\n': *p++ = ' '; i++; break;
1536 default:
1537 if (s[i+1] == 'x') {
1538 int val = 0;
1539 int c = xdigitval(s[i+2]);
1540 if (c == -1) {
1541 *p++ = 'x';
1542 i++;
1543 break;
1544 }
1545 val = c;
1546 c = xdigitval(s[i+3]);
1547 if (c == -1) {
1548 *p++ = val;
1549 i += 2;
1550 break;
1551 }
1552 val = (val*16)+c;
1553 *p++ = val;
1554 i += 3;
1555 break;
1556 } else if (s[i+1] >= '0' && s[i+1] <= '7')
1557 {
1558 int val = 0;
1559 int c = odigitval(s[i+1]);
1560 val = c;
1561 c = odigitval(s[i+2]);
1562 if (c == -1) {
1563 *p++ = val;
1564 i ++;
1565 break;
1566 }
1567 val = (val*8)+c;
1568 c = odigitval(s[i+3]);
1569 if (c == -1) {
1570 *p++ = val;
1571 i += 2;
1572 break;
1573 }
1574 val = (val*8)+c;
1575 *p++ = val;
1576 i += 3;
1577 } else {
1578 *p++ = s[i+1];
1579 i++;
1580 }
1581 break;
1582 }
1583 break;
1584 default:
1585 *p++ = s[i];
1586 break;
1587 }
1588 }
1589 len = p-dest;
1590 *p++ = '\0';
1591 return len;
1592 }
1593
1594 /* Returns a dynamically allocated copy of the current token in the
1595 * parser context. The function perform conversion of escapes if
1596 * the token is of type JIM_TT_ESC.
1597 *
1598 * Note that after the conversion, tokens that are grouped with
1599 * braces in the source code, are always recognizable from the
1600 * identical string obtained in a different way from the type.
1601 *
1602 * For exmple the string:
1603 *
1604 * {expand}$a
1605 *
1606 * will return as first token "expand", of type JIM_TT_STR
1607 *
1608 * While the string:
1609 *
1610 * expand$a
1611 *
1612 * will return as first token "expand", of type JIM_TT_ESC
1613 */
1614 char *JimParserGetToken(struct JimParserCtx *pc,
1615 int *lenPtr, int *typePtr, int *linePtr)
1616 {
1617 const char *start, *end;
1618 char *token;
1619 int len;
1620
1621 start = JimParserTstart(pc);
1622 end = JimParserTend(pc);
1623 if (start > end) {
1624 if (lenPtr) *lenPtr = 0;
1625 if (typePtr) *typePtr = JimParserTtype(pc);
1626 if (linePtr) *linePtr = JimParserTline(pc);
1627 token = Jim_Alloc(1);
1628 token[0] = '\0';
1629 return token;
1630 }
1631 len = (end-start)+1;
1632 token = Jim_Alloc(len+1);
1633 if (JimParserTtype(pc) != JIM_TT_ESC) {
1634 /* No escape conversion needed? Just copy it. */
1635 memcpy(token, start, len);
1636 token[len] = '\0';
1637 } else {
1638 /* Else convert the escape chars. */
1639 len = JimEscape(token, start, len);
1640 }
1641 if (lenPtr) *lenPtr = len;
1642 if (typePtr) *typePtr = JimParserTtype(pc);
1643 if (linePtr) *linePtr = JimParserTline(pc);
1644 return token;
1645 }
1646
1647 /* The following functin is not really part of the parsing engine of Jim,
1648 * but it somewhat related. Given an string and its length, it tries
1649 * to guess if the script is complete or there are instead " " or { }
1650 * open and not completed. This is useful for interactive shells
1651 * implementation and for [info complete].
1652 *
1653 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
1654 * '{' on scripts incomplete missing one or more '}' to be balanced.
1655 * '"' on scripts incomplete missing a '"' char.
1656 *
1657 * If the script is complete, 1 is returned, otherwise 0. */
1658 int Jim_ScriptIsComplete(const char *s, int len, char *stateCharPtr)
1659 {
1660 int level = 0;
1661 int state = ' ';
1662
1663 while(len) {
1664 switch (*s) {
1665 case '\\':
1666 if (len > 1)
1667 s++;
1668 break;
1669 case '"':
1670 if (state == ' ') {
1671 state = '"';
1672 } else if (state == '"') {
1673 state = ' ';
1674 }
1675 break;
1676 case '{':
1677 if (state == '{') {
1678 level++;
1679 } else if (state == ' ') {
1680 state = '{';
1681 level++;
1682 }
1683 break;
1684 case '}':
1685 if (state == '{') {
1686 level--;
1687 if (level == 0)
1688 state = ' ';
1689 }
1690 break;
1691 }
1692 s++;
1693 len--;
1694 }
1695 if (stateCharPtr)
1696 *stateCharPtr = state;
1697 return state == ' ';
1698 }
1699
1700 /* -----------------------------------------------------------------------------
1701 * Tcl Lists parsing
1702 * ---------------------------------------------------------------------------*/
1703 static int JimParseListSep(struct JimParserCtx *pc);
1704 static int JimParseListStr(struct JimParserCtx *pc);
1705
1706 int JimParseList(struct JimParserCtx *pc)
1707 {
1708 if (pc->len == 0) {
1709 pc->tstart = pc->tend = pc->p;
1710 pc->tline = pc->linenr;
1711 pc->tt = JIM_TT_EOL;
1712 pc->eof = 1;
1713 return JIM_OK;
1714 }
1715 switch(*pc->p) {
1716 case ' ':
1717 case '\n':
1718 case '\t':
1719 case '\r':
1720 if (pc->state == JIM_PS_DEF)
1721 return JimParseListSep(pc);
1722 else
1723 return JimParseListStr(pc);
1724 break;
1725 default:
1726 return JimParseListStr(pc);
1727 break;
1728 }
1729 return JIM_OK;
1730 }
1731
1732 int JimParseListSep(struct JimParserCtx *pc)
1733 {
1734 pc->tstart = pc->p;
1735 pc->tline = pc->linenr;
1736 while (*pc->p == ' ' || *pc->p == '\t' || *pc->p == '\r' || *pc->p == '\n')
1737 {
1738 pc->p++; pc->len--;
1739 }
1740 pc->tend = pc->p-1;
1741 pc->tt = JIM_TT_SEP;
1742 return JIM_OK;
1743 }
1744
1745 int JimParseListStr(struct JimParserCtx *pc)
1746 {
1747 int newword = (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1748 pc->tt == JIM_TT_NONE);
1749 if (newword && *pc->p == '{') {
1750 return JimParseBrace(pc);
1751 } else if (newword && *pc->p == '"') {
1752 pc->state = JIM_PS_QUOTE;
1753 pc->p++; pc->len--;
1754 }
1755 pc->tstart = pc->p;
1756 pc->tline = pc->linenr;
1757 while (1) {
1758 if (pc->len == 0) {
1759 pc->tend = pc->p-1;
1760 pc->tt = JIM_TT_ESC;
1761 return JIM_OK;
1762 }
1763 switch(*pc->p) {
1764 case '\\':
1765 pc->p++; pc->len--;
1766 break;
1767 case ' ':
1768 case '\t':
1769 case '\n':
1770 case '\r':
1771 if (pc->state == JIM_PS_DEF) {
1772 pc->tend = pc->p-1;
1773 pc->tt = JIM_TT_ESC;
1774 return JIM_OK;
1775 } else if (*pc->p == '\n') {
1776 pc->linenr++;
1777 }
1778 break;
1779 case '"':
1780 if (pc->state == JIM_PS_QUOTE) {
1781 pc->tend = pc->p-1;
1782 pc->tt = JIM_TT_ESC;
1783 pc->p++; pc->len--;
1784 pc->state = JIM_PS_DEF;
1785 return JIM_OK;
1786 }
1787 break;
1788 }
1789 pc->p++; pc->len--;
1790 }
1791 return JIM_OK; /* unreached */
1792 }
1793
1794 /* -----------------------------------------------------------------------------
1795 * Jim_Obj related functions
1796 * ---------------------------------------------------------------------------*/
1797
1798 /* Return a new initialized object. */
1799 Jim_Obj *Jim_NewObj(Jim_Interp *interp)
1800 {
1801 Jim_Obj *objPtr;
1802
1803 /* -- Check if there are objects in the free list -- */
1804 if (interp->freeList != NULL) {
1805 /* -- Unlink the object from the free list -- */
1806 objPtr = interp->freeList;
1807 interp->freeList = objPtr->nextObjPtr;
1808 } else {
1809 /* -- No ready to use objects: allocate a new one -- */
1810 objPtr = Jim_Alloc(sizeof(*objPtr));
1811 }
1812
1813 /* Object is returned with refCount of 0. Every
1814 * kind of GC implemented should take care to don't try
1815 * to scan objects with refCount == 0. */
1816 objPtr->refCount = 0;
1817 /* All the other fields are left not initialized to save time.
1818 * The caller will probably want set they to the right
1819 * value anyway. */
1820
1821 /* -- Put the object into the live list -- */
1822 objPtr->prevObjPtr = NULL;
1823 objPtr->nextObjPtr = interp->liveList;
1824 if (interp->liveList)
1825 interp->liveList->prevObjPtr = objPtr;
1826 interp->liveList = objPtr;
1827
1828 return objPtr;
1829 }
1830
1831 /* Free an object. Actually objects are never freed, but
1832 * just moved to the free objects list, where they will be
1833 * reused by Jim_NewObj(). */
1834 void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr)
1835 {
1836 /* Check if the object was already freed, panic. */
1837 if (objPtr->refCount != 0) {
1838 Jim_Panic(interp,"!!!Object %p freed with bad refcount %d", objPtr,
1839 objPtr->refCount);
1840 }
1841 /* Free the internal representation */
1842 Jim_FreeIntRep(interp, objPtr);
1843 /* Free the string representation */
1844 if (objPtr->bytes != NULL) {
1845 if (objPtr->bytes != JimEmptyStringRep)
1846 Jim_Free(objPtr->bytes);
1847 }
1848 /* Unlink the object from the live objects list */
1849 if (objPtr->prevObjPtr)
1850 objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr;
1851 if (objPtr->nextObjPtr)
1852 objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr;
1853 if (interp->liveList == objPtr)
1854 interp->liveList = objPtr->nextObjPtr;
1855 /* Link the object into the free objects list */
1856 objPtr->prevObjPtr = NULL;
1857 objPtr->nextObjPtr = interp->freeList;
1858 if (interp->freeList)
1859 interp->freeList->prevObjPtr = objPtr;
1860 interp->freeList = objPtr;
1861 objPtr->refCount = -1;
1862 }
1863
1864 /* Invalidate the string representation of an object. */
1865 void Jim_InvalidateStringRep(Jim_Obj *objPtr)
1866 {
1867 if (objPtr->bytes != NULL) {
1868 if (objPtr->bytes != JimEmptyStringRep)
1869 Jim_Free(objPtr->bytes);
1870 }
1871 objPtr->bytes = NULL;
1872 }
1873
1874 #define Jim_SetStringRep(o, b, l) \
1875 do { (o)->bytes = b; (o)->length = l; } while (0)
1876
1877 /* Set the initial string representation for an object.
1878 * Does not try to free an old one. */
1879 void Jim_InitStringRep(Jim_Obj *objPtr, const char *bytes, int length)
1880 {
1881 if (length == 0) {
1882 objPtr->bytes = JimEmptyStringRep;
1883 objPtr->length = 0;
1884 } else {
1885 objPtr->bytes = Jim_Alloc(length+1);
1886 objPtr->length = length;
1887 memcpy(objPtr->bytes, bytes, length);
1888 objPtr->bytes[length] = '\0';
1889 }
1890 }
1891
1892 /* Duplicate an object. The returned object has refcount = 0. */
1893 Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
1894 {
1895 Jim_Obj *dupPtr;
1896
1897 dupPtr = Jim_NewObj(interp);
1898 if (objPtr->bytes == NULL) {
1899 /* Object does not have a valid string representation. */
1900 dupPtr->bytes = NULL;
1901 } else {
1902 Jim_InitStringRep(dupPtr, objPtr->bytes, objPtr->length);
1903 }
1904 if (objPtr->typePtr != NULL) {
1905 if (objPtr->typePtr->dupIntRepProc == NULL) {
1906 dupPtr->internalRep = objPtr->internalRep;
1907 } else {
1908 objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr);
1909 }
1910 dupPtr->typePtr = objPtr->typePtr;
1911 } else {
1912 dupPtr->typePtr = NULL;
1913 }
1914 return dupPtr;
1915 }
1916
1917 /* Return the string representation for objPtr. If the object
1918 * string representation is invalid, calls the method to create
1919 * a new one starting from the internal representation of the object. */
1920 const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr)
1921 {
1922 if (objPtr->bytes == NULL) {
1923 /* Invalid string repr. Generate it. */
1924 if (objPtr->typePtr->updateStringProc == NULL) {
1925 Jim_Panic(NULL,"UpdataStringProc called against '%s' type.",
1926 objPtr->typePtr->name);
1927 }
1928 objPtr->typePtr->updateStringProc(objPtr);
1929 }
1930 if (lenPtr)
1931 *lenPtr = objPtr->length;
1932 return objPtr->bytes;
1933 }
1934
1935 /* Just returns the length of the object's string rep */
1936 int Jim_Length(Jim_Obj *objPtr)
1937 {
1938 int len;
1939
1940 Jim_GetString(objPtr, &len);
1941 return len;
1942 }
1943
1944 /* -----------------------------------------------------------------------------
1945 * String Object
1946 * ---------------------------------------------------------------------------*/
1947 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
1948 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
1949
1950 static Jim_ObjType stringObjType = {
1951 "string",
1952 NULL,
1953 DupStringInternalRep,
1954 NULL,
1955 JIM_TYPE_REFERENCES,
1956 };
1957
1958 void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
1959 {
1960 JIM_NOTUSED(interp);
1961
1962 /* This is a bit subtle: the only caller of this function
1963 * should be Jim_DuplicateObj(), that will copy the
1964 * string representaion. After the copy, the duplicated
1965 * object will not have more room in teh buffer than
1966 * srcPtr->length bytes. So we just set it to length. */
1967 dupPtr->internalRep.strValue.maxLength = srcPtr->length;
1968 }
1969
1970 int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
1971 {
1972 /* Get a fresh string representation. */
1973 (void) Jim_GetString(objPtr, NULL);
1974 /* Free any other internal representation. */
1975 Jim_FreeIntRep(interp, objPtr);
1976 /* Set it as string, i.e. just set the maxLength field. */
1977 objPtr->typePtr = &stringObjType;
1978 objPtr->internalRep.strValue.maxLength = objPtr->length;
1979 return JIM_OK;
1980 }
1981
1982 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
1983 {
1984 Jim_Obj *objPtr = Jim_NewObj(interp);
1985
1986 if (len == -1)
1987 len = strlen(s);
1988 /* Alloc/Set the string rep. */
1989 if (len == 0) {
1990 objPtr->bytes = JimEmptyStringRep;
1991 objPtr->length = 0;
1992 } else {
1993 objPtr->bytes = Jim_Alloc(len+1);
1994 objPtr->length = len;
1995 memcpy(objPtr->bytes, s, len);
1996 objPtr->bytes[len] = '\0';
1997 }
1998
1999 /* No typePtr field for the vanilla string object. */
2000 objPtr->typePtr = NULL;
2001 return objPtr;
2002 }
2003
2004 /* This version does not try to duplicate the 's' pointer, but
2005 * use it directly. */
2006 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
2007 {
2008 Jim_Obj *objPtr = Jim_NewObj(interp);
2009
2010 if (len == -1)
2011 len = strlen(s);
2012 Jim_SetStringRep(objPtr, s, len);
2013 objPtr->typePtr = NULL;
2014 return objPtr;
2015 }
2016
2017 /* Low-level string append. Use it only against objects
2018 * of type "string". */
2019 void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
2020 {
2021 int needlen;
2022
2023 if (len == -1)
2024 len = strlen(str);
2025 needlen = objPtr->length + len;
2026 if (objPtr->internalRep.strValue.maxLength < needlen ||
2027 objPtr->internalRep.strValue.maxLength == 0) {
2028 if (objPtr->bytes == JimEmptyStringRep) {
2029 objPtr->bytes = Jim_Alloc((needlen*2)+1);
2030 } else {
2031 objPtr->bytes = Jim_Realloc(objPtr->bytes, (needlen*2)+1);
2032 }
2033 objPtr->internalRep.strValue.maxLength = needlen*2;
2034 }
2035 memcpy(objPtr->bytes + objPtr->length, str, len);
2036 objPtr->bytes[objPtr->length+len] = '\0';
2037 objPtr->length += len;
2038 }
2039
2040 /* Low-level wrapper to append an object. */
2041 void StringAppendObj(Jim_Obj *objPtr, Jim_Obj *appendObjPtr)
2042 {
2043 int len;
2044 const char *str;
2045
2046 str = Jim_GetString(appendObjPtr, &len);
2047 StringAppendString(objPtr, str, len);
2048 }
2049
2050 /* Higher level API to append strings to objects. */
2051 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str,
2052 int len)
2053 {
2054 if (Jim_IsShared(objPtr))
2055 Jim_Panic(interp,"Jim_AppendString called with shared object");
2056 if (objPtr->typePtr != &stringObjType)
2057 SetStringFromAny(interp, objPtr);
2058 StringAppendString(objPtr, str, len);
2059 }
2060
2061 void Jim_AppendString_sprintf( Jim_Interp *interp, Jim_Obj *objPtr, const char *fmt, ... )
2062 {
2063 char *buf;
2064 va_list ap;
2065
2066 va_start( ap, fmt );
2067 buf = jim_vasprintf( fmt, ap );
2068 va_end(ap);
2069
2070 if( buf ){
2071 Jim_AppendString( interp, objPtr, buf, -1 );
2072 jim_vasprintf_done(buf);
2073 }
2074 }
2075
2076
2077 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr,
2078 Jim_Obj *appendObjPtr)
2079 {
2080 int len;
2081 const char *str;
2082
2083 str = Jim_GetString(appendObjPtr, &len);
2084 Jim_AppendString(interp, objPtr, str, len);
2085 }
2086
2087 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2088 {
2089 va_list ap;
2090
2091 if (objPtr->typePtr != &stringObjType)
2092 SetStringFromAny(interp, objPtr);
2093 va_start(ap, objPtr);
2094 while (1) {
2095 char *s = va_arg(ap, char*);
2096
2097 if (s == NULL) break;
2098 Jim_AppendString(interp, objPtr, s, -1);
2099 }
2100 va_end(ap);
2101 }
2102
2103 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr, int nocase)
2104 {
2105 const char *aStr, *bStr;
2106 int aLen, bLen, i;
2107
2108 if (aObjPtr == bObjPtr) return 1;
2109 aStr = Jim_GetString(aObjPtr, &aLen);
2110 bStr = Jim_GetString(bObjPtr, &bLen);
2111 if (aLen != bLen) return 0;
2112 if (nocase == 0)
2113 return memcmp(aStr, bStr, aLen) == 0;
2114 for (i = 0; i < aLen; i++) {
2115 if (tolower((int)aStr[i]) != tolower((int)bStr[i]))
2116 return 0;
2117 }
2118 return 1;
2119 }
2120
2121 int Jim_StringMatchObj(Jim_Obj *patternObjPtr, Jim_Obj *objPtr,
2122 int nocase)
2123 {
2124 const char *pattern, *string;
2125 int patternLen, stringLen;
2126
2127 pattern = Jim_GetString(patternObjPtr, &patternLen);
2128 string = Jim_GetString(objPtr, &stringLen);
2129 return JimStringMatch(pattern, patternLen, string, stringLen, nocase);
2130 }
2131
2132 int Jim_StringCompareObj(Jim_Obj *firstObjPtr,
2133 Jim_Obj *secondObjPtr, int nocase)
2134 {
2135 const char *s1, *s2;
2136 int l1, l2;
2137
2138 s1 = Jim_GetString(firstObjPtr, &l1);
2139 s2 = Jim_GetString(secondObjPtr, &l2);
2140 return JimStringCompare(s1, l1, s2, l2, nocase);
2141 }
2142
2143 /* Convert a range, as returned by Jim_GetRange(), into
2144 * an absolute index into an object of the specified length.
2145 * This function may return negative values, or values
2146 * bigger or equal to the length of the list if the index
2147 * is out of range. */
2148 static int JimRelToAbsIndex(int len, int index)
2149 {
2150 if (index < 0)
2151 return len + index;
2152 return index;
2153 }
2154
2155 /* Convert a pair of index as normalize by JimRelToAbsIndex(),
2156 * into a range stored in *firstPtr, *lastPtr, *rangeLenPtr, suitable
2157 * for implementation of commands like [string range] and [lrange].
2158 *
2159 * The resulting range is guaranteed to address valid elements of
2160 * the structure. */
2161 static void JimRelToAbsRange(int len, int first, int last,
2162 int *firstPtr, int *lastPtr, int *rangeLenPtr)
2163 {
2164 int rangeLen;
2165
2166 if (first > last) {
2167 rangeLen = 0;
2168 } else {
2169 rangeLen = last-first+1;
2170 if (rangeLen) {
2171 if (first < 0) {
2172 rangeLen += first;
2173 first = 0;
2174 }
2175 if (last >= len) {
2176 rangeLen -= (last-(len-1));
2177 last = len-1;
2178 }
2179 }
2180 }
2181 if (rangeLen < 0) rangeLen = 0;
2182
2183 *firstPtr = first;
2184 *lastPtr = last;
2185 *rangeLenPtr = rangeLen;
2186 }
2187
2188 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2189 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2190 {
2191 int first, last;
2192 const char *str;
2193 int len, rangeLen;
2194
2195 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
2196 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
2197 return NULL;
2198 str = Jim_GetString(strObjPtr, &len);
2199 first = JimRelToAbsIndex(len, first);
2200 last = JimRelToAbsIndex(len, last);
2201 JimRelToAbsRange(len, first, last, &first, &last, &rangeLen);
2202 return Jim_NewStringObj(interp, str+first, rangeLen);
2203 }
2204
2205 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2206 {
2207 char *buf;
2208 int i;
2209 if (strObjPtr->typePtr != &stringObjType) {
2210 SetStringFromAny(interp, strObjPtr);
2211 }
2212
2213 buf = Jim_Alloc(strObjPtr->length+1);
2214
2215 memcpy(buf, strObjPtr->bytes, strObjPtr->length+1);
2216 for (i = 0; i < strObjPtr->length; i++)
2217 buf[i] = tolower(buf[i]);
2218 return Jim_NewStringObjNoAlloc(interp, buf, strObjPtr->length);
2219 }
2220
2221 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2222 {
2223 char *buf;
2224 int i;
2225 if (strObjPtr->typePtr != &stringObjType) {
2226 SetStringFromAny(interp, strObjPtr);
2227 }
2228
2229 buf = Jim_Alloc(strObjPtr->length+1);
2230
2231 memcpy(buf, strObjPtr->bytes, strObjPtr->length+1);
2232 for (i = 0; i < strObjPtr->length; i++)
2233 buf[i] = toupper(buf[i]);
2234 return Jim_NewStringObjNoAlloc(interp, buf, strObjPtr->length);
2235 }
2236
2237 /* This is the core of the [format] command.
2238 * TODO: Lots of things work - via a hack
2239 * However, no format item can be >= JIM_MAX_FMT
2240 */
2241 #define JIM_MAX_FMT 2048
2242 static Jim_Obj *Jim_FormatString_Inner(Jim_Interp *interp, Jim_Obj *fmtObjPtr,
2243 int objc, Jim_Obj *const *objv, char *sprintf_buf)
2244 {
2245 const char *fmt, *_fmt;
2246 int fmtLen;
2247 Jim_Obj *resObjPtr;
2248
2249
2250 fmt = Jim_GetString(fmtObjPtr, &fmtLen);
2251 _fmt = fmt;
2252 resObjPtr = Jim_NewStringObj(interp, "", 0);
2253 while (fmtLen) {
2254 const char *p = fmt;
2255 char spec[2], c;
2256 jim_wide wideValue;
2257 double doubleValue;
2258 /* we cheat and use Sprintf()! */
2259 char fmt_str[100];
2260 char *cp;
2261 int width;
2262 int ljust;
2263 int zpad;
2264 int spad;
2265 int altfm;
2266 int forceplus;
2267 int prec;
2268 int inprec;
2269 int haveprec;
2270 int accum;
2271
2272 while (*fmt != '%' && fmtLen) {
2273 fmt++; fmtLen--;
2274 }
2275 Jim_AppendString(interp, resObjPtr, p, fmt-p);
2276 if (fmtLen == 0)
2277 break;
2278 fmt++; fmtLen--; /* skip '%' */
2279 zpad = 0;
2280 spad = 0;
2281 width = -1;
2282 ljust = 0;
2283 altfm = 0;
2284 forceplus = 0;
2285 inprec = 0;
2286 haveprec = 0;
2287 prec = -1; /* not found yet */
2288 next_fmt:
2289 if( fmtLen <= 0 ){
2290 break;
2291 }
2292 switch( *fmt ){
2293 /* terminals */
2294 case 'b': /* binary - not all printfs() do this */
2295 case 's': /* string */
2296 case 'i': /* integer */
2297 case 'd': /* decimal */
2298 case 'x': /* hex */
2299 case 'X': /* CAP hex */
2300 case 'c': /* char */
2301 case 'o': /* octal */
2302 case 'u': /* unsigned */
2303 case 'f': /* float */
2304 break;
2305
2306 /* non-terminals */
2307 case '0': /* zero pad */
2308 zpad = 1;
2309 fmt++; fmtLen--;
2310 goto next_fmt;
2311 break;
2312 case '+':
2313 forceplus = 1;
2314 fmt++; fmtLen--;
2315 goto next_fmt;
2316 break;
2317 case ' ': /* sign space */
2318 spad = 1;
2319 fmt++; fmtLen--;
2320 goto next_fmt;
2321 break;
2322 case '-':
2323 ljust = 1;
2324 fmt++; fmtLen--;
2325 goto next_fmt;
2326 break;
2327 case '#':
2328 altfm = 1;
2329 fmt++; fmtLen--;
2330 goto next_fmt;
2331
2332 case '.':
2333 inprec = 1;
2334 fmt++; fmtLen--;
2335 goto next_fmt;
2336 break;
2337 case '1':
2338 case '2':
2339 case '3':
2340 case '4':
2341 case '5':
2342 case '6':
2343 case '7':
2344 case '8':
2345 case '9':
2346 accum = 0;
2347 while( isdigit(*fmt) && (fmtLen > 0) ){
2348 accum = (accum * 10) + (*fmt - '0');
2349 fmt++; fmtLen--;
2350 }
2351 if( inprec ){
2352 haveprec = 1;
2353 prec = accum;
2354 } else {
2355 width = accum;
2356 }
2357 goto next_fmt;
2358 case '*':
2359 /* suck up the next item as an integer */
2360 fmt++; fmtLen--;
2361 objc--;
2362 if( objc <= 0 ){
2363 goto not_enough_args;
2364 }
2365 if( Jim_GetWide(interp,objv[0],&wideValue )== JIM_ERR ){
2366 Jim_FreeNewObj(interp, resObjPtr );
2367 return NULL;
2368 }
2369 if( inprec ){
2370 haveprec = 1;
2371 prec = wideValue;
2372 if( prec < 0 ){
2373 /* man 3 printf says */
2374 /* if prec is negative, it is zero */
2375 prec = 0;
2376 }
2377 } else {
2378 width = wideValue;
2379 if( width < 0 ){
2380 ljust = 1;
2381 width = -width;
2382 }
2383 }
2384 objv++;
2385 goto next_fmt;
2386 break;
2387 }
2388
2389
2390 if (*fmt != '%') {
2391 if (objc == 0) {
2392 not_enough_args:
2393 Jim_FreeNewObj(interp, resObjPtr);
2394 Jim_SetResultString(interp,
2395 "not enough arguments for all format specifiers", -1);
2396 return NULL;
2397 } else {
2398 objc--;
2399 }
2400 }
2401
2402 /*
2403 * Create the formatter
2404 * cause we cheat and use sprintf()
2405 */
2406 cp = fmt_str;
2407 *cp++ = '%';
2408 if( altfm ){
2409 *cp++ = '#';
2410 }
2411 if( forceplus ){
2412 *cp++ = '+';
2413 } else if( spad ){
2414 /* PLUS overrides */
2415 *cp++ = ' ';
2416 }
2417 if( ljust ){
2418 *cp++ = '-';
2419 }
2420 if( zpad ){
2421 *cp++ = '0';
2422 }
2423 if( width > 0 ){
2424 sprintf( cp, "%d", width );
2425 /* skip ahead */
2426 cp = strchr(cp,0);
2427 }
2428 /* did we find a period? */
2429 if( inprec ){
2430 /* then add it */
2431 *cp++ = '.';
2432 /* did something occur after the period? */
2433 if( haveprec ){
2434 sprintf( cp, "%d", prec );
2435 }
2436 cp = strchr(cp,0);
2437 }
2438 *cp = 0;
2439
2440 /* here we do the work */
2441 /* actually - we make sprintf() do it for us */
2442 switch(*fmt) {
2443 case 's':
2444 *cp++ = 's';
2445 *cp = 0;
2446 /* BUG: we do not handled embeded NULLs */
2447 snprintf( sprintf_buf, JIM_MAX_FMT, fmt_str, Jim_GetString( objv[0], NULL ));
2448 break;
2449 case 'c':
2450 *cp++ = 'c';
2451 *cp = 0;
2452 if (Jim_GetWide(interp, objv[0], &wideValue) == JIM_ERR) {
2453 Jim_FreeNewObj(interp, resObjPtr);
2454 return NULL;
2455 }
2456 c = (char) wideValue;
2457 snprintf( sprintf_buf, JIM_MAX_FMT, fmt_str, c );
2458 break;
2459 case 'f':
2460 case 'F':
2461 case 'g':
2462 case 'G':
2463 case 'e':
2464 case 'E':
2465 *cp++ = *fmt;
2466 *cp = 0;
2467 if( Jim_GetDouble( interp, objv[0], &doubleValue ) == JIM_ERR ){
2468 Jim_FreeNewObj( interp, resObjPtr );
2469 return NULL;
2470 }
2471 snprintf( sprintf_buf, JIM_MAX_FMT, fmt_str, doubleValue );
2472 break;
2473 case 'b':
2474 case 'd':
2475 case 'o':
2476 case 'i':
2477 case 'u':
2478 case 'x':
2479 case 'X':
2480 /* jim widevaluse are 64bit */
2481 if( sizeof(jim_wide) == sizeof(long long) ){
2482 *cp++ = 'l';
2483 *cp++ = 'l';
2484 } else {
2485 *cp++ = 'l';
2486 }
2487 *cp++ = *fmt;
2488 *cp = 0;
2489 if (Jim_GetWide(interp, objv[0], &wideValue) == JIM_ERR) {
2490 Jim_FreeNewObj(interp, resObjPtr);
2491 return NULL;
2492 }
2493 snprintf(sprintf_buf, JIM_MAX_FMT, fmt_str, wideValue );
2494 break;
2495 case '%':
2496 sprintf_buf[0] = '%';
2497 sprintf_buf[1] = 0;
2498 objv--; /* undo the objv++ below */
2499 break;
2500 default:
2501 spec[0] = *fmt; spec[1] = '\0';
2502 Jim_FreeNewObj(interp, resObjPtr);
2503 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
2504 Jim_AppendStrings(interp, Jim_GetResult(interp),
2505 "bad field specifier \"", spec, "\"", NULL);
2506 return NULL;
2507 }
2508 /* force terminate */
2509 #if 0
2510 printf("FMT was: %s\n", fmt_str );
2511 printf("RES was: |%s|\n", sprintf_buf );
2512 #endif
2513
2514 sprintf_buf[ JIM_MAX_FMT - 1] = 0;
2515 Jim_AppendString( interp, resObjPtr, sprintf_buf, strlen(sprintf_buf) );
2516 /* next obj */
2517 objv++;
2518 fmt++;
2519 fmtLen--;
2520 }
2521 return resObjPtr;
2522 }
2523
2524 Jim_Obj *Jim_FormatString(Jim_Interp *interp, Jim_Obj *fmtObjPtr,
2525 int objc, Jim_Obj *const *objv)
2526 {
2527 char *sprintf_buf=malloc(JIM_MAX_FMT);
2528 Jim_Obj *t=Jim_FormatString_Inner(interp, fmtObjPtr, objc, objv, sprintf_buf);
2529 free(sprintf_buf);
2530 return t;
2531 }
2532
2533 /* -----------------------------------------------------------------------------
2534 * Compared String Object
2535 * ---------------------------------------------------------------------------*/
2536
2537 /* This is strange object that allows to compare a C literal string
2538 * with a Jim object in very short time if the same comparison is done
2539 * multiple times. For example every time the [if] command is executed,
2540 * Jim has to check if a given argument is "else". This comparions if
2541 * the code has no errors are true most of the times, so we can cache
2542 * inside the object the pointer of the string of the last matching
2543 * comparison. Because most C compilers perform literal sharing,
2544 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
2545 * this works pretty well even if comparisons are at different places
2546 * inside the C code. */
2547
2548 static Jim_ObjType comparedStringObjType = {
2549 "compared-string",
2550 NULL,
2551 NULL,
2552 NULL,
2553 JIM_TYPE_REFERENCES,
2554 };
2555
2556 /* The only way this object is exposed to the API is via the following
2557 * function. Returns true if the string and the object string repr.
2558 * are the same, otherwise zero is returned.
2559 *
2560 * Note: this isn't binary safe, but it hardly needs to be.*/
2561 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr,
2562 const char *str)
2563 {
2564 if (objPtr->typePtr == &comparedStringObjType &&
2565 objPtr->internalRep.ptr == str)
2566 return 1;
2567 else {
2568 const char *objStr = Jim_GetString(objPtr, NULL);
2569 if (strcmp(str, objStr) != 0) return 0;
2570 if (objPtr->typePtr != &comparedStringObjType) {
2571 Jim_FreeIntRep(interp, objPtr);
2572 objPtr->typePtr = &comparedStringObjType;
2573 }
2574 objPtr->internalRep.ptr = (char*)str; /*ATTENTION: const cast */
2575 return 1;
2576 }
2577 }
2578
2579 int qsortCompareStringPointers(const void *a, const void *b)
2580 {
2581 char * const *sa = (char * const *)a;
2582 char * const *sb = (char * const *)b;
2583 return strcmp(*sa, *sb);
2584 }
2585
2586 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
2587 const char * const *tablePtr, int *indexPtr, const char *name, int flags)
2588 {
2589 const char * const *entryPtr = NULL;
2590 char **tablePtrSorted;
2591 int i, count = 0;
2592
2593 *indexPtr = -1;
2594 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
2595 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
2596 *indexPtr = i;
2597 return JIM_OK;
2598 }
2599 count++; /* If nothing matches, this will reach the len of tablePtr */
2600 }
2601 if (flags & JIM_ERRMSG) {
2602 if (name == NULL)
2603 name = "option";
2604 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
2605 Jim_AppendStrings(interp, Jim_GetResult(interp),
2606 "bad ", name, " \"", Jim_GetString(objPtr, NULL), "\": must be one of ",
2607 NULL);
2608 tablePtrSorted = Jim_Alloc(sizeof(char*)*count);
2609 memcpy(tablePtrSorted, tablePtr, sizeof(char*)*count);
2610 qsort(tablePtrSorted, count, sizeof(char*), qsortCompareStringPointers);
2611 for (i = 0; i < count; i++) {
2612 if (i+1 == count && count > 1)
2613 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
2614 Jim_AppendString(interp, Jim_GetResult(interp),
2615 tablePtrSorted[i], -1);
2616 if (i+1 != count)
2617 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
2618 }
2619 Jim_Free(tablePtrSorted);
2620 }
2621 return JIM_ERR;
2622 }
2623
2624 int Jim_GetNvp(Jim_Interp *interp,
2625 Jim_Obj *objPtr,
2626 const Jim_Nvp *nvp_table,
2627 const Jim_Nvp ** result)
2628 {
2629 Jim_Nvp *n;
2630 int e;
2631
2632 e = Jim_Nvp_name2value_obj( interp, nvp_table, objPtr, &n );
2633 if( e == JIM_ERR ){
2634 return e;
2635 }
2636
2637 /* Success? found? */
2638 if( n->name ){
2639 /* remove const */
2640 *result = (Jim_Nvp *)n;
2641 return JIM_OK;
2642 } else {
2643 return JIM_ERR;
2644 }
2645 }
2646
2647 /* -----------------------------------------------------------------------------
2648 * Source Object
2649 *
2650 * This object is just a string from the language point of view, but
2651 * in the internal representation it contains the filename and line number
2652 * where this given token was read. This information is used by
2653 * Jim_EvalObj() if the object passed happens to be of type "source".
2654 *
2655 * This allows to propagate the information about line numbers and file
2656 * names and give error messages with absolute line numbers.
2657 *
2658 * Note that this object uses shared strings for filenames, and the
2659 * pointer to the filename together with the line number is taken into
2660 * the space for the "inline" internal represenation of the Jim_Object,
2661 * so there is almost memory zero-overhead.
2662 *
2663 * Also the object will be converted to something else if the given
2664 * token it represents in the source file is not something to be
2665 * evaluated (not a script), and will be specialized in some other way,
2666 * so the time overhead is alzo null.
2667 * ---------------------------------------------------------------------------*/
2668
2669 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2670 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2671
2672 static Jim_ObjType sourceObjType = {
2673 "source",
2674 FreeSourceInternalRep,
2675 DupSourceInternalRep,
2676 NULL,
2677 JIM_TYPE_REFERENCES,
2678 };
2679
2680 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2681 {
2682 Jim_ReleaseSharedString(interp,
2683 objPtr->internalRep.sourceValue.fileName);
2684 }
2685
2686 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2687 {
2688 dupPtr->internalRep.sourceValue.fileName =
2689 Jim_GetSharedString(interp,
2690 srcPtr->internalRep.sourceValue.fileName);
2691 dupPtr->internalRep.sourceValue.lineNumber =
2692 dupPtr->internalRep.sourceValue.lineNumber;
2693 dupPtr->typePtr = &sourceObjType;
2694 }
2695
2696 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
2697 const char *fileName, int lineNumber)
2698 {
2699 if (Jim_IsShared(objPtr))
2700 Jim_Panic(interp,"JimSetSourceInfo called with shared object");
2701 if (objPtr->typePtr != NULL)
2702 Jim_Panic(interp,"JimSetSourceInfo called with typePtr != NULL");
2703 objPtr->internalRep.sourceValue.fileName =
2704 Jim_GetSharedString(interp, fileName);
2705 objPtr->internalRep.sourceValue.lineNumber = lineNumber;
2706 objPtr->typePtr = &sourceObjType;
2707 }
2708
2709 /* -----------------------------------------------------------------------------
2710 * Script Object
2711 * ---------------------------------------------------------------------------*/
2712
2713 #define JIM_CMDSTRUCT_EXPAND -1
2714
2715 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2716 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2717 static int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2718
2719 static Jim_ObjType scriptObjType = {
2720 "script",
2721 FreeScriptInternalRep,
2722 DupScriptInternalRep,
2723 NULL,
2724 JIM_TYPE_REFERENCES,
2725 };
2726
2727 /* The ScriptToken structure represents every token into a scriptObj.
2728 * Every token contains an associated Jim_Obj that can be specialized
2729 * by commands operating on it. */
2730 typedef struct ScriptToken {
2731 int type;
2732 Jim_Obj *objPtr;
2733 int linenr;
2734 } ScriptToken;
2735
2736 /* This is the script object internal representation. An array of
2737 * ScriptToken structures, with an associated command structure array.
2738 * The command structure is a pre-computed representation of the
2739 * command length and arguments structure as a simple liner array
2740 * of integers.
2741 *
2742 * For example the script:
2743 *
2744 * puts hello
2745 * set $i $x$y [foo]BAR
2746 *
2747 * will produce a ScriptObj with the following Tokens:
2748 *
2749 * ESC puts
2750 * SEP
2751 * ESC hello
2752 * EOL
2753 * ESC set
2754 * EOL
2755 * VAR i
2756 * SEP
2757 * VAR x
2758 * VAR y
2759 * SEP
2760 * CMD foo
2761 * ESC BAR
2762 * EOL
2763 *
2764 * This is a description of the tokens, separators, and of lines.
2765 * The command structure instead represents the number of arguments
2766 * of every command, followed by the tokens of which every argument
2767 * is composed. So for the example script, the cmdstruct array will
2768 * contain:
2769 *
2770 * 2 1 1 4 1 1 2 2
2771 *
2772 * Because "puts hello" has two args (2), composed of single tokens (1 1)
2773 * While "set $i $x$y [foo]BAR" has four (4) args, the first two
2774 * composed of single tokens (1 1) and the last two of double tokens
2775 * (2 2).
2776 *
2777 * The precomputation of the command structure makes Jim_Eval() faster,
2778 * and simpler because there aren't dynamic lengths / allocations.
2779 *
2780 * -- {expand} handling --
2781 *
2782 * Expand is handled in a special way. When a command
2783 * contains at least an argument with the {expand} prefix,
2784 * the command structure presents a -1 before the integer
2785 * describing the number of arguments. This is used in order
2786 * to send the command exection to a different path in case
2787 * of {expand} and guarantee a fast path for the more common
2788 * case. Also, the integers describing the number of tokens
2789 * are expressed with negative sign, to allow for fast check
2790 * of what's an {expand}-prefixed argument and what not.
2791 *
2792 * For example the command:
2793 *
2794 * list {expand}{1 2}
2795 *
2796 * Will produce the following cmdstruct array:
2797 *
2798 * -1 2 1 -2
2799 *
2800 * -- the substFlags field of the structure --
2801 *
2802 * The scriptObj structure is used to represent both "script" objects
2803 * and "subst" objects. In the second case, the cmdStruct related
2804 * fields are not used at all, but there is an additional field used
2805 * that is 'substFlags': this represents the flags used to turn
2806 * the string into the intenral representation used to perform the
2807 * substitution. If this flags are not what the application requires
2808 * the scriptObj is created again. For example the script:
2809 *
2810 * subst -nocommands $string
2811 * subst -novariables $string
2812 *
2813 * Will recreate the internal representation of the $string object
2814 * two times.
2815 */
2816 typedef struct ScriptObj {
2817 int len; /* Length as number of tokens. */
2818 int commands; /* number of top-level commands in script. */
2819 ScriptToken *token; /* Tokens array. */
2820 int *cmdStruct; /* commands structure */
2821 int csLen; /* length of the cmdStruct array. */
2822 int substFlags; /* flags used for the compilation of "subst" objects */
2823 int inUse; /* Used to share a ScriptObj. Currently
2824 only used by Jim_EvalObj() as protection against
2825 shimmering of the currently evaluated object. */
2826 char *fileName;
2827 } ScriptObj;
2828
2829 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2830 {
2831 int i;
2832 struct ScriptObj *script = (void*) objPtr->internalRep.ptr;
2833
2834 script->inUse--;
2835 if (script->inUse != 0) return;
2836 for (i = 0; i < script->len; i++) {
2837 if (script->token[i].objPtr != NULL)
2838 Jim_DecrRefCount(interp, script->token[i].objPtr);
2839 }
2840 Jim_Free(script->token);
2841 Jim_Free(script->cmdStruct);
2842 Jim_Free(script->fileName);
2843 Jim_Free(script);
2844 }
2845
2846 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2847 {
2848 JIM_NOTUSED(interp);
2849 JIM_NOTUSED(srcPtr);
2850
2851 /* Just returns an simple string. */
2852 dupPtr->typePtr = NULL;
2853 }
2854
2855 /* Add a new token to the internal repr of a script object */
2856 static void ScriptObjAddToken(Jim_Interp *interp, struct ScriptObj *script,
2857 char *strtoken, int len, int type, char *filename, int linenr)
2858 {
2859 int prevtype;
2860 struct ScriptToken *token;
2861
2862 prevtype = (script->len == 0) ? JIM_TT_EOL : \
2863 script->token[script->len-1].type;
2864 /* Skip tokens without meaning, like words separators
2865 * following a word separator or an end of command and
2866 * so on. */
2867 if (prevtype == JIM_TT_EOL) {
2868 if (type == JIM_TT_EOL || type == JIM_TT_SEP) {
2869 Jim_Free(strtoken);
2870 return;
2871 }
2872 } else if (prevtype == JIM_TT_SEP) {
2873 if (type == JIM_TT_SEP) {
2874 Jim_Free(strtoken);
2875 return;
2876 } else if (type == JIM_TT_EOL) {
2877 /* If an EOL is following by a SEP, drop the previous
2878 * separator. */
2879 script->len--;
2880 Jim_DecrRefCount(interp, script->token[script->len].objPtr);
2881 }
2882 } else if (prevtype != JIM_TT_EOL && prevtype != JIM_TT_SEP &&
2883 type == JIM_TT_ESC && len == 0)
2884 {
2885 /* Don't add empty tokens used in interpolation */
2886 Jim_Free(strtoken);
2887 return;
2888 }
2889 /* Make space for a new istruction */
2890 script->len++;
2891 script->token = Jim_Realloc(script->token,
2892 sizeof(ScriptToken)*script->len);
2893 /* Initialize the new token */
2894 token = script->token+(script->len-1);
2895 token->type = type;
2896 /* Every object is intially as a string, but the
2897 * internal type may be specialized during execution of the
2898 * script. */
2899 token->objPtr = Jim_NewStringObjNoAlloc(interp, strtoken, len);
2900 /* To add source info to SEP and EOL tokens is useless because
2901 * they will never by called as arguments of Jim_EvalObj(). */
2902 if (filename && type != JIM_TT_SEP && type != JIM_TT_EOL)
2903 JimSetSourceInfo(interp, token->objPtr, filename, linenr);
2904 Jim_IncrRefCount(token->objPtr);
2905 token->linenr = linenr;
2906 }
2907
2908 /* Add an integer into the command structure field of the script object. */
2909 static void ScriptObjAddInt(struct ScriptObj *script, int val)
2910 {
2911 script->csLen++;
2912 script->cmdStruct = Jim_Realloc(script->cmdStruct,
2913 sizeof(int)*script->csLen);
2914 script->cmdStruct[script->csLen-1] = val;
2915 }
2916
2917 /* Search a Jim_Obj contained in 'script' with the same stinrg repr.
2918 * of objPtr. Search nested script objects recursively. */
2919 static Jim_Obj *ScriptSearchLiteral(Jim_Interp *interp, ScriptObj *script,
2920 ScriptObj *scriptBarrier, Jim_Obj *objPtr)
2921 {
2922 int i;
2923
2924 for (i = 0; i < script->len; i++) {
2925 if (script->token[i].objPtr != objPtr &&
2926 Jim_StringEqObj(script->token[i].objPtr, objPtr, 0)) {
2927 return script->token[i].objPtr;
2928 }
2929 /* Enter recursively on scripts only if the object
2930 * is not the same as the one we are searching for
2931 * shared occurrences. */
2932 if (script->token[i].objPtr->typePtr == &scriptObjType &&
2933 script->token[i].objPtr != objPtr) {
2934 Jim_Obj *foundObjPtr;
2935
2936 ScriptObj *subScript =
2937 script->token[i].objPtr->internalRep.ptr;
2938 /* Don't recursively enter the script we are trying
2939 * to make shared to avoid circular references. */
2940 if (subScript == scriptBarrier) continue;
2941 if (subScript != script) {
2942 foundObjPtr =
2943 ScriptSearchLiteral(interp, subScript,
2944 scriptBarrier, objPtr);
2945 if (foundObjPtr != NULL)
2946 return foundObjPtr;
2947 }
2948 }
2949 }
2950 return NULL;
2951 }
2952
2953 /* Share literals of a script recursively sharing sub-scripts literals. */
2954 static void ScriptShareLiterals(Jim_Interp *interp, ScriptObj *script,
2955 ScriptObj *topLevelScript)
2956 {
2957 int i, j;
2958
2959 return;
2960 /* Try to share with toplevel object. */
2961 if (topLevelScript != NULL) {
2962 for (i = 0; i < script->len; i++) {
2963 Jim_Obj *foundObjPtr;
2964 char *str = script->token[i].objPtr->bytes;
2965
2966 if (script->token[i].objPtr->refCount != 1) continue;
2967 if (script->token[i].objPtr->typePtr == &scriptObjType) continue;
2968 if (strchr(str, ' ') || strchr(str, '\n')) continue;
2969 foundObjPtr = ScriptSearchLiteral(interp,
2970 topLevelScript,
2971 script, /* barrier */
2972 script->token[i].objPtr);
2973 if (foundObjPtr != NULL) {
2974 Jim_IncrRefCount(foundObjPtr);
2975 Jim_DecrRefCount(interp,
2976 script->token[i].objPtr);
2977 script->token[i].objPtr = foundObjPtr;
2978 }
2979 }
2980 }
2981 /* Try to share locally */
2982 for (i = 0; i < script->len; i++) {
2983 char *str = script->token[i].objPtr->bytes;
2984
2985 if (script->token[i].objPtr->refCount != 1) continue;
2986 if (strchr(str, ' ') || strchr(str, '\n')) continue;
2987 for (j = 0; j < script->len; j++) {
2988 if (script->token[i].objPtr !=
2989 script->token[j].objPtr &&
2990 Jim_StringEqObj(script->token[i].objPtr,
2991 script->token[j].objPtr, 0))
2992 {
2993 Jim_IncrRefCount(script->token[j].objPtr);
2994 Jim_DecrRefCount(interp,
2995 script->token[i].objPtr);
2996 script->token[i].objPtr =
2997 script->token[j].objPtr;
2998 }
2999 }
3000 }
3001 }
3002
3003 /* This method takes the string representation of an object
3004 * as a Tcl script, and generates the pre-parsed internal representation
3005 * of the script. */
3006 int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3007 {
3008 int scriptTextLen;
3009 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
3010 struct JimParserCtx parser;
3011 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
3012 ScriptToken *token;
3013 int args, tokens, start, end, i;
3014 int initialLineNumber;
3015 int propagateSourceInfo = 0;
3016
3017 script->len = 0;
3018 script->csLen = 0;
3019 script->commands = 0;
3020 script->token = NULL;
3021 script->cmdStruct = NULL;
3022 script->inUse = 1;
3023 /* Try to get information about filename / line number */
3024 if (objPtr->typePtr == &sourceObjType) {
3025 script->fileName =
3026 Jim_StrDup(objPtr->internalRep.sourceValue.fileName);
3027 initialLineNumber = objPtr->internalRep.sourceValue.lineNumber;
3028 propagateSourceInfo = 1;
3029 } else {
3030 script->fileName = Jim_StrDup("");
3031 initialLineNumber = 1;
3032 }
3033
3034 JimParserInit(&parser, scriptText, scriptTextLen, initialLineNumber);
3035 while(!JimParserEof(&parser)) {
3036 char *token;
3037 int len, type, linenr;
3038
3039 JimParseScript(&parser);
3040 token = JimParserGetToken(&parser, &len, &type, &linenr);
3041 ScriptObjAddToken(interp, script, token, len, type,
3042 propagateSourceInfo ? script->fileName : NULL,
3043 linenr);
3044 }
3045 token = script->token;
3046
3047 /* Compute the command structure array
3048 * (see the ScriptObj struct definition for more info) */
3049 start = 0; /* Current command start token index */
3050 end = -1; /* Current command end token index */
3051 while (1) {
3052 int expand = 0; /* expand flag. set to 1 on {expand} form. */
3053 int interpolation = 0; /* set to 1 if there is at least one
3054 argument of the command obtained via
3055 interpolation of more tokens. */
3056 /* Search for the end of command, while
3057 * count the number of args. */
3058 start = ++end;
3059 if (start >= script->len) break;
3060 args = 1; /* Number of args in current command */
3061 while (token[end].type != JIM_TT_EOL) {
3062 if (end == 0 || token[end-1].type == JIM_TT_SEP ||
3063 token[end-1].type == JIM_TT_EOL)
3064 {
3065 if (token[end].type == JIM_TT_STR &&
3066 token[end+1].type != JIM_TT_SEP &&
3067 token[end+1].type != JIM_TT_EOL &&
3068 (!strcmp(token[end].objPtr->bytes, "expand") ||
3069 !strcmp(token[end].objPtr->bytes, "*")))
3070 expand++;
3071 }
3072 if (token[end].type == JIM_TT_SEP)
3073 args++;
3074 end++;
3075 }
3076 interpolation = !((end-start+1) == args*2);
3077 /* Add the 'number of arguments' info into cmdstruct.
3078 * Negative value if there is list expansion involved. */
3079 if (expand)
3080 ScriptObjAddInt(script, -1);
3081 ScriptObjAddInt(script, args);
3082 /* Now add info about the number of tokens. */
3083 tokens = 0; /* Number of tokens in current argument. */
3084 expand = 0;
3085 for (i = start; i <= end; i++) {
3086 if (token[i].type == JIM_TT_SEP ||
3087 token[i].type == JIM_TT_EOL)
3088 {
3089 if (tokens == 1 && expand)
3090 expand = 0;
3091 ScriptObjAddInt(script,
3092 expand ? -tokens : tokens);
3093
3094 expand = 0;
3095 tokens = 0;
3096 continue;
3097 } else if (tokens == 0 && token[i].type == JIM_TT_STR &&
3098 (!strcmp(token[i].objPtr->bytes, "expand") ||
3099 !strcmp(token[i].objPtr->bytes, "*")))
3100 {
3101 expand++;
3102 }
3103 tokens++;
3104 }
3105 }
3106 /* Perform literal sharing, but only for objects that appear
3107 * to be scripts written as literals inside the source code,
3108 * and not computed at runtime. Literal sharing is a costly
3109 * operation that should be done only against objects that
3110 * are likely to require compilation only the first time, and
3111 * then are executed multiple times. */
3112 if (propagateSourceInfo && interp->framePtr->procBodyObjPtr) {
3113 Jim_Obj *bodyObjPtr = interp->framePtr->procBodyObjPtr;
3114 if (bodyObjPtr->typePtr == &scriptObjType) {
3115 ScriptObj *bodyScript =
3116 bodyObjPtr->internalRep.ptr;
3117 ScriptShareLiterals(interp, script, bodyScript);
3118 }
3119 } else if (propagateSourceInfo) {
3120 ScriptShareLiterals(interp, script, NULL);
3121 }
3122 /* Free the old internal rep and set the new one. */
3123 Jim_FreeIntRep(interp, objPtr);
3124 Jim_SetIntRepPtr(objPtr, script);
3125 objPtr->typePtr = &scriptObjType;
3126 return JIM_OK;
3127 }
3128
3129 ScriptObj *Jim_GetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3130 {
3131 if (objPtr->typePtr != &scriptObjType) {
3132 SetScriptFromAny(interp, objPtr);
3133 }
3134 return (ScriptObj*) Jim_GetIntRepPtr(objPtr);
3135 }
3136
3137 /* -----------------------------------------------------------------------------
3138 * Commands
3139 * ---------------------------------------------------------------------------*/
3140
3141 /* Commands HashTable Type.
3142 *
3143 * Keys are dynamic allocated strings, Values are Jim_Cmd structures. */
3144 static void Jim_CommandsHT_ValDestructor(void *interp, void *val)
3145 {
3146 Jim_Cmd *cmdPtr = (void*) val;
3147
3148 if (cmdPtr->cmdProc == NULL) {
3149 Jim_DecrRefCount(interp, cmdPtr->argListObjPtr);
3150 Jim_DecrRefCount(interp, cmdPtr->bodyObjPtr);
3151 if (cmdPtr->staticVars) {
3152 Jim_FreeHashTable(cmdPtr->staticVars);
3153 Jim_Free(cmdPtr->staticVars);
3154 }
3155 } else if (cmdPtr->delProc != NULL) {
3156 /* If it was a C coded command, call the delProc if any */
3157 cmdPtr->delProc(interp, cmdPtr->privData);
3158 }
3159 Jim_Free(val);
3160 }
3161
3162 static Jim_HashTableType JimCommandsHashTableType = {
3163 JimStringCopyHTHashFunction, /* hash function */
3164 JimStringCopyHTKeyDup, /* key dup */
3165 NULL, /* val dup */
3166 JimStringCopyHTKeyCompare, /* key compare */
3167 JimStringCopyHTKeyDestructor, /* key destructor */
3168 Jim_CommandsHT_ValDestructor /* val destructor */
3169 };
3170
3171 /* ------------------------- Commands related functions --------------------- */
3172
3173 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdName,
3174 Jim_CmdProc cmdProc, void *privData, Jim_DelCmdProc delProc)
3175 {
3176 Jim_HashEntry *he;
3177 Jim_Cmd *cmdPtr;
3178
3179 he = Jim_FindHashEntry(&interp->commands, cmdName);
3180 if (he == NULL) { /* New command to create */
3181 cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3182 Jim_AddHashEntry(&interp->commands, cmdName, cmdPtr);
3183 } else {
3184 Jim_InterpIncrProcEpoch(interp);
3185 /* Free the arglist/body objects if it was a Tcl procedure */
3186 cmdPtr = he->val;
3187 if (cmdPtr->cmdProc == NULL) {
3188 Jim_DecrRefCount(interp, cmdPtr->argListObjPtr);
3189 Jim_DecrRefCount(interp, cmdPtr->bodyObjPtr);
3190 if (cmdPtr->staticVars) {
3191 Jim_FreeHashTable(cmdPtr->staticVars);
3192 Jim_Free(cmdPtr->staticVars);
3193 }
3194 cmdPtr->staticVars = NULL;
3195 } else if (cmdPtr->delProc != NULL) {
3196 /* If it was a C coded command, call the delProc if any */
3197 cmdPtr->delProc(interp, cmdPtr->privData);
3198 }
3199 }
3200
3201 /* Store the new details for this proc */
3202 cmdPtr->delProc = delProc;
3203 cmdPtr->cmdProc = cmdProc;
3204 cmdPtr->privData = privData;
3205
3206 /* There is no need to increment the 'proc epoch' because
3207 * creation of a new procedure can never affect existing
3208 * cached commands. We don't do negative caching. */
3209 return JIM_OK;
3210 }
3211
3212 int Jim_CreateProcedure(Jim_Interp *interp, const char *cmdName,
3213 Jim_Obj *argListObjPtr, Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr,
3214 int arityMin, int arityMax)
3215 {
3216 Jim_Cmd *cmdPtr;
3217
3218 cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3219 cmdPtr->cmdProc = NULL; /* Not a C coded command */
3220 cmdPtr->argListObjPtr = argListObjPtr;
3221 cmdPtr->bodyObjPtr = bodyObjPtr;
3222 Jim_IncrRefCount(argListObjPtr);
3223 Jim_IncrRefCount(bodyObjPtr);
3224 cmdPtr->arityMin = arityMin;
3225 cmdPtr->arityMax = arityMax;
3226 cmdPtr->staticVars = NULL;
3227
3228 /* Create the statics hash table. */
3229 if (staticsListObjPtr) {
3230 int len, i;
3231
3232 Jim_ListLength(interp, staticsListObjPtr, &len);
3233 if (len != 0) {
3234 cmdPtr->staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3235 Jim_InitHashTable(cmdPtr->staticVars, &JimVariablesHashTableType,
3236 interp);
3237 for (i = 0; i < len; i++) {
3238 Jim_Obj *objPtr, *initObjPtr, *nameObjPtr;
3239 Jim_Var *varPtr;
3240 int subLen;
3241
3242 Jim_ListIndex(interp, staticsListObjPtr, i, &objPtr, JIM_NONE);
3243 /* Check if it's composed of two elements. */
3244 Jim_ListLength(interp, objPtr, &subLen);
3245 if (subLen == 1 || subLen == 2) {
3246 /* Try to get the variable value from the current
3247 * environment. */
3248 Jim_ListIndex(interp, objPtr, 0, &nameObjPtr, JIM_NONE);
3249 if (subLen == 1) {
3250 initObjPtr = Jim_GetVariable(interp, nameObjPtr,
3251 JIM_NONE);
3252 if (initObjPtr == NULL) {
3253 Jim_SetResult(interp,
3254 Jim_NewEmptyStringObj(interp));
3255 Jim_AppendStrings(interp, Jim_GetResult(interp),
3256 "variable for initialization of static \"",
3257 Jim_GetString(nameObjPtr, NULL),
3258 "\" not found in the local context",
3259 NULL);
3260 goto err;
3261 }
3262 } else {
3263 Jim_ListIndex(interp, objPtr, 1, &initObjPtr, JIM_NONE);
3264 }
3265 varPtr = Jim_Alloc(sizeof(*varPtr));
3266 varPtr->objPtr = initObjPtr;
3267 Jim_IncrRefCount(initObjPtr);
3268 varPtr->linkFramePtr = NULL;
3269 if (Jim_AddHashEntry(cmdPtr->staticVars,
3270 Jim_GetString(nameObjPtr, NULL),
3271 varPtr) != JIM_OK)
3272 {
3273 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3274 Jim_AppendStrings(interp, Jim_GetResult(interp),
3275 "static variable name \"",
3276 Jim_GetString(objPtr, NULL), "\"",
3277 " duplicated in statics list", NULL);
3278 Jim_DecrRefCount(interp, initObjPtr);
3279 Jim_Free(varPtr);
3280 goto err;
3281 }
3282 } else {
3283 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3284 Jim_AppendStrings(interp, Jim_GetResult(interp),
3285 "too many fields in static specifier \"",
3286 objPtr, "\"", NULL);
3287 goto err;
3288 }
3289 }
3290 }
3291 }
3292
3293 /* Add the new command */
3294
3295 /* it may already exist, so we try to delete the old one */
3296 if (Jim_DeleteHashEntry(&interp->commands, cmdName) != JIM_ERR) {
3297 /* There was an old procedure with the same name, this requires
3298 * a 'proc epoch' update. */
3299 Jim_InterpIncrProcEpoch(interp);
3300 }
3301 /* If a procedure with the same name didn't existed there is no need
3302 * to increment the 'proc epoch' because creation of a new procedure
3303 * can never affect existing cached commands. We don't do
3304 * negative caching. */
3305 Jim_AddHashEntry(&interp->commands, cmdName, cmdPtr);
3306 return JIM_OK;
3307
3308 err:
3309 Jim_FreeHashTable(cmdPtr->staticVars);
3310 Jim_Free(cmdPtr->staticVars);
3311 Jim_DecrRefCount(interp, argListObjPtr);
3312 Jim_DecrRefCount(interp, bodyObjPtr);
3313 Jim_Free(cmdPtr);
3314 return JIM_ERR;
3315 }
3316
3317 int Jim_DeleteCommand(Jim_Interp *interp, const char *cmdName)
3318 {
3319 if (Jim_DeleteHashEntry(&interp->commands, cmdName) == JIM_ERR)
3320 return JIM_ERR;
3321 Jim_InterpIncrProcEpoch(interp);
3322 return JIM_OK;
3323 }
3324
3325 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName,
3326 const char *newName)
3327 {
3328 Jim_Cmd *cmdPtr;
3329 Jim_HashEntry *he;
3330 Jim_Cmd *copyCmdPtr;
3331
3332 if (newName[0] == '\0') /* Delete! */
3333 return Jim_DeleteCommand(interp, oldName);
3334 /* Rename */
3335 he = Jim_FindHashEntry(&interp->commands, oldName);
3336 if (he == NULL)
3337 return JIM_ERR; /* Invalid command name */
3338 cmdPtr = he->val;
3339 copyCmdPtr = Jim_Alloc(sizeof(Jim_Cmd));
3340 *copyCmdPtr = *cmdPtr;
3341 /* In order to avoid that a procedure will get arglist/body/statics
3342 * freed by the hash table methods, fake a C-coded command
3343 * setting cmdPtr->cmdProc as not NULL */
3344 cmdPtr->cmdProc = (void*)1;
3345 /* Also make sure delProc is NULL. */
3346 cmdPtr->delProc = NULL;
3347 /* Destroy the old command, and make sure the new is freed
3348 * as well. */
3349 Jim_DeleteHashEntry(&interp->commands, oldName);
3350 Jim_DeleteHashEntry(&interp->commands, newName);
3351 /* Now the new command. We are sure it can't fail because
3352 * the target name was already freed. */
3353 Jim_AddHashEntry(&interp->commands, newName, copyCmdPtr);
3354 /* Increment the epoch */
3355 Jim_InterpIncrProcEpoch(interp);
3356 return JIM_OK;
3357 }
3358
3359 /* -----------------------------------------------------------------------------
3360 * Command object
3361 * ---------------------------------------------------------------------------*/
3362
3363 static int SetCommandFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3364
3365 static Jim_ObjType commandObjType = {
3366 "command",
3367 NULL,
3368 NULL,
3369 NULL,
3370 JIM_TYPE_REFERENCES,
3371 };
3372
3373 int SetCommandFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
3374 {
3375 Jim_HashEntry *he;
3376 const char *cmdName;
3377
3378 /* Get the string representation */
3379 cmdName = Jim_GetString(objPtr, NULL);
3380 /* Lookup this name into the commands hash table */
3381 he = Jim_FindHashEntry(&interp->commands, cmdName);
3382 if (he == NULL)
3383 return JIM_ERR;
3384
3385 /* Free the old internal repr and set the new one. */
3386 Jim_FreeIntRep(interp, objPtr);
3387 objPtr->typePtr = &commandObjType;
3388 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
3389 objPtr->internalRep.cmdValue.cmdPtr = (void*)he->val;
3390 return JIM_OK;
3391 }
3392
3393 /* This function returns the command structure for the command name
3394 * stored in objPtr. It tries to specialize the objPtr to contain
3395 * a cached info instead to perform the lookup into the hash table
3396 * every time. The information cached may not be uptodate, in such
3397 * a case the lookup is performed and the cache updated. */
3398 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
3399 {
3400 if ((objPtr->typePtr != &commandObjType ||
3401 objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch) &&
3402 SetCommandFromAny(interp, objPtr) == JIM_ERR) {
3403 if (flags & JIM_ERRMSG) {
3404 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3405 Jim_AppendStrings(interp, Jim_GetResult(interp),
3406 "invalid command name \"", objPtr->bytes, "\"",
3407 NULL);
3408 }
3409 return NULL;
3410 }
3411 return objPtr->internalRep.cmdValue.cmdPtr;
3412 }
3413
3414 /* -----------------------------------------------------------------------------
3415 * Variables
3416 * ---------------------------------------------------------------------------*/
3417
3418 /* Variables HashTable Type.
3419 *
3420 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3421 static void JimVariablesHTValDestructor(void *interp, void *val)
3422 {
3423 Jim_Var *varPtr = (void*) val;
3424
3425 Jim_DecrRefCount(interp, varPtr->objPtr);
3426 Jim_Free(val);
3427 }
3428
3429 static Jim_HashTableType JimVariablesHashTableType = {
3430 JimStringCopyHTHashFunction, /* hash function */
3431 JimStringCopyHTKeyDup, /* key dup */
3432 NULL, /* val dup */
3433 JimStringCopyHTKeyCompare, /* key compare */
3434 JimStringCopyHTKeyDestructor, /* key destructor */
3435 JimVariablesHTValDestructor /* val destructor */
3436 };
3437
3438 /* -----------------------------------------------------------------------------
3439 * Variable object
3440 * ---------------------------------------------------------------------------*/
3441
3442 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
3443
3444 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3445
3446 static Jim_ObjType variableObjType = {
3447 "variable",
3448 NULL,
3449 NULL,
3450 NULL,
3451 JIM_TYPE_REFERENCES,
3452 };
3453
3454 /* Return true if the string "str" looks like syntax sugar for [dict]. I.e.
3455 * is in the form "varname(key)". */
3456 static int Jim_NameIsDictSugar(const char *str, int len)
3457 {
3458 if (len == -1)
3459 len = strlen(str);
3460 if (len && str[len-1] == ')' && strchr(str, '(') != NULL)
3461 return 1;
3462 return 0;
3463 }
3464
3465 /* This method should be called only by the variable API.
3466 * It returns JIM_OK on success (variable already exists),
3467 * JIM_ERR if it does not exists, JIM_DICT_GLUE if it's not
3468 * a variable name, but syntax glue for [dict] i.e. the last
3469 * character is ')' */
3470 int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3471 {
3472 Jim_HashEntry *he;
3473 const char *varName;
3474 int len;
3475
3476 /* Check if the object is already an uptodate variable */
3477 if (objPtr->typePtr == &variableObjType &&
3478 objPtr->internalRep.varValue.callFrameId == interp->framePtr->id)
3479 return JIM_OK; /* nothing to do */
3480 /* Get the string representation */
3481 varName = Jim_GetString(objPtr, &len);
3482 /* Make sure it's not syntax glue to get/set dict. */
3483 if (Jim_NameIsDictSugar(varName, len))
3484 return JIM_DICT_SUGAR;
3485 if (varName[0] == ':' && varName[1] == ':') {
3486 he = Jim_FindHashEntry(&interp->topFramePtr->vars, varName + 2);
3487 if (he == NULL) {
3488 return JIM_ERR;
3489 }
3490 }
3491 else {
3492 /* Lookup this name into the variables hash table */
3493 he = Jim_FindHashEntry(&interp->framePtr->vars, varName);
3494 if (he == NULL) {
3495 /* Try with static vars. */
3496 if (interp->framePtr->staticVars == NULL)
3497 return JIM_ERR;
3498 if (!(he = Jim_FindHashEntry(interp->framePtr->staticVars, varName)))
3499 return JIM_ERR;
3500 }
3501 }
3502 /* Free the old internal repr and set the new one. */
3503 Jim_FreeIntRep(interp, objPtr);
3504 objPtr->typePtr = &variableObjType;
3505 objPtr->internalRep.varValue.callFrameId = interp->framePtr->id;
3506 objPtr->internalRep.varValue.varPtr = (void*)he->val;
3507 return JIM_OK;
3508 }
3509
3510 /* -------------------- Variables related functions ------------------------- */
3511 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr,
3512 Jim_Obj *valObjPtr);
3513 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr);
3514
3515 /* For now that's dummy. Variables lookup should be optimized
3516 * in many ways, with caching of lookups, and possibly with
3517 * a table of pre-allocated vars in every CallFrame for local vars.
3518 * All the caching should also have an 'epoch' mechanism similar
3519 * to the one used by Tcl for procedures lookup caching. */
3520
3521 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
3522 {
3523 const char *name;
3524 Jim_Var *var;
3525 int err;
3526
3527 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3528 /* Check for [dict] syntax sugar. */
3529 if (err == JIM_DICT_SUGAR)
3530 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
3531 /* New variable to create */
3532 name = Jim_GetString(nameObjPtr, NULL);
3533
3534 var = Jim_Alloc(sizeof(*var));
3535 var->objPtr = valObjPtr;
3536 Jim_IncrRefCount(valObjPtr);
3537 var->linkFramePtr = NULL;
3538 /* Insert the new variable */
3539 if (name[0] == ':' && name[1] == ':') {
3540 /* Into to the top evel frame */
3541 Jim_AddHashEntry(&interp->topFramePtr->vars, name + 2, var);
3542 }
3543 else {
3544 Jim_AddHashEntry(&interp->framePtr->vars, name, var);
3545 }
3546 /* Make the object int rep a variable */
3547 Jim_FreeIntRep(interp, nameObjPtr);
3548 nameObjPtr->typePtr = &variableObjType;
3549 nameObjPtr->internalRep.varValue.callFrameId =
3550 interp->framePtr->id;
3551 nameObjPtr->internalRep.varValue.varPtr = var;
3552 } else {
3553 var = nameObjPtr->internalRep.varValue.varPtr;
3554 if (var->linkFramePtr == NULL) {
3555 Jim_IncrRefCount(valObjPtr);
3556 Jim_DecrRefCount(interp, var->objPtr);
3557 var->objPtr = valObjPtr;
3558 } else { /* Else handle the link */
3559 Jim_CallFrame *savedCallFrame;
3560
3561 savedCallFrame = interp->framePtr;
3562 interp->framePtr = var->linkFramePtr;
3563 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
3564 interp->framePtr = savedCallFrame;
3565 if (err != JIM_OK)
3566 return err;
3567 }
3568 }
3569 return JIM_OK;
3570 }
3571
3572 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
3573 {
3574 Jim_Obj *nameObjPtr;
3575 int result;
3576
3577 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3578 Jim_IncrRefCount(nameObjPtr);
3579 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
3580 Jim_DecrRefCount(interp, nameObjPtr);
3581 return result;
3582 }
3583
3584 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
3585 {
3586 Jim_CallFrame *savedFramePtr;
3587 int result;
3588
3589 savedFramePtr = interp->framePtr;
3590 interp->framePtr = interp->topFramePtr;
3591 result = Jim_SetVariableStr(interp, name, objPtr);
3592 interp->framePtr = savedFramePtr;
3593 return result;
3594 }
3595
3596 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
3597 {
3598 Jim_Obj *nameObjPtr, *valObjPtr;
3599 int result;
3600
3601 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3602 valObjPtr = Jim_NewStringObj(interp, val, -1);
3603 Jim_IncrRefCount(nameObjPtr);
3604 Jim_IncrRefCount(valObjPtr);
3605 result = Jim_SetVariable(interp, nameObjPtr, valObjPtr);
3606 Jim_DecrRefCount(interp, nameObjPtr);
3607 Jim_DecrRefCount(interp, valObjPtr);
3608 return result;
3609 }
3610
3611 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
3612 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
3613 {
3614 const char *varName;
3615 int len;
3616
3617 /* Check for cycles. */
3618 if (interp->framePtr == targetCallFrame) {
3619 Jim_Obj *objPtr = targetNameObjPtr;
3620 Jim_Var *varPtr;
3621 /* Cycles are only possible with 'uplevel 0' */
3622 while(1) {
3623 if (Jim_StringEqObj(objPtr, nameObjPtr, 0)) {
3624 Jim_SetResultString(interp,
3625 "can't upvar from variable to itself", -1);
3626 return JIM_ERR;
3627 }
3628 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
3629 break;
3630 varPtr = objPtr->internalRep.varValue.varPtr;
3631 if (varPtr->linkFramePtr != targetCallFrame) break;
3632 objPtr = varPtr->objPtr;
3633 }
3634 }
3635 varName = Jim_GetString(nameObjPtr, &len);
3636 if (Jim_NameIsDictSugar(varName, len)) {
3637 Jim_SetResultString(interp,
3638 "Dict key syntax invalid as link source", -1);
3639 return JIM_ERR;
3640 }
3641 /* Perform the binding */
3642 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
3643 /* We are now sure 'nameObjPtr' type is variableObjType */
3644 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
3645 return JIM_OK;
3646 }
3647
3648 /* Return the Jim_Obj pointer associated with a variable name,
3649 * or NULL if the variable was not found in the current context.
3650 * The same optimization discussed in the comment to the
3651 * 'SetVariable' function should apply here. */
3652 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
3653 {
3654 int err;
3655
3656 /* All the rest is handled here */
3657 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3658 /* Check for [dict] syntax sugar. */
3659 if (err == JIM_DICT_SUGAR)
3660 return JimDictSugarGet(interp, nameObjPtr);
3661 if (flags & JIM_ERRMSG) {
3662 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3663 Jim_AppendStrings(interp, Jim_GetResult(interp),
3664 "can't read \"", nameObjPtr->bytes,
3665 "\": no such variable", NULL);
3666 }
3667 return NULL;
3668 } else {
3669 Jim_Var *varPtr;
3670 Jim_Obj *objPtr;
3671 Jim_CallFrame *savedCallFrame;
3672
3673 varPtr = nameObjPtr->internalRep.varValue.varPtr;
3674 if (varPtr->linkFramePtr == NULL)
3675 return varPtr->objPtr;
3676 /* The variable is a link? Resolve it. */
3677 savedCallFrame = interp->framePtr;
3678 interp->framePtr = varPtr->linkFramePtr;
3679 objPtr = Jim_GetVariable(interp, varPtr->objPtr, JIM_NONE);
3680 if (objPtr == NULL && flags & JIM_ERRMSG) {
3681 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3682 Jim_AppendStrings(interp, Jim_GetResult(interp),
3683 "can't read \"", nameObjPtr->bytes,
3684 "\": no such variable", NULL);
3685 }
3686 interp->framePtr = savedCallFrame;
3687 return objPtr;
3688 }
3689 }
3690
3691 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr,
3692 int flags)
3693 {
3694 Jim_CallFrame *savedFramePtr;
3695 Jim_Obj *objPtr;
3696
3697 savedFramePtr = interp->framePtr;
3698 interp->framePtr = interp->topFramePtr;
3699 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
3700 interp->framePtr = savedFramePtr;
3701
3702 return objPtr;
3703 }
3704
3705 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
3706 {
3707 Jim_Obj *nameObjPtr, *varObjPtr;
3708
3709 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3710 Jim_IncrRefCount(nameObjPtr);
3711 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
3712 Jim_DecrRefCount(interp, nameObjPtr);
3713 return varObjPtr;
3714 }
3715
3716 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name,
3717 int flags)
3718 {
3719 Jim_CallFrame *savedFramePtr;
3720 Jim_Obj *objPtr;
3721
3722 savedFramePtr = interp->framePtr;
3723 interp->framePtr = interp->topFramePtr;
3724 objPtr = Jim_GetVariableStr(interp, name, flags);
3725 interp->framePtr = savedFramePtr;
3726
3727 return objPtr;
3728 }
3729
3730 /* Unset a variable.
3731 * Note: On success unset invalidates all the variable objects created
3732 * in the current call frame incrementing. */
3733 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
3734 {
3735 const char *name;
3736 Jim_Var *varPtr;
3737 int err;
3738
3739 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3740 /* Check for [dict] syntax sugar. */
3741 if (err == JIM_DICT_SUGAR)
3742 return JimDictSugarSet(interp, nameObjPtr, NULL);
3743 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3744 Jim_AppendStrings(interp, Jim_GetResult(interp),
3745 "can't unset \"", nameObjPtr->bytes,
3746 "\": no such variable", NULL);
3747 return JIM_ERR; /* var not found */
3748 }
3749 varPtr = nameObjPtr->internalRep.varValue.varPtr;
3750 /* If it's a link call UnsetVariable recursively */
3751 if (varPtr->linkFramePtr) {
3752 int retval;
3753
3754 Jim_CallFrame *savedCallFrame;
3755
3756 savedCallFrame = interp->framePtr;
3757 interp->framePtr = varPtr->linkFramePtr;
3758 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
3759 interp->framePtr = savedCallFrame;
3760 if (retval != JIM_OK && flags & JIM_ERRMSG) {
3761 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3762 Jim_AppendStrings(interp, Jim_GetResult(interp),
3763 "can't unset \"", nameObjPtr->bytes,
3764 "\": no such variable", NULL);
3765 }
3766 return retval;
3767 } else {
3768 name = Jim_GetString(nameObjPtr, NULL);
3769 if (Jim_DeleteHashEntry(&interp->framePtr->vars, name)
3770 != JIM_OK) return JIM_ERR;
3771 /* Change the callframe id, invalidating var lookup caching */
3772 JimChangeCallFrameId(interp, interp->framePtr);
3773 return JIM_OK;
3774 }
3775 }
3776
3777 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
3778
3779 /* Given a variable name for [dict] operation syntax sugar,
3780 * this function returns two objects, the first with the name
3781 * of the variable to set, and the second with the rispective key.
3782 * For example "foo(bar)" will return objects with string repr. of
3783 * "foo" and "bar".
3784 *
3785 * The returned objects have refcount = 1. The function can't fail. */
3786 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
3787 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
3788 {
3789 const char *str, *p;
3790 char *t;
3791 int len, keyLen, nameLen;
3792 Jim_Obj *varObjPtr, *keyObjPtr;
3793
3794 str = Jim_GetString(objPtr, &len);
3795 p = strchr(str, '(');
3796 p++;
3797 keyLen = len-((p-str)+1);
3798 nameLen = (p-str)-1;
3799 /* Create the objects with the variable name and key. */
3800 t = Jim_Alloc(nameLen+1);
3801 memcpy(t, str, nameLen);
3802 t[nameLen] = '\0';
3803 varObjPtr = Jim_NewStringObjNoAlloc(interp, t, nameLen);
3804
3805 t = Jim_Alloc(keyLen+1);
3806 memcpy(t, p, keyLen);
3807 t[keyLen] = '\0';
3808 keyObjPtr = Jim_NewStringObjNoAlloc(interp, t, keyLen);
3809
3810 Jim_IncrRefCount(varObjPtr);
3811 Jim_IncrRefCount(keyObjPtr);
3812 *varPtrPtr = varObjPtr;
3813 *keyPtrPtr = keyObjPtr;
3814 }
3815
3816 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
3817 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
3818 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr,
3819 Jim_Obj *valObjPtr)
3820 {
3821 Jim_Obj *varObjPtr, *keyObjPtr;
3822 int err = JIM_OK;
3823
3824 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3825 err = Jim_SetDictKeysVector(interp, varObjPtr, &keyObjPtr, 1,
3826 valObjPtr);
3827 Jim_DecrRefCount(interp, varObjPtr);
3828 Jim_DecrRefCount(interp, keyObjPtr);
3829 return err;
3830 }
3831
3832 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
3833 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr)
3834 {
3835 Jim_Obj *varObjPtr, *keyObjPtr, *dictObjPtr, *resObjPtr;
3836
3837 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3838 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
3839 if (!dictObjPtr) {
3840 resObjPtr = NULL;
3841 goto err;
3842 }
3843 if (Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_ERRMSG)
3844 != JIM_OK) {
3845 resObjPtr = NULL;
3846 }
3847 err:
3848 Jim_DecrRefCount(interp, varObjPtr);
3849 Jim_DecrRefCount(interp, keyObjPtr);
3850 return resObjPtr;
3851 }
3852
3853 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
3854
3855 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3856 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr,
3857 Jim_Obj *dupPtr);
3858
3859 static Jim_ObjType dictSubstObjType = {
3860 "dict-substitution",
3861 FreeDictSubstInternalRep,
3862 DupDictSubstInternalRep,
3863 NULL,
3864 JIM_TYPE_NONE,
3865 };
3866
3867 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3868 {
3869 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
3870 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
3871 }
3872
3873 void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr,
3874 Jim_Obj *dupPtr)
3875 {
3876 JIM_NOTUSED(interp);
3877
3878 dupPtr->internalRep.dictSubstValue.varNameObjPtr =
3879 srcPtr->internalRep.dictSubstValue.varNameObjPtr;
3880 dupPtr->internalRep.dictSubstValue.indexObjPtr =
3881 srcPtr->internalRep.dictSubstValue.indexObjPtr;
3882 dupPtr->typePtr = &dictSubstObjType;
3883 }
3884
3885 /* This function is used to expand [dict get] sugar in the form
3886 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
3887 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
3888 * object that is *guaranteed* to be in the form VARNAME(INDEX).
3889 * The 'index' part is [subst]ituted, and is used to lookup a key inside
3890 * the [dict]ionary contained in variable VARNAME. */
3891 Jim_Obj *Jim_ExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
3892 {
3893 Jim_Obj *varObjPtr, *keyObjPtr, *dictObjPtr, *resObjPtr;
3894 Jim_Obj *substKeyObjPtr = NULL;
3895
3896 if (objPtr->typePtr != &dictSubstObjType) {
3897 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3898 Jim_FreeIntRep(interp, objPtr);
3899 objPtr->typePtr = &dictSubstObjType;
3900 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
3901 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
3902 }
3903 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
3904 &substKeyObjPtr, JIM_NONE)
3905 != JIM_OK) {
3906 substKeyObjPtr = NULL;
3907 goto err;
3908 }
3909 Jim_IncrRefCount(substKeyObjPtr);
3910 dictObjPtr = Jim_GetVariable(interp,
3911 objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_ERRMSG);
3912 if (!dictObjPtr) {
3913 resObjPtr = NULL;
3914 goto err;
3915 }
3916 if (Jim_DictKey(interp, dictObjPtr, substKeyObjPtr, &resObjPtr, JIM_ERRMSG)
3917 != JIM_OK) {
3918 resObjPtr = NULL;
3919 goto err;
3920 }
3921 err:
3922 if (substKeyObjPtr) Jim_DecrRefCount(interp, substKeyObjPtr);
3923 return resObjPtr;
3924 }
3925
3926 /* -----------------------------------------------------------------------------
3927 * CallFrame
3928 * ---------------------------------------------------------------------------*/
3929
3930 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp)
3931 {
3932 Jim_CallFrame *cf;
3933 if (interp->freeFramesList) {
3934 cf = interp->freeFramesList;
3935 interp->freeFramesList = cf->nextFramePtr;
3936 } else {
3937 cf = Jim_Alloc(sizeof(*cf));
3938 cf->vars.table = NULL;
3939 }
3940
3941 cf->id = interp->callFrameEpoch++;
3942 cf->parentCallFrame = NULL;
3943 cf->argv = NULL;
3944 cf->argc = 0;
3945 cf->procArgsObjPtr = NULL;
3946 cf->procBodyObjPtr = NULL;
3947 cf->nextFramePtr = NULL;
3948 cf->staticVars = NULL;
3949 if (cf->vars.table == NULL)
3950 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
3951 return cf;
3952 }
3953
3954 /* Used to invalidate every caching related to callframe stability. */
3955 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf)
3956 {
3957 cf->id = interp->callFrameEpoch++;
3958 }
3959
3960 #define JIM_FCF_NONE 0 /* no flags */
3961 #define JIM_FCF_NOHT 1 /* don't free the hash table */
3962 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf,
3963 int flags)
3964 {
3965 if (cf->procArgsObjPtr) Jim_DecrRefCount(interp, cf->procArgsObjPtr);
3966 if (cf->procBodyObjPtr) Jim_DecrRefCount(interp, cf->procBodyObjPtr);
3967 if (!(flags & JIM_FCF_NOHT))
3968 Jim_FreeHashTable(&cf->vars);
3969 else {
3970 int i;
3971 Jim_HashEntry **table = cf->vars.table, *he;
3972
3973 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
3974 he = table[i];
3975 while (he != NULL) {
3976 Jim_HashEntry *nextEntry = he->next;
3977 Jim_Var *varPtr = (void*) he->val;
3978
3979 Jim_DecrRefCount(interp, varPtr->objPtr);
3980 Jim_Free(he->val);
3981 Jim_Free((void*)he->key); /* ATTENTION: const cast */
3982 Jim_Free(he);
3983 table[i] = NULL;
3984 he = nextEntry;
3985 }
3986 }
3987 cf->vars.used = 0;
3988 }
3989 cf->nextFramePtr = interp->freeFramesList;
3990 interp->freeFramesList = cf;
3991 }
3992
3993 /* -----------------------------------------------------------------------------
3994 * References
3995 * ---------------------------------------------------------------------------*/
3996
3997 /* References HashTable Type.
3998 *
3999 * Keys are jim_wide integers, dynamically allocated for now but in the
4000 * future it's worth to cache this 8 bytes objects. Values are poitners
4001 * to Jim_References. */
4002 static void JimReferencesHTValDestructor(void *interp, void *val)
4003 {
4004 Jim_Reference *refPtr = (void*) val;
4005
4006 Jim_DecrRefCount(interp, refPtr->objPtr);
4007 if (refPtr->finalizerCmdNamePtr != NULL) {
4008 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
4009 }
4010 Jim_Free(val);
4011 }
4012
4013 unsigned int JimReferencesHTHashFunction(const void *key)
4014 {
4015 /* Only the least significant bits are used. */
4016 const jim_wide *widePtr = key;
4017 unsigned int intValue = (unsigned int) *widePtr;
4018 return Jim_IntHashFunction(intValue);
4019 }
4020
4021 unsigned int JimReferencesHTDoubleHashFunction(const void *key)
4022 {
4023 /* Only the least significant bits are used. */
4024 const jim_wide *widePtr = key;
4025 unsigned int intValue = (unsigned int) *widePtr;
4026 return intValue; /* identity function. */
4027 }
4028
4029 const void *JimReferencesHTKeyDup(void *privdata, const void *key)
4030 {
4031 void *copy = Jim_Alloc(sizeof(jim_wide));
4032 JIM_NOTUSED(privdata);
4033
4034 memcpy(copy, key, sizeof(jim_wide));
4035 return copy;
4036 }
4037
4038 int JimReferencesHTKeyCompare(void *privdata, const void *key1,
4039 const void *key2)
4040 {
4041 JIM_NOTUSED(privdata);
4042
4043 return memcmp(key1, key2, sizeof(jim_wide)) == 0;
4044 }
4045
4046 void JimReferencesHTKeyDestructor(void *privdata, const void *key)
4047 {
4048 JIM_NOTUSED(privdata);
4049
4050 Jim_Free((void*)key);
4051 }
4052
4053 static Jim_HashTableType JimReferencesHashTableType = {
4054 JimReferencesHTHashFunction, /* hash function */
4055 JimReferencesHTKeyDup, /* key dup */
4056 NULL, /* val dup */
4057 JimReferencesHTKeyCompare, /* key compare */
4058 JimReferencesHTKeyDestructor, /* key destructor */
4059 JimReferencesHTValDestructor /* val destructor */
4060 };
4061
4062 /* -----------------------------------------------------------------------------
4063 * Reference object type and References API
4064 * ---------------------------------------------------------------------------*/
4065
4066 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
4067
4068 static Jim_ObjType referenceObjType = {
4069 "reference",
4070 NULL,
4071 NULL,
4072 UpdateStringOfReference,
4073 JIM_TYPE_REFERENCES,
4074 };
4075
4076 void UpdateStringOfReference(struct Jim_Obj *objPtr)
4077 {
4078 int len;
4079 char buf[JIM_REFERENCE_SPACE+1];
4080 Jim_Reference *refPtr;
4081
4082 refPtr = objPtr->internalRep.refValue.refPtr;
4083 len = JimFormatReference(buf, refPtr, objPtr->internalRep.refValue.id);
4084 objPtr->bytes = Jim_Alloc(len+1);
4085 memcpy(objPtr->bytes, buf, len+1);
4086 objPtr->length = len;
4087 }
4088
4089 /* returns true if 'c' is a valid reference tag character.
4090 * i.e. inside the range [_a-zA-Z0-9] */
4091 static int isrefchar(int c)
4092 {
4093 if (c == '_' || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') ||
4094 (c >= '0' && c <= '9')) return 1;
4095 return 0;
4096 }
4097
4098 int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4099 {
4100 jim_wide wideValue;
4101 int i, len;
4102 const char *str, *start, *end;
4103 char refId[21];
4104 Jim_Reference *refPtr;
4105 Jim_HashEntry *he;
4106
4107 /* Get the string representation */
4108 str = Jim_GetString(objPtr, &len);
4109 /* Check if it looks like a reference */
4110 if (len < JIM_REFERENCE_SPACE) goto badformat;
4111 /* Trim spaces */
4112 start = str;
4113 end = str+len-1;
4114 while (*start == ' ') start++;
4115 while (*end == ' ' && end > start) end--;
4116 if (end-start+1 != JIM_REFERENCE_SPACE) goto badformat;
4117 /* <reference.<1234567>.%020> */
4118 if (memcmp(start, "<reference.<", 12) != 0) goto badformat;
4119 if (start[12+JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>') goto badformat;
4120 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
4121 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
4122 if (!isrefchar(start[12+i])) goto badformat;
4123 }
4124 /* Extract info from the refernece. */
4125 memcpy(refId, start+14+JIM_REFERENCE_TAGLEN, 20);
4126 refId[20] = '\0';
4127 /* Try to convert the ID into a jim_wide */
4128 if (Jim_StringToWide(refId, &wideValue, 10) != JIM_OK) goto badformat;
4129 /* Check if the reference really exists! */
4130 he = Jim_FindHashEntry(&interp->references, &wideValue);
4131 if (he == NULL) {
4132 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4133 Jim_AppendStrings(interp, Jim_GetResult(interp),
4134 "Invalid reference ID \"", str, "\"", NULL);
4135 return JIM_ERR;
4136 }
4137 refPtr = he->val;
4138 /* Free the old internal repr and set the new one. */
4139 Jim_FreeIntRep(interp, objPtr);
4140 objPtr->typePtr = &referenceObjType;
4141 objPtr->internalRep.refValue.id = wideValue;
4142 objPtr->internalRep.refValue.refPtr = refPtr;
4143 return JIM_OK;
4144
4145 badformat:
4146 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4147 Jim_AppendStrings(interp, Jim_GetResult(interp),
4148 "expected reference but got \"", str, "\"", NULL);
4149 return JIM_ERR;
4150 }
4151
4152 /* Returns a new reference pointing to objPtr, having cmdNamePtr
4153 * as finalizer command (or NULL if there is no finalizer).
4154 * The returned reference object has refcount = 0. */
4155 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr,
4156 Jim_Obj *cmdNamePtr)
4157 {
4158 struct Jim_Reference *refPtr;
4159 jim_wide wideValue = interp->referenceNextId;
4160 Jim_Obj *refObjPtr;
4161 const char *tag;
4162 int tagLen, i;
4163
4164 /* Perform the Garbage Collection if needed. */
4165 Jim_CollectIfNeeded(interp);
4166
4167 refPtr = Jim_Alloc(sizeof(*refPtr));
4168 refPtr->objPtr = objPtr;
4169 Jim_IncrRefCount(objPtr);
4170 refPtr->finalizerCmdNamePtr = cmdNamePtr;
4171 if (cmdNamePtr)
4172 Jim_IncrRefCount(cmdNamePtr);
4173 Jim_AddHashEntry(&interp->references, &wideValue, refPtr);
4174 refObjPtr = Jim_NewObj(interp);
4175 refObjPtr->typePtr = &referenceObjType;
4176 refObjPtr->bytes = NULL;
4177 refObjPtr->internalRep.refValue.id = interp->referenceNextId;
4178 refObjPtr->internalRep.refValue.refPtr = refPtr;
4179 interp->referenceNextId++;
4180 /* Set the tag. Trimmered at JIM_REFERENCE_TAGLEN. Everything
4181 * that does not pass the 'isrefchar' test is replaced with '_' */
4182 tag = Jim_GetString(tagPtr, &tagLen);
4183 if (tagLen > JIM_REFERENCE_TAGLEN)
4184 tagLen = JIM_REFERENCE_TAGLEN;
4185 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
4186 if (i < tagLen)
4187 refPtr->tag[i] = tag[i];
4188 else
4189 refPtr->tag[i] = '_';
4190 }
4191 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
4192 return refObjPtr;
4193 }
4194
4195 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
4196 {
4197 if (objPtr->typePtr != &referenceObjType &&
4198 SetReferenceFromAny(interp, objPtr) == JIM_ERR)
4199 return NULL;
4200 return objPtr->internalRep.refValue.refPtr;
4201 }
4202
4203 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
4204 {
4205 Jim_Reference *refPtr;
4206
4207 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
4208 return JIM_ERR;
4209 Jim_IncrRefCount(cmdNamePtr);
4210 if (refPtr->finalizerCmdNamePtr)
4211 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
4212 refPtr->finalizerCmdNamePtr = cmdNamePtr;
4213 return JIM_OK;
4214 }
4215
4216 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
4217 {
4218 Jim_Reference *refPtr;
4219
4220 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
4221 return JIM_ERR;
4222 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
4223 return JIM_OK;
4224 }
4225
4226 /* -----------------------------------------------------------------------------
4227 * References Garbage Collection
4228 * ---------------------------------------------------------------------------*/
4229
4230 /* This the hash table type for the "MARK" phase of the GC */
4231 static Jim_HashTableType JimRefMarkHashTableType = {
4232 JimReferencesHTHashFunction, /* hash function */
4233 JimReferencesHTKeyDup, /* key dup */
4234 NULL, /* val dup */
4235 JimReferencesHTKeyCompare, /* key compare */
4236 JimReferencesHTKeyDestructor, /* key destructor */
4237 NULL /* val destructor */
4238 };
4239
4240 /* #define JIM_DEBUG_GC 1 */
4241
4242 /* Performs the garbage collection. */
4243 int Jim_Collect(Jim_Interp *interp)
4244 {
4245 Jim_HashTable marks;
4246 Jim_HashTableIterator *htiter;
4247 Jim_HashEntry *he;
4248 Jim_Obj *objPtr;
4249 int collected = 0;
4250
4251 /* Avoid recursive calls */
4252 if (interp->lastCollectId == -1) {
4253 /* Jim_Collect() already running. Return just now. */
4254 return 0;
4255 }
4256 interp->lastCollectId = -1;
4257
4258 /* Mark all the references found into the 'mark' hash table.
4259 * The references are searched in every live object that
4260 * is of a type that can contain references. */
4261 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
4262 objPtr = interp->liveList;
4263 while(objPtr) {
4264 if (objPtr->typePtr == NULL ||
4265 objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
4266 const char *str, *p;
4267 int len;
4268
4269 /* If the object is of type reference, to get the
4270 * Id is simple... */
4271 if (objPtr->typePtr == &referenceObjType) {
4272 Jim_AddHashEntry(&marks,
4273 &objPtr->internalRep.refValue.id, NULL);
4274 #ifdef JIM_DEBUG_GC
4275 Jim_fprintf(interp,interp->cookie_stdout,
4276 "MARK (reference): %d refcount: %d" JIM_NL,
4277 (int) objPtr->internalRep.refValue.id,
4278 objPtr->refCount);
4279 #endif
4280 objPtr = objPtr->nextObjPtr;
4281 continue;
4282 }
4283 /* Get the string repr of the object we want
4284 * to scan for references. */
4285 p = str = Jim_GetString(objPtr, &len);
4286 /* Skip objects too little to contain references. */
4287 if (len < JIM_REFERENCE_SPACE) {
4288 objPtr = objPtr->nextObjPtr;
4289 continue;
4290 }
4291 /* Extract references from the object string repr. */
4292 while(1) {
4293 int i;
4294 jim_wide id;
4295 char buf[21];
4296
4297 if ((p = strstr(p, "<reference.<")) == NULL)
4298 break;
4299 /* Check if it's a valid reference. */
4300 if (len-(p-str) < JIM_REFERENCE_SPACE) break;
4301 if (p[41] != '>' || p[19] != '>' || p[20] != '.') break;
4302 for (i = 21; i <= 40; i++)
4303 if (!isdigit((int)p[i]))
4304 break;
4305 /* Get the ID */
4306 memcpy(buf, p+21, 20);
4307 buf[20] = '\0';
4308 Jim_StringToWide(buf, &id, 10);
4309
4310 /* Ok, a reference for the given ID
4311 * was found. Mark it. */
4312 Jim_AddHashEntry(&marks, &id, NULL);
4313 #ifdef JIM_DEBUG_GC
4314 Jim_fprintf(interp,interp->cookie_stdout,"MARK: %d" JIM_NL, (int)id);
4315 #endif
4316 p += JIM_REFERENCE_SPACE;
4317 }
4318 }
4319 objPtr = objPtr->nextObjPtr;
4320 }
4321
4322 /* Run the references hash table to destroy every reference that
4323 * is not referenced outside (not present in the mark HT). */
4324 htiter = Jim_GetHashTableIterator(&interp->references);
4325 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
4326 const jim_wide *refId;
4327 Jim_Reference *refPtr;
4328
4329 refId = he->key;
4330 /* Check if in the mark phase we encountered
4331 * this reference. */
4332 if (Jim_FindHashEntry(&marks, refId) == NULL) {
4333 #ifdef JIM_DEBUG_GC
4334 Jim_fprintf(interp,interp->cookie_stdout,"COLLECTING %d" JIM_NL, (int)*refId);
4335 #endif
4336 collected++;
4337 /* Drop the reference, but call the
4338 * finalizer first if registered. */
4339 refPtr = he->val;
4340 if (refPtr->finalizerCmdNamePtr) {
4341 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE+1);
4342 Jim_Obj *objv[3], *oldResult;
4343
4344 JimFormatReference(refstr, refPtr, *refId);
4345
4346 objv[0] = refPtr->finalizerCmdNamePtr;
4347 objv[1] = Jim_NewStringObjNoAlloc(interp,
4348 refstr, 32);
4349 objv[2] = refPtr->objPtr;
4350 Jim_IncrRefCount(objv[0]);
4351 Jim_IncrRefCount(objv[1]);
4352 Jim_IncrRefCount(objv[2]);
4353
4354 /* Drop the reference itself */
4355 Jim_DeleteHashEntry(&interp->references, refId);
4356
4357 /* Call the finalizer. Errors ignored. */
4358 oldResult = interp->result;
4359 Jim_IncrRefCount(oldResult);
4360 Jim_EvalObjVector(interp, 3, objv);
4361 Jim_SetResult(interp, oldResult);
4362 Jim_DecrRefCount(interp, oldResult);
4363
4364 Jim_DecrRefCount(interp, objv[0]);
4365 Jim_DecrRefCount(interp, objv[1]);
4366 Jim_DecrRefCount(interp, objv[2]);
4367 } else {
4368 Jim_DeleteHashEntry(&interp->references, refId);
4369 }
4370 }
4371 }
4372 Jim_FreeHashTableIterator(htiter);
4373 Jim_FreeHashTable(&marks);
4374 interp->lastCollectId = interp->referenceNextId;
4375 interp->lastCollectTime = time(NULL);
4376 return collected;
4377 }
4378
4379 #define JIM_COLLECT_ID_PERIOD 5000
4380 #define JIM_COLLECT_TIME_PERIOD 300
4381
4382 void Jim_CollectIfNeeded(Jim_Interp *interp)
4383 {
4384 jim_wide elapsedId;
4385 int elapsedTime;
4386
4387 elapsedId = interp->referenceNextId - interp->lastCollectId;
4388 elapsedTime = time(NULL) - interp->lastCollectTime;
4389
4390
4391 if (elapsedId > JIM_COLLECT_ID_PERIOD ||
4392 elapsedTime > JIM_COLLECT_TIME_PERIOD) {
4393 Jim_Collect(interp);
4394 }
4395 }
4396
4397 /* -----------------------------------------------------------------------------
4398 * Interpreter related functions
4399 * ---------------------------------------------------------------------------*/
4400
4401 Jim_Interp *Jim_CreateInterp(void)
4402 {
4403 Jim_Interp *i = Jim_Alloc(sizeof(*i));
4404 Jim_Obj *pathPtr;
4405
4406 i->errorLine = 0;
4407 i->errorFileName = Jim_StrDup("");
4408 i->numLevels = 0;
4409 i->maxNestingDepth = JIM_MAX_NESTING_DEPTH;
4410 i->returnCode = JIM_OK;
4411 i->exitCode = 0;
4412 i->procEpoch = 0;
4413 i->callFrameEpoch = 0;
4414 i->liveList = i->freeList = NULL;
4415 i->scriptFileName = Jim_StrDup("");
4416 i->referenceNextId = 0;
4417 i->lastCollectId = 0;
4418 i->lastCollectTime = time(NULL);
4419 i->freeFramesList = NULL;
4420 i->prngState = NULL;
4421 i->evalRetcodeLevel = -1;
4422 i->cookie_stdin = stdin;
4423 i->cookie_stdout = stdout;
4424 i->cookie_stderr = stderr;
4425 i->cb_fwrite = ((size_t (*)( const void *, size_t, size_t, void *))(fwrite));
4426 i->cb_fread = ((size_t (*)( void *, size_t, size_t, void *))(fread));
4427 i->cb_vfprintf = ((int (*)( void *, const char *fmt, va_list ))(vfprintf));
4428 i->cb_fflush = ((int (*)( void *))(fflush));
4429 i->cb_fgets = ((char * (*)( char *, int, void *))(fgets));
4430
4431 /* Note that we can create objects only after the
4432 * interpreter liveList and freeList pointers are
4433 * initialized to NULL. */
4434 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
4435 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
4436 Jim_InitHashTable(&i->sharedStrings, &JimSharedStringsHashTableType,
4437 NULL);
4438 Jim_InitHashTable(&i->stub, &JimStringCopyHashTableType, NULL);
4439 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
4440 Jim_InitHashTable(&i->packages, &JimStringKeyValCopyHashTableType, NULL);
4441 i->framePtr = i->topFramePtr = JimCreateCallFrame(i);
4442 i->emptyObj = Jim_NewEmptyStringObj(i);
4443 i->result = i->emptyObj;
4444 i->stackTrace = Jim_NewListObj(i, NULL, 0);
4445 i->unknown = Jim_NewStringObj(i, "unknown", -1);
4446 i->unknown_called = 0;
4447 Jim_IncrRefCount(i->emptyObj);
4448 Jim_IncrRefCount(i->result);
4449 Jim_IncrRefCount(i->stackTrace);
4450 Jim_IncrRefCount(i->unknown);
4451
4452 /* Initialize key variables every interpreter should contain */
4453 pathPtr = Jim_NewStringObj(i, "./", -1);
4454 Jim_SetVariableStr(i, "jim_libpath", pathPtr);
4455 Jim_SetVariableStrWithStr(i, "jim_interactive", "0");
4456
4457 /* Export the core API to extensions */
4458 JimRegisterCoreApi(i);
4459 return i;
4460 }
4461
4462 /* This is the only function Jim exports directly without
4463 * to use the STUB system. It is only used by embedders
4464 * in order to get an interpreter with the Jim API pointers
4465 * registered. */
4466 Jim_Interp *ExportedJimCreateInterp(void)
4467 {
4468 return Jim_CreateInterp();
4469 }
4470
4471 void Jim_FreeInterp(Jim_Interp *i)
4472 {
4473 Jim_CallFrame *cf = i->framePtr, *prevcf, *nextcf;
4474 Jim_Obj *objPtr, *nextObjPtr;
4475
4476 Jim_DecrRefCount(i, i->emptyObj);
4477 Jim_DecrRefCount(i, i->result);
4478 Jim_DecrRefCount(i, i->stackTrace);
4479 Jim_DecrRefCount(i, i->unknown);
4480 Jim_Free((void*)i->errorFileName);
4481 Jim_Free((void*)i->scriptFileName);
4482 Jim_FreeHashTable(&i->commands);
4483 Jim_FreeHashTable(&i->references);
4484 Jim_FreeHashTable(&i->stub);
4485 Jim_FreeHashTable(&i->assocData);
4486 Jim_FreeHashTable(&i->packages);
4487 Jim_Free(i->prngState);
4488 /* Free the call frames list */
4489 while(cf) {
4490 prevcf = cf->parentCallFrame;
4491 JimFreeCallFrame(i, cf, JIM_FCF_NONE);
4492 cf = prevcf;
4493 }
4494 /* Check that the live object list is empty, otherwise
4495 * there is a memory leak. */
4496 if (i->liveList != NULL) {
4497 Jim_Obj *objPtr = i->liveList;
4498
4499 Jim_fprintf( i, i->cookie_stdout,JIM_NL "-------------------------------------" JIM_NL);
4500 Jim_fprintf( i, i->cookie_stdout,"Objects still in the free list:" JIM_NL);
4501 while(objPtr) {
4502 const char *type = objPtr->typePtr ?
4503 objPtr->typePtr->name : "";
4504 Jim_fprintf( i, i->cookie_stdout,"%p \"%-10s\": '%.20s' (refCount: %d)" JIM_NL,
4505 objPtr, type,
4506 objPtr->bytes ? objPtr->bytes
4507 : "(null)", objPtr->refCount);
4508 if (objPtr->typePtr == &sourceObjType) {
4509 Jim_fprintf( i, i->cookie_stdout, "FILE %s LINE %d" JIM_NL,
4510 objPtr->internalRep.sourceValue.fileName,
4511 objPtr->internalRep.sourceValue.lineNumber);
4512 }
4513 objPtr = objPtr->nextObjPtr;
4514 }
4515 Jim_fprintf( i, i->cookie_stdout, "-------------------------------------" JIM_NL JIM_NL);
4516 Jim_Panic(i,"Live list non empty freeing the interpreter! Leak?");
4517 }
4518 /* Free all the freed objects. */
4519 objPtr = i->freeList;
4520 while (objPtr) {
4521 nextObjPtr = objPtr->nextObjPtr;
4522 Jim_Free(objPtr);
4523 objPtr = nextObjPtr;
4524 }
4525 /* Free cached CallFrame structures */
4526 cf = i->freeFramesList;
4527 while(cf) {
4528 nextcf = cf->nextFramePtr;
4529 if (cf->vars.table != NULL)
4530 Jim_Free(cf->vars.table);
4531 Jim_Free(cf);
4532 cf = nextcf;
4533 }
4534 /* Free the sharedString hash table. Make sure to free it
4535 * after every other Jim_Object was freed. */
4536 Jim_FreeHashTable(&i->sharedStrings);
4537 /* Free the interpreter structure. */
4538 Jim_Free(i);
4539 }
4540
4541 /* Store the call frame relative to the level represented by
4542 * levelObjPtr into *framePtrPtr. If levelObjPtr == NULL, the
4543 * level is assumed to be '1'.
4544 *
4545 * If a newLevelptr int pointer is specified, the function stores
4546 * the absolute level integer value of the new target callframe into
4547 * *newLevelPtr. (this is used to adjust interp->numLevels
4548 * in the implementation of [uplevel], so that [info level] will
4549 * return a correct information).
4550 *
4551 * This function accepts the 'level' argument in the form
4552 * of the commands [uplevel] and [upvar].
4553 *
4554 * For a function accepting a relative integer as level suitable
4555 * for implementation of [info level ?level?] check the
4556 * GetCallFrameByInteger() function. */
4557 int Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
4558 Jim_CallFrame **framePtrPtr, int *newLevelPtr)
4559 {
4560 long level;
4561 const char *str;
4562 Jim_CallFrame *framePtr;
4563
4564 if (newLevelPtr) *newLevelPtr = interp->numLevels;
4565 if (levelObjPtr) {
4566 str = Jim_GetString(levelObjPtr, NULL);
4567 if (str[0] == '#') {
4568 char *endptr;
4569 /* speedup for the toplevel (level #0) */
4570 if (str[1] == '0' && str[2] == '\0') {
4571 if (newLevelPtr) *newLevelPtr = 0;
4572 *framePtrPtr = interp->topFramePtr;
4573 return JIM_OK;
4574 }
4575
4576 level = strtol(str+1, &endptr, 0);
4577 if (str[1] == '\0' || endptr[0] != '\0' || level < 0)
4578 goto badlevel;
4579 /* An 'absolute' level is converted into the
4580 * 'number of levels to go back' format. */
4581 level = interp->numLevels - level;
4582 if (level < 0) goto badlevel;
4583 } else {
4584 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0)
4585 goto badlevel;
4586 }
4587 } else {
4588 str = "1"; /* Needed to format the error message. */
4589 level = 1;
4590 }
4591 /* Lookup */
4592 framePtr = interp->framePtr;
4593 if (newLevelPtr) *newLevelPtr = (*newLevelPtr)-level;
4594 while (level--) {
4595 framePtr = framePtr->parentCallFrame;
4596 if (framePtr == NULL) goto badlevel;
4597 }
4598 *framePtrPtr = framePtr;
4599 return JIM_OK;
4600 badlevel:
4601 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4602 Jim_AppendStrings(interp, Jim_GetResult(interp),
4603 "bad level \"", str, "\"", NULL);
4604 return JIM_ERR;
4605 }
4606
4607 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
4608 * as a relative integer like in the [info level ?level?] command. */
4609 static int JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr,
4610 Jim_CallFrame **framePtrPtr)
4611 {
4612 jim_wide level;
4613 jim_wide relLevel; /* level relative to the current one. */
4614 Jim_CallFrame *framePtr;
4615
4616 if (Jim_GetWide(interp, levelObjPtr, &level) != JIM_OK)
4617 goto badlevel;
4618 if (level > 0) {
4619 /* An 'absolute' level is converted into the
4620 * 'number of levels to go back' format. */
4621 relLevel = interp->numLevels - level;
4622 } else {
4623 relLevel = -level;
4624 }
4625 /* Lookup */
4626 framePtr = interp->framePtr;
4627 while (relLevel--) {
4628 framePtr = framePtr->parentCallFrame;
4629 if (framePtr == NULL) goto badlevel;
4630 }
4631 *framePtrPtr = framePtr;
4632 return JIM_OK;
4633 badlevel:
4634 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4635 Jim_AppendStrings(interp, Jim_GetResult(interp),
4636 "bad level \"", Jim_GetString(levelObjPtr, NULL), "\"", NULL);
4637 return JIM_ERR;
4638 }
4639
4640 static void JimSetErrorFileName(Jim_Interp *interp, char *filename)
4641 {
4642 Jim_Free((void*)interp->errorFileName);
4643 interp->errorFileName = Jim_StrDup(filename);
4644 }
4645
4646 static void JimSetErrorLineNumber(Jim_Interp *interp, int linenr)
4647 {
4648 interp->errorLine = linenr;
4649 }
4650
4651 static void JimResetStackTrace(Jim_Interp *interp)
4652 {
4653 Jim_DecrRefCount(interp, interp->stackTrace);
4654 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
4655 Jim_IncrRefCount(interp->stackTrace);
4656 }
4657
4658 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
4659 const char *filename, int linenr)
4660 {
4661 /* No need to add this dummy entry to the stack trace */
4662 if (strcmp(procname, "unknown") == 0) {
4663 return;
4664 }
4665
4666 if (Jim_IsShared(interp->stackTrace)) {
4667 interp->stackTrace =
4668 Jim_DuplicateObj(interp, interp->stackTrace);
4669 Jim_IncrRefCount(interp->stackTrace);
4670 }
4671 Jim_ListAppendElement(interp, interp->stackTrace,
4672 Jim_NewStringObj(interp, procname, -1));
4673 Jim_ListAppendElement(interp, interp->stackTrace,
4674 Jim_NewStringObj(interp, filename, -1));
4675 Jim_ListAppendElement(interp, interp->stackTrace,
4676 Jim_NewIntObj(interp, linenr));
4677 }
4678
4679 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc *delProc, void *data)
4680 {
4681 AssocDataValue *assocEntryPtr = (AssocDataValue *)Jim_Alloc(sizeof(AssocDataValue));
4682 assocEntryPtr->delProc = delProc;
4683 assocEntryPtr->data = data;
4684 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
4685 }
4686
4687 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
4688 {
4689 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
4690 if (entryPtr != NULL) {
4691 AssocDataValue *assocEntryPtr = (AssocDataValue *)entryPtr->val;
4692 return assocEntryPtr->data;
4693 }
4694 return NULL;
4695 }
4696
4697 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
4698 {
4699 return Jim_DeleteHashEntry(&interp->assocData, key);
4700 }
4701
4702 int Jim_GetExitCode(Jim_Interp *interp) {
4703 return interp->exitCode;
4704 }
4705
4706 void *Jim_SetStdin(Jim_Interp *interp, void *fp)
4707 {
4708 if (fp != NULL) interp->cookie_stdin = fp;
4709 return interp->cookie_stdin;
4710 }
4711
4712 void *Jim_SetStdout(Jim_Interp *interp, void *fp)
4713 {
4714 if (fp != NULL) interp->cookie_stdout = fp;
4715 return interp->cookie_stdout;
4716 }
4717
4718 void *Jim_SetStderr(Jim_Interp *interp, void *fp)
4719 {
4720 if (fp != NULL) interp->cookie_stderr = fp;
4721 return interp->cookie_stderr;
4722 }
4723
4724 /* -----------------------------------------------------------------------------
4725 * Shared strings.
4726 * Every interpreter has an hash table where to put shared dynamically
4727 * allocate strings that are likely to be used a lot of times.
4728 * For example, in the 'source' object type, there is a pointer to
4729 * the filename associated with that object. Every script has a lot
4730 * of this objects with the identical file name, so it is wise to share
4731 * this info.
4732 *
4733 * The API is trivial: Jim_GetSharedString(interp, "foobar")
4734 * returns the pointer to the shared string. Every time a reference
4735 * to the string is no longer used, the user should call
4736 * Jim_ReleaseSharedString(interp, stringPointer). Once no one is using
4737 * a given string, it is removed from the hash table.
4738 * ---------------------------------------------------------------------------*/
4739 const char *Jim_GetSharedString(Jim_Interp *interp, const char *str)
4740 {
4741 Jim_HashEntry *he = Jim_FindHashEntry(&interp->sharedStrings, str);
4742
4743 if (he == NULL) {
4744 char *strCopy = Jim_StrDup(str);
4745
4746 Jim_AddHashEntry(&interp->sharedStrings, strCopy, (void*)1);
4747 return strCopy;
4748 } else {
4749 long refCount = (long) he->val;
4750
4751 refCount++;
4752 he->val = (void*) refCount;
4753 return he->key;
4754 }
4755 }
4756
4757 void Jim_ReleaseSharedString(Jim_Interp *interp, const char *str)
4758 {
4759 long refCount;
4760 Jim_HashEntry *he = Jim_FindHashEntry(&interp->sharedStrings, str);
4761
4762 if (he == NULL)
4763 Jim_Panic(interp,"Jim_ReleaseSharedString called with "
4764 "unknown shared string '%s'", str);
4765 refCount = (long) he->val;
4766 refCount--;
4767 if (refCount == 0) {
4768 Jim_DeleteHashEntry(&interp->sharedStrings, str);
4769 } else {
4770 he->val = (void*) refCount;
4771 }
4772 }
4773
4774 /* -----------------------------------------------------------------------------
4775 * Integer object
4776 * ---------------------------------------------------------------------------*/
4777 #define JIM_INTEGER_SPACE 24
4778
4779 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
4780 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
4781
4782 static Jim_ObjType intObjType = {
4783 "int",
4784 NULL,
4785 NULL,
4786 UpdateStringOfInt,
4787 JIM_TYPE_NONE,
4788 };
4789
4790 void UpdateStringOfInt(struct Jim_Obj *objPtr)
4791 {
4792 int len;
4793 char buf[JIM_INTEGER_SPACE+1];
4794
4795 len = Jim_WideToString(buf, objPtr->internalRep.wideValue);
4796 objPtr->bytes = Jim_Alloc(len+1);
4797 memcpy(objPtr->bytes, buf, len+1);
4798 objPtr->length = len;
4799 }
4800
4801 int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4802 {
4803 jim_wide wideValue;
4804 const char *str;
4805
4806 /* Get the string representation */
4807 str = Jim_GetString(objPtr, NULL);
4808 /* Try to convert into a jim_wide */
4809 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
4810 if (flags & JIM_ERRMSG) {
4811 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4812 Jim_AppendStrings(interp, Jim_GetResult(interp),
4813 "expected integer but got \"", str, "\"", NULL);
4814 }
4815 return JIM_ERR;
4816 }
4817 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) &&
4818 errno == ERANGE) {
4819 Jim_SetResultString(interp,
4820 "Integer value too big to be represented", -1);
4821 return JIM_ERR;
4822 }
4823 /* Free the old internal repr and set the new one. */
4824 Jim_FreeIntRep(interp, objPtr);
4825 objPtr->typePtr = &intObjType;
4826 objPtr->internalRep.wideValue = wideValue;
4827 return JIM_OK;
4828 }
4829
4830 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide *widePtr)
4831 {
4832 if (objPtr->typePtr != &intObjType &&
4833 SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
4834 return JIM_ERR;
4835 *widePtr = objPtr->internalRep.wideValue;
4836 return JIM_OK;
4837 }
4838
4839 /* Get a wide but does not set an error if the format is bad. */
4840 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr,
4841 jim_wide *widePtr)
4842 {
4843 if (objPtr->typePtr != &intObjType &&
4844 SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
4845 return JIM_ERR;
4846 *widePtr = objPtr->internalRep.wideValue;
4847 return JIM_OK;
4848 }
4849
4850 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
4851 {
4852 jim_wide wideValue;
4853 int retval;
4854
4855 retval = Jim_GetWide(interp, objPtr, &wideValue);
4856 if (retval == JIM_OK) {
4857 *longPtr = (long) wideValue;
4858 return JIM_OK;
4859 }
4860 return JIM_ERR;
4861 }
4862
4863 void Jim_SetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide wideValue)
4864 {
4865 if (Jim_IsShared(objPtr))
4866 Jim_Panic(interp,"Jim_SetWide called with shared object");
4867 if (objPtr->typePtr != &intObjType) {
4868 Jim_FreeIntRep(interp, objPtr);
4869 objPtr->typePtr = &intObjType;
4870 }
4871 Jim_InvalidateStringRep(objPtr);
4872 objPtr->internalRep.wideValue = wideValue;
4873 }
4874
4875 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
4876 {
4877 Jim_Obj *objPtr;
4878
4879 objPtr = Jim_NewObj(interp);
4880 objPtr->typePtr = &intObjType;
4881 objPtr->bytes = NULL;
4882 objPtr->internalRep.wideValue = wideValue;
4883 return objPtr;
4884 }
4885
4886 /* -----------------------------------------------------------------------------
4887 * Double object
4888 * ---------------------------------------------------------------------------*/
4889 #define JIM_DOUBLE_SPACE 30
4890
4891 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
4892 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
4893
4894 static Jim_ObjType doubleObjType = {
4895 "double",
4896 NULL,
4897 NULL,
4898 UpdateStringOfDouble,
4899 JIM_TYPE_NONE,
4900 };
4901
4902 void UpdateStringOfDouble(struct Jim_Obj *objPtr)
4903 {
4904 int len;
4905 char buf[JIM_DOUBLE_SPACE+1];
4906
4907 len = Jim_DoubleToString(buf, objPtr->internalRep.doubleValue);
4908 objPtr->bytes = Jim_Alloc(len+1);
4909 memcpy(objPtr->bytes, buf, len+1);
4910 objPtr->length = len;
4911 }
4912
4913 int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4914 {
4915 double doubleValue;
4916 const char *str;
4917
4918 /* Get the string representation */
4919 str = Jim_GetString(objPtr, NULL);
4920 /* Try to convert into a double */
4921 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
4922 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4923 Jim_AppendStrings(interp, Jim_GetResult(interp),
4924 "expected number but got '", str, "'", NULL);
4925 return JIM_ERR;
4926 }
4927 /* Free the old internal repr and set the new one. */
4928 Jim_FreeIntRep(interp, objPtr);
4929 objPtr->typePtr = &doubleObjType;
4930 objPtr->internalRep.doubleValue = doubleValue;
4931 return JIM_OK;
4932 }
4933
4934 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
4935 {
4936 if (objPtr->typePtr != &doubleObjType &&
4937 SetDoubleFromAny(interp, objPtr) == JIM_ERR)
4938 return JIM_ERR;
4939 *doublePtr = objPtr->internalRep.doubleValue;
4940 return JIM_OK;
4941 }
4942
4943 void Jim_SetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double doubleValue)
4944 {
4945 if (Jim_IsShared(objPtr))
4946 Jim_Panic(interp,"Jim_SetDouble called with shared object");
4947 if (objPtr->typePtr != &doubleObjType) {
4948 Jim_FreeIntRep(interp, objPtr);
4949 objPtr->typePtr = &doubleObjType;
4950 }
4951 Jim_InvalidateStringRep(objPtr);
4952 objPtr->internalRep.doubleValue = doubleValue;
4953 }
4954
4955 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
4956 {
4957 Jim_Obj *objPtr;
4958
4959 objPtr = Jim_NewObj(interp);
4960 objPtr->typePtr = &doubleObjType;
4961 objPtr->bytes = NULL;
4962 objPtr->internalRep.doubleValue = doubleValue;
4963 return objPtr;
4964 }
4965
4966 /* -----------------------------------------------------------------------------
4967 * List object
4968 * ---------------------------------------------------------------------------*/
4969 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
4970 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
4971 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
4972 static void UpdateStringOfList(struct Jim_Obj *objPtr);
4973 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4974
4975 /* Note that while the elements of the list may contain references,
4976 * the list object itself can't. This basically means that the
4977 * list object string representation as a whole can't contain references
4978 * that are not presents in the single elements. */
4979 static Jim_ObjType listObjType = {
4980 "list",
4981 FreeListInternalRep,
4982 DupListInternalRep,
4983 UpdateStringOfList,
4984 JIM_TYPE_NONE,
4985 };
4986
4987 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4988 {
4989 int i;
4990
4991 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
4992 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
4993 }
4994 Jim_Free(objPtr->internalRep.listValue.ele);
4995 }
4996
4997 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4998 {
4999 int i;
5000 JIM_NOTUSED(interp);
5001
5002 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
5003 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
5004 dupPtr->internalRep.listValue.ele =
5005 Jim_Alloc(sizeof(Jim_Obj*)*srcPtr->internalRep.listValue.maxLen);
5006 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
5007 sizeof(Jim_Obj*)*srcPtr->internalRep.listValue.len);
5008 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
5009 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
5010 }
5011 dupPtr->typePtr = &listObjType;
5012 }
5013
5014 /* The following function checks if a given string can be encoded
5015 * into a list element without any kind of quoting, surrounded by braces,
5016 * or using escapes to quote. */
5017 #define JIM_ELESTR_SIMPLE 0
5018 #define JIM_ELESTR_BRACE 1
5019 #define JIM_ELESTR_QUOTE 2
5020 static int ListElementQuotingType(const char *s, int len)
5021 {
5022 int i, level, trySimple = 1;
5023
5024 /* Try with the SIMPLE case */
5025 if (len == 0) return JIM_ELESTR_BRACE;
5026 if (s[0] == '"' || s[0] == '{') {
5027 trySimple = 0;
5028 goto testbrace;
5029 }
5030 for (i = 0; i < len; i++) {
5031 switch(s[i]) {
5032 case ' ':
5033 case '$':
5034 case '"':
5035 case '[':
5036 case ']':
5037 case ';':
5038 case '\\':
5039 case '\r':
5040 case '\n':
5041 case '\t':
5042 case '\f':
5043 case '\v':
5044 trySimple = 0;
5045 case '{':
5046 case '}':
5047 goto testbrace;
5048 }
5049 }
5050 return JIM_ELESTR_SIMPLE;
5051
5052 testbrace:
5053 /* Test if it's possible to do with braces */
5054 if (s[len-1] == '\\' ||
5055 s[len-1] == ']') return JIM_ELESTR_QUOTE;
5056 level = 0;
5057 for (i = 0; i < len; i++) {
5058 switch(s[i]) {
5059 case '{': level++; break;
5060 case '}': level--;
5061 if (level < 0) return JIM_ELESTR_QUOTE;
5062 break;
5063 case '\\':
5064 if (s[i+1] == '\n')
5065 return JIM_ELESTR_QUOTE;
5066 else
5067 if (s[i+1] != '\0') i++;
5068 break;
5069 }
5070 }
5071 if (level == 0) {
5072 if (!trySimple) return JIM_ELESTR_BRACE;
5073 for (i = 0; i < len; i++) {
5074 switch(s[i]) {
5075 case ' ':
5076 case '$':
5077 case '"':
5078 case '[':
5079 case ']':
5080 case ';':
5081 case '\\':
5082 case '\r':
5083 case '\n':
5084 case '\t':
5085 case '\f':
5086 case '\v':
5087 return JIM_ELESTR_BRACE;
5088 break;
5089 }
5090 }
5091 return JIM_ELESTR_SIMPLE;
5092 }
5093 return JIM_ELESTR_QUOTE;
5094 }
5095
5096 /* Returns the malloc-ed representation of a string
5097 * using backslash to quote special chars. */
5098 char *BackslashQuoteString(const char *s, int len, int *qlenPtr)
5099 {
5100 char *q = Jim_Alloc(len*2+1), *p;
5101
5102 p = q;
5103 while(*s) {
5104 switch (*s) {
5105 case ' ':
5106 case '$':
5107 case '"':
5108 case '[':
5109 case ']':
5110 case '{':
5111 case '}':
5112 case ';':
5113 case '\\':
5114 *p++ = '\\';
5115 *p++ = *s++;
5116 break;
5117 case '\n': *p++ = '\\'; *p++ = 'n'; s++; break;
5118 case '\r': *p++ = '\\'; *p++ = 'r'; s++; break;
5119 case '\t': *p++ = '\\'; *p++ = 't'; s++; break;
5120 case '\f': *p++ = '\\'; *p++ = 'f'; s++; break;
5121 case '\v': *p++ = '\\'; *p++ = 'v'; s++; break;
5122 default:
5123 *p++ = *s++;
5124 break;
5125 }
5126 }
5127 *p = '\0';
5128 *qlenPtr = p-q;
5129 return q;
5130 }
5131
5132 void UpdateStringOfList(struct Jim_Obj *objPtr)
5133 {
5134 int i, bufLen, realLength;
5135 const char *strRep;
5136 char *p;
5137 int *quotingType;
5138 Jim_Obj **ele = objPtr->internalRep.listValue.ele;
5139
5140 /* (Over) Estimate the space needed. */
5141 quotingType = Jim_Alloc(sizeof(int)*objPtr->internalRep.listValue.len+1);
5142 bufLen = 0;
5143 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5144 int len;
5145
5146 strRep = Jim_GetString(ele[i], &len);
5147 quotingType[i] = ListElementQuotingType(strRep, len);
5148 switch (quotingType[i]) {
5149 case JIM_ELESTR_SIMPLE: bufLen += len; break;
5150 case JIM_ELESTR_BRACE: bufLen += len+2; break;
5151 case JIM_ELESTR_QUOTE: bufLen += len*2; break;
5152 }
5153 bufLen++; /* elements separator. */
5154 }
5155 bufLen++;
5156
5157 /* Generate the string rep. */
5158 p = objPtr->bytes = Jim_Alloc(bufLen+1);
5159 realLength = 0;
5160 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5161 int len, qlen;
5162 const char *strRep = Jim_GetString(ele[i], &len);
5163 char *q;
5164
5165 switch(quotingType[i]) {
5166 case JIM_ELESTR_SIMPLE:
5167 memcpy(p, strRep, len);
5168 p += len;
5169 realLength += len;
5170 break;
5171 case JIM_ELESTR_BRACE:
5172 *p++ = '{';
5173 memcpy(p, strRep, len);
5174 p += len;
5175 *p++ = '}';
5176 realLength += len+2;
5177 break;
5178 case JIM_ELESTR_QUOTE:
5179 q = BackslashQuoteString(strRep, len, &qlen);
5180 memcpy(p, q, qlen);
5181 Jim_Free(q);
5182 p += qlen;
5183 realLength += qlen;
5184 break;
5185 }
5186 /* Add a separating space */
5187 if (i+1 != objPtr->internalRep.listValue.len) {
5188 *p++ = ' ';
5189 realLength ++;
5190 }
5191 }
5192 *p = '\0'; /* nul term. */
5193 objPtr->length = realLength;
5194 Jim_Free(quotingType);
5195 }
5196
5197 int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
5198 {
5199 struct JimParserCtx parser;
5200 const char *str;
5201 int strLen;
5202
5203 /* Get the string representation */
5204 str = Jim_GetString(objPtr, &strLen);
5205
5206 /* Free the old internal repr just now and initialize the
5207 * new one just now. The string->list conversion can't fail. */
5208 Jim_FreeIntRep(interp, objPtr);
5209 objPtr->typePtr = &listObjType;
5210 objPtr->internalRep.listValue.len = 0;
5211 objPtr->internalRep.listValue.maxLen = 0;
5212 objPtr->internalRep.listValue.ele = NULL;
5213
5214 /* Convert into a list */
5215 JimParserInit(&parser, str, strLen, 1);
5216 while(!JimParserEof(&parser)) {
5217 char *token;
5218 int tokenLen, type;
5219 Jim_Obj *elementPtr;
5220
5221 JimParseList(&parser);
5222 if (JimParserTtype(&parser) != JIM_TT_STR &&
5223 JimParserTtype(&parser) != JIM_TT_ESC)
5224 continue;
5225 token = JimParserGetToken(&parser, &tokenLen, &type, NULL);
5226 elementPtr = Jim_NewStringObjNoAlloc(interp, token, tokenLen);
5227 ListAppendElement(objPtr, elementPtr);
5228 }
5229 return JIM_OK;
5230 }
5231
5232 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements,
5233 int len)
5234 {
5235 Jim_Obj *objPtr;
5236 int i;
5237
5238 objPtr = Jim_NewObj(interp);
5239 objPtr->typePtr = &listObjType;
5240 objPtr->bytes = NULL;
5241 objPtr->internalRep.listValue.ele = NULL;
5242 objPtr->internalRep.listValue.len = 0;
5243 objPtr->internalRep.listValue.maxLen = 0;
5244 for (i = 0; i < len; i++) {
5245 ListAppendElement(objPtr, elements[i]);
5246 }
5247 return objPtr;
5248 }
5249
5250 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
5251 * length of the vector. Note that the user of this function should make
5252 * sure that the list object can't shimmer while the vector returned
5253 * is in use, this vector is the one stored inside the internal representation
5254 * of the list object. This function is not exported, extensions should
5255 * always access to the List object elements using Jim_ListIndex(). */
5256 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *argc,
5257 Jim_Obj ***listVec)
5258 {
5259 Jim_ListLength(interp, listObj, argc);
5260 assert(listObj->typePtr == &listObjType);
5261 *listVec = listObj->internalRep.listValue.ele;
5262 }
5263
5264 /* ListSortElements type values */
5265 enum {JIM_LSORT_ASCII, JIM_LSORT_NOCASE, JIM_LSORT_ASCII_DECR,
5266 JIM_LSORT_NOCASE_DECR};
5267
5268 /* Sort the internal rep of a list. */
5269 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5270 {
5271 return Jim_StringCompareObj(*lhsObj, *rhsObj, 0);
5272 }
5273
5274 static int ListSortStringDecr(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5275 {
5276 return Jim_StringCompareObj(*lhsObj, *rhsObj, 0) * -1;
5277 }
5278
5279 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5280 {
5281 return Jim_StringCompareObj(*lhsObj, *rhsObj, 1);
5282 }
5283
5284 static int ListSortStringNoCaseDecr(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5285 {
5286 return Jim_StringCompareObj(*lhsObj, *rhsObj, 1) * -1;
5287 }
5288
5289 /* Sort a list *in place*. MUST be called with non-shared objects. */
5290 static void ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, int type)
5291 {
5292 typedef int (qsort_comparator)(const void *, const void *);
5293 int (*fn)(Jim_Obj**, Jim_Obj**);
5294 Jim_Obj **vector;
5295 int len;
5296
5297 if (Jim_IsShared(listObjPtr))
5298 Jim_Panic(interp,"Jim_ListSortElements called with shared object");
5299 if (listObjPtr->typePtr != &listObjType)
5300 SetListFromAny(interp, listObjPtr);
5301
5302 vector = listObjPtr->internalRep.listValue.ele;
5303 len = listObjPtr->internalRep.listValue.len;
5304 switch (type) {
5305 case JIM_LSORT_ASCII: fn = ListSortString; break;
5306 case JIM_LSORT_NOCASE: fn = ListSortStringNoCase; break;
5307 case JIM_LSORT_ASCII_DECR: fn = ListSortStringDecr; break;
5308 case JIM_LSORT_NOCASE_DECR: fn = ListSortStringNoCaseDecr; break;
5309 default:
5310 fn = NULL; /* avoid warning */
5311 Jim_Panic(interp,"ListSort called with invalid sort type");
5312 }
5313 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *)fn);
5314 Jim_InvalidateStringRep(listObjPtr);
5315 }
5316
5317 /* This is the low-level function to append an element to a list.
5318 * The higher-level Jim_ListAppendElement() performs shared object
5319 * check and invalidate the string repr. This version is used
5320 * in the internals of the List Object and is not exported.
5321 *
5322 * NOTE: this function can be called only against objects
5323 * with internal type of List. */
5324 void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
5325 {
5326 int requiredLen = listPtr->internalRep.listValue.len + 1;
5327
5328 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5329 int maxLen = requiredLen * 2;
5330
5331 listPtr->internalRep.listValue.ele =
5332 Jim_Realloc(listPtr->internalRep.listValue.ele,
5333 sizeof(Jim_Obj*)*maxLen);
5334 listPtr->internalRep.listValue.maxLen = maxLen;
5335 }
5336 listPtr->internalRep.listValue.ele[listPtr->internalRep.listValue.len] =
5337 objPtr;
5338 listPtr->internalRep.listValue.len ++;
5339 Jim_IncrRefCount(objPtr);
5340 }
5341
5342 /* This is the low-level function to insert elements into a list.
5343 * The higher-level Jim_ListInsertElements() performs shared object
5344 * check and invalidate the string repr. This version is used
5345 * in the internals of the List Object and is not exported.
5346 *
5347 * NOTE: this function can be called only against objects
5348 * with internal type of List. */
5349 void ListInsertElements(Jim_Obj *listPtr, int index, int elemc,
5350 Jim_Obj *const *elemVec)
5351 {
5352 int currentLen = listPtr->internalRep.listValue.len;
5353 int requiredLen = currentLen + elemc;
5354 int i;
5355 Jim_Obj **point;
5356
5357 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5358 int maxLen = requiredLen * 2;
5359
5360 listPtr->internalRep.listValue.ele =
5361 Jim_Realloc(listPtr->internalRep.listValue.ele,
5362 sizeof(Jim_Obj*)*maxLen);
5363 listPtr->internalRep.listValue.maxLen = maxLen;
5364 }
5365 point = listPtr->internalRep.listValue.ele + index;
5366 memmove(point+elemc, point, (currentLen-index) * sizeof(Jim_Obj*));
5367 for (i=0; i < elemc; ++i) {
5368 point[i] = elemVec[i];
5369 Jim_IncrRefCount(point[i]);
5370 }
5371 listPtr->internalRep.listValue.len += elemc;
5372 }
5373
5374 /* Appends every element of appendListPtr into listPtr.
5375 * Both have to be of the list type. */
5376 void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
5377 {
5378 int i, oldLen = listPtr->internalRep.listValue.len;
5379 int appendLen = appendListPtr->internalRep.listValue.len;
5380 int requiredLen = oldLen + appendLen;
5381
5382 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5383 int maxLen = requiredLen * 2;
5384
5385 listPtr->internalRep.listValue.ele =
5386 Jim_Realloc(listPtr->internalRep.listValue.ele,
5387 sizeof(Jim_Obj*)*maxLen);
5388 listPtr->internalRep.listValue.maxLen = maxLen;
5389 }
5390 for (i = 0; i < appendLen; i++) {
5391 Jim_Obj *objPtr = appendListPtr->internalRep.listValue.ele[i];
5392 listPtr->internalRep.listValue.ele[oldLen+i] = objPtr;
5393 Jim_IncrRefCount(objPtr);
5394 }
5395 listPtr->internalRep.listValue.len += appendLen;
5396 }
5397
5398 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
5399 {
5400 if (Jim_IsShared(listPtr))
5401 Jim_Panic(interp,"Jim_ListAppendElement called with shared object");
5402 if (listPtr->typePtr != &listObjType)
5403 SetListFromAny(interp, listPtr);
5404 Jim_InvalidateStringRep(listPtr);
5405 ListAppendElement(listPtr, objPtr);
5406 }
5407
5408 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
5409 {
5410 if (Jim_IsShared(listPtr))
5411 Jim_Panic(interp,"Jim_ListAppendList called with shared object");
5412 if (listPtr->typePtr != &listObjType)
5413 SetListFromAny(interp, listPtr);
5414 Jim_InvalidateStringRep(listPtr);
5415 ListAppendList(listPtr, appendListPtr);
5416 }
5417
5418 void Jim_ListLength(Jim_Interp *interp, Jim_Obj *listPtr, int *intPtr)
5419 {
5420 if (listPtr->typePtr != &listObjType)
5421 SetListFromAny(interp, listPtr);
5422 *intPtr = listPtr->internalRep.listValue.len;
5423 }
5424
5425 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5426 int objc, Jim_Obj *const *objVec)
5427 {
5428 if (Jim_IsShared(listPtr))
5429 Jim_Panic(interp,"Jim_ListInsertElement called with shared object");
5430 if (listPtr->typePtr != &listObjType)
5431 SetListFromAny(interp, listPtr);
5432 if (index >= 0 && index > listPtr->internalRep.listValue.len)
5433 index = listPtr->internalRep.listValue.len;
5434 else if (index < 0 )
5435 index = 0;
5436 Jim_InvalidateStringRep(listPtr);
5437 ListInsertElements(listPtr, index, objc, objVec);
5438 }
5439
5440 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5441 Jim_Obj **objPtrPtr, int flags)
5442 {
5443 if (listPtr->typePtr != &listObjType)
5444 SetListFromAny(interp, listPtr);
5445 if ((index >= 0 && index >= listPtr->internalRep.listValue.len) ||
5446 (index < 0 && (-index-1) >= listPtr->internalRep.listValue.len)) {
5447 if (flags & JIM_ERRMSG) {
5448 Jim_SetResultString(interp,
5449 "list index out of range", -1);
5450 }
5451 return JIM_ERR;
5452 }
5453 if (index < 0)
5454 index = listPtr->internalRep.listValue.len+index;
5455 *objPtrPtr = listPtr->internalRep.listValue.ele[index];
5456 return JIM_OK;
5457 }
5458
5459 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5460 Jim_Obj *newObjPtr, int flags)
5461 {
5462 if (listPtr->typePtr != &listObjType)
5463 SetListFromAny(interp, listPtr);
5464 if ((index >= 0 && index >= listPtr->internalRep.listValue.len) ||
5465 (index < 0 && (-index-1) >= listPtr->internalRep.listValue.len)) {
5466 if (flags & JIM_ERRMSG) {
5467 Jim_SetResultString(interp,
5468 "list index out of range", -1);
5469 }
5470 return JIM_ERR;
5471 }
5472 if (index < 0)
5473 index = listPtr->internalRep.listValue.len+index;
5474 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[index]);
5475 listPtr->internalRep.listValue.ele[index] = newObjPtr;
5476 Jim_IncrRefCount(newObjPtr);
5477 return JIM_OK;
5478 }
5479
5480 /* Modify the list stored into the variable named 'varNamePtr'
5481 * setting the element specified by the 'indexc' indexes objects in 'indexv',
5482 * with the new element 'newObjptr'. */
5483 int Jim_SetListIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
5484 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
5485 {
5486 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
5487 int shared, i, index;
5488
5489 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
5490 if (objPtr == NULL)
5491 return JIM_ERR;
5492 if ((shared = Jim_IsShared(objPtr)))
5493 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
5494 for (i = 0; i < indexc-1; i++) {
5495 listObjPtr = objPtr;
5496 if (Jim_GetIndex(interp, indexv[i], &index) != JIM_OK)
5497 goto err;
5498 if (Jim_ListIndex(interp, listObjPtr, index, &objPtr,
5499 JIM_ERRMSG) != JIM_OK) {
5500 goto err;
5501 }
5502 if (Jim_IsShared(objPtr)) {
5503 objPtr = Jim_DuplicateObj(interp, objPtr);
5504 ListSetIndex(interp, listObjPtr, index, objPtr, JIM_NONE);
5505 }
5506 Jim_InvalidateStringRep(listObjPtr);
5507 }
5508 if (Jim_GetIndex(interp, indexv[indexc-1], &index) != JIM_OK)
5509 goto err;
5510 if (ListSetIndex(interp, objPtr, index, newObjPtr, JIM_ERRMSG) == JIM_ERR)
5511 goto err;
5512 Jim_InvalidateStringRep(objPtr);
5513 Jim_InvalidateStringRep(varObjPtr);
5514 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
5515 goto err;
5516 Jim_SetResult(interp, varObjPtr);
5517 return JIM_OK;
5518 err:
5519 if (shared) {
5520 Jim_FreeNewObj(interp, varObjPtr);
5521 }
5522 return JIM_ERR;
5523 }
5524
5525 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
5526 {
5527 int i;
5528
5529 /* If all the objects in objv are lists without string rep.
5530 * it's possible to return a list as result, that's the
5531 * concatenation of all the lists. */
5532 for (i = 0; i < objc; i++) {
5533 if (objv[i]->typePtr != &listObjType || objv[i]->bytes)
5534 break;
5535 }
5536 if (i == objc) {
5537 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
5538 for (i = 0; i < objc; i++)
5539 Jim_ListAppendList(interp, objPtr, objv[i]);
5540 return objPtr;
5541 } else {
5542 /* Else... we have to glue strings together */
5543 int len = 0, objLen;
5544 char *bytes, *p;
5545
5546 /* Compute the length */
5547 for (i = 0; i < objc; i++) {
5548 Jim_GetString(objv[i], &objLen);
5549 len += objLen;
5550 }
5551 if (objc) len += objc-1;
5552 /* Create the string rep, and a stinrg object holding it. */
5553 p = bytes = Jim_Alloc(len+1);
5554 for (i = 0; i < objc; i++) {
5555 const char *s = Jim_GetString(objv[i], &objLen);
5556 while (objLen && (*s == ' ' || *s == '\t' || *s == '\n'))
5557 {
5558 s++; objLen--; len--;
5559 }
5560 while (objLen && (s[objLen-1] == ' ' ||
5561 s[objLen-1] == '\n' || s[objLen-1] == '\t')) {
5562 objLen--; len--;
5563 }
5564 memcpy(p, s, objLen);
5565 p += objLen;
5566 if (objLen && i+1 != objc) {
5567 *p++ = ' ';
5568 } else if (i+1 != objc) {
5569 /* Drop the space calcuated for this
5570 * element that is instead null. */
5571 len--;
5572 }
5573 }
5574 *p = '\0';
5575 return Jim_NewStringObjNoAlloc(interp, bytes, len);
5576 }
5577 }
5578
5579 /* Returns a list composed of the elements in the specified range.
5580 * first and start are directly accepted as Jim_Objects and
5581 * processed for the end?-index? case. */
5582 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
5583 {
5584 int first, last;
5585 int len, rangeLen;
5586
5587 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
5588 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
5589 return NULL;
5590 Jim_ListLength(interp, listObjPtr, &len); /* will convert into list */
5591 first = JimRelToAbsIndex(len, first);
5592 last = JimRelToAbsIndex(len, last);
5593 JimRelToAbsRange(len, first, last, &first, &last, &rangeLen);
5594 return Jim_NewListObj(interp,
5595 listObjPtr->internalRep.listValue.ele+first, rangeLen);
5596 }
5597
5598 /* -----------------------------------------------------------------------------
5599 * Dict object
5600 * ---------------------------------------------------------------------------*/
5601 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
5602 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
5603 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
5604 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
5605
5606 /* Dict HashTable Type.
5607 *
5608 * Keys and Values are Jim objects. */
5609
5610 unsigned int JimObjectHTHashFunction(const void *key)
5611 {
5612 const char *str;
5613 Jim_Obj *objPtr = (Jim_Obj*) key;
5614 int len, h;
5615
5616 str = Jim_GetString(objPtr, &len);
5617 h = Jim_GenHashFunction((unsigned char*)str, len);
5618 return h;
5619 }
5620
5621 int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
5622 {
5623 JIM_NOTUSED(privdata);
5624
5625 return Jim_StringEqObj((Jim_Obj*)key1, (Jim_Obj*)key2, 0);
5626 }
5627
5628 static void JimObjectHTKeyValDestructor(void *interp, void *val)
5629 {
5630 Jim_Obj *objPtr = val;
5631
5632 Jim_DecrRefCount(interp, objPtr);
5633 }
5634
5635 static Jim_HashTableType JimDictHashTableType = {
5636 JimObjectHTHashFunction, /* hash function */
5637 NULL, /* key dup */
5638 NULL, /* val dup */
5639 JimObjectHTKeyCompare, /* key compare */
5640 (void(*)(void*, const void*)) /* ATTENTION: const cast */
5641 JimObjectHTKeyValDestructor, /* key destructor */
5642 JimObjectHTKeyValDestructor /* val destructor */
5643 };
5644
5645 /* Note that while the elements of the dict may contain references,
5646 * the list object itself can't. This basically means that the
5647 * dict object string representation as a whole can't contain references
5648 * that are not presents in the single elements. */
5649 static Jim_ObjType dictObjType = {
5650 "dict",
5651 FreeDictInternalRep,
5652 DupDictInternalRep,
5653 UpdateStringOfDict,
5654 JIM_TYPE_NONE,
5655 };
5656
5657 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
5658 {
5659 JIM_NOTUSED(interp);
5660
5661 Jim_FreeHashTable(objPtr->internalRep.ptr);
5662 Jim_Free(objPtr->internalRep.ptr);
5663 }
5664
5665 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
5666 {
5667 Jim_HashTable *ht, *dupHt;
5668 Jim_HashTableIterator *htiter;
5669 Jim_HashEntry *he;
5670
5671 /* Create a new hash table */
5672 ht = srcPtr->internalRep.ptr;
5673 dupHt = Jim_Alloc(sizeof(*dupHt));
5674 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
5675 if (ht->size != 0)
5676 Jim_ExpandHashTable(dupHt, ht->size);
5677 /* Copy every element from the source to the dup hash table */
5678 htiter = Jim_GetHashTableIterator(ht);
5679 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
5680 const Jim_Obj *keyObjPtr = he->key;
5681 Jim_Obj *valObjPtr = he->val;
5682
5683 Jim_IncrRefCount((Jim_Obj*)keyObjPtr); /* ATTENTION: const cast */
5684 Jim_IncrRefCount(valObjPtr);
5685 Jim_AddHashEntry(dupHt, keyObjPtr, valObjPtr);
5686 }
5687 Jim_FreeHashTableIterator(htiter);
5688
5689 dupPtr->internalRep.ptr = dupHt;
5690 dupPtr->typePtr = &dictObjType;
5691 }
5692
5693 void UpdateStringOfDict(struct Jim_Obj *objPtr)
5694 {
5695 int i, bufLen, realLength;
5696 const char *strRep;
5697 char *p;
5698 int *quotingType, objc;
5699 Jim_HashTable *ht;
5700 Jim_HashTableIterator *htiter;
5701 Jim_HashEntry *he;
5702 Jim_Obj **objv;
5703
5704 /* Trun the hash table into a flat vector of Jim_Objects. */
5705 ht = objPtr->internalRep.ptr;
5706 objc = ht->used*2;
5707 objv = Jim_Alloc(objc*sizeof(Jim_Obj*));
5708 htiter = Jim_GetHashTableIterator(ht);
5709 i = 0;
5710 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
5711 objv[i++] = (Jim_Obj*)he->key; /* ATTENTION: const cast */
5712 objv[i++] = he->val;
5713 }
5714 Jim_FreeHashTableIterator(htiter);
5715 /* (Over) Estimate the space needed. */
5716 quotingType = Jim_Alloc(sizeof(int)*objc);
5717 bufLen = 0;
5718 for (i = 0; i < objc; i++) {
5719 int len;
5720
5721 strRep = Jim_GetString(objv[i], &len);
5722 quotingType[i] = ListElementQuotingType(strRep, len);
5723 switch (quotingType[i]) {
5724 case JIM_ELESTR_SIMPLE: bufLen += len; break;
5725 case JIM_ELESTR_BRACE: bufLen += len+2; break;
5726 case JIM_ELESTR_QUOTE: bufLen += len*2; break;
5727 }
5728 bufLen++; /* elements separator. */
5729 }
5730 bufLen++;
5731
5732 /* Generate the string rep. */
5733 p = objPtr->bytes = Jim_Alloc(bufLen+1);
5734 realLength = 0;
5735 for (i = 0; i < objc; i++) {
5736 int len, qlen;
5737 const char *strRep = Jim_GetString(objv[i], &len);
5738 char *q;
5739
5740 switch(quotingType[i]) {
5741 case JIM_ELESTR_SIMPLE:
5742 memcpy(p, strRep, len);
5743 p += len;
5744 realLength += len;
5745 break;
5746 case JIM_ELESTR_BRACE:
5747 *p++ = '{';
5748 memcpy(p, strRep, len);
5749 p += len;
5750 *p++ = '}';
5751 realLength += len+2;
5752 break;
5753 case JIM_ELESTR_QUOTE:
5754 q = BackslashQuoteString(strRep, len, &qlen);
5755 memcpy(p, q, qlen);
5756 Jim_Free(q);
5757 p += qlen;
5758 realLength += qlen;
5759 break;
5760 }
5761 /* Add a separating space */
5762 if (i+1 != objc) {
5763 *p++ = ' ';
5764 realLength ++;
5765 }
5766 }
5767 *p = '\0'; /* nul term. */
5768 objPtr->length = realLength;
5769 Jim_Free(quotingType);
5770 Jim_Free(objv);
5771 }
5772
5773 int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
5774 {
5775 struct JimParserCtx parser;
5776 Jim_HashTable *ht;
5777 Jim_Obj *objv[2];
5778 const char *str;
5779 int i, strLen;
5780
5781 /* Get the string representation */
5782 str = Jim_GetString(objPtr, &strLen);
5783
5784 /* Free the old internal repr just now and initialize the
5785 * new one just now. The string->list conversion can't fail. */
5786 Jim_FreeIntRep(interp, objPtr);
5787 ht = Jim_Alloc(sizeof(*ht));
5788 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
5789 objPtr->typePtr = &dictObjType;
5790 objPtr->internalRep.ptr = ht;
5791
5792 /* Convert into a dict */
5793 JimParserInit(&parser, str, strLen, 1);
5794 i = 0;
5795 while(!JimParserEof(&parser)) {
5796 char *token;
5797 int tokenLen, type;
5798
5799 JimParseList(&parser);
5800 if (JimParserTtype(&parser) != JIM_TT_STR &&
5801 JimParserTtype(&parser) != JIM_TT_ESC)
5802 continue;
5803 token = JimParserGetToken(&parser, &tokenLen, &type, NULL);
5804 objv[i++] = Jim_NewStringObjNoAlloc(interp, token, tokenLen);
5805 if (i == 2) {
5806 i = 0;
5807 Jim_IncrRefCount(objv[0]);
5808 Jim_IncrRefCount(objv[1]);
5809 if (Jim_AddHashEntry(ht, objv[0], objv[1]) != JIM_OK) {
5810 Jim_HashEntry *he;
5811 he = Jim_FindHashEntry(ht, objv[0]);
5812 Jim_DecrRefCount(interp, objv[0]);
5813 /* ATTENTION: const cast */
5814 Jim_DecrRefCount(interp, (Jim_Obj*)he->val);
5815 he->val = objv[1];
5816 }
5817 }
5818 }
5819 if (i) {
5820 Jim_FreeNewObj(interp, objv[0]);
5821 objPtr->typePtr = NULL;
5822 Jim_FreeHashTable(ht);
5823 Jim_SetResultString(interp, "invalid dictionary value: must be a list with an even number of elements", -1);
5824 return JIM_ERR;
5825 }
5826 return JIM_OK;
5827 }
5828
5829 /* Dict object API */
5830
5831 /* Add an element to a dict. objPtr must be of the "dict" type.
5832 * The higer-level exported function is Jim_DictAddElement().
5833 * If an element with the specified key already exists, the value
5834 * associated is replaced with the new one.
5835 *
5836 * if valueObjPtr == NULL, the key is instead removed if it exists. */
5837 static void DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
5838 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
5839 {
5840 Jim_HashTable *ht = objPtr->internalRep.ptr;
5841
5842 if (valueObjPtr == NULL) { /* unset */
5843 Jim_DeleteHashEntry(ht, keyObjPtr);
5844 return;
5845 }
5846 Jim_IncrRefCount(keyObjPtr);
5847 Jim_IncrRefCount(valueObjPtr);
5848 if (Jim_AddHashEntry(ht, keyObjPtr, valueObjPtr) != JIM_OK) {
5849 Jim_HashEntry *he = Jim_FindHashEntry(ht, keyObjPtr);
5850 Jim_DecrRefCount(interp, keyObjPtr);
5851 /* ATTENTION: const cast */
5852 Jim_DecrRefCount(interp, (Jim_Obj*)he->val);
5853 he->val = valueObjPtr;
5854 }
5855 }
5856
5857 /* Add an element, higher-level interface for DictAddElement().
5858 * If valueObjPtr == NULL, the key is removed if it exists. */
5859 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
5860 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
5861 {
5862 if (Jim_IsShared(objPtr))
5863 Jim_Panic(interp,"Jim_DictAddElement called with shared object");
5864 if (objPtr->typePtr != &dictObjType) {
5865 if (SetDictFromAny(interp, objPtr) != JIM_OK)
5866 return JIM_ERR;
5867 }
5868 DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
5869 Jim_InvalidateStringRep(objPtr);
5870 return JIM_OK;
5871 }
5872
5873 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
5874 {
5875 Jim_Obj *objPtr;
5876 int i;
5877
5878 if (len % 2)
5879 Jim_Panic(interp,"Jim_NewDicObj() 'len' argument must be even");
5880
5881 objPtr = Jim_NewObj(interp);
5882 objPtr->typePtr = &dictObjType;
5883 objPtr->bytes = NULL;
5884 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
5885 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
5886 for (i = 0; i < len; i += 2)
5887 DictAddElement(interp, objPtr, elements[i], elements[i+1]);
5888 return objPtr;
5889 }
5890
5891 /* Return the value associated to the specified dict key */
5892 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
5893 Jim_Obj **objPtrPtr, int flags)
5894 {
5895 Jim_HashEntry *he;
5896 Jim_HashTable *ht;
5897
5898 if (dictPtr->typePtr != &dictObjType) {
5899 if (SetDictFromAny(interp, dictPtr) != JIM_OK)
5900 return JIM_ERR;
5901 }
5902 ht = dictPtr->internalRep.ptr;
5903 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
5904 if (flags & JIM_ERRMSG) {
5905 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
5906 Jim_AppendStrings(interp, Jim_GetResult(interp),
5907 "key \"", Jim_GetString(keyPtr, NULL),
5908 "\" not found in dictionary", NULL);
5909 }
5910 return JIM_ERR;
5911 }
5912 *objPtrPtr = he->val;
5913 return JIM_OK;
5914 }
5915
5916 /* Return the value associated to the specified dict keys */
5917 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
5918 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
5919 {
5920 Jim_Obj *objPtr;
5921 int i;
5922
5923 if (keyc == 0) {
5924 *objPtrPtr = dictPtr;
5925 return JIM_OK;
5926 }
5927
5928 for (i = 0; i < keyc; i++) {
5929 if (Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags)
5930 != JIM_OK)
5931 return JIM_ERR;
5932 dictPtr = objPtr;
5933 }
5934 *objPtrPtr = objPtr;
5935 return JIM_OK;
5936 }
5937
5938 /* Modify the dict stored into the variable named 'varNamePtr'
5939 * setting the element specified by the 'keyc' keys objects in 'keyv',
5940 * with the new value of the element 'newObjPtr'.
5941 *
5942 * If newObjPtr == NULL the operation is to remove the given key
5943 * from the dictionary. */
5944 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
5945 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr)
5946 {
5947 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
5948 int shared, i;
5949
5950 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
5951 if (objPtr == NULL) {
5952 if (newObjPtr == NULL) /* Cannot remove a key from non existing var */
5953 return JIM_ERR;
5954 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
5955 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
5956 Jim_FreeNewObj(interp, varObjPtr);
5957 return JIM_ERR;
5958 }
5959 }
5960 if ((shared = Jim_IsShared(objPtr)))
5961 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
5962 for (i = 0; i < keyc-1; i++) {
5963 dictObjPtr = objPtr;
5964
5965 /* Check if it's a valid dictionary */
5966 if (dictObjPtr->typePtr != &dictObjType) {
5967 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK)
5968 goto err;
5969 }
5970 /* Check if the given key exists. */
5971 Jim_InvalidateStringRep(dictObjPtr);
5972 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
5973 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK)
5974 {
5975 /* This key exists at the current level.
5976 * Make sure it's not shared!. */
5977 if (Jim_IsShared(objPtr)) {
5978 objPtr = Jim_DuplicateObj(interp, objPtr);
5979 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
5980 }
5981 } else {
5982 /* Key not found. If it's an [unset] operation
5983 * this is an error. Only the last key may not
5984 * exist. */
5985 if (newObjPtr == NULL)
5986 goto err;
5987 /* Otherwise set an empty dictionary
5988 * as key's value. */
5989 objPtr = Jim_NewDictObj(interp, NULL, 0);
5990 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
5991 }
5992 }
5993 if (Jim_DictAddElement(interp, objPtr, keyv[keyc-1], newObjPtr)
5994 != JIM_OK)
5995 goto err;
5996 Jim_InvalidateStringRep(objPtr);
5997 Jim_InvalidateStringRep(varObjPtr);
5998 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
5999 goto err;
6000 Jim_SetResult(interp, varObjPtr);
6001 return JIM_OK;
6002 err:
6003 if (shared) {
6004 Jim_FreeNewObj(interp, varObjPtr);
6005 }
6006 return JIM_ERR;
6007 }
6008
6009 /* -----------------------------------------------------------------------------
6010 * Index object
6011 * ---------------------------------------------------------------------------*/
6012 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
6013 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6014
6015 static Jim_ObjType indexObjType = {
6016 "index",
6017 NULL,
6018 NULL,
6019 UpdateStringOfIndex,
6020 JIM_TYPE_NONE,
6021 };
6022
6023 void UpdateStringOfIndex(struct Jim_Obj *objPtr)
6024 {
6025 int len;
6026 char buf[JIM_INTEGER_SPACE+1];
6027
6028 if (objPtr->internalRep.indexValue >= 0)
6029 len = sprintf(buf, "%d", objPtr->internalRep.indexValue);
6030 else if (objPtr->internalRep.indexValue == -1)
6031 len = sprintf(buf, "end");
6032 else {
6033 len = sprintf(buf, "end%d", objPtr->internalRep.indexValue+1);
6034 }
6035 objPtr->bytes = Jim_Alloc(len+1);
6036 memcpy(objPtr->bytes, buf, len+1);
6037 objPtr->length = len;
6038 }
6039
6040 int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6041 {
6042 int index, end = 0;
6043 const char *str;
6044
6045 /* Get the string representation */
6046 str = Jim_GetString(objPtr, NULL);
6047 /* Try to convert into an index */
6048 if (!strcmp(str, "end")) {
6049 index = 0;
6050 end = 1;
6051 } else {
6052 if (!strncmp(str, "end-", 4)) {
6053 str += 4;
6054 end = 1;
6055 }
6056 if (Jim_StringToIndex(str, &index) != JIM_OK) {
6057 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
6058 Jim_AppendStrings(interp, Jim_GetResult(interp),
6059 "bad index \"", Jim_GetString(objPtr, NULL), "\": "
6060 "must be integer or end?-integer?", NULL);
6061 return JIM_ERR;
6062 }
6063 }
6064 if (end) {
6065 if (index < 0)
6066 index = INT_MAX;
6067 else
6068 index = -(index+1);
6069 } else if (!end && index < 0)
6070 index = -INT_MAX;
6071 /* Free the old internal repr and set the new one. */
6072 Jim_FreeIntRep(interp, objPtr);
6073 objPtr->typePtr = &indexObjType;
6074 objPtr->internalRep.indexValue = index;
6075 return JIM_OK;
6076 }
6077
6078 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
6079 {
6080 /* Avoid shimmering if the object is an integer. */
6081 if (objPtr->typePtr == &intObjType) {
6082 jim_wide val = objPtr->internalRep.wideValue;
6083 if (!(val < LONG_MIN) && !(val > LONG_MAX)) {
6084 *indexPtr = (val < 0) ? -INT_MAX : (long)val;;
6085 return JIM_OK;
6086 }
6087 }
6088 if (objPtr->typePtr != &indexObjType &&
6089 SetIndexFromAny(interp, objPtr) == JIM_ERR)
6090 return JIM_ERR;
6091 *indexPtr = objPtr->internalRep.indexValue;
6092 return JIM_OK;
6093 }
6094
6095 /* -----------------------------------------------------------------------------
6096 * Return Code Object.
6097 * ---------------------------------------------------------------------------*/
6098
6099 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
6100
6101 static Jim_ObjType returnCodeObjType = {
6102 "return-code",
6103 NULL,
6104 NULL,
6105 NULL,
6106 JIM_TYPE_NONE,
6107 };
6108
6109 int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6110 {
6111 const char *str;
6112 int strLen, returnCode;
6113 jim_wide wideValue;
6114
6115 /* Get the string representation */
6116 str = Jim_GetString(objPtr, &strLen);
6117 /* Try to convert into an integer */
6118 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
6119 returnCode = (int) wideValue;
6120 else if (!JimStringCompare(str, strLen, "ok", 2, JIM_NOCASE))
6121 returnCode = JIM_OK;
6122 else if (!JimStringCompare(str, strLen, "error", 5, JIM_NOCASE))
6123 returnCode = JIM_ERR;
6124 else if (!JimStringCompare(str, strLen, "return", 6, JIM_NOCASE))
6125 returnCode = JIM_RETURN;
6126 else if (!JimStringCompare(str, strLen, "break", 5, JIM_NOCASE))
6127 returnCode = JIM_BREAK;
6128 else if (!JimStringCompare(str, strLen, "continue", 8, JIM_NOCASE))
6129 returnCode = JIM_CONTINUE;
6130 else if (!JimStringCompare(str, strLen, "eval", 4, JIM_NOCASE))
6131 returnCode = JIM_EVAL;
6132 else if (!JimStringCompare(str, strLen, "exit", 4, JIM_NOCASE))
6133 returnCode = JIM_EXIT;
6134 else {
6135 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
6136 Jim_AppendStrings(interp, Jim_GetResult(interp),
6137 "expected return code but got '", str, "'",
6138 NULL);
6139 return JIM_ERR;
6140 }
6141 /* Free the old internal repr and set the new one. */
6142 Jim_FreeIntRep(interp, objPtr);
6143 objPtr->typePtr = &returnCodeObjType;
6144 objPtr->internalRep.returnCode = returnCode;
6145 return JIM_OK;
6146 }
6147
6148 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
6149 {
6150 if (objPtr->typePtr != &returnCodeObjType &&
6151 SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
6152 return JIM_ERR;
6153 *intPtr = objPtr->internalRep.returnCode;
6154 return JIM_OK;
6155 }
6156
6157 /* -----------------------------------------------------------------------------
6158 * Expression Parsing
6159 * ---------------------------------------------------------------------------*/
6160 static int JimParseExprOperator(struct JimParserCtx *pc);
6161 static int JimParseExprNumber(struct JimParserCtx *pc);
6162 static int JimParseExprIrrational(struct JimParserCtx *pc);
6163
6164 /* Exrp's Stack machine operators opcodes. */
6165
6166 /* Binary operators (numbers) */
6167 #define JIM_EXPROP_BINARY_NUM_FIRST 0 /* first */
6168 #define JIM_EXPROP_MUL 0
6169 #define JIM_EXPROP_DIV 1
6170 #define JIM_EXPROP_MOD 2
6171 #define JIM_EXPROP_SUB 3
6172 #define JIM_EXPROP_ADD 4
6173 #define JIM_EXPROP_LSHIFT 5
6174 #define JIM_EXPROP_RSHIFT 6
6175 #define JIM_EXPROP_ROTL 7
6176 #define JIM_EXPROP_ROTR 8
6177 #define JIM_EXPROP_LT 9
6178 #define JIM_EXPROP_GT 10
6179 #define JIM_EXPROP_LTE 11
6180 #define JIM_EXPROP_GTE 12
6181 #define JIM_EXPROP_NUMEQ 13
6182 #define JIM_EXPROP_NUMNE 14
6183 #define JIM_EXPROP_BITAND 15
6184 #define JIM_EXPROP_BITXOR 16
6185 #define JIM_EXPROP_BITOR 17
6186 #define JIM_EXPROP_LOGICAND 18
6187 #define JIM_EXPROP_LOGICOR 19
6188 #define JIM_EXPROP_LOGICAND_LEFT 20
6189 #define JIM_EXPROP_LOGICOR_LEFT 21
6190 #define JIM_EXPROP_POW 22
6191 #define JIM_EXPROP_BINARY_NUM_LAST 22 /* last */
6192
6193 /* Binary operators (strings) */
6194 #define JIM_EXPROP_STREQ 23
6195 #define JIM_EXPROP_STRNE 24
6196
6197 /* Unary operators (numbers) */
6198 #define JIM_EXPROP_NOT 25
6199 #define JIM_EXPROP_BITNOT 26
6200 #define JIM_EXPROP_UNARYMINUS 27
6201 #define JIM_EXPROP_UNARYPLUS 28
6202 #define JIM_EXPROP_LOGICAND_RIGHT 29
6203 #define JIM_EXPROP_LOGICOR_RIGHT 30
6204
6205 /* Ternary operators */
6206 #define JIM_EXPROP_TERNARY 31
6207
6208 /* Operands */
6209 #define JIM_EXPROP_NUMBER 32
6210 #define JIM_EXPROP_COMMAND 33
6211 #define JIM_EXPROP_VARIABLE 34
6212 #define JIM_EXPROP_DICTSUGAR 35
6213 #define JIM_EXPROP_SUBST 36
6214 #define JIM_EXPROP_STRING 37
6215
6216 /* Operators table */
6217 typedef struct Jim_ExprOperator {
6218 const char *name;
6219 int precedence;
6220 int arity;
6221 int opcode;
6222 } Jim_ExprOperator;
6223
6224 /* name - precedence - arity - opcode */
6225 static struct Jim_ExprOperator Jim_ExprOperators[] = {
6226 {"!", 300, 1, JIM_EXPROP_NOT},
6227 {"~", 300, 1, JIM_EXPROP_BITNOT},
6228 {"unarymin", 300, 1, JIM_EXPROP_UNARYMINUS},
6229 {"unaryplus", 300, 1, JIM_EXPROP_UNARYPLUS},
6230
6231 {"**", 250, 2, JIM_EXPROP_POW},
6232
6233 {"*", 200, 2, JIM_EXPROP_MUL},
6234 {"/", 200, 2, JIM_EXPROP_DIV},
6235 {"%", 200, 2, JIM_EXPROP_MOD},
6236
6237 {"-", 100, 2, JIM_EXPROP_SUB},
6238 {"+", 100, 2, JIM_EXPROP_ADD},
6239
6240 {"<<<", 90, 3, JIM_EXPROP_ROTL},
6241 {">>>", 90, 3, JIM_EXPROP_ROTR},
6242 {"<<", 90, 2, JIM_EXPROP_LSHIFT},
6243 {">>", 90, 2, JIM_EXPROP_RSHIFT},
6244
6245 {"<", 80, 2, JIM_EXPROP_LT},
6246 {">", 80, 2, JIM_EXPROP_GT},
6247 {"<=", 80, 2, JIM_EXPROP_LTE},
6248 {">=", 80, 2, JIM_EXPROP_GTE},
6249
6250 {"==", 70, 2, JIM_EXPROP_NUMEQ},
6251 {"!=", 70, 2, JIM_EXPROP_NUMNE},
6252
6253 {"eq", 60, 2, JIM_EXPROP_STREQ},
6254 {"ne", 60, 2, JIM_EXPROP_STRNE},
6255
6256 {"&", 50, 2, JIM_EXPROP_BITAND},
6257 {"^", 49, 2, JIM_EXPROP_BITXOR},
6258 {"|", 48, 2, JIM_EXPROP_BITOR},
6259
6260 {"&&", 10, 2, JIM_EXPROP_LOGICAND},
6261 {"||", 10, 2, JIM_EXPROP_LOGICOR},
6262
6263 {"?", 5, 3, JIM_EXPROP_TERNARY},
6264 /* private operators */
6265 {NULL, 10, 2, JIM_EXPROP_LOGICAND_LEFT},
6266 {NULL, 10, 1, JIM_EXPROP_LOGICAND_RIGHT},
6267 {NULL, 10, 2, JIM_EXPROP_LOGICOR_LEFT},
6268 {NULL, 10, 1, JIM_EXPROP_LOGICOR_RIGHT},
6269 };
6270
6271 #define JIM_EXPR_OPERATORS_NUM \
6272 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
6273
6274 int JimParseExpression(struct JimParserCtx *pc)
6275 {
6276 /* Discard spaces and quoted newline */
6277 while(*(pc->p) == ' ' ||
6278 *(pc->p) == '\t' ||
6279 *(pc->p) == '\r' ||
6280 *(pc->p) == '\n' ||
6281 (*(pc->p) == '\\' && *(pc->p+1) == '\n')) {
6282 pc->p++; pc->len--;
6283 }
6284
6285 if (pc->len == 0) {
6286 pc->tstart = pc->tend = pc->p;
6287 pc->tline = pc->linenr;
6288 pc->tt = JIM_TT_EOL;
6289 pc->eof = 1;
6290 return JIM_OK;
6291 }
6292 switch(*(pc->p)) {
6293 case '(':
6294 pc->tstart = pc->tend = pc->p;
6295 pc->tline = pc->linenr;
6296 pc->tt = JIM_TT_SUBEXPR_START;
6297 pc->p++; pc->len--;
6298 break;
6299 case ')':
6300 pc->tstart = pc->tend = pc->p;
6301 pc->tline = pc->linenr;
6302 pc->tt = JIM_TT_SUBEXPR_END;
6303 pc->p++; pc->len--;
6304 break;
6305 case '[':
6306 return JimParseCmd(pc);
6307 break;
6308 case '$':
6309 if (JimParseVar(pc) == JIM_ERR)
6310 return JimParseExprOperator(pc);
6311 else
6312 return JIM_OK;
6313 break;
6314 case '-':
6315 if ((pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_EXPR_OPERATOR) &&
6316 isdigit((int)*(pc->p+1)))
6317 return JimParseExprNumber(pc);
6318 else
6319 return JimParseExprOperator(pc);
6320 break;
6321 case '0': case '1': case '2': case '3': case '4':
6322 case '5': case '6': case '7': case '8': case '9': case '.':
6323 return JimParseExprNumber(pc);
6324 break;
6325 case '"':
6326 case '{':
6327 /* Here it's possible to reuse the List String parsing. */
6328 pc->tt = JIM_TT_NONE; /* Make sure it's sensed as a new word. */
6329 return JimParseListStr(pc);
6330 break;
6331 case 'N': case 'I':
6332 case 'n': case 'i':
6333 if (JimParseExprIrrational(pc) == JIM_ERR)
6334 return JimParseExprOperator(pc);
6335 break;
6336 default:
6337 return JimParseExprOperator(pc);
6338 break;
6339 }
6340 return JIM_OK;
6341 }
6342
6343 int JimParseExprNumber(struct JimParserCtx *pc)
6344 {
6345 int allowdot = 1;
6346 int allowhex = 0;
6347
6348 pc->tstart = pc->p;
6349 pc->tline = pc->linenr;
6350 if (*pc->p == '-') {
6351 pc->p++; pc->len--;
6352 }
6353 while ( isdigit((int)*pc->p)
6354 || (allowhex && isxdigit((int)*pc->p) )
6355 || (allowdot && *pc->p == '.')
6356 || (pc->p-pc->tstart == 1 && *pc->tstart == '0' &&
6357 (*pc->p == 'x' || *pc->p == 'X'))
6358 )
6359 {
6360 if ((*pc->p == 'x') || (*pc->p == 'X')) {
6361 allowhex = 1;
6362 allowdot = 0;
6363 }
6364 if (*pc->p == '.')
6365 allowdot = 0;
6366 pc->p++; pc->len--;
6367 if (!allowdot && *pc->p == 'e' && *(pc->p+1) == '-') {
6368 pc->p += 2; pc->len -= 2;
6369 }
6370 }
6371 pc->tend = pc->p-1;
6372 pc->tt = JIM_TT_EXPR_NUMBER;
6373 return JIM_OK;
6374 }
6375
6376 int JimParseExprIrrational(struct JimParserCtx *pc)
6377 {
6378 const char *Tokens[] = {"NaN", "nan", "NAN", "Inf", "inf", "INF", NULL};
6379 const char **token;
6380 for (token = Tokens; *token != NULL; token++) {
6381 int len = strlen(*token);
6382 if (strncmp(*token, pc->p, len) == 0) {
6383 pc->tstart = pc->p;
6384 pc->tend = pc->p + len - 1;
6385 pc->p += len; pc->len -= len;
6386 pc->tline = pc->linenr;
6387 pc->tt = JIM_TT_EXPR_NUMBER;
6388 return JIM_OK;
6389 }
6390 }
6391 return JIM_ERR;
6392 }
6393
6394 int JimParseExprOperator(struct JimParserCtx *pc)
6395 {
6396 int i;
6397 int bestIdx = -1, bestLen = 0;
6398
6399 /* Try to get the longest match. */
6400 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
6401 const char *opname;
6402 int oplen;
6403
6404 opname = Jim_ExprOperators[i].name;
6405 if (opname == NULL) continue;
6406 oplen = strlen(opname);
6407
6408 if (strncmp(opname, pc->p, oplen) == 0 && oplen > bestLen) {
6409 bestIdx = i;
6410 bestLen = oplen;
6411 }
6412 }
6413 if (bestIdx == -1) return JIM_ERR;
6414 pc->tstart = pc->p;
6415 pc->tend = pc->p + bestLen - 1;
6416 pc->p += bestLen; pc->len -= bestLen;
6417 pc->tline = pc->linenr;
6418 pc->tt = JIM_TT_EXPR_OPERATOR;
6419 return JIM_OK;
6420 }
6421
6422 struct Jim_ExprOperator *JimExprOperatorInfo(const char *opname)
6423 {
6424 int i;
6425 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++)
6426 if (Jim_ExprOperators[i].name &&
6427 strcmp(opname, Jim_ExprOperators[i].name) == 0)
6428 return &Jim_ExprOperators[i];
6429 return NULL;
6430 }
6431
6432 struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
6433 {
6434 int i;
6435 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++)
6436 if (Jim_ExprOperators[i].opcode == opcode)
6437 return &Jim_ExprOperators[i];
6438 return NULL;
6439 }
6440
6441 /* -----------------------------------------------------------------------------
6442 * Expression Object
6443 * ---------------------------------------------------------------------------*/
6444 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6445 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6446 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6447
6448 static Jim_ObjType exprObjType = {
6449 "expression",
6450 FreeExprInternalRep,
6451 DupExprInternalRep,
6452 NULL,
6453 JIM_TYPE_REFERENCES,
6454 };
6455
6456 /* Expr bytecode structure */
6457 typedef struct ExprByteCode {
6458 int *opcode; /* Integer array of opcodes. */
6459 Jim_Obj **obj; /* Array of associated Jim Objects. */
6460 int len; /* Bytecode length */
6461 int inUse; /* Used for sharing. */
6462 } ExprByteCode;
6463
6464 void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6465 {
6466 int i;
6467 ExprByteCode *expr = (void*) objPtr->internalRep.ptr;
6468
6469 expr->inUse--;
6470 if (expr->inUse != 0) return;
6471 for (i = 0; i < expr->len; i++)
6472 Jim_DecrRefCount(interp, expr->obj[i]);
6473 Jim_Free(expr->opcode);
6474 Jim_Free(expr->obj);
6475 Jim_Free(expr);
6476 }
6477
6478 void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6479 {
6480 JIM_NOTUSED(interp);
6481 JIM_NOTUSED(srcPtr);
6482
6483 /* Just returns an simple string. */
6484 dupPtr->typePtr = NULL;
6485 }
6486
6487 /* Add a new instruction to an expression bytecode structure. */
6488 static void ExprObjAddInstr(Jim_Interp *interp, ExprByteCode *expr,
6489 int opcode, char *str, int len)
6490 {
6491 expr->opcode = Jim_Realloc(expr->opcode, sizeof(int)*(expr->len+1));
6492 expr->obj = Jim_Realloc(expr->obj, sizeof(Jim_Obj*)*(expr->len+1));
6493 expr->opcode[expr->len] = opcode;
6494 expr->obj[expr->len] = Jim_NewStringObjNoAlloc(interp, str, len);
6495 Jim_IncrRefCount(expr->obj[expr->len]);
6496 expr->len++;
6497 }
6498
6499 /* Check if an expr program looks correct. */
6500 static int ExprCheckCorrectness(ExprByteCode *expr)
6501 {
6502 int i;
6503 int stacklen = 0;
6504
6505 /* Try to check if there are stack underflows,
6506 * and make sure at the end of the program there is
6507 * a single result on the stack. */
6508 for (i = 0; i < expr->len; i++) {
6509 switch(expr->opcode[i]) {
6510 case JIM_EXPROP_NUMBER:
6511 case JIM_EXPROP_STRING:
6512 case JIM_EXPROP_SUBST:
6513 case JIM_EXPROP_VARIABLE:
6514 case JIM_EXPROP_DICTSUGAR:
6515 case JIM_EXPROP_COMMAND:
6516 stacklen++;
6517 break;
6518 case JIM_EXPROP_NOT:
6519 case JIM_EXPROP_BITNOT:
6520 case JIM_EXPROP_UNARYMINUS:
6521 case JIM_EXPROP_UNARYPLUS:
6522 /* Unary operations */
6523 if (stacklen < 1) return JIM_ERR;
6524 break;
6525 case JIM_EXPROP_ADD:
6526 case JIM_EXPROP_SUB:
6527 case JIM_EXPROP_MUL:
6528 case JIM_EXPROP_DIV:
6529 case JIM_EXPROP_MOD:
6530 case JIM_EXPROP_LT:
6531 case JIM_EXPROP_GT:
6532 case JIM_EXPROP_LTE:
6533 case JIM_EXPROP_GTE:
6534 case JIM_EXPROP_ROTL:
6535 case JIM_EXPROP_ROTR:
6536 case JIM_EXPROP_LSHIFT:
6537 case JIM_EXPROP_RSHIFT:
6538 case JIM_EXPROP_NUMEQ:
6539 case JIM_EXPROP_NUMNE:
6540 case JIM_EXPROP_STREQ:
6541 case JIM_EXPROP_STRNE:
6542 case JIM_EXPROP_BITAND:
6543 case JIM_EXPROP_BITXOR:
6544 case JIM_EXPROP_BITOR:
6545 case JIM_EXPROP_LOGICAND:
6546 case JIM_EXPROP_LOGICOR:
6547 case JIM_EXPROP_POW:
6548 /* binary operations */
6549 if (stacklen < 2) return JIM_ERR;
6550 stacklen--;
6551 break;
6552 default:
6553 Jim_Panic(NULL,"Default opcode reached ExprCheckCorrectness");
6554 break;
6555 }
6556 }
6557 if (stacklen != 1) return JIM_ERR;
6558 return JIM_OK;
6559 }
6560
6561 static void ExprShareLiterals(Jim_Interp *interp, ExprByteCode *expr,
6562 ScriptObj *topLevelScript)
6563 {
6564 int i;
6565
6566 return;
6567 for (i = 0; i < expr->len; i++) {
6568 Jim_Obj *foundObjPtr;
6569
6570 if (expr->obj[i] == NULL) continue;
6571 foundObjPtr = ScriptSearchLiteral(interp, topLevelScript,
6572 NULL, expr->obj[i]);
6573 if (foundObjPtr != NULL) {
6574 Jim_IncrRefCount(foundObjPtr);
6575 Jim_DecrRefCount(interp, expr->obj[i]);
6576 expr->obj[i] = foundObjPtr;
6577 }
6578 }
6579 }
6580
6581 /* This procedure converts every occurrence of || and && opereators
6582 * in lazy unary versions.
6583 *
6584 * a b || is converted into:
6585 *
6586 * a <offset> |L b |R
6587 *
6588 * a b && is converted into:
6589 *
6590 * a <offset> &L b &R
6591 *
6592 * "|L" checks if 'a' is true:
6593 * 1) if it is true pushes 1 and skips <offset> istructions to reach
6594 * the opcode just after |R.
6595 * 2) if it is false does nothing.
6596 * "|R" checks if 'b' is true:
6597 * 1) if it is true pushes 1, otherwise pushes 0.
6598 *
6599 * "&L" checks if 'a' is true:
6600 * 1) if it is true does nothing.
6601 * 2) If it is false pushes 0 and skips <offset> istructions to reach
6602 * the opcode just after &R
6603 * "&R" checks if 'a' is true:
6604 * if it is true pushes 1, otherwise pushes 0.
6605 */
6606 static void ExprMakeLazy(Jim_Interp *interp, ExprByteCode *expr)
6607 {
6608 while (1) {
6609 int index = -1, leftindex, arity, i, offset;
6610 Jim_ExprOperator *op;
6611
6612 /* Search for || or && */
6613 for (i = 0; i < expr->len; i++) {
6614 if (expr->opcode[i] == JIM_EXPROP_LOGICAND ||
6615 expr->opcode[i] == JIM_EXPROP_LOGICOR) {
6616 index = i;
6617 break;
6618 }
6619 }
6620 if (index == -1) return;
6621 /* Search for the end of the first operator */
6622 leftindex = index-1;
6623 arity = 1;
6624 while(arity) {
6625 switch(expr->opcode[leftindex]) {
6626 case JIM_EXPROP_NUMBER:
6627 case JIM_EXPROP_COMMAND:
6628 case JIM_EXPROP_VARIABLE:
6629 case JIM_EXPROP_DICTSUGAR:
6630 case JIM_EXPROP_SUBST:
6631 case JIM_EXPROP_STRING:
6632 break;
6633 default:
6634 op = JimExprOperatorInfoByOpcode(expr->opcode[leftindex]);
6635 if (op == NULL) {
6636 Jim_Panic(interp,"Default reached in ExprMakeLazy()");
6637 }
6638 arity += op->arity;
6639 break;
6640 }
6641 arity--;
6642 leftindex--;
6643 }
6644 leftindex++;
6645 expr->opcode = Jim_Realloc(expr->opcode, sizeof(int)*(expr->len+2));
6646 expr->obj = Jim_Realloc(expr->obj, sizeof(Jim_Obj*)*(expr->len+2));
6647 memmove(&expr->opcode[leftindex+2], &expr->opcode[leftindex],
6648 sizeof(int)*(expr->len-leftindex));
6649 memmove(&expr->obj[leftindex+2], &expr->obj[leftindex],
6650 sizeof(Jim_Obj*)*(expr->len-leftindex));
6651 expr->len += 2;
6652 index += 2;
6653 offset = (index-leftindex)-1;
6654 Jim_DecrRefCount(interp, expr->obj[index]);
6655 if (expr->opcode[index] == JIM_EXPROP_LOGICAND) {
6656 expr->opcode[leftindex+1] = JIM_EXPROP_LOGICAND_LEFT;
6657 expr->opcode[index] = JIM_EXPROP_LOGICAND_RIGHT;
6658 expr->obj[leftindex+1] = Jim_NewStringObj(interp, "&L", -1);
6659 expr->obj[index] = Jim_NewStringObj(interp, "&R", -1);
6660 } else {
6661 expr->opcode[leftindex+1] = JIM_EXPROP_LOGICOR_LEFT;
6662 expr->opcode[index] = JIM_EXPROP_LOGICOR_RIGHT;
6663 expr->obj[leftindex+1] = Jim_NewStringObj(interp, "|L", -1);
6664 expr->obj[index] = Jim_NewStringObj(interp, "|R", -1);
6665 }
6666 expr->opcode[leftindex] = JIM_EXPROP_NUMBER;
6667 expr->obj[leftindex] = Jim_NewIntObj(interp, offset);
6668 Jim_IncrRefCount(expr->obj[index]);
6669 Jim_IncrRefCount(expr->obj[leftindex]);
6670 Jim_IncrRefCount(expr->obj[leftindex+1]);
6671 }
6672 }
6673
6674 /* This method takes the string representation of an expression
6675 * and generates a program for the Expr's stack-based VM. */
6676 int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6677 {
6678 int exprTextLen;
6679 const char *exprText = Jim_GetString(objPtr, &exprTextLen);
6680 struct JimParserCtx parser;
6681 int i, shareLiterals;
6682 ExprByteCode *expr = Jim_Alloc(sizeof(*expr));
6683 Jim_Stack stack;
6684 Jim_ExprOperator *op;
6685
6686 /* Perform literal sharing with the current procedure
6687 * running only if this expression appears to be not generated
6688 * at runtime. */
6689 shareLiterals = objPtr->typePtr == &sourceObjType;
6690
6691 expr->opcode = NULL;
6692 expr->obj = NULL;
6693 expr->len = 0;
6694 expr->inUse = 1;
6695
6696 Jim_InitStack(&stack);
6697 JimParserInit(&parser, exprText, exprTextLen, 1);
6698 while(!JimParserEof(&parser)) {
6699 char *token;
6700 int len, type;
6701
6702 if (JimParseExpression(&parser) != JIM_OK) {
6703 Jim_SetResultString(interp, "Syntax error in expression", -1);
6704 goto err;
6705 }
6706 token = JimParserGetToken(&parser, &len, &type, NULL);
6707 if (type == JIM_TT_EOL) {
6708 Jim_Free(token);
6709 break;
6710 }
6711 switch(type) {
6712 case JIM_TT_STR:
6713 ExprObjAddInstr(interp, expr, JIM_EXPROP_STRING, token, len);
6714 break;
6715 case JIM_TT_ESC:
6716 ExprObjAddInstr(interp, expr, JIM_EXPROP_SUBST, token, len);
6717 break;
6718 case JIM_TT_VAR:
6719 ExprObjAddInstr(interp, expr, JIM_EXPROP_VARIABLE, token, len);
6720 break;
6721 case JIM_TT_DICTSUGAR:
6722 ExprObjAddInstr(interp, expr, JIM_EXPROP_DICTSUGAR, token, len);
6723 break;
6724 case JIM_TT_CMD:
6725 ExprObjAddInstr(interp, expr, JIM_EXPROP_COMMAND, token, len);
6726 break;
6727 case JIM_TT_EXPR_NUMBER:
6728 ExprObjAddInstr(interp, expr, JIM_EXPROP_NUMBER, token, len);
6729 break;
6730 case JIM_TT_EXPR_OPERATOR:
6731 op = JimExprOperatorInfo(token);
6732 while(1) {
6733 Jim_ExprOperator *stackTopOp;
6734
6735 if (Jim_StackPeek(&stack) != NULL) {
6736 stackTopOp = JimExprOperatorInfo(Jim_StackPeek(&stack));
6737 } else {
6738 stackTopOp = NULL;
6739 }
6740 if (Jim_StackLen(&stack) && op->arity != 1 &&
6741 stackTopOp && stackTopOp->precedence >= op->precedence)
6742 {
6743 ExprObjAddInstr(interp, expr, stackTopOp->opcode,
6744 Jim_StackPeek(&stack), -1);
6745 Jim_StackPop(&stack);
6746 } else {
6747 break;
6748 }
6749 }
6750 Jim_StackPush(&stack, token);
6751 break;
6752 case JIM_TT_SUBEXPR_START:
6753 Jim_StackPush(&stack, Jim_StrDup("("));
6754 Jim_Free(token);
6755 break;
6756 case JIM_TT_SUBEXPR_END:
6757 {
6758 int found = 0;
6759 while(Jim_StackLen(&stack)) {
6760 char *opstr = Jim_StackPop(&stack);
6761 if (!strcmp(opstr, "(")) {
6762 Jim_Free(opstr);
6763 found = 1;
6764 break;
6765 }
6766 op = JimExprOperatorInfo(opstr);
6767 ExprObjAddInstr(interp, expr, op->opcode, opstr, -1);
6768 }
6769 if (!found) {
6770 Jim_SetResultString(interp,
6771 "Unexpected close parenthesis", -1);
6772 goto err;
6773 }
6774 }
6775 Jim_Free(token);
6776 break;
6777 default:
6778 Jim_Panic(interp,"Default reached in SetExprFromAny()");
6779 break;
6780 }
6781 }
6782 while (Jim_StackLen(&stack)) {
6783 char *opstr = Jim_StackPop(&stack);
6784 op = JimExprOperatorInfo(opstr);
6785 if (op == NULL && !strcmp(opstr, "(")) {
6786 Jim_Free(opstr);
6787 Jim_SetResultString(interp, "Missing close parenthesis", -1);
6788 goto err;
6789 }
6790 ExprObjAddInstr(interp, expr, op->opcode, opstr, -1);
6791 }
6792 /* Check program correctness. */
6793 if (ExprCheckCorrectness(expr) != JIM_OK) {
6794 Jim_SetResultString(interp, "Invalid expression", -1);
6795 goto err;
6796 }
6797
6798 /* Free the stack used for the compilation. */
6799 Jim_FreeStackElements(&stack, Jim_Free);
6800 Jim_FreeStack(&stack);
6801
6802 /* Convert || and && operators in unary |L |R and &L &R for lazyness */
6803 ExprMakeLazy(interp, expr);
6804
6805 /* Perform literal sharing */
6806 if (shareLiterals && interp->framePtr->procBodyObjPtr) {
6807 Jim_Obj *bodyObjPtr = interp->framePtr->procBodyObjPtr;
6808 if (bodyObjPtr->typePtr == &scriptObjType) {
6809 ScriptObj *bodyScript = bodyObjPtr->internalRep.ptr;
6810 ExprShareLiterals(interp, expr, bodyScript);
6811 }
6812 }
6813
6814 /* Free the old internal rep and set the new one. */
6815 Jim_FreeIntRep(interp, objPtr);
6816 Jim_SetIntRepPtr(objPtr, expr);
6817 objPtr->typePtr = &exprObjType;
6818 return JIM_OK;
6819
6820 err: /* we jump here on syntax/compile errors. */
6821 Jim_FreeStackElements(&stack, Jim_Free);
6822 Jim_FreeStack(&stack);
6823 Jim_Free(expr->opcode);
6824 for (i = 0; i < expr->len; i++) {
6825 Jim_DecrRefCount(interp,expr->obj[i]);
6826 }
6827 Jim_Free(expr->obj);
6828 Jim_Free(expr);
6829 return JIM_ERR;
6830 }
6831
6832 ExprByteCode *Jim_GetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
6833 {
6834 if (objPtr->typePtr != &exprObjType) {
6835 if (SetExprFromAny(interp, objPtr) != JIM_OK)
6836 return NULL;
6837 }
6838 return (ExprByteCode*) Jim_GetIntRepPtr(objPtr);
6839 }
6840
6841 /* -----------------------------------------------------------------------------
6842 * Expressions evaluation.
6843 * Jim uses a specialized stack-based virtual machine for expressions,
6844 * that takes advantage of the fact that expr's operators
6845 * can't be redefined.
6846 *
6847 * Jim_EvalExpression() uses the bytecode compiled by
6848 * SetExprFromAny() method of the "expression" object.
6849 *
6850 * On success a Tcl Object containing the result of the evaluation
6851 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
6852 * returned.
6853 * On error the function returns a retcode != to JIM_OK and set a suitable
6854 * error on the interp.
6855 * ---------------------------------------------------------------------------*/
6856 #define JIM_EE_STATICSTACK_LEN 10
6857
6858 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr,
6859 Jim_Obj **exprResultPtrPtr)
6860 {
6861 ExprByteCode *expr;
6862 Jim_Obj **stack, *staticStack[JIM_EE_STATICSTACK_LEN];
6863 int stacklen = 0, i, error = 0, errRetCode = JIM_ERR;
6864
6865 Jim_IncrRefCount(exprObjPtr);
6866 expr = Jim_GetExpression(interp, exprObjPtr);
6867 if (!expr) {
6868 Jim_DecrRefCount(interp, exprObjPtr);
6869 return JIM_ERR; /* error in expression. */
6870 }
6871 /* In order to avoid that the internal repr gets freed due to
6872 * shimmering of the exprObjPtr's object, we make the internal rep
6873 * shared. */
6874 expr->inUse++;
6875
6876 /* The stack-based expr VM itself */
6877
6878 /* Stack allocation. Expr programs have the feature that
6879 * a program of length N can't require a stack longer than
6880 * N. */
6881 if (expr->len > JIM_EE_STATICSTACK_LEN)
6882 stack = Jim_Alloc(sizeof(Jim_Obj*)*expr->len);
6883 else
6884 stack = staticStack;
6885
6886 /* Execute every istruction */
6887 for (i = 0; i < expr->len; i++) {
6888 Jim_Obj *A, *B, *objPtr;
6889 jim_wide wA, wB, wC;
6890 double dA, dB, dC;
6891 const char *sA, *sB;
6892 int Alen, Blen, retcode;
6893 int opcode = expr->opcode[i];
6894
6895 if (opcode == JIM_EXPROP_NUMBER || opcode == JIM_EXPROP_STRING) {
6896 stack[stacklen++] = expr->obj[i];
6897 Jim_IncrRefCount(expr->obj[i]);
6898 } else if (opcode == JIM_EXPROP_VARIABLE) {
6899 objPtr = Jim_GetVariable(interp, expr->obj[i], JIM_ERRMSG);
6900 if (objPtr == NULL) {
6901 error = 1;
6902 goto err;
6903 }
6904 stack[stacklen++] = objPtr;
6905 Jim_IncrRefCount(objPtr);
6906 } else if (opcode == JIM_EXPROP_SUBST) {
6907 if ((retcode = Jim_SubstObj(interp, expr->obj[i],
6908 &objPtr, JIM_NONE)) != JIM_OK)
6909 {
6910 error = 1;
6911 errRetCode = retcode;
6912 goto err;
6913 }
6914 stack[stacklen++] = objPtr;
6915 Jim_IncrRefCount(objPtr);
6916 } else if (opcode == JIM_EXPROP_DICTSUGAR) {
6917 objPtr = Jim_ExpandDictSugar(interp, expr->obj[i]);
6918 if (objPtr == NULL) {
6919 error = 1;
6920 goto err;
6921 }
6922 stack[stacklen++] = objPtr;
6923 Jim_IncrRefCount(objPtr);
6924 } else if (opcode == JIM_EXPROP_COMMAND) {
6925 if ((retcode = Jim_EvalObj(interp, expr->obj[i])) != JIM_OK) {
6926 error = 1;
6927 errRetCode = retcode;
6928 goto err;
6929 }
6930 stack[stacklen++] = interp->result;
6931 Jim_IncrRefCount(interp->result);
6932 } else if (opcode >= JIM_EXPROP_BINARY_NUM_FIRST &&
6933 opcode <= JIM_EXPROP_BINARY_NUM_LAST)
6934 {
6935 /* Note that there isn't to increment the
6936 * refcount of objects. the references are moved
6937 * from stack to A and B. */
6938 B = stack[--stacklen];
6939 A = stack[--stacklen];
6940
6941 /* --- Integer --- */
6942 if ((A->typePtr == &doubleObjType && !A->bytes) ||
6943 (B->typePtr == &doubleObjType && !B->bytes) ||
6944 JimGetWideNoErr(interp, A, &wA) != JIM_OK ||
6945 JimGetWideNoErr(interp, B, &wB) != JIM_OK) {
6946 goto trydouble;
6947 }
6948 Jim_DecrRefCount(interp, A);
6949 Jim_DecrRefCount(interp, B);
6950 switch(expr->opcode[i]) {
6951 case JIM_EXPROP_ADD: wC = wA+wB; break;
6952 case JIM_EXPROP_SUB: wC = wA-wB; break;
6953 case JIM_EXPROP_MUL: wC = wA*wB; break;
6954 case JIM_EXPROP_LT: wC = wA<wB; break;
6955 case JIM_EXPROP_GT: wC = wA>wB; break;
6956 case JIM_EXPROP_LTE: wC = wA<=wB; break;
6957 case JIM_EXPROP_GTE: wC = wA>=wB; break;
6958 case JIM_EXPROP_LSHIFT: wC = wA<<wB; break;
6959 case JIM_EXPROP_RSHIFT: wC = wA>>wB; break;
6960 case JIM_EXPROP_NUMEQ: wC = wA==wB; break;
6961 case JIM_EXPROP_NUMNE: wC = wA!=wB; break;
6962 case JIM_EXPROP_BITAND: wC = wA&wB; break;
6963 case JIM_EXPROP_BITXOR: wC = wA^wB; break;
6964 case JIM_EXPROP_BITOR: wC = wA|wB; break;
6965 case JIM_EXPROP_POW: wC = JimPowWide(wA,wB); break;
6966 case JIM_EXPROP_LOGICAND_LEFT:
6967 if (wA == 0) {
6968 i += (int)wB;
6969 wC = 0;
6970 } else {
6971 continue;
6972 }
6973 break;
6974 case JIM_EXPROP_LOGICOR_LEFT:
6975 if (wA != 0) {
6976 i += (int)wB;
6977 wC = 1;
6978 } else {
6979 continue;
6980 }
6981 break;
6982 case JIM_EXPROP_DIV:
6983 if (wB == 0) goto divbyzero;
6984 wC = wA/wB;
6985 break;
6986 case JIM_EXPROP_MOD:
6987 if (wB == 0) goto divbyzero;
6988 wC = wA%wB;
6989 break;
6990 case JIM_EXPROP_ROTL: {
6991 /* uint32_t would be better. But not everyone has inttypes.h?*/
6992 unsigned long uA = (unsigned long)wA;
6993 #ifdef _MSC_VER
6994 wC = _rotl(uA,(unsigned long)wB);
6995 #else
6996 const unsigned int S = sizeof(unsigned long) * 8;
6997 wC = (unsigned long)((uA<<wB)|(uA>>(S-wB)));
6998 #endif
6999 break;
7000 }
7001 case JIM_EXPROP_ROTR: {
7002 unsigned long uA = (unsigned long)wA;
7003 #ifdef _MSC_VER
7004 wC = _rotr(uA,(unsigned long)wB);
7005 #else
7006 const unsigned int S = sizeof(unsigned long) * 8;
7007 wC = (unsigned long)((uA>>wB)|(uA<<(S-wB)));
7008 #endif
7009 break;
7010 }
7011
7012 default:
7013 wC = 0; /* avoid gcc warning */
7014 break;
7015 }
7016 stack[stacklen] = Jim_NewIntObj(interp, wC);
7017 Jim_IncrRefCount(stack[stacklen]);
7018 stacklen++;
7019 continue;
7020 trydouble:
7021 /* --- Double --- */
7022 if (Jim_GetDouble(interp, A, &dA) != JIM_OK ||
7023 Jim_GetDouble(interp, B, &dB) != JIM_OK) {
7024
7025 /* Hmmm! For compatibility, maybe convert != and == into ne and eq */
7026 if (expr->opcode[i] == JIM_EXPROP_NUMNE) {
7027 opcode = JIM_EXPROP_STRNE;
7028 goto retry_as_string;
7029 }
7030 else if (expr->opcode[i] == JIM_EXPROP_NUMEQ) {
7031 opcode = JIM_EXPROP_STREQ;
7032 goto retry_as_string;
7033 }
7034 Jim_DecrRefCount(interp, A);
7035 Jim_DecrRefCount(interp, B);
7036 error = 1;
7037 goto err;
7038 }
7039 Jim_DecrRefCount(interp, A);
7040 Jim_DecrRefCount(interp, B);
7041 switch(expr->opcode[i]) {
7042 case JIM_EXPROP_ROTL:
7043 case JIM_EXPROP_ROTR:
7044 case JIM_EXPROP_LSHIFT:
7045 case JIM_EXPROP_RSHIFT:
7046 case JIM_EXPROP_BITAND:
7047 case JIM_EXPROP_BITXOR:
7048 case JIM_EXPROP_BITOR:
7049 case JIM_EXPROP_MOD:
7050 case JIM_EXPROP_POW:
7051 Jim_SetResultString(interp,
7052 "Got floating-point value where integer was expected", -1);
7053 error = 1;
7054 goto err;
7055 break;
7056 case JIM_EXPROP_ADD: dC = dA+dB; break;
7057 case JIM_EXPROP_SUB: dC = dA-dB; break;
7058 case JIM_EXPROP_MUL: dC = dA*dB; break;
7059 case JIM_EXPROP_LT: dC = dA<dB; break;
7060 case JIM_EXPROP_GT: dC = dA>dB; break;
7061 case JIM_EXPROP_LTE: dC = dA<=dB; break;
7062 case JIM_EXPROP_GTE: dC = dA>=dB; break;
7063 case JIM_EXPROP_NUMEQ: dC = dA==dB; break;
7064 case JIM_EXPROP_NUMNE: dC = dA!=dB; break;
7065 case JIM_EXPROP_LOGICAND_LEFT:
7066 if (dA == 0) {
7067 i += (int)dB;
7068 dC = 0;
7069 } else {
7070 continue;
7071 }
7072 break;
7073 case JIM_EXPROP_LOGICOR_LEFT:
7074 if (dA != 0) {
7075 i += (int)dB;
7076 dC = 1;
7077 } else {
7078 continue;
7079 }
7080 break;
7081 case JIM_EXPROP_DIV:
7082 if (dB == 0) goto divbyzero;
7083 dC = dA/dB;
7084 break;
7085 default:
7086 dC = 0; /* avoid gcc warning */
7087 break;
7088 }
7089 stack[stacklen] = Jim_NewDoubleObj(interp, dC);
7090 Jim_IncrRefCount(stack[stacklen]);
7091 stacklen++;
7092 } else if (opcode == JIM_EXPROP_STREQ || opcode == JIM_EXPROP_STRNE) {
7093 B = stack[--stacklen];
7094 A = stack[--stacklen];
7095 retry_as_string:
7096 sA = Jim_GetString(A, &Alen);
7097 sB = Jim_GetString(B, &Blen);
7098 switch(opcode) {
7099 case JIM_EXPROP_STREQ:
7100 if (Alen == Blen && memcmp(sA, sB, Alen) ==0)
7101 wC = 1;
7102 else
7103 wC = 0;
7104 break;
7105 case JIM_EXPROP_STRNE:
7106 if (Alen != Blen || memcmp(sA, sB, Alen) != 0)
7107 wC = 1;
7108 else
7109 wC = 0;
7110 break;
7111 default:
7112 wC = 0; /* avoid gcc warning */
7113 break;
7114 }
7115 Jim_DecrRefCount(interp, A);
7116 Jim_DecrRefCount(interp, B);
7117 stack[stacklen] = Jim_NewIntObj(interp, wC);
7118 Jim_IncrRefCount(stack[stacklen]);
7119 stacklen++;
7120 } else if (opcode == JIM_EXPROP_NOT ||
7121 opcode == JIM_EXPROP_BITNOT ||
7122 opcode == JIM_EXPROP_LOGICAND_RIGHT ||
7123 opcode == JIM_EXPROP_LOGICOR_RIGHT) {
7124 /* Note that there isn't to increment the
7125 * refcount of objects. the references are moved
7126 * from stack to A and B. */
7127 A = stack[--stacklen];
7128
7129 /* --- Integer --- */
7130 if ((A->typePtr == &doubleObjType && !A->bytes) ||
7131 JimGetWideNoErr(interp, A, &wA) != JIM_OK) {
7132 goto trydouble_unary;
7133 }
7134 Jim_DecrRefCount(interp, A);
7135 switch(expr->opcode[i]) {
7136 case JIM_EXPROP_NOT: wC = !wA; break;
7137 case JIM_EXPROP_BITNOT: wC = ~wA; break;
7138 case JIM_EXPROP_LOGICAND_RIGHT:
7139 case JIM_EXPROP_LOGICOR_RIGHT: wC = (wA != 0); break;
7140 default:
7141 wC = 0; /* avoid gcc warning */
7142 break;
7143 }
7144 stack[stacklen] = Jim_NewIntObj(interp, wC);
7145 Jim_IncrRefCount(stack[stacklen]);
7146 stacklen++;
7147 continue;
7148 trydouble_unary:
7149 /* --- Double --- */
7150 if (Jim_GetDouble(interp, A, &dA) != JIM_OK) {
7151 Jim_DecrRefCount(interp, A);
7152 error = 1;
7153 goto err;
7154 }
7155 Jim_DecrRefCount(interp, A);
7156 switch(expr->opcode[i]) {
7157 case JIM_EXPROP_NOT: dC = !dA; break;
7158 case JIM_EXPROP_LOGICAND_RIGHT:
7159 case JIM_EXPROP_LOGICOR_RIGHT: dC = (dA != 0); break;
7160 case JIM_EXPROP_BITNOT:
7161 Jim_SetResultString(interp,
7162 "Got floating-point value where integer was expected", -1);
7163 error = 1;
7164 goto err;
7165 break;
7166 default:
7167 dC = 0; /* avoid gcc warning */
7168 break;
7169 }
7170 stack[stacklen] = Jim_NewDoubleObj(interp, dC);
7171 Jim_IncrRefCount(stack[stacklen]);
7172 stacklen++;
7173 } else {
7174 Jim_Panic(interp,"Unknown opcode in Jim_EvalExpression");
7175 }
7176 }
7177 err:
7178 /* There is no need to decerement the inUse field because
7179 * this reference is transfered back into the exprObjPtr. */
7180 Jim_FreeIntRep(interp, exprObjPtr);
7181 exprObjPtr->typePtr = &exprObjType;
7182 Jim_SetIntRepPtr(exprObjPtr, expr);
7183 Jim_DecrRefCount(interp, exprObjPtr);
7184 if (!error) {
7185 *exprResultPtrPtr = stack[0];
7186 Jim_IncrRefCount(stack[0]);
7187 errRetCode = JIM_OK;
7188 }
7189 for (i = 0; i < stacklen; i++) {
7190 Jim_DecrRefCount(interp, stack[i]);
7191 }
7192 if (stack != staticStack)
7193 Jim_Free(stack);
7194 return errRetCode;
7195 divbyzero:
7196 error = 1;
7197 Jim_SetResultString(interp, "Division by zero", -1);
7198 goto err;
7199 }
7200
7201 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
7202 {
7203 int retcode;
7204 jim_wide wideValue;
7205 double doubleValue;
7206 Jim_Obj *exprResultPtr;
7207
7208 retcode = Jim_EvalExpression(interp, exprObjPtr, &exprResultPtr);
7209 if (retcode != JIM_OK)
7210 return retcode;
7211 if (JimGetWideNoErr(interp, exprResultPtr, &wideValue) != JIM_OK) {
7212 if (Jim_GetDouble(interp, exprResultPtr, &doubleValue) != JIM_OK)
7213 {
7214 Jim_DecrRefCount(interp, exprResultPtr);
7215 return JIM_ERR;
7216 } else {
7217 Jim_DecrRefCount(interp, exprResultPtr);
7218 *boolPtr = doubleValue != 0;
7219 return JIM_OK;
7220 }
7221 }
7222 Jim_DecrRefCount(interp, exprResultPtr);
7223 *boolPtr = wideValue != 0;
7224 return JIM_OK;
7225 }
7226
7227 /* -----------------------------------------------------------------------------
7228 * ScanFormat String Object
7229 * ---------------------------------------------------------------------------*/
7230
7231 /* This Jim_Obj will held a parsed representation of a format string passed to
7232 * the Jim_ScanString command. For error diagnostics, the scanformat string has
7233 * to be parsed in its entirely first and then, if correct, can be used for
7234 * scanning. To avoid endless re-parsing, the parsed representation will be
7235 * stored in an internal representation and re-used for performance reason. */
7236
7237 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
7238 * scanformat string. This part will later be used to extract information
7239 * out from the string to be parsed by Jim_ScanString */
7240
7241 typedef struct ScanFmtPartDescr {
7242 char type; /* Type of conversion (e.g. c, d, f) */
7243 char modifier; /* Modify type (e.g. l - long, h - short */
7244 size_t width; /* Maximal width of input to be converted */
7245 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
7246 char *arg; /* Specification of a CHARSET conversion */
7247 char *prefix; /* Prefix to be scanned literally before conversion */
7248 } ScanFmtPartDescr;
7249
7250 /* The ScanFmtStringObj will held the internal representation of a scanformat
7251 * string parsed and separated in part descriptions. Furthermore it contains
7252 * the original string representation of the scanformat string to allow for
7253 * fast update of the Jim_Obj's string representation part.
7254 *
7255 * As add-on the internal object representation add some scratch pad area
7256 * for usage by Jim_ScanString to avoid endless allocating and freeing of
7257 * memory for purpose of string scanning.
7258 *
7259 * The error member points to a static allocated string in case of a mal-
7260 * formed scanformat string or it contains '0' (NULL) in case of a valid
7261 * parse representation.
7262 *
7263 * The whole memory of the internal representation is allocated as a single
7264 * area of memory that will be internally separated. So freeing and duplicating
7265 * of such an object is cheap */
7266
7267 typedef struct ScanFmtStringObj {
7268 jim_wide size; /* Size of internal repr in bytes */
7269 char *stringRep; /* Original string representation */
7270 size_t count; /* Number of ScanFmtPartDescr contained */
7271 size_t convCount; /* Number of conversions that will assign */
7272 size_t maxPos; /* Max position index if XPG3 is used */
7273 const char *error; /* Ptr to error text (NULL if no error */
7274 char *scratch; /* Some scratch pad used by Jim_ScanString */
7275 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
7276 } ScanFmtStringObj;
7277
7278
7279 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
7280 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
7281 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
7282
7283 static Jim_ObjType scanFmtStringObjType = {
7284 "scanformatstring",
7285 FreeScanFmtInternalRep,
7286 DupScanFmtInternalRep,
7287 UpdateStringOfScanFmt,
7288 JIM_TYPE_NONE,
7289 };
7290
7291 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
7292 {
7293 JIM_NOTUSED(interp);
7294 Jim_Free((char*)objPtr->internalRep.ptr);
7295 objPtr->internalRep.ptr = 0;
7296 }
7297
7298 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
7299 {
7300 size_t size = (size_t)((ScanFmtStringObj*)srcPtr->internalRep.ptr)->size;
7301 ScanFmtStringObj *newVec = (ScanFmtStringObj*)Jim_Alloc(size);
7302
7303 JIM_NOTUSED(interp);
7304 memcpy(newVec, srcPtr->internalRep.ptr, size);
7305 dupPtr->internalRep.ptr = newVec;
7306 dupPtr->typePtr = &scanFmtStringObjType;
7307 }
7308
7309 void UpdateStringOfScanFmt(Jim_Obj *objPtr)
7310 {
7311 char *bytes = ((ScanFmtStringObj*)objPtr->internalRep.ptr)->stringRep;
7312
7313 objPtr->bytes = Jim_StrDup(bytes);
7314 objPtr->length = strlen(bytes);
7315 }
7316
7317 /* SetScanFmtFromAny will parse a given string and create the internal
7318 * representation of the format specification. In case of an error
7319 * the error data member of the internal representation will be set
7320 * to an descriptive error text and the function will be left with
7321 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
7322 * specification */
7323
7324 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7325 {
7326 ScanFmtStringObj *fmtObj;
7327 char *buffer;
7328 int maxCount, i, approxSize, lastPos = -1;
7329 const char *fmt = objPtr->bytes;
7330 int maxFmtLen = objPtr->length;
7331 const char *fmtEnd = fmt + maxFmtLen;
7332 int curr;
7333
7334 Jim_FreeIntRep(interp, objPtr);
7335 /* Count how many conversions could take place maximally */
7336 for (i=0, maxCount=0; i < maxFmtLen; ++i)
7337 if (fmt[i] == '%')
7338 ++maxCount;
7339 /* Calculate an approximation of the memory necessary */
7340 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
7341 + (maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
7342 + maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
7343 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
7344 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
7345 + (maxCount +1) * sizeof(char) /* '\0' for every partial */
7346 + 1; /* safety byte */
7347 fmtObj = (ScanFmtStringObj*)Jim_Alloc(approxSize);
7348 memset(fmtObj, 0, approxSize);
7349 fmtObj->size = approxSize;
7350 fmtObj->maxPos = 0;
7351 fmtObj->scratch = (char*)&fmtObj->descr[maxCount+1];
7352 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
7353 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
7354 buffer = fmtObj->stringRep + maxFmtLen + 1;
7355 objPtr->internalRep.ptr = fmtObj;
7356 objPtr->typePtr = &scanFmtStringObjType;
7357 for (i=0, curr=0; fmt < fmtEnd; ++fmt) {
7358 int width=0, skip;
7359 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
7360 fmtObj->count++;
7361 descr->width = 0; /* Assume width unspecified */
7362 /* Overread and store any "literal" prefix */
7363 if (*fmt != '%' || fmt[1] == '%') {
7364 descr->type = 0;
7365 descr->prefix = &buffer[i];
7366 for (; fmt < fmtEnd; ++fmt) {
7367 if (*fmt == '%') {
7368 if (fmt[1] != '%') break;
7369 ++fmt;
7370 }
7371 buffer[i++] = *fmt;
7372 }
7373 buffer[i++] = 0;
7374 }
7375 /* Skip the conversion introducing '%' sign */
7376 ++fmt;
7377 /* End reached due to non-conversion literal only? */
7378 if (fmt >= fmtEnd)
7379 goto done;
7380 descr->pos = 0; /* Assume "natural" positioning */
7381 if (*fmt == '*') {
7382 descr->pos = -1; /* Okay, conversion will not be assigned */
7383 ++fmt;
7384 } else
7385 fmtObj->convCount++; /* Otherwise count as assign-conversion */
7386 /* Check if next token is a number (could be width or pos */
7387 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
7388 fmt += skip;
7389 /* Was the number a XPG3 position specifier? */
7390 if (descr->pos != -1 && *fmt == '$') {
7391 int prev;
7392 ++fmt;
7393 descr->pos = width;
7394 width = 0;
7395 /* Look if "natural" postioning and XPG3 one was mixed */
7396 if ((lastPos == 0 && descr->pos > 0)
7397 || (lastPos > 0 && descr->pos == 0)) {
7398 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
7399 return JIM_ERR;
7400 }
7401 /* Look if this position was already used */
7402 for (prev=0; prev < curr; ++prev) {
7403 if (fmtObj->descr[prev].pos == -1) continue;
7404 if (fmtObj->descr[prev].pos == descr->pos) {
7405 fmtObj->error = "same \"%n$\" conversion specifier "
7406 "used more than once";
7407 return JIM_ERR;
7408 }
7409 }
7410 /* Try to find a width after the XPG3 specifier */
7411 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
7412 descr->width = width;
7413 fmt += skip;
7414 }
7415 if (descr->pos > 0 && (size_t)descr->pos > fmtObj->maxPos)
7416 fmtObj->maxPos = descr->pos;
7417 } else {
7418 /* Number was not a XPG3, so it has to be a width */
7419 descr->width = width;
7420 }
7421 }
7422 /* If positioning mode was undetermined yet, fix this */
7423 if (lastPos == -1)
7424 lastPos = descr->pos;
7425 /* Handle CHARSET conversion type ... */
7426 if (*fmt == '[') {
7427 int swapped = 1, beg = i, end, j;
7428 descr->type = '[';
7429 descr->arg = &buffer[i];
7430 ++fmt;
7431 if (*fmt == '^') buffer[i++] = *fmt++;
7432 if (*fmt == ']') buffer[i++] = *fmt++;
7433 while (*fmt && *fmt != ']') buffer[i++] = *fmt++;
7434 if (*fmt != ']') {
7435 fmtObj->error = "unmatched [ in format string";
7436 return JIM_ERR;
7437 }
7438 end = i;
7439 buffer[i++] = 0;
7440 /* In case a range fence was given "backwards", swap it */
7441 while (swapped) {
7442 swapped = 0;
7443 for (j=beg+1; j < end-1; ++j) {
7444 if (buffer[j] == '-' && buffer[j-1] > buffer[j+1]) {
7445 char tmp = buffer[j-1];
7446 buffer[j-1] = buffer[j+1];
7447 buffer[j+1] = tmp;
7448 swapped = 1;
7449 }
7450 }
7451 }
7452 } else {
7453 /* Remember any valid modifier if given */
7454 if (strchr("hlL", *fmt) != 0)
7455 descr->modifier = tolower((int)*fmt++);
7456
7457 descr->type = *fmt;
7458 if (strchr("efgcsndoxui", *fmt) == 0) {
7459 fmtObj->error = "bad scan conversion character";
7460 return JIM_ERR;
7461 } else if (*fmt == 'c' && descr->width != 0) {
7462 fmtObj->error = "field width may not be specified in %c "
7463 "conversion";
7464 return JIM_ERR;
7465 } else if (*fmt == 'u' && descr->modifier == 'l') {
7466 fmtObj->error = "unsigned wide not supported";
7467 return JIM_ERR;
7468 }
7469 }
7470 curr++;
7471 }
7472 done:
7473 if (fmtObj->convCount == 0) {
7474 fmtObj->error = "no any conversion specifier given";
7475 return JIM_ERR;
7476 }
7477 return JIM_OK;
7478 }
7479
7480 /* Some accessor macros to allow lowlevel access to fields of internal repr */
7481
7482 #define FormatGetCnvCount(_fo_) \
7483 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
7484 #define FormatGetMaxPos(_fo_) \
7485 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
7486 #define FormatGetError(_fo_) \
7487 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
7488
7489 /* Some Bit testing/setting/cleaning routines. For now only used in handling
7490 * charsets ([a-z123]) within scanning. Later on perhaps a base for a
7491 * bitvector implementation in Jim? */
7492
7493 static int JimTestBit(const char *bitvec, char ch)
7494 {
7495 div_t pos = div(ch-1, 8);
7496 return bitvec[pos.quot] & (1 << pos.rem);
7497 }
7498
7499 static void JimSetBit(char *bitvec, char ch)
7500 {
7501 div_t pos = div(ch-1, 8);
7502 bitvec[pos.quot] |= (1 << pos.rem);
7503 }
7504
7505 #if 0 /* currently not used */
7506 static void JimClearBit(char *bitvec, char ch)
7507 {
7508 div_t pos = div(ch-1, 8);
7509 bitvec[pos.quot] &= ~(1 << pos.rem);
7510 }
7511 #endif
7512
7513 /* JimScanAString is used to scan an unspecified string that ends with
7514 * next WS, or a string that is specified via a charset. The charset
7515 * is currently implemented in a way to only allow for usage with
7516 * ASCII. Whenever we will switch to UNICODE, another idea has to
7517 * be born :-/
7518 *
7519 * FIXME: Works only with ASCII */
7520
7521 static Jim_Obj *
7522 JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
7523 {
7524 size_t i;
7525 Jim_Obj *result;
7526 char charset[256/8+1]; /* A Charset may contain max 256 chars */
7527 char *buffer = Jim_Alloc(strlen(str)+1), *anchor = buffer;
7528
7529 /* First init charset to nothing or all, depending if a specified
7530 * or an unspecified string has to be parsed */
7531 memset(charset, (sdescr ? 0 : 255), sizeof(charset));
7532 if (sdescr) {
7533 /* There was a set description given, that means we are parsing
7534 * a specified string. So we have to build a corresponding
7535 * charset reflecting the description */
7536 int notFlag = 0;
7537 /* Should the set be negated at the end? */
7538 if (*sdescr == '^') {
7539 notFlag = 1;
7540 ++sdescr;
7541 }
7542 /* Here '-' is meant literally and not to define a range */
7543 if (*sdescr == '-') {
7544 JimSetBit(charset, '-');
7545 ++sdescr;
7546 }
7547 while (*sdescr) {
7548 if (sdescr[1] == '-' && sdescr[2] != 0) {
7549 /* Handle range definitions */
7550 int i;
7551 for (i=sdescr[0]; i <= sdescr[2]; ++i)
7552 JimSetBit(charset, (char)i);
7553 sdescr += 3;
7554 } else {
7555 /* Handle verbatim character definitions */
7556 JimSetBit(charset, *sdescr++);
7557 }
7558 }
7559 /* Negate the charset if there was a NOT given */
7560 for (i=0; notFlag && i < sizeof(charset); ++i)
7561 charset[i] = ~charset[i];
7562 }
7563 /* And after all the mess above, the real work begin ... */
7564 while (str && *str) {
7565 if (!sdescr && isspace((int)*str))
7566 break; /* EOS via WS if unspecified */
7567 if (JimTestBit(charset, *str)) *buffer++ = *str++;
7568 else break; /* EOS via mismatch if specified scanning */
7569 }
7570 *buffer = 0; /* Close the string properly ... */
7571 result = Jim_NewStringObj(interp, anchor, -1);
7572 Jim_Free(anchor); /* ... and free it afer usage */
7573 return result;
7574 }
7575
7576 /* ScanOneEntry will scan one entry out of the string passed as argument.
7577 * It use the sscanf() function for this task. After extracting and
7578 * converting of the value, the count of scanned characters will be
7579 * returned of -1 in case of no conversion tool place and string was
7580 * already scanned thru */
7581
7582 static int ScanOneEntry(Jim_Interp *interp, const char *str, long pos,
7583 ScanFmtStringObj *fmtObj, long index, Jim_Obj **valObjPtr)
7584 {
7585 # define MAX_SIZE (sizeof(jim_wide) > sizeof(double) \
7586 ? sizeof(jim_wide) \
7587 : sizeof(double))
7588 char buffer[MAX_SIZE];
7589 char *value = buffer;
7590 const char *tok;
7591 const ScanFmtPartDescr *descr = &fmtObj->descr[index];
7592 size_t sLen = strlen(&str[pos]), scanned = 0;
7593 size_t anchor = pos;
7594 int i;
7595
7596 /* First pessimiticly assume, we will not scan anything :-) */
7597 *valObjPtr = 0;
7598 if (descr->prefix) {
7599 /* There was a prefix given before the conversion, skip it and adjust
7600 * the string-to-be-parsed accordingly */
7601 for (i=0; str[pos] && descr->prefix[i]; ++i) {
7602 /* If prefix require, skip WS */
7603 if (isspace((int)descr->prefix[i]))
7604 while (str[pos] && isspace((int)str[pos])) ++pos;
7605 else if (descr->prefix[i] != str[pos])
7606 break; /* Prefix do not match here, leave the loop */
7607 else
7608 ++pos; /* Prefix matched so far, next round */
7609 }
7610 if (str[pos] == 0)
7611 return -1; /* All of str consumed: EOF condition */
7612 else if (descr->prefix[i] != 0)
7613 return 0; /* Not whole prefix consumed, no conversion possible */
7614 }
7615 /* For all but following conversion, skip leading WS */
7616 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
7617 while (isspace((int)str[pos])) ++pos;
7618 /* Determine how much skipped/scanned so far */
7619 scanned = pos - anchor;
7620 if (descr->type == 'n') {
7621 /* Return pseudo conversion means: how much scanned so far? */
7622 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
7623 } else if (str[pos] == 0) {
7624 /* Cannot scan anything, as str is totally consumed */
7625 return -1;
7626 } else {
7627 /* Processing of conversions follows ... */
7628 if (descr->width > 0) {
7629 /* Do not try to scan as fas as possible but only the given width.
7630 * To ensure this, we copy the part that should be scanned. */
7631 size_t tLen = descr->width > sLen ? sLen : descr->width;
7632 tok = Jim_StrDupLen(&str[pos], tLen);
7633 } else {
7634 /* As no width was given, simply refer to the original string */
7635 tok = &str[pos];
7636 }
7637 switch (descr->type) {
7638 case 'c':
7639 *valObjPtr = Jim_NewIntObj(interp, *tok);
7640 scanned += 1;
7641 break;
7642 case 'd': case 'o': case 'x': case 'u': case 'i': {
7643 char *endp; /* Position where the number finished */
7644 int base = descr->type == 'o' ? 8
7645 : descr->type == 'x' ? 16
7646 : descr->type == 'i' ? 0
7647 : 10;
7648
7649 do {
7650 /* Try to scan a number with the given base */
7651 if (descr->modifier == 'l')
7652 #ifdef HAVE_LONG_LONG
7653 *(jim_wide*)value = JimStrtoll(tok, &endp, base);
7654 #else
7655 *(jim_wide*)value = strtol(tok, &endp, base);
7656 #endif
7657 else
7658 if (descr->type == 'u')
7659 *(long*)value = strtoul(tok, &endp, base);
7660 else
7661 *(long*)value = strtol(tok, &endp, base);
7662 /* If scanning failed, and base was undetermined, simply
7663 * put it to 10 and try once more. This should catch the
7664 * case where %i begin to parse a number prefix (e.g.
7665 * '0x' but no further digits follows. This will be
7666 * handled as a ZERO followed by a char 'x' by Tcl */
7667 if (endp == tok && base == 0) base = 10;
7668 else break;
7669 } while (1);
7670 if (endp != tok) {
7671 /* There was some number sucessfully scanned! */
7672 if (descr->modifier == 'l')
7673 *valObjPtr = Jim_NewIntObj(interp, *(jim_wide*)value);
7674 else
7675 *valObjPtr = Jim_NewIntObj(interp, *(long*)value);
7676 /* Adjust the number-of-chars scanned so far */
7677 scanned += endp - tok;
7678 } else {
7679 /* Nothing was scanned. We have to determine if this
7680 * happened due to e.g. prefix mismatch or input str
7681 * exhausted */
7682 scanned = *tok ? 0 : -1;
7683 }
7684 break;
7685 }
7686 case 's': case '[': {
7687 *valObjPtr = JimScanAString(interp, descr->arg, tok);
7688 scanned += Jim_Length(*valObjPtr);
7689 break;
7690 }
7691 case 'e': case 'f': case 'g': {
7692 char *endp;
7693
7694 *(double*)value = strtod(tok, &endp);
7695 if (endp != tok) {
7696 /* There was some number sucessfully scanned! */
7697 *valObjPtr = Jim_NewDoubleObj(interp, *(double*)value);
7698 /* Adjust the number-of-chars scanned so far */
7699 scanned += endp - tok;
7700 } else {
7701 /* Nothing was scanned. We have to determine if this
7702 * happened due to e.g. prefix mismatch or input str
7703 * exhausted */
7704 scanned = *tok ? 0 : -1;
7705 }
7706 break;
7707 }
7708 }
7709 /* If a substring was allocated (due to pre-defined width) do not
7710 * forget to free it */
7711 if (tok != &str[pos])
7712 Jim_Free((char*)tok);
7713 }
7714 return scanned;
7715 }
7716
7717 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
7718 * string and returns all converted (and not ignored) values in a list back
7719 * to the caller. If an error occured, a NULL pointer will be returned */
7720
7721 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr,
7722 Jim_Obj *fmtObjPtr, int flags)
7723 {
7724 size_t i, pos;
7725 int scanned = 1;
7726 const char *str = Jim_GetString(strObjPtr, 0);
7727 Jim_Obj *resultList = 0;
7728 Jim_Obj **resultVec;
7729 int resultc;
7730 Jim_Obj *emptyStr = 0;
7731 ScanFmtStringObj *fmtObj;
7732
7733 /* If format specification is not an object, convert it! */
7734 if (fmtObjPtr->typePtr != &scanFmtStringObjType)
7735 SetScanFmtFromAny(interp, fmtObjPtr);
7736 fmtObj = (ScanFmtStringObj*)fmtObjPtr->internalRep.ptr;
7737 /* Check if format specification was valid */
7738 if (fmtObj->error != 0) {
7739 if (flags & JIM_ERRMSG)
7740 Jim_SetResultString(interp, fmtObj->error, -1);
7741 return 0;
7742 }
7743 /* Allocate a new "shared" empty string for all unassigned conversions */
7744 emptyStr = Jim_NewEmptyStringObj(interp);
7745 Jim_IncrRefCount(emptyStr);
7746 /* Create a list and fill it with empty strings up to max specified XPG3 */
7747 resultList = Jim_NewListObj(interp, 0, 0);
7748 if (fmtObj->maxPos > 0) {
7749 for (i=0; i < fmtObj->maxPos; ++i)
7750 Jim_ListAppendElement(interp, resultList, emptyStr);
7751 JimListGetElements(interp, resultList, &resultc, &resultVec);
7752 }
7753 /* Now handle every partial format description */
7754 for (i=0, pos=0; i < fmtObj->count; ++i) {
7755 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
7756 Jim_Obj *value = 0;
7757 /* Only last type may be "literal" w/o conversion - skip it! */
7758 if (descr->type == 0) continue;
7759 /* As long as any conversion could be done, we will proceed */
7760 if (scanned > 0)
7761 scanned = ScanOneEntry(interp, str, pos, fmtObj, i, &value);
7762 /* In case our first try results in EOF, we will leave */
7763 if (scanned == -1 && i == 0)
7764 goto eof;
7765 /* Advance next pos-to-be-scanned for the amount scanned already */
7766 pos += scanned;
7767 /* value == 0 means no conversion took place so take empty string */
7768 if (value == 0)
7769 value = Jim_NewEmptyStringObj(interp);
7770 /* If value is a non-assignable one, skip it */
7771 if (descr->pos == -1) {
7772 Jim_FreeNewObj(interp, value);
7773 } else if (descr->pos == 0)
7774 /* Otherwise append it to the result list if no XPG3 was given */
7775 Jim_ListAppendElement(interp, resultList, value);
7776 else if (resultVec[descr->pos-1] == emptyStr) {
7777 /* But due to given XPG3, put the value into the corr. slot */
7778 Jim_DecrRefCount(interp, resultVec[descr->pos-1]);
7779 Jim_IncrRefCount(value);
7780 resultVec[descr->pos-1] = value;
7781 } else {
7782 /* Otherwise, the slot was already used - free obj and ERROR */
7783 Jim_FreeNewObj(interp, value);
7784 goto err;
7785 }
7786 }
7787 Jim_DecrRefCount(interp, emptyStr);
7788 return resultList;
7789 eof:
7790 Jim_DecrRefCount(interp, emptyStr);
7791 Jim_FreeNewObj(interp, resultList);
7792 return (Jim_Obj*)EOF;
7793 err:
7794 Jim_DecrRefCount(interp, emptyStr);
7795 Jim_FreeNewObj(interp, resultList);
7796 return 0;
7797 }
7798
7799 /* -----------------------------------------------------------------------------
7800 * Pseudo Random Number Generation
7801 * ---------------------------------------------------------------------------*/
7802 static void JimPrngSeed(Jim_Interp *interp, const unsigned char *seed,
7803 int seedLen);
7804
7805 /* Initialize the sbox with the numbers from 0 to 255 */
7806 static void JimPrngInit(Jim_Interp *interp)
7807 {
7808 int i;
7809 unsigned int seed[256];
7810
7811 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
7812 for (i = 0; i < 256; i++)
7813 seed[i] = (rand() ^ time(NULL) ^ clock());
7814 JimPrngSeed(interp, (unsigned char*) seed, sizeof(int)*256);
7815 }
7816
7817 /* Generates N bytes of random data */
7818 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
7819 {
7820 Jim_PrngState *prng;
7821 unsigned char *destByte = (unsigned char*) dest;
7822 unsigned int si, sj, x;
7823
7824 /* initialization, only needed the first time */
7825 if (interp->prngState == NULL)
7826 JimPrngInit(interp);
7827 prng = interp->prngState;
7828 /* generates 'len' bytes of pseudo-random numbers */
7829 for (x = 0; x < len; x++) {
7830 prng->i = (prng->i+1) & 0xff;
7831 si = prng->sbox[prng->i];
7832 prng->j = (prng->j + si) & 0xff;
7833 sj = prng->sbox[prng->j];
7834 prng->sbox[prng->i] = sj;
7835 prng->sbox[prng->j] = si;
7836 *destByte++ = prng->sbox[(si+sj)&0xff];
7837 }
7838 }
7839
7840 /* Re-seed the generator with user-provided bytes */
7841 static void JimPrngSeed(Jim_Interp *interp, const unsigned char *seed,
7842 int seedLen)
7843 {
7844 int i;
7845 unsigned char buf[256];
7846 Jim_PrngState *prng;
7847
7848 /* initialization, only needed the first time */
7849 if (interp->prngState == NULL)
7850 JimPrngInit(interp);
7851 prng = interp->prngState;
7852
7853 /* Set the sbox[i] with i */
7854 for (i = 0; i < 256; i++)
7855 prng->sbox[i] = i;
7856 /* Now use the seed to perform a random permutation of the sbox */
7857 for (i = 0; i < seedLen; i++) {
7858 unsigned char t;
7859
7860 t = prng->sbox[i&0xFF];
7861 prng->sbox[i&0xFF] = prng->sbox[seed[i]];
7862 prng->sbox[seed[i]] = t;
7863 }
7864 prng->i = prng->j = 0;
7865 /* discard the first 256 bytes of stream. */
7866 JimRandomBytes(interp, buf, 256);
7867 }
7868
7869 /* -----------------------------------------------------------------------------
7870 * Dynamic libraries support (WIN32 not supported)
7871 * ---------------------------------------------------------------------------*/
7872
7873 #ifdef JIM_DYNLIB
7874 #ifdef WIN32
7875 #define RTLD_LAZY 0
7876 void * dlopen(const char *path, int mode)
7877 {
7878 JIM_NOTUSED(mode);
7879
7880 return (void *)LoadLibraryA(path);
7881 }
7882 int dlclose(void *handle)
7883 {
7884 FreeLibrary((HANDLE)handle);
7885 return 0;
7886 }
7887 void *dlsym(void *handle, const char *symbol)
7888 {
7889 return GetProcAddress((HMODULE)handle, symbol);
7890 }
7891 static char win32_dlerror_string[121];
7892 const char *dlerror(void)
7893 {
7894 FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM, NULL, GetLastError(),
7895 LANG_NEUTRAL, win32_dlerror_string, 120, NULL);
7896 return win32_dlerror_string;
7897 }
7898 #endif /* WIN32 */
7899
7900 int Jim_LoadLibrary(Jim_Interp *interp, const char *pathName)
7901 {
7902 Jim_Obj *libPathObjPtr;
7903 int prefixc, i;
7904 void *handle;
7905 int (*onload)(Jim_Interp *interp);
7906
7907 libPathObjPtr = Jim_GetGlobalVariableStr(interp, "jim_libpath", JIM_NONE);
7908 if (libPathObjPtr == NULL) {
7909 prefixc = 0;
7910 libPathObjPtr = NULL;
7911 } else {
7912 Jim_IncrRefCount(libPathObjPtr);
7913 Jim_ListLength(interp, libPathObjPtr, &prefixc);
7914 }
7915
7916 for (i = -1; i < prefixc; i++) {
7917 if (i < 0) {
7918 handle = dlopen(pathName, RTLD_LAZY);
7919 } else {
7920 FILE *fp;
7921 char buf[JIM_PATH_LEN];
7922 const char *prefix;
7923 int prefixlen;
7924 Jim_Obj *prefixObjPtr;
7925
7926 buf[0] = '\0';
7927 if (Jim_ListIndex(interp, libPathObjPtr, i,
7928 &prefixObjPtr, JIM_NONE) != JIM_OK)
7929 continue;
7930 prefix = Jim_GetString(prefixObjPtr, &prefixlen);
7931 if (prefixlen+strlen(pathName)+1 >= JIM_PATH_LEN)
7932 continue;
7933 if (*pathName == '/') {
7934 strcpy(buf, pathName);
7935 }
7936 else if (prefixlen && prefix[prefixlen-1] == '/')
7937 sprintf(buf, "%s%s", prefix, pathName);
7938 else
7939 sprintf(buf, "%s/%s", prefix, pathName);
7940 fp = fopen(buf, "r");
7941 if (fp == NULL)
7942 continue;
7943 fclose(fp);
7944 handle = dlopen(buf, RTLD_LAZY);
7945 }
7946 if (handle == NULL) {
7947 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
7948 Jim_AppendStrings(interp, Jim_GetResult(interp),
7949 "error loading extension \"", pathName,
7950 "\": ", dlerror(), NULL);
7951 if (i < 0)
7952 continue;
7953 goto err;
7954 }
7955 if ((onload = dlsym(handle, "Jim_OnLoad")) == NULL) {
7956 Jim_SetResultString(interp,
7957 "No Jim_OnLoad symbol found on extension", -1);
7958 goto err;
7959 }
7960 if (onload(interp) == JIM_ERR) {
7961 dlclose(handle);
7962 goto err;
7963 }
7964 Jim_SetEmptyResult(interp);
7965 if (libPathObjPtr != NULL)
7966 Jim_DecrRefCount(interp, libPathObjPtr);
7967 return JIM_OK;
7968 }
7969 err:
7970 if (libPathObjPtr != NULL)
7971 Jim_DecrRefCount(interp, libPathObjPtr);
7972 return JIM_ERR;
7973 }
7974 #else /* JIM_DYNLIB */
7975 int Jim_LoadLibrary(Jim_Interp *interp, const char *pathName)
7976 {
7977 JIM_NOTUSED(interp);
7978 JIM_NOTUSED(pathName);
7979
7980 Jim_SetResultString(interp, "the Jim binary has no support for [load]", -1);
7981 return JIM_ERR;
7982 }
7983 #endif/* JIM_DYNLIB */
7984
7985 /* -----------------------------------------------------------------------------
7986 * Packages handling
7987 * ---------------------------------------------------------------------------*/
7988
7989 #define JIM_PKG_ANY_VERSION -1
7990
7991 /* Convert a string of the type "1.2" into an integer.
7992 * MAJOR.MINOR is converted as MAJOR*100+MINOR, so "1.2" is converted
7993 * to the integer with value 102 */
7994 static int JimPackageVersionToInt(Jim_Interp *interp, const char *v,
7995 int *intPtr, int flags)
7996 {
7997 char *copy;
7998 jim_wide major, minor;
7999 char *majorStr, *minorStr, *p;
8000
8001 if (v[0] == '\0') {
8002 *intPtr = JIM_PKG_ANY_VERSION;
8003 return JIM_OK;
8004 }
8005
8006 copy = Jim_StrDup(v);
8007 p = strchr(copy, '.');
8008 if (p == NULL) goto badfmt;
8009 *p = '\0';
8010 majorStr = copy;
8011 minorStr = p+1;
8012
8013 if (Jim_StringToWide(majorStr, &major, 10) != JIM_OK ||
8014 Jim_StringToWide(minorStr, &minor, 10) != JIM_OK)
8015 goto badfmt;
8016 *intPtr = (int)(major*100+minor);
8017 Jim_Free(copy);
8018 return JIM_OK;
8019
8020 badfmt:
8021 Jim_Free(copy);
8022 if (flags & JIM_ERRMSG) {
8023 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8024 Jim_AppendStrings(interp, Jim_GetResult(interp),
8025 "invalid package version '", v, "'", NULL);
8026 }
8027 return JIM_ERR;
8028 }
8029
8030 #define JIM_MATCHVER_EXACT (1<<JIM_PRIV_FLAG_SHIFT)
8031 static int JimPackageMatchVersion(int needed, int actual, int flags)
8032 {
8033 if (needed == JIM_PKG_ANY_VERSION) return 1;
8034 if (flags & JIM_MATCHVER_EXACT) {
8035 return needed == actual;
8036 } else {
8037 return needed/100 == actual/100 && (needed <= actual);
8038 }
8039 }
8040
8041 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver,
8042 int flags)
8043 {
8044 int intVersion;
8045 /* Check if the version format is ok */
8046 if (JimPackageVersionToInt(interp, ver, &intVersion, JIM_ERRMSG) != JIM_OK)
8047 return JIM_ERR;
8048 /* If the package was already provided returns an error. */
8049 if (Jim_FindHashEntry(&interp->packages, name) != NULL) {
8050 if (flags & JIM_ERRMSG) {
8051 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8052 Jim_AppendStrings(interp, Jim_GetResult(interp),
8053 "package '", name, "' was already provided", NULL);
8054 }
8055 return JIM_ERR;
8056 }
8057 Jim_AddHashEntry(&interp->packages, name, (char*) ver);
8058 return JIM_OK;
8059 }
8060
8061 #ifndef JIM_ANSIC
8062
8063 #ifndef WIN32
8064 # include <sys/types.h>
8065 # include <dirent.h>
8066 #else
8067 # include <io.h>
8068 /* Posix dirent.h compatiblity layer for WIN32.
8069 * Copyright Kevlin Henney, 1997, 2003. All rights reserved.
8070 * Copyright Salvatore Sanfilippo ,2005.
8071 *
8072 * Permission to use, copy, modify, and distribute this software and its
8073 * documentation for any purpose is hereby granted without fee, provided
8074 * that this copyright and permissions notice appear in all copies and
8075 * derivatives.
8076 *
8077 * This software is supplied "as is" without express or implied warranty.
8078 * This software was modified by Salvatore Sanfilippo for the Jim Interpreter.
8079 */
8080
8081 struct dirent {
8082 char *d_name;
8083 };
8084
8085 typedef struct DIR {
8086 long handle; /* -1 for failed rewind */
8087 struct _finddata_t info;
8088 struct dirent result; /* d_name null iff first time */
8089 char *name; /* null-terminated char string */
8090 } DIR;
8091
8092 DIR *opendir(const char *name)
8093 {
8094 DIR *dir = 0;
8095
8096 if(name && name[0]) {
8097 size_t base_length = strlen(name);
8098 const char *all = /* search pattern must end with suitable wildcard */
8099 strchr("/\\", name[base_length - 1]) ? "*" : "/*";
8100
8101 if((dir = (DIR *) Jim_Alloc(sizeof *dir)) != 0 &&
8102 (dir->name = (char *) Jim_Alloc(base_length + strlen(all) + 1)) != 0)
8103 {
8104 strcat(strcpy(dir->name, name), all);
8105
8106 if((dir->handle = (long) _findfirst(dir->name, &dir->info)) != -1)
8107 dir->result.d_name = 0;
8108 else { /* rollback */
8109 Jim_Free(dir->name);
8110 Jim_Free(dir);
8111 dir = 0;
8112 }
8113 } else { /* rollback */
8114 Jim_Free(dir);
8115 dir = 0;
8116 errno = ENOMEM;
8117 }
8118 } else {
8119 errno = EINVAL;
8120 }
8121 return dir;
8122 }
8123
8124 int closedir(DIR *dir)
8125 {
8126 int result = -1;
8127
8128 if(dir) {
8129 if(dir->handle != -1)
8130 result = _findclose(dir->handle);
8131 Jim_Free(dir->name);
8132 Jim_Free(dir);
8133 }
8134 if(result == -1) /* map all errors to EBADF */
8135 errno = EBADF;
8136 return result;
8137 }
8138
8139 struct dirent *readdir(DIR *dir)
8140 {
8141 struct dirent *result = 0;
8142
8143 if(dir && dir->handle != -1) {
8144 if(!dir->result.d_name || _findnext(dir->handle, &dir->info) != -1) {
8145 result = &dir->result;
8146 result->d_name = dir->info.name;
8147 }
8148 } else {
8149 errno = EBADF;
8150 }
8151 return result;
8152 }
8153
8154 #endif /* WIN32 */
8155
8156 static char *JimFindBestPackage(Jim_Interp *interp, char **prefixes,
8157 int prefixc, const char *pkgName, int pkgVer, int flags)
8158 {
8159 int bestVer = -1, i;
8160 int pkgNameLen = strlen(pkgName);
8161 char *bestPackage = NULL;
8162 struct dirent *de;
8163
8164 for (i = 0; i < prefixc; i++) {
8165 DIR *dir;
8166 char buf[JIM_PATH_LEN];
8167 int prefixLen;
8168
8169 if (prefixes[i] == NULL) continue;
8170 strncpy(buf, prefixes[i], JIM_PATH_LEN);
8171 buf[JIM_PATH_LEN-1] = '\0';
8172 prefixLen = strlen(buf);
8173 if (prefixLen && buf[prefixLen-1] == '/')
8174 buf[prefixLen-1] = '\0';
8175
8176 if ((dir = opendir(buf)) == NULL) continue;
8177 while ((de = readdir(dir)) != NULL) {
8178 char *fileName = de->d_name;
8179 int fileNameLen = strlen(fileName);
8180
8181 if (strncmp(fileName, "jim-", 4) == 0 &&
8182 strncmp(fileName+4, pkgName, pkgNameLen) == 0 &&
8183 *(fileName+4+pkgNameLen) == '-' &&
8184 fileNameLen > 4 && /* note that this is not really useful */
8185 (strncmp(fileName+fileNameLen-4, ".tcl", 4) == 0 ||
8186 strncmp(fileName+fileNameLen-4, ".dll", 4) == 0 ||
8187 strncmp(fileName+fileNameLen-3, ".so", 3) == 0))
8188 {
8189 char ver[6]; /* xx.yy<nulterm> */
8190 char *p = strrchr(fileName, '.');
8191 int verLen, fileVer;
8192
8193 verLen = p - (fileName+4+pkgNameLen+1);
8194 if (verLen < 3 || verLen > 5) continue;
8195 memcpy(ver, fileName+4+pkgNameLen+1, verLen);
8196 ver[verLen] = '\0';
8197 if (JimPackageVersionToInt(interp, ver, &fileVer, JIM_NONE)
8198 != JIM_OK) continue;
8199 if (JimPackageMatchVersion(pkgVer, fileVer, flags) &&
8200 (bestVer == -1 || bestVer < fileVer))
8201 {
8202 bestVer = fileVer;
8203 Jim_Free(bestPackage);
8204 bestPackage = Jim_Alloc(strlen(buf)+strlen(fileName)+2);
8205 sprintf(bestPackage, "%s/%s", buf, fileName);
8206 }
8207 }
8208 }
8209 closedir(dir);
8210 }
8211 return bestPackage;
8212 }
8213
8214 #else /* JIM_ANSIC */
8215
8216 static char *JimFindBestPackage(Jim_Interp *interp, char **prefixes,
8217 int prefixc, const char *pkgName, int pkgVer, int flags)
8218 {
8219 JIM_NOTUSED(interp);
8220 JIM_NOTUSED(prefixes);
8221 JIM_NOTUSED(prefixc);
8222 JIM_NOTUSED(pkgName);
8223 JIM_NOTUSED(pkgVer);
8224 JIM_NOTUSED(flags);
8225 return NULL;
8226 }
8227
8228 #endif /* JIM_ANSIC */
8229
8230 /* Search for a suitable package under every dir specified by jim_libpath
8231 * and load it if possible. If a suitable package was loaded with success
8232 * JIM_OK is returned, otherwise JIM_ERR is returned. */
8233 static int JimLoadPackage(Jim_Interp *interp, const char *name, int ver,
8234 int flags)
8235 {
8236 Jim_Obj *libPathObjPtr;
8237 char **prefixes, *best;
8238 int prefixc, i, retCode = JIM_OK;
8239
8240 libPathObjPtr = Jim_GetGlobalVariableStr(interp, "jim_libpath", JIM_NONE);
8241 if (libPathObjPtr == NULL) {
8242 prefixc = 0;
8243 libPathObjPtr = NULL;
8244 } else {
8245 Jim_IncrRefCount(libPathObjPtr);
8246 Jim_ListLength(interp, libPathObjPtr, &prefixc);
8247 }
8248
8249 prefixes = Jim_Alloc(sizeof(char*)*prefixc);
8250 for (i = 0; i < prefixc; i++) {
8251 Jim_Obj *prefixObjPtr;
8252 if (Jim_ListIndex(interp, libPathObjPtr, i,
8253 &prefixObjPtr, JIM_NONE) != JIM_OK)
8254 {
8255 prefixes[i] = NULL;
8256 continue;
8257 }
8258 prefixes[i] = Jim_StrDup(Jim_GetString(prefixObjPtr, NULL));
8259 }
8260 /* Scan every directory to find the "best" package. */
8261 best = JimFindBestPackage(interp, prefixes, prefixc, name, ver, flags);
8262 if (best != NULL) {
8263 char *p = strrchr(best, '.');
8264 /* Try to load/source it */
8265 if (p && strcmp(p, ".tcl") == 0) {
8266 retCode = Jim_EvalFile(interp, best);
8267 } else {
8268 retCode = Jim_LoadLibrary(interp, best);
8269 }
8270 } else {
8271 retCode = JIM_ERR;
8272 }
8273 Jim_Free(best);
8274 for (i = 0; i < prefixc; i++)
8275 Jim_Free(prefixes[i]);
8276 Jim_Free(prefixes);
8277 if (libPathObjPtr)
8278 Jim_DecrRefCount(interp, libPathObjPtr);
8279 return retCode;
8280 }
8281
8282 const char *Jim_PackageRequire(Jim_Interp *interp, const char *name,
8283 const char *ver, int flags)
8284 {
8285 Jim_HashEntry *he;
8286 int requiredVer;
8287
8288 /* Start with an empty error string */
8289 Jim_SetResultString(interp, "", 0);
8290
8291 if (JimPackageVersionToInt(interp, ver, &requiredVer, JIM_ERRMSG) != JIM_OK)
8292 return NULL;
8293 he = Jim_FindHashEntry(&interp->packages, name);
8294 if (he == NULL) {
8295 /* Try to load the package. */
8296 if (JimLoadPackage(interp, name, requiredVer, flags) == JIM_OK) {
8297 he = Jim_FindHashEntry(&interp->packages, name);
8298 if (he == NULL) {
8299 return "?";
8300 }
8301 return he->val;
8302 }
8303 /* No way... return an error. */
8304 if (flags & JIM_ERRMSG) {
8305 int len;
8306 Jim_GetString(Jim_GetResult(interp), &len);
8307 Jim_AppendStrings(interp, Jim_GetResult(interp), len ? "\n" : "",
8308 "Can't find package '", name, "'", NULL);
8309 }
8310 return NULL;
8311 } else {
8312 int actualVer;
8313 if (JimPackageVersionToInt(interp, he->val, &actualVer, JIM_ERRMSG)
8314 != JIM_OK)
8315 {
8316 return NULL;
8317 }
8318 /* Check if version matches. */
8319 if (JimPackageMatchVersion(requiredVer, actualVer, flags) == 0) {
8320 Jim_AppendStrings(interp, Jim_GetResult(interp),
8321 "Package '", name, "' already loaded, but with version ",
8322 he->val, NULL);
8323 return NULL;
8324 }
8325 return he->val;
8326 }
8327 }
8328
8329 /* -----------------------------------------------------------------------------
8330 * Eval
8331 * ---------------------------------------------------------------------------*/
8332 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
8333 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
8334
8335 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc,
8336 Jim_Obj *const *argv);
8337
8338 /* Handle calls to the [unknown] command */
8339 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
8340 {
8341 Jim_Obj **v, *sv[JIM_EVAL_SARGV_LEN];
8342 int retCode;
8343
8344 /* If JimUnknown() is recursively called (e.g. error in the unknown proc,
8345 * done here
8346 */
8347 if (interp->unknown_called) {
8348 return JIM_ERR;
8349 }
8350
8351 /* If the [unknown] command does not exists returns
8352 * just now */
8353 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
8354 return JIM_ERR;
8355
8356 /* The object interp->unknown just contains
8357 * the "unknown" string, it is used in order to
8358 * avoid to lookup the unknown command every time
8359 * but instread to cache the result. */
8360 if (argc+1 <= JIM_EVAL_SARGV_LEN)
8361 v = sv;
8362 else
8363 v = Jim_Alloc(sizeof(Jim_Obj*)*(argc+1));
8364 /* Make a copy of the arguments vector, but shifted on
8365 * the right of one position. The command name of the
8366 * command will be instead the first argument of the
8367 * [unknonw] call. */
8368 memcpy(v+1, argv, sizeof(Jim_Obj*)*argc);
8369 v[0] = interp->unknown;
8370 /* Call it */
8371 interp->unknown_called++;
8372 retCode = Jim_EvalObjVector(interp, argc+1, v);
8373 interp->unknown_called--;
8374
8375 /* Clean up */
8376 if (v != sv)
8377 Jim_Free(v);
8378 return retCode;
8379 }
8380
8381 /* Eval the object vector 'objv' composed of 'objc' elements.
8382 * Every element is used as single argument.
8383 * Jim_EvalObj() will call this function every time its object
8384 * argument is of "list" type, with no string representation.
8385 *
8386 * This is possible because the string representation of a
8387 * list object generated by the UpdateStringOfList is made
8388 * in a way that ensures that every list element is a different
8389 * command argument. */
8390 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
8391 {
8392 int i, retcode;
8393 Jim_Cmd *cmdPtr;
8394
8395 /* Incr refcount of arguments. */
8396 for (i = 0; i < objc; i++)
8397 Jim_IncrRefCount(objv[i]);
8398 /* Command lookup */
8399 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
8400 if (cmdPtr == NULL) {
8401 retcode = JimUnknown(interp, objc, objv);
8402 } else {
8403 /* Call it -- Make sure result is an empty object. */
8404 Jim_SetEmptyResult(interp);
8405 if (cmdPtr->cmdProc) {
8406 interp->cmdPrivData = cmdPtr->privData;
8407 retcode = cmdPtr->cmdProc(interp, objc, objv);
8408 if (retcode == JIM_ERR_ADDSTACK) {
8409 //JimAppendStackTrace(interp, "", script->fileName, token[i-argc*2].linenr);
8410 retcode = JIM_ERR;
8411 }
8412 } else {
8413 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
8414 if (retcode == JIM_ERR) {
8415 JimAppendStackTrace(interp,
8416 Jim_GetString(objv[0], NULL), "", 1);
8417 }
8418 }
8419 }
8420 /* Decr refcount of arguments and return the retcode */
8421 for (i = 0; i < objc; i++)
8422 Jim_DecrRefCount(interp, objv[i]);
8423 return retcode;
8424 }
8425
8426 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
8427 * via *objPtrPtr. This function is only called by Jim_EvalObj().
8428 * The returned object has refcount = 0. */
8429 int Jim_InterpolateTokens(Jim_Interp *interp, ScriptToken *token,
8430 int tokens, Jim_Obj **objPtrPtr)
8431 {
8432 int totlen = 0, i, retcode;
8433 Jim_Obj **intv;
8434 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
8435 Jim_Obj *objPtr;
8436 char *s;
8437
8438 if (tokens <= JIM_EVAL_SINTV_LEN)
8439 intv = sintv;
8440 else
8441 intv = Jim_Alloc(sizeof(Jim_Obj*)*
8442 tokens);
8443 /* Compute every token forming the argument
8444 * in the intv objects vector. */
8445 for (i = 0; i < tokens; i++) {
8446 switch(token[i].type) {
8447 case JIM_TT_ESC:
8448 case JIM_TT_STR:
8449 intv[i] = token[i].objPtr;
8450 break;
8451 case JIM_TT_VAR:
8452 intv[i] = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
8453 if (!intv[i]) {
8454 retcode = JIM_ERR;
8455 goto err;
8456 }
8457 break;
8458 case JIM_TT_DICTSUGAR:
8459 intv[i] = Jim_ExpandDictSugar(interp, token[i].objPtr);
8460 if (!intv[i]) {
8461 retcode = JIM_ERR;
8462 goto err;
8463 }
8464 break;
8465 case JIM_TT_CMD:
8466 retcode = Jim_EvalObj(interp, token[i].objPtr);
8467 if (retcode != JIM_OK)
8468 goto err;
8469 intv[i] = Jim_GetResult(interp);
8470 break;
8471 default:
8472 Jim_Panic(interp,
8473 "default token type reached "
8474 "in Jim_InterpolateTokens().");
8475 break;
8476 }
8477 Jim_IncrRefCount(intv[i]);
8478 /* Make sure there is a valid
8479 * string rep, and add the string
8480 * length to the total legnth. */
8481 Jim_GetString(intv[i], NULL);
8482 totlen += intv[i]->length;
8483 }
8484 /* Concatenate every token in an unique
8485 * object. */
8486 objPtr = Jim_NewStringObjNoAlloc(interp,
8487 NULL, 0);
8488 s = objPtr->bytes = Jim_Alloc(totlen+1);
8489 objPtr->length = totlen;
8490 for (i = 0; i < tokens; i++) {
8491 memcpy(s, intv[i]->bytes, intv[i]->length);
8492 s += intv[i]->length;
8493 Jim_DecrRefCount(interp, intv[i]);
8494 }
8495 objPtr->bytes[totlen] = '\0';
8496 /* Free the intv vector if not static. */
8497 if (tokens > JIM_EVAL_SINTV_LEN)
8498 Jim_Free(intv);
8499 *objPtrPtr = objPtr;
8500 return JIM_OK;
8501 err:
8502 i--;
8503 for (; i >= 0; i--)
8504 Jim_DecrRefCount(interp, intv[i]);
8505 if (tokens > JIM_EVAL_SINTV_LEN)
8506 Jim_Free(intv);
8507 return retcode;
8508 }
8509
8510 /* Helper of Jim_EvalObj() to perform argument expansion.
8511 * Basically this function append an argument to 'argv'
8512 * (and increments argc by reference accordingly), performing
8513 * expansion of the list object if 'expand' is non-zero, or
8514 * just adding objPtr to argv if 'expand' is zero. */
8515 void Jim_ExpandArgument(Jim_Interp *interp, Jim_Obj ***argv,
8516 int *argcPtr, int expand, Jim_Obj *objPtr)
8517 {
8518 if (!expand) {
8519 (*argv) = Jim_Realloc(*argv, sizeof(Jim_Obj*)*((*argcPtr)+1));
8520 /* refcount of objPtr not incremented because
8521 * we are actually transfering a reference from
8522 * the old 'argv' to the expanded one. */
8523 (*argv)[*argcPtr] = objPtr;
8524 (*argcPtr)++;
8525 } else {
8526 int len, i;
8527
8528 Jim_ListLength(interp, objPtr, &len);
8529 (*argv) = Jim_Realloc(*argv, sizeof(Jim_Obj*)*((*argcPtr)+len));
8530 for (i = 0; i < len; i++) {
8531 (*argv)[*argcPtr] = objPtr->internalRep.listValue.ele[i];
8532 Jim_IncrRefCount(objPtr->internalRep.listValue.ele[i]);
8533 (*argcPtr)++;
8534 }
8535 /* The original object reference is no longer needed,
8536 * after the expansion it is no longer present on
8537 * the argument vector, but the single elements are
8538 * in its place. */
8539 Jim_DecrRefCount(interp, objPtr);
8540 }
8541 }
8542
8543 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
8544 {
8545 int i, j = 0, len;
8546 ScriptObj *script;
8547 ScriptToken *token;
8548 int *cs; /* command structure array */
8549 int retcode = JIM_OK;
8550 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL, *tmpObjPtr;
8551
8552 interp->errorFlag = 0;
8553
8554 /* If the object is of type "list" and there is no
8555 * string representation for this object, we can call
8556 * a specialized version of Jim_EvalObj() */
8557 if (scriptObjPtr->typePtr == &listObjType &&
8558 scriptObjPtr->internalRep.listValue.len &&
8559 scriptObjPtr->bytes == NULL) {
8560 Jim_IncrRefCount(scriptObjPtr);
8561 retcode = Jim_EvalObjVector(interp,
8562 scriptObjPtr->internalRep.listValue.len,
8563 scriptObjPtr->internalRep.listValue.ele);
8564 Jim_DecrRefCount(interp, scriptObjPtr);
8565 return retcode;
8566 }
8567
8568 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
8569 script = Jim_GetScript(interp, scriptObjPtr);
8570 /* Now we have to make sure the internal repr will not be
8571 * freed on shimmering.
8572 *
8573 * Think for example to this:
8574 *
8575 * set x {llength $x; ... some more code ...}; eval $x
8576 *
8577 * In order to preserve the internal rep, we increment the
8578 * inUse field of the script internal rep structure. */
8579 script->inUse++;
8580
8581 token = script->token;
8582 len = script->len;
8583 cs = script->cmdStruct;
8584 i = 0; /* 'i' is the current token index. */
8585
8586 /* Reset the interpreter result. This is useful to
8587 * return the emtpy result in the case of empty program. */
8588 Jim_SetEmptyResult(interp);
8589
8590 /* Execute every command sequentially, returns on
8591 * error (i.e. if a command does not return JIM_OK) */
8592 while (i < len) {
8593 int expand = 0;
8594 int argc = *cs++; /* Get the number of arguments */
8595 Jim_Cmd *cmd;
8596
8597 /* Set the expand flag if needed. */
8598 if (argc == -1) {
8599 expand++;
8600 argc = *cs++;
8601 }
8602 /* Allocate the arguments vector */
8603 if (argc <= JIM_EVAL_SARGV_LEN)
8604 argv = sargv;
8605 else
8606 argv = Jim_Alloc(sizeof(Jim_Obj*)*argc);
8607 /* Populate the arguments objects. */
8608 for (j = 0; j < argc; j++) {
8609 int tokens = *cs++;
8610
8611 /* tokens is negative if expansion is needed.
8612 * for this argument. */
8613 if (tokens < 0) {
8614 tokens = (-tokens)-1;
8615 i++;
8616 }
8617 if (tokens == 1) {
8618 /* Fast path if the token does not
8619 * need interpolation */
8620 switch(token[i].type) {
8621 case JIM_TT_ESC:
8622 case JIM_TT_STR:
8623 argv[j] = token[i].objPtr;
8624 break;
8625 case JIM_TT_VAR:
8626 tmpObjPtr = Jim_GetVariable(interp, token[i].objPtr,
8627 JIM_ERRMSG);
8628 if (!tmpObjPtr) {
8629 retcode = JIM_ERR;
8630 goto err;
8631 }
8632 argv[j] = tmpObjPtr;
8633 break;
8634 case JIM_TT_DICTSUGAR:
8635 tmpObjPtr = Jim_ExpandDictSugar(interp, token[i].objPtr);
8636 if (!tmpObjPtr) {
8637 retcode = JIM_ERR;
8638 goto err;
8639 }
8640 argv[j] = tmpObjPtr;
8641 break;
8642 case JIM_TT_CMD:
8643 retcode = Jim_EvalObj(interp, token[i].objPtr);
8644 if (retcode != JIM_OK)
8645 goto err;
8646 argv[j] = Jim_GetResult(interp);
8647 break;
8648 default:
8649 Jim_Panic(interp,
8650 "default token type reached "
8651 "in Jim_EvalObj().");
8652 break;
8653 }
8654 Jim_IncrRefCount(argv[j]);
8655 i += 2;
8656 } else {
8657 /* For interpolation we call an helper
8658 * function doing the work for us. */
8659 if ((retcode = Jim_InterpolateTokens(interp,
8660 token+i, tokens, &tmpObjPtr)) != JIM_OK)
8661 {
8662 goto err;
8663 }
8664 argv[j] = tmpObjPtr;
8665 Jim_IncrRefCount(argv[j]);
8666 i += tokens+1;
8667 }
8668 }
8669 /* Handle {expand} expansion */
8670 if (expand) {
8671 int *ecs = cs - argc;
8672 int eargc = 0;
8673 Jim_Obj **eargv = NULL;
8674
8675 for (j = 0; j < argc; j++) {
8676 Jim_ExpandArgument( interp, &eargv, &eargc,
8677 ecs[j] < 0, argv[j]);
8678 }
8679 if (argv != sargv)
8680 Jim_Free(argv);
8681 argc = eargc;
8682 argv = eargv;
8683 j = argc;
8684 if (argc == 0) {
8685 /* Nothing to do with zero args. */
8686 Jim_Free(eargv);
8687 continue;
8688 }
8689 }
8690 /* Lookup the command to call */
8691 cmd = Jim_GetCommand(interp, argv[0], JIM_ERRMSG);
8692 if (cmd != NULL) {
8693 /* Call it -- Make sure result is an empty object. */
8694 Jim_SetEmptyResult(interp);
8695 if (cmd->cmdProc) {
8696 interp->cmdPrivData = cmd->privData;
8697 retcode = cmd->cmdProc(interp, argc, argv);
8698 if (retcode == JIM_ERR_ADDSTACK) {
8699 JimAppendStackTrace(interp, "", script->fileName, token[i-argc*2].linenr);
8700 retcode = JIM_ERR;
8701 }
8702 } else {
8703 retcode = JimCallProcedure(interp, cmd, argc, argv);
8704 if (retcode == JIM_ERR) {
8705 JimAppendStackTrace(interp,
8706 Jim_GetString(argv[0], NULL), script->fileName,
8707 token[i-argc*2].linenr);
8708 }
8709 }
8710 } else {
8711 /* Call [unknown] */
8712 retcode = JimUnknown(interp, argc, argv);
8713 if (retcode == JIM_ERR) {
8714 JimAppendStackTrace(interp,
8715 "", script->fileName,
8716 token[i-argc*2].linenr);
8717 }
8718 }
8719 if (retcode != JIM_OK) {
8720 i -= argc*2; /* point to the command name. */
8721 goto err;
8722 }
8723 /* Decrement the arguments count */
8724 for (j = 0; j < argc; j++) {
8725 Jim_DecrRefCount(interp, argv[j]);
8726 }
8727
8728 if (argv != sargv) {
8729 Jim_Free(argv);
8730 argv = NULL;
8731 }
8732 }
8733 /* Note that we don't have to decrement inUse, because the
8734 * following code transfers our use of the reference again to
8735 * the script object. */
8736 j = 0; /* on normal termination, the argv array is already
8737 Jim_DecrRefCount-ed. */
8738 err:
8739 /* Handle errors. */
8740 if (retcode == JIM_ERR && !interp->errorFlag) {
8741 interp->errorFlag = 1;
8742 JimSetErrorFileName(interp, script->fileName);
8743 JimSetErrorLineNumber(interp, token[i].linenr);
8744 JimResetStackTrace(interp);
8745 }
8746 Jim_FreeIntRep(interp, scriptObjPtr);
8747 scriptObjPtr->typePtr = &scriptObjType;
8748 Jim_SetIntRepPtr(scriptObjPtr, script);
8749 Jim_DecrRefCount(interp, scriptObjPtr);
8750 for (i = 0; i < j; i++) {
8751 Jim_DecrRefCount(interp, argv[i]);
8752 }
8753 if (argv != sargv)
8754 Jim_Free(argv);
8755 return retcode;
8756 }
8757
8758 /* Call a procedure implemented in Tcl.
8759 * It's possible to speed-up a lot this function, currently
8760 * the callframes are not cached, but allocated and
8761 * destroied every time. What is expecially costly is
8762 * to create/destroy the local vars hash table every time.
8763 *
8764 * This can be fixed just implementing callframes caching
8765 * in JimCreateCallFrame() and JimFreeCallFrame(). */
8766 int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc,
8767 Jim_Obj *const *argv)
8768 {
8769 int i, retcode;
8770 Jim_CallFrame *callFramePtr;
8771 int num_args;
8772
8773 /* Check arity */
8774 if (argc < cmd->arityMin || (cmd->arityMax != -1 &&
8775 argc > cmd->arityMax)) {
8776 Jim_Obj *objPtr = Jim_NewEmptyStringObj(interp);
8777 Jim_AppendStrings(interp, objPtr,
8778 "wrong # args: should be \"", Jim_GetString(argv[0], NULL),
8779 (cmd->arityMin > 1) ? " " : "",
8780 Jim_GetString(cmd->argListObjPtr, NULL), "\"", NULL);
8781 Jim_SetResult(interp, objPtr);
8782 return JIM_ERR;
8783 }
8784 /* Check if there are too nested calls */
8785 if (interp->numLevels == interp->maxNestingDepth) {
8786 Jim_SetResultString(interp,
8787 "Too many nested calls. Infinite recursion?", -1);
8788 return JIM_ERR;
8789 }
8790 /* Create a new callframe */
8791 callFramePtr = JimCreateCallFrame(interp);
8792 callFramePtr->parentCallFrame = interp->framePtr;
8793 callFramePtr->argv = argv;
8794 callFramePtr->argc = argc;
8795 callFramePtr->procArgsObjPtr = cmd->argListObjPtr;
8796 callFramePtr->procBodyObjPtr = cmd->bodyObjPtr;
8797 callFramePtr->staticVars = cmd->staticVars;
8798 Jim_IncrRefCount(cmd->argListObjPtr);
8799 Jim_IncrRefCount(cmd->bodyObjPtr);
8800 interp->framePtr = callFramePtr;
8801 interp->numLevels ++;
8802
8803 /* Set arguments */
8804 Jim_ListLength(interp, cmd->argListObjPtr, &num_args);
8805
8806 /* If last argument is 'args', don't set it here */
8807 if (cmd->arityMax == -1) {
8808 num_args--;
8809 }
8810
8811 for (i = 0; i < num_args; i++) {
8812 Jim_Obj *argObjPtr;
8813 Jim_Obj *nameObjPtr;
8814 Jim_Obj *valueObjPtr;
8815
8816 Jim_ListIndex(interp, cmd->argListObjPtr, i, &argObjPtr, JIM_NONE);
8817 if (i + 1 >= cmd->arityMin) {
8818 /* The name is the first element of the list */
8819 Jim_ListIndex(interp, argObjPtr, 0, &nameObjPtr, JIM_NONE);
8820 }
8821 else {
8822 /* The element arg is the name */
8823 nameObjPtr = argObjPtr;
8824 }
8825
8826 if (i + 1 >= argc) {
8827 /* No more values, so use default */
8828 /* The value is the second element of the list */
8829 Jim_ListIndex(interp, argObjPtr, 1, &valueObjPtr, JIM_NONE);
8830 }
8831 else {
8832 valueObjPtr = argv[i+1];
8833 }
8834 Jim_SetVariable(interp, nameObjPtr, valueObjPtr);
8835 }
8836 /* Set optional arguments */
8837 if (cmd->arityMax == -1) {
8838 Jim_Obj *listObjPtr, *objPtr;
8839
8840 i++;
8841 listObjPtr = Jim_NewListObj(interp, argv+i, argc-i);
8842 Jim_ListIndex(interp, cmd->argListObjPtr, num_args, &objPtr, JIM_NONE);
8843 Jim_SetVariable(interp, objPtr, listObjPtr);
8844 }
8845 /* Eval the body */
8846 retcode = Jim_EvalObj(interp, cmd->bodyObjPtr);
8847
8848 /* Destroy the callframe */
8849 interp->numLevels --;
8850 interp->framePtr = interp->framePtr->parentCallFrame;
8851 if (callFramePtr->vars.size != JIM_HT_INITIAL_SIZE) {
8852 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NONE);
8853 } else {
8854 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NOHT);
8855 }
8856 /* Handle the JIM_EVAL return code */
8857 if (retcode == JIM_EVAL && interp->evalRetcodeLevel != interp->numLevels) {
8858 int savedLevel = interp->evalRetcodeLevel;
8859
8860 interp->evalRetcodeLevel = interp->numLevels;
8861 while (retcode == JIM_EVAL) {
8862 Jim_Obj *resultScriptObjPtr = Jim_GetResult(interp);
8863 Jim_IncrRefCount(resultScriptObjPtr);
8864 retcode = Jim_EvalObj(interp, resultScriptObjPtr);
8865 Jim_DecrRefCount(interp, resultScriptObjPtr);
8866 }
8867 interp->evalRetcodeLevel = savedLevel;
8868 }
8869 /* Handle the JIM_RETURN return code */
8870 if (retcode == JIM_RETURN) {
8871 retcode = interp->returnCode;
8872 interp->returnCode = JIM_OK;
8873 }
8874 return retcode;
8875 }
8876
8877 int Jim_Eval_Named(Jim_Interp *interp, const char *script, const char *filename, int lineno)
8878 {
8879 int retval;
8880 Jim_Obj *scriptObjPtr;
8881
8882 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
8883 Jim_IncrRefCount(scriptObjPtr);
8884
8885
8886 if( filename ){
8887 JimSetSourceInfo( interp, scriptObjPtr, filename, lineno );
8888 }
8889
8890 retval = Jim_EvalObj(interp, scriptObjPtr);
8891 Jim_DecrRefCount(interp, scriptObjPtr);
8892 return retval;
8893 }
8894
8895 int Jim_Eval(Jim_Interp *interp, const char *script)
8896 {
8897 return Jim_Eval_Named( interp, script, NULL, 0 );
8898 }
8899
8900
8901
8902 /* Execute script in the scope of the global level */
8903 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
8904 {
8905 Jim_CallFrame *savedFramePtr;
8906 int retval;
8907
8908 savedFramePtr = interp->framePtr;
8909 interp->framePtr = interp->topFramePtr;
8910 retval = Jim_Eval(interp, script);
8911 interp->framePtr = savedFramePtr;
8912 return retval;
8913 }
8914
8915 int Jim_EvalObjBackground(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
8916 {
8917 Jim_CallFrame *savedFramePtr;
8918 int retval;
8919
8920 savedFramePtr = interp->framePtr;
8921 interp->framePtr = interp->topFramePtr;
8922 retval = Jim_EvalObj(interp, scriptObjPtr);
8923 interp->framePtr = savedFramePtr;
8924 /* Try to report the error (if any) via the bgerror proc */
8925 if (retval != JIM_OK) {
8926 Jim_Obj *objv[2];
8927
8928 objv[0] = Jim_NewStringObj(interp, "bgerror", -1);
8929 objv[1] = Jim_GetResult(interp);
8930 Jim_IncrRefCount(objv[0]);
8931 Jim_IncrRefCount(objv[1]);
8932 if (Jim_EvalObjVector(interp, 2, objv) != JIM_OK) {
8933 /* Report the error to stderr. */
8934 Jim_fprintf( interp, interp->cookie_stderr, "Background error:" JIM_NL);
8935 Jim_PrintErrorMessage(interp);
8936 }
8937 Jim_DecrRefCount(interp, objv[0]);
8938 Jim_DecrRefCount(interp, objv[1]);
8939 }
8940 return retval;
8941 }
8942
8943 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
8944 {
8945 char *prg = NULL;
8946 FILE *fp;
8947 int nread, totread, maxlen, buflen;
8948 int retval;
8949 Jim_Obj *scriptObjPtr;
8950
8951 if ((fp = fopen(filename, "r")) == NULL) {
8952 const int cwd_len=2048;
8953 char *cwd=malloc(cwd_len);
8954 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8955 getcwd( cwd, cwd_len );
8956 Jim_AppendStrings(interp, Jim_GetResult(interp),
8957 "Error loading script \"", filename, "\"",
8958 " cwd: ", cwd,
8959 " err: ", strerror(errno), NULL);
8960 free(cwd);
8961 return JIM_ERR;
8962 }
8963 buflen = 1024;
8964 maxlen = totread = 0;
8965 while (1) {
8966 if (maxlen < totread+buflen+1) {
8967 maxlen = totread+buflen+1;
8968 prg = Jim_Realloc(prg, maxlen);
8969 }
8970 /* do not use Jim_fread() - this is really a file */
8971 if ((nread = fread(prg+totread, 1, buflen, fp)) == 0) break;
8972 totread += nread;
8973 }
8974 prg[totread] = '\0';
8975 /* do not use Jim_fclose() - this is really a file */
8976 fclose(fp);
8977
8978 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, prg, totread);
8979 JimSetSourceInfo(interp, scriptObjPtr, filename, 1);
8980 Jim_IncrRefCount(scriptObjPtr);
8981 retval = Jim_EvalObj(interp, scriptObjPtr);
8982 Jim_DecrRefCount(interp, scriptObjPtr);
8983 return retval;
8984 }
8985
8986 /* -----------------------------------------------------------------------------
8987 * Subst
8988 * ---------------------------------------------------------------------------*/
8989 static int JimParseSubstStr(struct JimParserCtx *pc)
8990 {
8991 pc->tstart = pc->p;
8992 pc->tline = pc->linenr;
8993 while (*pc->p && *pc->p != '$' && *pc->p != '[') {
8994 pc->p++; pc->len--;
8995 }
8996 pc->tend = pc->p-1;
8997 pc->tt = JIM_TT_ESC;
8998 return JIM_OK;
8999 }
9000
9001 static int JimParseSubst(struct JimParserCtx *pc, int flags)
9002 {
9003 int retval;
9004
9005 if (pc->len == 0) {
9006 pc->tstart = pc->tend = pc->p;
9007 pc->tline = pc->linenr;
9008 pc->tt = JIM_TT_EOL;
9009 pc->eof = 1;
9010 return JIM_OK;
9011 }
9012 switch(*pc->p) {
9013 case '[':
9014 retval = JimParseCmd(pc);
9015 if (flags & JIM_SUBST_NOCMD) {
9016 pc->tstart--;
9017 pc->tend++;
9018 pc->tt = (flags & JIM_SUBST_NOESC) ?
9019 JIM_TT_STR : JIM_TT_ESC;
9020 }
9021 return retval;
9022 break;
9023 case '$':
9024 if (JimParseVar(pc) == JIM_ERR) {
9025 pc->tstart = pc->tend = pc->p++; pc->len--;
9026 pc->tline = pc->linenr;
9027 pc->tt = JIM_TT_STR;
9028 } else {
9029 if (flags & JIM_SUBST_NOVAR) {
9030 pc->tstart--;
9031 if (flags & JIM_SUBST_NOESC)
9032 pc->tt = JIM_TT_STR;
9033 else
9034 pc->tt = JIM_TT_ESC;
9035 if (*pc->tstart == '{') {
9036 pc->tstart--;
9037 if (*(pc->tend+1))
9038 pc->tend++;
9039 }
9040 }
9041 }
9042 break;
9043 default:
9044 retval = JimParseSubstStr(pc);
9045 if (flags & JIM_SUBST_NOESC)
9046 pc->tt = JIM_TT_STR;
9047 return retval;
9048 break;
9049 }
9050 return JIM_OK;
9051 }
9052
9053 /* The subst object type reuses most of the data structures and functions
9054 * of the script object. Script's data structures are a bit more complex
9055 * for what is needed for [subst]itution tasks, but the reuse helps to
9056 * deal with a single data structure at the cost of some more memory
9057 * usage for substitutions. */
9058 static Jim_ObjType substObjType = {
9059 "subst",
9060 FreeScriptInternalRep,
9061 DupScriptInternalRep,
9062 NULL,
9063 JIM_TYPE_REFERENCES,
9064 };
9065
9066 /* This method takes the string representation of an object
9067 * as a Tcl string where to perform [subst]itution, and generates
9068 * the pre-parsed internal representation. */
9069 int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
9070 {
9071 int scriptTextLen;
9072 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
9073 struct JimParserCtx parser;
9074 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
9075
9076 script->len = 0;
9077 script->csLen = 0;
9078 script->commands = 0;
9079 script->token = NULL;
9080 script->cmdStruct = NULL;
9081 script->inUse = 1;
9082 script->substFlags = flags;
9083 script->fileName = NULL;
9084
9085 JimParserInit(&parser, scriptText, scriptTextLen, 1);
9086 while(1) {
9087 char *token;
9088 int len, type, linenr;
9089
9090 JimParseSubst(&parser, flags);
9091 if (JimParserEof(&parser)) break;
9092 token = JimParserGetToken(&parser, &len, &type, &linenr);
9093 ScriptObjAddToken(interp, script, token, len, type,
9094 NULL, linenr);
9095 }
9096 /* Free the old internal rep and set the new one. */
9097 Jim_FreeIntRep(interp, objPtr);
9098 Jim_SetIntRepPtr(objPtr, script);
9099 objPtr->typePtr = &scriptObjType;
9100 return JIM_OK;
9101 }
9102
9103 ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
9104 {
9105 struct ScriptObj *script = Jim_GetIntRepPtr(objPtr);
9106
9107 if (objPtr->typePtr != &substObjType || script->substFlags != flags)
9108 SetSubstFromAny(interp, objPtr, flags);
9109 return (ScriptObj*) Jim_GetIntRepPtr(objPtr);
9110 }
9111
9112 /* Performs commands,variables,blackslashes substitution,
9113 * storing the result object (with refcount 0) into
9114 * resObjPtrPtr. */
9115 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr,
9116 Jim_Obj **resObjPtrPtr, int flags)
9117 {
9118 ScriptObj *script;
9119 ScriptToken *token;
9120 int i, len, retcode = JIM_OK;
9121 Jim_Obj *resObjPtr, *savedResultObjPtr;
9122
9123 script = Jim_GetSubst(interp, substObjPtr, flags);
9124 #ifdef JIM_OPTIMIZATION
9125 /* Fast path for a very common case with array-alike syntax,
9126 * that's: $foo($bar) */
9127 if (script->len == 1 && script->token[0].type == JIM_TT_VAR) {
9128 Jim_Obj *varObjPtr = script->token[0].objPtr;
9129
9130 Jim_IncrRefCount(varObjPtr);
9131 resObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
9132 if (resObjPtr == NULL) {
9133 Jim_DecrRefCount(interp, varObjPtr);
9134 return JIM_ERR;
9135 }
9136 Jim_DecrRefCount(interp, varObjPtr);
9137 *resObjPtrPtr = resObjPtr;
9138 return JIM_OK;
9139 }
9140 #endif
9141
9142 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
9143 /* In order to preserve the internal rep, we increment the
9144 * inUse field of the script internal rep structure. */
9145 script->inUse++;
9146
9147 token = script->token;
9148 len = script->len;
9149
9150 /* Save the interp old result, to set it again before
9151 * to return. */
9152 savedResultObjPtr = interp->result;
9153 Jim_IncrRefCount(savedResultObjPtr);
9154
9155 /* Perform the substitution. Starts with an empty object
9156 * and adds every token (performing the appropriate
9157 * var/command/escape substitution). */
9158 resObjPtr = Jim_NewStringObj(interp, "", 0);
9159 for (i = 0; i < len; i++) {
9160 Jim_Obj *objPtr;
9161
9162 switch(token[i].type) {
9163 case JIM_TT_STR:
9164 case JIM_TT_ESC:
9165 Jim_AppendObj(interp, resObjPtr, token[i].objPtr);
9166 break;
9167 case JIM_TT_VAR:
9168 objPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
9169 if (objPtr == NULL) goto err;
9170 Jim_IncrRefCount(objPtr);
9171 Jim_AppendObj(interp, resObjPtr, objPtr);
9172 Jim_DecrRefCount(interp, objPtr);
9173 break;
9174 case JIM_TT_DICTSUGAR:
9175 objPtr = Jim_ExpandDictSugar(interp, token[i].objPtr);
9176 if (!objPtr) {
9177 retcode = JIM_ERR;
9178 goto err;
9179 }
9180 break;
9181 case JIM_TT_CMD:
9182 if (Jim_EvalObj(interp, token[i].objPtr) != JIM_OK)
9183 goto err;
9184 Jim_AppendObj(interp, resObjPtr, interp->result);
9185 break;
9186 default:
9187 Jim_Panic(interp,
9188 "default token type (%d) reached "
9189 "in Jim_SubstObj().", token[i].type);
9190 break;
9191 }
9192 }
9193 ok:
9194 if (retcode == JIM_OK)
9195 Jim_SetResult(interp, savedResultObjPtr);
9196 Jim_DecrRefCount(interp, savedResultObjPtr);
9197 /* Note that we don't have to decrement inUse, because the
9198 * following code transfers our use of the reference again to
9199 * the script object. */
9200 Jim_FreeIntRep(interp, substObjPtr);
9201 substObjPtr->typePtr = &scriptObjType;
9202 Jim_SetIntRepPtr(substObjPtr, script);
9203 Jim_DecrRefCount(interp, substObjPtr);
9204 *resObjPtrPtr = resObjPtr;
9205 return retcode;
9206 err:
9207 Jim_FreeNewObj(interp, resObjPtr);
9208 retcode = JIM_ERR;
9209 goto ok;
9210 }
9211
9212 /* -----------------------------------------------------------------------------
9213 * API Input/Export functions
9214 * ---------------------------------------------------------------------------*/
9215
9216 int Jim_GetApi(Jim_Interp *interp, const char *funcname, void *targetPtrPtr)
9217 {
9218 Jim_HashEntry *he;
9219
9220 he = Jim_FindHashEntry(&interp->stub, funcname);
9221 if (!he)
9222 return JIM_ERR;
9223 memcpy(targetPtrPtr, &he->val, sizeof(void*));
9224 return JIM_OK;
9225 }
9226
9227 int Jim_RegisterApi(Jim_Interp *interp, const char *funcname, void *funcptr)
9228 {
9229 return Jim_AddHashEntry(&interp->stub, funcname, funcptr);
9230 }
9231
9232 #define JIM_REGISTER_API(name) \
9233 Jim_RegisterApi(interp, "Jim_" #name, (void *)Jim_ ## name)
9234
9235 void JimRegisterCoreApi(Jim_Interp *interp)
9236 {
9237 interp->getApiFuncPtr = Jim_GetApi;
9238 JIM_REGISTER_API(Alloc);
9239 JIM_REGISTER_API(Free);
9240 JIM_REGISTER_API(Eval);
9241 JIM_REGISTER_API(Eval_Named);
9242 JIM_REGISTER_API(EvalGlobal);
9243 JIM_REGISTER_API(EvalFile);
9244 JIM_REGISTER_API(EvalObj);
9245 JIM_REGISTER_API(EvalObjBackground);
9246 JIM_REGISTER_API(EvalObjVector);
9247 JIM_REGISTER_API(InitHashTable);
9248 JIM_REGISTER_API(ExpandHashTable);
9249 JIM_REGISTER_API(AddHashEntry);
9250 JIM_REGISTER_API(ReplaceHashEntry);
9251 JIM_REGISTER_API(DeleteHashEntry);
9252 JIM_REGISTER_API(FreeHashTable);
9253 JIM_REGISTER_API(FindHashEntry);
9254 JIM_REGISTER_API(ResizeHashTable);
9255 JIM_REGISTER_API(GetHashTableIterator);
9256 JIM_REGISTER_API(NextHashEntry);
9257 JIM_REGISTER_API(NewObj);
9258 JIM_REGISTER_API(FreeObj);
9259 JIM_REGISTER_API(InvalidateStringRep);
9260 JIM_REGISTER_API(InitStringRep);
9261 JIM_REGISTER_API(DuplicateObj);
9262 JIM_REGISTER_API(GetString);
9263 JIM_REGISTER_API(Length);
9264 JIM_REGISTER_API(InvalidateStringRep);
9265 JIM_REGISTER_API(NewStringObj);
9266 JIM_REGISTER_API(NewStringObjNoAlloc);
9267 JIM_REGISTER_API(AppendString);
9268 JIM_REGISTER_API(AppendString_sprintf);
9269 JIM_REGISTER_API(AppendObj);
9270 JIM_REGISTER_API(AppendStrings);
9271 JIM_REGISTER_API(StringEqObj);
9272 JIM_REGISTER_API(StringMatchObj);
9273 JIM_REGISTER_API(StringRangeObj);
9274 JIM_REGISTER_API(FormatString);
9275 JIM_REGISTER_API(CompareStringImmediate);
9276 JIM_REGISTER_API(NewReference);
9277 JIM_REGISTER_API(GetReference);
9278 JIM_REGISTER_API(SetFinalizer);
9279 JIM_REGISTER_API(GetFinalizer);
9280 JIM_REGISTER_API(CreateInterp);
9281 JIM_REGISTER_API(FreeInterp);
9282 JIM_REGISTER_API(GetExitCode);
9283 JIM_REGISTER_API(SetStdin);
9284 JIM_REGISTER_API(SetStdout);
9285 JIM_REGISTER_API(SetStderr);
9286 JIM_REGISTER_API(CreateCommand);
9287 JIM_REGISTER_API(CreateProcedure);
9288 JIM_REGISTER_API(DeleteCommand);
9289 JIM_REGISTER_API(RenameCommand);
9290 JIM_REGISTER_API(GetCommand);
9291 JIM_REGISTER_API(SetVariable);
9292 JIM_REGISTER_API(SetVariableStr);
9293 JIM_REGISTER_API(SetGlobalVariableStr);
9294 JIM_REGISTER_API(SetVariableStrWithStr);
9295 JIM_REGISTER_API(SetVariableLink);
9296 JIM_REGISTER_API(GetVariable);
9297 JIM_REGISTER_API(GetCallFrameByLevel);
9298 JIM_REGISTER_API(Collect);
9299 JIM_REGISTER_API(CollectIfNeeded);
9300 JIM_REGISTER_API(GetIndex);
9301 JIM_REGISTER_API(NewListObj);
9302 JIM_REGISTER_API(ListAppendElement);
9303 JIM_REGISTER_API(ListAppendList);
9304 JIM_REGISTER_API(ListLength);
9305 JIM_REGISTER_API(ListIndex);
9306 JIM_REGISTER_API(SetListIndex);
9307 JIM_REGISTER_API(ConcatObj);
9308 JIM_REGISTER_API(NewDictObj);
9309 JIM_REGISTER_API(DictKey);
9310 JIM_REGISTER_API(DictKeysVector);
9311 JIM_REGISTER_API(GetIndex);
9312 JIM_REGISTER_API(GetReturnCode);
9313 JIM_REGISTER_API(EvalExpression);
9314 JIM_REGISTER_API(GetBoolFromExpr);
9315 JIM_REGISTER_API(GetWide);
9316 JIM_REGISTER_API(GetLong);
9317 JIM_REGISTER_API(SetWide);
9318 JIM_REGISTER_API(NewIntObj);
9319 JIM_REGISTER_API(GetDouble);
9320 JIM_REGISTER_API(SetDouble);
9321 JIM_REGISTER_API(NewDoubleObj);
9322 JIM_REGISTER_API(WrongNumArgs);
9323 JIM_REGISTER_API(SetDictKeysVector);
9324 JIM_REGISTER_API(SubstObj);
9325 JIM_REGISTER_API(RegisterApi);
9326 JIM_REGISTER_API(PrintErrorMessage);
9327 JIM_REGISTER_API(InteractivePrompt);
9328 JIM_REGISTER_API(RegisterCoreCommands);
9329 JIM_REGISTER_API(GetSharedString);
9330 JIM_REGISTER_API(ReleaseSharedString);
9331 JIM_REGISTER_API(Panic);
9332 JIM_REGISTER_API(StrDup);
9333 JIM_REGISTER_API(UnsetVariable);
9334 JIM_REGISTER_API(GetVariableStr);
9335 JIM_REGISTER_API(GetGlobalVariable);
9336 JIM_REGISTER_API(GetGlobalVariableStr);
9337 JIM_REGISTER_API(GetAssocData);
9338 JIM_REGISTER_API(SetAssocData);
9339 JIM_REGISTER_API(DeleteAssocData);
9340 JIM_REGISTER_API(GetEnum);
9341 JIM_REGISTER_API(ScriptIsComplete);
9342 JIM_REGISTER_API(PackageRequire);
9343 JIM_REGISTER_API(PackageProvide);
9344 JIM_REGISTER_API(InitStack);
9345 JIM_REGISTER_API(FreeStack);
9346 JIM_REGISTER_API(StackLen);
9347 JIM_REGISTER_API(StackPush);
9348 JIM_REGISTER_API(StackPop);
9349 JIM_REGISTER_API(StackPeek);
9350 JIM_REGISTER_API(FreeStackElements);
9351 JIM_REGISTER_API(fprintf );
9352 JIM_REGISTER_API(vfprintf );
9353 JIM_REGISTER_API(fwrite );
9354 JIM_REGISTER_API(fread );
9355 JIM_REGISTER_API(fflush );
9356 JIM_REGISTER_API(fgets );
9357 JIM_REGISTER_API(GetNvp);
9358 JIM_REGISTER_API(Nvp_name2value);
9359 JIM_REGISTER_API(Nvp_name2value_simple);
9360 JIM_REGISTER_API(Nvp_name2value_obj);
9361 JIM_REGISTER_API(Nvp_name2value_nocase);
9362 JIM_REGISTER_API(Nvp_name2value_obj_nocase);
9363
9364 JIM_REGISTER_API(Nvp_value2name);
9365 JIM_REGISTER_API(Nvp_value2name_simple);
9366 JIM_REGISTER_API(Nvp_value2name_obj);
9367
9368 JIM_REGISTER_API(GetOpt_Setup);
9369 JIM_REGISTER_API(GetOpt_Debug);
9370 JIM_REGISTER_API(GetOpt_Obj);
9371 JIM_REGISTER_API(GetOpt_String);
9372 JIM_REGISTER_API(GetOpt_Double);
9373 JIM_REGISTER_API(GetOpt_Wide);
9374 JIM_REGISTER_API(GetOpt_Nvp);
9375 JIM_REGISTER_API(GetOpt_NvpUnknown);
9376 JIM_REGISTER_API(GetOpt_Enum);
9377
9378 JIM_REGISTER_API(Debug_ArgvString);
9379 JIM_REGISTER_API(SetResult_sprintf);
9380 JIM_REGISTER_API(SetResult_NvpUnknown);
9381
9382 }
9383
9384 /* -----------------------------------------------------------------------------
9385 * Core commands utility functions
9386 * ---------------------------------------------------------------------------*/
9387 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv,
9388 const char *msg)
9389 {
9390 int i;
9391 Jim_Obj *objPtr = Jim_NewEmptyStringObj(interp);
9392
9393 Jim_AppendString(interp, objPtr, "wrong # args: should be \"", -1);
9394 for (i = 0; i < argc; i++) {
9395 Jim_AppendObj(interp, objPtr, argv[i]);
9396 if (!(i+1 == argc && msg[0] == '\0'))
9397 Jim_AppendString(interp, objPtr, " ", 1);
9398 }
9399 Jim_AppendString(interp, objPtr, msg, -1);
9400 Jim_AppendString(interp, objPtr, "\"", 1);
9401 Jim_SetResult(interp, objPtr);
9402 }
9403
9404 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr)
9405 {
9406 Jim_HashTableIterator *htiter;
9407 Jim_HashEntry *he;
9408 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
9409 const char *pattern;
9410 int patternLen;
9411
9412 pattern = patternObjPtr ? Jim_GetString(patternObjPtr, &patternLen) : NULL;
9413 htiter = Jim_GetHashTableIterator(&interp->commands);
9414 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
9415 if (pattern && !JimStringMatch(pattern, patternLen, he->key,
9416 strlen((const char*)he->key), 0))
9417 continue;
9418 Jim_ListAppendElement(interp, listObjPtr,
9419 Jim_NewStringObj(interp, he->key, -1));
9420 }
9421 Jim_FreeHashTableIterator(htiter);
9422 return listObjPtr;
9423 }
9424
9425 #define JIM_VARLIST_GLOBALS 0
9426 #define JIM_VARLIST_LOCALS 1
9427 #define JIM_VARLIST_VARS 2
9428
9429 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr,
9430 int mode)
9431 {
9432 Jim_HashTableIterator *htiter;
9433 Jim_HashEntry *he;
9434 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
9435 const char *pattern;
9436 int patternLen;
9437
9438 pattern = patternObjPtr ? Jim_GetString(patternObjPtr, &patternLen) : NULL;
9439 if (mode == JIM_VARLIST_GLOBALS) {
9440 htiter = Jim_GetHashTableIterator(&interp->topFramePtr->vars);
9441 } else {
9442 /* For [info locals], if we are at top level an emtpy list
9443 * is returned. I don't agree, but we aim at compatibility (SS) */
9444 if (mode == JIM_VARLIST_LOCALS &&
9445 interp->framePtr == interp->topFramePtr)
9446 return listObjPtr;
9447 htiter = Jim_GetHashTableIterator(&interp->framePtr->vars);
9448 }
9449 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
9450 Jim_Var *varPtr = (Jim_Var*) he->val;
9451 if (mode == JIM_VARLIST_LOCALS) {
9452 if (varPtr->linkFramePtr != NULL)
9453 continue;
9454 }
9455 if (pattern && !JimStringMatch(pattern, patternLen, he->key,
9456 strlen((const char*)he->key), 0))
9457 continue;
9458 Jim_ListAppendElement(interp, listObjPtr,
9459 Jim_NewStringObj(interp, he->key, -1));
9460 }
9461 Jim_FreeHashTableIterator(htiter);
9462 return listObjPtr;
9463 }
9464
9465 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
9466 Jim_Obj **objPtrPtr)
9467 {
9468 Jim_CallFrame *targetCallFrame;
9469
9470 if (JimGetCallFrameByInteger(interp, levelObjPtr, &targetCallFrame)
9471 != JIM_OK)
9472 return JIM_ERR;
9473 /* No proc call at toplevel callframe */
9474 if (targetCallFrame == interp->topFramePtr) {
9475 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
9476 Jim_AppendStrings(interp, Jim_GetResult(interp),
9477 "bad level \"",
9478 Jim_GetString(levelObjPtr, NULL), "\"", NULL);
9479 return JIM_ERR;
9480 }
9481 *objPtrPtr = Jim_NewListObj(interp,
9482 targetCallFrame->argv,
9483 targetCallFrame->argc);
9484 return JIM_OK;
9485 }
9486
9487 /* -----------------------------------------------------------------------------
9488 * Core commands
9489 * ---------------------------------------------------------------------------*/
9490
9491 /* fake [puts] -- not the real puts, just for debugging. */
9492 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc,
9493 Jim_Obj *const *argv)
9494 {
9495 const char *str;
9496 int len, nonewline = 0;
9497
9498 if (argc != 2 && argc != 3) {
9499 Jim_WrongNumArgs(interp, 1, argv, "-nonewline string");
9500 return JIM_ERR;
9501 }
9502 if (argc == 3) {
9503 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline"))
9504 {
9505 Jim_SetResultString(interp, "The second argument must "
9506 "be -nonewline", -1);
9507 return JIM_OK;
9508 } else {
9509 nonewline = 1;
9510 argv++;
9511 }
9512 }
9513 str = Jim_GetString(argv[1], &len);
9514 Jim_fwrite(interp, str, 1, len, interp->cookie_stdout);
9515 if (!nonewline) Jim_fprintf( interp, interp->cookie_stdout, JIM_NL);
9516 return JIM_OK;
9517 }
9518
9519 /* Helper for [+] and [*] */
9520 static int Jim_AddMulHelper(Jim_Interp *interp, int argc,
9521 Jim_Obj *const *argv, int op)
9522 {
9523 jim_wide wideValue, res;
9524 double doubleValue, doubleRes;
9525 int i;
9526
9527 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
9528
9529 for (i = 1; i < argc; i++) {
9530 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
9531 goto trydouble;
9532 if (op == JIM_EXPROP_ADD)
9533 res += wideValue;
9534 else
9535 res *= wideValue;
9536 }
9537 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9538 return JIM_OK;
9539 trydouble:
9540 doubleRes = (double) res;
9541 for (;i < argc; i++) {
9542 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
9543 return JIM_ERR;
9544 if (op == JIM_EXPROP_ADD)
9545 doubleRes += doubleValue;
9546 else
9547 doubleRes *= doubleValue;
9548 }
9549 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
9550 return JIM_OK;
9551 }
9552
9553 /* Helper for [-] and [/] */
9554 static int Jim_SubDivHelper(Jim_Interp *interp, int argc,
9555 Jim_Obj *const *argv, int op)
9556 {
9557 jim_wide wideValue, res = 0;
9558 double doubleValue, doubleRes = 0;
9559 int i = 2;
9560
9561 if (argc < 2) {
9562 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
9563 return JIM_ERR;
9564 } else if (argc == 2) {
9565 /* The arity = 2 case is different. For [- x] returns -x,
9566 * while [/ x] returns 1/x. */
9567 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
9568 if (Jim_GetDouble(interp, argv[1], &doubleValue) !=
9569 JIM_OK)
9570 {
9571 return JIM_ERR;
9572 } else {
9573 if (op == JIM_EXPROP_SUB)
9574 doubleRes = -doubleValue;
9575 else
9576 doubleRes = 1.0/doubleValue;
9577 Jim_SetResult(interp, Jim_NewDoubleObj(interp,
9578 doubleRes));
9579 return JIM_OK;
9580 }
9581 }
9582 if (op == JIM_EXPROP_SUB) {
9583 res = -wideValue;
9584 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9585 } else {
9586 doubleRes = 1.0/wideValue;
9587 Jim_SetResult(interp, Jim_NewDoubleObj(interp,
9588 doubleRes));
9589 }
9590 return JIM_OK;
9591 } else {
9592 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
9593 if (Jim_GetDouble(interp, argv[1], &doubleRes)
9594 != JIM_OK) {
9595 return JIM_ERR;
9596 } else {
9597 goto trydouble;
9598 }
9599 }
9600 }
9601 for (i = 2; i < argc; i++) {
9602 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
9603 doubleRes = (double) res;
9604 goto trydouble;
9605 }
9606 if (op == JIM_EXPROP_SUB)
9607 res -= wideValue;
9608 else
9609 res /= wideValue;
9610 }
9611 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9612 return JIM_OK;
9613 trydouble:
9614 for (;i < argc; i++) {
9615 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
9616 return JIM_ERR;
9617 if (op == JIM_EXPROP_SUB)
9618 doubleRes -= doubleValue;
9619 else
9620 doubleRes /= doubleValue;
9621 }
9622 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
9623 return JIM_OK;
9624 }
9625
9626
9627 /* [+] */
9628 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc,
9629 Jim_Obj *const *argv)
9630 {
9631 return Jim_AddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
9632 }
9633
9634 /* [*] */
9635 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc,
9636 Jim_Obj *const *argv)
9637 {
9638 return Jim_AddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
9639 }
9640
9641 /* [-] */
9642 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc,
9643 Jim_Obj *const *argv)
9644 {
9645 return Jim_SubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
9646 }
9647
9648 /* [/] */
9649 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc,
9650 Jim_Obj *const *argv)
9651 {
9652 return Jim_SubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
9653 }
9654
9655 /* [set] */
9656 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc,
9657 Jim_Obj *const *argv)
9658 {
9659 if (argc != 2 && argc != 3) {
9660 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
9661 return JIM_ERR;
9662 }
9663 if (argc == 2) {
9664 Jim_Obj *objPtr;
9665 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
9666 if (!objPtr)
9667 return JIM_ERR;
9668 Jim_SetResult(interp, objPtr);
9669 return JIM_OK;
9670 }
9671 /* argc == 3 case. */
9672 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
9673 return JIM_ERR;
9674 Jim_SetResult(interp, argv[2]);
9675 return JIM_OK;
9676 }
9677
9678 /* [unset] */
9679 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc,
9680 Jim_Obj *const *argv)
9681 {
9682 int i;
9683
9684 if (argc < 2) {
9685 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
9686 return JIM_ERR;
9687 }
9688 for (i = 1; i < argc; i++) {
9689 if (Jim_UnsetVariable(interp, argv[i], JIM_ERRMSG) != JIM_OK)
9690 return JIM_ERR;
9691 }
9692 return JIM_OK;
9693 }
9694
9695 /* [incr] */
9696 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc,
9697 Jim_Obj *const *argv)
9698 {
9699 jim_wide wideValue, increment = 1;
9700 Jim_Obj *intObjPtr;
9701
9702 if (argc != 2 && argc != 3) {
9703 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
9704 return JIM_ERR;
9705 }
9706 if (argc == 3) {
9707 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
9708 return JIM_ERR;
9709 }
9710 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
9711 if (!intObjPtr) return JIM_ERR;
9712 if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK)
9713 return JIM_ERR;
9714 if (Jim_IsShared(intObjPtr)) {
9715 intObjPtr = Jim_NewIntObj(interp, wideValue+increment);
9716 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
9717 Jim_FreeNewObj(interp, intObjPtr);
9718 return JIM_ERR;
9719 }
9720 } else {
9721 Jim_SetWide(interp, intObjPtr, wideValue+increment);
9722 /* The following step is required in order to invalidate the
9723 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
9724 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
9725 return JIM_ERR;
9726 }
9727 }
9728 Jim_SetResult(interp, intObjPtr);
9729 return JIM_OK;
9730 }
9731
9732 /* [while] */
9733 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc,
9734 Jim_Obj *const *argv)
9735 {
9736 if (argc != 3) {
9737 Jim_WrongNumArgs(interp, 1, argv, "condition body");
9738 return JIM_ERR;
9739 }
9740 /* Try to run a specialized version of while if the expression
9741 * is in one of the following forms:
9742 *
9743 * $a < CONST, $a < $b
9744 * $a <= CONST, $a <= $b
9745 * $a > CONST, $a > $b
9746 * $a >= CONST, $a >= $b
9747 * $a != CONST, $a != $b
9748 * $a == CONST, $a == $b
9749 * $a
9750 * !$a
9751 * CONST
9752 */
9753
9754 #ifdef JIM_OPTIMIZATION
9755 {
9756 ExprByteCode *expr;
9757 Jim_Obj *varAObjPtr = NULL, *varBObjPtr = NULL, *objPtr;
9758 int exprLen, retval;
9759
9760 /* STEP 1 -- Check if there are the conditions to run the specialized
9761 * version of while */
9762
9763 if ((expr = Jim_GetExpression(interp, argv[1])) == NULL) goto noopt;
9764 if (expr->len <= 0 || expr->len > 3) goto noopt;
9765 switch(expr->len) {
9766 case 1:
9767 if (expr->opcode[0] != JIM_EXPROP_VARIABLE &&
9768 expr->opcode[0] != JIM_EXPROP_NUMBER)
9769 goto noopt;
9770 break;
9771 case 2:
9772 if (expr->opcode[1] != JIM_EXPROP_NOT ||
9773 expr->opcode[0] != JIM_EXPROP_VARIABLE)
9774 goto noopt;
9775 break;
9776 case 3:
9777 if (expr->opcode[0] != JIM_EXPROP_VARIABLE ||
9778 (expr->opcode[1] != JIM_EXPROP_NUMBER &&
9779 expr->opcode[1] != JIM_EXPROP_VARIABLE))
9780 goto noopt;
9781 switch(expr->opcode[2]) {
9782 case JIM_EXPROP_LT:
9783 case JIM_EXPROP_LTE:
9784 case JIM_EXPROP_GT:
9785 case JIM_EXPROP_GTE:
9786 case JIM_EXPROP_NUMEQ:
9787 case JIM_EXPROP_NUMNE:
9788 /* nothing to do */
9789 break;
9790 default:
9791 goto noopt;
9792 }
9793 break;
9794 default:
9795 Jim_Panic(interp,
9796 "Unexpected default reached in Jim_WhileCoreCommand()");
9797 break;
9798 }
9799
9800 /* STEP 2 -- conditions meet. Initialization. Take different
9801 * branches for different expression lengths. */
9802 exprLen = expr->len;
9803
9804 if (exprLen == 1) {
9805 jim_wide wideValue;
9806
9807 if (expr->opcode[0] == JIM_EXPROP_VARIABLE) {
9808 varAObjPtr = expr->obj[0];
9809 Jim_IncrRefCount(varAObjPtr);
9810 } else {
9811 if (Jim_GetWide(interp, expr->obj[0], &wideValue) != JIM_OK)
9812 goto noopt;
9813 }
9814 while (1) {
9815 if (varAObjPtr) {
9816 if (!(objPtr =
9817 Jim_GetVariable(interp, varAObjPtr, JIM_NONE)) ||
9818 Jim_GetWide(interp, objPtr, &wideValue) != JIM_OK)
9819 {
9820 Jim_DecrRefCount(interp, varAObjPtr);
9821 goto noopt;
9822 }
9823 }
9824 if (!wideValue) break;
9825 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9826 switch(retval) {
9827 case JIM_BREAK:
9828 if (varAObjPtr)
9829 Jim_DecrRefCount(interp, varAObjPtr);
9830 goto out;
9831 break;
9832 case JIM_CONTINUE:
9833 continue;
9834 break;
9835 default:
9836 if (varAObjPtr)
9837 Jim_DecrRefCount(interp, varAObjPtr);
9838 return retval;
9839 }
9840 }
9841 }
9842 if (varAObjPtr)
9843 Jim_DecrRefCount(interp, varAObjPtr);
9844 } else if (exprLen == 3) {
9845 jim_wide wideValueA, wideValueB, cmpRes = 0;
9846 int cmpType = expr->opcode[2];
9847
9848 varAObjPtr = expr->obj[0];
9849 Jim_IncrRefCount(varAObjPtr);
9850 if (expr->opcode[1] == JIM_EXPROP_VARIABLE) {
9851 varBObjPtr = expr->obj[1];
9852 Jim_IncrRefCount(varBObjPtr);
9853 } else {
9854 if (Jim_GetWide(interp, expr->obj[1], &wideValueB) != JIM_OK)
9855 goto noopt;
9856 }
9857 while (1) {
9858 if (!(objPtr = Jim_GetVariable(interp, varAObjPtr, JIM_NONE)) ||
9859 Jim_GetWide(interp, objPtr, &wideValueA) != JIM_OK)
9860 {
9861 Jim_DecrRefCount(interp, varAObjPtr);
9862 if (varBObjPtr)
9863 Jim_DecrRefCount(interp, varBObjPtr);
9864 goto noopt;
9865 }
9866 if (varBObjPtr) {
9867 if (!(objPtr =
9868 Jim_GetVariable(interp, varBObjPtr, JIM_NONE)) ||
9869 Jim_GetWide(interp, objPtr, &wideValueB) != JIM_OK)
9870 {
9871 Jim_DecrRefCount(interp, varAObjPtr);
9872 if (varBObjPtr)
9873 Jim_DecrRefCount(interp, varBObjPtr);
9874 goto noopt;
9875 }
9876 }
9877 switch(cmpType) {
9878 case JIM_EXPROP_LT:
9879 cmpRes = wideValueA < wideValueB; break;
9880 case JIM_EXPROP_LTE:
9881 cmpRes = wideValueA <= wideValueB; break;
9882 case JIM_EXPROP_GT:
9883 cmpRes = wideValueA > wideValueB; break;
9884 case JIM_EXPROP_GTE:
9885 cmpRes = wideValueA >= wideValueB; break;
9886 case JIM_EXPROP_NUMEQ:
9887 cmpRes = wideValueA == wideValueB; break;
9888 case JIM_EXPROP_NUMNE:
9889 cmpRes = wideValueA != wideValueB; break;
9890 }
9891 if (!cmpRes) break;
9892 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9893 switch(retval) {
9894 case JIM_BREAK:
9895 Jim_DecrRefCount(interp, varAObjPtr);
9896 if (varBObjPtr)
9897 Jim_DecrRefCount(interp, varBObjPtr);
9898 goto out;
9899 break;
9900 case JIM_CONTINUE:
9901 continue;
9902 break;
9903 default:
9904 Jim_DecrRefCount(interp, varAObjPtr);
9905 if (varBObjPtr)
9906 Jim_DecrRefCount(interp, varBObjPtr);
9907 return retval;
9908 }
9909 }
9910 }
9911 Jim_DecrRefCount(interp, varAObjPtr);
9912 if (varBObjPtr)
9913 Jim_DecrRefCount(interp, varBObjPtr);
9914 } else {
9915 /* TODO: case for len == 2 */
9916 goto noopt;
9917 }
9918 Jim_SetEmptyResult(interp);
9919 return JIM_OK;
9920 }
9921 noopt:
9922 #endif
9923
9924 /* The general purpose implementation of while starts here */
9925 while (1) {
9926 int boolean, retval;
9927
9928 if ((retval = Jim_GetBoolFromExpr(interp, argv[1],
9929 &boolean)) != JIM_OK)
9930 return retval;
9931 if (!boolean) break;
9932 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9933 switch(retval) {
9934 case JIM_BREAK:
9935 goto out;
9936 break;
9937 case JIM_CONTINUE:
9938 continue;
9939 break;
9940 default:
9941 return retval;
9942 }
9943 }
9944 }
9945 out:
9946 Jim_SetEmptyResult(interp);
9947 return JIM_OK;
9948 }
9949
9950 /* [for] */
9951 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc,
9952 Jim_Obj *const *argv)
9953 {
9954 int retval;
9955
9956 if (argc != 5) {
9957 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
9958 return JIM_ERR;
9959 }
9960 /* Check if the for is on the form:
9961 * for {set i CONST} {$i < CONST} {incr i}
9962 * for {set i CONST} {$i < $j} {incr i}
9963 * for {set i CONST} {$i <= CONST} {incr i}
9964 * for {set i CONST} {$i <= $j} {incr i}
9965 * XXX: NOTE: if variable traces are implemented, this optimization
9966 * need to be modified to check for the proc epoch at every variable
9967 * update. */
9968 #ifdef JIM_OPTIMIZATION
9969 {
9970 ScriptObj *initScript, *incrScript;
9971 ExprByteCode *expr;
9972 jim_wide start, stop, currentVal;
9973 unsigned jim_wide procEpoch = interp->procEpoch;
9974 Jim_Obj *varNamePtr, *stopVarNamePtr = NULL, *objPtr;
9975 int cmpType;
9976 struct Jim_Cmd *cmdPtr;
9977
9978 /* Do it only if there aren't shared arguments */
9979 if (argv[1] == argv[2] || argv[2] == argv[3] || argv[1] == argv[3])
9980 goto evalstart;
9981 initScript = Jim_GetScript(interp, argv[1]);
9982 expr = Jim_GetExpression(interp, argv[2]);
9983 incrScript = Jim_GetScript(interp, argv[3]);
9984
9985 /* Ensure proper lengths to start */
9986 if (initScript->len != 6) goto evalstart;
9987 if (incrScript->len != 4) goto evalstart;
9988 if (expr->len != 3) goto evalstart;
9989 /* Ensure proper token types. */
9990 if (initScript->token[2].type != JIM_TT_ESC ||
9991 initScript->token[4].type != JIM_TT_ESC ||
9992 incrScript->token[2].type != JIM_TT_ESC ||
9993 expr->opcode[0] != JIM_EXPROP_VARIABLE ||
9994 (expr->opcode[1] != JIM_EXPROP_NUMBER &&
9995 expr->opcode[1] != JIM_EXPROP_VARIABLE) ||
9996 (expr->opcode[2] != JIM_EXPROP_LT &&
9997 expr->opcode[2] != JIM_EXPROP_LTE))
9998 goto evalstart;
9999 cmpType = expr->opcode[2];
10000 /* Initialization command must be [set] */
10001 cmdPtr = Jim_GetCommand(interp, initScript->token[0].objPtr, JIM_NONE);
10002 if (cmdPtr == NULL || cmdPtr->cmdProc != Jim_SetCoreCommand)
10003 goto evalstart;
10004 /* Update command must be incr */
10005 cmdPtr = Jim_GetCommand(interp, incrScript->token[0].objPtr, JIM_NONE);
10006 if (cmdPtr == NULL || cmdPtr->cmdProc != Jim_IncrCoreCommand)
10007 goto evalstart;
10008 /* set, incr, expression must be about the same variable */
10009 if (!Jim_StringEqObj(initScript->token[2].objPtr,
10010 incrScript->token[2].objPtr, 0))
10011 goto evalstart;
10012 if (!Jim_StringEqObj(initScript->token[2].objPtr,
10013 expr->obj[0], 0))
10014 goto evalstart;
10015 /* Check that the initialization and comparison are valid integers */
10016 if (Jim_GetWide(interp, initScript->token[4].objPtr, &start) == JIM_ERR)
10017 goto evalstart;
10018 if (expr->opcode[1] == JIM_EXPROP_NUMBER &&
10019 Jim_GetWide(interp, expr->obj[1], &stop) == JIM_ERR)
10020 {
10021 goto evalstart;
10022 }
10023
10024 /* Initialization */
10025 varNamePtr = expr->obj[0];
10026 if (expr->opcode[1] == JIM_EXPROP_VARIABLE) {
10027 stopVarNamePtr = expr->obj[1];
10028 Jim_IncrRefCount(stopVarNamePtr);
10029 }
10030 Jim_IncrRefCount(varNamePtr);
10031
10032 /* --- OPTIMIZED FOR --- */
10033 /* Start to loop */
10034 objPtr = Jim_NewIntObj(interp, start);
10035 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
10036 Jim_DecrRefCount(interp, varNamePtr);
10037 if (stopVarNamePtr) Jim_DecrRefCount(interp, stopVarNamePtr);
10038 Jim_FreeNewObj(interp, objPtr);
10039 goto evalstart;
10040 }
10041 while (1) {
10042 /* === Check condition === */
10043 /* Common code: */
10044 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
10045 if (objPtr == NULL ||
10046 Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK)
10047 {
10048 Jim_DecrRefCount(interp, varNamePtr);
10049 if (stopVarNamePtr) Jim_DecrRefCount(interp, stopVarNamePtr);
10050 goto testcond;
10051 }
10052 /* Immediate or Variable? get the 'stop' value if the latter. */
10053 if (stopVarNamePtr) {
10054 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
10055 if (objPtr == NULL ||
10056 Jim_GetWide(interp, objPtr, &stop) != JIM_OK)
10057 {
10058 Jim_DecrRefCount(interp, varNamePtr);
10059 Jim_DecrRefCount(interp, stopVarNamePtr);
10060 goto testcond;
10061 }
10062 }
10063 if (cmpType == JIM_EXPROP_LT) {
10064 if (currentVal >= stop) break;
10065 } else {
10066 if (currentVal > stop) break;
10067 }
10068 /* Eval body */
10069 if ((retval = Jim_EvalObj(interp, argv[4])) != JIM_OK) {
10070 switch(retval) {
10071 case JIM_BREAK:
10072 if (stopVarNamePtr)
10073 Jim_DecrRefCount(interp, stopVarNamePtr);
10074 Jim_DecrRefCount(interp, varNamePtr);
10075 goto out;
10076 case JIM_CONTINUE:
10077 /* nothing to do */
10078 break;
10079 default:
10080 if (stopVarNamePtr)
10081 Jim_DecrRefCount(interp, stopVarNamePtr);
10082 Jim_DecrRefCount(interp, varNamePtr);
10083 return retval;
10084 }
10085 }
10086 /* If there was a change in procedures/command continue
10087 * with the usual [for] command implementation */
10088 if (procEpoch != interp->procEpoch) {
10089 if (stopVarNamePtr)
10090 Jim_DecrRefCount(interp, stopVarNamePtr);
10091 Jim_DecrRefCount(interp, varNamePtr);
10092 goto evalnext;
10093 }
10094 /* Increment */
10095 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
10096 if (objPtr->refCount == 1 && objPtr->typePtr == &intObjType) {
10097 objPtr->internalRep.wideValue ++;
10098 Jim_InvalidateStringRep(objPtr);
10099 } else {
10100 Jim_Obj *auxObjPtr;
10101
10102 if (Jim_GetWide(interp, objPtr, &currentVal) == JIM_ERR) {
10103 if (stopVarNamePtr)
10104 Jim_DecrRefCount(interp, stopVarNamePtr);
10105 Jim_DecrRefCount(interp, varNamePtr);
10106 goto evalnext;
10107 }
10108 auxObjPtr = Jim_NewIntObj(interp, currentVal+1);
10109 if (Jim_SetVariable(interp, varNamePtr, auxObjPtr) == JIM_ERR) {
10110 if (stopVarNamePtr)
10111 Jim_DecrRefCount(interp, stopVarNamePtr);
10112 Jim_DecrRefCount(interp, varNamePtr);
10113 Jim_FreeNewObj(interp, auxObjPtr);
10114 goto evalnext;
10115 }
10116 }
10117 }
10118 if (stopVarNamePtr)
10119 Jim_DecrRefCount(interp, stopVarNamePtr);
10120 Jim_DecrRefCount(interp, varNamePtr);
10121 Jim_SetEmptyResult(interp);
10122 return JIM_OK;
10123 }
10124 #endif
10125 evalstart:
10126 /* Eval start */
10127 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK)
10128 return retval;
10129 while (1) {
10130 int boolean;
10131 testcond:
10132 /* Test the condition */
10133 if ((retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean))
10134 != JIM_OK)
10135 return retval;
10136 if (!boolean) break;
10137 /* Eval body */
10138 if ((retval = Jim_EvalObj(interp, argv[4])) != JIM_OK) {
10139 switch(retval) {
10140 case JIM_BREAK:
10141 goto out;
10142 break;
10143 case JIM_CONTINUE:
10144 /* Nothing to do */
10145 break;
10146 default:
10147 return retval;
10148 }
10149 }
10150 evalnext:
10151 /* Eval next */
10152 if ((retval = Jim_EvalObj(interp, argv[3])) != JIM_OK) {
10153 switch(retval) {
10154 case JIM_BREAK:
10155 goto out;
10156 break;
10157 case JIM_CONTINUE:
10158 continue;
10159 break;
10160 default:
10161 return retval;
10162 }
10163 }
10164 }
10165 out:
10166 Jim_SetEmptyResult(interp);
10167 return JIM_OK;
10168 }
10169
10170 /* foreach + lmap implementation. */
10171 static int JimForeachMapHelper(Jim_Interp *interp, int argc,
10172 Jim_Obj *const *argv, int doMap)
10173 {
10174 int result = JIM_ERR, i, nbrOfLists, *listsIdx, *listsEnd;
10175 int nbrOfLoops = 0;
10176 Jim_Obj *emptyStr, *script, *mapRes = NULL;
10177
10178 if (argc < 4 || argc % 2 != 0) {
10179 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
10180 return JIM_ERR;
10181 }
10182 if (doMap) {
10183 mapRes = Jim_NewListObj(interp, NULL, 0);
10184 Jim_IncrRefCount(mapRes);
10185 }
10186 emptyStr = Jim_NewEmptyStringObj(interp);
10187 Jim_IncrRefCount(emptyStr);
10188 script = argv[argc-1]; /* Last argument is a script */
10189 nbrOfLists = (argc - 1 - 1) / 2; /* argc - 'foreach' - script */
10190 listsIdx = (int*)Jim_Alloc(nbrOfLists * sizeof(int));
10191 listsEnd = (int*)Jim_Alloc(nbrOfLists*2 * sizeof(int));
10192 /* Initialize iterators and remember max nbr elements each list */
10193 memset(listsIdx, 0, nbrOfLists * sizeof(int));
10194 /* Remember lengths of all lists and calculate how much rounds to loop */
10195 for (i=0; i < nbrOfLists*2; i += 2) {
10196 div_t cnt;
10197 int count;
10198 Jim_ListLength(interp, argv[i+1], &listsEnd[i]);
10199 Jim_ListLength(interp, argv[i+2], &listsEnd[i+1]);
10200 if (listsEnd[i] == 0) {
10201 Jim_SetResultString(interp, "foreach varlist is empty", -1);
10202 goto err;
10203 }
10204 cnt = div(listsEnd[i+1], listsEnd[i]);
10205 count = cnt.quot + (cnt.rem ? 1 : 0);
10206 if (count > nbrOfLoops)
10207 nbrOfLoops = count;
10208 }
10209 for (; nbrOfLoops-- > 0; ) {
10210 for (i=0; i < nbrOfLists; ++i) {
10211 int varIdx = 0, var = i * 2;
10212 while (varIdx < listsEnd[var]) {
10213 Jim_Obj *varName, *ele;
10214 int lst = i * 2 + 1;
10215 if (Jim_ListIndex(interp, argv[var+1], varIdx, &varName, JIM_ERRMSG)
10216 != JIM_OK)
10217 goto err;
10218 if (listsIdx[i] < listsEnd[lst]) {
10219 if (Jim_ListIndex(interp, argv[lst+1], listsIdx[i], &ele, JIM_ERRMSG)
10220 != JIM_OK)
10221 goto err;
10222 if (Jim_SetVariable(interp, varName, ele) != JIM_OK) {
10223 Jim_SetResultString(interp, "couldn't set loop variable: ", -1);
10224 goto err;
10225 }
10226 ++listsIdx[i]; /* Remember next iterator of current list */
10227 } else if (Jim_SetVariable(interp, varName, emptyStr) != JIM_OK) {
10228 Jim_SetResultString(interp, "couldn't set loop variable: ", -1);
10229 goto err;
10230 }
10231 ++varIdx; /* Next variable */
10232 }
10233 }
10234 switch (result = Jim_EvalObj(interp, script)) {
10235 case JIM_OK:
10236 if (doMap)
10237 Jim_ListAppendElement(interp, mapRes, interp->result);
10238 break;
10239 case JIM_CONTINUE:
10240 break;
10241 case JIM_BREAK:
10242 goto out;
10243 break;
10244 default:
10245 goto err;
10246 }
10247 }
10248 out:
10249 result = JIM_OK;
10250 if (doMap)
10251 Jim_SetResult(interp, mapRes);
10252 else
10253 Jim_SetEmptyResult(interp);
10254 err:
10255 if (doMap)
10256 Jim_DecrRefCount(interp, mapRes);
10257 Jim_DecrRefCount(interp, emptyStr);
10258 Jim_Free(listsIdx);
10259 Jim_Free(listsEnd);
10260 return result;
10261 }
10262
10263 /* [foreach] */
10264 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc,
10265 Jim_Obj *const *argv)
10266 {
10267 return JimForeachMapHelper(interp, argc, argv, 0);
10268 }
10269
10270 /* [lmap] */
10271 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc,
10272 Jim_Obj *const *argv)
10273 {
10274 return JimForeachMapHelper(interp, argc, argv, 1);
10275 }
10276
10277 /* [if] */
10278 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc,
10279 Jim_Obj *const *argv)
10280 {
10281 int boolean, retval, current = 1, falsebody = 0;
10282 if (argc >= 3) {
10283 while (1) {
10284 /* Far not enough arguments given! */
10285 if (current >= argc) goto err;
10286 if ((retval = Jim_GetBoolFromExpr(interp,
10287 argv[current++], &boolean))
10288 != JIM_OK)
10289 return retval;
10290 /* There lacks something, isn't it? */
10291 if (current >= argc) goto err;
10292 if (Jim_CompareStringImmediate(interp, argv[current],
10293 "then")) current++;
10294 /* Tsk tsk, no then-clause? */
10295 if (current >= argc) goto err;
10296 if (boolean)
10297 return Jim_EvalObj(interp, argv[current]);
10298 /* Ok: no else-clause follows */
10299 if (++current >= argc) {
10300 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10301 return JIM_OK;
10302 }
10303 falsebody = current++;
10304 if (Jim_CompareStringImmediate(interp, argv[falsebody],
10305 "else")) {
10306 /* IIICKS - else-clause isn't last cmd? */
10307 if (current != argc-1) goto err;
10308 return Jim_EvalObj(interp, argv[current]);
10309 } else if (Jim_CompareStringImmediate(interp,
10310 argv[falsebody], "elseif"))
10311 /* Ok: elseif follows meaning all the stuff
10312 * again (how boring...) */
10313 continue;
10314 /* OOPS - else-clause is not last cmd?*/
10315 else if (falsebody != argc-1)
10316 goto err;
10317 return Jim_EvalObj(interp, argv[falsebody]);
10318 }
10319 return JIM_OK;
10320 }
10321 err:
10322 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
10323 return JIM_ERR;
10324 }
10325
10326 enum {SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD, SWITCH_UNKNOWN};
10327
10328 /* [switch] */
10329 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc,
10330 Jim_Obj *const *argv)
10331 {
10332 int retcode = JIM_ERR, matchOpt = SWITCH_EXACT, opt=1, patCount, i;
10333 Jim_Obj *command = 0, *const *caseList = 0, *strObj;
10334 Jim_Obj *script = 0;
10335 if (argc < 3) goto wrongnumargs;
10336 for (opt=1; opt < argc; ++opt) {
10337 const char *option = Jim_GetString(argv[opt], 0);
10338 if (*option != '-') break;
10339 else if (strncmp(option, "--", 2) == 0) { ++opt; break; }
10340 else if (strncmp(option, "-exact", 2) == 0) matchOpt = SWITCH_EXACT;
10341 else if (strncmp(option, "-glob", 2) == 0) matchOpt = SWITCH_GLOB;
10342 else if (strncmp(option, "-regexp", 2) == 0) matchOpt = SWITCH_RE;
10343 else if (strncmp(option, "-command", 2) == 0) { matchOpt = SWITCH_CMD;
10344 if ((argc - opt) < 2) goto wrongnumargs;
10345 command = argv[++opt];
10346 } else {
10347 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10348 Jim_AppendStrings(interp, Jim_GetResult(interp),
10349 "bad option \"", option, "\": must be -exact, -glob, "
10350 "-regexp, -command procname or --", 0);
10351 goto err;
10352 }
10353 if ((argc - opt) < 2) goto wrongnumargs;
10354 }
10355 strObj = argv[opt++];
10356 patCount = argc - opt;
10357 if (patCount == 1) {
10358 Jim_Obj **vector;
10359 JimListGetElements(interp, argv[opt], &patCount, &vector);
10360 caseList = vector;
10361 } else
10362 caseList = &argv[opt];
10363 if (patCount == 0 || patCount % 2 != 0) goto wrongnumargs;
10364 for (i=0; script == 0 && i < patCount; i += 2) {
10365 Jim_Obj *patObj = caseList[i];
10366 if (!Jim_CompareStringImmediate(interp, patObj, "default")
10367 || i < (patCount-2)) {
10368 switch (matchOpt) {
10369 case SWITCH_EXACT:
10370 if (Jim_StringEqObj(strObj, patObj, 0))
10371 script = caseList[i+1];
10372 break;
10373 case SWITCH_GLOB:
10374 if (Jim_StringMatchObj(patObj, strObj, 0))
10375 script = caseList[i+1];
10376 break;
10377 case SWITCH_RE:
10378 command = Jim_NewStringObj(interp, "regexp", -1);
10379 /* Fall thru intentionally */
10380 case SWITCH_CMD: {
10381 Jim_Obj *parms[] = {command, patObj, strObj};
10382 int rc = Jim_EvalObjVector(interp, 3, parms);
10383 long matching;
10384 /* After the execution of a command we need to
10385 * make sure to reconvert the object into a list
10386 * again. Only for the single-list style [switch]. */
10387 if (argc-opt == 1) {
10388 Jim_Obj **vector;
10389 JimListGetElements(interp, argv[opt], &patCount,
10390 &vector);
10391 caseList = vector;
10392 }
10393 /* command is here already decref'd */
10394 if (rc != JIM_OK) {
10395 retcode = rc;
10396 goto err;
10397 }
10398 rc = Jim_GetLong(interp, Jim_GetResult(interp), &matching);
10399 if (rc != JIM_OK) {
10400 retcode = rc;
10401 goto err;
10402 }
10403 if (matching)
10404 script = caseList[i+1];
10405 break;
10406 }
10407 default:
10408 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10409 Jim_AppendStrings(interp, Jim_GetResult(interp),
10410 "internal error: no such option implemented", 0);
10411 goto err;
10412 }
10413 } else {
10414 script = caseList[i+1];
10415 }
10416 }
10417 for(; i < patCount && Jim_CompareStringImmediate(interp, script, "-");
10418 i += 2)
10419 script = caseList[i+1];
10420 if (script && Jim_CompareStringImmediate(interp, script, "-")) {
10421 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10422 Jim_AppendStrings(interp, Jim_GetResult(interp),
10423 "no body specified for pattern \"",
10424 Jim_GetString(caseList[i-2], 0), "\"", 0);
10425 goto err;
10426 }
10427 retcode = JIM_OK;
10428 Jim_SetEmptyResult(interp);
10429 if (script != 0)
10430 retcode = Jim_EvalObj(interp, script);
10431 return retcode;
10432 wrongnumargs:
10433 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
10434 "pattern body ... ?default body? or "
10435 "{pattern body ?pattern body ...?}");
10436 err:
10437 return retcode;
10438 }
10439
10440 /* [list] */
10441 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc,
10442 Jim_Obj *const *argv)
10443 {
10444 Jim_Obj *listObjPtr;
10445
10446 listObjPtr = Jim_NewListObj(interp, argv+1, argc-1);
10447 Jim_SetResult(interp, listObjPtr);
10448 return JIM_OK;
10449 }
10450
10451 /* [lindex] */
10452 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc,
10453 Jim_Obj *const *argv)
10454 {
10455 Jim_Obj *objPtr, *listObjPtr;
10456 int i;
10457 int index;
10458
10459 if (argc < 3) {
10460 Jim_WrongNumArgs(interp, 1, argv, "list index ?...?");
10461 return JIM_ERR;
10462 }
10463 objPtr = argv[1];
10464 Jim_IncrRefCount(objPtr);
10465 for (i = 2; i < argc; i++) {
10466 listObjPtr = objPtr;
10467 if (Jim_GetIndex(interp, argv[i], &index) != JIM_OK) {
10468 Jim_DecrRefCount(interp, listObjPtr);
10469 return JIM_ERR;
10470 }
10471 if (Jim_ListIndex(interp, listObjPtr, index, &objPtr,
10472 JIM_NONE) != JIM_OK) {
10473 /* Returns an empty object if the index
10474 * is out of range. */
10475 Jim_DecrRefCount(interp, listObjPtr);
10476 Jim_SetEmptyResult(interp);
10477 return JIM_OK;
10478 }
10479 Jim_IncrRefCount(objPtr);
10480 Jim_DecrRefCount(interp, listObjPtr);
10481 }
10482 Jim_SetResult(interp, objPtr);
10483 Jim_DecrRefCount(interp, objPtr);
10484 return JIM_OK;
10485 }
10486
10487 /* [llength] */
10488 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc,
10489 Jim_Obj *const *argv)
10490 {
10491 int len;
10492
10493 if (argc != 2) {
10494 Jim_WrongNumArgs(interp, 1, argv, "list");
10495 return JIM_ERR;
10496 }
10497 Jim_ListLength(interp, argv[1], &len);
10498 Jim_SetResult(interp, Jim_NewIntObj(interp, len));
10499 return JIM_OK;
10500 }
10501
10502 /* [lappend] */
10503 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc,
10504 Jim_Obj *const *argv)
10505 {
10506 Jim_Obj *listObjPtr;
10507 int shared, i;
10508
10509 if (argc < 2) {
10510 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
10511 return JIM_ERR;
10512 }
10513 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_NONE);
10514 if (!listObjPtr) {
10515 /* Create the list if it does not exists */
10516 listObjPtr = Jim_NewListObj(interp, NULL, 0);
10517 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
10518 Jim_FreeNewObj(interp, listObjPtr);
10519 return JIM_ERR;
10520 }
10521 }
10522 shared = Jim_IsShared(listObjPtr);
10523 if (shared)
10524 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
10525 for (i = 2; i < argc; i++)
10526 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
10527 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
10528 if (shared)
10529 Jim_FreeNewObj(interp, listObjPtr);
10530 return JIM_ERR;
10531 }
10532 Jim_SetResult(interp, listObjPtr);
10533 return JIM_OK;
10534 }
10535
10536 /* [linsert] */
10537 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc,
10538 Jim_Obj *const *argv)
10539 {
10540 int index, len;
10541 Jim_Obj *listPtr;
10542
10543 if (argc < 4) {
10544 Jim_WrongNumArgs(interp, 1, argv, "list index element "
10545 "?element ...?");
10546 return JIM_ERR;
10547 }
10548 listPtr = argv[1];
10549 if (Jim_IsShared(listPtr))
10550 listPtr = Jim_DuplicateObj(interp, listPtr);
10551 if (Jim_GetIndex(interp, argv[2], &index) != JIM_OK)
10552 goto err;
10553 Jim_ListLength(interp, listPtr, &len);
10554 if (index >= len)
10555 index = len;
10556 else if (index < 0)
10557 index = len + index + 1;
10558 Jim_ListInsertElements(interp, listPtr, index, argc-3, &argv[3]);
10559 Jim_SetResult(interp, listPtr);
10560 return JIM_OK;
10561 err:
10562 if (listPtr != argv[1]) {
10563 Jim_FreeNewObj(interp, listPtr);
10564 }
10565 return JIM_ERR;
10566 }
10567
10568 /* [lset] */
10569 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc,
10570 Jim_Obj *const *argv)
10571 {
10572 if (argc < 3) {
10573 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
10574 return JIM_ERR;
10575 } else if (argc == 3) {
10576 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
10577 return JIM_ERR;
10578 Jim_SetResult(interp, argv[2]);
10579 return JIM_OK;
10580 }
10581 if (Jim_SetListIndex(interp, argv[1], argv+2, argc-3, argv[argc-1])
10582 == JIM_ERR) return JIM_ERR;
10583 return JIM_OK;
10584 }
10585
10586 /* [lsort] */
10587 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
10588 {
10589 const char *options[] = {
10590 "-ascii", "-nocase", "-increasing", "-decreasing", NULL
10591 };
10592 enum {OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING};
10593 Jim_Obj *resObj;
10594 int i, lsortType = JIM_LSORT_ASCII; /* default sort type */
10595 int decreasing = 0;
10596
10597 if (argc < 2) {
10598 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
10599 return JIM_ERR;
10600 }
10601 for (i = 1; i < (argc-1); i++) {
10602 int option;
10603
10604 if (Jim_GetEnum(interp, argv[i], options, &option, "option", JIM_ERRMSG)
10605 != JIM_OK)
10606 return JIM_ERR;
10607 switch(option) {
10608 case OPT_ASCII: lsortType = JIM_LSORT_ASCII; break;
10609 case OPT_NOCASE: lsortType = JIM_LSORT_NOCASE; break;
10610 case OPT_INCREASING: decreasing = 0; break;
10611 case OPT_DECREASING: decreasing = 1; break;
10612 }
10613 }
10614 if (decreasing) {
10615 switch(lsortType) {
10616 case JIM_LSORT_ASCII: lsortType = JIM_LSORT_ASCII_DECR; break;
10617 case JIM_LSORT_NOCASE: lsortType = JIM_LSORT_NOCASE_DECR; break;
10618 }
10619 }
10620 resObj = Jim_DuplicateObj(interp, argv[argc-1]);
10621 ListSortElements(interp, resObj, lsortType);
10622 Jim_SetResult(interp, resObj);
10623 return JIM_OK;
10624 }
10625
10626 /* [append] */
10627 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc,
10628 Jim_Obj *const *argv)
10629 {
10630 Jim_Obj *stringObjPtr;
10631 int shared, i;
10632
10633 if (argc < 2) {
10634 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
10635 return JIM_ERR;
10636 }
10637 if (argc == 2) {
10638 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
10639 if (!stringObjPtr) return JIM_ERR;
10640 } else {
10641 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_NONE);
10642 if (!stringObjPtr) {
10643 /* Create the string if it does not exists */
10644 stringObjPtr = Jim_NewEmptyStringObj(interp);
10645 if (Jim_SetVariable(interp, argv[1], stringObjPtr)
10646 != JIM_OK) {
10647 Jim_FreeNewObj(interp, stringObjPtr);
10648 return JIM_ERR;
10649 }
10650 }
10651 }
10652 shared = Jim_IsShared(stringObjPtr);
10653 if (shared)
10654 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
10655 for (i = 2; i < argc; i++)
10656 Jim_AppendObj(interp, stringObjPtr, argv[i]);
10657 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
10658 if (shared)
10659 Jim_FreeNewObj(interp, stringObjPtr);
10660 return JIM_ERR;
10661 }
10662 Jim_SetResult(interp, stringObjPtr);
10663 return JIM_OK;
10664 }
10665
10666 /* [debug] */
10667 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc,
10668 Jim_Obj *const *argv)
10669 {
10670 const char *options[] = {
10671 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
10672 "exprbc",
10673 NULL
10674 };
10675 enum {
10676 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
10677 OPT_EXPRLEN, OPT_EXPRBC
10678 };
10679 int option;
10680
10681 if (argc < 2) {
10682 Jim_WrongNumArgs(interp, 1, argv, "option ?...?");
10683 return JIM_ERR;
10684 }
10685 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
10686 JIM_ERRMSG) != JIM_OK)
10687 return JIM_ERR;
10688 if (option == OPT_REFCOUNT) {
10689 if (argc != 3) {
10690 Jim_WrongNumArgs(interp, 2, argv, "object");
10691 return JIM_ERR;
10692 }
10693 Jim_SetResult(interp, Jim_NewIntObj(interp, argv[2]->refCount));
10694 return JIM_OK;
10695 } else if (option == OPT_OBJCOUNT) {
10696 int freeobj = 0, liveobj = 0;
10697 char buf[256];
10698 Jim_Obj *objPtr;
10699
10700 if (argc != 2) {
10701 Jim_WrongNumArgs(interp, 2, argv, "");
10702 return JIM_ERR;
10703 }
10704 /* Count the number of free objects. */
10705 objPtr = interp->freeList;
10706 while (objPtr) {
10707 freeobj++;
10708 objPtr = objPtr->nextObjPtr;
10709 }
10710 /* Count the number of live objects. */
10711 objPtr = interp->liveList;
10712 while (objPtr) {
10713 liveobj++;
10714 objPtr = objPtr->nextObjPtr;
10715 }
10716 /* Set the result string and return. */
10717 sprintf(buf, "free %d used %d", freeobj, liveobj);
10718 Jim_SetResultString(interp, buf, -1);
10719 return JIM_OK;
10720 } else if (option == OPT_OBJECTS) {
10721 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
10722 /* Count the number of live objects. */
10723 objPtr = interp->liveList;
10724 listObjPtr = Jim_NewListObj(interp, NULL, 0);
10725 while (objPtr) {
10726 char buf[128];
10727 const char *type = objPtr->typePtr ?
10728 objPtr->typePtr->name : "";
10729 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
10730 sprintf(buf, "%p", objPtr);
10731 Jim_ListAppendElement(interp, subListObjPtr,
10732 Jim_NewStringObj(interp, buf, -1));
10733 Jim_ListAppendElement(interp, subListObjPtr,
10734 Jim_NewStringObj(interp, type, -1));
10735 Jim_ListAppendElement(interp, subListObjPtr,
10736 Jim_NewIntObj(interp, objPtr->refCount));
10737 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
10738 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
10739 objPtr = objPtr->nextObjPtr;
10740 }
10741 Jim_SetResult(interp, listObjPtr);
10742 return JIM_OK;
10743 } else if (option == OPT_INVSTR) {
10744 Jim_Obj *objPtr;
10745
10746 if (argc != 3) {
10747 Jim_WrongNumArgs(interp, 2, argv, "object");
10748 return JIM_ERR;
10749 }
10750 objPtr = argv[2];
10751 if (objPtr->typePtr != NULL)
10752 Jim_InvalidateStringRep(objPtr);
10753 Jim_SetEmptyResult(interp);
10754 return JIM_OK;
10755 } else if (option == OPT_SCRIPTLEN) {
10756 ScriptObj *script;
10757 if (argc != 3) {
10758 Jim_WrongNumArgs(interp, 2, argv, "script");
10759 return JIM_ERR;
10760 }
10761 script = Jim_GetScript(interp, argv[2]);
10762 Jim_SetResult(interp, Jim_NewIntObj(interp, script->len));
10763 return JIM_OK;
10764 } else if (option == OPT_EXPRLEN) {
10765 ExprByteCode *expr;
10766 if (argc != 3) {
10767 Jim_WrongNumArgs(interp, 2, argv, "expression");
10768 return JIM_ERR;
10769 }
10770 expr = Jim_GetExpression(interp, argv[2]);
10771 if (expr == NULL)
10772 return JIM_ERR;
10773 Jim_SetResult(interp, Jim_NewIntObj(interp, expr->len));
10774 return JIM_OK;
10775 } else if (option == OPT_EXPRBC) {
10776 Jim_Obj *objPtr;
10777 ExprByteCode *expr;
10778 int i;
10779
10780 if (argc != 3) {
10781 Jim_WrongNumArgs(interp, 2, argv, "expression");
10782 return JIM_ERR;
10783 }
10784 expr = Jim_GetExpression(interp, argv[2]);
10785 if (expr == NULL)
10786 return JIM_ERR;
10787 objPtr = Jim_NewListObj(interp, NULL, 0);
10788 for (i = 0; i < expr->len; i++) {
10789 const char *type;
10790 Jim_ExprOperator *op;
10791
10792 switch(expr->opcode[i]) {
10793 case JIM_EXPROP_NUMBER: type = "number"; break;
10794 case JIM_EXPROP_COMMAND: type = "command"; break;
10795 case JIM_EXPROP_VARIABLE: type = "variable"; break;
10796 case JIM_EXPROP_DICTSUGAR: type = "dictsugar"; break;
10797 case JIM_EXPROP_SUBST: type = "subst"; break;
10798 case JIM_EXPROP_STRING: type = "string"; break;
10799 default:
10800 op = JimExprOperatorInfo(Jim_GetString(expr->obj[i], NULL));
10801 if (op == NULL) {
10802 type = "private";
10803 } else {
10804 type = "operator";
10805 }
10806 break;
10807 }
10808 Jim_ListAppendElement(interp, objPtr,
10809 Jim_NewStringObj(interp, type, -1));
10810 Jim_ListAppendElement(interp, objPtr, expr->obj[i]);
10811 }
10812 Jim_SetResult(interp, objPtr);
10813 return JIM_OK;
10814 } else {
10815 Jim_SetResultString(interp,
10816 "bad option. Valid options are refcount, "
10817 "objcount, objects, invstr", -1);
10818 return JIM_ERR;
10819 }
10820 return JIM_OK; /* unreached */
10821 }
10822
10823 /* [eval] */
10824 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc,
10825 Jim_Obj *const *argv)
10826 {
10827 if (argc == 2) {
10828 return Jim_EvalObj(interp, argv[1]);
10829 } else if (argc > 2) {
10830 Jim_Obj *objPtr;
10831 int retcode;
10832
10833 objPtr = Jim_ConcatObj(interp, argc-1, argv+1);
10834 Jim_IncrRefCount(objPtr);
10835 retcode = Jim_EvalObj(interp, objPtr);
10836 Jim_DecrRefCount(interp, objPtr);
10837 return retcode;
10838 } else {
10839 Jim_WrongNumArgs(interp, 1, argv, "script ?...?");
10840 return JIM_ERR;
10841 }
10842 }
10843
10844 /* [uplevel] */
10845 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc,
10846 Jim_Obj *const *argv)
10847 {
10848 if (argc >= 2) {
10849 int retcode, newLevel, oldLevel;
10850 Jim_CallFrame *savedCallFrame, *targetCallFrame;
10851 Jim_Obj *objPtr;
10852 const char *str;
10853
10854 /* Save the old callframe pointer */
10855 savedCallFrame = interp->framePtr;
10856
10857 /* Lookup the target frame pointer */
10858 str = Jim_GetString(argv[1], NULL);
10859 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#')
10860 {
10861 if (Jim_GetCallFrameByLevel(interp, argv[1],
10862 &targetCallFrame,
10863 &newLevel) != JIM_OK)
10864 return JIM_ERR;
10865 argc--;
10866 argv++;
10867 } else {
10868 if (Jim_GetCallFrameByLevel(interp, NULL,
10869 &targetCallFrame,
10870 &newLevel) != JIM_OK)
10871 return JIM_ERR;
10872 }
10873 if (argc < 2) {
10874 argc++;
10875 argv--;
10876 Jim_WrongNumArgs(interp, 1, argv,
10877 "?level? command ?arg ...?");
10878 return JIM_ERR;
10879 }
10880 /* Eval the code in the target callframe. */
10881 interp->framePtr = targetCallFrame;
10882 oldLevel = interp->numLevels;
10883 interp->numLevels = newLevel;
10884 if (argc == 2) {
10885 retcode = Jim_EvalObj(interp, argv[1]);
10886 } else {
10887 objPtr = Jim_ConcatObj(interp, argc-1, argv+1);
10888 Jim_IncrRefCount(objPtr);
10889 retcode = Jim_EvalObj(interp, objPtr);
10890 Jim_DecrRefCount(interp, objPtr);
10891 }
10892 interp->numLevels = oldLevel;
10893 interp->framePtr = savedCallFrame;
10894 return retcode;
10895 } else {
10896 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
10897 return JIM_ERR;
10898 }
10899 }
10900
10901 /* [expr] */
10902 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc,
10903 Jim_Obj *const *argv)
10904 {
10905 Jim_Obj *exprResultPtr;
10906 int retcode;
10907
10908 if (argc == 2) {
10909 retcode = Jim_EvalExpression(interp, argv[1], &exprResultPtr);
10910 } else if (argc > 2) {
10911 Jim_Obj *objPtr;
10912
10913 objPtr = Jim_ConcatObj(interp, argc-1, argv+1);
10914 Jim_IncrRefCount(objPtr);
10915 retcode = Jim_EvalExpression(interp, objPtr, &exprResultPtr);
10916 Jim_DecrRefCount(interp, objPtr);
10917 } else {
10918 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
10919 return JIM_ERR;
10920 }
10921 if (retcode != JIM_OK) return retcode;
10922 Jim_SetResult(interp, exprResultPtr);
10923 Jim_DecrRefCount(interp, exprResultPtr);
10924 return JIM_OK;
10925 }
10926
10927 /* [break] */
10928 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc,
10929 Jim_Obj *const *argv)
10930 {
10931 if (argc != 1) {
10932 Jim_WrongNumArgs(interp, 1, argv, "");
10933 return JIM_ERR;
10934 }
10935 return JIM_BREAK;
10936 }
10937
10938 /* [continue] */
10939 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc,
10940 Jim_Obj *const *argv)
10941 {
10942 if (argc != 1) {
10943 Jim_WrongNumArgs(interp, 1, argv, "");
10944 return JIM_ERR;
10945 }
10946 return JIM_CONTINUE;
10947 }
10948
10949 /* [return] */
10950 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc,
10951 Jim_Obj *const *argv)
10952 {
10953 if (argc == 1) {
10954 return JIM_RETURN;
10955 } else if (argc == 2) {
10956 Jim_SetResult(interp, argv[1]);
10957 interp->returnCode = JIM_OK;
10958 return JIM_RETURN;
10959 } else if (argc == 3 || argc == 4) {
10960 int returnCode;
10961 if (Jim_GetReturnCode(interp, argv[2], &returnCode) == JIM_ERR)
10962 return JIM_ERR;
10963 interp->returnCode = returnCode;
10964 if (argc == 4)
10965 Jim_SetResult(interp, argv[3]);
10966 return JIM_RETURN;
10967 } else {
10968 Jim_WrongNumArgs(interp, 1, argv, "?-code code? ?result?");
10969 return JIM_ERR;
10970 }
10971 return JIM_RETURN; /* unreached */
10972 }
10973
10974 /* [tailcall] */
10975 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc,
10976 Jim_Obj *const *argv)
10977 {
10978 Jim_Obj *objPtr;
10979
10980 objPtr = Jim_NewListObj(interp, argv+1, argc-1);
10981 Jim_SetResult(interp, objPtr);
10982 return JIM_EVAL;
10983 }
10984
10985 /* [proc] */
10986 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc,
10987 Jim_Obj *const *argv)
10988 {
10989 int argListLen;
10990 int arityMin, arityMax;
10991
10992 if (argc != 4 && argc != 5) {
10993 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
10994 return JIM_ERR;
10995 }
10996 Jim_ListLength(interp, argv[2], &argListLen);
10997 arityMin = arityMax = argListLen+1;
10998
10999 if (argListLen) {
11000 const char *str;
11001 int len;
11002 Jim_Obj *argPtr;
11003
11004 /* Check for 'args' and adjust arityMin and arityMax if necessary */
11005 Jim_ListIndex(interp, argv[2], argListLen-1, &argPtr, JIM_NONE);
11006 str = Jim_GetString(argPtr, &len);
11007 if (len == 4 && memcmp(str, "args", 4) == 0) {
11008 arityMin--;
11009 arityMax = -1;
11010 }
11011
11012 /* Check for default arguments and reduce arityMin if necessary */
11013 while (arityMin > 1) {
11014 int len;
11015 Jim_ListIndex(interp, argv[2], arityMin - 2, &argPtr, JIM_NONE);
11016 Jim_ListLength(interp, argPtr, &len);
11017 if (len != 2) {
11018 /* No default argument */
11019 break;
11020 }
11021 arityMin--;
11022 }
11023 }
11024 if (argc == 4) {
11025 return Jim_CreateProcedure(interp, Jim_GetString(argv[1], NULL),
11026 argv[2], NULL, argv[3], arityMin, arityMax);
11027 } else {
11028 return Jim_CreateProcedure(interp, Jim_GetString(argv[1], NULL),
11029 argv[2], argv[3], argv[4], arityMin, arityMax);
11030 }
11031 }
11032
11033 /* [concat] */
11034 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc,
11035 Jim_Obj *const *argv)
11036 {
11037 Jim_SetResult(interp, Jim_ConcatObj(interp, argc-1, argv+1));
11038 return JIM_OK;
11039 }
11040
11041 /* [upvar] */
11042 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc,
11043 Jim_Obj *const *argv)
11044 {
11045 const char *str;
11046 int i;
11047 Jim_CallFrame *targetCallFrame;
11048
11049 /* Lookup the target frame pointer */
11050 str = Jim_GetString(argv[1], NULL);
11051 if (argc > 3 &&
11052 ((str[0] >= '0' && str[0] <= '9') || str[0] == '#'))
11053 {
11054 if (Jim_GetCallFrameByLevel(interp, argv[1],
11055 &targetCallFrame, NULL) != JIM_OK)
11056 return JIM_ERR;
11057 argc--;
11058 argv++;
11059 } else {
11060 if (Jim_GetCallFrameByLevel(interp, NULL,
11061 &targetCallFrame, NULL) != JIM_OK)
11062 return JIM_ERR;
11063 }
11064 /* Check for arity */
11065 if (argc < 3 || ((argc-1)%2) != 0) {
11066 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
11067 return JIM_ERR;
11068 }
11069 /* Now... for every other/local couple: */
11070 for (i = 1; i < argc; i += 2) {
11071 if (Jim_SetVariableLink(interp, argv[i+1], argv[i],
11072 targetCallFrame) != JIM_OK) return JIM_ERR;
11073 }
11074 return JIM_OK;
11075 }
11076
11077 /* [global] */
11078 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc,
11079 Jim_Obj *const *argv)
11080 {
11081 int i;
11082
11083 if (argc < 2) {
11084 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
11085 return JIM_ERR;
11086 }
11087 /* Link every var to the toplevel having the same name */
11088 if (interp->numLevels == 0) return JIM_OK; /* global at toplevel... */
11089 for (i = 1; i < argc; i++) {
11090 if (Jim_SetVariableLink(interp, argv[i], argv[i],
11091 interp->topFramePtr) != JIM_OK) return JIM_ERR;
11092 }
11093 return JIM_OK;
11094 }
11095
11096 /* does the [string map] operation. On error NULL is returned,
11097 * otherwise a new string object with the result, having refcount = 0,
11098 * is returned. */
11099 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
11100 Jim_Obj *objPtr, int nocase)
11101 {
11102 int numMaps;
11103 const char **key, *str, *noMatchStart = NULL;
11104 Jim_Obj **value;
11105 int *keyLen, strLen, i;
11106 Jim_Obj *resultObjPtr;
11107
11108 Jim_ListLength(interp, mapListObjPtr, &numMaps);
11109 if (numMaps % 2) {
11110 Jim_SetResultString(interp,
11111 "list must contain an even number of elements", -1);
11112 return NULL;
11113 }
11114 /* Initialization */
11115 numMaps /= 2;
11116 key = Jim_Alloc(sizeof(char*)*numMaps);
11117 keyLen = Jim_Alloc(sizeof(int)*numMaps);
11118 value = Jim_Alloc(sizeof(Jim_Obj*)*numMaps);
11119 resultObjPtr = Jim_NewStringObj(interp, "", 0);
11120 for (i = 0; i < numMaps; i++) {
11121 Jim_Obj *eleObjPtr;
11122
11123 Jim_ListIndex(interp, mapListObjPtr, i*2, &eleObjPtr, JIM_NONE);
11124 key[i] = Jim_GetString(eleObjPtr, &keyLen[i]);
11125 Jim_ListIndex(interp, mapListObjPtr, i*2+1, &eleObjPtr, JIM_NONE);
11126 value[i] = eleObjPtr;
11127 }
11128 str = Jim_GetString(objPtr, &strLen);
11129 /* Map it */
11130 while(strLen) {
11131 for (i = 0; i < numMaps; i++) {
11132 if (strLen >= keyLen[i] && keyLen[i]) {
11133 if (!JimStringCompare(str, keyLen[i], key[i], keyLen[i],
11134 nocase))
11135 {
11136 if (noMatchStart) {
11137 Jim_AppendString(interp, resultObjPtr,
11138 noMatchStart, str-noMatchStart);
11139 noMatchStart = NULL;
11140 }
11141 Jim_AppendObj(interp, resultObjPtr, value[i]);
11142 str += keyLen[i];
11143 strLen -= keyLen[i];
11144 break;
11145 }
11146 }
11147 }
11148 if (i == numMaps) { /* no match */
11149 if (noMatchStart == NULL)
11150 noMatchStart = str;
11151 str ++;
11152 strLen --;
11153 }
11154 }
11155 if (noMatchStart) {
11156 Jim_AppendString(interp, resultObjPtr,
11157 noMatchStart, str-noMatchStart);
11158 }
11159 Jim_Free((void*)key);
11160 Jim_Free(keyLen);
11161 Jim_Free(value);
11162 return resultObjPtr;
11163 }
11164
11165 /* [string] */
11166 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc,
11167 Jim_Obj *const *argv)
11168 {
11169 int option;
11170 const char *options[] = {
11171 "length", "compare", "match", "equal", "range", "map", "repeat",
11172 "index", "first", "tolower", "toupper", NULL
11173 };
11174 enum {
11175 OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_RANGE,
11176 OPT_MAP, OPT_REPEAT, OPT_INDEX, OPT_FIRST, OPT_TOLOWER, OPT_TOUPPER
11177 };
11178
11179 if (argc < 2) {
11180 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
11181 return JIM_ERR;
11182 }
11183 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
11184 JIM_ERRMSG) != JIM_OK)
11185 return JIM_ERR;
11186
11187 if (option == OPT_LENGTH) {
11188 int len;
11189
11190 if (argc != 3) {
11191 Jim_WrongNumArgs(interp, 2, argv, "string");
11192 return JIM_ERR;
11193 }
11194 Jim_GetString(argv[2], &len);
11195 Jim_SetResult(interp, Jim_NewIntObj(interp, len));
11196 return JIM_OK;
11197 } else if (option == OPT_COMPARE) {
11198 int nocase = 0;
11199 if ((argc != 4 && argc != 5) ||
11200 (argc == 5 && Jim_CompareStringImmediate(interp,
11201 argv[2], "-nocase") == 0)) {
11202 Jim_WrongNumArgs(interp, 2, argv, "string1 string2");
11203 return JIM_ERR;
11204 }
11205 if (argc == 5) {
11206 nocase = 1;
11207 argv++;
11208 }
11209 Jim_SetResult(interp, Jim_NewIntObj(interp,
11210 Jim_StringCompareObj(argv[2],
11211 argv[3], nocase)));
11212 return JIM_OK;
11213 } else if (option == OPT_MATCH) {
11214 int nocase = 0;
11215 if ((argc != 4 && argc != 5) ||
11216 (argc == 5 && Jim_CompareStringImmediate(interp,
11217 argv[2], "-nocase") == 0)) {
11218 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern "
11219 "string");
11220 return JIM_ERR;
11221 }
11222 if (argc == 5) {
11223 nocase = 1;
11224 argv++;
11225 }
11226 Jim_SetResult(interp,
11227 Jim_NewIntObj(interp, Jim_StringMatchObj(argv[2],
11228 argv[3], nocase)));
11229 return JIM_OK;
11230 } else if (option == OPT_EQUAL) {
11231 if (argc != 4) {
11232 Jim_WrongNumArgs(interp, 2, argv, "string1 string2");
11233 return JIM_ERR;
11234 }
11235 Jim_SetResult(interp,
11236 Jim_NewIntObj(interp, Jim_StringEqObj(argv[2],
11237 argv[3], 0)));
11238 return JIM_OK;
11239 } else if (option == OPT_RANGE) {
11240 Jim_Obj *objPtr;
11241
11242 if (argc != 5) {
11243 Jim_WrongNumArgs(interp, 2, argv, "string first last");
11244 return JIM_ERR;
11245 }
11246 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
11247 if (objPtr == NULL)
11248 return JIM_ERR;
11249 Jim_SetResult(interp, objPtr);
11250 return JIM_OK;
11251 } else if (option == OPT_MAP) {
11252 int nocase = 0;
11253 Jim_Obj *objPtr;
11254
11255 if ((argc != 4 && argc != 5) ||
11256 (argc == 5 && Jim_CompareStringImmediate(interp,
11257 argv[2], "-nocase") == 0)) {
11258 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList "
11259 "string");
11260 return JIM_ERR;
11261 }
11262 if (argc == 5) {
11263 nocase = 1;
11264 argv++;
11265 }
11266 objPtr = JimStringMap(interp, argv[2], argv[3], nocase);
11267 if (objPtr == NULL)
11268 return JIM_ERR;
11269 Jim_SetResult(interp, objPtr);
11270 return JIM_OK;
11271 } else if (option == OPT_REPEAT) {
11272 Jim_Obj *objPtr;
11273 jim_wide count;
11274
11275 if (argc != 4) {
11276 Jim_WrongNumArgs(interp, 2, argv, "string count");
11277 return JIM_ERR;
11278 }
11279 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK)
11280 return JIM_ERR;
11281 objPtr = Jim_NewStringObj(interp, "", 0);
11282 while (count--) {
11283 Jim_AppendObj(interp, objPtr, argv[2]);
11284 }
11285 Jim_SetResult(interp, objPtr);
11286 return JIM_OK;
11287 } else if (option == OPT_INDEX) {
11288 int index, len;
11289 const char *str;
11290
11291 if (argc != 4) {
11292 Jim_WrongNumArgs(interp, 2, argv, "string index");
11293 return JIM_ERR;
11294 }
11295 if (Jim_GetIndex(interp, argv[3], &index) != JIM_OK)
11296 return JIM_ERR;
11297 str = Jim_GetString(argv[2], &len);
11298 if (index != INT_MIN && index != INT_MAX)
11299 index = JimRelToAbsIndex(len, index);
11300 if (index < 0 || index >= len) {
11301 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11302 return JIM_OK;
11303 } else {
11304 Jim_SetResult(interp, Jim_NewStringObj(interp, str+index, 1));
11305 return JIM_OK;
11306 }
11307 } else if (option == OPT_FIRST) {
11308 int index = 0, l1, l2;
11309 const char *s1, *s2;
11310
11311 if (argc != 4 && argc != 5) {
11312 Jim_WrongNumArgs(interp, 2, argv, "subString string ?startIndex?");
11313 return JIM_ERR;
11314 }
11315 s1 = Jim_GetString(argv[2], &l1);
11316 s2 = Jim_GetString(argv[3], &l2);
11317 if (argc == 5) {
11318 if (Jim_GetIndex(interp, argv[4], &index) != JIM_OK)
11319 return JIM_ERR;
11320 index = JimRelToAbsIndex(l2, index);
11321 }
11322 Jim_SetResult(interp, Jim_NewIntObj(interp,
11323 JimStringFirst(s1, l1, s2, l2, index)));
11324 return JIM_OK;
11325 } else if (option == OPT_TOLOWER) {
11326 if (argc != 3) {
11327 Jim_WrongNumArgs(interp, 2, argv, "string");
11328 return JIM_ERR;
11329 }
11330 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
11331 } else if (option == OPT_TOUPPER) {
11332 if (argc != 3) {
11333 Jim_WrongNumArgs(interp, 2, argv, "string");
11334 return JIM_ERR;
11335 }
11336 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
11337 }
11338 return JIM_OK;
11339 }
11340
11341 /* [time] */
11342 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc,
11343 Jim_Obj *const *argv)
11344 {
11345 long i, count = 1;
11346 jim_wide start, elapsed;
11347 char buf [256];
11348 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
11349
11350 if (argc < 2) {
11351 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
11352 return JIM_ERR;
11353 }
11354 if (argc == 3) {
11355 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
11356 return JIM_ERR;
11357 }
11358 if (count < 0)
11359 return JIM_OK;
11360 i = count;
11361 start = JimClock();
11362 while (i-- > 0) {
11363 int retval;
11364
11365 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK)
11366 return retval;
11367 }
11368 elapsed = JimClock() - start;
11369 sprintf(buf, fmt, elapsed/count);
11370 Jim_SetResultString(interp, buf, -1);
11371 return JIM_OK;
11372 }
11373
11374 /* [exit] */
11375 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc,
11376 Jim_Obj *const *argv)
11377 {
11378 long exitCode = 0;
11379
11380 if (argc > 2) {
11381 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
11382 return JIM_ERR;
11383 }
11384 if (argc == 2) {
11385 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
11386 return JIM_ERR;
11387 }
11388 interp->exitCode = exitCode;
11389 return JIM_EXIT;
11390 }
11391
11392 /* [catch] */
11393 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc,
11394 Jim_Obj *const *argv)
11395 {
11396 int exitCode = 0;
11397
11398 if (argc != 2 && argc != 3) {
11399 Jim_WrongNumArgs(interp, 1, argv, "script ?varName?");
11400 return JIM_ERR;
11401 }
11402 exitCode = Jim_EvalObj(interp, argv[1]);
11403 if (argc == 3) {
11404 if (Jim_SetVariable(interp, argv[2], Jim_GetResult(interp))
11405 != JIM_OK)
11406 return JIM_ERR;
11407 }
11408 Jim_SetResult(interp, Jim_NewIntObj(interp, exitCode));
11409 return JIM_OK;
11410 }
11411
11412 /* [ref] */
11413 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc,
11414 Jim_Obj *const *argv)
11415 {
11416 if (argc != 3 && argc != 4) {
11417 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
11418 return JIM_ERR;
11419 }
11420 if (argc == 3) {
11421 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
11422 } else {
11423 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2],
11424 argv[3]));
11425 }
11426 return JIM_OK;
11427 }
11428
11429 /* [getref] */
11430 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc,
11431 Jim_Obj *const *argv)
11432 {
11433 Jim_Reference *refPtr;
11434
11435 if (argc != 2) {
11436 Jim_WrongNumArgs(interp, 1, argv, "reference");
11437 return JIM_ERR;
11438 }
11439 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
11440 return JIM_ERR;
11441 Jim_SetResult(interp, refPtr->objPtr);
11442 return JIM_OK;
11443 }
11444
11445 /* [setref] */
11446 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc,
11447 Jim_Obj *const *argv)
11448 {
11449 Jim_Reference *refPtr;
11450
11451 if (argc != 3) {
11452 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
11453 return JIM_ERR;
11454 }
11455 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
11456 return JIM_ERR;
11457 Jim_IncrRefCount(argv[2]);
11458 Jim_DecrRefCount(interp, refPtr->objPtr);
11459 refPtr->objPtr = argv[2];
11460 Jim_SetResult(interp, argv[2]);
11461 return JIM_OK;
11462 }
11463
11464 /* [collect] */
11465 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc,
11466 Jim_Obj *const *argv)
11467 {
11468 if (argc != 1) {
11469 Jim_WrongNumArgs(interp, 1, argv, "");
11470 return JIM_ERR;
11471 }
11472 Jim_SetResult(interp, Jim_NewIntObj(interp, Jim_Collect(interp)));
11473 return JIM_OK;
11474 }
11475
11476 /* [finalize] reference ?newValue? */
11477 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc,
11478 Jim_Obj *const *argv)
11479 {
11480 if (argc != 2 && argc != 3) {
11481 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
11482 return JIM_ERR;
11483 }
11484 if (argc == 2) {
11485 Jim_Obj *cmdNamePtr;
11486
11487 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
11488 return JIM_ERR;
11489 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
11490 Jim_SetResult(interp, cmdNamePtr);
11491 } else {
11492 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
11493 return JIM_ERR;
11494 Jim_SetResult(interp, argv[2]);
11495 }
11496 return JIM_OK;
11497 }
11498
11499 /* TODO */
11500 /* [info references] (list of all the references/finalizers) */
11501
11502 /* [rename] */
11503 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc,
11504 Jim_Obj *const *argv)
11505 {
11506 const char *oldName, *newName;
11507
11508 if (argc != 3) {
11509 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
11510 return JIM_ERR;
11511 }
11512 oldName = Jim_GetString(argv[1], NULL);
11513 newName = Jim_GetString(argv[2], NULL);
11514 if (Jim_RenameCommand(interp, oldName, newName) != JIM_OK) {
11515 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11516 Jim_AppendStrings(interp, Jim_GetResult(interp),
11517 "can't rename \"", oldName, "\": ",
11518 "command doesn't exist", NULL);
11519 return JIM_ERR;
11520 }
11521 return JIM_OK;
11522 }
11523
11524 /* [dict] */
11525 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc,
11526 Jim_Obj *const *argv)
11527 {
11528 int option;
11529 const char *options[] = {
11530 "create", "get", "set", "unset", "exists", NULL
11531 };
11532 enum {
11533 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXIST
11534 };
11535
11536 if (argc < 2) {
11537 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
11538 return JIM_ERR;
11539 }
11540
11541 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
11542 JIM_ERRMSG) != JIM_OK)
11543 return JIM_ERR;
11544
11545 if (option == OPT_CREATE) {
11546 Jim_Obj *objPtr;
11547
11548 if (argc % 2) {
11549 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
11550 return JIM_ERR;
11551 }
11552 objPtr = Jim_NewDictObj(interp, argv+2, argc-2);
11553 Jim_SetResult(interp, objPtr);
11554 return JIM_OK;
11555 } else if (option == OPT_GET) {
11556 Jim_Obj *objPtr;
11557
11558 if (Jim_DictKeysVector(interp, argv[2], argv+3, argc-3, &objPtr,
11559 JIM_ERRMSG) != JIM_OK)
11560 return JIM_ERR;
11561 Jim_SetResult(interp, objPtr);
11562 return JIM_OK;
11563 } else if (option == OPT_SET) {
11564 if (argc < 5) {
11565 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
11566 return JIM_ERR;
11567 }
11568 return Jim_SetDictKeysVector(interp, argv[2], argv+3, argc-4,
11569 argv[argc-1]);
11570 } else if (option == OPT_UNSET) {
11571 if (argc < 4) {
11572 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
11573 return JIM_ERR;
11574 }
11575 return Jim_SetDictKeysVector(interp, argv[2], argv+3, argc-3,
11576 NULL);
11577 } else if (option == OPT_EXIST) {
11578 Jim_Obj *objPtr;
11579 int exists;
11580
11581 if (Jim_DictKeysVector(interp, argv[2], argv+3, argc-3, &objPtr,
11582 JIM_ERRMSG) == JIM_OK)
11583 exists = 1;
11584 else
11585 exists = 0;
11586 Jim_SetResult(interp, Jim_NewIntObj(interp, exists));
11587 return JIM_OK;
11588 } else {
11589 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11590 Jim_AppendStrings(interp, Jim_GetResult(interp),
11591 "bad option \"", Jim_GetString(argv[1], NULL), "\":",
11592 " must be create, get, set", NULL);
11593 return JIM_ERR;
11594 }
11595 return JIM_OK;
11596 }
11597
11598 /* [load] */
11599 static int Jim_LoadCoreCommand(Jim_Interp *interp, int argc,
11600 Jim_Obj *const *argv)
11601 {
11602 if (argc < 2) {
11603 Jim_WrongNumArgs(interp, 1, argv, "libaryFile");
11604 return JIM_ERR;
11605 }
11606 return Jim_LoadLibrary(interp, Jim_GetString(argv[1], NULL));
11607 }
11608
11609 /* [subst] */
11610 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc,
11611 Jim_Obj *const *argv)
11612 {
11613 int i, flags = 0;
11614 Jim_Obj *objPtr;
11615
11616 if (argc < 2) {
11617 Jim_WrongNumArgs(interp, 1, argv,
11618 "?-nobackslashes? ?-nocommands? ?-novariables? string");
11619 return JIM_ERR;
11620 }
11621 i = argc-2;
11622 while(i--) {
11623 if (Jim_CompareStringImmediate(interp, argv[i+1],
11624 "-nobackslashes"))
11625 flags |= JIM_SUBST_NOESC;
11626 else if (Jim_CompareStringImmediate(interp, argv[i+1],
11627 "-novariables"))
11628 flags |= JIM_SUBST_NOVAR;
11629 else if (Jim_CompareStringImmediate(interp, argv[i+1],
11630 "-nocommands"))
11631 flags |= JIM_SUBST_NOCMD;
11632 else {
11633 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11634 Jim_AppendStrings(interp, Jim_GetResult(interp),
11635 "bad option \"", Jim_GetString(argv[i+1], NULL),
11636 "\": must be -nobackslashes, -nocommands, or "
11637 "-novariables", NULL);
11638 return JIM_ERR;
11639 }
11640 }
11641 if (Jim_SubstObj(interp, argv[argc-1], &objPtr, flags) != JIM_OK)
11642 return JIM_ERR;
11643 Jim_SetResult(interp, objPtr);
11644 return JIM_OK;
11645 }
11646
11647 /* [info] */
11648 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc,
11649 Jim_Obj *const *argv)
11650 {
11651 int cmd, result = JIM_OK;
11652 static const char *commands[] = {
11653 "body", "commands", "exists", "globals", "level", "locals",
11654 "vars", "version", "complete", "args", "hostname", NULL
11655 };
11656 enum {INFO_BODY, INFO_COMMANDS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
11657 INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_COMPLETE, INFO_ARGS, INFO_HOSTNAME};
11658
11659 if (argc < 2) {
11660 Jim_WrongNumArgs(interp, 1, argv, "command ?args ...?");
11661 return JIM_ERR;
11662 }
11663 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "command", JIM_ERRMSG)
11664 != JIM_OK) {
11665 return JIM_ERR;
11666 }
11667
11668 if (cmd == INFO_COMMANDS) {
11669 if (argc != 2 && argc != 3) {
11670 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
11671 return JIM_ERR;
11672 }
11673 if (argc == 3)
11674 Jim_SetResult(interp,JimCommandsList(interp, argv[2]));
11675 else
11676 Jim_SetResult(interp, JimCommandsList(interp, NULL));
11677 } else if (cmd == INFO_EXISTS) {
11678 Jim_Obj *exists;
11679 if (argc != 3) {
11680 Jim_WrongNumArgs(interp, 2, argv, "varName");
11681 return JIM_ERR;
11682 }
11683 exists = Jim_GetVariable(interp, argv[2], 0);
11684 Jim_SetResult(interp, Jim_NewIntObj(interp, exists != 0));
11685 } else if (cmd == INFO_GLOBALS || cmd == INFO_LOCALS || cmd == INFO_VARS) {
11686 int mode;
11687 switch (cmd) {
11688 case INFO_GLOBALS: mode = JIM_VARLIST_GLOBALS; break;
11689 case INFO_LOCALS: mode = JIM_VARLIST_LOCALS; break;
11690 case INFO_VARS: mode = JIM_VARLIST_VARS; break;
11691 default: mode = 0; /* avoid warning */; break;
11692 }
11693 if (argc != 2 && argc != 3) {
11694 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
11695 return JIM_ERR;
11696 }
11697 if (argc == 3)
11698 Jim_SetResult(interp,JimVariablesList(interp, argv[2], mode));
11699 else
11700 Jim_SetResult(interp, JimVariablesList(interp, NULL, mode));
11701 } else if (cmd == INFO_LEVEL) {
11702 Jim_Obj *objPtr;
11703 switch (argc) {
11704 case 2:
11705 Jim_SetResult(interp,
11706 Jim_NewIntObj(interp, interp->numLevels));
11707 break;
11708 case 3:
11709 if (JimInfoLevel(interp, argv[2], &objPtr) != JIM_OK)
11710 return JIM_ERR;
11711 Jim_SetResult(interp, objPtr);
11712 break;
11713 default:
11714 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
11715 return JIM_ERR;
11716 }
11717 } else if (cmd == INFO_BODY || cmd == INFO_ARGS) {
11718 Jim_Cmd *cmdPtr;
11719
11720 if (argc != 3) {
11721 Jim_WrongNumArgs(interp, 2, argv, "procname");
11722 return JIM_ERR;
11723 }
11724 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL)
11725 return JIM_ERR;
11726 if (cmdPtr->cmdProc != NULL) {
11727 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11728 Jim_AppendStrings(interp, Jim_GetResult(interp),
11729 "command \"", Jim_GetString(argv[2], NULL),
11730 "\" is not a procedure", NULL);
11731 return JIM_ERR;
11732 }
11733 if (cmd == INFO_BODY)
11734 Jim_SetResult(interp, cmdPtr->bodyObjPtr);
11735 else
11736 Jim_SetResult(interp, cmdPtr->argListObjPtr);
11737 } else if (cmd == INFO_VERSION) {
11738 char buf[(JIM_INTEGER_SPACE * 2) + 1];
11739 sprintf(buf, "%d.%d",
11740 JIM_VERSION / 100, JIM_VERSION % 100);
11741 Jim_SetResultString(interp, buf, -1);
11742 } else if (cmd == INFO_COMPLETE) {
11743 const char *s;
11744 int len;
11745
11746 if (argc != 3) {
11747 Jim_WrongNumArgs(interp, 2, argv, "script");
11748 return JIM_ERR;
11749 }
11750 s = Jim_GetString(argv[2], &len);
11751 Jim_SetResult(interp,
11752 Jim_NewIntObj(interp, Jim_ScriptIsComplete(s, len, NULL)));
11753 } else if (cmd == INFO_HOSTNAME) {
11754 /* Redirect to os.hostname if it exists */
11755 Jim_Obj *command = Jim_NewStringObj(interp, "os.gethostname", -1);
11756 result = Jim_EvalObjVector(interp, 1, &command);
11757 }
11758 return result;
11759 }
11760
11761 /* [split] */
11762 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc,
11763 Jim_Obj *const *argv)
11764 {
11765 const char *str, *splitChars, *noMatchStart;
11766 int splitLen, strLen, i;
11767 Jim_Obj *resObjPtr;
11768
11769 if (argc != 2 && argc != 3) {
11770 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
11771 return JIM_ERR;
11772 }
11773 /* Init */
11774 if (argc == 2) {
11775 splitChars = " \n\t\r";
11776 splitLen = 4;
11777 } else {
11778 splitChars = Jim_GetString(argv[2], &splitLen);
11779 }
11780 str = Jim_GetString(argv[1], &strLen);
11781 if (!strLen) return JIM_OK;
11782 noMatchStart = str;
11783 resObjPtr = Jim_NewListObj(interp, NULL, 0);
11784 /* Split */
11785 if (splitLen) {
11786 while (strLen) {
11787 for (i = 0; i < splitLen; i++) {
11788 if (*str == splitChars[i]) {
11789 Jim_Obj *objPtr;
11790
11791 objPtr = Jim_NewStringObj(interp, noMatchStart,
11792 (str-noMatchStart));
11793 Jim_ListAppendElement(interp, resObjPtr, objPtr);
11794 noMatchStart = str+1;
11795 break;
11796 }
11797 }
11798 str ++;
11799 strLen --;
11800 }
11801 Jim_ListAppendElement(interp, resObjPtr,
11802 Jim_NewStringObj(interp, noMatchStart, (str-noMatchStart)));
11803 } else {
11804 /* This handles the special case of splitchars eq {}. This
11805 * is trivial but we want to perform object sharing as Tcl does. */
11806 Jim_Obj *objCache[256];
11807 const unsigned char *u = (unsigned char*) str;
11808 memset(objCache, 0, sizeof(objCache));
11809 for (i = 0; i < strLen; i++) {
11810 int c = u[i];
11811
11812 if (objCache[c] == NULL)
11813 objCache[c] = Jim_NewStringObj(interp, (char*)u+i, 1);
11814 Jim_ListAppendElement(interp, resObjPtr, objCache[c]);
11815 }
11816 }
11817 Jim_SetResult(interp, resObjPtr);
11818 return JIM_OK;
11819 }
11820
11821 /* [join] */
11822 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc,
11823 Jim_Obj *const *argv)
11824 {
11825 const char *joinStr;
11826 int joinStrLen, i, listLen;
11827 Jim_Obj *resObjPtr;
11828
11829 if (argc != 2 && argc != 3) {
11830 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
11831 return JIM_ERR;
11832 }
11833 /* Init */
11834 if (argc == 2) {
11835 joinStr = " ";
11836 joinStrLen = 1;
11837 } else {
11838 joinStr = Jim_GetString(argv[2], &joinStrLen);
11839 }
11840 Jim_ListLength(interp, argv[1], &listLen);
11841 resObjPtr = Jim_NewStringObj(interp, NULL, 0);
11842 /* Split */
11843 for (i = 0; i < listLen; i++) {
11844 Jim_Obj *objPtr;
11845
11846 Jim_ListIndex(interp, argv[1], i, &objPtr, JIM_NONE);
11847 Jim_AppendObj(interp, resObjPtr, objPtr);
11848 if (i+1 != listLen) {
11849 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
11850 }
11851 }
11852 Jim_SetResult(interp, resObjPtr);
11853 return JIM_OK;
11854 }
11855
11856 /* [format] */
11857 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc,
11858 Jim_Obj *const *argv)
11859 {
11860 Jim_Obj *objPtr;
11861
11862 if (argc < 2) {
11863 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
11864 return JIM_ERR;
11865 }
11866 objPtr = Jim_FormatString(interp, argv[1], argc-2, argv+2);
11867 if (objPtr == NULL)
11868 return JIM_ERR;
11869 Jim_SetResult(interp, objPtr);
11870 return JIM_OK;
11871 }
11872
11873 /* [scan] */
11874 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc,
11875 Jim_Obj *const *argv)
11876 {
11877 Jim_Obj *listPtr, **outVec;
11878 int outc, i, count = 0;
11879
11880 if (argc < 3) {
11881 Jim_WrongNumArgs(interp, 1, argv, "string formatString ?varName ...?");
11882 return JIM_ERR;
11883 }
11884 if (argv[2]->typePtr != &scanFmtStringObjType)
11885 SetScanFmtFromAny(interp, argv[2]);
11886 if (FormatGetError(argv[2]) != 0) {
11887 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
11888 return JIM_ERR;
11889 }
11890 if (argc > 3) {
11891 int maxPos = FormatGetMaxPos(argv[2]);
11892 int count = FormatGetCnvCount(argv[2]);
11893 if (maxPos > argc-3) {
11894 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
11895 return JIM_ERR;
11896 } else if (count != 0 && count < argc-3) {
11897 Jim_SetResultString(interp, "variable is not assigned by any "
11898 "conversion specifiers", -1);
11899 return JIM_ERR;
11900 } else if (count > argc-3) {
11901 Jim_SetResultString(interp, "different numbers of variable names and "
11902 "field specifiers", -1);
11903 return JIM_ERR;
11904 }
11905 }
11906 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
11907 if (listPtr == 0)
11908 return JIM_ERR;
11909 if (argc > 3) {
11910 int len = 0;
11911 if (listPtr != 0 && listPtr != (Jim_Obj*)EOF)
11912 Jim_ListLength(interp, listPtr, &len);
11913 if (listPtr == (Jim_Obj*)EOF || len == 0) { // XXX
11914 Jim_SetResult(interp, Jim_NewIntObj(interp, -1));
11915 return JIM_OK;
11916 }
11917 JimListGetElements(interp, listPtr, &outc, &outVec);
11918 for (i = 0; i < outc; ++i) {
11919 if (Jim_Length(outVec[i]) > 0) {
11920 ++count;
11921 if (Jim_SetVariable(interp, argv[3+i], outVec[i]) != JIM_OK)
11922 goto err;
11923 }
11924 }
11925 Jim_FreeNewObj(interp, listPtr);
11926 Jim_SetResult(interp, Jim_NewIntObj(interp, count));
11927 } else {
11928 if (listPtr == (Jim_Obj*)EOF) {
11929 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
11930 return JIM_OK;
11931 }
11932 Jim_SetResult(interp, listPtr);
11933 }
11934 return JIM_OK;
11935 err:
11936 Jim_FreeNewObj(interp, listPtr);
11937 return JIM_ERR;
11938 }
11939
11940 /* [error] */
11941 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc,
11942 Jim_Obj *const *argv)
11943 {
11944 if (argc != 2) {
11945 Jim_WrongNumArgs(interp, 1, argv, "message");
11946 return JIM_ERR;
11947 }
11948 Jim_SetResult(interp, argv[1]);
11949 return JIM_ERR;
11950 }
11951
11952 /* [lrange] */
11953 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc,
11954 Jim_Obj *const *argv)
11955 {
11956 Jim_Obj *objPtr;
11957
11958 if (argc != 4) {
11959 Jim_WrongNumArgs(interp, 1, argv, "list first last");
11960 return JIM_ERR;
11961 }
11962 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
11963 return JIM_ERR;
11964 Jim_SetResult(interp, objPtr);
11965 return JIM_OK;
11966 }
11967
11968 /* [env] */
11969 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc,
11970 Jim_Obj *const *argv)
11971 {
11972 const char *key;
11973 char *val;
11974
11975 if (argc == 1) {
11976 extern char **environ;
11977
11978 int i;
11979 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
11980
11981 for (i = 0; environ[i]; i++) {
11982 const char *equals = strchr(environ[i], '=');
11983 if (equals) {
11984 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, environ[i], equals - environ[i]));
11985 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
11986 }
11987 }
11988
11989 Jim_SetResult(interp, listObjPtr);
11990 return JIM_OK;
11991 }
11992
11993 if (argc != 2) {
11994 Jim_WrongNumArgs(interp, 1, argv, "varName");
11995 return JIM_ERR;
11996 }
11997 key = Jim_GetString(argv[1], NULL);
11998 val = getenv(key);
11999 if (val == NULL) {
12000 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
12001 Jim_AppendStrings(interp, Jim_GetResult(interp),
12002 "environment variable \"",
12003 key, "\" does not exist", NULL);
12004 return JIM_ERR;
12005 }
12006 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
12007 return JIM_OK;
12008 }
12009
12010 /* [source] */
12011 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc,
12012 Jim_Obj *const *argv)
12013 {
12014 int retval;
12015
12016 if (argc != 2) {
12017 Jim_WrongNumArgs(interp, 1, argv, "fileName");
12018 return JIM_ERR;
12019 }
12020 retval = Jim_EvalFile(interp, Jim_GetString(argv[1], NULL));
12021 if (retval == JIM_ERR) {
12022 return JIM_ERR_ADDSTACK;
12023 }
12024 if (retval == JIM_RETURN)
12025 return JIM_OK;
12026 return retval;
12027 }
12028
12029 /* [lreverse] */
12030 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc,
12031 Jim_Obj *const *argv)
12032 {
12033 Jim_Obj *revObjPtr, **ele;
12034 int len;
12035
12036 if (argc != 2) {
12037 Jim_WrongNumArgs(interp, 1, argv, "list");
12038 return JIM_ERR;
12039 }
12040 JimListGetElements(interp, argv[1], &len, &ele);
12041 len--;
12042 revObjPtr = Jim_NewListObj(interp, NULL, 0);
12043 while (len >= 0)
12044 ListAppendElement(revObjPtr, ele[len--]);
12045 Jim_SetResult(interp, revObjPtr);
12046 return JIM_OK;
12047 }
12048
12049 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
12050 {
12051 jim_wide len;
12052
12053 if (step == 0) return -1;
12054 if (start == end) return 0;
12055 else if (step > 0 && start > end) return -1;
12056 else if (step < 0 && end > start) return -1;
12057 len = end-start;
12058 if (len < 0) len = -len; /* abs(len) */
12059 if (step < 0) step = -step; /* abs(step) */
12060 len = 1 + ((len-1)/step);
12061 /* We can truncate safely to INT_MAX, the range command
12062 * will always return an error for a such long range
12063 * because Tcl lists can't be so long. */
12064 if (len > INT_MAX) len = INT_MAX;
12065 return (int)((len < 0) ? -1 : len);
12066 }
12067
12068 /* [range] */
12069 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc,
12070 Jim_Obj *const *argv)
12071 {
12072 jim_wide start = 0, end, step = 1;
12073 int len, i;
12074 Jim_Obj *objPtr;
12075
12076 if (argc < 2 || argc > 4) {
12077 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
12078 return JIM_ERR;
12079 }
12080 if (argc == 2) {
12081 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
12082 return JIM_ERR;
12083 } else {
12084 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
12085 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
12086 return JIM_ERR;
12087 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
12088 return JIM_ERR;
12089 }
12090 if ((len = JimRangeLen(start, end, step)) == -1) {
12091 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
12092 return JIM_ERR;
12093 }
12094 objPtr = Jim_NewListObj(interp, NULL, 0);
12095 for (i = 0; i < len; i++)
12096 ListAppendElement(objPtr, Jim_NewIntObj(interp, start+i*step));
12097 Jim_SetResult(interp, objPtr);
12098 return JIM_OK;
12099 }
12100
12101 /* [rand] */
12102 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc,
12103 Jim_Obj *const *argv)
12104 {
12105 jim_wide min = 0, max, len, maxMul;
12106
12107 if (argc < 1 || argc > 3) {
12108 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
12109 return JIM_ERR;
12110 }
12111 if (argc == 1) {
12112 max = JIM_WIDE_MAX;
12113 } else if (argc == 2) {
12114 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
12115 return JIM_ERR;
12116 } else if (argc == 3) {
12117 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
12118 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
12119 return JIM_ERR;
12120 }
12121 len = max-min;
12122 if (len < 0) {
12123 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
12124 return JIM_ERR;
12125 }
12126 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
12127 while (1) {
12128 jim_wide r;
12129
12130 JimRandomBytes(interp, &r, sizeof(jim_wide));
12131 if (r < 0 || r >= maxMul) continue;
12132 r = (len == 0) ? 0 : r%len;
12133 Jim_SetResult(interp, Jim_NewIntObj(interp, min+r));
12134 return JIM_OK;
12135 }
12136 }
12137
12138 /* [package] */
12139 static int Jim_PackageCoreCommand(Jim_Interp *interp, int argc,
12140 Jim_Obj *const *argv)
12141 {
12142 int option;
12143 const char *options[] = {
12144 "require", "provide", NULL
12145 };
12146 enum {OPT_REQUIRE, OPT_PROVIDE};
12147
12148 if (argc < 2) {
12149 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
12150 return JIM_ERR;
12151 }
12152 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
12153 JIM_ERRMSG) != JIM_OK)
12154 return JIM_ERR;
12155
12156 if (option == OPT_REQUIRE) {
12157 int exact = 0;
12158 const char *ver;
12159
12160 if (Jim_CompareStringImmediate(interp, argv[2], "-exact")) {
12161 exact = 1;
12162 argv++;
12163 argc--;
12164 }
12165 if (argc != 3 && argc != 4) {
12166 Jim_WrongNumArgs(interp, 2, argv, "?-exact? package ?version?");
12167 return JIM_ERR;
12168 }
12169 ver = Jim_PackageRequire(interp, Jim_GetString(argv[2], NULL),
12170 argc == 4 ? Jim_GetString(argv[3], NULL) : "",
12171 JIM_ERRMSG);
12172 if (ver == NULL)
12173 return JIM_ERR_ADDSTACK;
12174 Jim_SetResultString(interp, ver, -1);
12175 } else if (option == OPT_PROVIDE) {
12176 if (argc != 4) {
12177 Jim_WrongNumArgs(interp, 2, argv, "package version");
12178 return JIM_ERR;
12179 }
12180 return Jim_PackageProvide(interp, Jim_GetString(argv[2], NULL),
12181 Jim_GetString(argv[3], NULL), JIM_ERRMSG);
12182 }
12183 return JIM_OK;
12184 }
12185
12186 static struct {
12187 const char *name;
12188 Jim_CmdProc cmdProc;
12189 } Jim_CoreCommandsTable[] = {
12190 {"set", Jim_SetCoreCommand},
12191 {"unset", Jim_UnsetCoreCommand},
12192 {"puts", Jim_PutsCoreCommand},
12193 {"+", Jim_AddCoreCommand},
12194 {"*", Jim_MulCoreCommand},
12195 {"-", Jim_SubCoreCommand},
12196 {"/", Jim_DivCoreCommand},
12197 {"incr", Jim_IncrCoreCommand},
12198 {"while", Jim_WhileCoreCommand},
12199 {"for", Jim_ForCoreCommand},
12200 {"foreach", Jim_ForeachCoreCommand},
12201 {"lmap", Jim_LmapCoreCommand},
12202 {"if", Jim_IfCoreCommand},
12203 {"switch", Jim_SwitchCoreCommand},
12204 {"list", Jim_ListCoreCommand},
12205 {"lindex", Jim_LindexCoreCommand},
12206 {"lset", Jim_LsetCoreCommand},
12207 {"llength", Jim_LlengthCoreCommand},
12208 {"lappend", Jim_LappendCoreCommand},
12209 {"linsert", Jim_LinsertCoreCommand},
12210 {"lsort", Jim_LsortCoreCommand},
12211 {"append", Jim_AppendCoreCommand},
12212 {"debug", Jim_DebugCoreCommand},
12213 {"eval", Jim_EvalCoreCommand},
12214 {"uplevel", Jim_UplevelCoreCommand},
12215 {"expr", Jim_ExprCoreCommand},
12216 {"break", Jim_BreakCoreCommand},
12217 {"continue", Jim_ContinueCoreCommand},
12218 {"proc", Jim_ProcCoreCommand},
12219 {"concat", Jim_ConcatCoreCommand},
12220 {"return", Jim_ReturnCoreCommand},
12221 {"upvar", Jim_UpvarCoreCommand},
12222 {"global", Jim_GlobalCoreCommand},
12223 {"string", Jim_StringCoreCommand},
12224 {"time", Jim_TimeCoreCommand},
12225 {"exit", Jim_ExitCoreCommand},
12226 {"catch", Jim_CatchCoreCommand},
12227 {"ref", Jim_RefCoreCommand},
12228 {"getref", Jim_GetrefCoreCommand},
12229 {"setref", Jim_SetrefCoreCommand},
12230 {"finalize", Jim_FinalizeCoreCommand},
12231 {"collect", Jim_CollectCoreCommand},
12232 {"rename", Jim_RenameCoreCommand},
12233 {"dict", Jim_DictCoreCommand},
12234 {"load", Jim_LoadCoreCommand},
12235 {"subst", Jim_SubstCoreCommand},
12236 {"info", Jim_InfoCoreCommand},
12237 {"split", Jim_SplitCoreCommand},
12238 {"join", Jim_JoinCoreCommand},
12239 {"format", Jim_FormatCoreCommand},
12240 {"scan", Jim_ScanCoreCommand},
12241 {"error", Jim_ErrorCoreCommand},
12242 {"lrange", Jim_LrangeCoreCommand},
12243 {"env", Jim_EnvCoreCommand},
12244 {"source", Jim_SourceCoreCommand},
12245 {"lreverse", Jim_LreverseCoreCommand},
12246 {"range", Jim_RangeCoreCommand},
12247 {"rand", Jim_RandCoreCommand},
12248 {"package", Jim_PackageCoreCommand},
12249 {"tailcall", Jim_TailcallCoreCommand},
12250 {NULL, NULL},
12251 };
12252
12253 /* Some Jim core command is actually a procedure written in Jim itself. */
12254 static void Jim_RegisterCoreProcedures(Jim_Interp *interp)
12255 {
12256 Jim_Eval(interp, (char*)
12257 "proc lambda {arglist args} {\n"
12258 " set name [ref {} function lambdaFinalizer]\n"
12259 " uplevel 1 [list proc $name $arglist {expand}$args]\n"
12260 " return $name\n"
12261 "}\n"
12262 "proc lambdaFinalizer {name val} {\n"
12263 " rename $name {}\n"
12264 "}\n"
12265 );
12266 }
12267
12268 void Jim_RegisterCoreCommands(Jim_Interp *interp)
12269 {
12270 int i = 0;
12271
12272 while(Jim_CoreCommandsTable[i].name != NULL) {
12273 Jim_CreateCommand(interp,
12274 Jim_CoreCommandsTable[i].name,
12275 Jim_CoreCommandsTable[i].cmdProc,
12276 NULL, NULL);
12277 i++;
12278 }
12279 Jim_RegisterCoreProcedures(interp);
12280 }
12281
12282 /* -----------------------------------------------------------------------------
12283 * Interactive prompt
12284 * ---------------------------------------------------------------------------*/
12285 void Jim_PrintErrorMessage(Jim_Interp *interp)
12286 {
12287 int len, i;
12288
12289 if (*interp->errorFileName) {
12290 Jim_fprintf(interp, interp->cookie_stderr, "Runtime error, file \"%s\", line %d:" JIM_NL " ",
12291 interp->errorFileName, interp->errorLine);
12292 }
12293 Jim_fprintf(interp,interp->cookie_stderr, "%s" JIM_NL,
12294 Jim_GetString(interp->result, NULL));
12295 Jim_ListLength(interp, interp->stackTrace, &len);
12296 for (i = len-3; i >= 0; i-= 3) {
12297 Jim_Obj *objPtr;
12298 const char *proc, *file, *line;
12299
12300 Jim_ListIndex(interp, interp->stackTrace, i, &objPtr, JIM_NONE);
12301 proc = Jim_GetString(objPtr, NULL);
12302 Jim_ListIndex(interp, interp->stackTrace, i+1, &objPtr,
12303 JIM_NONE);
12304 file = Jim_GetString(objPtr, NULL);
12305 Jim_ListIndex(interp, interp->stackTrace, i+2, &objPtr,
12306 JIM_NONE);
12307 line = Jim_GetString(objPtr, NULL);
12308 if (*proc) {
12309 Jim_fprintf( interp, interp->cookie_stderr,
12310 "in procedure '%s' ", proc);
12311 }
12312 if (*file) {
12313 Jim_fprintf( interp, interp->cookie_stderr,
12314 "called at file \"%s\", line %s",
12315 file, line);
12316 }
12317 if (*file || *proc) {
12318 Jim_fprintf( interp, interp->cookie_stderr, JIM_NL);
12319 }
12320 }
12321 }
12322
12323 int Jim_InteractivePrompt(Jim_Interp *interp)
12324 {
12325 int retcode = JIM_OK;
12326 Jim_Obj *scriptObjPtr;
12327
12328 Jim_fprintf(interp,interp->cookie_stdout, "Welcome to Jim version %d.%d, "
12329 "Copyright (c) 2005-8 Salvatore Sanfilippo" JIM_NL,
12330 JIM_VERSION / 100, JIM_VERSION % 100);
12331 Jim_SetVariableStrWithStr(interp, "jim_interactive", "1");
12332 while (1) {
12333 char buf[1024];
12334 const char *result;
12335 const char *retcodestr[] = {
12336 "ok", "error", "return", "break", "continue", "eval", "exit"
12337 };
12338 int reslen;
12339
12340 if (retcode != 0) {
12341 if (retcode >= 2 && retcode <= 6)
12342 Jim_fprintf(interp,interp->cookie_stdout, "[%s] . ", retcodestr[retcode]);
12343 else
12344 Jim_fprintf(interp,interp->cookie_stdout, "[%d] . ", retcode);
12345 } else
12346 Jim_fprintf( interp, interp->cookie_stdout, ". ");
12347 Jim_fflush( interp, interp->cookie_stdout);
12348 scriptObjPtr = Jim_NewStringObj(interp, "", 0);
12349 Jim_IncrRefCount(scriptObjPtr);
12350 while(1) {
12351 const char *str;
12352 char state;
12353 int len;
12354
12355 if ( Jim_fgets(interp, buf, 1024, interp->cookie_stdin) == NULL) {
12356 Jim_DecrRefCount(interp, scriptObjPtr);
12357 goto out;
12358 }
12359 Jim_AppendString(interp, scriptObjPtr, buf, -1);
12360 str = Jim_GetString(scriptObjPtr, &len);
12361 if (Jim_ScriptIsComplete(str, len, &state))
12362 break;
12363 Jim_fprintf( interp, interp->cookie_stdout, "%c> ", state);
12364 Jim_fflush( interp, interp->cookie_stdout);
12365 }
12366 retcode = Jim_EvalObj(interp, scriptObjPtr);
12367 Jim_DecrRefCount(interp, scriptObjPtr);
12368 result = Jim_GetString(Jim_GetResult(interp), &reslen);
12369 if (retcode == JIM_ERR) {
12370 Jim_PrintErrorMessage(interp);
12371 } else if (retcode == JIM_EXIT) {
12372 exit(Jim_GetExitCode(interp));
12373 } else {
12374 if (reslen) {
12375 Jim_fwrite( interp, result, 1, reslen, interp->cookie_stdout);
12376 Jim_fprintf( interp,interp->cookie_stdout, JIM_NL);
12377 }
12378 }
12379 }
12380 out:
12381 return 0;
12382 }
12383
12384 /* -----------------------------------------------------------------------------
12385 * Jim's idea of STDIO..
12386 * ---------------------------------------------------------------------------*/
12387
12388 int Jim_fprintf( Jim_Interp *interp, void *cookie, const char *fmt, ... )
12389 {
12390 int r;
12391
12392 va_list ap;
12393 va_start(ap,fmt);
12394 r = Jim_vfprintf( interp, cookie, fmt,ap );
12395 va_end(ap);
12396 return r;
12397 }
12398
12399 int Jim_vfprintf( Jim_Interp *interp, void *cookie, const char *fmt, va_list ap )
12400 {
12401 if( (interp == NULL) || (interp->cb_vfprintf == NULL) ){
12402 errno = ENOTSUP;
12403 return -1;
12404 }
12405 return (*(interp->cb_vfprintf))( cookie, fmt, ap );
12406 }
12407
12408 size_t Jim_fwrite( Jim_Interp *interp, const void *ptr, size_t size, size_t n, void *cookie )
12409 {
12410 if( (interp == NULL) || (interp->cb_fwrite == NULL) ){
12411 errno = ENOTSUP;
12412 return 0;
12413 }
12414 return (*(interp->cb_fwrite))( ptr, size, n, cookie);
12415 }
12416
12417 size_t Jim_fread( Jim_Interp *interp, void *ptr, size_t size, size_t n, void *cookie )
12418 {
12419 if( (interp == NULL) || (interp->cb_fread == NULL) ){
12420 errno = ENOTSUP;
12421 return 0;
12422 }
12423 return (*(interp->cb_fread))( ptr, size, n, cookie);
12424 }
12425
12426 int Jim_fflush( Jim_Interp *interp, void *cookie )
12427 {
12428 if( (interp == NULL) || (interp->cb_fflush == NULL) ){
12429 /* pretend all is well */
12430 return 0;
12431 }
12432 return (*(interp->cb_fflush))( cookie );
12433 }
12434
12435 char* Jim_fgets( Jim_Interp *interp, char *s, int size, void *cookie )
12436 {
12437 if( (interp == NULL) || (interp->cb_fgets == NULL) ){
12438 errno = ENOTSUP;
12439 return NULL;
12440 }
12441 return (*(interp->cb_fgets))( s, size, cookie );
12442 }
12443 Jim_Nvp *
12444 Jim_Nvp_name2value_simple( const Jim_Nvp *p, const char *name )
12445 {
12446 while( p->name ){
12447 if( 0 == strcmp( name, p->name ) ){
12448 break;
12449 }
12450 p++;
12451 }
12452 return ((Jim_Nvp *)(p));
12453 }
12454
12455 Jim_Nvp *
12456 Jim_Nvp_name2value_nocase_simple( const Jim_Nvp *p, const char *name )
12457 {
12458 while( p->name ){
12459 if( 0 == strcasecmp( name, p->name ) ){
12460 break;
12461 }
12462 p++;
12463 }
12464 return ((Jim_Nvp *)(p));
12465 }
12466
12467 int
12468 Jim_Nvp_name2value_obj( Jim_Interp *interp,
12469 const Jim_Nvp *p,
12470 Jim_Obj *o,
12471 Jim_Nvp **result )
12472 {
12473 return Jim_Nvp_name2value( interp, p, Jim_GetString( o, NULL ), result );
12474 }
12475
12476
12477 int
12478 Jim_Nvp_name2value( Jim_Interp *interp,
12479 const Jim_Nvp *_p,
12480 const char *name,
12481 Jim_Nvp **result)
12482 {
12483 const Jim_Nvp *p;
12484
12485 p = Jim_Nvp_name2value_simple( _p, name );
12486
12487 /* result */
12488 if( result ){
12489 *result = (Jim_Nvp *)(p);
12490 }
12491
12492 /* found? */
12493 if( p->name ){
12494 return JIM_OK;
12495 } else {
12496 return JIM_ERR;
12497 }
12498 }
12499
12500 int
12501 Jim_Nvp_name2value_obj_nocase( Jim_Interp *interp, const Jim_Nvp *p, Jim_Obj *o, Jim_Nvp **puthere )
12502 {
12503 return Jim_Nvp_name2value_nocase( interp, p, Jim_GetString( o, NULL ), puthere );
12504 }
12505
12506 int
12507 Jim_Nvp_name2value_nocase( Jim_Interp *interp, const Jim_Nvp *_p, const char *name, Jim_Nvp **puthere )
12508 {
12509 const Jim_Nvp *p;
12510
12511 p = Jim_Nvp_name2value_nocase_simple( _p, name );
12512
12513 if( puthere ){
12514 *puthere = (Jim_Nvp *)(p);
12515 }
12516 /* found */
12517 if( p->name ){
12518 return JIM_OK;
12519 } else {
12520 return JIM_ERR;
12521 }
12522 }
12523
12524
12525 int
12526 Jim_Nvp_value2name_obj( Jim_Interp *interp, const Jim_Nvp *p, Jim_Obj *o, Jim_Nvp **result )
12527 {
12528 int e;;
12529 jim_wide w;
12530
12531 e = Jim_GetWide( interp, o, &w );
12532 if( e != JIM_OK ){
12533 return e;
12534 }
12535
12536 return Jim_Nvp_value2name( interp, p, w, result );
12537 }
12538
12539 Jim_Nvp *
12540 Jim_Nvp_value2name_simple( const Jim_Nvp *p, int value )
12541 {
12542 while( p->name ){
12543 if( value == p->value ){
12544 break;
12545 }
12546 p++;
12547 }
12548 return ((Jim_Nvp *)(p));
12549 }
12550
12551
12552 int
12553 Jim_Nvp_value2name( Jim_Interp *interp, const Jim_Nvp *_p, int value, Jim_Nvp **result )
12554 {
12555 const Jim_Nvp *p;
12556
12557 p = Jim_Nvp_value2name_simple( _p, value );
12558
12559 if( result ){
12560 *result = (Jim_Nvp *)(p);
12561 }
12562
12563 if( p->name ){
12564 return JIM_OK;
12565 } else {
12566 return JIM_ERR;
12567 }
12568 }
12569
12570
12571 int
12572 Jim_GetOpt_Setup( Jim_GetOptInfo *p, Jim_Interp *interp, int argc, Jim_Obj * const * argv)
12573 {
12574 memset( p, 0, sizeof(*p) );
12575 p->interp = interp;
12576 p->argc = argc;
12577 p->argv = argv;
12578
12579 return JIM_OK;
12580 }
12581
12582 void
12583 Jim_GetOpt_Debug( Jim_GetOptInfo *p )
12584 {
12585 int x;
12586
12587 Jim_fprintf( p->interp, p->interp->cookie_stderr, "---args---\n");
12588 for( x = 0 ; x < p->argc ; x++ ){
12589 Jim_fprintf( p->interp, p->interp->cookie_stderr,
12590 "%2d) %s\n",
12591 x,
12592 Jim_GetString( p->argv[x], NULL ) );
12593 }
12594 Jim_fprintf( p->interp, p->interp->cookie_stderr, "-------\n");
12595 }
12596
12597
12598 int
12599 Jim_GetOpt_Obj( Jim_GetOptInfo *goi, Jim_Obj **puthere )
12600 {
12601 Jim_Obj *o;
12602
12603 o = NULL; // failure
12604 if( goi->argc ){
12605 // success
12606 o = goi->argv[0];
12607 goi->argc -= 1;
12608 goi->argv += 1;
12609 }
12610 if( puthere ){
12611 *puthere = o;
12612 }
12613 if( o != NULL ){
12614 return JIM_OK;
12615 } else {
12616 return JIM_ERR;
12617 }
12618 }
12619
12620 int
12621 Jim_GetOpt_String( Jim_GetOptInfo *goi, char **puthere, int *len )
12622 {
12623 int r;
12624 Jim_Obj *o;
12625 const char *cp;
12626
12627
12628 r = Jim_GetOpt_Obj( goi, &o );
12629 if( r == JIM_OK ){
12630 cp = Jim_GetString( o, len );
12631 if( puthere ){
12632 /* remove const */
12633 *puthere = (char *)(cp);
12634 }
12635 }
12636 return r;
12637 }
12638
12639 int
12640 Jim_GetOpt_Double( Jim_GetOptInfo *goi, double *puthere )
12641 {
12642 int r;
12643 Jim_Obj *o;
12644 double _safe;
12645
12646 if( puthere == NULL ){
12647 puthere = &_safe;
12648 }
12649
12650 r = Jim_GetOpt_Obj( goi, &o );
12651 if( r == JIM_OK ){
12652 r = Jim_GetDouble( goi->interp, o, puthere );
12653 if( r != JIM_OK ){
12654 Jim_SetResult_sprintf( goi->interp,
12655 "not a number: %s",
12656 Jim_GetString( o, NULL ) );
12657 }
12658 }
12659 return r;
12660 }
12661
12662 int
12663 Jim_GetOpt_Wide( Jim_GetOptInfo *goi, jim_wide *puthere )
12664 {
12665 int r;
12666 Jim_Obj *o;
12667 jim_wide _safe;
12668
12669 if( puthere == NULL ){
12670 puthere = &_safe;
12671 }
12672
12673 r = Jim_GetOpt_Obj( goi, &o );
12674 if( r == JIM_OK ){
12675 r = Jim_GetWide( goi->interp, o, puthere );
12676 }
12677 return r;
12678 }
12679
12680 int Jim_GetOpt_Nvp( Jim_GetOptInfo *goi,
12681 const Jim_Nvp *nvp,
12682 Jim_Nvp **puthere)
12683 {
12684 Jim_Nvp *_safe;
12685 Jim_Obj *o;
12686 int e;
12687
12688 if( puthere == NULL ){
12689 puthere = &_safe;
12690 }
12691
12692 e = Jim_GetOpt_Obj( goi, &o );
12693 if( e == JIM_OK ){
12694 e = Jim_Nvp_name2value_obj( goi->interp,
12695 nvp,
12696 o,
12697 puthere );
12698 }
12699
12700 return e;
12701 }
12702
12703 void
12704 Jim_GetOpt_NvpUnknown( Jim_GetOptInfo *goi,
12705 const Jim_Nvp *nvptable,
12706 int hadprefix )
12707 {
12708 if( hadprefix ){
12709 Jim_SetResult_NvpUnknown( goi->interp,
12710 goi->argv[-2],
12711 goi->argv[-1],
12712 nvptable );
12713 } else {
12714 Jim_SetResult_NvpUnknown( goi->interp,
12715 NULL,
12716 goi->argv[-1],
12717 nvptable );
12718 }
12719 }
12720
12721
12722 int
12723 Jim_GetOpt_Enum( Jim_GetOptInfo *goi,
12724 const char * const * lookup,
12725 int *puthere)
12726 {
12727 int _safe;
12728 Jim_Obj *o;
12729 int e;
12730
12731 if( puthere == NULL ){
12732 puthere = &_safe;
12733 }
12734 e = Jim_GetOpt_Obj( goi, &o );
12735 if( e == JIM_OK ){
12736 e = Jim_GetEnum( goi->interp,
12737 o,
12738 lookup,
12739 puthere,
12740 "option",
12741 JIM_ERRMSG );
12742 }
12743 return e;
12744 }
12745
12746
12747
12748 int
12749 Jim_SetResult_sprintf( Jim_Interp *interp, const char *fmt,... )
12750 {
12751 va_list ap;
12752 char *buf;
12753
12754 va_start(ap,fmt);
12755 buf = jim_vasprintf( fmt, ap );
12756 va_end(ap);
12757 if( buf ){
12758 Jim_SetResultString( interp, buf, -1 );
12759 jim_vasprintf_done(buf);
12760 }
12761 return JIM_OK;
12762 }
12763
12764
12765 void
12766 Jim_SetResult_NvpUnknown( Jim_Interp *interp,
12767 Jim_Obj *param_name,
12768 Jim_Obj *param_value,
12769 const Jim_Nvp *nvp )
12770 {
12771 if( param_name ){
12772 Jim_SetResult_sprintf( interp,
12773 "%s: Unknown: %s, try one of: ",
12774 Jim_GetString( param_name, NULL ),
12775 Jim_GetString( param_value, NULL ) );
12776 } else {
12777 Jim_SetResult_sprintf( interp,
12778 "Unknown param: %s, try one of: ",
12779 Jim_GetString( param_value, NULL ) );
12780 }
12781 while( nvp->name ){
12782 const char *a;
12783 const char *b;
12784
12785 if( (nvp+1)->name ){
12786 a = nvp->name;
12787 b = ", ";
12788 } else {
12789 a = "or ";
12790 b = nvp->name;
12791 }
12792 Jim_AppendStrings( interp,
12793 Jim_GetResult(interp),
12794 a, b, NULL );
12795 nvp++;
12796 }
12797 }
12798
12799
12800 static Jim_Obj *debug_string_obj;
12801
12802 const char *
12803 Jim_Debug_ArgvString( Jim_Interp *interp, int argc, Jim_Obj *const *argv )
12804 {
12805 int x;
12806
12807 if( debug_string_obj ){
12808 Jim_FreeObj( interp, debug_string_obj );
12809 }
12810
12811 debug_string_obj = Jim_NewEmptyStringObj( interp );
12812 for( x = 0 ; x < argc ; x++ ){
12813 Jim_AppendStrings( interp,
12814 debug_string_obj,
12815 Jim_GetString( argv[x], NULL ),
12816 " ",
12817 NULL );
12818 }
12819
12820 return Jim_GetString( debug_string_obj, NULL );
12821 }
12822
12823
12824
12825 /*
12826 * Local Variables: ***
12827 * c-basic-offset: 4 ***
12828 * tab-width: 4 ***
12829 * End: ***
12830 */

Linking to existing account procedure

If you already have an account and want to add another login method you MUST first sign in with your existing account and then change URL to read https://review.openocd.org/login/?link to get to this page again but this time it'll work for linking. Thank you.

SSH host keys fingerprints

1024 SHA256:YKx8b7u5ZWdcbp7/4AeXNaqElP49m6QrwfXaqQGJAOk gerrit-code-review@openocd.zylin.com (DSA)
384 SHA256:jHIbSQa4REvwCFG4cq5LBlBLxmxSqelQPem/EXIrxjk gerrit-code-review@openocd.org (ECDSA)
521 SHA256:UAOPYkU9Fjtcao0Ul/Rrlnj/OsQvt+pgdYSZ4jOYdgs gerrit-code-review@openocd.org (ECDSA)
256 SHA256:A13M5QlnozFOvTllybRZH6vm7iSt0XLxbA48yfc2yfY gerrit-code-review@openocd.org (ECDSA)
256 SHA256:spYMBqEYoAOtK7yZBrcwE8ZpYt6b68Cfh9yEVetvbXg gerrit-code-review@openocd.org (ED25519)
+--[ED25519 256]--+
|=..              |
|+o..   .         |
|*.o   . .        |
|+B . . .         |
|Bo. = o S        |
|Oo.+ + =         |
|oB=.* = . o      |
| =+=.+   + E     |
|. .=o   . o      |
+----[SHA256]-----+
2048 SHA256:0Onrb7/PHjpo6iVZ7xQX2riKN83FJ3KGU0TvI0TaFG4 gerrit-code-review@openocd.zylin.com (RSA)