5eb8c0bbbb561bc69ec08df10f0bc1e1c7b6a760
[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 #define _GNU_SOURCE /* for vasprintf() */
53 #include <stdio.h>
54 #include <stdlib.h>
55 #include <string.h>
56 #include <stdarg.h>
57 #include <ctype.h>
58 #include <limits.h>
59 #include <assert.h>
60 #include <errno.h>
61 #include <time.h>
62 #if defined(WIN32)
63 /* sys/time - need is different */
64 #else
65 #include <sys/time.h> // for gettimeofday()
66 #endif
67
68 #include "replacements.h"
69
70 /* Include the platform dependent libraries for
71 * dynamic loading of libraries. */
72 #ifdef JIM_DYNLIB
73 #if defined(_WIN32) || defined(WIN32)
74 #ifndef WIN32
75 #define WIN32 1
76 #endif
77 #ifndef STRICT
78 #define STRICT
79 #endif
80 #define WIN32_LEAN_AND_MEAN
81 #include <windows.h>
82 #if _MSC_VER >= 1000
83 #pragma warning(disable:4146)
84 #endif /* _MSC_VER */
85 #else
86 #include <dlfcn.h>
87 #endif /* WIN32 */
88 #endif /* JIM_DYNLIB */
89
90 #ifndef WIN32
91 #include <unistd.h>
92 #endif
93
94 #ifdef __ECOS
95 #include <cyg/jimtcl/jim.h>
96 #else
97 #include "jim.h"
98 #endif
99
100 #ifdef HAVE_BACKTRACE
101 #include <execinfo.h>
102 #endif
103
104 /* -----------------------------------------------------------------------------
105 * Global variables
106 * ---------------------------------------------------------------------------*/
107
108 /* A shared empty string for the objects string representation.
109 * Jim_InvalidateStringRep knows about it and don't try to free. */
110 static char *JimEmptyStringRep = (char*) "";
111
112 /* -----------------------------------------------------------------------------
113 * Required prototypes of not exported functions
114 * ---------------------------------------------------------------------------*/
115 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf);
116 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int flags);
117 static void JimRegisterCoreApi(Jim_Interp *interp);
118
119 static Jim_HashTableType JimVariablesHashTableType;
120
121 /* -----------------------------------------------------------------------------
122 * Utility functions
123 * ---------------------------------------------------------------------------*/
124
125 static char *
126 jim_vasprintf( const char *fmt, va_list ap )
127 {
128 #ifndef HAVE_VASPRINTF
129 /* yucky way */
130 static char buf[2048];
131 vsnprintf( buf, sizeof(buf), fmt, ap );
132 /* garentee termination */
133 buf[sizeof(buf)-1] = 0;
134 #else
135 char *buf;
136 int result;
137 result = vasprintf( &buf, fmt, ap );
138 if (result < 0) exit(-1);
139 #endif
140 return buf;
141 }
142
143 static void
144 jim_vasprintf_done( void *buf )
145 {
146 #ifndef HAVE_VASPRINTF
147 (void)(buf);
148 #else
149 free(buf);
150 #endif
151 }
152
153
154 /*
155 * Convert a string to a jim_wide INTEGER.
156 * This function originates from BSD.
157 *
158 * Ignores `locale' stuff. Assumes that the upper and lower case
159 * alphabets and digits are each contiguous.
160 */
161 #ifdef HAVE_LONG_LONG
162 #define JimIsAscii(c) (((c) & ~0x7f) == 0)
163 static jim_wide JimStrtoll(const char *nptr, char **endptr, register int base)
164 {
165 register const char *s;
166 register unsigned jim_wide acc;
167 register unsigned char c;
168 register unsigned jim_wide qbase, cutoff;
169 register int neg, any, cutlim;
170
171 /*
172 * Skip white space and pick up leading +/- sign if any.
173 * If base is 0, allow 0x for hex and 0 for octal, else
174 * assume decimal; if base is already 16, allow 0x.
175 */
176 s = nptr;
177 do {
178 c = *s++;
179 } while (isspace(c));
180 if (c == '-') {
181 neg = 1;
182 c = *s++;
183 } else {
184 neg = 0;
185 if (c == '+')
186 c = *s++;
187 }
188 if ((base == 0 || base == 16) &&
189 c == '0' && (*s == 'x' || *s == 'X')) {
190 c = s[1];
191 s += 2;
192 base = 16;
193 }
194 if (base == 0)
195 base = c == '0' ? 8 : 10;
196
197 /*
198 * Compute the cutoff value between legal numbers and illegal
199 * numbers. That is the largest legal value, divided by the
200 * base. An input number that is greater than this value, if
201 * followed by a legal input character, is too big. One that
202 * is equal to this value may be valid or not; the limit
203 * between valid and invalid numbers is then based on the last
204 * digit. For instance, if the range for quads is
205 * [-9223372036854775808..9223372036854775807] and the input base
206 * is 10, cutoff will be set to 922337203685477580 and cutlim to
207 * either 7 (neg==0) or 8 (neg==1), meaning that if we have
208 * accumulated a value > 922337203685477580, or equal but the
209 * next digit is > 7 (or 8), the number is too big, and we will
210 * return a range error.
211 *
212 * Set any if any `digits' consumed; make it negative to indicate
213 * overflow.
214 */
215 qbase = (unsigned)base;
216 cutoff = neg ? (unsigned jim_wide)-(LLONG_MIN + LLONG_MAX) + LLONG_MAX
217 : LLONG_MAX;
218 cutlim = (int)(cutoff % qbase);
219 cutoff /= qbase;
220 for (acc = 0, any = 0;; c = *s++) {
221 if (!JimIsAscii(c))
222 break;
223 if (isdigit(c))
224 c -= '0';
225 else if (isalpha(c))
226 c -= isupper(c) ? 'A' - 10 : 'a' - 10;
227 else
228 break;
229 if (c >= base)
230 break;
231 if (any < 0 || acc > cutoff || (acc == cutoff && c > cutlim))
232 any = -1;
233 else {
234 any = 1;
235 acc *= qbase;
236 acc += c;
237 }
238 }
239 if (any < 0) {
240 acc = neg ? LLONG_MIN : LLONG_MAX;
241 errno = ERANGE;
242 } else if (neg)
243 acc = -acc;
244 if (endptr != 0)
245 *endptr = (char *)(any ? s - 1 : nptr);
246 return (acc);
247 }
248 #endif
249
250 /* Glob-style pattern matching. */
251 static int JimStringMatch(const char *pattern, int patternLen,
252 const char *string, int stringLen, int nocase)
253 {
254 while(patternLen) {
255 switch(pattern[0]) {
256 case '*':
257 while (pattern[1] == '*') {
258 pattern++;
259 patternLen--;
260 }
261 if (patternLen == 1)
262 return 1; /* match */
263 while(stringLen) {
264 if (JimStringMatch(pattern+1, patternLen-1,
265 string, stringLen, nocase))
266 return 1; /* match */
267 string++;
268 stringLen--;
269 }
270 return 0; /* no match */
271 break;
272 case '?':
273 if (stringLen == 0)
274 return 0; /* no match */
275 string++;
276 stringLen--;
277 break;
278 case '[':
279 {
280 int not, match;
281
282 pattern++;
283 patternLen--;
284 not = pattern[0] == '^';
285 if (not) {
286 pattern++;
287 patternLen--;
288 }
289 match = 0;
290 while(1) {
291 if (pattern[0] == '\\') {
292 pattern++;
293 patternLen--;
294 if (pattern[0] == string[0])
295 match = 1;
296 } else if (pattern[0] == ']') {
297 break;
298 } else if (patternLen == 0) {
299 pattern--;
300 patternLen++;
301 break;
302 } else if (pattern[1] == '-' && patternLen >= 3) {
303 int start = pattern[0];
304 int end = pattern[2];
305 int c = string[0];
306 if (start > end) {
307 int t = start;
308 start = end;
309 end = t;
310 }
311 if (nocase) {
312 start = tolower(start);
313 end = tolower(end);
314 c = tolower(c);
315 }
316 pattern += 2;
317 patternLen -= 2;
318 if (c >= start && c <= end)
319 match = 1;
320 } else {
321 if (!nocase) {
322 if (pattern[0] == string[0])
323 match = 1;
324 } else {
325 if (tolower((int)pattern[0]) == tolower((int)string[0]))
326 match = 1;
327 }
328 }
329 pattern++;
330 patternLen--;
331 }
332 if (not)
333 match = !match;
334 if (!match)
335 return 0; /* no match */
336 string++;
337 stringLen--;
338 break;
339 }
340 case '\\':
341 if (patternLen >= 2) {
342 pattern++;
343 patternLen--;
344 }
345 /* fall through */
346 default:
347 if (!nocase) {
348 if (pattern[0] != string[0])
349 return 0; /* no match */
350 } else {
351 if (tolower((int)pattern[0]) != tolower((int)string[0]))
352 return 0; /* no match */
353 }
354 string++;
355 stringLen--;
356 break;
357 }
358 pattern++;
359 patternLen--;
360 if (stringLen == 0) {
361 while(*pattern == '*') {
362 pattern++;
363 patternLen--;
364 }
365 break;
366 }
367 }
368 if (patternLen == 0 && stringLen == 0)
369 return 1;
370 return 0;
371 }
372
373 int JimStringCompare(const char *s1, int l1, const char *s2, int l2,
374 int nocase)
375 {
376 unsigned char *u1 = (unsigned char*) s1, *u2 = (unsigned char*) s2;
377
378 if (nocase == 0) {
379 while(l1 && l2) {
380 if (*u1 != *u2)
381 return (int)*u1-*u2;
382 u1++; u2++; l1--; l2--;
383 }
384 if (!l1 && !l2) return 0;
385 return l1-l2;
386 } else {
387 while(l1 && l2) {
388 if (tolower((int)*u1) != tolower((int)*u2))
389 return tolower((int)*u1)-tolower((int)*u2);
390 u1++; u2++; l1--; l2--;
391 }
392 if (!l1 && !l2) return 0;
393 return l1-l2;
394 }
395 }
396
397 /* Search 's1' inside 's2', starting to search from char 'index' of 's2'.
398 * The index of the first occurrence of s1 in s2 is returned.
399 * If s1 is not found inside s2, -1 is returned. */
400 int JimStringFirst(const char *s1, int l1, const char *s2, int l2, int index)
401 {
402 int i;
403
404 if (!l1 || !l2 || l1 > l2) return -1;
405 if (index < 0) index = 0;
406 s2 += index;
407 for (i = index; i <= l2-l1; i++) {
408 if (memcmp(s2, s1, l1) == 0)
409 return i;
410 s2++;
411 }
412 return -1;
413 }
414
415 int Jim_WideToString(char *buf, jim_wide wideValue)
416 {
417 const char *fmt = "%" JIM_WIDE_MODIFIER;
418 return sprintf(buf, fmt, wideValue);
419 }
420
421 int Jim_StringToWide(const char *str, jim_wide *widePtr, int base)
422 {
423 char *endptr;
424
425 #ifdef HAVE_LONG_LONG
426 *widePtr = JimStrtoll(str, &endptr, base);
427 #else
428 *widePtr = strtol(str, &endptr, base);
429 #endif
430 if ((str[0] == '\0') || (str == endptr) )
431 return JIM_ERR;
432 if (endptr[0] != '\0') {
433 while(*endptr) {
434 if (!isspace((int)*endptr))
435 return JIM_ERR;
436 endptr++;
437 }
438 }
439 return JIM_OK;
440 }
441
442 int Jim_StringToIndex(const char *str, int *intPtr)
443 {
444 char *endptr;
445
446 *intPtr = strtol(str, &endptr, 10);
447 if ( (str[0] == '\0') || (str == endptr) )
448 return JIM_ERR;
449 if (endptr[0] != '\0') {
450 while(*endptr) {
451 if (!isspace((int)*endptr))
452 return JIM_ERR;
453 endptr++;
454 }
455 }
456 return JIM_OK;
457 }
458
459 /* The string representation of references has two features in order
460 * to make the GC faster. The first is that every reference starts
461 * with a non common character '~', in order to make the string matching
462 * fater. The second is that the reference string rep his 32 characters
463 * in length, this allows to avoid to check every object with a string
464 * repr < 32, and usually there are many of this objects. */
465
466 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
467
468 static int JimFormatReference(char *buf, Jim_Reference *refPtr, jim_wide id)
469 {
470 const char *fmt = "<reference.<%s>.%020" JIM_WIDE_MODIFIER ">";
471 sprintf(buf, fmt, refPtr->tag, id);
472 return JIM_REFERENCE_SPACE;
473 }
474
475 int Jim_DoubleToString(char *buf, double doubleValue)
476 {
477 char *s;
478 int len;
479
480 len = sprintf(buf, "%.17g", doubleValue);
481 s = buf;
482 while(*s) {
483 if (*s == '.') return len;
484 s++;
485 }
486 /* Add a final ".0" if it's a number. But not
487 * for NaN or InF */
488 if (isdigit((int)buf[0])
489 || ((buf[0] == '-' || buf[0] == '+')
490 && isdigit((int)buf[1]))) {
491 s[0] = '.';
492 s[1] = '0';
493 s[2] = '\0';
494 return len+2;
495 }
496 return len;
497 }
498
499 int Jim_StringToDouble(const char *str, double *doublePtr)
500 {
501 char *endptr;
502
503 *doublePtr = strtod(str, &endptr);
504 if (str[0] == '\0' || endptr[0] != '\0' || (str == endptr) )
505 return JIM_ERR;
506 return JIM_OK;
507 }
508
509 static jim_wide JimPowWide(jim_wide b, jim_wide e)
510 {
511 jim_wide i, res = 1;
512 if ((b==0 && e!=0) || (e<0)) return 0;
513 for(i=0; i<e; i++) {res *= b;}
514 return res;
515 }
516
517 /* -----------------------------------------------------------------------------
518 * Special functions
519 * ---------------------------------------------------------------------------*/
520
521 /* Note that 'interp' may be NULL if not available in the
522 * context of the panic. It's only useful to get the error
523 * file descriptor, it will default to stderr otherwise. */
524 void Jim_Panic(Jim_Interp *interp, const char *fmt, ...)
525 {
526 va_list ap;
527
528 va_start(ap, fmt);
529 /*
530 * Send it here first.. Assuming STDIO still works
531 */
532 fprintf(stderr, JIM_NL "JIM INTERPRETER PANIC: ");
533 vfprintf(stderr, fmt, ap);
534 fprintf(stderr, JIM_NL JIM_NL);
535 va_end(ap);
536
537 #ifdef HAVE_BACKTRACE
538 {
539 void *array[40];
540 int size, i;
541 char **strings;
542
543 size = backtrace(array, 40);
544 strings = backtrace_symbols(array, size);
545 for (i = 0; i < size; i++)
546 fprintf(fp,"[backtrace] %s" JIM_NL, strings[i]);
547 fprintf(fp,"[backtrace] Include the above lines and the output" JIM_NL);
548 fprintf(fp,"[backtrace] of 'nm <executable>' in the bug report." JIM_NL);
549 }
550 #endif
551
552 /* This may actually crash... we do it last */
553 if( interp && interp->cookie_stderr ){
554 Jim_fprintf( interp, interp->cookie_stderr, JIM_NL "JIM INTERPRETER PANIC: ");
555 Jim_vfprintf( interp, interp->cookie_stderr, fmt, ap );
556 Jim_fprintf( interp, interp->cookie_stderr, JIM_NL JIM_NL );
557 }
558 abort();
559 }
560
561 /* -----------------------------------------------------------------------------
562 * Memory allocation
563 * ---------------------------------------------------------------------------*/
564
565 /* Macro used for memory debugging.
566 * In order for they to work you have to rename Jim_Alloc into _Jim_Alloc
567 * and similary for Jim_Realloc and Jim_Free */
568 #if 0
569 #define Jim_Alloc(s) (printf("%s %d: Jim_Alloc(%d)\n",__FILE__,__LINE__,s),_Jim_Alloc(s))
570 #define Jim_Free(p) (printf("%s %d: Jim_Free(%p)\n",__FILE__,__LINE__,p),_Jim_Free(p))
571 #define Jim_Realloc(p,s) (printf("%s %d: Jim_Realloc(%p,%d)\n",__FILE__,__LINE__,p,s),_Jim_Realloc(p,s))
572 #endif
573
574 void *Jim_Alloc(int size)
575 {
576 /* We allocate zero length arrayes, etc. to use a single orthogonal codepath */
577 if (size==0)
578 size=1;
579 void *p = malloc(size);
580 if (p == NULL)
581 Jim_Panic(NULL,"malloc: Out of memory");
582 return p;
583 }
584
585 void Jim_Free(void *ptr) {
586 free(ptr);
587 }
588
589 void *Jim_Realloc(void *ptr, int size)
590 {
591 /* We allocate zero length arrayes, etc. to use a single orthogonal codepath */
592 if (size==0)
593 size=1;
594 void *p = realloc(ptr, size);
595 if (p == NULL)
596 Jim_Panic(NULL,"realloc: Out of memory");
597 return p;
598 }
599
600 char *Jim_StrDup(const char *s)
601 {
602 int l = strlen(s);
603 char *copy = Jim_Alloc(l+1);
604
605 memcpy(copy, s, l+1);
606 return copy;
607 }
608
609 char *Jim_StrDupLen(const char *s, int l)
610 {
611 char *copy = Jim_Alloc(l+1);
612
613 memcpy(copy, s, l+1);
614 copy[l] = 0; /* Just to be sure, original could be substring */
615 return copy;
616 }
617
618 /* -----------------------------------------------------------------------------
619 * Time related functions
620 * ---------------------------------------------------------------------------*/
621 /* Returns microseconds of CPU used since start. */
622 static jim_wide JimClock(void)
623 {
624 #if (defined WIN32) && !(defined JIM_ANSIC)
625 LARGE_INTEGER t, f;
626 QueryPerformanceFrequency(&f);
627 QueryPerformanceCounter(&t);
628 return (long)((t.QuadPart * 1000000) / f.QuadPart);
629 #else /* !WIN32 */
630 clock_t clocks = clock();
631
632 return (long)(clocks*(1000000/CLOCKS_PER_SEC));
633 #endif /* WIN32 */
634 }
635
636 /* -----------------------------------------------------------------------------
637 * Hash Tables
638 * ---------------------------------------------------------------------------*/
639
640 /* -------------------------- private prototypes ---------------------------- */
641 static int JimExpandHashTableIfNeeded(Jim_HashTable *ht);
642 static unsigned int JimHashTableNextPower(unsigned int size);
643 static int JimInsertHashEntry(Jim_HashTable *ht, const void *key);
644
645 /* -------------------------- hash functions -------------------------------- */
646
647 /* Thomas Wang's 32 bit Mix Function */
648 unsigned int Jim_IntHashFunction(unsigned int key)
649 {
650 key += ~(key << 15);
651 key ^= (key >> 10);
652 key += (key << 3);
653 key ^= (key >> 6);
654 key += ~(key << 11);
655 key ^= (key >> 16);
656 return key;
657 }
658
659 /* Identity hash function for integer keys */
660 unsigned int Jim_IdentityHashFunction(unsigned int key)
661 {
662 return key;
663 }
664
665 /* Generic hash function (we are using to multiply by 9 and add the byte
666 * as Tcl) */
667 unsigned int Jim_GenHashFunction(const unsigned char *buf, int len)
668 {
669 unsigned int h = 0;
670 while(len--)
671 h += (h<<3)+*buf++;
672 return h;
673 }
674
675 /* ----------------------------- API implementation ------------------------- */
676 /* reset an hashtable already initialized with ht_init().
677 * NOTE: This function should only called by ht_destroy(). */
678 static void JimResetHashTable(Jim_HashTable *ht)
679 {
680 ht->table = NULL;
681 ht->size = 0;
682 ht->sizemask = 0;
683 ht->used = 0;
684 ht->collisions = 0;
685 }
686
687 /* Initialize the hash table */
688 int Jim_InitHashTable(Jim_HashTable *ht, Jim_HashTableType *type,
689 void *privDataPtr)
690 {
691 JimResetHashTable(ht);
692 ht->type = type;
693 ht->privdata = privDataPtr;
694 return JIM_OK;
695 }
696
697 /* Resize the table to the minimal size that contains all the elements,
698 * but with the invariant of a USER/BUCKETS ration near to <= 1 */
699 int Jim_ResizeHashTable(Jim_HashTable *ht)
700 {
701 int minimal = ht->used;
702
703 if (minimal < JIM_HT_INITIAL_SIZE)
704 minimal = JIM_HT_INITIAL_SIZE;
705 return Jim_ExpandHashTable(ht, minimal);
706 }
707
708 /* Expand or create the hashtable */
709 int Jim_ExpandHashTable(Jim_HashTable *ht, unsigned int size)
710 {
711 Jim_HashTable n; /* the new hashtable */
712 unsigned int realsize = JimHashTableNextPower(size), i;
713
714 /* the size is invalid if it is smaller than the number of
715 * elements already inside the hashtable */
716 if (ht->used >= size)
717 return JIM_ERR;
718
719 Jim_InitHashTable(&n, ht->type, ht->privdata);
720 n.size = realsize;
721 n.sizemask = realsize-1;
722 n.table = Jim_Alloc(realsize*sizeof(Jim_HashEntry*));
723
724 /* Initialize all the pointers to NULL */
725 memset(n.table, 0, realsize*sizeof(Jim_HashEntry*));
726
727 /* Copy all the elements from the old to the new table:
728 * note that if the old hash table is empty ht->size is zero,
729 * so Jim_ExpandHashTable just creates an hash table. */
730 n.used = ht->used;
731 for (i = 0; i < ht->size && ht->used > 0; i++) {
732 Jim_HashEntry *he, *nextHe;
733
734 if (ht->table[i] == NULL) continue;
735
736 /* For each hash entry on this slot... */
737 he = ht->table[i];
738 while(he) {
739 unsigned int h;
740
741 nextHe = he->next;
742 /* Get the new element index */
743 h = Jim_HashKey(ht, he->key) & n.sizemask;
744 he->next = n.table[h];
745 n.table[h] = he;
746 ht->used--;
747 /* Pass to the next element */
748 he = nextHe;
749 }
750 }
751 assert(ht->used == 0);
752 Jim_Free(ht->table);
753
754 /* Remap the new hashtable in the old */
755 *ht = n;
756 return JIM_OK;
757 }
758
759 /* Add an element to the target hash table */
760 int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val)
761 {
762 int index;
763 Jim_HashEntry *entry;
764
765 /* Get the index of the new element, or -1 if
766 * the element already exists. */
767 if ((index = JimInsertHashEntry(ht, key)) == -1)
768 return JIM_ERR;
769
770 /* Allocates the memory and stores key */
771 entry = Jim_Alloc(sizeof(*entry));
772 entry->next = ht->table[index];
773 ht->table[index] = entry;
774
775 /* Set the hash entry fields. */
776 Jim_SetHashKey(ht, entry, key);
777 Jim_SetHashVal(ht, entry, val);
778 ht->used++;
779 return JIM_OK;
780 }
781
782 /* Add an element, discarding the old if the key already exists */
783 int Jim_ReplaceHashEntry(Jim_HashTable *ht, const void *key, void *val)
784 {
785 Jim_HashEntry *entry;
786
787 /* Try to add the element. If the key
788 * does not exists Jim_AddHashEntry will suceed. */
789 if (Jim_AddHashEntry(ht, key, val) == JIM_OK)
790 return JIM_OK;
791 /* It already exists, get the entry */
792 entry = Jim_FindHashEntry(ht, key);
793 /* Free the old value and set the new one */
794 Jim_FreeEntryVal(ht, entry);
795 Jim_SetHashVal(ht, entry, val);
796 return JIM_OK;
797 }
798
799 /* Search and remove an element */
800 int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key)
801 {
802 unsigned int h;
803 Jim_HashEntry *he, *prevHe;
804
805 if (ht->size == 0)
806 return JIM_ERR;
807 h = Jim_HashKey(ht, key) & ht->sizemask;
808 he = ht->table[h];
809
810 prevHe = NULL;
811 while(he) {
812 if (Jim_CompareHashKeys(ht, key, he->key)) {
813 /* Unlink the element from the list */
814 if (prevHe)
815 prevHe->next = he->next;
816 else
817 ht->table[h] = he->next;
818 Jim_FreeEntryKey(ht, he);
819 Jim_FreeEntryVal(ht, he);
820 Jim_Free(he);
821 ht->used--;
822 return JIM_OK;
823 }
824 prevHe = he;
825 he = he->next;
826 }
827 return JIM_ERR; /* not found */
828 }
829
830 /* Destroy an entire hash table */
831 int Jim_FreeHashTable(Jim_HashTable *ht)
832 {
833 unsigned int i;
834
835 /* Free all the elements */
836 for (i = 0; i < ht->size && ht->used > 0; i++) {
837 Jim_HashEntry *he, *nextHe;
838
839 if ((he = ht->table[i]) == NULL) continue;
840 while(he) {
841 nextHe = he->next;
842 Jim_FreeEntryKey(ht, he);
843 Jim_FreeEntryVal(ht, he);
844 Jim_Free(he);
845 ht->used--;
846 he = nextHe;
847 }
848 }
849 /* Free the table and the allocated cache structure */
850 Jim_Free(ht->table);
851 /* Re-initialize the table */
852 JimResetHashTable(ht);
853 return JIM_OK; /* never fails */
854 }
855
856 Jim_HashEntry *Jim_FindHashEntry(Jim_HashTable *ht, const void *key)
857 {
858 Jim_HashEntry *he;
859 unsigned int h;
860
861 if (ht->size == 0) return NULL;
862 h = Jim_HashKey(ht, key) & ht->sizemask;
863 he = ht->table[h];
864 while(he) {
865 if (Jim_CompareHashKeys(ht, key, he->key))
866 return he;
867 he = he->next;
868 }
869 return NULL;
870 }
871
872 Jim_HashTableIterator *Jim_GetHashTableIterator(Jim_HashTable *ht)
873 {
874 Jim_HashTableIterator *iter = Jim_Alloc(sizeof(*iter));
875
876 iter->ht = ht;
877 iter->index = -1;
878 iter->entry = NULL;
879 iter->nextEntry = NULL;
880 return iter;
881 }
882
883 Jim_HashEntry *Jim_NextHashEntry(Jim_HashTableIterator *iter)
884 {
885 while (1) {
886 if (iter->entry == NULL) {
887 iter->index++;
888 if (iter->index >=
889 (signed)iter->ht->size) break;
890 iter->entry = iter->ht->table[iter->index];
891 } else {
892 iter->entry = iter->nextEntry;
893 }
894 if (iter->entry) {
895 /* We need to save the 'next' here, the iterator user
896 * may delete the entry we are returning. */
897 iter->nextEntry = iter->entry->next;
898 return iter->entry;
899 }
900 }
901 return NULL;
902 }
903
904 /* ------------------------- private functions ------------------------------ */
905
906 /* Expand the hash table if needed */
907 static int JimExpandHashTableIfNeeded(Jim_HashTable *ht)
908 {
909 /* If the hash table is empty expand it to the intial size,
910 * if the table is "full" dobule its size. */
911 if (ht->size == 0)
912 return Jim_ExpandHashTable(ht, JIM_HT_INITIAL_SIZE);
913 if (ht->size == ht->used)
914 return Jim_ExpandHashTable(ht, ht->size*2);
915 return JIM_OK;
916 }
917
918 /* Our hash table capability is a power of two */
919 static unsigned int JimHashTableNextPower(unsigned int size)
920 {
921 unsigned int i = JIM_HT_INITIAL_SIZE;
922
923 if (size >= 2147483648U)
924 return 2147483648U;
925 while(1) {
926 if (i >= size)
927 return i;
928 i *= 2;
929 }
930 }
931
932 /* Returns the index of a free slot that can be populated with
933 * an hash entry for the given 'key'.
934 * If the key already exists, -1 is returned. */
935 static int JimInsertHashEntry(Jim_HashTable *ht, const void *key)
936 {
937 unsigned int h;
938 Jim_HashEntry *he;
939
940 /* Expand the hashtable if needed */
941 if (JimExpandHashTableIfNeeded(ht) == JIM_ERR)
942 return -1;
943 /* Compute the key hash value */
944 h = Jim_HashKey(ht, key) & ht->sizemask;
945 /* Search if this slot does not already contain the given key */
946 he = ht->table[h];
947 while(he) {
948 if (Jim_CompareHashKeys(ht, key, he->key))
949 return -1;
950 he = he->next;
951 }
952 return h;
953 }
954
955 /* ----------------------- StringCopy Hash Table Type ------------------------*/
956
957 static unsigned int JimStringCopyHTHashFunction(const void *key)
958 {
959 return Jim_GenHashFunction(key, strlen(key));
960 }
961
962 static const void *JimStringCopyHTKeyDup(void *privdata, const void *key)
963 {
964 int len = strlen(key);
965 char *copy = Jim_Alloc(len+1);
966 JIM_NOTUSED(privdata);
967
968 memcpy(copy, key, len);
969 copy[len] = '\0';
970 return copy;
971 }
972
973 static void *JimStringKeyValCopyHTValDup(void *privdata, const void *val)
974 {
975 int len = strlen(val);
976 char *copy = Jim_Alloc(len+1);
977 JIM_NOTUSED(privdata);
978
979 memcpy(copy, val, len);
980 copy[len] = '\0';
981 return copy;
982 }
983
984 static int JimStringCopyHTKeyCompare(void *privdata, const void *key1,
985 const void *key2)
986 {
987 JIM_NOTUSED(privdata);
988
989 return strcmp(key1, key2) == 0;
990 }
991
992 static void JimStringCopyHTKeyDestructor(void *privdata, const void *key)
993 {
994 JIM_NOTUSED(privdata);
995
996 Jim_Free((void*)key); /* ATTENTION: const cast */
997 }
998
999 static void JimStringKeyValCopyHTValDestructor(void *privdata, void *val)
1000 {
1001 JIM_NOTUSED(privdata);
1002
1003 Jim_Free((void*)val); /* ATTENTION: const cast */
1004 }
1005
1006 static Jim_HashTableType JimStringCopyHashTableType = {
1007 JimStringCopyHTHashFunction, /* hash function */
1008 JimStringCopyHTKeyDup, /* key dup */
1009 NULL, /* val dup */
1010 JimStringCopyHTKeyCompare, /* key compare */
1011 JimStringCopyHTKeyDestructor, /* key destructor */
1012 NULL /* val destructor */
1013 };
1014
1015 /* This is like StringCopy but does not auto-duplicate the key.
1016 * It's used for intepreter's shared strings. */
1017 static Jim_HashTableType JimSharedStringsHashTableType = {
1018 JimStringCopyHTHashFunction, /* hash function */
1019 NULL, /* key dup */
1020 NULL, /* val dup */
1021 JimStringCopyHTKeyCompare, /* key compare */
1022 JimStringCopyHTKeyDestructor, /* key destructor */
1023 NULL /* val destructor */
1024 };
1025
1026 /* This is like StringCopy but also automatically handle dynamic
1027 * allocated C strings as values. */
1028 static Jim_HashTableType JimStringKeyValCopyHashTableType = {
1029 JimStringCopyHTHashFunction, /* hash function */
1030 JimStringCopyHTKeyDup, /* key dup */
1031 JimStringKeyValCopyHTValDup, /* val dup */
1032 JimStringCopyHTKeyCompare, /* key compare */
1033 JimStringCopyHTKeyDestructor, /* key destructor */
1034 JimStringKeyValCopyHTValDestructor, /* val destructor */
1035 };
1036
1037 typedef struct AssocDataValue {
1038 Jim_InterpDeleteProc *delProc;
1039 void *data;
1040 } AssocDataValue;
1041
1042 static void JimAssocDataHashTableValueDestructor(void *privdata, void *data)
1043 {
1044 AssocDataValue *assocPtr = (AssocDataValue *)data;
1045 if (assocPtr->delProc != NULL)
1046 assocPtr->delProc((Jim_Interp *)privdata, assocPtr->data);
1047 Jim_Free(data);
1048 }
1049
1050 static Jim_HashTableType JimAssocDataHashTableType = {
1051 JimStringCopyHTHashFunction, /* hash function */
1052 JimStringCopyHTKeyDup, /* key dup */
1053 NULL, /* val dup */
1054 JimStringCopyHTKeyCompare, /* key compare */
1055 JimStringCopyHTKeyDestructor, /* key destructor */
1056 JimAssocDataHashTableValueDestructor /* val destructor */
1057 };
1058
1059 /* -----------------------------------------------------------------------------
1060 * Stack - This is a simple generic stack implementation. It is used for
1061 * example in the 'expr' expression compiler.
1062 * ---------------------------------------------------------------------------*/
1063 void Jim_InitStack(Jim_Stack *stack)
1064 {
1065 stack->len = 0;
1066 stack->maxlen = 0;
1067 stack->vector = NULL;
1068 }
1069
1070 void Jim_FreeStack(Jim_Stack *stack)
1071 {
1072 Jim_Free(stack->vector);
1073 }
1074
1075 int Jim_StackLen(Jim_Stack *stack)
1076 {
1077 return stack->len;
1078 }
1079
1080 void Jim_StackPush(Jim_Stack *stack, void *element) {
1081 int neededLen = stack->len+1;
1082 if (neededLen > stack->maxlen) {
1083 stack->maxlen = neededLen*2;
1084 stack->vector = Jim_Realloc(stack->vector, sizeof(void*)*stack->maxlen);
1085 }
1086 stack->vector[stack->len] = element;
1087 stack->len++;
1088 }
1089
1090 void *Jim_StackPop(Jim_Stack *stack)
1091 {
1092 if (stack->len == 0) return NULL;
1093 stack->len--;
1094 return stack->vector[stack->len];
1095 }
1096
1097 void *Jim_StackPeek(Jim_Stack *stack)
1098 {
1099 if (stack->len == 0) return NULL;
1100 return stack->vector[stack->len-1];
1101 }
1102
1103 void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc)(void *ptr))
1104 {
1105 int i;
1106
1107 for (i = 0; i < stack->len; i++)
1108 freeFunc(stack->vector[i]);
1109 }
1110
1111 /* -----------------------------------------------------------------------------
1112 * Parser
1113 * ---------------------------------------------------------------------------*/
1114
1115 /* Token types */
1116 #define JIM_TT_NONE -1 /* No token returned */
1117 #define JIM_TT_STR 0 /* simple string */
1118 #define JIM_TT_ESC 1 /* string that needs escape chars conversion */
1119 #define JIM_TT_VAR 2 /* var substitution */
1120 #define JIM_TT_DICTSUGAR 3 /* Syntax sugar for [dict get], $foo(bar) */
1121 #define JIM_TT_CMD 4 /* command substitution */
1122 #define JIM_TT_SEP 5 /* word separator */
1123 #define JIM_TT_EOL 6 /* line separator */
1124
1125 /* Additional token types needed for expressions */
1126 #define JIM_TT_SUBEXPR_START 7
1127 #define JIM_TT_SUBEXPR_END 8
1128 #define JIM_TT_EXPR_NUMBER 9
1129 #define JIM_TT_EXPR_OPERATOR 10
1130
1131 /* Parser states */
1132 #define JIM_PS_DEF 0 /* Default state */
1133 #define JIM_PS_QUOTE 1 /* Inside "" */
1134
1135 /* Parser context structure. The same context is used both to parse
1136 * Tcl scripts and lists. */
1137 struct JimParserCtx {
1138 const char *prg; /* Program text */
1139 const char *p; /* Pointer to the point of the program we are parsing */
1140 int len; /* Left length of 'prg' */
1141 int linenr; /* Current line number */
1142 const char *tstart;
1143 const char *tend; /* Returned token is at tstart-tend in 'prg'. */
1144 int tline; /* Line number of the returned token */
1145 int tt; /* Token type */
1146 int eof; /* Non zero if EOF condition is true. */
1147 int state; /* Parser state */
1148 int comment; /* Non zero if the next chars may be a comment. */
1149 };
1150
1151 #define JimParserEof(c) ((c)->eof)
1152 #define JimParserTstart(c) ((c)->tstart)
1153 #define JimParserTend(c) ((c)->tend)
1154 #define JimParserTtype(c) ((c)->tt)
1155 #define JimParserTline(c) ((c)->tline)
1156
1157 static int JimParseScript(struct JimParserCtx *pc);
1158 static int JimParseSep(struct JimParserCtx *pc);
1159 static int JimParseEol(struct JimParserCtx *pc);
1160 static int JimParseCmd(struct JimParserCtx *pc);
1161 static int JimParseVar(struct JimParserCtx *pc);
1162 static int JimParseBrace(struct JimParserCtx *pc);
1163 static int JimParseStr(struct JimParserCtx *pc);
1164 static int JimParseComment(struct JimParserCtx *pc);
1165 static char *JimParserGetToken(struct JimParserCtx *pc,
1166 int *lenPtr, int *typePtr, int *linePtr);
1167
1168 /* Initialize a parser context.
1169 * 'prg' is a pointer to the program text, linenr is the line
1170 * number of the first line contained in the program. */
1171 void JimParserInit(struct JimParserCtx *pc, const char *prg,
1172 int len, int linenr)
1173 {
1174 pc->prg = prg;
1175 pc->p = prg;
1176 pc->len = len;
1177 pc->tstart = NULL;
1178 pc->tend = NULL;
1179 pc->tline = 0;
1180 pc->tt = JIM_TT_NONE;
1181 pc->eof = 0;
1182 pc->state = JIM_PS_DEF;
1183 pc->linenr = linenr;
1184 pc->comment = 1;
1185 }
1186
1187 int JimParseScript(struct JimParserCtx *pc)
1188 {
1189 while(1) { /* the while is used to reiterate with continue if needed */
1190 if (!pc->len) {
1191 pc->tstart = pc->p;
1192 pc->tend = pc->p-1;
1193 pc->tline = pc->linenr;
1194 pc->tt = JIM_TT_EOL;
1195 pc->eof = 1;
1196 return JIM_OK;
1197 }
1198 switch(*(pc->p)) {
1199 case '\\':
1200 if (*(pc->p+1) == '\n')
1201 return JimParseSep(pc);
1202 else {
1203 pc->comment = 0;
1204 return JimParseStr(pc);
1205 }
1206 break;
1207 case ' ':
1208 case '\t':
1209 case '\r':
1210 if (pc->state == JIM_PS_DEF)
1211 return JimParseSep(pc);
1212 else {
1213 pc->comment = 0;
1214 return JimParseStr(pc);
1215 }
1216 break;
1217 case '\n':
1218 case ';':
1219 pc->comment = 1;
1220 if (pc->state == JIM_PS_DEF)
1221 return JimParseEol(pc);
1222 else
1223 return JimParseStr(pc);
1224 break;
1225 case '[':
1226 pc->comment = 0;
1227 return JimParseCmd(pc);
1228 break;
1229 case '$':
1230 pc->comment = 0;
1231 if (JimParseVar(pc) == JIM_ERR) {
1232 pc->tstart = pc->tend = pc->p++; pc->len--;
1233 pc->tline = pc->linenr;
1234 pc->tt = JIM_TT_STR;
1235 return JIM_OK;
1236 } else
1237 return JIM_OK;
1238 break;
1239 case '#':
1240 if (pc->comment) {
1241 JimParseComment(pc);
1242 continue;
1243 } else {
1244 return JimParseStr(pc);
1245 }
1246 default:
1247 pc->comment = 0;
1248 return JimParseStr(pc);
1249 break;
1250 }
1251 return JIM_OK;
1252 }
1253 }
1254
1255 int JimParseSep(struct JimParserCtx *pc)
1256 {
1257 pc->tstart = pc->p;
1258 pc->tline = pc->linenr;
1259 while (*pc->p == ' ' || *pc->p == '\t' || *pc->p == '\r' ||
1260 (*pc->p == '\\' && *(pc->p+1) == '\n')) {
1261 if (*pc->p == '\\') {
1262 pc->p++; pc->len--;
1263 pc->linenr++;
1264 }
1265 pc->p++; pc->len--;
1266 }
1267 pc->tend = pc->p-1;
1268 pc->tt = JIM_TT_SEP;
1269 return JIM_OK;
1270 }
1271
1272 int JimParseEol(struct JimParserCtx *pc)
1273 {
1274 pc->tstart = pc->p;
1275 pc->tline = pc->linenr;
1276 while (*pc->p == ' ' || *pc->p == '\n' ||
1277 *pc->p == '\t' || *pc->p == '\r' || *pc->p == ';') {
1278 if (*pc->p == '\n')
1279 pc->linenr++;
1280 pc->p++; pc->len--;
1281 }
1282 pc->tend = pc->p-1;
1283 pc->tt = JIM_TT_EOL;
1284 return JIM_OK;
1285 }
1286
1287 /* Todo. Don't stop if ']' appears inside {} or quoted.
1288 * Also should handle the case of puts [string length "]"] */
1289 int JimParseCmd(struct JimParserCtx *pc)
1290 {
1291 int level = 1;
1292 int blevel = 0;
1293
1294 pc->tstart = ++pc->p; pc->len--;
1295 pc->tline = pc->linenr;
1296 while (1) {
1297 if (pc->len == 0) {
1298 break;
1299 } else if (*pc->p == '[' && blevel == 0) {
1300 level++;
1301 } else if (*pc->p == ']' && blevel == 0) {
1302 level--;
1303 if (!level) break;
1304 } else if (*pc->p == '\\') {
1305 pc->p++; pc->len--;
1306 } else if (*pc->p == '{') {
1307 blevel++;
1308 } else if (*pc->p == '}') {
1309 if (blevel != 0)
1310 blevel--;
1311 } else if (*pc->p == '\n')
1312 pc->linenr++;
1313 pc->p++; pc->len--;
1314 }
1315 pc->tend = pc->p-1;
1316 pc->tt = JIM_TT_CMD;
1317 if (*pc->p == ']') {
1318 pc->p++; pc->len--;
1319 }
1320 return JIM_OK;
1321 }
1322
1323 int JimParseVar(struct JimParserCtx *pc)
1324 {
1325 int brace = 0, stop = 0, ttype = JIM_TT_VAR;
1326
1327 pc->tstart = ++pc->p; pc->len--; /* skip the $ */
1328 pc->tline = pc->linenr;
1329 if (*pc->p == '{') {
1330 pc->tstart = ++pc->p; pc->len--;
1331 brace = 1;
1332 }
1333 if (brace) {
1334 while (!stop) {
1335 if (*pc->p == '}' || pc->len == 0) {
1336 pc->tend = pc->p-1;
1337 stop = 1;
1338 if (pc->len == 0)
1339 break;
1340 }
1341 else if (*pc->p == '\n')
1342 pc->linenr++;
1343 pc->p++; pc->len--;
1344 }
1345 } else {
1346 /* Include leading colons */
1347 while (*pc->p == ':') {
1348 pc->p++;
1349 pc->len--;
1350 }
1351 while (!stop) {
1352 if (!((*pc->p >= 'a' && *pc->p <= 'z') ||
1353 (*pc->p >= 'A' && *pc->p <= 'Z') ||
1354 (*pc->p >= '0' && *pc->p <= '9') || *pc->p == '_'))
1355 stop = 1;
1356 else {
1357 pc->p++; pc->len--;
1358 }
1359 }
1360 /* Parse [dict get] syntax sugar. */
1361 if (*pc->p == '(') {
1362 while (*pc->p != ')' && pc->len) {
1363 pc->p++; pc->len--;
1364 if (*pc->p == '\\' && pc->len >= 2) {
1365 pc->p += 2; pc->len -= 2;
1366 }
1367 }
1368 if (*pc->p != '\0') {
1369 pc->p++; pc->len--;
1370 }
1371 ttype = JIM_TT_DICTSUGAR;
1372 }
1373 pc->tend = pc->p-1;
1374 }
1375 /* Check if we parsed just the '$' character.
1376 * That's not a variable so an error is returned
1377 * to tell the state machine to consider this '$' just
1378 * a string. */
1379 if (pc->tstart == pc->p) {
1380 pc->p--; pc->len++;
1381 return JIM_ERR;
1382 }
1383 pc->tt = ttype;
1384 return JIM_OK;
1385 }
1386
1387 int JimParseBrace(struct JimParserCtx *pc)
1388 {
1389 int level = 1;
1390
1391 pc->tstart = ++pc->p; pc->len--;
1392 pc->tline = pc->linenr;
1393 while (1) {
1394 if (*pc->p == '\\' && pc->len >= 2) {
1395 pc->p++; pc->len--;
1396 if (*pc->p == '\n')
1397 pc->linenr++;
1398 } else if (*pc->p == '{') {
1399 level++;
1400 } else if (pc->len == 0 || *pc->p == '}') {
1401 level--;
1402 if (pc->len == 0 || level == 0) {
1403 pc->tend = pc->p-1;
1404 if (pc->len != 0) {
1405 pc->p++; pc->len--;
1406 }
1407 pc->tt = JIM_TT_STR;
1408 return JIM_OK;
1409 }
1410 } else if (*pc->p == '\n') {
1411 pc->linenr++;
1412 }
1413 pc->p++; pc->len--;
1414 }
1415 return JIM_OK; /* unreached */
1416 }
1417
1418 int JimParseStr(struct JimParserCtx *pc)
1419 {
1420 int newword = (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1421 pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR);
1422 if (newword && *pc->p == '{') {
1423 return JimParseBrace(pc);
1424 } else if (newword && *pc->p == '"') {
1425 pc->state = JIM_PS_QUOTE;
1426 pc->p++; pc->len--;
1427 }
1428 pc->tstart = pc->p;
1429 pc->tline = pc->linenr;
1430 while (1) {
1431 if (pc->len == 0) {
1432 pc->tend = pc->p-1;
1433 pc->tt = JIM_TT_ESC;
1434 return JIM_OK;
1435 }
1436 switch(*pc->p) {
1437 case '\\':
1438 if (pc->state == JIM_PS_DEF &&
1439 *(pc->p+1) == '\n') {
1440 pc->tend = pc->p-1;
1441 pc->tt = JIM_TT_ESC;
1442 return JIM_OK;
1443 }
1444 if (pc->len >= 2) {
1445 pc->p++; pc->len--;
1446 }
1447 break;
1448 case '$':
1449 case '[':
1450 pc->tend = pc->p-1;
1451 pc->tt = JIM_TT_ESC;
1452 return JIM_OK;
1453 case ' ':
1454 case '\t':
1455 case '\n':
1456 case '\r':
1457 case ';':
1458 if (pc->state == JIM_PS_DEF) {
1459 pc->tend = pc->p-1;
1460 pc->tt = JIM_TT_ESC;
1461 return JIM_OK;
1462 } else if (*pc->p == '\n') {
1463 pc->linenr++;
1464 }
1465 break;
1466 case '"':
1467 if (pc->state == JIM_PS_QUOTE) {
1468 pc->tend = pc->p-1;
1469 pc->tt = JIM_TT_ESC;
1470 pc->p++; pc->len--;
1471 pc->state = JIM_PS_DEF;
1472 return JIM_OK;
1473 }
1474 break;
1475 }
1476 pc->p++; pc->len--;
1477 }
1478 return JIM_OK; /* unreached */
1479 }
1480
1481 int JimParseComment(struct JimParserCtx *pc)
1482 {
1483 while (*pc->p) {
1484 if (*pc->p == '\n') {
1485 pc->linenr++;
1486 if (*(pc->p-1) != '\\') {
1487 pc->p++; pc->len--;
1488 return JIM_OK;
1489 }
1490 }
1491 pc->p++; pc->len--;
1492 }
1493 return JIM_OK;
1494 }
1495
1496 /* xdigitval and odigitval are helper functions for JimParserGetToken() */
1497 static int xdigitval(int c)
1498 {
1499 if (c >= '0' && c <= '9') return c-'0';
1500 if (c >= 'a' && c <= 'f') return c-'a'+10;
1501 if (c >= 'A' && c <= 'F') return c-'A'+10;
1502 return -1;
1503 }
1504
1505 static int odigitval(int c)
1506 {
1507 if (c >= '0' && c <= '7') return c-'0';
1508 return -1;
1509 }
1510
1511 /* Perform Tcl escape substitution of 's', storing the result
1512 * string into 'dest'. The escaped string is guaranteed to
1513 * be the same length or shorted than the source string.
1514 * Slen is the length of the string at 's', if it's -1 the string
1515 * length will be calculated by the function.
1516 *
1517 * The function returns the length of the resulting string. */
1518 static int JimEscape(char *dest, const char *s, int slen)
1519 {
1520 char *p = dest;
1521 int i, len;
1522
1523 if (slen == -1)
1524 slen = strlen(s);
1525
1526 for (i = 0; i < slen; i++) {
1527 switch(s[i]) {
1528 case '\\':
1529 switch(s[i+1]) {
1530 case 'a': *p++ = 0x7; i++; break;
1531 case 'b': *p++ = 0x8; i++; break;
1532 case 'f': *p++ = 0xc; i++; break;
1533 case 'n': *p++ = 0xa; i++; break;
1534 case 'r': *p++ = 0xd; i++; break;
1535 case 't': *p++ = 0x9; i++; break;
1536 case 'v': *p++ = 0xb; i++; break;
1537 case '\0': *p++ = '\\'; i++; break;
1538 case '\n': *p++ = ' '; i++; break;
1539 default:
1540 if (s[i+1] == 'x') {
1541 int val = 0;
1542 int c = xdigitval(s[i+2]);
1543 if (c == -1) {
1544 *p++ = 'x';
1545 i++;
1546 break;
1547 }
1548 val = c;
1549 c = xdigitval(s[i+3]);
1550 if (c == -1) {
1551 *p++ = val;
1552 i += 2;
1553 break;
1554 }
1555 val = (val*16)+c;
1556 *p++ = val;
1557 i += 3;
1558 break;
1559 } else if (s[i+1] >= '0' && s[i+1] <= '7')
1560 {
1561 int val = 0;
1562 int c = odigitval(s[i+1]);
1563 val = c;
1564 c = odigitval(s[i+2]);
1565 if (c == -1) {
1566 *p++ = val;
1567 i ++;
1568 break;
1569 }
1570 val = (val*8)+c;
1571 c = odigitval(s[i+3]);
1572 if (c == -1) {
1573 *p++ = val;
1574 i += 2;
1575 break;
1576 }
1577 val = (val*8)+c;
1578 *p++ = val;
1579 i += 3;
1580 } else {
1581 *p++ = s[i+1];
1582 i++;
1583 }
1584 break;
1585 }
1586 break;
1587 default:
1588 *p++ = s[i];
1589 break;
1590 }
1591 }
1592 len = p-dest;
1593 *p++ = '\0';
1594 return len;
1595 }
1596
1597 /* Returns a dynamically allocated copy of the current token in the
1598 * parser context. The function perform conversion of escapes if
1599 * the token is of type JIM_TT_ESC.
1600 *
1601 * Note that after the conversion, tokens that are grouped with
1602 * braces in the source code, are always recognizable from the
1603 * identical string obtained in a different way from the type.
1604 *
1605 * For exmple the string:
1606 *
1607 * {expand}$a
1608 *
1609 * will return as first token "expand", of type JIM_TT_STR
1610 *
1611 * While the string:
1612 *
1613 * expand$a
1614 *
1615 * will return as first token "expand", of type JIM_TT_ESC
1616 */
1617 char *JimParserGetToken(struct JimParserCtx *pc,
1618 int *lenPtr, int *typePtr, int *linePtr)
1619 {
1620 const char *start, *end;
1621 char *token;
1622 int len;
1623
1624 start = JimParserTstart(pc);
1625 end = JimParserTend(pc);
1626 if (start > end) {
1627 if (lenPtr) *lenPtr = 0;
1628 if (typePtr) *typePtr = JimParserTtype(pc);
1629 if (linePtr) *linePtr = JimParserTline(pc);
1630 token = Jim_Alloc(1);
1631 token[0] = '\0';
1632 return token;
1633 }
1634 len = (end-start)+1;
1635 token = Jim_Alloc(len+1);
1636 if (JimParserTtype(pc) != JIM_TT_ESC) {
1637 /* No escape conversion needed? Just copy it. */
1638 memcpy(token, start, len);
1639 token[len] = '\0';
1640 } else {
1641 /* Else convert the escape chars. */
1642 len = JimEscape(token, start, len);
1643 }
1644 if (lenPtr) *lenPtr = len;
1645 if (typePtr) *typePtr = JimParserTtype(pc);
1646 if (linePtr) *linePtr = JimParserTline(pc);
1647 return token;
1648 }
1649
1650 /* The following functin is not really part of the parsing engine of Jim,
1651 * but it somewhat related. Given an string and its length, it tries
1652 * to guess if the script is complete or there are instead " " or { }
1653 * open and not completed. This is useful for interactive shells
1654 * implementation and for [info complete].
1655 *
1656 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
1657 * '{' on scripts incomplete missing one or more '}' to be balanced.
1658 * '"' on scripts incomplete missing a '"' char.
1659 *
1660 * If the script is complete, 1 is returned, otherwise 0. */
1661 int Jim_ScriptIsComplete(const char *s, int len, char *stateCharPtr)
1662 {
1663 int level = 0;
1664 int state = ' ';
1665
1666 while(len) {
1667 switch (*s) {
1668 case '\\':
1669 if (len > 1)
1670 s++;
1671 break;
1672 case '"':
1673 if (state == ' ') {
1674 state = '"';
1675 } else if (state == '"') {
1676 state = ' ';
1677 }
1678 break;
1679 case '{':
1680 if (state == '{') {
1681 level++;
1682 } else if (state == ' ') {
1683 state = '{';
1684 level++;
1685 }
1686 break;
1687 case '}':
1688 if (state == '{') {
1689 level--;
1690 if (level == 0)
1691 state = ' ';
1692 }
1693 break;
1694 }
1695 s++;
1696 len--;
1697 }
1698 if (stateCharPtr)
1699 *stateCharPtr = state;
1700 return state == ' ';
1701 }
1702
1703 /* -----------------------------------------------------------------------------
1704 * Tcl Lists parsing
1705 * ---------------------------------------------------------------------------*/
1706 static int JimParseListSep(struct JimParserCtx *pc);
1707 static int JimParseListStr(struct JimParserCtx *pc);
1708
1709 int JimParseList(struct JimParserCtx *pc)
1710 {
1711 if (pc->len == 0) {
1712 pc->tstart = pc->tend = pc->p;
1713 pc->tline = pc->linenr;
1714 pc->tt = JIM_TT_EOL;
1715 pc->eof = 1;
1716 return JIM_OK;
1717 }
1718 switch(*pc->p) {
1719 case ' ':
1720 case '\n':
1721 case '\t':
1722 case '\r':
1723 if (pc->state == JIM_PS_DEF)
1724 return JimParseListSep(pc);
1725 else
1726 return JimParseListStr(pc);
1727 break;
1728 default:
1729 return JimParseListStr(pc);
1730 break;
1731 }
1732 return JIM_OK;
1733 }
1734
1735 int JimParseListSep(struct JimParserCtx *pc)
1736 {
1737 pc->tstart = pc->p;
1738 pc->tline = pc->linenr;
1739 while (*pc->p == ' ' || *pc->p == '\t' || *pc->p == '\r' || *pc->p == '\n')
1740 {
1741 pc->p++; pc->len--;
1742 }
1743 pc->tend = pc->p-1;
1744 pc->tt = JIM_TT_SEP;
1745 return JIM_OK;
1746 }
1747
1748 int JimParseListStr(struct JimParserCtx *pc)
1749 {
1750 int newword = (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1751 pc->tt == JIM_TT_NONE);
1752 if (newword && *pc->p == '{') {
1753 return JimParseBrace(pc);
1754 } else if (newword && *pc->p == '"') {
1755 pc->state = JIM_PS_QUOTE;
1756 pc->p++; pc->len--;
1757 }
1758 pc->tstart = pc->p;
1759 pc->tline = pc->linenr;
1760 while (1) {
1761 if (pc->len == 0) {
1762 pc->tend = pc->p-1;
1763 pc->tt = JIM_TT_ESC;
1764 return JIM_OK;
1765 }
1766 switch(*pc->p) {
1767 case '\\':
1768 pc->p++; pc->len--;
1769 break;
1770 case ' ':
1771 case '\t':
1772 case '\n':
1773 case '\r':
1774 if (pc->state == JIM_PS_DEF) {
1775 pc->tend = pc->p-1;
1776 pc->tt = JIM_TT_ESC;
1777 return JIM_OK;
1778 } else if (*pc->p == '\n') {
1779 pc->linenr++;
1780 }
1781 break;
1782 case '"':
1783 if (pc->state == JIM_PS_QUOTE) {
1784 pc->tend = pc->p-1;
1785 pc->tt = JIM_TT_ESC;
1786 pc->p++; pc->len--;
1787 pc->state = JIM_PS_DEF;
1788 return JIM_OK;
1789 }
1790 break;
1791 }
1792 pc->p++; pc->len--;
1793 }
1794 return JIM_OK; /* unreached */
1795 }
1796
1797 /* -----------------------------------------------------------------------------
1798 * Jim_Obj related functions
1799 * ---------------------------------------------------------------------------*/
1800
1801 /* Return a new initialized object. */
1802 Jim_Obj *Jim_NewObj(Jim_Interp *interp)
1803 {
1804 Jim_Obj *objPtr;
1805
1806 /* -- Check if there are objects in the free list -- */
1807 if (interp->freeList != NULL) {
1808 /* -- Unlink the object from the free list -- */
1809 objPtr = interp->freeList;
1810 interp->freeList = objPtr->nextObjPtr;
1811 } else {
1812 /* -- No ready to use objects: allocate a new one -- */
1813 objPtr = Jim_Alloc(sizeof(*objPtr));
1814 }
1815
1816 /* Object is returned with refCount of 0. Every
1817 * kind of GC implemented should take care to don't try
1818 * to scan objects with refCount == 0. */
1819 objPtr->refCount = 0;
1820 /* All the other fields are left not initialized to save time.
1821 * The caller will probably want set they to the right
1822 * value anyway. */
1823
1824 /* -- Put the object into the live list -- */
1825 objPtr->prevObjPtr = NULL;
1826 objPtr->nextObjPtr = interp->liveList;
1827 if (interp->liveList)
1828 interp->liveList->prevObjPtr = objPtr;
1829 interp->liveList = objPtr;
1830
1831 return objPtr;
1832 }
1833
1834 /* Free an object. Actually objects are never freed, but
1835 * just moved to the free objects list, where they will be
1836 * reused by Jim_NewObj(). */
1837 void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr)
1838 {
1839 /* Check if the object was already freed, panic. */
1840 if (objPtr->refCount != 0) {
1841 Jim_Panic(interp,"!!!Object %p freed with bad refcount %d", objPtr,
1842 objPtr->refCount);
1843 }
1844 /* Free the internal representation */
1845 Jim_FreeIntRep(interp, objPtr);
1846 /* Free the string representation */
1847 if (objPtr->bytes != NULL) {
1848 if (objPtr->bytes != JimEmptyStringRep)
1849 Jim_Free(objPtr->bytes);
1850 }
1851 /* Unlink the object from the live objects list */
1852 if (objPtr->prevObjPtr)
1853 objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr;
1854 if (objPtr->nextObjPtr)
1855 objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr;
1856 if (interp->liveList == objPtr)
1857 interp->liveList = objPtr->nextObjPtr;
1858 /* Link the object into the free objects list */
1859 objPtr->prevObjPtr = NULL;
1860 objPtr->nextObjPtr = interp->freeList;
1861 if (interp->freeList)
1862 interp->freeList->prevObjPtr = objPtr;
1863 interp->freeList = objPtr;
1864 objPtr->refCount = -1;
1865 }
1866
1867 /* Invalidate the string representation of an object. */
1868 void Jim_InvalidateStringRep(Jim_Obj *objPtr)
1869 {
1870 if (objPtr->bytes != NULL) {
1871 if (objPtr->bytes != JimEmptyStringRep)
1872 Jim_Free(objPtr->bytes);
1873 }
1874 objPtr->bytes = NULL;
1875 }
1876
1877 #define Jim_SetStringRep(o, b, l) \
1878 do { (o)->bytes = b; (o)->length = l; } while (0)
1879
1880 /* Set the initial string representation for an object.
1881 * Does not try to free an old one. */
1882 void Jim_InitStringRep(Jim_Obj *objPtr, const char *bytes, int length)
1883 {
1884 if (length == 0) {
1885 objPtr->bytes = JimEmptyStringRep;
1886 objPtr->length = 0;
1887 } else {
1888 objPtr->bytes = Jim_Alloc(length+1);
1889 objPtr->length = length;
1890 memcpy(objPtr->bytes, bytes, length);
1891 objPtr->bytes[length] = '\0';
1892 }
1893 }
1894
1895 /* Duplicate an object. The returned object has refcount = 0. */
1896 Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
1897 {
1898 Jim_Obj *dupPtr;
1899
1900 dupPtr = Jim_NewObj(interp);
1901 if (objPtr->bytes == NULL) {
1902 /* Object does not have a valid string representation. */
1903 dupPtr->bytes = NULL;
1904 } else {
1905 Jim_InitStringRep(dupPtr, objPtr->bytes, objPtr->length);
1906 }
1907 if (objPtr->typePtr != NULL) {
1908 if (objPtr->typePtr->dupIntRepProc == NULL) {
1909 dupPtr->internalRep = objPtr->internalRep;
1910 } else {
1911 objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr);
1912 }
1913 dupPtr->typePtr = objPtr->typePtr;
1914 } else {
1915 dupPtr->typePtr = NULL;
1916 }
1917 return dupPtr;
1918 }
1919
1920 /* Return the string representation for objPtr. If the object
1921 * string representation is invalid, calls the method to create
1922 * a new one starting from the internal representation of the object. */
1923 const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr)
1924 {
1925 if (objPtr->bytes == NULL) {
1926 /* Invalid string repr. Generate it. */
1927 if (objPtr->typePtr->updateStringProc == NULL) {
1928 Jim_Panic(NULL,"UpdataStringProc called against '%s' type.",
1929 objPtr->typePtr->name);
1930 }
1931 objPtr->typePtr->updateStringProc(objPtr);
1932 }
1933 if (lenPtr)
1934 *lenPtr = objPtr->length;
1935 return objPtr->bytes;
1936 }
1937
1938 /* Just returns the length of the object's string rep */
1939 int Jim_Length(Jim_Obj *objPtr)
1940 {
1941 int len;
1942
1943 Jim_GetString(objPtr, &len);
1944 return len;
1945 }
1946
1947 /* -----------------------------------------------------------------------------
1948 * String Object
1949 * ---------------------------------------------------------------------------*/
1950 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
1951 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
1952
1953 static Jim_ObjType stringObjType = {
1954 "string",
1955 NULL,
1956 DupStringInternalRep,
1957 NULL,
1958 JIM_TYPE_REFERENCES,
1959 };
1960
1961 void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
1962 {
1963 JIM_NOTUSED(interp);
1964
1965 /* This is a bit subtle: the only caller of this function
1966 * should be Jim_DuplicateObj(), that will copy the
1967 * string representaion. After the copy, the duplicated
1968 * object will not have more room in teh buffer than
1969 * srcPtr->length bytes. So we just set it to length. */
1970 dupPtr->internalRep.strValue.maxLength = srcPtr->length;
1971 }
1972
1973 int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
1974 {
1975 /* Get a fresh string representation. */
1976 (void) Jim_GetString(objPtr, NULL);
1977 /* Free any other internal representation. */
1978 Jim_FreeIntRep(interp, objPtr);
1979 /* Set it as string, i.e. just set the maxLength field. */
1980 objPtr->typePtr = &stringObjType;
1981 objPtr->internalRep.strValue.maxLength = objPtr->length;
1982 return JIM_OK;
1983 }
1984
1985 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
1986 {
1987 Jim_Obj *objPtr = Jim_NewObj(interp);
1988
1989 if (len == -1)
1990 len = strlen(s);
1991 /* Alloc/Set the string rep. */
1992 if (len == 0) {
1993 objPtr->bytes = JimEmptyStringRep;
1994 objPtr->length = 0;
1995 } else {
1996 objPtr->bytes = Jim_Alloc(len+1);
1997 objPtr->length = len;
1998 memcpy(objPtr->bytes, s, len);
1999 objPtr->bytes[len] = '\0';
2000 }
2001
2002 /* No typePtr field for the vanilla string object. */
2003 objPtr->typePtr = NULL;
2004 return objPtr;
2005 }
2006
2007 /* This version does not try to duplicate the 's' pointer, but
2008 * use it directly. */
2009 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
2010 {
2011 Jim_Obj *objPtr = Jim_NewObj(interp);
2012
2013 if (len == -1)
2014 len = strlen(s);
2015 Jim_SetStringRep(objPtr, s, len);
2016 objPtr->typePtr = NULL;
2017 return objPtr;
2018 }
2019
2020 /* Low-level string append. Use it only against objects
2021 * of type "string". */
2022 void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
2023 {
2024 int needlen;
2025
2026 if (len == -1)
2027 len = strlen(str);
2028 needlen = objPtr->length + len;
2029 if (objPtr->internalRep.strValue.maxLength < needlen ||
2030 objPtr->internalRep.strValue.maxLength == 0) {
2031 if (objPtr->bytes == JimEmptyStringRep) {
2032 objPtr->bytes = Jim_Alloc((needlen*2)+1);
2033 } else {
2034 objPtr->bytes = Jim_Realloc(objPtr->bytes, (needlen*2)+1);
2035 }
2036 objPtr->internalRep.strValue.maxLength = needlen*2;
2037 }
2038 memcpy(objPtr->bytes + objPtr->length, str, len);
2039 objPtr->bytes[objPtr->length+len] = '\0';
2040 objPtr->length += len;
2041 }
2042
2043 /* Low-level wrapper to append an object. */
2044 void StringAppendObj(Jim_Obj *objPtr, Jim_Obj *appendObjPtr)
2045 {
2046 int len;
2047 const char *str;
2048
2049 str = Jim_GetString(appendObjPtr, &len);
2050 StringAppendString(objPtr, str, len);
2051 }
2052
2053 /* Higher level API to append strings to objects. */
2054 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str,
2055 int len)
2056 {
2057 if (Jim_IsShared(objPtr))
2058 Jim_Panic(interp,"Jim_AppendString called with shared object");
2059 if (objPtr->typePtr != &stringObjType)
2060 SetStringFromAny(interp, objPtr);
2061 StringAppendString(objPtr, str, len);
2062 }
2063
2064 void Jim_AppendString_sprintf( Jim_Interp *interp, Jim_Obj *objPtr, const char *fmt, ... )
2065 {
2066 char *buf;
2067 va_list ap;
2068
2069 va_start( ap, fmt );
2070 buf = jim_vasprintf( fmt, ap );
2071 va_end(ap);
2072
2073 if( buf ){
2074 Jim_AppendString( interp, objPtr, buf, -1 );
2075 jim_vasprintf_done(buf);
2076 }
2077 }
2078
2079
2080 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr,
2081 Jim_Obj *appendObjPtr)
2082 {
2083 int len;
2084 const char *str;
2085
2086 str = Jim_GetString(appendObjPtr, &len);
2087 Jim_AppendString(interp, objPtr, str, len);
2088 }
2089
2090 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2091 {
2092 va_list ap;
2093
2094 if (objPtr->typePtr != &stringObjType)
2095 SetStringFromAny(interp, objPtr);
2096 va_start(ap, objPtr);
2097 while (1) {
2098 char *s = va_arg(ap, char*);
2099
2100 if (s == NULL) break;
2101 Jim_AppendString(interp, objPtr, s, -1);
2102 }
2103 va_end(ap);
2104 }
2105
2106 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr, int nocase)
2107 {
2108 const char *aStr, *bStr;
2109 int aLen, bLen, i;
2110
2111 if (aObjPtr == bObjPtr) return 1;
2112 aStr = Jim_GetString(aObjPtr, &aLen);
2113 bStr = Jim_GetString(bObjPtr, &bLen);
2114 if (aLen != bLen) return 0;
2115 if (nocase == 0)
2116 return memcmp(aStr, bStr, aLen) == 0;
2117 for (i = 0; i < aLen; i++) {
2118 if (tolower((int)aStr[i]) != tolower((int)bStr[i]))
2119 return 0;
2120 }
2121 return 1;
2122 }
2123
2124 int Jim_StringMatchObj(Jim_Obj *patternObjPtr, Jim_Obj *objPtr,
2125 int nocase)
2126 {
2127 const char *pattern, *string;
2128 int patternLen, stringLen;
2129
2130 pattern = Jim_GetString(patternObjPtr, &patternLen);
2131 string = Jim_GetString(objPtr, &stringLen);
2132 return JimStringMatch(pattern, patternLen, string, stringLen, nocase);
2133 }
2134
2135 int Jim_StringCompareObj(Jim_Obj *firstObjPtr,
2136 Jim_Obj *secondObjPtr, int nocase)
2137 {
2138 const char *s1, *s2;
2139 int l1, l2;
2140
2141 s1 = Jim_GetString(firstObjPtr, &l1);
2142 s2 = Jim_GetString(secondObjPtr, &l2);
2143 return JimStringCompare(s1, l1, s2, l2, nocase);
2144 }
2145
2146 /* Convert a range, as returned by Jim_GetRange(), into
2147 * an absolute index into an object of the specified length.
2148 * This function may return negative values, or values
2149 * bigger or equal to the length of the list if the index
2150 * is out of range. */
2151 static int JimRelToAbsIndex(int len, int index)
2152 {
2153 if (index < 0)
2154 return len + index;
2155 return index;
2156 }
2157
2158 /* Convert a pair of index as normalize by JimRelToAbsIndex(),
2159 * into a range stored in *firstPtr, *lastPtr, *rangeLenPtr, suitable
2160 * for implementation of commands like [string range] and [lrange].
2161 *
2162 * The resulting range is guaranteed to address valid elements of
2163 * the structure. */
2164 static void JimRelToAbsRange(int len, int first, int last,
2165 int *firstPtr, int *lastPtr, int *rangeLenPtr)
2166 {
2167 int rangeLen;
2168
2169 if (first > last) {
2170 rangeLen = 0;
2171 } else {
2172 rangeLen = last-first+1;
2173 if (rangeLen) {
2174 if (first < 0) {
2175 rangeLen += first;
2176 first = 0;
2177 }
2178 if (last >= len) {
2179 rangeLen -= (last-(len-1));
2180 last = len-1;
2181 }
2182 }
2183 }
2184 if (rangeLen < 0) rangeLen = 0;
2185
2186 *firstPtr = first;
2187 *lastPtr = last;
2188 *rangeLenPtr = rangeLen;
2189 }
2190
2191 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2192 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2193 {
2194 int first, last;
2195 const char *str;
2196 int len, rangeLen;
2197
2198 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
2199 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
2200 return NULL;
2201 str = Jim_GetString(strObjPtr, &len);
2202 first = JimRelToAbsIndex(len, first);
2203 last = JimRelToAbsIndex(len, last);
2204 JimRelToAbsRange(len, first, last, &first, &last, &rangeLen);
2205 return Jim_NewStringObj(interp, str+first, rangeLen);
2206 }
2207
2208 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2209 {
2210 char *buf;
2211 int i;
2212 if (strObjPtr->typePtr != &stringObjType) {
2213 SetStringFromAny(interp, strObjPtr);
2214 }
2215
2216 buf = Jim_Alloc(strObjPtr->length+1);
2217
2218 memcpy(buf, strObjPtr->bytes, strObjPtr->length+1);
2219 for (i = 0; i < strObjPtr->length; i++)
2220 buf[i] = tolower(buf[i]);
2221 return Jim_NewStringObjNoAlloc(interp, buf, strObjPtr->length);
2222 }
2223
2224 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2225 {
2226 char *buf;
2227 int i;
2228 if (strObjPtr->typePtr != &stringObjType) {
2229 SetStringFromAny(interp, strObjPtr);
2230 }
2231
2232 buf = Jim_Alloc(strObjPtr->length+1);
2233
2234 memcpy(buf, strObjPtr->bytes, strObjPtr->length+1);
2235 for (i = 0; i < strObjPtr->length; i++)
2236 buf[i] = toupper(buf[i]);
2237 return Jim_NewStringObjNoAlloc(interp, buf, strObjPtr->length);
2238 }
2239
2240 /* This is the core of the [format] command.
2241 * TODO: Lots of things work - via a hack
2242 * However, no format item can be >= JIM_MAX_FMT
2243 */
2244 #define JIM_MAX_FMT 2048
2245 static Jim_Obj *Jim_FormatString_Inner(Jim_Interp *interp, Jim_Obj *fmtObjPtr,
2246 int objc, Jim_Obj *const *objv, char *sprintf_buf)
2247 {
2248 const char *fmt, *_fmt;
2249 int fmtLen;
2250 Jim_Obj *resObjPtr;
2251
2252
2253 fmt = Jim_GetString(fmtObjPtr, &fmtLen);
2254 _fmt = fmt;
2255 resObjPtr = Jim_NewStringObj(interp, "", 0);
2256 while (fmtLen) {
2257 const char *p = fmt;
2258 char spec[2], c;
2259 jim_wide wideValue;
2260 double doubleValue;
2261 /* we cheat and use Sprintf()! */
2262 char fmt_str[100];
2263 char *cp;
2264 int width;
2265 int ljust;
2266 int zpad;
2267 int spad;
2268 int altfm;
2269 int forceplus;
2270 int prec;
2271 int inprec;
2272 int haveprec;
2273 int accum;
2274
2275 while (*fmt != '%' && fmtLen) {
2276 fmt++; fmtLen--;
2277 }
2278 Jim_AppendString(interp, resObjPtr, p, fmt-p);
2279 if (fmtLen == 0)
2280 break;
2281 fmt++; fmtLen--; /* skip '%' */
2282 zpad = 0;
2283 spad = 0;
2284 width = -1;
2285 ljust = 0;
2286 altfm = 0;
2287 forceplus = 0;
2288 inprec = 0;
2289 haveprec = 0;
2290 prec = -1; /* not found yet */
2291 next_fmt:
2292 if( fmtLen <= 0 ){
2293 break;
2294 }
2295 switch( *fmt ){
2296 /* terminals */
2297 case 'b': /* binary - not all printfs() do this */
2298 case 's': /* string */
2299 case 'i': /* integer */
2300 case 'd': /* decimal */
2301 case 'x': /* hex */
2302 case 'X': /* CAP hex */
2303 case 'c': /* char */
2304 case 'o': /* octal */
2305 case 'u': /* unsigned */
2306 case 'f': /* float */
2307 break;
2308
2309 /* non-terminals */
2310 case '0': /* zero pad */
2311 zpad = 1;
2312 fmt++; fmtLen--;
2313 goto next_fmt;
2314 break;
2315 case '+':
2316 forceplus = 1;
2317 fmt++; fmtLen--;
2318 goto next_fmt;
2319 break;
2320 case ' ': /* sign space */
2321 spad = 1;
2322 fmt++; fmtLen--;
2323 goto next_fmt;
2324 break;
2325 case '-':
2326 ljust = 1;
2327 fmt++; fmtLen--;
2328 goto next_fmt;
2329 break;
2330 case '#':
2331 altfm = 1;
2332 fmt++; fmtLen--;
2333 goto next_fmt;
2334
2335 case '.':
2336 inprec = 1;
2337 fmt++; fmtLen--;
2338 goto next_fmt;
2339 break;
2340 case '1':
2341 case '2':
2342 case '3':
2343 case '4':
2344 case '5':
2345 case '6':
2346 case '7':
2347 case '8':
2348 case '9':
2349 accum = 0;
2350 while( isdigit(*fmt) && (fmtLen > 0) ){
2351 accum = (accum * 10) + (*fmt - '0');
2352 fmt++; fmtLen--;
2353 }
2354 if( inprec ){
2355 haveprec = 1;
2356 prec = accum;
2357 } else {
2358 width = accum;
2359 }
2360 goto next_fmt;
2361 case '*':
2362 /* suck up the next item as an integer */
2363 fmt++; fmtLen--;
2364 objc--;
2365 if( objc <= 0 ){
2366 goto not_enough_args;
2367 }
2368 if( Jim_GetWide(interp,objv[0],&wideValue )== JIM_ERR ){
2369 Jim_FreeNewObj(interp, resObjPtr );
2370 return NULL;
2371 }
2372 if( inprec ){
2373 haveprec = 1;
2374 prec = wideValue;
2375 if( prec < 0 ){
2376 /* man 3 printf says */
2377 /* if prec is negative, it is zero */
2378 prec = 0;
2379 }
2380 } else {
2381 width = wideValue;
2382 if( width < 0 ){
2383 ljust = 1;
2384 width = -width;
2385 }
2386 }
2387 objv++;
2388 goto next_fmt;
2389 break;
2390 }
2391
2392
2393 if (*fmt != '%') {
2394 if (objc == 0) {
2395 not_enough_args:
2396 Jim_FreeNewObj(interp, resObjPtr);
2397 Jim_SetResultString(interp,
2398 "not enough arguments for all format specifiers", -1);
2399 return NULL;
2400 } else {
2401 objc--;
2402 }
2403 }
2404
2405 /*
2406 * Create the formatter
2407 * cause we cheat and use sprintf()
2408 */
2409 cp = fmt_str;
2410 *cp++ = '%';
2411 if( altfm ){
2412 *cp++ = '#';
2413 }
2414 if( forceplus ){
2415 *cp++ = '+';
2416 } else if( spad ){
2417 /* PLUS overrides */
2418 *cp++ = ' ';
2419 }
2420 if( ljust ){
2421 *cp++ = '-';
2422 }
2423 if( zpad ){
2424 *cp++ = '0';
2425 }
2426 if( width > 0 ){
2427 sprintf( cp, "%d", width );
2428 /* skip ahead */
2429 cp = strchr(cp,0);
2430 }
2431 /* did we find a period? */
2432 if( inprec ){
2433 /* then add it */
2434 *cp++ = '.';
2435 /* did something occur after the period? */
2436 if( haveprec ){
2437 sprintf( cp, "%d", prec );
2438 }
2439 cp = strchr(cp,0);
2440 }
2441 *cp = 0;
2442
2443 /* here we do the work */
2444 /* actually - we make sprintf() do it for us */
2445 switch(*fmt) {
2446 case 's':
2447 *cp++ = 's';
2448 *cp = 0;
2449 /* BUG: we do not handled embeded NULLs */
2450 snprintf( sprintf_buf, JIM_MAX_FMT, fmt_str, Jim_GetString( objv[0], NULL ));
2451 break;
2452 case 'c':
2453 *cp++ = 'c';
2454 *cp = 0;
2455 if (Jim_GetWide(interp, objv[0], &wideValue) == JIM_ERR) {
2456 Jim_FreeNewObj(interp, resObjPtr);
2457 return NULL;
2458 }
2459 c = (char) wideValue;
2460 snprintf( sprintf_buf, JIM_MAX_FMT, fmt_str, c );
2461 break;
2462 case 'f':
2463 case 'F':
2464 case 'g':
2465 case 'G':
2466 case 'e':
2467 case 'E':
2468 *cp++ = *fmt;
2469 *cp = 0;
2470 if( Jim_GetDouble( interp, objv[0], &doubleValue ) == JIM_ERR ){
2471 Jim_FreeNewObj( interp, resObjPtr );
2472 return NULL;
2473 }
2474 snprintf( sprintf_buf, JIM_MAX_FMT, fmt_str, doubleValue );
2475 break;
2476 case 'b':
2477 case 'd':
2478 case 'o':
2479 case 'i':
2480 case 'u':
2481 case 'x':
2482 case 'X':
2483 /* jim widevaluse are 64bit */
2484 if( sizeof(jim_wide) == sizeof(long long) ){
2485 *cp++ = 'l';
2486 *cp++ = 'l';
2487 } else {
2488 *cp++ = 'l';
2489 }
2490 *cp++ = *fmt;
2491 *cp = 0;
2492 if (Jim_GetWide(interp, objv[0], &wideValue) == JIM_ERR) {
2493 Jim_FreeNewObj(interp, resObjPtr);
2494 return NULL;
2495 }
2496 snprintf(sprintf_buf, JIM_MAX_FMT, fmt_str, wideValue );
2497 break;
2498 case '%':
2499 sprintf_buf[0] = '%';
2500 sprintf_buf[1] = 0;
2501 objv--; /* undo the objv++ below */
2502 break;
2503 default:
2504 spec[0] = *fmt; spec[1] = '\0';
2505 Jim_FreeNewObj(interp, resObjPtr);
2506 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
2507 Jim_AppendStrings(interp, Jim_GetResult(interp),
2508 "bad field specifier \"", spec, "\"", NULL);
2509 return NULL;
2510 }
2511 /* force terminate */
2512 #if 0
2513 printf("FMT was: %s\n", fmt_str );
2514 printf("RES was: |%s|\n", sprintf_buf );
2515 #endif
2516
2517 sprintf_buf[ JIM_MAX_FMT - 1] = 0;
2518 Jim_AppendString( interp, resObjPtr, sprintf_buf, strlen(sprintf_buf) );
2519 /* next obj */
2520 objv++;
2521 fmt++;
2522 fmtLen--;
2523 }
2524 return resObjPtr;
2525 }
2526
2527 Jim_Obj *Jim_FormatString(Jim_Interp *interp, Jim_Obj *fmtObjPtr,
2528 int objc, Jim_Obj *const *objv)
2529 {
2530 char *sprintf_buf=malloc(JIM_MAX_FMT);
2531 Jim_Obj *t=Jim_FormatString_Inner(interp, fmtObjPtr, objc, objv, sprintf_buf);
2532 free(sprintf_buf);
2533 return t;
2534 }
2535
2536 /* -----------------------------------------------------------------------------
2537 * Compared String Object
2538 * ---------------------------------------------------------------------------*/
2539
2540 /* This is strange object that allows to compare a C literal string
2541 * with a Jim object in very short time if the same comparison is done
2542 * multiple times. For example every time the [if] command is executed,
2543 * Jim has to check if a given argument is "else". This comparions if
2544 * the code has no errors are true most of the times, so we can cache
2545 * inside the object the pointer of the string of the last matching
2546 * comparison. Because most C compilers perform literal sharing,
2547 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
2548 * this works pretty well even if comparisons are at different places
2549 * inside the C code. */
2550
2551 static Jim_ObjType comparedStringObjType = {
2552 "compared-string",
2553 NULL,
2554 NULL,
2555 NULL,
2556 JIM_TYPE_REFERENCES,
2557 };
2558
2559 /* The only way this object is exposed to the API is via the following
2560 * function. Returns true if the string and the object string repr.
2561 * are the same, otherwise zero is returned.
2562 *
2563 * Note: this isn't binary safe, but it hardly needs to be.*/
2564 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr,
2565 const char *str)
2566 {
2567 if (objPtr->typePtr == &comparedStringObjType &&
2568 objPtr->internalRep.ptr == str)
2569 return 1;
2570 else {
2571 const char *objStr = Jim_GetString(objPtr, NULL);
2572 if (strcmp(str, objStr) != 0) return 0;
2573 if (objPtr->typePtr != &comparedStringObjType) {
2574 Jim_FreeIntRep(interp, objPtr);
2575 objPtr->typePtr = &comparedStringObjType;
2576 }
2577 objPtr->internalRep.ptr = (char*)str; /*ATTENTION: const cast */
2578 return 1;
2579 }
2580 }
2581
2582 int qsortCompareStringPointers(const void *a, const void *b)
2583 {
2584 char * const *sa = (char * const *)a;
2585 char * const *sb = (char * const *)b;
2586 return strcmp(*sa, *sb);
2587 }
2588
2589 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
2590 const char * const *tablePtr, int *indexPtr, const char *name, int flags)
2591 {
2592 const char * const *entryPtr = NULL;
2593 char **tablePtrSorted;
2594 int i, count = 0;
2595
2596 *indexPtr = -1;
2597 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
2598 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
2599 *indexPtr = i;
2600 return JIM_OK;
2601 }
2602 count++; /* If nothing matches, this will reach the len of tablePtr */
2603 }
2604 if (flags & JIM_ERRMSG) {
2605 if (name == NULL)
2606 name = "option";
2607 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
2608 Jim_AppendStrings(interp, Jim_GetResult(interp),
2609 "bad ", name, " \"", Jim_GetString(objPtr, NULL), "\": must be one of ",
2610 NULL);
2611 tablePtrSorted = Jim_Alloc(sizeof(char*)*count);
2612 memcpy(tablePtrSorted, tablePtr, sizeof(char*)*count);
2613 qsort(tablePtrSorted, count, sizeof(char*), qsortCompareStringPointers);
2614 for (i = 0; i < count; i++) {
2615 if (i+1 == count && count > 1)
2616 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
2617 Jim_AppendString(interp, Jim_GetResult(interp),
2618 tablePtrSorted[i], -1);
2619 if (i+1 != count)
2620 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
2621 }
2622 Jim_Free(tablePtrSorted);
2623 }
2624 return JIM_ERR;
2625 }
2626
2627 int Jim_GetNvp(Jim_Interp *interp,
2628 Jim_Obj *objPtr,
2629 const Jim_Nvp *nvp_table,
2630 const Jim_Nvp ** result)
2631 {
2632 Jim_Nvp *n;
2633 int e;
2634
2635 e = Jim_Nvp_name2value_obj( interp, nvp_table, objPtr, &n );
2636 if( e == JIM_ERR ){
2637 return e;
2638 }
2639
2640 /* Success? found? */
2641 if( n->name ){
2642 /* remove const */
2643 *result = (Jim_Nvp *)n;
2644 return JIM_OK;
2645 } else {
2646 return JIM_ERR;
2647 }
2648 }
2649
2650 /* -----------------------------------------------------------------------------
2651 * Source Object
2652 *
2653 * This object is just a string from the language point of view, but
2654 * in the internal representation it contains the filename and line number
2655 * where this given token was read. This information is used by
2656 * Jim_EvalObj() if the object passed happens to be of type "source".
2657 *
2658 * This allows to propagate the information about line numbers and file
2659 * names and give error messages with absolute line numbers.
2660 *
2661 * Note that this object uses shared strings for filenames, and the
2662 * pointer to the filename together with the line number is taken into
2663 * the space for the "inline" internal represenation of the Jim_Object,
2664 * so there is almost memory zero-overhead.
2665 *
2666 * Also the object will be converted to something else if the given
2667 * token it represents in the source file is not something to be
2668 * evaluated (not a script), and will be specialized in some other way,
2669 * so the time overhead is alzo null.
2670 * ---------------------------------------------------------------------------*/
2671
2672 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2673 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2674
2675 static Jim_ObjType sourceObjType = {
2676 "source",
2677 FreeSourceInternalRep,
2678 DupSourceInternalRep,
2679 NULL,
2680 JIM_TYPE_REFERENCES,
2681 };
2682
2683 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2684 {
2685 Jim_ReleaseSharedString(interp,
2686 objPtr->internalRep.sourceValue.fileName);
2687 }
2688
2689 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2690 {
2691 dupPtr->internalRep.sourceValue.fileName =
2692 Jim_GetSharedString(interp,
2693 srcPtr->internalRep.sourceValue.fileName);
2694 dupPtr->internalRep.sourceValue.lineNumber =
2695 dupPtr->internalRep.sourceValue.lineNumber;
2696 dupPtr->typePtr = &sourceObjType;
2697 }
2698
2699 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
2700 const char *fileName, int lineNumber)
2701 {
2702 if (Jim_IsShared(objPtr))
2703 Jim_Panic(interp,"JimSetSourceInfo called with shared object");
2704 if (objPtr->typePtr != NULL)
2705 Jim_Panic(interp,"JimSetSourceInfo called with typePtr != NULL");
2706 objPtr->internalRep.sourceValue.fileName =
2707 Jim_GetSharedString(interp, fileName);
2708 objPtr->internalRep.sourceValue.lineNumber = lineNumber;
2709 objPtr->typePtr = &sourceObjType;
2710 }
2711
2712 /* -----------------------------------------------------------------------------
2713 * Script Object
2714 * ---------------------------------------------------------------------------*/
2715
2716 #define JIM_CMDSTRUCT_EXPAND -1
2717
2718 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2719 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2720 static int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2721
2722 static Jim_ObjType scriptObjType = {
2723 "script",
2724 FreeScriptInternalRep,
2725 DupScriptInternalRep,
2726 NULL,
2727 JIM_TYPE_REFERENCES,
2728 };
2729
2730 /* The ScriptToken structure represents every token into a scriptObj.
2731 * Every token contains an associated Jim_Obj that can be specialized
2732 * by commands operating on it. */
2733 typedef struct ScriptToken {
2734 int type;
2735 Jim_Obj *objPtr;
2736 int linenr;
2737 } ScriptToken;
2738
2739 /* This is the script object internal representation. An array of
2740 * ScriptToken structures, with an associated command structure array.
2741 * The command structure is a pre-computed representation of the
2742 * command length and arguments structure as a simple liner array
2743 * of integers.
2744 *
2745 * For example the script:
2746 *
2747 * puts hello
2748 * set $i $x$y [foo]BAR
2749 *
2750 * will produce a ScriptObj with the following Tokens:
2751 *
2752 * ESC puts
2753 * SEP
2754 * ESC hello
2755 * EOL
2756 * ESC set
2757 * EOL
2758 * VAR i
2759 * SEP
2760 * VAR x
2761 * VAR y
2762 * SEP
2763 * CMD foo
2764 * ESC BAR
2765 * EOL
2766 *
2767 * This is a description of the tokens, separators, and of lines.
2768 * The command structure instead represents the number of arguments
2769 * of every command, followed by the tokens of which every argument
2770 * is composed. So for the example script, the cmdstruct array will
2771 * contain:
2772 *
2773 * 2 1 1 4 1 1 2 2
2774 *
2775 * Because "puts hello" has two args (2), composed of single tokens (1 1)
2776 * While "set $i $x$y [foo]BAR" has four (4) args, the first two
2777 * composed of single tokens (1 1) and the last two of double tokens
2778 * (2 2).
2779 *
2780 * The precomputation of the command structure makes Jim_Eval() faster,
2781 * and simpler because there aren't dynamic lengths / allocations.
2782 *
2783 * -- {expand} handling --
2784 *
2785 * Expand is handled in a special way. When a command
2786 * contains at least an argument with the {expand} prefix,
2787 * the command structure presents a -1 before the integer
2788 * describing the number of arguments. This is used in order
2789 * to send the command exection to a different path in case
2790 * of {expand} and guarantee a fast path for the more common
2791 * case. Also, the integers describing the number of tokens
2792 * are expressed with negative sign, to allow for fast check
2793 * of what's an {expand}-prefixed argument and what not.
2794 *
2795 * For example the command:
2796 *
2797 * list {expand}{1 2}
2798 *
2799 * Will produce the following cmdstruct array:
2800 *
2801 * -1 2 1 -2
2802 *
2803 * -- the substFlags field of the structure --
2804 *
2805 * The scriptObj structure is used to represent both "script" objects
2806 * and "subst" objects. In the second case, the cmdStruct related
2807 * fields are not used at all, but there is an additional field used
2808 * that is 'substFlags': this represents the flags used to turn
2809 * the string into the intenral representation used to perform the
2810 * substitution. If this flags are not what the application requires
2811 * the scriptObj is created again. For example the script:
2812 *
2813 * subst -nocommands $string
2814 * subst -novariables $string
2815 *
2816 * Will recreate the internal representation of the $string object
2817 * two times.
2818 */
2819 typedef struct ScriptObj {
2820 int len; /* Length as number of tokens. */
2821 int commands; /* number of top-level commands in script. */
2822 ScriptToken *token; /* Tokens array. */
2823 int *cmdStruct; /* commands structure */
2824 int csLen; /* length of the cmdStruct array. */
2825 int substFlags; /* flags used for the compilation of "subst" objects */
2826 int inUse; /* Used to share a ScriptObj. Currently
2827 only used by Jim_EvalObj() as protection against
2828 shimmering of the currently evaluated object. */
2829 char *fileName;
2830 } ScriptObj;
2831
2832 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2833 {
2834 int i;
2835 struct ScriptObj *script = (void*) objPtr->internalRep.ptr;
2836
2837 script->inUse--;
2838 if (script->inUse != 0) return;
2839 for (i = 0; i < script->len; i++) {
2840 if (script->token[i].objPtr != NULL)
2841 Jim_DecrRefCount(interp, script->token[i].objPtr);
2842 }
2843 Jim_Free(script->token);
2844 Jim_Free(script->cmdStruct);
2845 Jim_Free(script->fileName);
2846 Jim_Free(script);
2847 }
2848
2849 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2850 {
2851 JIM_NOTUSED(interp);
2852 JIM_NOTUSED(srcPtr);
2853
2854 /* Just returns an simple string. */
2855 dupPtr->typePtr = NULL;
2856 }
2857
2858 /* Add a new token to the internal repr of a script object */
2859 static void ScriptObjAddToken(Jim_Interp *interp, struct ScriptObj *script,
2860 char *strtoken, int len, int type, char *filename, int linenr)
2861 {
2862 int prevtype;
2863 struct ScriptToken *token;
2864
2865 prevtype = (script->len == 0) ? JIM_TT_EOL : \
2866 script->token[script->len-1].type;
2867 /* Skip tokens without meaning, like words separators
2868 * following a word separator or an end of command and
2869 * so on. */
2870 if (prevtype == JIM_TT_EOL) {
2871 if (type == JIM_TT_EOL || type == JIM_TT_SEP) {
2872 Jim_Free(strtoken);
2873 return;
2874 }
2875 } else if (prevtype == JIM_TT_SEP) {
2876 if (type == JIM_TT_SEP) {
2877 Jim_Free(strtoken);
2878 return;
2879 } else if (type == JIM_TT_EOL) {
2880 /* If an EOL is following by a SEP, drop the previous
2881 * separator. */
2882 script->len--;
2883 Jim_DecrRefCount(interp, script->token[script->len].objPtr);
2884 }
2885 } else if (prevtype != JIM_TT_EOL && prevtype != JIM_TT_SEP &&
2886 type == JIM_TT_ESC && len == 0)
2887 {
2888 /* Don't add empty tokens used in interpolation */
2889 Jim_Free(strtoken);
2890 return;
2891 }
2892 /* Make space for a new istruction */
2893 script->len++;
2894 script->token = Jim_Realloc(script->token,
2895 sizeof(ScriptToken)*script->len);
2896 /* Initialize the new token */
2897 token = script->token+(script->len-1);
2898 token->type = type;
2899 /* Every object is intially as a string, but the
2900 * internal type may be specialized during execution of the
2901 * script. */
2902 token->objPtr = Jim_NewStringObjNoAlloc(interp, strtoken, len);
2903 /* To add source info to SEP and EOL tokens is useless because
2904 * they will never by called as arguments of Jim_EvalObj(). */
2905 if (filename && type != JIM_TT_SEP && type != JIM_TT_EOL)
2906 JimSetSourceInfo(interp, token->objPtr, filename, linenr);
2907 Jim_IncrRefCount(token->objPtr);
2908 token->linenr = linenr;
2909 }
2910
2911 /* Add an integer into the command structure field of the script object. */
2912 static void ScriptObjAddInt(struct ScriptObj *script, int val)
2913 {
2914 script->csLen++;
2915 script->cmdStruct = Jim_Realloc(script->cmdStruct,
2916 sizeof(int)*script->csLen);
2917 script->cmdStruct[script->csLen-1] = val;
2918 }
2919
2920 /* Search a Jim_Obj contained in 'script' with the same stinrg repr.
2921 * of objPtr. Search nested script objects recursively. */
2922 static Jim_Obj *ScriptSearchLiteral(Jim_Interp *interp, ScriptObj *script,
2923 ScriptObj *scriptBarrier, Jim_Obj *objPtr)
2924 {
2925 int i;
2926
2927 for (i = 0; i < script->len; i++) {
2928 if (script->token[i].objPtr != objPtr &&
2929 Jim_StringEqObj(script->token[i].objPtr, objPtr, 0)) {
2930 return script->token[i].objPtr;
2931 }
2932 /* Enter recursively on scripts only if the object
2933 * is not the same as the one we are searching for
2934 * shared occurrences. */
2935 if (script->token[i].objPtr->typePtr == &scriptObjType &&
2936 script->token[i].objPtr != objPtr) {
2937 Jim_Obj *foundObjPtr;
2938
2939 ScriptObj *subScript =
2940 script->token[i].objPtr->internalRep.ptr;
2941 /* Don't recursively enter the script we are trying
2942 * to make shared to avoid circular references. */
2943 if (subScript == scriptBarrier) continue;
2944 if (subScript != script) {
2945 foundObjPtr =
2946 ScriptSearchLiteral(interp, subScript,
2947 scriptBarrier, objPtr);
2948 if (foundObjPtr != NULL)
2949 return foundObjPtr;
2950 }
2951 }
2952 }
2953 return NULL;
2954 }
2955
2956 /* Share literals of a script recursively sharing sub-scripts literals. */
2957 static void ScriptShareLiterals(Jim_Interp *interp, ScriptObj *script,
2958 ScriptObj *topLevelScript)
2959 {
2960 int i, j;
2961
2962 return;
2963 /* Try to share with toplevel object. */
2964 if (topLevelScript != NULL) {
2965 for (i = 0; i < script->len; i++) {
2966 Jim_Obj *foundObjPtr;
2967 char *str = script->token[i].objPtr->bytes;
2968
2969 if (script->token[i].objPtr->refCount != 1) continue;
2970 if (script->token[i].objPtr->typePtr == &scriptObjType) continue;
2971 if (strchr(str, ' ') || strchr(str, '\n')) continue;
2972 foundObjPtr = ScriptSearchLiteral(interp,
2973 topLevelScript,
2974 script, /* barrier */
2975 script->token[i].objPtr);
2976 if (foundObjPtr != NULL) {
2977 Jim_IncrRefCount(foundObjPtr);
2978 Jim_DecrRefCount(interp,
2979 script->token[i].objPtr);
2980 script->token[i].objPtr = foundObjPtr;
2981 }
2982 }
2983 }
2984 /* Try to share locally */
2985 for (i = 0; i < script->len; i++) {
2986 char *str = script->token[i].objPtr->bytes;
2987
2988 if (script->token[i].objPtr->refCount != 1) continue;
2989 if (strchr(str, ' ') || strchr(str, '\n')) continue;
2990 for (j = 0; j < script->len; j++) {
2991 if (script->token[i].objPtr !=
2992 script->token[j].objPtr &&
2993 Jim_StringEqObj(script->token[i].objPtr,
2994 script->token[j].objPtr, 0))
2995 {
2996 Jim_IncrRefCount(script->token[j].objPtr);
2997 Jim_DecrRefCount(interp,
2998 script->token[i].objPtr);
2999 script->token[i].objPtr =
3000 script->token[j].objPtr;
3001 }
3002 }
3003 }
3004 }
3005
3006 /* This method takes the string representation of an object
3007 * as a Tcl script, and generates the pre-parsed internal representation
3008 * of the script. */
3009 int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3010 {
3011 int scriptTextLen;
3012 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
3013 struct JimParserCtx parser;
3014 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
3015 ScriptToken *token;
3016 int args, tokens, start, end, i;
3017 int initialLineNumber;
3018 int propagateSourceInfo = 0;
3019
3020 script->len = 0;
3021 script->csLen = 0;
3022 script->commands = 0;
3023 script->token = NULL;
3024 script->cmdStruct = NULL;
3025 script->inUse = 1;
3026 /* Try to get information about filename / line number */
3027 if (objPtr->typePtr == &sourceObjType) {
3028 script->fileName =
3029 Jim_StrDup(objPtr->internalRep.sourceValue.fileName);
3030 initialLineNumber = objPtr->internalRep.sourceValue.lineNumber;
3031 propagateSourceInfo = 1;
3032 } else {
3033 script->fileName = Jim_StrDup("");
3034 initialLineNumber = 1;
3035 }
3036
3037 JimParserInit(&parser, scriptText, scriptTextLen, initialLineNumber);
3038 while(!JimParserEof(&parser)) {
3039 char *token;
3040 int len, type, linenr;
3041
3042 JimParseScript(&parser);
3043 token = JimParserGetToken(&parser, &len, &type, &linenr);
3044 ScriptObjAddToken(interp, script, token, len, type,
3045 propagateSourceInfo ? script->fileName : NULL,
3046 linenr);
3047 }
3048 token = script->token;
3049
3050 /* Compute the command structure array
3051 * (see the ScriptObj struct definition for more info) */
3052 start = 0; /* Current command start token index */
3053 end = -1; /* Current command end token index */
3054 while (1) {
3055 int expand = 0; /* expand flag. set to 1 on {expand} form. */
3056 int interpolation = 0; /* set to 1 if there is at least one
3057 argument of the command obtained via
3058 interpolation of more tokens. */
3059 /* Search for the end of command, while
3060 * count the number of args. */
3061 start = ++end;
3062 if (start >= script->len) break;
3063 args = 1; /* Number of args in current command */
3064 while (token[end].type != JIM_TT_EOL) {
3065 if (end == 0 || token[end-1].type == JIM_TT_SEP ||
3066 token[end-1].type == JIM_TT_EOL)
3067 {
3068 if (token[end].type == JIM_TT_STR &&
3069 token[end+1].type != JIM_TT_SEP &&
3070 token[end+1].type != JIM_TT_EOL &&
3071 (!strcmp(token[end].objPtr->bytes, "expand") ||
3072 !strcmp(token[end].objPtr->bytes, "*")))
3073 expand++;
3074 }
3075 if (token[end].type == JIM_TT_SEP)
3076 args++;
3077 end++;
3078 }
3079 interpolation = !((end-start+1) == args*2);
3080 /* Add the 'number of arguments' info into cmdstruct.
3081 * Negative value if there is list expansion involved. */
3082 if (expand)
3083 ScriptObjAddInt(script, -1);
3084 ScriptObjAddInt(script, args);
3085 /* Now add info about the number of tokens. */
3086 tokens = 0; /* Number of tokens in current argument. */
3087 expand = 0;
3088 for (i = start; i <= end; i++) {
3089 if (token[i].type == JIM_TT_SEP ||
3090 token[i].type == JIM_TT_EOL)
3091 {
3092 if (tokens == 1 && expand)
3093 expand = 0;
3094 ScriptObjAddInt(script,
3095 expand ? -tokens : tokens);
3096
3097 expand = 0;
3098 tokens = 0;
3099 continue;
3100 } else if (tokens == 0 && token[i].type == JIM_TT_STR &&
3101 (!strcmp(token[i].objPtr->bytes, "expand") ||
3102 !strcmp(token[i].objPtr->bytes, "*")))
3103 {
3104 expand++;
3105 }
3106 tokens++;
3107 }
3108 }
3109 /* Perform literal sharing, but only for objects that appear
3110 * to be scripts written as literals inside the source code,
3111 * and not computed at runtime. Literal sharing is a costly
3112 * operation that should be done only against objects that
3113 * are likely to require compilation only the first time, and
3114 * then are executed multiple times. */
3115 if (propagateSourceInfo && interp->framePtr->procBodyObjPtr) {
3116 Jim_Obj *bodyObjPtr = interp->framePtr->procBodyObjPtr;
3117 if (bodyObjPtr->typePtr == &scriptObjType) {
3118 ScriptObj *bodyScript =
3119 bodyObjPtr->internalRep.ptr;
3120 ScriptShareLiterals(interp, script, bodyScript);
3121 }
3122 } else if (propagateSourceInfo) {
3123 ScriptShareLiterals(interp, script, NULL);
3124 }
3125 /* Free the old internal rep and set the new one. */
3126 Jim_FreeIntRep(interp, objPtr);
3127 Jim_SetIntRepPtr(objPtr, script);
3128 objPtr->typePtr = &scriptObjType;
3129 return JIM_OK;
3130 }
3131
3132 ScriptObj *Jim_GetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3133 {
3134 if (objPtr->typePtr != &scriptObjType) {
3135 SetScriptFromAny(interp, objPtr);
3136 }
3137 return (ScriptObj*) Jim_GetIntRepPtr(objPtr);
3138 }
3139
3140 /* -----------------------------------------------------------------------------
3141 * Commands
3142 * ---------------------------------------------------------------------------*/
3143
3144 /* Commands HashTable Type.
3145 *
3146 * Keys are dynamic allocated strings, Values are Jim_Cmd structures. */
3147 static void Jim_CommandsHT_ValDestructor(void *interp, void *val)
3148 {
3149 Jim_Cmd *cmdPtr = (void*) val;
3150
3151 if (cmdPtr->cmdProc == NULL) {
3152 Jim_DecrRefCount(interp, cmdPtr->argListObjPtr);
3153 Jim_DecrRefCount(interp, cmdPtr->bodyObjPtr);
3154 if (cmdPtr->staticVars) {
3155 Jim_FreeHashTable(cmdPtr->staticVars);
3156 Jim_Free(cmdPtr->staticVars);
3157 }
3158 } else if (cmdPtr->delProc != NULL) {
3159 /* If it was a C coded command, call the delProc if any */
3160 cmdPtr->delProc(interp, cmdPtr->privData);
3161 }
3162 Jim_Free(val);
3163 }
3164
3165 static Jim_HashTableType JimCommandsHashTableType = {
3166 JimStringCopyHTHashFunction, /* hash function */
3167 JimStringCopyHTKeyDup, /* key dup */
3168 NULL, /* val dup */
3169 JimStringCopyHTKeyCompare, /* key compare */
3170 JimStringCopyHTKeyDestructor, /* key destructor */
3171 Jim_CommandsHT_ValDestructor /* val destructor */
3172 };
3173
3174 /* ------------------------- Commands related functions --------------------- */
3175
3176 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdName,
3177 Jim_CmdProc cmdProc, void *privData, Jim_DelCmdProc delProc)
3178 {
3179 Jim_HashEntry *he;
3180 Jim_Cmd *cmdPtr;
3181
3182 he = Jim_FindHashEntry(&interp->commands, cmdName);
3183 if (he == NULL) { /* New command to create */
3184 cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3185 Jim_AddHashEntry(&interp->commands, cmdName, cmdPtr);
3186 } else {
3187 Jim_InterpIncrProcEpoch(interp);
3188 /* Free the arglist/body objects if it was a Tcl procedure */
3189 cmdPtr = he->val;
3190 if (cmdPtr->cmdProc == NULL) {
3191 Jim_DecrRefCount(interp, cmdPtr->argListObjPtr);
3192 Jim_DecrRefCount(interp, cmdPtr->bodyObjPtr);
3193 if (cmdPtr->staticVars) {
3194 Jim_FreeHashTable(cmdPtr->staticVars);
3195 Jim_Free(cmdPtr->staticVars);
3196 }
3197 cmdPtr->staticVars = NULL;
3198 } else if (cmdPtr->delProc != NULL) {
3199 /* If it was a C coded command, call the delProc if any */
3200 cmdPtr->delProc(interp, cmdPtr->privData);
3201 }
3202 }
3203
3204 /* Store the new details for this proc */
3205 cmdPtr->delProc = delProc;
3206 cmdPtr->cmdProc = cmdProc;
3207 cmdPtr->privData = privData;
3208
3209 /* There is no need to increment the 'proc epoch' because
3210 * creation of a new procedure can never affect existing
3211 * cached commands. We don't do negative caching. */
3212 return JIM_OK;
3213 }
3214
3215 int Jim_CreateProcedure(Jim_Interp *interp, const char *cmdName,
3216 Jim_Obj *argListObjPtr, Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr,
3217 int arityMin, int arityMax)
3218 {
3219 Jim_Cmd *cmdPtr;
3220
3221 cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3222 cmdPtr->cmdProc = NULL; /* Not a C coded command */
3223 cmdPtr->argListObjPtr = argListObjPtr;
3224 cmdPtr->bodyObjPtr = bodyObjPtr;
3225 Jim_IncrRefCount(argListObjPtr);
3226 Jim_IncrRefCount(bodyObjPtr);
3227 cmdPtr->arityMin = arityMin;
3228 cmdPtr->arityMax = arityMax;
3229 cmdPtr->staticVars = NULL;
3230
3231 /* Create the statics hash table. */
3232 if (staticsListObjPtr) {
3233 int len, i;
3234
3235 Jim_ListLength(interp, staticsListObjPtr, &len);
3236 if (len != 0) {
3237 cmdPtr->staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3238 Jim_InitHashTable(cmdPtr->staticVars, &JimVariablesHashTableType,
3239 interp);
3240 for (i = 0; i < len; i++) {
3241 Jim_Obj *objPtr, *initObjPtr, *nameObjPtr;
3242 Jim_Var *varPtr;
3243 int subLen;
3244
3245 Jim_ListIndex(interp, staticsListObjPtr, i, &objPtr, JIM_NONE);
3246 /* Check if it's composed of two elements. */
3247 Jim_ListLength(interp, objPtr, &subLen);
3248 if (subLen == 1 || subLen == 2) {
3249 /* Try to get the variable value from the current
3250 * environment. */
3251 Jim_ListIndex(interp, objPtr, 0, &nameObjPtr, JIM_NONE);
3252 if (subLen == 1) {
3253 initObjPtr = Jim_GetVariable(interp, nameObjPtr,
3254 JIM_NONE);
3255 if (initObjPtr == NULL) {
3256 Jim_SetResult(interp,
3257 Jim_NewEmptyStringObj(interp));
3258 Jim_AppendStrings(interp, Jim_GetResult(interp),
3259 "variable for initialization of static \"",
3260 Jim_GetString(nameObjPtr, NULL),
3261 "\" not found in the local context",
3262 NULL);
3263 goto err;
3264 }
3265 } else {
3266 Jim_ListIndex(interp, objPtr, 1, &initObjPtr, JIM_NONE);
3267 }
3268 varPtr = Jim_Alloc(sizeof(*varPtr));
3269 varPtr->objPtr = initObjPtr;
3270 Jim_IncrRefCount(initObjPtr);
3271 varPtr->linkFramePtr = NULL;
3272 if (Jim_AddHashEntry(cmdPtr->staticVars,
3273 Jim_GetString(nameObjPtr, NULL),
3274 varPtr) != JIM_OK)
3275 {
3276 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3277 Jim_AppendStrings(interp, Jim_GetResult(interp),
3278 "static variable name \"",
3279 Jim_GetString(objPtr, NULL), "\"",
3280 " duplicated in statics list", NULL);
3281 Jim_DecrRefCount(interp, initObjPtr);
3282 Jim_Free(varPtr);
3283 goto err;
3284 }
3285 } else {
3286 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3287 Jim_AppendStrings(interp, Jim_GetResult(interp),
3288 "too many fields in static specifier \"",
3289 objPtr, "\"", NULL);
3290 goto err;
3291 }
3292 }
3293 }
3294 }
3295
3296 /* Add the new command */
3297
3298 /* it may already exist, so we try to delete the old one */
3299 if (Jim_DeleteHashEntry(&interp->commands, cmdName) != JIM_ERR) {
3300 /* There was an old procedure with the same name, this requires
3301 * a 'proc epoch' update. */
3302 Jim_InterpIncrProcEpoch(interp);
3303 }
3304 /* If a procedure with the same name didn't existed there is no need
3305 * to increment the 'proc epoch' because creation of a new procedure
3306 * can never affect existing cached commands. We don't do
3307 * negative caching. */
3308 Jim_AddHashEntry(&interp->commands, cmdName, cmdPtr);
3309 return JIM_OK;
3310
3311 err:
3312 Jim_FreeHashTable(cmdPtr->staticVars);
3313 Jim_Free(cmdPtr->staticVars);
3314 Jim_DecrRefCount(interp, argListObjPtr);
3315 Jim_DecrRefCount(interp, bodyObjPtr);
3316 Jim_Free(cmdPtr);
3317 return JIM_ERR;
3318 }
3319
3320 int Jim_DeleteCommand(Jim_Interp *interp, const char *cmdName)
3321 {
3322 if (Jim_DeleteHashEntry(&interp->commands, cmdName) == JIM_ERR)
3323 return JIM_ERR;
3324 Jim_InterpIncrProcEpoch(interp);
3325 return JIM_OK;
3326 }
3327
3328 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName,
3329 const char *newName)
3330 {
3331 Jim_Cmd *cmdPtr;
3332 Jim_HashEntry *he;
3333 Jim_Cmd *copyCmdPtr;
3334
3335 if (newName[0] == '\0') /* Delete! */
3336 return Jim_DeleteCommand(interp, oldName);
3337 /* Rename */
3338 he = Jim_FindHashEntry(&interp->commands, oldName);
3339 if (he == NULL)
3340 return JIM_ERR; /* Invalid command name */
3341 cmdPtr = he->val;
3342 copyCmdPtr = Jim_Alloc(sizeof(Jim_Cmd));
3343 *copyCmdPtr = *cmdPtr;
3344 /* In order to avoid that a procedure will get arglist/body/statics
3345 * freed by the hash table methods, fake a C-coded command
3346 * setting cmdPtr->cmdProc as not NULL */
3347 cmdPtr->cmdProc = (void*)1;
3348 /* Also make sure delProc is NULL. */
3349 cmdPtr->delProc = NULL;
3350 /* Destroy the old command, and make sure the new is freed
3351 * as well. */
3352 Jim_DeleteHashEntry(&interp->commands, oldName);
3353 Jim_DeleteHashEntry(&interp->commands, newName);
3354 /* Now the new command. We are sure it can't fail because
3355 * the target name was already freed. */
3356 Jim_AddHashEntry(&interp->commands, newName, copyCmdPtr);
3357 /* Increment the epoch */
3358 Jim_InterpIncrProcEpoch(interp);
3359 return JIM_OK;
3360 }
3361
3362 /* -----------------------------------------------------------------------------
3363 * Command object
3364 * ---------------------------------------------------------------------------*/
3365
3366 static int SetCommandFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3367
3368 static Jim_ObjType commandObjType = {
3369 "command",
3370 NULL,
3371 NULL,
3372 NULL,
3373 JIM_TYPE_REFERENCES,
3374 };
3375
3376 int SetCommandFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
3377 {
3378 Jim_HashEntry *he;
3379 const char *cmdName;
3380
3381 /* Get the string representation */
3382 cmdName = Jim_GetString(objPtr, NULL);
3383 /* Lookup this name into the commands hash table */
3384 he = Jim_FindHashEntry(&interp->commands, cmdName);
3385 if (he == NULL)
3386 return JIM_ERR;
3387
3388 /* Free the old internal repr and set the new one. */
3389 Jim_FreeIntRep(interp, objPtr);
3390 objPtr->typePtr = &commandObjType;
3391 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
3392 objPtr->internalRep.cmdValue.cmdPtr = (void*)he->val;
3393 return JIM_OK;
3394 }
3395
3396 /* This function returns the command structure for the command name
3397 * stored in objPtr. It tries to specialize the objPtr to contain
3398 * a cached info instead to perform the lookup into the hash table
3399 * every time. The information cached may not be uptodate, in such
3400 * a case the lookup is performed and the cache updated. */
3401 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
3402 {
3403 if ((objPtr->typePtr != &commandObjType ||
3404 objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch) &&
3405 SetCommandFromAny(interp, objPtr) == JIM_ERR) {
3406 if (flags & JIM_ERRMSG) {
3407 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3408 Jim_AppendStrings(interp, Jim_GetResult(interp),
3409 "invalid command name \"", objPtr->bytes, "\"",
3410 NULL);
3411 }
3412 return NULL;
3413 }
3414 return objPtr->internalRep.cmdValue.cmdPtr;
3415 }
3416
3417 /* -----------------------------------------------------------------------------
3418 * Variables
3419 * ---------------------------------------------------------------------------*/
3420
3421 /* Variables HashTable Type.
3422 *
3423 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3424 static void JimVariablesHTValDestructor(void *interp, void *val)
3425 {
3426 Jim_Var *varPtr = (void*) val;
3427
3428 Jim_DecrRefCount(interp, varPtr->objPtr);
3429 Jim_Free(val);
3430 }
3431
3432 static Jim_HashTableType JimVariablesHashTableType = {
3433 JimStringCopyHTHashFunction, /* hash function */
3434 JimStringCopyHTKeyDup, /* key dup */
3435 NULL, /* val dup */
3436 JimStringCopyHTKeyCompare, /* key compare */
3437 JimStringCopyHTKeyDestructor, /* key destructor */
3438 JimVariablesHTValDestructor /* val destructor */
3439 };
3440
3441 /* -----------------------------------------------------------------------------
3442 * Variable object
3443 * ---------------------------------------------------------------------------*/
3444
3445 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
3446
3447 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3448
3449 static Jim_ObjType variableObjType = {
3450 "variable",
3451 NULL,
3452 NULL,
3453 NULL,
3454 JIM_TYPE_REFERENCES,
3455 };
3456
3457 /* Return true if the string "str" looks like syntax sugar for [dict]. I.e.
3458 * is in the form "varname(key)". */
3459 static int Jim_NameIsDictSugar(const char *str, int len)
3460 {
3461 if (len == -1)
3462 len = strlen(str);
3463 if (len && str[len-1] == ')' && strchr(str, '(') != NULL)
3464 return 1;
3465 return 0;
3466 }
3467
3468 /* This method should be called only by the variable API.
3469 * It returns JIM_OK on success (variable already exists),
3470 * JIM_ERR if it does not exists, JIM_DICT_GLUE if it's not
3471 * a variable name, but syntax glue for [dict] i.e. the last
3472 * character is ')' */
3473 int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3474 {
3475 Jim_HashEntry *he;
3476 const char *varName;
3477 int len;
3478
3479 /* Check if the object is already an uptodate variable */
3480 if (objPtr->typePtr == &variableObjType &&
3481 objPtr->internalRep.varValue.callFrameId == interp->framePtr->id)
3482 return JIM_OK; /* nothing to do */
3483 /* Get the string representation */
3484 varName = Jim_GetString(objPtr, &len);
3485 /* Make sure it's not syntax glue to get/set dict. */
3486 if (Jim_NameIsDictSugar(varName, len))
3487 return JIM_DICT_SUGAR;
3488 if (varName[0] == ':' && varName[1] == ':') {
3489 he = Jim_FindHashEntry(&interp->topFramePtr->vars, varName + 2);
3490 if (he == NULL) {
3491 return JIM_ERR;
3492 }
3493 }
3494 else {
3495 /* Lookup this name into the variables hash table */
3496 he = Jim_FindHashEntry(&interp->framePtr->vars, varName);
3497 if (he == NULL) {
3498 /* Try with static vars. */
3499 if (interp->framePtr->staticVars == NULL)
3500 return JIM_ERR;
3501 if (!(he = Jim_FindHashEntry(interp->framePtr->staticVars, varName)))
3502 return JIM_ERR;
3503 }
3504 }
3505 /* Free the old internal repr and set the new one. */
3506 Jim_FreeIntRep(interp, objPtr);
3507 objPtr->typePtr = &variableObjType;
3508 objPtr->internalRep.varValue.callFrameId = interp->framePtr->id;
3509 objPtr->internalRep.varValue.varPtr = (void*)he->val;
3510 return JIM_OK;
3511 }
3512
3513 /* -------------------- Variables related functions ------------------------- */
3514 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr,
3515 Jim_Obj *valObjPtr);
3516 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr);
3517
3518 /* For now that's dummy. Variables lookup should be optimized
3519 * in many ways, with caching of lookups, and possibly with
3520 * a table of pre-allocated vars in every CallFrame for local vars.
3521 * All the caching should also have an 'epoch' mechanism similar
3522 * to the one used by Tcl for procedures lookup caching. */
3523
3524 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
3525 {
3526 const char *name;
3527 Jim_Var *var;
3528 int err;
3529
3530 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3531 /* Check for [dict] syntax sugar. */
3532 if (err == JIM_DICT_SUGAR)
3533 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
3534 /* New variable to create */
3535 name = Jim_GetString(nameObjPtr, NULL);
3536
3537 var = Jim_Alloc(sizeof(*var));
3538 var->objPtr = valObjPtr;
3539 Jim_IncrRefCount(valObjPtr);
3540 var->linkFramePtr = NULL;
3541 /* Insert the new variable */
3542 if (name[0] == ':' && name[1] == ':') {
3543 /* Into to the top evel frame */
3544 Jim_AddHashEntry(&interp->topFramePtr->vars, name + 2, var);
3545 }
3546 else {
3547 Jim_AddHashEntry(&interp->framePtr->vars, name, var);
3548 }
3549 /* Make the object int rep a variable */
3550 Jim_FreeIntRep(interp, nameObjPtr);
3551 nameObjPtr->typePtr = &variableObjType;
3552 nameObjPtr->internalRep.varValue.callFrameId =
3553 interp->framePtr->id;
3554 nameObjPtr->internalRep.varValue.varPtr = var;
3555 } else {
3556 var = nameObjPtr->internalRep.varValue.varPtr;
3557 if (var->linkFramePtr == NULL) {
3558 Jim_IncrRefCount(valObjPtr);
3559 Jim_DecrRefCount(interp, var->objPtr);
3560 var->objPtr = valObjPtr;
3561 } else { /* Else handle the link */
3562 Jim_CallFrame *savedCallFrame;
3563
3564 savedCallFrame = interp->framePtr;
3565 interp->framePtr = var->linkFramePtr;
3566 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
3567 interp->framePtr = savedCallFrame;
3568 if (err != JIM_OK)
3569 return err;
3570 }
3571 }
3572 return JIM_OK;
3573 }
3574
3575 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
3576 {
3577 Jim_Obj *nameObjPtr;
3578 int result;
3579
3580 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3581 Jim_IncrRefCount(nameObjPtr);
3582 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
3583 Jim_DecrRefCount(interp, nameObjPtr);
3584 return result;
3585 }
3586
3587 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
3588 {
3589 Jim_CallFrame *savedFramePtr;
3590 int result;
3591
3592 savedFramePtr = interp->framePtr;
3593 interp->framePtr = interp->topFramePtr;
3594 result = Jim_SetVariableStr(interp, name, objPtr);
3595 interp->framePtr = savedFramePtr;
3596 return result;
3597 }
3598
3599 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
3600 {
3601 Jim_Obj *nameObjPtr, *valObjPtr;
3602 int result;
3603
3604 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3605 valObjPtr = Jim_NewStringObj(interp, val, -1);
3606 Jim_IncrRefCount(nameObjPtr);
3607 Jim_IncrRefCount(valObjPtr);
3608 result = Jim_SetVariable(interp, nameObjPtr, valObjPtr);
3609 Jim_DecrRefCount(interp, nameObjPtr);
3610 Jim_DecrRefCount(interp, valObjPtr);
3611 return result;
3612 }
3613
3614 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
3615 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
3616 {
3617 const char *varName;
3618 int len;
3619
3620 /* Check for cycles. */
3621 if (interp->framePtr == targetCallFrame) {
3622 Jim_Obj *objPtr = targetNameObjPtr;
3623 Jim_Var *varPtr;
3624 /* Cycles are only possible with 'uplevel 0' */
3625 while(1) {
3626 if (Jim_StringEqObj(objPtr, nameObjPtr, 0)) {
3627 Jim_SetResultString(interp,
3628 "can't upvar from variable to itself", -1);
3629 return JIM_ERR;
3630 }
3631 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
3632 break;
3633 varPtr = objPtr->internalRep.varValue.varPtr;
3634 if (varPtr->linkFramePtr != targetCallFrame) break;
3635 objPtr = varPtr->objPtr;
3636 }
3637 }
3638 varName = Jim_GetString(nameObjPtr, &len);
3639 if (Jim_NameIsDictSugar(varName, len)) {
3640 Jim_SetResultString(interp,
3641 "Dict key syntax invalid as link source", -1);
3642 return JIM_ERR;
3643 }
3644 /* Perform the binding */
3645 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
3646 /* We are now sure 'nameObjPtr' type is variableObjType */
3647 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
3648 return JIM_OK;
3649 }
3650
3651 /* Return the Jim_Obj pointer associated with a variable name,
3652 * or NULL if the variable was not found in the current context.
3653 * The same optimization discussed in the comment to the
3654 * 'SetVariable' function should apply here. */
3655 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
3656 {
3657 int err;
3658
3659 /* All the rest is handled here */
3660 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3661 /* Check for [dict] syntax sugar. */
3662 if (err == JIM_DICT_SUGAR)
3663 return JimDictSugarGet(interp, nameObjPtr);
3664 if (flags & JIM_ERRMSG) {
3665 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3666 Jim_AppendStrings(interp, Jim_GetResult(interp),
3667 "can't read \"", nameObjPtr->bytes,
3668 "\": no such variable", NULL);
3669 }
3670 return NULL;
3671 } else {
3672 Jim_Var *varPtr;
3673 Jim_Obj *objPtr;
3674 Jim_CallFrame *savedCallFrame;
3675
3676 varPtr = nameObjPtr->internalRep.varValue.varPtr;
3677 if (varPtr->linkFramePtr == NULL)
3678 return varPtr->objPtr;
3679 /* The variable is a link? Resolve it. */
3680 savedCallFrame = interp->framePtr;
3681 interp->framePtr = varPtr->linkFramePtr;
3682 objPtr = Jim_GetVariable(interp, varPtr->objPtr, JIM_NONE);
3683 if (objPtr == NULL && flags & JIM_ERRMSG) {
3684 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3685 Jim_AppendStrings(interp, Jim_GetResult(interp),
3686 "can't read \"", nameObjPtr->bytes,
3687 "\": no such variable", NULL);
3688 }
3689 interp->framePtr = savedCallFrame;
3690 return objPtr;
3691 }
3692 }
3693
3694 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr,
3695 int flags)
3696 {
3697 Jim_CallFrame *savedFramePtr;
3698 Jim_Obj *objPtr;
3699
3700 savedFramePtr = interp->framePtr;
3701 interp->framePtr = interp->topFramePtr;
3702 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
3703 interp->framePtr = savedFramePtr;
3704
3705 return objPtr;
3706 }
3707
3708 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
3709 {
3710 Jim_Obj *nameObjPtr, *varObjPtr;
3711
3712 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3713 Jim_IncrRefCount(nameObjPtr);
3714 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
3715 Jim_DecrRefCount(interp, nameObjPtr);
3716 return varObjPtr;
3717 }
3718
3719 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name,
3720 int flags)
3721 {
3722 Jim_CallFrame *savedFramePtr;
3723 Jim_Obj *objPtr;
3724
3725 savedFramePtr = interp->framePtr;
3726 interp->framePtr = interp->topFramePtr;
3727 objPtr = Jim_GetVariableStr(interp, name, flags);
3728 interp->framePtr = savedFramePtr;
3729
3730 return objPtr;
3731 }
3732
3733 /* Unset a variable.
3734 * Note: On success unset invalidates all the variable objects created
3735 * in the current call frame incrementing. */
3736 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
3737 {
3738 const char *name;
3739 Jim_Var *varPtr;
3740 int err;
3741
3742 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3743 /* Check for [dict] syntax sugar. */
3744 if (err == JIM_DICT_SUGAR)
3745 return JimDictSugarSet(interp, nameObjPtr, NULL);
3746 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3747 Jim_AppendStrings(interp, Jim_GetResult(interp),
3748 "can't unset \"", nameObjPtr->bytes,
3749 "\": no such variable", NULL);
3750 return JIM_ERR; /* var not found */
3751 }
3752 varPtr = nameObjPtr->internalRep.varValue.varPtr;
3753 /* If it's a link call UnsetVariable recursively */
3754 if (varPtr->linkFramePtr) {
3755 int retval;
3756
3757 Jim_CallFrame *savedCallFrame;
3758
3759 savedCallFrame = interp->framePtr;
3760 interp->framePtr = varPtr->linkFramePtr;
3761 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
3762 interp->framePtr = savedCallFrame;
3763 if (retval != JIM_OK && flags & JIM_ERRMSG) {
3764 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3765 Jim_AppendStrings(interp, Jim_GetResult(interp),
3766 "can't unset \"", nameObjPtr->bytes,
3767 "\": no such variable", NULL);
3768 }
3769 return retval;
3770 } else {
3771 name = Jim_GetString(nameObjPtr, NULL);
3772 if (Jim_DeleteHashEntry(&interp->framePtr->vars, name)
3773 != JIM_OK) return JIM_ERR;
3774 /* Change the callframe id, invalidating var lookup caching */
3775 JimChangeCallFrameId(interp, interp->framePtr);
3776 return JIM_OK;
3777 }
3778 }
3779
3780 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
3781
3782 /* Given a variable name for [dict] operation syntax sugar,
3783 * this function returns two objects, the first with the name
3784 * of the variable to set, and the second with the rispective key.
3785 * For example "foo(bar)" will return objects with string repr. of
3786 * "foo" and "bar".
3787 *
3788 * The returned objects have refcount = 1. The function can't fail. */
3789 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
3790 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
3791 {
3792 const char *str, *p;
3793 char *t;
3794 int len, keyLen, nameLen;
3795 Jim_Obj *varObjPtr, *keyObjPtr;
3796
3797 str = Jim_GetString(objPtr, &len);
3798 p = strchr(str, '(');
3799 p++;
3800 keyLen = len-((p-str)+1);
3801 nameLen = (p-str)-1;
3802 /* Create the objects with the variable name and key. */
3803 t = Jim_Alloc(nameLen+1);
3804 memcpy(t, str, nameLen);
3805 t[nameLen] = '\0';
3806 varObjPtr = Jim_NewStringObjNoAlloc(interp, t, nameLen);
3807
3808 t = Jim_Alloc(keyLen+1);
3809 memcpy(t, p, keyLen);
3810 t[keyLen] = '\0';
3811 keyObjPtr = Jim_NewStringObjNoAlloc(interp, t, keyLen);
3812
3813 Jim_IncrRefCount(varObjPtr);
3814 Jim_IncrRefCount(keyObjPtr);
3815 *varPtrPtr = varObjPtr;
3816 *keyPtrPtr = keyObjPtr;
3817 }
3818
3819 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
3820 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
3821 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr,
3822 Jim_Obj *valObjPtr)
3823 {
3824 Jim_Obj *varObjPtr, *keyObjPtr;
3825 int err = JIM_OK;
3826
3827 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3828 err = Jim_SetDictKeysVector(interp, varObjPtr, &keyObjPtr, 1,
3829 valObjPtr);
3830 Jim_DecrRefCount(interp, varObjPtr);
3831 Jim_DecrRefCount(interp, keyObjPtr);
3832 return err;
3833 }
3834
3835 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
3836 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr)
3837 {
3838 Jim_Obj *varObjPtr, *keyObjPtr, *dictObjPtr, *resObjPtr;
3839
3840 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3841 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
3842 if (!dictObjPtr) {
3843 resObjPtr = NULL;
3844 goto err;
3845 }
3846 if (Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_ERRMSG)
3847 != JIM_OK) {
3848 resObjPtr = NULL;
3849 }
3850 err:
3851 Jim_DecrRefCount(interp, varObjPtr);
3852 Jim_DecrRefCount(interp, keyObjPtr);
3853 return resObjPtr;
3854 }
3855
3856 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
3857
3858 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3859 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr,
3860 Jim_Obj *dupPtr);
3861
3862 static Jim_ObjType dictSubstObjType = {
3863 "dict-substitution",
3864 FreeDictSubstInternalRep,
3865 DupDictSubstInternalRep,
3866 NULL,
3867 JIM_TYPE_NONE,
3868 };
3869
3870 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3871 {
3872 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
3873 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
3874 }
3875
3876 void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr,
3877 Jim_Obj *dupPtr)
3878 {
3879 JIM_NOTUSED(interp);
3880
3881 dupPtr->internalRep.dictSubstValue.varNameObjPtr =
3882 srcPtr->internalRep.dictSubstValue.varNameObjPtr;
3883 dupPtr->internalRep.dictSubstValue.indexObjPtr =
3884 srcPtr->internalRep.dictSubstValue.indexObjPtr;
3885 dupPtr->typePtr = &dictSubstObjType;
3886 }
3887
3888 /* This function is used to expand [dict get] sugar in the form
3889 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
3890 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
3891 * object that is *guaranteed* to be in the form VARNAME(INDEX).
3892 * The 'index' part is [subst]ituted, and is used to lookup a key inside
3893 * the [dict]ionary contained in variable VARNAME. */
3894 Jim_Obj *Jim_ExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
3895 {
3896 Jim_Obj *varObjPtr, *keyObjPtr, *dictObjPtr, *resObjPtr;
3897 Jim_Obj *substKeyObjPtr = NULL;
3898
3899 if (objPtr->typePtr != &dictSubstObjType) {
3900 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3901 Jim_FreeIntRep(interp, objPtr);
3902 objPtr->typePtr = &dictSubstObjType;
3903 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
3904 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
3905 }
3906 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
3907 &substKeyObjPtr, JIM_NONE)
3908 != JIM_OK) {
3909 substKeyObjPtr = NULL;
3910 goto err;
3911 }
3912 Jim_IncrRefCount(substKeyObjPtr);
3913 dictObjPtr = Jim_GetVariable(interp,
3914 objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_ERRMSG);
3915 if (!dictObjPtr) {
3916 resObjPtr = NULL;
3917 goto err;
3918 }
3919 if (Jim_DictKey(interp, dictObjPtr, substKeyObjPtr, &resObjPtr, JIM_ERRMSG)
3920 != JIM_OK) {
3921 resObjPtr = NULL;
3922 goto err;
3923 }
3924 err:
3925 if (substKeyObjPtr) Jim_DecrRefCount(interp, substKeyObjPtr);
3926 return resObjPtr;
3927 }
3928
3929 /* -----------------------------------------------------------------------------
3930 * CallFrame
3931 * ---------------------------------------------------------------------------*/
3932
3933 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp)
3934 {
3935 Jim_CallFrame *cf;
3936 if (interp->freeFramesList) {
3937 cf = interp->freeFramesList;
3938 interp->freeFramesList = cf->nextFramePtr;
3939 } else {
3940 cf = Jim_Alloc(sizeof(*cf));
3941 cf->vars.table = NULL;
3942 }
3943
3944 cf->id = interp->callFrameEpoch++;
3945 cf->parentCallFrame = NULL;
3946 cf->argv = NULL;
3947 cf->argc = 0;
3948 cf->procArgsObjPtr = NULL;
3949 cf->procBodyObjPtr = NULL;
3950 cf->nextFramePtr = NULL;
3951 cf->staticVars = NULL;
3952 if (cf->vars.table == NULL)
3953 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
3954 return cf;
3955 }
3956
3957 /* Used to invalidate every caching related to callframe stability. */
3958 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf)
3959 {
3960 cf->id = interp->callFrameEpoch++;
3961 }
3962
3963 #define JIM_FCF_NONE 0 /* no flags */
3964 #define JIM_FCF_NOHT 1 /* don't free the hash table */
3965 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf,
3966 int flags)
3967 {
3968 if (cf->procArgsObjPtr) Jim_DecrRefCount(interp, cf->procArgsObjPtr);
3969 if (cf->procBodyObjPtr) Jim_DecrRefCount(interp, cf->procBodyObjPtr);
3970 if (!(flags & JIM_FCF_NOHT))
3971 Jim_FreeHashTable(&cf->vars);
3972 else {
3973 int i;
3974 Jim_HashEntry **table = cf->vars.table, *he;
3975
3976 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
3977 he = table[i];
3978 while (he != NULL) {
3979 Jim_HashEntry *nextEntry = he->next;
3980 Jim_Var *varPtr = (void*) he->val;
3981
3982 Jim_DecrRefCount(interp, varPtr->objPtr);
3983 Jim_Free(he->val);
3984 Jim_Free((void*)he->key); /* ATTENTION: const cast */
3985 Jim_Free(he);
3986 table[i] = NULL;
3987 he = nextEntry;
3988 }
3989 }
3990 cf->vars.used = 0;
3991 }
3992 cf->nextFramePtr = interp->freeFramesList;
3993 interp->freeFramesList = cf;
3994 }
3995
3996 /* -----------------------------------------------------------------------------
3997 * References
3998 * ---------------------------------------------------------------------------*/
3999
4000 /* References HashTable Type.
4001 *
4002 * Keys are jim_wide integers, dynamically allocated for now but in the
4003 * future it's worth to cache this 8 bytes objects. Values are poitners
4004 * to Jim_References. */
4005 static void JimReferencesHTValDestructor(void *interp, void *val)
4006 {
4007 Jim_Reference *refPtr = (void*) val;
4008
4009 Jim_DecrRefCount(interp, refPtr->objPtr);
4010 if (refPtr->finalizerCmdNamePtr != NULL) {
4011 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
4012 }
4013 Jim_Free(val);
4014 }
4015
4016 unsigned int JimReferencesHTHashFunction(const void *key)
4017 {
4018 /* Only the least significant bits are used. */
4019 const jim_wide *widePtr = key;
4020 unsigned int intValue = (unsigned int) *widePtr;
4021 return Jim_IntHashFunction(intValue);
4022 }
4023
4024 unsigned int JimReferencesHTDoubleHashFunction(const void *key)
4025 {
4026 /* Only the least significant bits are used. */
4027 const jim_wide *widePtr = key;
4028 unsigned int intValue = (unsigned int) *widePtr;
4029 return intValue; /* identity function. */
4030 }
4031
4032 const void *JimReferencesHTKeyDup(void *privdata, const void *key)
4033 {
4034 void *copy = Jim_Alloc(sizeof(jim_wide));
4035 JIM_NOTUSED(privdata);
4036
4037 memcpy(copy, key, sizeof(jim_wide));
4038 return copy;
4039 }
4040
4041 int JimReferencesHTKeyCompare(void *privdata, const void *key1,
4042 const void *key2)
4043 {
4044 JIM_NOTUSED(privdata);
4045
4046 return memcmp(key1, key2, sizeof(jim_wide)) == 0;
4047 }
4048
4049 void JimReferencesHTKeyDestructor(void *privdata, const void *key)
4050 {
4051 JIM_NOTUSED(privdata);
4052
4053 Jim_Free((void*)key);
4054 }
4055
4056 static Jim_HashTableType JimReferencesHashTableType = {
4057 JimReferencesHTHashFunction, /* hash function */
4058 JimReferencesHTKeyDup, /* key dup */
4059 NULL, /* val dup */
4060 JimReferencesHTKeyCompare, /* key compare */
4061 JimReferencesHTKeyDestructor, /* key destructor */
4062 JimReferencesHTValDestructor /* val destructor */
4063 };
4064
4065 /* -----------------------------------------------------------------------------
4066 * Reference object type and References API
4067 * ---------------------------------------------------------------------------*/
4068
4069 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
4070
4071 static Jim_ObjType referenceObjType = {
4072 "reference",
4073 NULL,
4074 NULL,
4075 UpdateStringOfReference,
4076 JIM_TYPE_REFERENCES,
4077 };
4078
4079 void UpdateStringOfReference(struct Jim_Obj *objPtr)
4080 {
4081 int len;
4082 char buf[JIM_REFERENCE_SPACE+1];
4083 Jim_Reference *refPtr;
4084
4085 refPtr = objPtr->internalRep.refValue.refPtr;
4086 len = JimFormatReference(buf, refPtr, objPtr->internalRep.refValue.id);
4087 objPtr->bytes = Jim_Alloc(len+1);
4088 memcpy(objPtr->bytes, buf, len+1);
4089 objPtr->length = len;
4090 }
4091
4092 /* returns true if 'c' is a valid reference tag character.
4093 * i.e. inside the range [_a-zA-Z0-9] */
4094 static int isrefchar(int c)
4095 {
4096 if (c == '_' || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') ||
4097 (c >= '0' && c <= '9')) return 1;
4098 return 0;
4099 }
4100
4101 int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4102 {
4103 jim_wide wideValue;
4104 int i, len;
4105 const char *str, *start, *end;
4106 char refId[21];
4107 Jim_Reference *refPtr;
4108 Jim_HashEntry *he;
4109
4110 /* Get the string representation */
4111 str = Jim_GetString(objPtr, &len);
4112 /* Check if it looks like a reference */
4113 if (len < JIM_REFERENCE_SPACE) goto badformat;
4114 /* Trim spaces */
4115 start = str;
4116 end = str+len-1;
4117 while (*start == ' ') start++;
4118 while (*end == ' ' && end > start) end--;
4119 if (end-start+1 != JIM_REFERENCE_SPACE) goto badformat;
4120 /* <reference.<1234567>.%020> */
4121 if (memcmp(start, "<reference.<", 12) != 0) goto badformat;
4122 if (start[12+JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>') goto badformat;
4123 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
4124 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
4125 if (!isrefchar(start[12+i])) goto badformat;
4126 }
4127 /* Extract info from the refernece. */
4128 memcpy(refId, start+14+JIM_REFERENCE_TAGLEN, 20);
4129 refId[20] = '\0';
4130 /* Try to convert the ID into a jim_wide */
4131 if (Jim_StringToWide(refId, &wideValue, 10) != JIM_OK) goto badformat;
4132 /* Check if the reference really exists! */
4133 he = Jim_FindHashEntry(&interp->references, &wideValue);
4134 if (he == NULL) {
4135 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4136 Jim_AppendStrings(interp, Jim_GetResult(interp),
4137 "Invalid reference ID \"", str, "\"", NULL);
4138 return JIM_ERR;
4139 }
4140 refPtr = he->val;
4141 /* Free the old internal repr and set the new one. */
4142 Jim_FreeIntRep(interp, objPtr);
4143 objPtr->typePtr = &referenceObjType;
4144 objPtr->internalRep.refValue.id = wideValue;
4145 objPtr->internalRep.refValue.refPtr = refPtr;
4146 return JIM_OK;
4147
4148 badformat:
4149 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4150 Jim_AppendStrings(interp, Jim_GetResult(interp),
4151 "expected reference but got \"", str, "\"", NULL);
4152 return JIM_ERR;
4153 }
4154
4155 /* Returns a new reference pointing to objPtr, having cmdNamePtr
4156 * as finalizer command (or NULL if there is no finalizer).
4157 * The returned reference object has refcount = 0. */
4158 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr,
4159 Jim_Obj *cmdNamePtr)
4160 {
4161 struct Jim_Reference *refPtr;
4162 jim_wide wideValue = interp->referenceNextId;
4163 Jim_Obj *refObjPtr;
4164 const char *tag;
4165 int tagLen, i;
4166
4167 /* Perform the Garbage Collection if needed. */
4168 Jim_CollectIfNeeded(interp);
4169
4170 refPtr = Jim_Alloc(sizeof(*refPtr));
4171 refPtr->objPtr = objPtr;
4172 Jim_IncrRefCount(objPtr);
4173 refPtr->finalizerCmdNamePtr = cmdNamePtr;
4174 if (cmdNamePtr)
4175 Jim_IncrRefCount(cmdNamePtr);
4176 Jim_AddHashEntry(&interp->references, &wideValue, refPtr);
4177 refObjPtr = Jim_NewObj(interp);
4178 refObjPtr->typePtr = &referenceObjType;
4179 refObjPtr->bytes = NULL;
4180 refObjPtr->internalRep.refValue.id = interp->referenceNextId;
4181 refObjPtr->internalRep.refValue.refPtr = refPtr;
4182 interp->referenceNextId++;
4183 /* Set the tag. Trimmered at JIM_REFERENCE_TAGLEN. Everything
4184 * that does not pass the 'isrefchar' test is replaced with '_' */
4185 tag = Jim_GetString(tagPtr, &tagLen);
4186 if (tagLen > JIM_REFERENCE_TAGLEN)
4187 tagLen = JIM_REFERENCE_TAGLEN;
4188 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
4189 if (i < tagLen)
4190 refPtr->tag[i] = tag[i];
4191 else
4192 refPtr->tag[i] = '_';
4193 }
4194 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
4195 return refObjPtr;
4196 }
4197
4198 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
4199 {
4200 if (objPtr->typePtr != &referenceObjType &&
4201 SetReferenceFromAny(interp, objPtr) == JIM_ERR)
4202 return NULL;
4203 return objPtr->internalRep.refValue.refPtr;
4204 }
4205
4206 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
4207 {
4208 Jim_Reference *refPtr;
4209
4210 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
4211 return JIM_ERR;
4212 Jim_IncrRefCount(cmdNamePtr);
4213 if (refPtr->finalizerCmdNamePtr)
4214 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
4215 refPtr->finalizerCmdNamePtr = cmdNamePtr;
4216 return JIM_OK;
4217 }
4218
4219 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
4220 {
4221 Jim_Reference *refPtr;
4222
4223 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
4224 return JIM_ERR;
4225 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
4226 return JIM_OK;
4227 }
4228
4229 /* -----------------------------------------------------------------------------
4230 * References Garbage Collection
4231 * ---------------------------------------------------------------------------*/
4232
4233 /* This the hash table type for the "MARK" phase of the GC */
4234 static Jim_HashTableType JimRefMarkHashTableType = {
4235 JimReferencesHTHashFunction, /* hash function */
4236 JimReferencesHTKeyDup, /* key dup */
4237 NULL, /* val dup */
4238 JimReferencesHTKeyCompare, /* key compare */
4239 JimReferencesHTKeyDestructor, /* key destructor */
4240 NULL /* val destructor */
4241 };
4242
4243 /* #define JIM_DEBUG_GC 1 */
4244
4245 /* Performs the garbage collection. */
4246 int Jim_Collect(Jim_Interp *interp)
4247 {
4248 Jim_HashTable marks;
4249 Jim_HashTableIterator *htiter;
4250 Jim_HashEntry *he;
4251 Jim_Obj *objPtr;
4252 int collected = 0;
4253
4254 /* Avoid recursive calls */
4255 if (interp->lastCollectId == -1) {
4256 /* Jim_Collect() already running. Return just now. */
4257 return 0;
4258 }
4259 interp->lastCollectId = -1;
4260
4261 /* Mark all the references found into the 'mark' hash table.
4262 * The references are searched in every live object that
4263 * is of a type that can contain references. */
4264 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
4265 objPtr = interp->liveList;
4266 while(objPtr) {
4267 if (objPtr->typePtr == NULL ||
4268 objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
4269 const char *str, *p;
4270 int len;
4271
4272 /* If the object is of type reference, to get the
4273 * Id is simple... */
4274 if (objPtr->typePtr == &referenceObjType) {
4275 Jim_AddHashEntry(&marks,
4276 &objPtr->internalRep.refValue.id, NULL);
4277 #ifdef JIM_DEBUG_GC
4278 Jim_fprintf(interp,interp->cookie_stdout,
4279 "MARK (reference): %d refcount: %d" JIM_NL,
4280 (int) objPtr->internalRep.refValue.id,
4281 objPtr->refCount);
4282 #endif
4283 objPtr = objPtr->nextObjPtr;
4284 continue;
4285 }
4286 /* Get the string repr of the object we want
4287 * to scan for references. */
4288 p = str = Jim_GetString(objPtr, &len);
4289 /* Skip objects too little to contain references. */
4290 if (len < JIM_REFERENCE_SPACE) {
4291 objPtr = objPtr->nextObjPtr;
4292 continue;
4293 }
4294 /* Extract references from the object string repr. */
4295 while(1) {
4296 int i;
4297 jim_wide id;
4298 char buf[21];
4299
4300 if ((p = strstr(p, "<reference.<")) == NULL)
4301 break;
4302 /* Check if it's a valid reference. */
4303 if (len-(p-str) < JIM_REFERENCE_SPACE) break;
4304 if (p[41] != '>' || p[19] != '>' || p[20] != '.') break;
4305 for (i = 21; i <= 40; i++)
4306 if (!isdigit((int)p[i]))
4307 break;
4308 /* Get the ID */
4309 memcpy(buf, p+21, 20);
4310 buf[20] = '\0';
4311 Jim_StringToWide(buf, &id, 10);
4312
4313 /* Ok, a reference for the given ID
4314 * was found. Mark it. */
4315 Jim_AddHashEntry(&marks, &id, NULL);
4316 #ifdef JIM_DEBUG_GC
4317 Jim_fprintf(interp,interp->cookie_stdout,"MARK: %d" JIM_NL, (int)id);
4318 #endif
4319 p += JIM_REFERENCE_SPACE;
4320 }
4321 }
4322 objPtr = objPtr->nextObjPtr;
4323 }
4324
4325 /* Run the references hash table to destroy every reference that
4326 * is not referenced outside (not present in the mark HT). */
4327 htiter = Jim_GetHashTableIterator(&interp->references);
4328 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
4329 const jim_wide *refId;
4330 Jim_Reference *refPtr;
4331
4332 refId = he->key;
4333 /* Check if in the mark phase we encountered
4334 * this reference. */
4335 if (Jim_FindHashEntry(&marks, refId) == NULL) {
4336 #ifdef JIM_DEBUG_GC
4337 Jim_fprintf(interp,interp->cookie_stdout,"COLLECTING %d" JIM_NL, (int)*refId);
4338 #endif
4339 collected++;
4340 /* Drop the reference, but call the
4341 * finalizer first if registered. */
4342 refPtr = he->val;
4343 if (refPtr->finalizerCmdNamePtr) {
4344 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE+1);
4345 Jim_Obj *objv[3], *oldResult;
4346
4347 JimFormatReference(refstr, refPtr, *refId);
4348
4349 objv[0] = refPtr->finalizerCmdNamePtr;
4350 objv[1] = Jim_NewStringObjNoAlloc(interp,
4351 refstr, 32);
4352 objv[2] = refPtr->objPtr;
4353 Jim_IncrRefCount(objv[0]);
4354 Jim_IncrRefCount(objv[1]);
4355 Jim_IncrRefCount(objv[2]);
4356
4357 /* Drop the reference itself */
4358 Jim_DeleteHashEntry(&interp->references, refId);
4359
4360 /* Call the finalizer. Errors ignored. */
4361 oldResult = interp->result;
4362 Jim_IncrRefCount(oldResult);
4363 Jim_EvalObjVector(interp, 3, objv);
4364 Jim_SetResult(interp, oldResult);
4365 Jim_DecrRefCount(interp, oldResult);
4366
4367 Jim_DecrRefCount(interp, objv[0]);
4368 Jim_DecrRefCount(interp, objv[1]);
4369 Jim_DecrRefCount(interp, objv[2]);
4370 } else {
4371 Jim_DeleteHashEntry(&interp->references, refId);
4372 }
4373 }
4374 }
4375 Jim_FreeHashTableIterator(htiter);
4376 Jim_FreeHashTable(&marks);
4377 interp->lastCollectId = interp->referenceNextId;
4378 interp->lastCollectTime = time(NULL);
4379 return collected;
4380 }
4381
4382 #define JIM_COLLECT_ID_PERIOD 5000
4383 #define JIM_COLLECT_TIME_PERIOD 300
4384
4385 void Jim_CollectIfNeeded(Jim_Interp *interp)
4386 {
4387 jim_wide elapsedId;
4388 int elapsedTime;
4389
4390 elapsedId = interp->referenceNextId - interp->lastCollectId;
4391 elapsedTime = time(NULL) - interp->lastCollectTime;
4392
4393
4394 if (elapsedId > JIM_COLLECT_ID_PERIOD ||
4395 elapsedTime > JIM_COLLECT_TIME_PERIOD) {
4396 Jim_Collect(interp);
4397 }
4398 }
4399
4400 /* -----------------------------------------------------------------------------
4401 * Interpreter related functions
4402 * ---------------------------------------------------------------------------*/
4403
4404 Jim_Interp *Jim_CreateInterp(void)
4405 {
4406 Jim_Interp *i = Jim_Alloc(sizeof(*i));
4407 Jim_Obj *pathPtr;
4408
4409 i->errorLine = 0;
4410 i->errorFileName = Jim_StrDup("");
4411 i->numLevels = 0;
4412 i->maxNestingDepth = JIM_MAX_NESTING_DEPTH;
4413 i->returnCode = JIM_OK;
4414 i->exitCode = 0;
4415 i->procEpoch = 0;
4416 i->callFrameEpoch = 0;
4417 i->liveList = i->freeList = NULL;
4418 i->scriptFileName = Jim_StrDup("");
4419 i->referenceNextId = 0;
4420 i->lastCollectId = 0;
4421 i->lastCollectTime = time(NULL);
4422 i->freeFramesList = NULL;
4423 i->prngState = NULL;
4424 i->evalRetcodeLevel = -1;
4425 i->cookie_stdin = stdin;
4426 i->cookie_stdout = stdout;
4427 i->cookie_stderr = stderr;
4428 i->cb_fwrite = ((size_t (*)( const void *, size_t, size_t, void *))(fwrite));
4429 i->cb_fread = ((size_t (*)( void *, size_t, size_t, void *))(fread));
4430 i->cb_vfprintf = ((int (*)( void *, const char *fmt, va_list ))(vfprintf));
4431 i->cb_fflush = ((int (*)( void *))(fflush));
4432 i->cb_fgets = ((char * (*)( char *, int, void *))(fgets));
4433
4434 /* Note that we can create objects only after the
4435 * interpreter liveList and freeList pointers are
4436 * initialized to NULL. */
4437 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
4438 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
4439 Jim_InitHashTable(&i->sharedStrings, &JimSharedStringsHashTableType,
4440 NULL);
4441 Jim_InitHashTable(&i->stub, &JimStringCopyHashTableType, NULL);
4442 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
4443 Jim_InitHashTable(&i->packages, &JimStringKeyValCopyHashTableType, NULL);
4444 i->framePtr = i->topFramePtr = JimCreateCallFrame(i);
4445 i->emptyObj = Jim_NewEmptyStringObj(i);
4446 i->result = i->emptyObj;
4447 i->stackTrace = Jim_NewListObj(i, NULL, 0);
4448 i->unknown = Jim_NewStringObj(i, "unknown", -1);
4449 i->unknown_called = 0;
4450 Jim_IncrRefCount(i->emptyObj);
4451 Jim_IncrRefCount(i->result);
4452 Jim_IncrRefCount(i->stackTrace);
4453 Jim_IncrRefCount(i->unknown);
4454
4455 /* Initialize key variables every interpreter should contain */
4456 pathPtr = Jim_NewStringObj(i, "./", -1);
4457 Jim_SetVariableStr(i, "jim_libpath", pathPtr);
4458 Jim_SetVariableStrWithStr(i, "jim_interactive", "0");
4459
4460 /* Export the core API to extensions */
4461 JimRegisterCoreApi(i);
4462 return i;
4463 }
4464
4465 /* This is the only function Jim exports directly without
4466 * to use the STUB system. It is only used by embedders
4467 * in order to get an interpreter with the Jim API pointers
4468 * registered. */
4469 Jim_Interp *ExportedJimCreateInterp(void)
4470 {
4471 return Jim_CreateInterp();
4472 }
4473
4474 void Jim_FreeInterp(Jim_Interp *i)
4475 {
4476 Jim_CallFrame *cf = i->framePtr, *prevcf, *nextcf;
4477 Jim_Obj *objPtr, *nextObjPtr;
4478
4479 Jim_DecrRefCount(i, i->emptyObj);
4480 Jim_DecrRefCount(i, i->result);
4481 Jim_DecrRefCount(i, i->stackTrace);
4482 Jim_DecrRefCount(i, i->unknown);
4483 Jim_Free((void*)i->errorFileName);
4484 Jim_Free((void*)i->scriptFileName);
4485 Jim_FreeHashTable(&i->commands);
4486 Jim_FreeHashTable(&i->references);
4487 Jim_FreeHashTable(&i->stub);
4488 Jim_FreeHashTable(&i->assocData);
4489 Jim_FreeHashTable(&i->packages);
4490 Jim_Free(i->prngState);
4491 /* Free the call frames list */
4492 while(cf) {
4493 prevcf = cf->parentCallFrame;
4494 JimFreeCallFrame(i, cf, JIM_FCF_NONE);
4495 cf = prevcf;
4496 }
4497 /* Check that the live object list is empty, otherwise
4498 * there is a memory leak. */
4499 if (i->liveList != NULL) {
4500 Jim_Obj *objPtr = i->liveList;
4501
4502 Jim_fprintf( i, i->cookie_stdout,JIM_NL "-------------------------------------" JIM_NL);
4503 Jim_fprintf( i, i->cookie_stdout,"Objects still in the free list:" JIM_NL);
4504 while(objPtr) {
4505 const char *type = objPtr->typePtr ?
4506 objPtr->typePtr->name : "";
4507 Jim_fprintf( i, i->cookie_stdout,"%p \"%-10s\": '%.20s' (refCount: %d)" JIM_NL,
4508 objPtr, type,
4509 objPtr->bytes ? objPtr->bytes
4510 : "(null)", objPtr->refCount);
4511 if (objPtr->typePtr == &sourceObjType) {
4512 Jim_fprintf( i, i->cookie_stdout, "FILE %s LINE %d" JIM_NL,
4513 objPtr->internalRep.sourceValue.fileName,
4514 objPtr->internalRep.sourceValue.lineNumber);
4515 }
4516 objPtr = objPtr->nextObjPtr;
4517 }
4518 Jim_fprintf( i, i->cookie_stdout, "-------------------------------------" JIM_NL JIM_NL);
4519 Jim_Panic(i,"Live list non empty freeing the interpreter! Leak?");
4520 }
4521 /* Free all the freed objects. */
4522 objPtr = i->freeList;
4523 while (objPtr) {
4524 nextObjPtr = objPtr->nextObjPtr;
4525 Jim_Free(objPtr);
4526 objPtr = nextObjPtr;
4527 }
4528 /* Free cached CallFrame structures */
4529 cf = i->freeFramesList;
4530 while(cf) {
4531 nextcf = cf->nextFramePtr;
4532 if (cf->vars.table != NULL)
4533 Jim_Free(cf->vars.table);
4534 Jim_Free(cf);
4535 cf = nextcf;
4536 }
4537 /* Free the sharedString hash table. Make sure to free it
4538 * after every other Jim_Object was freed. */
4539 Jim_FreeHashTable(&i->sharedStrings);
4540 /* Free the interpreter structure. */
4541 Jim_Free(i);
4542 }
4543
4544 /* Store the call frame relative to the level represented by
4545 * levelObjPtr into *framePtrPtr. If levelObjPtr == NULL, the
4546 * level is assumed to be '1'.
4547 *
4548 * If a newLevelptr int pointer is specified, the function stores
4549 * the absolute level integer value of the new target callframe into
4550 * *newLevelPtr. (this is used to adjust interp->numLevels
4551 * in the implementation of [uplevel], so that [info level] will
4552 * return a correct information).
4553 *
4554 * This function accepts the 'level' argument in the form
4555 * of the commands [uplevel] and [upvar].
4556 *
4557 * For a function accepting a relative integer as level suitable
4558 * for implementation of [info level ?level?] check the
4559 * GetCallFrameByInteger() function. */
4560 int Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
4561 Jim_CallFrame **framePtrPtr, int *newLevelPtr)
4562 {
4563 long level;
4564 const char *str;
4565 Jim_CallFrame *framePtr;
4566
4567 if (newLevelPtr) *newLevelPtr = interp->numLevels;
4568 if (levelObjPtr) {
4569 str = Jim_GetString(levelObjPtr, NULL);
4570 if (str[0] == '#') {
4571 char *endptr;
4572 /* speedup for the toplevel (level #0) */
4573 if (str[1] == '0' && str[2] == '\0') {
4574 if (newLevelPtr) *newLevelPtr = 0;
4575 *framePtrPtr = interp->topFramePtr;
4576 return JIM_OK;
4577 }
4578
4579 level = strtol(str+1, &endptr, 0);
4580 if (str[1] == '\0' || endptr[0] != '\0' || level < 0)
4581 goto badlevel;
4582 /* An 'absolute' level is converted into the
4583 * 'number of levels to go back' format. */
4584 level = interp->numLevels - level;
4585 if (level < 0) goto badlevel;
4586 } else {
4587 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0)
4588 goto badlevel;
4589 }
4590 } else {
4591 str = "1"; /* Needed to format the error message. */
4592 level = 1;
4593 }
4594 /* Lookup */
4595 framePtr = interp->framePtr;
4596 if (newLevelPtr) *newLevelPtr = (*newLevelPtr)-level;
4597 while (level--) {
4598 framePtr = framePtr->parentCallFrame;
4599 if (framePtr == NULL) goto badlevel;
4600 }
4601 *framePtrPtr = framePtr;
4602 return JIM_OK;
4603 badlevel:
4604 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4605 Jim_AppendStrings(interp, Jim_GetResult(interp),
4606 "bad level \"", str, "\"", NULL);
4607 return JIM_ERR;
4608 }
4609
4610 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
4611 * as a relative integer like in the [info level ?level?] command. */
4612 static int JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr,
4613 Jim_CallFrame **framePtrPtr)
4614 {
4615 jim_wide level;
4616 jim_wide relLevel; /* level relative to the current one. */
4617 Jim_CallFrame *framePtr;
4618
4619 if (Jim_GetWide(interp, levelObjPtr, &level) != JIM_OK)
4620 goto badlevel;
4621 if (level > 0) {
4622 /* An 'absolute' level is converted into the
4623 * 'number of levels to go back' format. */
4624 relLevel = interp->numLevels - level;
4625 } else {
4626 relLevel = -level;
4627 }
4628 /* Lookup */
4629 framePtr = interp->framePtr;
4630 while (relLevel--) {
4631 framePtr = framePtr->parentCallFrame;
4632 if (framePtr == NULL) goto badlevel;
4633 }
4634 *framePtrPtr = framePtr;
4635 return JIM_OK;
4636 badlevel:
4637 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4638 Jim_AppendStrings(interp, Jim_GetResult(interp),
4639 "bad level \"", Jim_GetString(levelObjPtr, NULL), "\"", NULL);
4640 return JIM_ERR;
4641 }
4642
4643 static void JimSetErrorFileName(Jim_Interp *interp, char *filename)
4644 {
4645 Jim_Free((void*)interp->errorFileName);
4646 interp->errorFileName = Jim_StrDup(filename);
4647 }
4648
4649 static void JimSetErrorLineNumber(Jim_Interp *interp, int linenr)
4650 {
4651 interp->errorLine = linenr;
4652 }
4653
4654 static void JimResetStackTrace(Jim_Interp *interp)
4655 {
4656 Jim_DecrRefCount(interp, interp->stackTrace);
4657 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
4658 Jim_IncrRefCount(interp->stackTrace);
4659 }
4660
4661 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
4662 const char *filename, int linenr)
4663 {
4664 /* No need to add this dummy entry to the stack trace */
4665 if (strcmp(procname, "unknown") == 0) {
4666 return;
4667 }
4668
4669 if (Jim_IsShared(interp->stackTrace)) {
4670 interp->stackTrace =
4671 Jim_DuplicateObj(interp, interp->stackTrace);
4672 Jim_IncrRefCount(interp->stackTrace);
4673 }
4674 Jim_ListAppendElement(interp, interp->stackTrace,
4675 Jim_NewStringObj(interp, procname, -1));
4676 Jim_ListAppendElement(interp, interp->stackTrace,
4677 Jim_NewStringObj(interp, filename, -1));
4678 Jim_ListAppendElement(interp, interp->stackTrace,
4679 Jim_NewIntObj(interp, linenr));
4680 }
4681
4682 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc *delProc, void *data)
4683 {
4684 AssocDataValue *assocEntryPtr = (AssocDataValue *)Jim_Alloc(sizeof(AssocDataValue));
4685 assocEntryPtr->delProc = delProc;
4686 assocEntryPtr->data = data;
4687 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
4688 }
4689
4690 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
4691 {
4692 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
4693 if (entryPtr != NULL) {
4694 AssocDataValue *assocEntryPtr = (AssocDataValue *)entryPtr->val;
4695 return assocEntryPtr->data;
4696 }
4697 return NULL;
4698 }
4699
4700 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
4701 {
4702 return Jim_DeleteHashEntry(&interp->assocData, key);
4703 }
4704
4705 int Jim_GetExitCode(Jim_Interp *interp) {
4706 return interp->exitCode;
4707 }
4708
4709 void *Jim_SetStdin(Jim_Interp *interp, void *fp)
4710 {
4711 if (fp != NULL) interp->cookie_stdin = fp;
4712 return interp->cookie_stdin;
4713 }
4714
4715 void *Jim_SetStdout(Jim_Interp *interp, void *fp)
4716 {
4717 if (fp != NULL) interp->cookie_stdout = fp;
4718 return interp->cookie_stdout;
4719 }
4720
4721 void *Jim_SetStderr(Jim_Interp *interp, void *fp)
4722 {
4723 if (fp != NULL) interp->cookie_stderr = fp;
4724 return interp->cookie_stderr;
4725 }
4726
4727 /* -----------------------------------------------------------------------------
4728 * Shared strings.
4729 * Every interpreter has an hash table where to put shared dynamically
4730 * allocate strings that are likely to be used a lot of times.
4731 * For example, in the 'source' object type, there is a pointer to
4732 * the filename associated with that object. Every script has a lot
4733 * of this objects with the identical file name, so it is wise to share
4734 * this info.
4735 *
4736 * The API is trivial: Jim_GetSharedString(interp, "foobar")
4737 * returns the pointer to the shared string. Every time a reference
4738 * to the string is no longer used, the user should call
4739 * Jim_ReleaseSharedString(interp, stringPointer). Once no one is using
4740 * a given string, it is removed from the hash table.
4741 * ---------------------------------------------------------------------------*/
4742 const char *Jim_GetSharedString(Jim_Interp *interp, const char *str)
4743 {
4744 Jim_HashEntry *he = Jim_FindHashEntry(&interp->sharedStrings, str);
4745
4746 if (he == NULL) {
4747 char *strCopy = Jim_StrDup(str);
4748
4749 Jim_AddHashEntry(&interp->sharedStrings, strCopy, (void*)1);
4750 return strCopy;
4751 } else {
4752 long refCount = (long) he->val;
4753
4754 refCount++;
4755 he->val = (void*) refCount;
4756 return he->key;
4757 }
4758 }
4759
4760 void Jim_ReleaseSharedString(Jim_Interp *interp, const char *str)
4761 {
4762 long refCount;
4763 Jim_HashEntry *he = Jim_FindHashEntry(&interp->sharedStrings, str);
4764
4765 if (he == NULL)
4766 Jim_Panic(interp,"Jim_ReleaseSharedString called with "
4767 "unknown shared string '%s'", str);
4768 refCount = (long) he->val;
4769 refCount--;
4770 if (refCount == 0) {
4771 Jim_DeleteHashEntry(&interp->sharedStrings, str);
4772 } else {
4773 he->val = (void*) refCount;
4774 }
4775 }
4776
4777 /* -----------------------------------------------------------------------------
4778 * Integer object
4779 * ---------------------------------------------------------------------------*/
4780 #define JIM_INTEGER_SPACE 24
4781
4782 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
4783 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
4784
4785 static Jim_ObjType intObjType = {
4786 "int",
4787 NULL,
4788 NULL,
4789 UpdateStringOfInt,
4790 JIM_TYPE_NONE,
4791 };
4792
4793 void UpdateStringOfInt(struct Jim_Obj *objPtr)
4794 {
4795 int len;
4796 char buf[JIM_INTEGER_SPACE+1];
4797
4798 len = Jim_WideToString(buf, objPtr->internalRep.wideValue);
4799 objPtr->bytes = Jim_Alloc(len+1);
4800 memcpy(objPtr->bytes, buf, len+1);
4801 objPtr->length = len;
4802 }
4803
4804 int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4805 {
4806 jim_wide wideValue;
4807 const char *str;
4808
4809 /* Get the string representation */
4810 str = Jim_GetString(objPtr, NULL);
4811 /* Try to convert into a jim_wide */
4812 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
4813 if (flags & JIM_ERRMSG) {
4814 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4815 Jim_AppendStrings(interp, Jim_GetResult(interp),
4816 "expected integer but got \"", str, "\"", NULL);
4817 }
4818 return JIM_ERR;
4819 }
4820 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) &&
4821 errno == ERANGE) {
4822 Jim_SetResultString(interp,
4823 "Integer value too big to be represented", -1);
4824 return JIM_ERR;
4825 }
4826 /* Free the old internal repr and set the new one. */
4827 Jim_FreeIntRep(interp, objPtr);
4828 objPtr->typePtr = &intObjType;
4829 objPtr->internalRep.wideValue = wideValue;
4830 return JIM_OK;
4831 }
4832
4833 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide *widePtr)
4834 {
4835 if (objPtr->typePtr != &intObjType &&
4836 SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
4837 return JIM_ERR;
4838 *widePtr = objPtr->internalRep.wideValue;
4839 return JIM_OK;
4840 }
4841
4842 /* Get a wide but does not set an error if the format is bad. */
4843 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr,
4844 jim_wide *widePtr)
4845 {
4846 if (objPtr->typePtr != &intObjType &&
4847 SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
4848 return JIM_ERR;
4849 *widePtr = objPtr->internalRep.wideValue;
4850 return JIM_OK;
4851 }
4852
4853 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
4854 {
4855 jim_wide wideValue;
4856 int retval;
4857
4858 retval = Jim_GetWide(interp, objPtr, &wideValue);
4859 if (retval == JIM_OK) {
4860 *longPtr = (long) wideValue;
4861 return JIM_OK;
4862 }
4863 return JIM_ERR;
4864 }
4865
4866 void Jim_SetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide wideValue)
4867 {
4868 if (Jim_IsShared(objPtr))
4869 Jim_Panic(interp,"Jim_SetWide called with shared object");
4870 if (objPtr->typePtr != &intObjType) {
4871 Jim_FreeIntRep(interp, objPtr);
4872 objPtr->typePtr = &intObjType;
4873 }
4874 Jim_InvalidateStringRep(objPtr);
4875 objPtr->internalRep.wideValue = wideValue;
4876 }
4877
4878 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
4879 {
4880 Jim_Obj *objPtr;
4881
4882 objPtr = Jim_NewObj(interp);
4883 objPtr->typePtr = &intObjType;
4884 objPtr->bytes = NULL;
4885 objPtr->internalRep.wideValue = wideValue;
4886 return objPtr;
4887 }
4888
4889 /* -----------------------------------------------------------------------------
4890 * Double object
4891 * ---------------------------------------------------------------------------*/
4892 #define JIM_DOUBLE_SPACE 30
4893
4894 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
4895 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
4896
4897 static Jim_ObjType doubleObjType = {
4898 "double",
4899 NULL,
4900 NULL,
4901 UpdateStringOfDouble,
4902 JIM_TYPE_NONE,
4903 };
4904
4905 void UpdateStringOfDouble(struct Jim_Obj *objPtr)
4906 {
4907 int len;
4908 char buf[JIM_DOUBLE_SPACE+1];
4909
4910 len = Jim_DoubleToString(buf, objPtr->internalRep.doubleValue);
4911 objPtr->bytes = Jim_Alloc(len+1);
4912 memcpy(objPtr->bytes, buf, len+1);
4913 objPtr->length = len;
4914 }
4915
4916 int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4917 {
4918 double doubleValue;
4919 const char *str;
4920
4921 /* Get the string representation */
4922 str = Jim_GetString(objPtr, NULL);
4923 /* Try to convert into a double */
4924 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
4925 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4926 Jim_AppendStrings(interp, Jim_GetResult(interp),
4927 "expected number but got '", str, "'", NULL);
4928 return JIM_ERR;
4929 }
4930 /* Free the old internal repr and set the new one. */
4931 Jim_FreeIntRep(interp, objPtr);
4932 objPtr->typePtr = &doubleObjType;
4933 objPtr->internalRep.doubleValue = doubleValue;
4934 return JIM_OK;
4935 }
4936
4937 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
4938 {
4939 if (objPtr->typePtr != &doubleObjType &&
4940 SetDoubleFromAny(interp, objPtr) == JIM_ERR)
4941 return JIM_ERR;
4942 *doublePtr = objPtr->internalRep.doubleValue;
4943 return JIM_OK;
4944 }
4945
4946 void Jim_SetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double doubleValue)
4947 {
4948 if (Jim_IsShared(objPtr))
4949 Jim_Panic(interp,"Jim_SetDouble called with shared object");
4950 if (objPtr->typePtr != &doubleObjType) {
4951 Jim_FreeIntRep(interp, objPtr);
4952 objPtr->typePtr = &doubleObjType;
4953 }
4954 Jim_InvalidateStringRep(objPtr);
4955 objPtr->internalRep.doubleValue = doubleValue;
4956 }
4957
4958 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
4959 {
4960 Jim_Obj *objPtr;
4961
4962 objPtr = Jim_NewObj(interp);
4963 objPtr->typePtr = &doubleObjType;
4964 objPtr->bytes = NULL;
4965 objPtr->internalRep.doubleValue = doubleValue;
4966 return objPtr;
4967 }
4968
4969 /* -----------------------------------------------------------------------------
4970 * List object
4971 * ---------------------------------------------------------------------------*/
4972 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
4973 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
4974 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
4975 static void UpdateStringOfList(struct Jim_Obj *objPtr);
4976 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4977
4978 /* Note that while the elements of the list may contain references,
4979 * the list object itself can't. This basically means that the
4980 * list object string representation as a whole can't contain references
4981 * that are not presents in the single elements. */
4982 static Jim_ObjType listObjType = {
4983 "list",
4984 FreeListInternalRep,
4985 DupListInternalRep,
4986 UpdateStringOfList,
4987 JIM_TYPE_NONE,
4988 };
4989
4990 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4991 {
4992 int i;
4993
4994 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
4995 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
4996 }
4997 Jim_Free(objPtr->internalRep.listValue.ele);
4998 }
4999
5000 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
5001 {
5002 int i;
5003 JIM_NOTUSED(interp);
5004
5005 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
5006 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
5007 dupPtr->internalRep.listValue.ele =
5008 Jim_Alloc(sizeof(Jim_Obj*)*srcPtr->internalRep.listValue.maxLen);
5009 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
5010 sizeof(Jim_Obj*)*srcPtr->internalRep.listValue.len);
5011 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
5012 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
5013 }
5014 dupPtr->typePtr = &listObjType;
5015 }
5016
5017 /* The following function checks if a given string can be encoded
5018 * into a list element without any kind of quoting, surrounded by braces,
5019 * or using escapes to quote. */
5020 #define JIM_ELESTR_SIMPLE 0
5021 #define JIM_ELESTR_BRACE 1
5022 #define JIM_ELESTR_QUOTE 2
5023 static int ListElementQuotingType(const char *s, int len)
5024 {
5025 int i, level, trySimple = 1;
5026
5027 /* Try with the SIMPLE case */
5028 if (len == 0) return JIM_ELESTR_BRACE;
5029 if (s[0] == '"' || s[0] == '{') {
5030 trySimple = 0;
5031 goto testbrace;
5032 }
5033 for (i = 0; i < len; i++) {
5034 switch(s[i]) {
5035 case ' ':
5036 case '$':
5037 case '"':
5038 case '[':
5039 case ']':
5040 case ';':
5041 case '\\':
5042 case '\r':
5043 case '\n':
5044 case '\t':
5045 case '\f':
5046 case '\v':
5047 trySimple = 0;
5048 case '{':
5049 case '}':
5050 goto testbrace;
5051 }
5052 }
5053 return JIM_ELESTR_SIMPLE;
5054
5055 testbrace:
5056 /* Test if it's possible to do with braces */
5057 if (s[len-1] == '\\' ||
5058 s[len-1] == ']') return JIM_ELESTR_QUOTE;
5059 level = 0;
5060 for (i = 0; i < len; i++) {
5061 switch(s[i]) {
5062 case '{': level++; break;
5063 case '}': level--;
5064 if (level < 0) return JIM_ELESTR_QUOTE;
5065 break;
5066 case '\\':
5067 if (s[i+1] == '\n')
5068 return JIM_ELESTR_QUOTE;
5069 else
5070 if (s[i+1] != '\0') i++;
5071 break;
5072 }
5073 }
5074 if (level == 0) {
5075 if (!trySimple) return JIM_ELESTR_BRACE;
5076 for (i = 0; i < len; i++) {
5077 switch(s[i]) {
5078 case ' ':
5079 case '$':
5080 case '"':
5081 case '[':
5082 case ']':
5083 case ';':
5084 case '\\':
5085 case '\r':
5086 case '\n':
5087 case '\t':
5088 case '\f':
5089 case '\v':
5090 return JIM_ELESTR_BRACE;
5091 break;
5092 }
5093 }
5094 return JIM_ELESTR_SIMPLE;
5095 }
5096 return JIM_ELESTR_QUOTE;
5097 }
5098
5099 /* Returns the malloc-ed representation of a string
5100 * using backslash to quote special chars. */
5101 char *BackslashQuoteString(const char *s, int len, int *qlenPtr)
5102 {
5103 char *q = Jim_Alloc(len*2+1), *p;
5104
5105 p = q;
5106 while(*s) {
5107 switch (*s) {
5108 case ' ':
5109 case '$':
5110 case '"':
5111 case '[':
5112 case ']':
5113 case '{':
5114 case '}':
5115 case ';':
5116 case '\\':
5117 *p++ = '\\';
5118 *p++ = *s++;
5119 break;
5120 case '\n': *p++ = '\\'; *p++ = 'n'; s++; break;
5121 case '\r': *p++ = '\\'; *p++ = 'r'; s++; break;
5122 case '\t': *p++ = '\\'; *p++ = 't'; s++; break;
5123 case '\f': *p++ = '\\'; *p++ = 'f'; s++; break;
5124 case '\v': *p++ = '\\'; *p++ = 'v'; s++; break;
5125 default:
5126 *p++ = *s++;
5127 break;
5128 }
5129 }
5130 *p = '\0';
5131 *qlenPtr = p-q;
5132 return q;
5133 }
5134
5135 void UpdateStringOfList(struct Jim_Obj *objPtr)
5136 {
5137 int i, bufLen, realLength;
5138 const char *strRep;
5139 char *p;
5140 int *quotingType;
5141 Jim_Obj **ele = objPtr->internalRep.listValue.ele;
5142
5143 /* (Over) Estimate the space needed. */
5144 quotingType = Jim_Alloc(sizeof(int)*objPtr->internalRep.listValue.len+1);
5145 bufLen = 0;
5146 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5147 int len;
5148
5149 strRep = Jim_GetString(ele[i], &len);
5150 quotingType[i] = ListElementQuotingType(strRep, len);
5151 switch (quotingType[i]) {
5152 case JIM_ELESTR_SIMPLE: bufLen += len; break;
5153 case JIM_ELESTR_BRACE: bufLen += len+2; break;
5154 case JIM_ELESTR_QUOTE: bufLen += len*2; break;
5155 }
5156 bufLen++; /* elements separator. */
5157 }
5158 bufLen++;
5159
5160 /* Generate the string rep. */
5161 p = objPtr->bytes = Jim_Alloc(bufLen+1);
5162 realLength = 0;
5163 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5164 int len, qlen;
5165 const char *strRep = Jim_GetString(ele[i], &len);
5166 char *q;
5167
5168 switch(quotingType[i]) {
5169 case JIM_ELESTR_SIMPLE:
5170 memcpy(p, strRep, len);
5171 p += len;
5172 realLength += len;
5173 break;
5174 case JIM_ELESTR_BRACE:
5175 *p++ = '{';
5176 memcpy(p, strRep, len);
5177 p += len;
5178 *p++ = '}';
5179 realLength += len+2;
5180 break;
5181 case JIM_ELESTR_QUOTE:
5182 q = BackslashQuoteString(strRep, len, &qlen);
5183 memcpy(p, q, qlen);
5184 Jim_Free(q);
5185 p += qlen;
5186 realLength += qlen;
5187 break;
5188 }
5189 /* Add a separating space */
5190 if (i+1 != objPtr->internalRep.listValue.len) {
5191 *p++ = ' ';
5192 realLength ++;
5193 }
5194 }
5195 *p = '\0'; /* nul term. */
5196 objPtr->length = realLength;
5197 Jim_Free(quotingType);
5198 }
5199
5200 int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
5201 {
5202 struct JimParserCtx parser;
5203 const char *str;
5204 int strLen;
5205
5206 /* Get the string representation */
5207 str = Jim_GetString(objPtr, &strLen);
5208
5209 /* Free the old internal repr just now and initialize the
5210 * new one just now. The string->list conversion can't fail. */
5211 Jim_FreeIntRep(interp, objPtr);
5212 objPtr->typePtr = &listObjType;
5213 objPtr->internalRep.listValue.len = 0;
5214 objPtr->internalRep.listValue.maxLen = 0;
5215 objPtr->internalRep.listValue.ele = NULL;
5216
5217 /* Convert into a list */
5218 JimParserInit(&parser, str, strLen, 1);
5219 while(!JimParserEof(&parser)) {
5220 char *token;
5221 int tokenLen, type;
5222 Jim_Obj *elementPtr;
5223
5224 JimParseList(&parser);
5225 if (JimParserTtype(&parser) != JIM_TT_STR &&
5226 JimParserTtype(&parser) != JIM_TT_ESC)
5227 continue;
5228 token = JimParserGetToken(&parser, &tokenLen, &type, NULL);
5229 elementPtr = Jim_NewStringObjNoAlloc(interp, token, tokenLen);
5230 ListAppendElement(objPtr, elementPtr);
5231 }
5232 return JIM_OK;
5233 }
5234
5235 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements,
5236 int len)
5237 {
5238 Jim_Obj *objPtr;
5239 int i;
5240
5241 objPtr = Jim_NewObj(interp);
5242 objPtr->typePtr = &listObjType;
5243 objPtr->bytes = NULL;
5244 objPtr->internalRep.listValue.ele = NULL;
5245 objPtr->internalRep.listValue.len = 0;
5246 objPtr->internalRep.listValue.maxLen = 0;
5247 for (i = 0; i < len; i++) {
5248 ListAppendElement(objPtr, elements[i]);
5249 }
5250 return objPtr;
5251 }
5252
5253 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
5254 * length of the vector. Note that the user of this function should make
5255 * sure that the list object can't shimmer while the vector returned
5256 * is in use, this vector is the one stored inside the internal representation
5257 * of the list object. This function is not exported, extensions should
5258 * always access to the List object elements using Jim_ListIndex(). */
5259 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *argc,
5260 Jim_Obj ***listVec)
5261 {
5262 Jim_ListLength(interp, listObj, argc);
5263 assert(listObj->typePtr == &listObjType);
5264 *listVec = listObj->internalRep.listValue.ele;
5265 }
5266
5267 /* ListSortElements type values */
5268 enum {JIM_LSORT_ASCII, JIM_LSORT_NOCASE, JIM_LSORT_ASCII_DECR,
5269 JIM_LSORT_NOCASE_DECR};
5270
5271 /* Sort the internal rep of a list. */
5272 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5273 {
5274 return Jim_StringCompareObj(*lhsObj, *rhsObj, 0);
5275 }
5276
5277 static int ListSortStringDecr(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5278 {
5279 return Jim_StringCompareObj(*lhsObj, *rhsObj, 0) * -1;
5280 }
5281
5282 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5283 {
5284 return Jim_StringCompareObj(*lhsObj, *rhsObj, 1);
5285 }
5286
5287 static int ListSortStringNoCaseDecr(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5288 {
5289 return Jim_StringCompareObj(*lhsObj, *rhsObj, 1) * -1;
5290 }
5291
5292 /* Sort a list *in place*. MUST be called with non-shared objects. */
5293 static void ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, int type)
5294 {
5295 typedef int (qsort_comparator)(const void *, const void *);
5296 int (*fn)(Jim_Obj**, Jim_Obj**);
5297 Jim_Obj **vector;
5298 int len;
5299
5300 if (Jim_IsShared(listObjPtr))
5301 Jim_Panic(interp,"Jim_ListSortElements called with shared object");
5302 if (listObjPtr->typePtr != &listObjType)
5303 SetListFromAny(interp, listObjPtr);
5304
5305 vector = listObjPtr->internalRep.listValue.ele;
5306 len = listObjPtr->internalRep.listValue.len;
5307 switch (type) {
5308 case JIM_LSORT_ASCII: fn = ListSortString; break;
5309 case JIM_LSORT_NOCASE: fn = ListSortStringNoCase; break;
5310 case JIM_LSORT_ASCII_DECR: fn = ListSortStringDecr; break;
5311 case JIM_LSORT_NOCASE_DECR: fn = ListSortStringNoCaseDecr; break;
5312 default:
5313 fn = NULL; /* avoid warning */
5314 Jim_Panic(interp,"ListSort called with invalid sort type");
5315 }
5316 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *)fn);
5317 Jim_InvalidateStringRep(listObjPtr);
5318 }
5319
5320 /* This is the low-level function to append an element to a list.
5321 * The higher-level Jim_ListAppendElement() performs shared object
5322 * check and invalidate the string repr. This version is used
5323 * in the internals of the List Object and is not exported.
5324 *
5325 * NOTE: this function can be called only against objects
5326 * with internal type of List. */
5327 void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
5328 {
5329 int requiredLen = listPtr->internalRep.listValue.len + 1;
5330
5331 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5332 int maxLen = requiredLen * 2;
5333
5334 listPtr->internalRep.listValue.ele =
5335 Jim_Realloc(listPtr->internalRep.listValue.ele,
5336 sizeof(Jim_Obj*)*maxLen);
5337 listPtr->internalRep.listValue.maxLen = maxLen;
5338 }
5339 listPtr->internalRep.listValue.ele[listPtr->internalRep.listValue.len] =
5340 objPtr;
5341 listPtr->internalRep.listValue.len ++;
5342 Jim_IncrRefCount(objPtr);
5343 }
5344
5345 /* This is the low-level function to insert elements into a list.
5346 * The higher-level Jim_ListInsertElements() performs shared object
5347 * check and invalidate the string repr. This version is used
5348 * in the internals of the List Object and is not exported.
5349 *
5350 * NOTE: this function can be called only against objects
5351 * with internal type of List. */
5352 void ListInsertElements(Jim_Obj *listPtr, int index, int elemc,
5353 Jim_Obj *const *elemVec)
5354 {
5355 int currentLen = listPtr->internalRep.listValue.len;
5356 int requiredLen = currentLen + elemc;
5357 int i;
5358 Jim_Obj **point;
5359
5360 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5361 int maxLen = requiredLen * 2;
5362
5363 listPtr->internalRep.listValue.ele =
5364 Jim_Realloc(listPtr->internalRep.listValue.ele,
5365 sizeof(Jim_Obj*)*maxLen);
5366 listPtr->internalRep.listValue.maxLen = maxLen;
5367 }
5368 point = listPtr->internalRep.listValue.ele + index;
5369 memmove(point+elemc, point, (currentLen-index) * sizeof(Jim_Obj*));
5370 for (i=0; i < elemc; ++i) {
5371 point[i] = elemVec[i];
5372 Jim_IncrRefCount(point[i]);
5373 }
5374 listPtr->internalRep.listValue.len += elemc;
5375 }
5376
5377 /* Appends every element of appendListPtr into listPtr.
5378 * Both have to be of the list type. */
5379 void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
5380 {
5381 int i, oldLen = listPtr->internalRep.listValue.len;
5382 int appendLen = appendListPtr->internalRep.listValue.len;
5383 int requiredLen = oldLen + appendLen;
5384
5385 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5386 int maxLen = requiredLen * 2;
5387
5388 listPtr->internalRep.listValue.ele =
5389 Jim_Realloc(listPtr->internalRep.listValue.ele,
5390 sizeof(Jim_Obj*)*maxLen);
5391 listPtr->internalRep.listValue.maxLen = maxLen;
5392 }
5393 for (i = 0; i < appendLen; i++) {
5394 Jim_Obj *objPtr = appendListPtr->internalRep.listValue.ele[i];
5395 listPtr->internalRep.listValue.ele[oldLen+i] = objPtr;
5396 Jim_IncrRefCount(objPtr);
5397 }
5398 listPtr->internalRep.listValue.len += appendLen;
5399 }
5400
5401 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
5402 {
5403 if (Jim_IsShared(listPtr))
5404 Jim_Panic(interp,"Jim_ListAppendElement called with shared object");
5405 if (listPtr->typePtr != &listObjType)
5406 SetListFromAny(interp, listPtr);
5407 Jim_InvalidateStringRep(listPtr);
5408 ListAppendElement(listPtr, objPtr);
5409 }
5410
5411 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
5412 {
5413 if (Jim_IsShared(listPtr))
5414 Jim_Panic(interp,"Jim_ListAppendList called with shared object");
5415 if (listPtr->typePtr != &listObjType)
5416 SetListFromAny(interp, listPtr);
5417 Jim_InvalidateStringRep(listPtr);
5418 ListAppendList(listPtr, appendListPtr);
5419 }
5420
5421 void Jim_ListLength(Jim_Interp *interp, Jim_Obj *listPtr, int *intPtr)
5422 {
5423 if (listPtr->typePtr != &listObjType)
5424 SetListFromAny(interp, listPtr);
5425 *intPtr = listPtr->internalRep.listValue.len;
5426 }
5427
5428 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5429 int objc, Jim_Obj *const *objVec)
5430 {
5431 if (Jim_IsShared(listPtr))
5432 Jim_Panic(interp,"Jim_ListInsertElement called with shared object");
5433 if (listPtr->typePtr != &listObjType)
5434 SetListFromAny(interp, listPtr);
5435 if (index >= 0 && index > listPtr->internalRep.listValue.len)
5436 index = listPtr->internalRep.listValue.len;
5437 else if (index < 0 )
5438 index = 0;
5439 Jim_InvalidateStringRep(listPtr);
5440 ListInsertElements(listPtr, index, objc, objVec);
5441 }
5442
5443 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5444 Jim_Obj **objPtrPtr, int flags)
5445 {
5446 if (listPtr->typePtr != &listObjType)
5447 SetListFromAny(interp, listPtr);
5448 if ((index >= 0 && index >= listPtr->internalRep.listValue.len) ||
5449 (index < 0 && (-index-1) >= listPtr->internalRep.listValue.len)) {
5450 if (flags & JIM_ERRMSG) {
5451 Jim_SetResultString(interp,
5452 "list index out of range", -1);
5453 }
5454 return JIM_ERR;
5455 }
5456 if (index < 0)
5457 index = listPtr->internalRep.listValue.len+index;
5458 *objPtrPtr = listPtr->internalRep.listValue.ele[index];
5459 return JIM_OK;
5460 }
5461
5462 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5463 Jim_Obj *newObjPtr, int flags)
5464 {
5465 if (listPtr->typePtr != &listObjType)
5466 SetListFromAny(interp, listPtr);
5467 if ((index >= 0 && index >= listPtr->internalRep.listValue.len) ||
5468 (index < 0 && (-index-1) >= listPtr->internalRep.listValue.len)) {
5469 if (flags & JIM_ERRMSG) {
5470 Jim_SetResultString(interp,
5471 "list index out of range", -1);
5472 }
5473 return JIM_ERR;
5474 }
5475 if (index < 0)
5476 index = listPtr->internalRep.listValue.len+index;
5477 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[index]);
5478 listPtr->internalRep.listValue.ele[index] = newObjPtr;
5479 Jim_IncrRefCount(newObjPtr);
5480 return JIM_OK;
5481 }
5482
5483 /* Modify the list stored into the variable named 'varNamePtr'
5484 * setting the element specified by the 'indexc' indexes objects in 'indexv',
5485 * with the new element 'newObjptr'. */
5486 int Jim_SetListIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
5487 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
5488 {
5489 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
5490 int shared, i, index;
5491
5492 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
5493 if (objPtr == NULL)
5494 return JIM_ERR;
5495 if ((shared = Jim_IsShared(objPtr)))
5496 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
5497 for (i = 0; i < indexc-1; i++) {
5498 listObjPtr = objPtr;
5499 if (Jim_GetIndex(interp, indexv[i], &index) != JIM_OK)
5500 goto err;
5501 if (Jim_ListIndex(interp, listObjPtr, index, &objPtr,
5502 JIM_ERRMSG) != JIM_OK) {
5503 goto err;
5504 }
5505 if (Jim_IsShared(objPtr)) {
5506 objPtr = Jim_DuplicateObj(interp, objPtr);
5507 ListSetIndex(interp, listObjPtr, index, objPtr, JIM_NONE);
5508 }
5509 Jim_InvalidateStringRep(listObjPtr);
5510 }
5511 if (Jim_GetIndex(interp, indexv[indexc-1], &index) != JIM_OK)
5512 goto err;
5513 if (ListSetIndex(interp, objPtr, index, newObjPtr, JIM_ERRMSG) == JIM_ERR)
5514 goto err;
5515 Jim_InvalidateStringRep(objPtr);
5516 Jim_InvalidateStringRep(varObjPtr);
5517 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
5518 goto err;
5519 Jim_SetResult(interp, varObjPtr);
5520 return JIM_OK;
5521 err:
5522 if (shared) {
5523 Jim_FreeNewObj(interp, varObjPtr);
5524 }
5525 return JIM_ERR;
5526 }
5527
5528 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
5529 {
5530 int i;
5531
5532 /* If all the objects in objv are lists without string rep.
5533 * it's possible to return a list as result, that's the
5534 * concatenation of all the lists. */
5535 for (i = 0; i < objc; i++) {
5536 if (objv[i]->typePtr != &listObjType || objv[i]->bytes)
5537 break;
5538 }
5539 if (i == objc) {
5540 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
5541 for (i = 0; i < objc; i++)
5542 Jim_ListAppendList(interp, objPtr, objv[i]);
5543 return objPtr;
5544 } else {
5545 /* Else... we have to glue strings together */
5546 int len = 0, objLen;
5547 char *bytes, *p;
5548
5549 /* Compute the length */
5550 for (i = 0; i < objc; i++) {
5551 Jim_GetString(objv[i], &objLen);
5552 len += objLen;
5553 }
5554 if (objc) len += objc-1;
5555 /* Create the string rep, and a stinrg object holding it. */
5556 p = bytes = Jim_Alloc(len+1);
5557 for (i = 0; i < objc; i++) {
5558 const char *s = Jim_GetString(objv[i], &objLen);
5559 while (objLen && (*s == ' ' || *s == '\t' || *s == '\n'))
5560 {
5561 s++; objLen--; len--;
5562 }
5563 while (objLen && (s[objLen-1] == ' ' ||
5564 s[objLen-1] == '\n' || s[objLen-1] == '\t')) {
5565 objLen--; len--;
5566 }
5567 memcpy(p, s, objLen);
5568 p += objLen;
5569 if (objLen && i+1 != objc) {
5570 *p++ = ' ';
5571 } else if (i+1 != objc) {
5572 /* Drop the space calcuated for this
5573 * element that is instead null. */
5574 len--;
5575 }
5576 }
5577 *p = '\0';
5578 return Jim_NewStringObjNoAlloc(interp, bytes, len);
5579 }
5580 }
5581
5582 /* Returns a list composed of the elements in the specified range.
5583 * first and start are directly accepted as Jim_Objects and
5584 * processed for the end?-index? case. */
5585 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
5586 {
5587 int first, last;
5588 int len, rangeLen;
5589
5590 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
5591 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
5592 return NULL;
5593 Jim_ListLength(interp, listObjPtr, &len); /* will convert into list */
5594 first = JimRelToAbsIndex(len, first);
5595 last = JimRelToAbsIndex(len, last);
5596 JimRelToAbsRange(len, first, last, &first, &last, &rangeLen);
5597 return Jim_NewListObj(interp,
5598 listObjPtr->internalRep.listValue.ele+first, rangeLen);
5599 }
5600
5601 /* -----------------------------------------------------------------------------
5602 * Dict object
5603 * ---------------------------------------------------------------------------*/
5604 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
5605 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
5606 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
5607 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
5608
5609 /* Dict HashTable Type.
5610 *
5611 * Keys and Values are Jim objects. */
5612
5613 unsigned int JimObjectHTHashFunction(const void *key)
5614 {
5615 const char *str;
5616 Jim_Obj *objPtr = (Jim_Obj*) key;
5617 int len, h;
5618
5619 str = Jim_GetString(objPtr, &len);
5620 h = Jim_GenHashFunction((unsigned char*)str, len);
5621 return h;
5622 }
5623
5624 int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
5625 {
5626 JIM_NOTUSED(privdata);
5627
5628 return Jim_StringEqObj((Jim_Obj*)key1, (Jim_Obj*)key2, 0);
5629 }
5630
5631 static void JimObjectHTKeyValDestructor(void *interp, void *val)
5632 {
5633 Jim_Obj *objPtr = val;
5634
5635 Jim_DecrRefCount(interp, objPtr);
5636 }
5637
5638 static Jim_HashTableType JimDictHashTableType = {
5639 JimObjectHTHashFunction, /* hash function */
5640 NULL, /* key dup */
5641 NULL, /* val dup */
5642 JimObjectHTKeyCompare, /* key compare */
5643 (void(*)(void*, const void*)) /* ATTENTION: const cast */
5644 JimObjectHTKeyValDestructor, /* key destructor */
5645 JimObjectHTKeyValDestructor /* val destructor */
5646 };
5647
5648 /* Note that while the elements of the dict may contain references,
5649 * the list object itself can't. This basically means that the
5650 * dict object string representation as a whole can't contain references
5651 * that are not presents in the single elements. */
5652 static Jim_ObjType dictObjType = {
5653 "dict",
5654 FreeDictInternalRep,
5655 DupDictInternalRep,
5656 UpdateStringOfDict,
5657 JIM_TYPE_NONE,
5658 };
5659
5660 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
5661 {
5662 JIM_NOTUSED(interp);
5663
5664 Jim_FreeHashTable(objPtr->internalRep.ptr);
5665 Jim_Free(objPtr->internalRep.ptr);
5666 }
5667
5668 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
5669 {
5670 Jim_HashTable *ht, *dupHt;
5671 Jim_HashTableIterator *htiter;
5672 Jim_HashEntry *he;
5673
5674 /* Create a new hash table */
5675 ht = srcPtr->internalRep.ptr;
5676 dupHt = Jim_Alloc(sizeof(*dupHt));
5677 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
5678 if (ht->size != 0)
5679 Jim_ExpandHashTable(dupHt, ht->size);
5680 /* Copy every element from the source to the dup hash table */
5681 htiter = Jim_GetHashTableIterator(ht);
5682 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
5683 const Jim_Obj *keyObjPtr = he->key;
5684 Jim_Obj *valObjPtr = he->val;
5685
5686 Jim_IncrRefCount((Jim_Obj*)keyObjPtr); /* ATTENTION: const cast */
5687 Jim_IncrRefCount(valObjPtr);
5688 Jim_AddHashEntry(dupHt, keyObjPtr, valObjPtr);
5689 }
5690 Jim_FreeHashTableIterator(htiter);
5691
5692 dupPtr->internalRep.ptr = dupHt;
5693 dupPtr->typePtr = &dictObjType;
5694 }
5695
5696 void UpdateStringOfDict(struct Jim_Obj *objPtr)
5697 {
5698 int i, bufLen, realLength;
5699 const char *strRep;
5700 char *p;
5701 int *quotingType, objc;
5702 Jim_HashTable *ht;
5703 Jim_HashTableIterator *htiter;
5704 Jim_HashEntry *he;
5705 Jim_Obj **objv;
5706
5707 /* Trun the hash table into a flat vector of Jim_Objects. */
5708 ht = objPtr->internalRep.ptr;
5709 objc = ht->used*2;
5710 objv = Jim_Alloc(objc*sizeof(Jim_Obj*));
5711 htiter = Jim_GetHashTableIterator(ht);
5712 i = 0;
5713 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
5714 objv[i++] = (Jim_Obj*)he->key; /* ATTENTION: const cast */
5715 objv[i++] = he->val;
5716 }
5717 Jim_FreeHashTableIterator(htiter);
5718 /* (Over) Estimate the space needed. */
5719 quotingType = Jim_Alloc(sizeof(int)*objc);
5720 bufLen = 0;
5721 for (i = 0; i < objc; i++) {
5722 int len;
5723
5724 strRep = Jim_GetString(objv[i], &len);
5725 quotingType[i] = ListElementQuotingType(strRep, len);
5726 switch (quotingType[i]) {
5727 case JIM_ELESTR_SIMPLE: bufLen += len; break;
5728 case JIM_ELESTR_BRACE: bufLen += len+2; break;
5729 case JIM_ELESTR_QUOTE: bufLen += len*2; break;
5730 }
5731 bufLen++; /* elements separator. */
5732 }
5733 bufLen++;
5734
5735 /* Generate the string rep. */
5736 p = objPtr->bytes = Jim_Alloc(bufLen+1);
5737 realLength = 0;
5738 for (i = 0; i < objc; i++) {
5739 int len, qlen;
5740 const char *strRep = Jim_GetString(objv[i], &len);
5741 char *q;
5742
5743 switch(quotingType[i]) {
5744 case JIM_ELESTR_SIMPLE:
5745 memcpy(p, strRep, len);
5746 p += len;
5747 realLength += len;
5748 break;
5749 case JIM_ELESTR_BRACE:
5750 *p++ = '{';
5751 memcpy(p, strRep, len);
5752 p += len;
5753 *p++ = '}';
5754 realLength += len+2;
5755 break;
5756 case JIM_ELESTR_QUOTE:
5757 q = BackslashQuoteString(strRep, len, &qlen);
5758 memcpy(p, q, qlen);
5759 Jim_Free(q);
5760 p += qlen;
5761 realLength += qlen;
5762 break;
5763 }
5764 /* Add a separating space */
5765 if (i+1 != objc) {
5766 *p++ = ' ';
5767 realLength ++;
5768 }
5769 }
5770 *p = '\0'; /* nul term. */
5771 objPtr->length = realLength;
5772 Jim_Free(quotingType);
5773 Jim_Free(objv);
5774 }
5775
5776 int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
5777 {
5778 struct JimParserCtx parser;
5779 Jim_HashTable *ht;
5780 Jim_Obj *objv[2];
5781 const char *str;
5782 int i, strLen;
5783
5784 /* Get the string representation */
5785 str = Jim_GetString(objPtr, &strLen);
5786
5787 /* Free the old internal repr just now and initialize the
5788 * new one just now. The string->list conversion can't fail. */
5789 Jim_FreeIntRep(interp, objPtr);
5790 ht = Jim_Alloc(sizeof(*ht));
5791 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
5792 objPtr->typePtr = &dictObjType;
5793 objPtr->internalRep.ptr = ht;
5794
5795 /* Convert into a dict */
5796 JimParserInit(&parser, str, strLen, 1);
5797 i = 0;
5798 while(!JimParserEof(&parser)) {
5799 char *token;
5800 int tokenLen, type;
5801
5802 JimParseList(&parser);
5803 if (JimParserTtype(&parser) != JIM_TT_STR &&
5804 JimParserTtype(&parser) != JIM_TT_ESC)
5805 continue;
5806 token = JimParserGetToken(&parser, &tokenLen, &type, NULL);
5807 objv[i++] = Jim_NewStringObjNoAlloc(interp, token, tokenLen);
5808 if (i == 2) {
5809 i = 0;
5810 Jim_IncrRefCount(objv[0]);
5811 Jim_IncrRefCount(objv[1]);
5812 if (Jim_AddHashEntry(ht, objv[0], objv[1]) != JIM_OK) {
5813 Jim_HashEntry *he;
5814 he = Jim_FindHashEntry(ht, objv[0]);
5815 Jim_DecrRefCount(interp, objv[0]);
5816 /* ATTENTION: const cast */
5817 Jim_DecrRefCount(interp, (Jim_Obj*)he->val);
5818 he->val = objv[1];
5819 }
5820 }
5821 }
5822 if (i) {
5823 Jim_FreeNewObj(interp, objv[0]);
5824 objPtr->typePtr = NULL;
5825 Jim_FreeHashTable(ht);
5826 Jim_SetResultString(interp, "invalid dictionary value: must be a list with an even number of elements", -1);
5827 return JIM_ERR;
5828 }
5829 return JIM_OK;
5830 }
5831
5832 /* Dict object API */
5833
5834 /* Add an element to a dict. objPtr must be of the "dict" type.
5835 * The higer-level exported function is Jim_DictAddElement().
5836 * If an element with the specified key already exists, the value
5837 * associated is replaced with the new one.
5838 *
5839 * if valueObjPtr == NULL, the key is instead removed if it exists. */
5840 static void DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
5841 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
5842 {
5843 Jim_HashTable *ht = objPtr->internalRep.ptr;
5844
5845 if (valueObjPtr == NULL) { /* unset */
5846 Jim_DeleteHashEntry(ht, keyObjPtr);
5847 return;
5848 }
5849 Jim_IncrRefCount(keyObjPtr);
5850 Jim_IncrRefCount(valueObjPtr);
5851 if (Jim_AddHashEntry(ht, keyObjPtr, valueObjPtr) != JIM_OK) {
5852 Jim_HashEntry *he = Jim_FindHashEntry(ht, keyObjPtr);
5853 Jim_DecrRefCount(interp, keyObjPtr);
5854 /* ATTENTION: const cast */
5855 Jim_DecrRefCount(interp, (Jim_Obj*)he->val);
5856 he->val = valueObjPtr;
5857 }
5858 }
5859
5860 /* Add an element, higher-level interface for DictAddElement().
5861 * If valueObjPtr == NULL, the key is removed if it exists. */
5862 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
5863 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
5864 {
5865 if (Jim_IsShared(objPtr))
5866 Jim_Panic(interp,"Jim_DictAddElement called with shared object");
5867 if (objPtr->typePtr != &dictObjType) {
5868 if (SetDictFromAny(interp, objPtr) != JIM_OK)
5869 return JIM_ERR;
5870 }
5871 DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
5872 Jim_InvalidateStringRep(objPtr);
5873 return JIM_OK;
5874 }
5875
5876 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
5877 {
5878 Jim_Obj *objPtr;
5879 int i;
5880
5881 if (len % 2)
5882 Jim_Panic(interp,"Jim_NewDicObj() 'len' argument must be even");
5883
5884 objPtr = Jim_NewObj(interp);
5885 objPtr->typePtr = &dictObjType;
5886 objPtr->bytes = NULL;
5887 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
5888 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
5889 for (i = 0; i < len; i += 2)
5890 DictAddElement(interp, objPtr, elements[i], elements[i+1]);
5891 return objPtr;
5892 }
5893
5894 /* Return the value associated to the specified dict key */
5895 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
5896 Jim_Obj **objPtrPtr, int flags)
5897 {
5898 Jim_HashEntry *he;
5899 Jim_HashTable *ht;
5900
5901 if (dictPtr->typePtr != &dictObjType) {
5902 if (SetDictFromAny(interp, dictPtr) != JIM_OK)
5903 return JIM_ERR;
5904 }
5905 ht = dictPtr->internalRep.ptr;
5906 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
5907 if (flags & JIM_ERRMSG) {
5908 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
5909 Jim_AppendStrings(interp, Jim_GetResult(interp),
5910 "key \"", Jim_GetString(keyPtr, NULL),
5911 "\" not found in dictionary", NULL);
5912 }
5913 return JIM_ERR;
5914 }
5915 *objPtrPtr = he->val;
5916 return JIM_OK;
5917 }
5918
5919 /* Return the value associated to the specified dict keys */
5920 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
5921 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
5922 {
5923 Jim_Obj *objPtr;
5924 int i;
5925
5926 if (keyc == 0) {
5927 *objPtrPtr = dictPtr;
5928 return JIM_OK;
5929 }
5930
5931 for (i = 0; i < keyc; i++) {
5932 if (Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags)
5933 != JIM_OK)
5934 return JIM_ERR;
5935 dictPtr = objPtr;
5936 }
5937 *objPtrPtr = objPtr;
5938 return JIM_OK;
5939 }
5940
5941 /* Modify the dict stored into the variable named 'varNamePtr'
5942 * setting the element specified by the 'keyc' keys objects in 'keyv',
5943 * with the new value of the element 'newObjPtr'.
5944 *
5945 * If newObjPtr == NULL the operation is to remove the given key
5946 * from the dictionary. */
5947 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
5948 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr)
5949 {
5950 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
5951 int shared, i;
5952
5953 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
5954 if (objPtr == NULL) {
5955 if (newObjPtr == NULL) /* Cannot remove a key from non existing var */
5956 return JIM_ERR;
5957 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
5958 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
5959 Jim_FreeNewObj(interp, varObjPtr);
5960 return JIM_ERR;
5961 }
5962 }
5963 if ((shared = Jim_IsShared(objPtr)))
5964 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
5965 for (i = 0; i < keyc-1; i++) {
5966 dictObjPtr = objPtr;
5967
5968 /* Check if it's a valid dictionary */
5969 if (dictObjPtr->typePtr != &dictObjType) {
5970 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK)
5971 goto err;
5972 }
5973 /* Check if the given key exists. */
5974 Jim_InvalidateStringRep(dictObjPtr);
5975 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
5976 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK)
5977 {
5978 /* This key exists at the current level.
5979 * Make sure it's not shared!. */
5980 if (Jim_IsShared(objPtr)) {
5981 objPtr = Jim_DuplicateObj(interp, objPtr);
5982 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
5983 }
5984 } else {
5985 /* Key not found. If it's an [unset] operation
5986 * this is an error. Only the last key may not
5987 * exist. */
5988 if (newObjPtr == NULL)
5989 goto err;
5990 /* Otherwise set an empty dictionary
5991 * as key's value. */
5992 objPtr = Jim_NewDictObj(interp, NULL, 0);
5993 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
5994 }
5995 }
5996 if (Jim_DictAddElement(interp, objPtr, keyv[keyc-1], newObjPtr)
5997 != JIM_OK)
5998 goto err;
5999 Jim_InvalidateStringRep(objPtr);
6000 Jim_InvalidateStringRep(varObjPtr);
6001 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
6002 goto err;
6003 Jim_SetResult(interp, varObjPtr);
6004 return JIM_OK;
6005 err:
6006 if (shared) {
6007 Jim_FreeNewObj(interp, varObjPtr);
6008 }
6009 return JIM_ERR;
6010 }
6011
6012 /* -----------------------------------------------------------------------------
6013 * Index object
6014 * ---------------------------------------------------------------------------*/
6015 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
6016 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6017
6018 static Jim_ObjType indexObjType = {
6019 "index",
6020 NULL,
6021 NULL,
6022 UpdateStringOfIndex,
6023 JIM_TYPE_NONE,
6024 };
6025
6026 void UpdateStringOfIndex(struct Jim_Obj *objPtr)
6027 {
6028 int len;
6029 char buf[JIM_INTEGER_SPACE+1];
6030
6031 if (objPtr->internalRep.indexValue >= 0)
6032 len = sprintf(buf, "%d", objPtr->internalRep.indexValue);
6033 else if (objPtr->internalRep.indexValue == -1)
6034 len = sprintf(buf, "end");
6035 else {
6036 len = sprintf(buf, "end%d", objPtr->internalRep.indexValue+1);
6037 }
6038 objPtr->bytes = Jim_Alloc(len+1);
6039 memcpy(objPtr->bytes, buf, len+1);
6040 objPtr->length = len;
6041 }
6042
6043 int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6044 {
6045 int index, end = 0;
6046 const char *str;
6047
6048 /* Get the string representation */
6049 str = Jim_GetString(objPtr, NULL);
6050 /* Try to convert into an index */
6051 if (!strcmp(str, "end")) {
6052 index = 0;
6053 end = 1;
6054 } else {
6055 if (!strncmp(str, "end-", 4)) {
6056 str += 4;
6057 end = 1;
6058 }
6059 if (Jim_StringToIndex(str, &index) != JIM_OK) {
6060 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
6061 Jim_AppendStrings(interp, Jim_GetResult(interp),
6062 "bad index \"", Jim_GetString(objPtr, NULL), "\": "
6063 "must be integer or end?-integer?", NULL);
6064 return JIM_ERR;
6065 }
6066 }
6067 if (end) {
6068 if (index < 0)
6069 index = INT_MAX;
6070 else
6071 index = -(index+1);
6072 } else if (!end && index < 0)
6073 index = -INT_MAX;
6074 /* Free the old internal repr and set the new one. */
6075 Jim_FreeIntRep(interp, objPtr);
6076 objPtr->typePtr = &indexObjType;
6077 objPtr->internalRep.indexValue = index;
6078 return JIM_OK;
6079 }
6080
6081 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
6082 {
6083 /* Avoid shimmering if the object is an integer. */
6084 if (objPtr->typePtr == &intObjType) {
6085 jim_wide val = objPtr->internalRep.wideValue;
6086 if (!(val < LONG_MIN) && !(val > LONG_MAX)) {
6087 *indexPtr = (val < 0) ? -INT_MAX : (long)val;;
6088 return JIM_OK;
6089 }
6090 }
6091 if (objPtr->typePtr != &indexObjType &&
6092 SetIndexFromAny(interp, objPtr) == JIM_ERR)
6093 return JIM_ERR;
6094 *indexPtr = objPtr->internalRep.indexValue;
6095 return JIM_OK;
6096 }
6097
6098 /* -----------------------------------------------------------------------------
6099 * Return Code Object.
6100 * ---------------------------------------------------------------------------*/
6101
6102 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
6103
6104 static Jim_ObjType returnCodeObjType = {
6105 "return-code",
6106 NULL,
6107 NULL,
6108 NULL,
6109 JIM_TYPE_NONE,
6110 };
6111
6112 int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6113 {
6114 const char *str;
6115 int strLen, returnCode;
6116 jim_wide wideValue;
6117
6118 /* Get the string representation */
6119 str = Jim_GetString(objPtr, &strLen);
6120 /* Try to convert into an integer */
6121 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
6122 returnCode = (int) wideValue;
6123 else if (!JimStringCompare(str, strLen, "ok", 2, JIM_NOCASE))
6124 returnCode = JIM_OK;
6125 else if (!JimStringCompare(str, strLen, "error", 5, JIM_NOCASE))
6126 returnCode = JIM_ERR;
6127 else if (!JimStringCompare(str, strLen, "return", 6, JIM_NOCASE))
6128 returnCode = JIM_RETURN;
6129 else if (!JimStringCompare(str, strLen, "break", 5, JIM_NOCASE))
6130 returnCode = JIM_BREAK;
6131 else if (!JimStringCompare(str, strLen, "continue", 8, JIM_NOCASE))
6132 returnCode = JIM_CONTINUE;
6133 else if (!JimStringCompare(str, strLen, "eval", 4, JIM_NOCASE))
6134 returnCode = JIM_EVAL;
6135 else if (!JimStringCompare(str, strLen, "exit", 4, JIM_NOCASE))
6136 returnCode = JIM_EXIT;
6137 else {
6138 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
6139 Jim_AppendStrings(interp, Jim_GetResult(interp),
6140 "expected return code but got '", str, "'",
6141 NULL);
6142 return JIM_ERR;
6143 }
6144 /* Free the old internal repr and set the new one. */
6145 Jim_FreeIntRep(interp, objPtr);
6146 objPtr->typePtr = &returnCodeObjType;
6147 objPtr->internalRep.returnCode = returnCode;
6148 return JIM_OK;
6149 }
6150
6151 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
6152 {
6153 if (objPtr->typePtr != &returnCodeObjType &&
6154 SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
6155 return JIM_ERR;
6156 *intPtr = objPtr->internalRep.returnCode;
6157 return JIM_OK;
6158 }
6159
6160 /* -----------------------------------------------------------------------------
6161 * Expression Parsing
6162 * ---------------------------------------------------------------------------*/
6163 static int JimParseExprOperator(struct JimParserCtx *pc);
6164 static int JimParseExprNumber(struct JimParserCtx *pc);
6165 static int JimParseExprIrrational(struct JimParserCtx *pc);
6166
6167 /* Exrp's Stack machine operators opcodes. */
6168
6169 /* Binary operators (numbers) */
6170 #define JIM_EXPROP_BINARY_NUM_FIRST 0 /* first */
6171 #define JIM_EXPROP_MUL 0
6172 #define JIM_EXPROP_DIV 1
6173 #define JIM_EXPROP_MOD 2
6174 #define JIM_EXPROP_SUB 3
6175 #define JIM_EXPROP_ADD 4
6176 #define JIM_EXPROP_LSHIFT 5
6177 #define JIM_EXPROP_RSHIFT 6
6178 #define JIM_EXPROP_ROTL 7
6179 #define JIM_EXPROP_ROTR 8
6180 #define JIM_EXPROP_LT 9
6181 #define JIM_EXPROP_GT 10
6182 #define JIM_EXPROP_LTE 11
6183 #define JIM_EXPROP_GTE 12
6184 #define JIM_EXPROP_NUMEQ 13
6185 #define JIM_EXPROP_NUMNE 14
6186 #define JIM_EXPROP_BITAND 15
6187 #define JIM_EXPROP_BITXOR 16
6188 #define JIM_EXPROP_BITOR 17
6189 #define JIM_EXPROP_LOGICAND 18
6190 #define JIM_EXPROP_LOGICOR 19
6191 #define JIM_EXPROP_LOGICAND_LEFT 20
6192 #define JIM_EXPROP_LOGICOR_LEFT 21
6193 #define JIM_EXPROP_POW 22
6194 #define JIM_EXPROP_BINARY_NUM_LAST 22 /* last */
6195
6196 /* Binary operators (strings) */
6197 #define JIM_EXPROP_STREQ 23
6198 #define JIM_EXPROP_STRNE 24
6199
6200 /* Unary operators (numbers) */
6201 #define JIM_EXPROP_NOT 25
6202 #define JIM_EXPROP_BITNOT 26
6203 #define JIM_EXPROP_UNARYMINUS 27
6204 #define JIM_EXPROP_UNARYPLUS 28
6205 #define JIM_EXPROP_LOGICAND_RIGHT 29
6206 #define JIM_EXPROP_LOGICOR_RIGHT 30
6207
6208 /* Ternary operators */
6209 #define JIM_EXPROP_TERNARY 31
6210
6211 /* Operands */
6212 #define JIM_EXPROP_NUMBER 32
6213 #define JIM_EXPROP_COMMAND 33
6214 #define JIM_EXPROP_VARIABLE 34
6215 #define JIM_EXPROP_DICTSUGAR 35
6216 #define JIM_EXPROP_SUBST 36
6217 #define JIM_EXPROP_STRING 37
6218
6219 /* Operators table */
6220 typedef struct Jim_ExprOperator {
6221 const char *name;
6222 int precedence;
6223 int arity;
6224 int opcode;
6225 } Jim_ExprOperator;
6226
6227 /* name - precedence - arity - opcode */
6228 static struct Jim_ExprOperator Jim_ExprOperators[] = {
6229 {"!", 300, 1, JIM_EXPROP_NOT},
6230 {"~", 300, 1, JIM_EXPROP_BITNOT},
6231 {"unarymin", 300, 1, JIM_EXPROP_UNARYMINUS},
6232 {"unaryplus", 300, 1, JIM_EXPROP_UNARYPLUS},
6233
6234 {"**", 250, 2, JIM_EXPROP_POW},
6235
6236 {"*", 200, 2, JIM_EXPROP_MUL},
6237 {"/", 200, 2, JIM_EXPROP_DIV},
6238 {"%", 200, 2, JIM_EXPROP_MOD},
6239
6240 {"-", 100, 2, JIM_EXPROP_SUB},
6241 {"+", 100, 2, JIM_EXPROP_ADD},
6242
6243 {"<<<", 90, 3, JIM_EXPROP_ROTL},
6244 {">>>", 90, 3, JIM_EXPROP_ROTR},
6245 {"<<", 90, 2, JIM_EXPROP_LSHIFT},
6246 {">>", 90, 2, JIM_EXPROP_RSHIFT},
6247
6248 {"<", 80, 2, JIM_EXPROP_LT},
6249 {">", 80, 2, JIM_EXPROP_GT},
6250 {"<=", 80, 2, JIM_EXPROP_LTE},
6251 {">=", 80, 2, JIM_EXPROP_GTE},
6252
6253 {"==", 70, 2, JIM_EXPROP_NUMEQ},
6254 {"!=", 70, 2, JIM_EXPROP_NUMNE},
6255
6256 {"eq", 60, 2, JIM_EXPROP_STREQ},
6257 {"ne", 60, 2, JIM_EXPROP_STRNE},
6258
6259 {"&", 50, 2, JIM_EXPROP_BITAND},
6260 {"^", 49, 2, JIM_EXPROP_BITXOR},
6261 {"|", 48, 2, JIM_EXPROP_BITOR},
6262
6263 {"&&", 10, 2, JIM_EXPROP_LOGICAND},
6264 {"||", 10, 2, JIM_EXPROP_LOGICOR},
6265
6266 {"?", 5, 3, JIM_EXPROP_TERNARY},
6267 /* private operators */
6268 {NULL, 10, 2, JIM_EXPROP_LOGICAND_LEFT},
6269 {NULL, 10, 1, JIM_EXPROP_LOGICAND_RIGHT},
6270 {NULL, 10, 2, JIM_EXPROP_LOGICOR_LEFT},
6271 {NULL, 10, 1, JIM_EXPROP_LOGICOR_RIGHT},
6272 };
6273
6274 #define JIM_EXPR_OPERATORS_NUM \
6275 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
6276
6277 int JimParseExpression(struct JimParserCtx *pc)
6278 {
6279 /* Discard spaces and quoted newline */
6280 while(*(pc->p) == ' ' ||
6281 *(pc->p) == '\t' ||
6282 *(pc->p) == '\r' ||
6283 *(pc->p) == '\n' ||
6284 (*(pc->p) == '\\' && *(pc->p+1) == '\n')) {
6285 pc->p++; pc->len--;
6286 }
6287
6288 if (pc->len == 0) {
6289 pc->tstart = pc->tend = pc->p;
6290 pc->tline = pc->linenr;
6291 pc->tt = JIM_TT_EOL;
6292 pc->eof = 1;
6293 return JIM_OK;
6294 }
6295 switch(*(pc->p)) {
6296 case '(':
6297 pc->tstart = pc->tend = pc->p;
6298 pc->tline = pc->linenr;
6299 pc->tt = JIM_TT_SUBEXPR_START;
6300 pc->p++; pc->len--;
6301 break;
6302 case ')':
6303 pc->tstart = pc->tend = pc->p;
6304 pc->tline = pc->linenr;
6305 pc->tt = JIM_TT_SUBEXPR_END;
6306 pc->p++; pc->len--;
6307 break;
6308 case '[':
6309 return JimParseCmd(pc);
6310 break;
6311 case '$':
6312 if (JimParseVar(pc) == JIM_ERR)
6313 return JimParseExprOperator(pc);
6314 else
6315 return JIM_OK;
6316 break;
6317 case '-':
6318 if ((pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_EXPR_OPERATOR) &&
6319 isdigit((int)*(pc->p+1)))
6320 return JimParseExprNumber(pc);
6321 else
6322 return JimParseExprOperator(pc);
6323 break;
6324 case '0': case '1': case '2': case '3': case '4':
6325 case '5': case '6': case '7': case '8': case '9': case '.':
6326 return JimParseExprNumber(pc);
6327 break;
6328 case '"':
6329 case '{':
6330 /* Here it's possible to reuse the List String parsing. */
6331 pc->tt = JIM_TT_NONE; /* Make sure it's sensed as a new word. */
6332 return JimParseListStr(pc);
6333 break;
6334 case 'N': case 'I':
6335 case 'n': case 'i':
6336 if (JimParseExprIrrational(pc) == JIM_ERR)
6337 return JimParseExprOperator(pc);
6338 break;
6339 default:
6340 return JimParseExprOperator(pc);
6341 break;
6342 }
6343 return JIM_OK;
6344 }
6345
6346 int JimParseExprNumber(struct JimParserCtx *pc)
6347 {
6348 int allowdot = 1;
6349 int allowhex = 0;
6350
6351 pc->tstart = pc->p;
6352 pc->tline = pc->linenr;
6353 if (*pc->p == '-') {
6354 pc->p++; pc->len--;
6355 }
6356 while ( isdigit((int)*pc->p)
6357 || (allowhex && isxdigit((int)*pc->p) )
6358 || (allowdot && *pc->p == '.')
6359 || (pc->p-pc->tstart == 1 && *pc->tstart == '0' &&
6360 (*pc->p == 'x' || *pc->p == 'X'))
6361 )
6362 {
6363 if ((*pc->p == 'x') || (*pc->p == 'X')) {
6364 allowhex = 1;
6365 allowdot = 0;
6366 }
6367 if (*pc->p == '.')
6368 allowdot = 0;
6369 pc->p++; pc->len--;
6370 if (!allowdot && *pc->p == 'e' && *(pc->p+1) == '-') {
6371 pc->p += 2; pc->len -= 2;
6372 }
6373 }
6374 pc->tend = pc->p-1;
6375 pc->tt = JIM_TT_EXPR_NUMBER;
6376 return JIM_OK;
6377 }
6378
6379 int JimParseExprIrrational(struct JimParserCtx *pc)
6380 {
6381 const char *Tokens[] = {"NaN", "nan", "NAN", "Inf", "inf", "INF", NULL};
6382 const char **token;
6383 for (token = Tokens; *token != NULL; token++) {
6384 int len = strlen(*token);
6385 if (strncmp(*token, pc->p, len) == 0) {
6386 pc->tstart = pc->p;
6387 pc->tend = pc->p + len - 1;
6388 pc->p += len; pc->len -= len;
6389 pc->tline = pc->linenr;
6390 pc->tt = JIM_TT_EXPR_NUMBER;
6391 return JIM_OK;
6392 }
6393 }
6394 return JIM_ERR;
6395 }
6396
6397 int JimParseExprOperator(struct JimParserCtx *pc)
6398 {
6399 int i;
6400 int bestIdx = -1, bestLen = 0;
6401
6402 /* Try to get the longest match. */
6403 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
6404 const char *opname;
6405 int oplen;
6406
6407 opname = Jim_ExprOperators[i].name;
6408 if (opname == NULL) continue;
6409 oplen = strlen(opname);
6410
6411 if (strncmp(opname, pc->p, oplen) == 0 && oplen > bestLen) {
6412 bestIdx = i;
6413 bestLen = oplen;
6414 }
6415 }
6416 if (bestIdx == -1) return JIM_ERR;
6417 pc->tstart = pc->p;
6418 pc->tend = pc->p + bestLen - 1;
6419 pc->p += bestLen; pc->len -= bestLen;
6420 pc->tline = pc->linenr;
6421 pc->tt = JIM_TT_EXPR_OPERATOR;
6422 return JIM_OK;
6423 }
6424
6425 struct Jim_ExprOperator *JimExprOperatorInfo(const char *opname)
6426 {
6427 int i;
6428 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++)
6429 if (Jim_ExprOperators[i].name &&
6430 strcmp(opname, Jim_ExprOperators[i].name) == 0)
6431 return &Jim_ExprOperators[i];
6432 return NULL;
6433 }
6434
6435 struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
6436 {
6437 int i;
6438 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++)
6439 if (Jim_ExprOperators[i].opcode == opcode)
6440 return &Jim_ExprOperators[i];
6441 return NULL;
6442 }
6443
6444 /* -----------------------------------------------------------------------------
6445 * Expression Object
6446 * ---------------------------------------------------------------------------*/
6447 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6448 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6449 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6450
6451 static Jim_ObjType exprObjType = {
6452 "expression",
6453 FreeExprInternalRep,
6454 DupExprInternalRep,
6455 NULL,
6456 JIM_TYPE_REFERENCES,
6457 };
6458
6459 /* Expr bytecode structure */
6460 typedef struct ExprByteCode {
6461 int *opcode; /* Integer array of opcodes. */
6462 Jim_Obj **obj; /* Array of associated Jim Objects. */
6463 int len; /* Bytecode length */
6464 int inUse; /* Used for sharing. */
6465 } ExprByteCode;
6466
6467 void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6468 {
6469 int i;
6470 ExprByteCode *expr = (void*) objPtr->internalRep.ptr;
6471
6472 expr->inUse--;
6473 if (expr->inUse != 0) return;
6474 for (i = 0; i < expr->len; i++)
6475 Jim_DecrRefCount(interp, expr->obj[i]);
6476 Jim_Free(expr->opcode);
6477 Jim_Free(expr->obj);
6478 Jim_Free(expr);
6479 }
6480
6481 void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6482 {
6483 JIM_NOTUSED(interp);
6484 JIM_NOTUSED(srcPtr);
6485
6486 /* Just returns an simple string. */
6487 dupPtr->typePtr = NULL;
6488 }
6489
6490 /* Add a new instruction to an expression bytecode structure. */
6491 static void ExprObjAddInstr(Jim_Interp *interp, ExprByteCode *expr,
6492 int opcode, char *str, int len)
6493 {
6494 expr->opcode = Jim_Realloc(expr->opcode, sizeof(int)*(expr->len+1));
6495 expr->obj = Jim_Realloc(expr->obj, sizeof(Jim_Obj*)*(expr->len+1));
6496 expr->opcode[expr->len] = opcode;
6497 expr->obj[expr->len] = Jim_NewStringObjNoAlloc(interp, str, len);
6498 Jim_IncrRefCount(expr->obj[expr->len]);
6499 expr->len++;
6500 }
6501
6502 /* Check if an expr program looks correct. */
6503 static int ExprCheckCorrectness(ExprByteCode *expr)
6504 {
6505 int i;
6506 int stacklen = 0;
6507
6508 /* Try to check if there are stack underflows,
6509 * and make sure at the end of the program there is
6510 * a single result on the stack. */
6511 for (i = 0; i < expr->len; i++) {
6512 switch(expr->opcode[i]) {
6513 case JIM_EXPROP_NUMBER:
6514 case JIM_EXPROP_STRING:
6515 case JIM_EXPROP_SUBST:
6516 case JIM_EXPROP_VARIABLE:
6517 case JIM_EXPROP_DICTSUGAR:
6518 case JIM_EXPROP_COMMAND:
6519 stacklen++;
6520 break;
6521 case JIM_EXPROP_NOT:
6522 case JIM_EXPROP_BITNOT:
6523 case JIM_EXPROP_UNARYMINUS:
6524 case JIM_EXPROP_UNARYPLUS:
6525 /* Unary operations */
6526 if (stacklen < 1) return JIM_ERR;
6527 break;
6528 case JIM_EXPROP_ADD:
6529 case JIM_EXPROP_SUB:
6530 case JIM_EXPROP_MUL:
6531 case JIM_EXPROP_DIV:
6532 case JIM_EXPROP_MOD:
6533 case JIM_EXPROP_LT:
6534 case JIM_EXPROP_GT:
6535 case JIM_EXPROP_LTE:
6536 case JIM_EXPROP_GTE:
6537 case JIM_EXPROP_ROTL:
6538 case JIM_EXPROP_ROTR:
6539 case JIM_EXPROP_LSHIFT:
6540 case JIM_EXPROP_RSHIFT:
6541 case JIM_EXPROP_NUMEQ:
6542 case JIM_EXPROP_NUMNE:
6543 case JIM_EXPROP_STREQ:
6544 case JIM_EXPROP_STRNE:
6545 case JIM_EXPROP_BITAND:
6546 case JIM_EXPROP_BITXOR:
6547 case JIM_EXPROP_BITOR:
6548 case JIM_EXPROP_LOGICAND:
6549 case JIM_EXPROP_LOGICOR:
6550 case JIM_EXPROP_POW:
6551 /* binary operations */
6552 if (stacklen < 2) return JIM_ERR;
6553 stacklen--;
6554 break;
6555 default:
6556 Jim_Panic(NULL,"Default opcode reached ExprCheckCorrectness");
6557 break;
6558 }
6559 }
6560 if (stacklen != 1) return JIM_ERR;
6561 return JIM_OK;
6562 }
6563
6564 static void ExprShareLiterals(Jim_Interp *interp, ExprByteCode *expr,
6565 ScriptObj *topLevelScript)
6566 {
6567 int i;
6568
6569 return;
6570 for (i = 0; i < expr->len; i++) {
6571 Jim_Obj *foundObjPtr;
6572
6573 if (expr->obj[i] == NULL) continue;
6574 foundObjPtr = ScriptSearchLiteral(interp, topLevelScript,
6575 NULL, expr->obj[i]);
6576 if (foundObjPtr != NULL) {
6577 Jim_IncrRefCount(foundObjPtr);
6578 Jim_DecrRefCount(interp, expr->obj[i]);
6579 expr->obj[i] = foundObjPtr;
6580 }
6581 }
6582 }
6583
6584 /* This procedure converts every occurrence of || and && opereators
6585 * in lazy unary versions.
6586 *
6587 * a b || is converted into:
6588 *
6589 * a <offset> |L b |R
6590 *
6591 * a b && is converted into:
6592 *
6593 * a <offset> &L b &R
6594 *
6595 * "|L" checks if 'a' is true:
6596 * 1) if it is true pushes 1 and skips <offset> istructions to reach
6597 * the opcode just after |R.
6598 * 2) if it is false does nothing.
6599 * "|R" checks if 'b' is true:
6600 * 1) if it is true pushes 1, otherwise pushes 0.
6601 *
6602 * "&L" checks if 'a' is true:
6603 * 1) if it is true does nothing.
6604 * 2) If it is false pushes 0 and skips <offset> istructions to reach
6605 * the opcode just after &R
6606 * "&R" checks if 'a' is true:
6607 * if it is true pushes 1, otherwise pushes 0.
6608 */
6609 static void ExprMakeLazy(Jim_Interp *interp, ExprByteCode *expr)
6610 {
6611 while (1) {
6612 int index = -1, leftindex, arity, i, offset;
6613 Jim_ExprOperator *op;
6614
6615 /* Search for || or && */
6616 for (i = 0; i < expr->len; i++) {
6617 if (expr->opcode[i] == JIM_EXPROP_LOGICAND ||
6618 expr->opcode[i] == JIM_EXPROP_LOGICOR) {
6619 index = i;
6620 break;
6621 }
6622 }
6623 if (index == -1) return;
6624 /* Search for the end of the first operator */
6625 leftindex = index-1;
6626 arity = 1;
6627 while(arity) {
6628 switch(expr->opcode[leftindex]) {
6629 case JIM_EXPROP_NUMBER:
6630 case JIM_EXPROP_COMMAND:
6631 case JIM_EXPROP_VARIABLE:
6632 case JIM_EXPROP_DICTSUGAR:
6633 case JIM_EXPROP_SUBST:
6634 case JIM_EXPROP_STRING:
6635 break;
6636 default:
6637 op = JimExprOperatorInfoByOpcode(expr->opcode[leftindex]);
6638 if (op == NULL) {
6639 Jim_Panic(interp,"Default reached in ExprMakeLazy()");
6640 }
6641 arity += op->arity;
6642 break;
6643 }
6644 arity--;
6645 leftindex--;
6646 }
6647 leftindex++;
6648 expr->opcode = Jim_Realloc(expr->opcode, sizeof(int)*(expr->len+2));
6649 expr->obj = Jim_Realloc(expr->obj, sizeof(Jim_Obj*)*(expr->len+2));
6650 memmove(&expr->opcode[leftindex+2], &expr->opcode[leftindex],
6651 sizeof(int)*(expr->len-leftindex));
6652 memmove(&expr->obj[leftindex+2], &expr->obj[leftindex],
6653 sizeof(Jim_Obj*)*(expr->len-leftindex));
6654 expr->len += 2;
6655 index += 2;
6656 offset = (index-leftindex)-1;
6657 Jim_DecrRefCount(interp, expr->obj[index]);
6658 if (expr->opcode[index] == JIM_EXPROP_LOGICAND) {
6659 expr->opcode[leftindex+1] = JIM_EXPROP_LOGICAND_LEFT;
6660 expr->opcode[index] = JIM_EXPROP_LOGICAND_RIGHT;
6661 expr->obj[leftindex+1] = Jim_NewStringObj(interp, "&L", -1);
6662 expr->obj[index] = Jim_NewStringObj(interp, "&R", -1);
6663 } else {
6664 expr->opcode[leftindex+1] = JIM_EXPROP_LOGICOR_LEFT;
6665 expr->opcode[index] = JIM_EXPROP_LOGICOR_RIGHT;
6666 expr->obj[leftindex+1] = Jim_NewStringObj(interp, "|L", -1);
6667 expr->obj[index] = Jim_NewStringObj(interp, "|R", -1);
6668 }
6669 expr->opcode[leftindex] = JIM_EXPROP_NUMBER;
6670 expr->obj[leftindex] = Jim_NewIntObj(interp, offset);
6671 Jim_IncrRefCount(expr->obj[index]);
6672 Jim_IncrRefCount(expr->obj[leftindex]);
6673 Jim_IncrRefCount(expr->obj[leftindex+1]);
6674 }
6675 }
6676
6677 /* This method takes the string representation of an expression
6678 * and generates a program for the Expr's stack-based VM. */
6679 int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6680 {
6681 int exprTextLen;
6682 const char *exprText = Jim_GetString(objPtr, &exprTextLen);
6683 struct JimParserCtx parser;
6684 int i, shareLiterals;
6685 ExprByteCode *expr = Jim_Alloc(sizeof(*expr));
6686 Jim_Stack stack;
6687 Jim_ExprOperator *op;
6688
6689 /* Perform literal sharing with the current procedure
6690 * running only if this expression appears to be not generated
6691 * at runtime. */
6692 shareLiterals = objPtr->typePtr == &sourceObjType;
6693
6694 expr->opcode = NULL;
6695 expr->obj = NULL;
6696 expr->len = 0;
6697 expr->inUse = 1;
6698
6699 Jim_InitStack(&stack);
6700 JimParserInit(&parser, exprText, exprTextLen, 1);
6701 while(!JimParserEof(&parser)) {
6702 char *token;
6703 int len, type;
6704
6705 if (JimParseExpression(&parser) != JIM_OK) {
6706 Jim_SetResultString(interp, "Syntax error in expression", -1);
6707 goto err;
6708 }
6709 token = JimParserGetToken(&parser, &len, &type, NULL);
6710 if (type == JIM_TT_EOL) {
6711 Jim_Free(token);
6712 break;
6713 }
6714 switch(type) {
6715 case JIM_TT_STR:
6716 ExprObjAddInstr(interp, expr, JIM_EXPROP_STRING, token, len);
6717 break;
6718 case JIM_TT_ESC:
6719 ExprObjAddInstr(interp, expr, JIM_EXPROP_SUBST, token, len);
6720 break;
6721 case JIM_TT_VAR:
6722 ExprObjAddInstr(interp, expr, JIM_EXPROP_VARIABLE, token, len);
6723 break;
6724 case JIM_TT_DICTSUGAR:
6725 ExprObjAddInstr(interp, expr, JIM_EXPROP_DICTSUGAR, token, len);
6726 break;
6727 case JIM_TT_CMD:
6728 ExprObjAddInstr(interp, expr, JIM_EXPROP_COMMAND, token, len);
6729 break;
6730 case JIM_TT_EXPR_NUMBER:
6731 ExprObjAddInstr(interp, expr, JIM_EXPROP_NUMBER, token, len);
6732 break;
6733 case JIM_TT_EXPR_OPERATOR:
6734 op = JimExprOperatorInfo(token);
6735 while(1) {
6736 Jim_ExprOperator *stackTopOp;
6737
6738 if (Jim_StackPeek(&stack) != NULL) {
6739 stackTopOp = JimExprOperatorInfo(Jim_StackPeek(&stack));
6740 } else {
6741 stackTopOp = NULL;
6742 }
6743 if (Jim_StackLen(&stack) && op->arity != 1 &&
6744 stackTopOp && stackTopOp->precedence >= op->precedence)
6745 {
6746 ExprObjAddInstr(interp, expr, stackTopOp->opcode,
6747 Jim_StackPeek(&stack), -1);
6748 Jim_StackPop(&stack);
6749 } else {
6750 break;
6751 }
6752 }
6753 Jim_StackPush(&stack, token);
6754 break;
6755 case JIM_TT_SUBEXPR_START:
6756 Jim_StackPush(&stack, Jim_StrDup("("));
6757 Jim_Free(token);
6758 break;
6759 case JIM_TT_SUBEXPR_END:
6760 {
6761 int found = 0;
6762 while(Jim_StackLen(&stack)) {
6763 char *opstr = Jim_StackPop(&stack);
6764 if (!strcmp(opstr, "(")) {
6765 Jim_Free(opstr);
6766 found = 1;
6767 break;
6768 }
6769 op = JimExprOperatorInfo(opstr);
6770 ExprObjAddInstr(interp, expr, op->opcode, opstr, -1);
6771 }
6772 if (!found) {
6773 Jim_SetResultString(interp,
6774 "Unexpected close parenthesis", -1);
6775 goto err;
6776 }
6777 }
6778 Jim_Free(token);
6779 break;
6780 default:
6781 Jim_Panic(interp,"Default reached in SetExprFromAny()");
6782 break;
6783 }
6784 }
6785 while (Jim_StackLen(&stack)) {
6786 char *opstr = Jim_StackPop(&stack);
6787 op = JimExprOperatorInfo(opstr);
6788 if (op == NULL && !strcmp(opstr, "(")) {
6789 Jim_Free(opstr);
6790 Jim_SetResultString(interp, "Missing close parenthesis", -1);
6791 goto err;
6792 }
6793 ExprObjAddInstr(interp, expr, op->opcode, opstr, -1);
6794 }
6795 /* Check program correctness. */
6796 if (ExprCheckCorrectness(expr) != JIM_OK) {
6797 Jim_SetResultString(interp, "Invalid expression", -1);
6798 goto err;
6799 }
6800
6801 /* Free the stack used for the compilation. */
6802 Jim_FreeStackElements(&stack, Jim_Free);
6803 Jim_FreeStack(&stack);
6804
6805 /* Convert || and && operators in unary |L |R and &L &R for lazyness */
6806 ExprMakeLazy(interp, expr);
6807
6808 /* Perform literal sharing */
6809 if (shareLiterals && interp->framePtr->procBodyObjPtr) {
6810 Jim_Obj *bodyObjPtr = interp->framePtr->procBodyObjPtr;
6811 if (bodyObjPtr->typePtr == &scriptObjType) {
6812 ScriptObj *bodyScript = bodyObjPtr->internalRep.ptr;
6813 ExprShareLiterals(interp, expr, bodyScript);
6814 }
6815 }
6816
6817 /* Free the old internal rep and set the new one. */
6818 Jim_FreeIntRep(interp, objPtr);
6819 Jim_SetIntRepPtr(objPtr, expr);
6820 objPtr->typePtr = &exprObjType;
6821 return JIM_OK;
6822
6823 err: /* we jump here on syntax/compile errors. */
6824 Jim_FreeStackElements(&stack, Jim_Free);
6825 Jim_FreeStack(&stack);
6826 Jim_Free(expr->opcode);
6827 for (i = 0; i < expr->len; i++) {
6828 Jim_DecrRefCount(interp,expr->obj[i]);
6829 }
6830 Jim_Free(expr->obj);
6831 Jim_Free(expr);
6832 return JIM_ERR;
6833 }
6834
6835 ExprByteCode *Jim_GetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
6836 {
6837 if (objPtr->typePtr != &exprObjType) {
6838 if (SetExprFromAny(interp, objPtr) != JIM_OK)
6839 return NULL;
6840 }
6841 return (ExprByteCode*) Jim_GetIntRepPtr(objPtr);
6842 }
6843
6844 /* -----------------------------------------------------------------------------
6845 * Expressions evaluation.
6846 * Jim uses a specialized stack-based virtual machine for expressions,
6847 * that takes advantage of the fact that expr's operators
6848 * can't be redefined.
6849 *
6850 * Jim_EvalExpression() uses the bytecode compiled by
6851 * SetExprFromAny() method of the "expression" object.
6852 *
6853 * On success a Tcl Object containing the result of the evaluation
6854 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
6855 * returned.
6856 * On error the function returns a retcode != to JIM_OK and set a suitable
6857 * error on the interp.
6858 * ---------------------------------------------------------------------------*/
6859 #define JIM_EE_STATICSTACK_LEN 10
6860
6861 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr,
6862 Jim_Obj **exprResultPtrPtr)
6863 {
6864 ExprByteCode *expr;
6865 Jim_Obj **stack, *staticStack[JIM_EE_STATICSTACK_LEN];
6866 int stacklen = 0, i, error = 0, errRetCode = JIM_ERR;
6867
6868 Jim_IncrRefCount(exprObjPtr);
6869 expr = Jim_GetExpression(interp, exprObjPtr);
6870 if (!expr) {
6871 Jim_DecrRefCount(interp, exprObjPtr);
6872 return JIM_ERR; /* error in expression. */
6873 }
6874 /* In order to avoid that the internal repr gets freed due to
6875 * shimmering of the exprObjPtr's object, we make the internal rep
6876 * shared. */
6877 expr->inUse++;
6878
6879 /* The stack-based expr VM itself */
6880
6881 /* Stack allocation. Expr programs have the feature that
6882 * a program of length N can't require a stack longer than
6883 * N. */
6884 if (expr->len > JIM_EE_STATICSTACK_LEN)
6885 stack = Jim_Alloc(sizeof(Jim_Obj*)*expr->len);
6886 else
6887 stack = staticStack;
6888
6889 /* Execute every istruction */
6890 for (i = 0; i < expr->len; i++) {
6891 Jim_Obj *A, *B, *objPtr;
6892 jim_wide wA, wB, wC;
6893 double dA, dB, dC;
6894 const char *sA, *sB;
6895 int Alen, Blen, retcode;
6896 int opcode = expr->opcode[i];
6897
6898 if (opcode == JIM_EXPROP_NUMBER || opcode == JIM_EXPROP_STRING) {
6899 stack[stacklen++] = expr->obj[i];
6900 Jim_IncrRefCount(expr->obj[i]);
6901 } else if (opcode == JIM_EXPROP_VARIABLE) {
6902 objPtr = Jim_GetVariable(interp, expr->obj[i], JIM_ERRMSG);
6903 if (objPtr == NULL) {
6904 error = 1;
6905 goto err;
6906 }
6907 stack[stacklen++] = objPtr;
6908 Jim_IncrRefCount(objPtr);
6909 } else if (opcode == JIM_EXPROP_SUBST) {
6910 if ((retcode = Jim_SubstObj(interp, expr->obj[i],
6911 &objPtr, JIM_NONE)) != JIM_OK)
6912 {
6913 error = 1;
6914 errRetCode = retcode;
6915 goto err;
6916 }
6917 stack[stacklen++] = objPtr;
6918 Jim_IncrRefCount(objPtr);
6919 } else if (opcode == JIM_EXPROP_DICTSUGAR) {
6920 objPtr = Jim_ExpandDictSugar(interp, expr->obj[i]);
6921 if (objPtr == NULL) {
6922 error = 1;
6923 goto err;
6924 }
6925 stack[stacklen++] = objPtr;
6926 Jim_IncrRefCount(objPtr);
6927 } else if (opcode == JIM_EXPROP_COMMAND) {
6928 if ((retcode = Jim_EvalObj(interp, expr->obj[i])) != JIM_OK) {
6929 error = 1;
6930 errRetCode = retcode;
6931 goto err;
6932 }
6933 stack[stacklen++] = interp->result;
6934 Jim_IncrRefCount(interp->result);
6935 } else if (opcode >= JIM_EXPROP_BINARY_NUM_FIRST &&
6936 opcode <= JIM_EXPROP_BINARY_NUM_LAST)
6937 {
6938 /* Note that there isn't to increment the
6939 * refcount of objects. the references are moved
6940 * from stack to A and B. */
6941 B = stack[--stacklen];
6942 A = stack[--stacklen];
6943
6944 /* --- Integer --- */
6945 if ((A->typePtr == &doubleObjType && !A->bytes) ||
6946 (B->typePtr == &doubleObjType && !B->bytes) ||
6947 JimGetWideNoErr(interp, A, &wA) != JIM_OK ||
6948 JimGetWideNoErr(interp, B, &wB) != JIM_OK) {
6949 goto trydouble;
6950 }
6951 Jim_DecrRefCount(interp, A);
6952 Jim_DecrRefCount(interp, B);
6953 switch(expr->opcode[i]) {
6954 case JIM_EXPROP_ADD: wC = wA+wB; break;
6955 case JIM_EXPROP_SUB: wC = wA-wB; break;
6956 case JIM_EXPROP_MUL: wC = wA*wB; break;
6957 case JIM_EXPROP_LT: wC = wA<wB; break;
6958 case JIM_EXPROP_GT: wC = wA>wB; break;
6959 case JIM_EXPROP_LTE: wC = wA<=wB; break;
6960 case JIM_EXPROP_GTE: wC = wA>=wB; break;
6961 case JIM_EXPROP_LSHIFT: wC = wA<<wB; break;
6962 case JIM_EXPROP_RSHIFT: wC = wA>>wB; break;
6963 case JIM_EXPROP_NUMEQ: wC = wA==wB; break;
6964 case JIM_EXPROP_NUMNE: wC = wA!=wB; break;
6965 case JIM_EXPROP_BITAND: wC = wA&wB; break;
6966 case JIM_EXPROP_BITXOR: wC = wA^wB; break;
6967 case JIM_EXPROP_BITOR: wC = wA|wB; break;
6968 case JIM_EXPROP_POW: wC = JimPowWide(wA,wB); break;
6969 case JIM_EXPROP_LOGICAND_LEFT:
6970 if (wA == 0) {
6971 i += (int)wB;
6972 wC = 0;
6973 } else {
6974 continue;
6975 }
6976 break;
6977 case JIM_EXPROP_LOGICOR_LEFT:
6978 if (wA != 0) {
6979 i += (int)wB;
6980 wC = 1;
6981 } else {
6982 continue;
6983 }
6984 break;
6985 case JIM_EXPROP_DIV:
6986 if (wB == 0) goto divbyzero;
6987 wC = wA/wB;
6988 break;
6989 case JIM_EXPROP_MOD:
6990 if (wB == 0) goto divbyzero;
6991 wC = wA%wB;
6992 break;
6993 case JIM_EXPROP_ROTL: {
6994 /* uint32_t would be better. But not everyone has inttypes.h?*/
6995 unsigned long uA = (unsigned long)wA;
6996 #ifdef _MSC_VER
6997 wC = _rotl(uA,(unsigned long)wB);
6998 #else
6999 const unsigned int S = sizeof(unsigned long) * 8;
7000 wC = (unsigned long)((uA<<wB)|(uA>>(S-wB)));
7001 #endif
7002 break;
7003 }
7004 case JIM_EXPROP_ROTR: {
7005 unsigned long uA = (unsigned long)wA;
7006 #ifdef _MSC_VER
7007 wC = _rotr(uA,(unsigned long)wB);
7008 #else
7009 const unsigned int S = sizeof(unsigned long) * 8;
7010 wC = (unsigned long)((uA>>wB)|(uA<<(S-wB)));
7011 #endif
7012 break;
7013 }
7014
7015 default:
7016 wC = 0; /* avoid gcc warning */
7017 break;
7018 }
7019 stack[stacklen] = Jim_NewIntObj(interp, wC);
7020 Jim_IncrRefCount(stack[stacklen]);
7021 stacklen++;
7022 continue;
7023 trydouble:
7024 /* --- Double --- */
7025 if (Jim_GetDouble(interp, A, &dA) != JIM_OK ||
7026 Jim_GetDouble(interp, B, &dB) != JIM_OK) {
7027
7028 /* Hmmm! For compatibility, maybe convert != and == into ne and eq */
7029 if (expr->opcode[i] == JIM_EXPROP_NUMNE) {
7030 opcode = JIM_EXPROP_STRNE;
7031 goto retry_as_string;
7032 }
7033 else if (expr->opcode[i] == JIM_EXPROP_NUMEQ) {
7034 opcode = JIM_EXPROP_STREQ;
7035 goto retry_as_string;
7036 }
7037 Jim_DecrRefCount(interp, A);
7038 Jim_DecrRefCount(interp, B);
7039 error = 1;
7040 goto err;
7041 }
7042 Jim_DecrRefCount(interp, A);
7043 Jim_DecrRefCount(interp, B);
7044 switch(expr->opcode[i]) {
7045 case JIM_EXPROP_ROTL:
7046 case JIM_EXPROP_ROTR:
7047 case JIM_EXPROP_LSHIFT:
7048 case JIM_EXPROP_RSHIFT:
7049 case JIM_EXPROP_BITAND:
7050 case JIM_EXPROP_BITXOR:
7051 case JIM_EXPROP_BITOR:
7052 case JIM_EXPROP_MOD:
7053 case JIM_EXPROP_POW:
7054 Jim_SetResultString(interp,
7055 "Got floating-point value where integer was expected", -1);
7056 error = 1;
7057 goto err;
7058 break;
7059 case JIM_EXPROP_ADD: dC = dA+dB; break;
7060 case JIM_EXPROP_SUB: dC = dA-dB; break;
7061 case JIM_EXPROP_MUL: dC = dA*dB; break;
7062 case JIM_EXPROP_LT: dC = dA<dB; break;
7063 case JIM_EXPROP_GT: dC = dA>dB; break;
7064 case JIM_EXPROP_LTE: dC = dA<=dB; break;
7065 case JIM_EXPROP_GTE: dC = dA>=dB; break;
7066 case JIM_EXPROP_NUMEQ: dC = dA==dB; break;
7067 case JIM_EXPROP_NUMNE: dC = dA!=dB; break;
7068 case JIM_EXPROP_LOGICAND_LEFT:
7069 if (dA == 0) {
7070 i += (int)dB;
7071 dC = 0;
7072 } else {
7073 continue;
7074 }
7075 break;
7076 case JIM_EXPROP_LOGICOR_LEFT:
7077 if (dA != 0) {
7078 i += (int)dB;
7079 dC = 1;
7080 } else {
7081 continue;
7082 }
7083 break;
7084 case JIM_EXPROP_DIV:
7085 if (dB == 0) goto divbyzero;
7086 dC = dA/dB;
7087 break;
7088 default:
7089 dC = 0; /* avoid gcc warning */
7090 break;
7091 }
7092 stack[stacklen] = Jim_NewDoubleObj(interp, dC);
7093 Jim_IncrRefCount(stack[stacklen]);
7094 stacklen++;
7095 } else if (opcode == JIM_EXPROP_STREQ || opcode == JIM_EXPROP_STRNE) {
7096 B = stack[--stacklen];
7097 A = stack[--stacklen];
7098 retry_as_string:
7099 sA = Jim_GetString(A, &Alen);
7100 sB = Jim_GetString(B, &Blen);
7101 switch(opcode) {
7102 case JIM_EXPROP_STREQ:
7103 if (Alen == Blen && memcmp(sA, sB, Alen) ==0)
7104 wC = 1;
7105 else
7106 wC = 0;
7107 break;
7108 case JIM_EXPROP_STRNE:
7109 if (Alen != Blen || memcmp(sA, sB, Alen) != 0)
7110 wC = 1;
7111 else
7112 wC = 0;
7113 break;
7114 default:
7115 wC = 0; /* avoid gcc warning */
7116 break;
7117 }
7118 Jim_DecrRefCount(interp, A);
7119 Jim_DecrRefCount(interp, B);
7120 stack[stacklen] = Jim_NewIntObj(interp, wC);
7121 Jim_IncrRefCount(stack[stacklen]);
7122 stacklen++;
7123 } else if (opcode == JIM_EXPROP_NOT ||
7124 opcode == JIM_EXPROP_BITNOT ||
7125 opcode == JIM_EXPROP_LOGICAND_RIGHT ||
7126 opcode == JIM_EXPROP_LOGICOR_RIGHT) {
7127 /* Note that there isn't to increment the
7128 * refcount of objects. the references are moved
7129 * from stack to A and B. */
7130 A = stack[--stacklen];
7131
7132 /* --- Integer --- */
7133 if ((A->typePtr == &doubleObjType && !A->bytes) ||
7134 JimGetWideNoErr(interp, A, &wA) != JIM_OK) {
7135 goto trydouble_unary;
7136 }
7137 Jim_DecrRefCount(interp, A);
7138 switch(expr->opcode[i]) {
7139 case JIM_EXPROP_NOT: wC = !wA; break;
7140 case JIM_EXPROP_BITNOT: wC = ~wA; break;
7141 case JIM_EXPROP_LOGICAND_RIGHT:
7142 case JIM_EXPROP_LOGICOR_RIGHT: wC = (wA != 0); break;
7143 default:
7144 wC = 0; /* avoid gcc warning */
7145 break;
7146 }
7147 stack[stacklen] = Jim_NewIntObj(interp, wC);
7148 Jim_IncrRefCount(stack[stacklen]);
7149 stacklen++;
7150 continue;
7151 trydouble_unary:
7152 /* --- Double --- */
7153 if (Jim_GetDouble(interp, A, &dA) != JIM_OK) {
7154 Jim_DecrRefCount(interp, A);
7155 error = 1;
7156 goto err;
7157 }
7158 Jim_DecrRefCount(interp, A);
7159 switch(expr->opcode[i]) {
7160 case JIM_EXPROP_NOT: dC = !dA; break;
7161 case JIM_EXPROP_LOGICAND_RIGHT:
7162 case JIM_EXPROP_LOGICOR_RIGHT: dC = (dA != 0); break;
7163 case JIM_EXPROP_BITNOT:
7164 Jim_SetResultString(interp,
7165 "Got floating-point value where integer was expected", -1);
7166 error = 1;
7167 goto err;
7168 break;
7169 default:
7170 dC = 0; /* avoid gcc warning */
7171 break;
7172 }
7173 stack[stacklen] = Jim_NewDoubleObj(interp, dC);
7174 Jim_IncrRefCount(stack[stacklen]);
7175 stacklen++;
7176 } else {
7177 Jim_Panic(interp,"Unknown opcode in Jim_EvalExpression");
7178 }
7179 }
7180 err:
7181 /* There is no need to decerement the inUse field because
7182 * this reference is transfered back into the exprObjPtr. */
7183 Jim_FreeIntRep(interp, exprObjPtr);
7184 exprObjPtr->typePtr = &exprObjType;
7185 Jim_SetIntRepPtr(exprObjPtr, expr);
7186 Jim_DecrRefCount(interp, exprObjPtr);
7187 if (!error) {
7188 *exprResultPtrPtr = stack[0];
7189 Jim_IncrRefCount(stack[0]);
7190 errRetCode = JIM_OK;
7191 }
7192 for (i = 0; i < stacklen; i++) {
7193 Jim_DecrRefCount(interp, stack[i]);
7194 }
7195 if (stack != staticStack)
7196 Jim_Free(stack);
7197 return errRetCode;
7198 divbyzero:
7199 error = 1;
7200 Jim_SetResultString(interp, "Division by zero", -1);
7201 goto err;
7202 }
7203
7204 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
7205 {
7206 int retcode;
7207 jim_wide wideValue;
7208 double doubleValue;
7209 Jim_Obj *exprResultPtr;
7210
7211 retcode = Jim_EvalExpression(interp, exprObjPtr, &exprResultPtr);
7212 if (retcode != JIM_OK)
7213 return retcode;
7214 if (JimGetWideNoErr(interp, exprResultPtr, &wideValue) != JIM_OK) {
7215 if (Jim_GetDouble(interp, exprResultPtr, &doubleValue) != JIM_OK)
7216 {
7217 Jim_DecrRefCount(interp, exprResultPtr);
7218 return JIM_ERR;
7219 } else {
7220 Jim_DecrRefCount(interp, exprResultPtr);
7221 *boolPtr = doubleValue != 0;
7222 return JIM_OK;
7223 }
7224 }
7225 Jim_DecrRefCount(interp, exprResultPtr);
7226 *boolPtr = wideValue != 0;
7227 return JIM_OK;
7228 }
7229
7230 /* -----------------------------------------------------------------------------
7231 * ScanFormat String Object
7232 * ---------------------------------------------------------------------------*/
7233
7234 /* This Jim_Obj will held a parsed representation of a format string passed to
7235 * the Jim_ScanString command. For error diagnostics, the scanformat string has
7236 * to be parsed in its entirely first and then, if correct, can be used for
7237 * scanning. To avoid endless re-parsing, the parsed representation will be
7238 * stored in an internal representation and re-used for performance reason. */
7239
7240 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
7241 * scanformat string. This part will later be used to extract information
7242 * out from the string to be parsed by Jim_ScanString */
7243
7244 typedef struct ScanFmtPartDescr {
7245 char type; /* Type of conversion (e.g. c, d, f) */
7246 char modifier; /* Modify type (e.g. l - long, h - short */
7247 size_t width; /* Maximal width of input to be converted */
7248 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
7249 char *arg; /* Specification of a CHARSET conversion */
7250 char *prefix; /* Prefix to be scanned literally before conversion */
7251 } ScanFmtPartDescr;
7252
7253 /* The ScanFmtStringObj will held the internal representation of a scanformat
7254 * string parsed and separated in part descriptions. Furthermore it contains
7255 * the original string representation of the scanformat string to allow for
7256 * fast update of the Jim_Obj's string representation part.
7257 *
7258 * As add-on the internal object representation add some scratch pad area
7259 * for usage by Jim_ScanString to avoid endless allocating and freeing of
7260 * memory for purpose of string scanning.
7261 *
7262 * The error member points to a static allocated string in case of a mal-
7263 * formed scanformat string or it contains '0' (NULL) in case of a valid
7264 * parse representation.
7265 *
7266 * The whole memory of the internal representation is allocated as a single
7267 * area of memory that will be internally separated. So freeing and duplicating
7268 * of such an object is cheap */
7269
7270 typedef struct ScanFmtStringObj {
7271 jim_wide size; /* Size of internal repr in bytes */
7272 char *stringRep; /* Original string representation */
7273 size_t count; /* Number of ScanFmtPartDescr contained */
7274 size_t convCount; /* Number of conversions that will assign */
7275 size_t maxPos; /* Max position index if XPG3 is used */
7276 const char *error; /* Ptr to error text (NULL if no error */
7277 char *scratch; /* Some scratch pad used by Jim_ScanString */
7278 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
7279 } ScanFmtStringObj;
7280
7281
7282 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
7283 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
7284 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
7285
7286 static Jim_ObjType scanFmtStringObjType = {
7287 "scanformatstring",
7288 FreeScanFmtInternalRep,
7289 DupScanFmtInternalRep,
7290 UpdateStringOfScanFmt,
7291 JIM_TYPE_NONE,
7292 };
7293
7294 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
7295 {
7296 JIM_NOTUSED(interp);
7297 Jim_Free((char*)objPtr->internalRep.ptr);
7298 objPtr->internalRep.ptr = 0;
7299 }
7300
7301 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
7302 {
7303 size_t size = (size_t)((ScanFmtStringObj*)srcPtr->internalRep.ptr)->size;
7304 ScanFmtStringObj *newVec = (ScanFmtStringObj*)Jim_Alloc(size);
7305
7306 JIM_NOTUSED(interp);
7307 memcpy(newVec, srcPtr->internalRep.ptr, size);
7308 dupPtr->internalRep.ptr = newVec;
7309 dupPtr->typePtr = &scanFmtStringObjType;
7310 }
7311
7312 void UpdateStringOfScanFmt(Jim_Obj *objPtr)
7313 {
7314 char *bytes = ((ScanFmtStringObj*)objPtr->internalRep.ptr)->stringRep;
7315
7316 objPtr->bytes = Jim_StrDup(bytes);
7317 objPtr->length = strlen(bytes);
7318 }
7319
7320 /* SetScanFmtFromAny will parse a given string and create the internal
7321 * representation of the format specification. In case of an error
7322 * the error data member of the internal representation will be set
7323 * to an descriptive error text and the function will be left with
7324 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
7325 * specification */
7326
7327 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7328 {
7329 ScanFmtStringObj *fmtObj;
7330 char *buffer;
7331 int maxCount, i, approxSize, lastPos = -1;
7332 const char *fmt = objPtr->bytes;
7333 int maxFmtLen = objPtr->length;
7334 const char *fmtEnd = fmt + maxFmtLen;
7335 int curr;
7336
7337 Jim_FreeIntRep(interp, objPtr);
7338 /* Count how many conversions could take place maximally */
7339 for (i=0, maxCount=0; i < maxFmtLen; ++i)
7340 if (fmt[i] == '%')
7341 ++maxCount;
7342 /* Calculate an approximation of the memory necessary */
7343 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
7344 + (maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
7345 + maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
7346 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
7347 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
7348 + (maxCount +1) * sizeof(char) /* '\0' for every partial */
7349 + 1; /* safety byte */
7350 fmtObj = (ScanFmtStringObj*)Jim_Alloc(approxSize);
7351 memset(fmtObj, 0, approxSize);
7352 fmtObj->size = approxSize;
7353 fmtObj->maxPos = 0;
7354 fmtObj->scratch = (char*)&fmtObj->descr[maxCount+1];
7355 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
7356 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
7357 buffer = fmtObj->stringRep + maxFmtLen + 1;
7358 objPtr->internalRep.ptr = fmtObj;
7359 objPtr->typePtr = &scanFmtStringObjType;
7360 for (i=0, curr=0; fmt < fmtEnd; ++fmt) {
7361 int width=0, skip;
7362 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
7363 fmtObj->count++;
7364 descr->width = 0; /* Assume width unspecified */
7365 /* Overread and store any "literal" prefix */
7366 if (*fmt != '%' || fmt[1] == '%') {
7367 descr->type = 0;
7368 descr->prefix = &buffer[i];
7369 for (; fmt < fmtEnd; ++fmt) {
7370 if (*fmt == '%') {
7371 if (fmt[1] != '%') break;
7372 ++fmt;
7373 }
7374 buffer[i++] = *fmt;
7375 }
7376 buffer[i++] = 0;
7377 }
7378 /* Skip the conversion introducing '%' sign */
7379 ++fmt;
7380 /* End reached due to non-conversion literal only? */
7381 if (fmt >= fmtEnd)
7382 goto done;
7383 descr->pos = 0; /* Assume "natural" positioning */
7384 if (*fmt == '*') {
7385 descr->pos = -1; /* Okay, conversion will not be assigned */
7386 ++fmt;
7387 } else
7388 fmtObj->convCount++; /* Otherwise count as assign-conversion */
7389 /* Check if next token is a number (could be width or pos */
7390 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
7391 fmt += skip;
7392 /* Was the number a XPG3 position specifier? */
7393 if (descr->pos != -1 && *fmt == '$') {
7394 int prev;
7395 ++fmt;
7396 descr->pos = width;
7397 width = 0;
7398 /* Look if "natural" postioning and XPG3 one was mixed */
7399 if ((lastPos == 0 && descr->pos > 0)
7400 || (lastPos > 0 && descr->pos == 0)) {
7401 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
7402 return JIM_ERR;
7403 }
7404 /* Look if this position was already used */
7405 for (prev=0; prev < curr; ++prev) {
7406 if (fmtObj->descr[prev].pos == -1) continue;
7407 if (fmtObj->descr[prev].pos == descr->pos) {
7408 fmtObj->error = "same \"%n$\" conversion specifier "
7409 "used more than once";
7410 return JIM_ERR;
7411 }
7412 }
7413 /* Try to find a width after the XPG3 specifier */
7414 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
7415 descr->width = width;
7416 fmt += skip;
7417 }
7418 if (descr->pos > 0 && (size_t)descr->pos > fmtObj->maxPos)
7419 fmtObj->maxPos = descr->pos;
7420 } else {
7421 /* Number was not a XPG3, so it has to be a width */
7422 descr->width = width;
7423 }
7424 }
7425 /* If positioning mode was undetermined yet, fix this */
7426 if (lastPos == -1)
7427 lastPos = descr->pos;
7428 /* Handle CHARSET conversion type ... */
7429 if (*fmt == '[') {
7430 int swapped = 1, beg = i, end, j;
7431 descr->type = '[';
7432 descr->arg = &buffer[i];
7433 ++fmt;
7434 if (*fmt == '^') buffer[i++] = *fmt++;
7435 if (*fmt == ']') buffer[i++] = *fmt++;
7436 while (*fmt && *fmt != ']') buffer[i++] = *fmt++;
7437 if (*fmt != ']') {
7438 fmtObj->error = "unmatched [ in format string";
7439 return JIM_ERR;
7440 }
7441 end = i;
7442 buffer[i++] = 0;
7443 /* In case a range fence was given "backwards", swap it */
7444 while (swapped) {
7445 swapped = 0;
7446 for (j=beg+1; j < end-1; ++j) {
7447 if (buffer[j] == '-' && buffer[j-1] > buffer[j+1]) {
7448 char tmp = buffer[j-1];
7449 buffer[j-1] = buffer[j+1];
7450 buffer[j+1] = tmp;
7451 swapped = 1;
7452 }
7453 }
7454 }
7455 } else {
7456 /* Remember any valid modifier if given */
7457 if (strchr("hlL", *fmt) != 0)
7458 descr->modifier = tolower((int)*fmt++);
7459
7460 descr->type = *fmt;
7461 if (strchr("efgcsndoxui", *fmt) == 0) {
7462 fmtObj->error = "bad scan conversion character";
7463 return JIM_ERR;
7464 } else if (*fmt == 'c' && descr->width != 0) {
7465 fmtObj->error = "field width may not be specified in %c "
7466 "conversion";
7467 return JIM_ERR;
7468 } else if (*fmt == 'u' && descr->modifier == 'l') {
7469 fmtObj->error = "unsigned wide not supported";
7470 return JIM_ERR;
7471 }
7472 }
7473 curr++;
7474 }
7475 done:
7476 if (fmtObj->convCount == 0) {
7477 fmtObj->error = "no any conversion specifier given";
7478 return JIM_ERR;
7479 }
7480 return JIM_OK;
7481 }
7482
7483 /* Some accessor macros to allow lowlevel access to fields of internal repr */
7484
7485 #define FormatGetCnvCount(_fo_) \
7486 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
7487 #define FormatGetMaxPos(_fo_) \
7488 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
7489 #define FormatGetError(_fo_) \
7490 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
7491
7492 /* Some Bit testing/setting/cleaning routines. For now only used in handling
7493 * charsets ([a-z123]) within scanning. Later on perhaps a base for a
7494 * bitvector implementation in Jim? */
7495
7496 static int JimTestBit(const char *bitvec, char ch)
7497 {
7498 div_t pos = div(ch-1, 8);
7499 return bitvec[pos.quot] & (1 << pos.rem);
7500 }
7501
7502 static void JimSetBit(char *bitvec, char ch)
7503 {
7504 div_t pos = div(ch-1, 8);
7505 bitvec[pos.quot] |= (1 << pos.rem);
7506 }
7507
7508 #if 0 /* currently not used */
7509 static void JimClearBit(char *bitvec, char ch)
7510 {
7511 div_t pos = div(ch-1, 8);
7512 bitvec[pos.quot] &= ~(1 << pos.rem);
7513 }
7514 #endif
7515
7516 /* JimScanAString is used to scan an unspecified string that ends with
7517 * next WS, or a string that is specified via a charset. The charset
7518 * is currently implemented in a way to only allow for usage with
7519 * ASCII. Whenever we will switch to UNICODE, another idea has to
7520 * be born :-/
7521 *
7522 * FIXME: Works only with ASCII */
7523
7524 static Jim_Obj *
7525 JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
7526 {
7527 size_t i;
7528 Jim_Obj *result;
7529 char charset[256/8+1]; /* A Charset may contain max 256 chars */
7530 char *buffer = Jim_Alloc(strlen(str)+1), *anchor = buffer;
7531
7532 /* First init charset to nothing or all, depending if a specified
7533 * or an unspecified string has to be parsed */
7534 memset(charset, (sdescr ? 0 : 255), sizeof(charset));
7535 if (sdescr) {
7536 /* There was a set description given, that means we are parsing
7537 * a specified string. So we have to build a corresponding
7538 * charset reflecting the description */
7539 int notFlag = 0;
7540 /* Should the set be negated at the end? */
7541 if (*sdescr == '^') {
7542 notFlag = 1;
7543 ++sdescr;
7544 }
7545 /* Here '-' is meant literally and not to define a range */
7546 if (*sdescr == '-') {
7547 JimSetBit(charset, '-');
7548 ++sdescr;
7549 }
7550 while (*sdescr) {
7551 if (sdescr[1] == '-' && sdescr[2] != 0) {
7552 /* Handle range definitions */
7553 int i;
7554 for (i=sdescr[0]; i <= sdescr[2]; ++i)
7555 JimSetBit(charset, (char)i);
7556 sdescr += 3;
7557 } else {
7558 /* Handle verbatim character definitions */
7559 JimSetBit(charset, *sdescr++);
7560 }
7561 }
7562 /* Negate the charset if there was a NOT given */
7563 for (i=0; notFlag && i < sizeof(charset); ++i)
7564 charset[i] = ~charset[i];
7565 }
7566 /* And after all the mess above, the real work begin ... */
7567 while (str && *str) {
7568 if (!sdescr && isspace((int)*str))
7569 break; /* EOS via WS if unspecified */
7570 if (JimTestBit(charset, *str)) *buffer++ = *str++;
7571 else break; /* EOS via mismatch if specified scanning */
7572 }
7573 *buffer = 0; /* Close the string properly ... */
7574 result = Jim_NewStringObj(interp, anchor, -1);
7575 Jim_Free(anchor); /* ... and free it afer usage */
7576 return result;
7577 }
7578
7579 /* ScanOneEntry will scan one entry out of the string passed as argument.
7580 * It use the sscanf() function for this task. After extracting and
7581 * converting of the value, the count of scanned characters will be
7582 * returned of -1 in case of no conversion tool place and string was
7583 * already scanned thru */
7584
7585 static int ScanOneEntry(Jim_Interp *interp, const char *str, long pos,
7586 ScanFmtStringObj *fmtObj, long index, Jim_Obj **valObjPtr)
7587 {
7588 # define MAX_SIZE (sizeof(jim_wide) > sizeof(double) \
7589 ? sizeof(jim_wide) \
7590 : sizeof(double))
7591 char buffer[MAX_SIZE];
7592 char *value = buffer;
7593 const char *tok;
7594 const ScanFmtPartDescr *descr = &fmtObj->descr[index];
7595 size_t sLen = strlen(&str[pos]), scanned = 0;
7596 size_t anchor = pos;
7597 int i;
7598
7599 /* First pessimiticly assume, we will not scan anything :-) */
7600 *valObjPtr = 0;
7601 if (descr->prefix) {
7602 /* There was a prefix given before the conversion, skip it and adjust
7603 * the string-to-be-parsed accordingly */
7604 for (i=0; str[pos] && descr->prefix[i]; ++i) {
7605 /* If prefix require, skip WS */
7606 if (isspace((int)descr->prefix[i]))
7607 while (str[pos] && isspace((int)str[pos])) ++pos;
7608 else if (descr->prefix[i] != str[pos])
7609 break; /* Prefix do not match here, leave the loop */
7610 else
7611 ++pos; /* Prefix matched so far, next round */
7612 }
7613 if (str[pos] == 0)
7614 return -1; /* All of str consumed: EOF condition */
7615 else if (descr->prefix[i] != 0)
7616 return 0; /* Not whole prefix consumed, no conversion possible */
7617 }
7618 /* For all but following conversion, skip leading WS */
7619 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
7620 while (isspace((int)str[pos])) ++pos;
7621 /* Determine how much skipped/scanned so far */
7622 scanned = pos - anchor;
7623 if (descr->type == 'n') {
7624 /* Return pseudo conversion means: how much scanned so far? */
7625 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
7626 } else if (str[pos] == 0) {
7627 /* Cannot scan anything, as str is totally consumed */
7628 return -1;
7629 } else {
7630 /* Processing of conversions follows ... */
7631 if (descr->width > 0) {
7632 /* Do not try to scan as fas as possible but only the given width.
7633 * To ensure this, we copy the part that should be scanned. */
7634 size_t tLen = descr->width > sLen ? sLen : descr->width;
7635 tok = Jim_StrDupLen(&str[pos], tLen);
7636 } else {
7637 /* As no width was given, simply refer to the original string */
7638 tok = &str[pos];
7639 }
7640 switch (descr->type) {
7641 case 'c':
7642 *valObjPtr = Jim_NewIntObj(interp, *tok);
7643 scanned += 1;
7644 break;
7645 case 'd': case 'o': case 'x': case 'u': case 'i': {
7646 char *endp; /* Position where the number finished */
7647 int base = descr->type == 'o' ? 8
7648 : descr->type == 'x' ? 16
7649 : descr->type == 'i' ? 0
7650 : 10;
7651
7652 do {
7653 /* Try to scan a number with the given base */
7654 if (descr->modifier == 'l')
7655 #ifdef HAVE_LONG_LONG
7656 *(jim_wide*)value = JimStrtoll(tok, &endp, base);
7657 #else
7658 *(jim_wide*)value = strtol(tok, &endp, base);
7659 #endif
7660 else
7661 if (descr->type == 'u')
7662 *(long*)value = strtoul(tok, &endp, base);
7663 else
7664 *(long*)value = strtol(tok, &endp, base);
7665 /* If scanning failed, and base was undetermined, simply
7666 * put it to 10 and try once more. This should catch the
7667 * case where %i begin to parse a number prefix (e.g.
7668 * '0x' but no further digits follows. This will be
7669 * handled as a ZERO followed by a char 'x' by Tcl */
7670 if (endp == tok && base == 0) base = 10;
7671 else break;
7672 } while (1);
7673 if (endp != tok) {
7674 /* There was some number sucessfully scanned! */
7675 if (descr->modifier == 'l')
7676 *valObjPtr = Jim_NewIntObj(interp, *(jim_wide*)value);
7677 else
7678 *valObjPtr = Jim_NewIntObj(interp, *(long*)value);
7679 /* Adjust the number-of-chars scanned so far */
7680 scanned += endp - tok;
7681 } else {
7682 /* Nothing was scanned. We have to determine if this
7683 * happened due to e.g. prefix mismatch or input str
7684 * exhausted */
7685 scanned = *tok ? 0 : -1;
7686 }
7687 break;
7688 }
7689 case 's': case '[': {
7690 *valObjPtr = JimScanAString(interp, descr->arg, tok);
7691 scanned += Jim_Length(*valObjPtr);
7692 break;
7693 }
7694 case 'e': case 'f': case 'g': {
7695 char *endp;
7696
7697 *(double*)value = strtod(tok, &endp);
7698 if (endp != tok) {
7699 /* There was some number sucessfully scanned! */
7700 *valObjPtr = Jim_NewDoubleObj(interp, *(double*)value);
7701 /* Adjust the number-of-chars scanned so far */
7702 scanned += endp - tok;
7703 } else {
7704 /* Nothing was scanned. We have to determine if this
7705 * happened due to e.g. prefix mismatch or input str
7706 * exhausted */
7707 scanned = *tok ? 0 : -1;
7708 }
7709 break;
7710 }
7711 }
7712 /* If a substring was allocated (due to pre-defined width) do not
7713 * forget to free it */
7714 if (tok != &str[pos])
7715 Jim_Free((char*)tok);
7716 }
7717 return scanned;
7718 }
7719
7720 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
7721 * string and returns all converted (and not ignored) values in a list back
7722 * to the caller. If an error occured, a NULL pointer will be returned */
7723
7724 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr,
7725 Jim_Obj *fmtObjPtr, int flags)
7726 {
7727 size_t i, pos;
7728 int scanned = 1;
7729 const char *str = Jim_GetString(strObjPtr, 0);
7730 Jim_Obj *resultList = 0;
7731 Jim_Obj **resultVec;
7732 int resultc;
7733 Jim_Obj *emptyStr = 0;
7734 ScanFmtStringObj *fmtObj;
7735
7736 /* If format specification is not an object, convert it! */
7737 if (fmtObjPtr->typePtr != &scanFmtStringObjType)
7738 SetScanFmtFromAny(interp, fmtObjPtr);
7739 fmtObj = (ScanFmtStringObj*)fmtObjPtr->internalRep.ptr;
7740 /* Check if format specification was valid */
7741 if (fmtObj->error != 0) {
7742 if (flags & JIM_ERRMSG)
7743 Jim_SetResultString(interp, fmtObj->error, -1);
7744 return 0;
7745 }
7746 /* Allocate a new "shared" empty string for all unassigned conversions */
7747 emptyStr = Jim_NewEmptyStringObj(interp);
7748 Jim_IncrRefCount(emptyStr);
7749 /* Create a list and fill it with empty strings up to max specified XPG3 */
7750 resultList = Jim_NewListObj(interp, 0, 0);
7751 if (fmtObj->maxPos > 0) {
7752 for (i=0; i < fmtObj->maxPos; ++i)
7753 Jim_ListAppendElement(interp, resultList, emptyStr);
7754 JimListGetElements(interp, resultList, &resultc, &resultVec);
7755 }
7756 /* Now handle every partial format description */
7757 for (i=0, pos=0; i < fmtObj->count; ++i) {
7758 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
7759 Jim_Obj *value = 0;
7760 /* Only last type may be "literal" w/o conversion - skip it! */
7761 if (descr->type == 0) continue;
7762 /* As long as any conversion could be done, we will proceed */
7763 if (scanned > 0)
7764 scanned = ScanOneEntry(interp, str, pos, fmtObj, i, &value);
7765 /* In case our first try results in EOF, we will leave */
7766 if (scanned == -1 && i == 0)
7767 goto eof;
7768 /* Advance next pos-to-be-scanned for the amount scanned already */
7769 pos += scanned;
7770 /* value == 0 means no conversion took place so take empty string */
7771 if (value == 0)
7772 value = Jim_NewEmptyStringObj(interp);
7773 /* If value is a non-assignable one, skip it */
7774 if (descr->pos == -1) {
7775 Jim_FreeNewObj(interp, value);
7776 } else if (descr->pos == 0)
7777 /* Otherwise append it to the result list if no XPG3 was given */
7778 Jim_ListAppendElement(interp, resultList, value);
7779 else if (resultVec[descr->pos-1] == emptyStr) {
7780 /* But due to given XPG3, put the value into the corr. slot */
7781 Jim_DecrRefCount(interp, resultVec[descr->pos-1]);
7782 Jim_IncrRefCount(value);
7783 resultVec[descr->pos-1] = value;
7784 } else {
7785 /* Otherwise, the slot was already used - free obj and ERROR */
7786 Jim_FreeNewObj(interp, value);
7787 goto err;
7788 }
7789 }
7790 Jim_DecrRefCount(interp, emptyStr);
7791 return resultList;
7792 eof:
7793 Jim_DecrRefCount(interp, emptyStr);
7794 Jim_FreeNewObj(interp, resultList);
7795 return (Jim_Obj*)EOF;
7796 err:
7797 Jim_DecrRefCount(interp, emptyStr);
7798 Jim_FreeNewObj(interp, resultList);
7799 return 0;
7800 }
7801
7802 /* -----------------------------------------------------------------------------
7803 * Pseudo Random Number Generation
7804 * ---------------------------------------------------------------------------*/
7805 static void JimPrngSeed(Jim_Interp *interp, const unsigned char *seed,
7806 int seedLen);
7807
7808 /* Initialize the sbox with the numbers from 0 to 255 */
7809 static void JimPrngInit(Jim_Interp *interp)
7810 {
7811 int i;
7812 unsigned int seed[256];
7813
7814 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
7815 for (i = 0; i < 256; i++)
7816 seed[i] = (rand() ^ time(NULL) ^ clock());
7817 JimPrngSeed(interp, (unsigned char*) seed, sizeof(int)*256);
7818 }
7819
7820 /* Generates N bytes of random data */
7821 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
7822 {
7823 Jim_PrngState *prng;
7824 unsigned char *destByte = (unsigned char*) dest;
7825 unsigned int si, sj, x;
7826
7827 /* initialization, only needed the first time */
7828 if (interp->prngState == NULL)
7829 JimPrngInit(interp);
7830 prng = interp->prngState;
7831 /* generates 'len' bytes of pseudo-random numbers */
7832 for (x = 0; x < len; x++) {
7833 prng->i = (prng->i+1) & 0xff;
7834 si = prng->sbox[prng->i];
7835 prng->j = (prng->j + si) & 0xff;
7836 sj = prng->sbox[prng->j];
7837 prng->sbox[prng->i] = sj;
7838 prng->sbox[prng->j] = si;
7839 *destByte++ = prng->sbox[(si+sj)&0xff];
7840 }
7841 }
7842
7843 /* Re-seed the generator with user-provided bytes */
7844 static void JimPrngSeed(Jim_Interp *interp, const unsigned char *seed,
7845 int seedLen)
7846 {
7847 int i;
7848 unsigned char buf[256];
7849 Jim_PrngState *prng;
7850
7851 /* initialization, only needed the first time */
7852 if (interp->prngState == NULL)
7853 JimPrngInit(interp);
7854 prng = interp->prngState;
7855
7856 /* Set the sbox[i] with i */
7857 for (i = 0; i < 256; i++)
7858 prng->sbox[i] = i;
7859 /* Now use the seed to perform a random permutation of the sbox */
7860 for (i = 0; i < seedLen; i++) {
7861 unsigned char t;
7862
7863 t = prng->sbox[i&0xFF];
7864 prng->sbox[i&0xFF] = prng->sbox[seed[i]];
7865 prng->sbox[seed[i]] = t;
7866 }
7867 prng->i = prng->j = 0;
7868 /* discard the first 256 bytes of stream. */
7869 JimRandomBytes(interp, buf, 256);
7870 }
7871
7872 /* -----------------------------------------------------------------------------
7873 * Dynamic libraries support (WIN32 not supported)
7874 * ---------------------------------------------------------------------------*/
7875
7876 #ifdef JIM_DYNLIB
7877 #ifdef WIN32
7878 #define RTLD_LAZY 0
7879 void * dlopen(const char *path, int mode)
7880 {
7881 JIM_NOTUSED(mode);
7882
7883 return (void *)LoadLibraryA(path);
7884 }
7885 int dlclose(void *handle)
7886 {
7887 FreeLibrary((HANDLE)handle);
7888 return 0;
7889 }
7890 void *dlsym(void *handle, const char *symbol)
7891 {
7892 return GetProcAddress((HMODULE)handle, symbol);
7893 }
7894 static char win32_dlerror_string[121];
7895 const char *dlerror(void)
7896 {
7897 FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM, NULL, GetLastError(),
7898 LANG_NEUTRAL, win32_dlerror_string, 120, NULL);
7899 return win32_dlerror_string;
7900 }
7901 #endif /* WIN32 */
7902
7903 int Jim_LoadLibrary(Jim_Interp *interp, const char *pathName)
7904 {
7905 Jim_Obj *libPathObjPtr;
7906 int prefixc, i;
7907 void *handle;
7908 int (*onload)(Jim_Interp *interp);
7909
7910 libPathObjPtr = Jim_GetGlobalVariableStr(interp, "jim_libpath", JIM_NONE);
7911 if (libPathObjPtr == NULL) {
7912 prefixc = 0;
7913 libPathObjPtr = NULL;
7914 } else {
7915 Jim_IncrRefCount(libPathObjPtr);
7916 Jim_ListLength(interp, libPathObjPtr, &prefixc);
7917 }
7918
7919 for (i = -1; i < prefixc; i++) {
7920 if (i < 0) {
7921 handle = dlopen(pathName, RTLD_LAZY);
7922 } else {
7923 FILE *fp;
7924 char buf[JIM_PATH_LEN];
7925 const char *prefix;
7926 int prefixlen;
7927 Jim_Obj *prefixObjPtr;
7928
7929 buf[0] = '\0';
7930 if (Jim_ListIndex(interp, libPathObjPtr, i,
7931 &prefixObjPtr, JIM_NONE) != JIM_OK)
7932 continue;
7933 prefix = Jim_GetString(prefixObjPtr, &prefixlen);
7934 if (prefixlen+strlen(pathName)+1 >= JIM_PATH_LEN)
7935 continue;
7936 if (*pathName == '/') {
7937 strcpy(buf, pathName);
7938 }
7939 else if (prefixlen && prefix[prefixlen-1] == '/')
7940 sprintf(buf, "%s%s", prefix, pathName);
7941 else
7942 sprintf(buf, "%s/%s", prefix, pathName);
7943 fp = fopen(buf, "r");
7944 if (fp == NULL)
7945 continue;
7946 fclose(fp);
7947 handle = dlopen(buf, RTLD_LAZY);
7948 }
7949 if (handle == NULL) {
7950 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
7951 Jim_AppendStrings(interp, Jim_GetResult(interp),
7952 "error loading extension \"", pathName,
7953 "\": ", dlerror(), NULL);
7954 if (i < 0)
7955 continue;
7956 goto err;
7957 }
7958 if ((onload = dlsym(handle, "Jim_OnLoad")) == NULL) {
7959 Jim_SetResultString(interp,
7960 "No Jim_OnLoad symbol found on extension", -1);
7961 goto err;
7962 }
7963 if (onload(interp) == JIM_ERR) {
7964 dlclose(handle);
7965 goto err;
7966 }
7967 Jim_SetEmptyResult(interp);
7968 if (libPathObjPtr != NULL)
7969 Jim_DecrRefCount(interp, libPathObjPtr);
7970 return JIM_OK;
7971 }
7972 err:
7973 if (libPathObjPtr != NULL)
7974 Jim_DecrRefCount(interp, libPathObjPtr);
7975 return JIM_ERR;
7976 }
7977 #else /* JIM_DYNLIB */
7978 int Jim_LoadLibrary(Jim_Interp *interp, const char *pathName)
7979 {
7980 JIM_NOTUSED(interp);
7981 JIM_NOTUSED(pathName);
7982
7983 Jim_SetResultString(interp, "the Jim binary has no support for [load]", -1);
7984 return JIM_ERR;
7985 }
7986 #endif/* JIM_DYNLIB */
7987
7988 /* -----------------------------------------------------------------------------
7989 * Packages handling
7990 * ---------------------------------------------------------------------------*/
7991
7992 #define JIM_PKG_ANY_VERSION -1
7993
7994 /* Convert a string of the type "1.2" into an integer.
7995 * MAJOR.MINOR is converted as MAJOR*100+MINOR, so "1.2" is converted
7996 * to the integer with value 102 */
7997 static int JimPackageVersionToInt(Jim_Interp *interp, const char *v,
7998 int *intPtr, int flags)
7999 {
8000 char *copy;
8001 jim_wide major, minor;
8002 char *majorStr, *minorStr, *p;
8003
8004 if (v[0] == '\0') {
8005 *intPtr = JIM_PKG_ANY_VERSION;
8006 return JIM_OK;
8007 }
8008
8009 copy = Jim_StrDup(v);
8010 p = strchr(copy, '.');
8011 if (p == NULL) goto badfmt;
8012 *p = '\0';
8013 majorStr = copy;
8014 minorStr = p+1;
8015
8016 if (Jim_StringToWide(majorStr, &major, 10) != JIM_OK ||
8017 Jim_StringToWide(minorStr, &minor, 10) != JIM_OK)
8018 goto badfmt;
8019 *intPtr = (int)(major*100+minor);
8020 Jim_Free(copy);
8021 return JIM_OK;
8022
8023 badfmt:
8024 Jim_Free(copy);
8025 if (flags & JIM_ERRMSG) {
8026 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8027 Jim_AppendStrings(interp, Jim_GetResult(interp),
8028 "invalid package version '", v, "'", NULL);
8029 }
8030 return JIM_ERR;
8031 }
8032
8033 #define JIM_MATCHVER_EXACT (1<<JIM_PRIV_FLAG_SHIFT)
8034 static int JimPackageMatchVersion(int needed, int actual, int flags)
8035 {
8036 if (needed == JIM_PKG_ANY_VERSION) return 1;
8037 if (flags & JIM_MATCHVER_EXACT) {
8038 return needed == actual;
8039 } else {
8040 return needed/100 == actual/100 && (needed <= actual);
8041 }
8042 }
8043
8044 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver,
8045 int flags)
8046 {
8047 int intVersion;
8048 /* Check if the version format is ok */
8049 if (JimPackageVersionToInt(interp, ver, &intVersion, JIM_ERRMSG) != JIM_OK)
8050 return JIM_ERR;
8051 /* If the package was already provided returns an error. */
8052 if (Jim_FindHashEntry(&interp->packages, name) != NULL) {
8053 if (flags & JIM_ERRMSG) {
8054 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8055 Jim_AppendStrings(interp, Jim_GetResult(interp),
8056 "package '", name, "' was already provided", NULL);
8057 }
8058 return JIM_ERR;
8059 }
8060 Jim_AddHashEntry(&interp->packages, name, (char*) ver);
8061 return JIM_OK;
8062 }
8063
8064 #ifndef JIM_ANSIC
8065
8066 #ifndef WIN32
8067 # include <sys/types.h>
8068 # include <dirent.h>
8069 #else
8070 # include <io.h>
8071 /* Posix dirent.h compatiblity layer for WIN32.
8072 * Copyright Kevlin Henney, 1997, 2003. All rights reserved.
8073 * Copyright Salvatore Sanfilippo ,2005.
8074 *
8075 * Permission to use, copy, modify, and distribute this software and its
8076 * documentation for any purpose is hereby granted without fee, provided
8077 * that this copyright and permissions notice appear in all copies and
8078 * derivatives.
8079 *
8080 * This software is supplied "as is" without express or implied warranty.
8081 * This software was modified by Salvatore Sanfilippo for the Jim Interpreter.
8082 */
8083
8084 struct dirent {
8085 char *d_name;
8086 };
8087
8088 typedef struct DIR {
8089 long handle; /* -1 for failed rewind */
8090 struct _finddata_t info;
8091 struct dirent result; /* d_name null iff first time */
8092 char *name; /* null-terminated char string */
8093 } DIR;
8094
8095 DIR *opendir(const char *name)
8096 {
8097 DIR *dir = 0;
8098
8099 if(name && name[0]) {
8100 size_t base_length = strlen(name);
8101 const char *all = /* search pattern must end with suitable wildcard */
8102 strchr("/\\", name[base_length - 1]) ? "*" : "/*";
8103
8104 if((dir = (DIR *) Jim_Alloc(sizeof *dir)) != 0 &&
8105 (dir->name = (char *) Jim_Alloc(base_length + strlen(all) + 1)) != 0)
8106 {
8107 strcat(strcpy(dir->name, name), all);
8108
8109 if((dir->handle = (long) _findfirst(dir->name, &dir->info)) != -1)
8110 dir->result.d_name = 0;
8111 else { /* rollback */
8112 Jim_Free(dir->name);
8113 Jim_Free(dir);
8114 dir = 0;
8115 }
8116 } else { /* rollback */
8117 Jim_Free(dir);
8118 dir = 0;
8119 errno = ENOMEM;
8120 }
8121 } else {
8122 errno = EINVAL;
8123 }
8124 return dir;
8125 }
8126
8127 int closedir(DIR *dir)
8128 {
8129 int result = -1;
8130
8131 if(dir) {
8132 if(dir->handle != -1)
8133 result = _findclose(dir->handle);
8134 Jim_Free(dir->name);
8135 Jim_Free(dir);
8136 }
8137 if(result == -1) /* map all errors to EBADF */
8138 errno = EBADF;
8139 return result;
8140 }
8141
8142 struct dirent *readdir(DIR *dir)
8143 {
8144 struct dirent *result = 0;
8145
8146 if(dir && dir->handle != -1) {
8147 if(!dir->result.d_name || _findnext(dir->handle, &dir->info) != -1) {
8148 result = &dir->result;
8149 result->d_name = dir->info.name;
8150 }
8151 } else {
8152 errno = EBADF;
8153 }
8154 return result;
8155 }
8156
8157 #endif /* WIN32 */
8158
8159 static char *JimFindBestPackage(Jim_Interp *interp, char **prefixes,
8160 int prefixc, const char *pkgName, int pkgVer, int flags)
8161 {
8162 int bestVer = -1, i;
8163 int pkgNameLen = strlen(pkgName);
8164 char *bestPackage = NULL;
8165 struct dirent *de;
8166
8167 for (i = 0; i < prefixc; i++) {
8168 DIR *dir;
8169 char buf[JIM_PATH_LEN];
8170 int prefixLen;
8171
8172 if (prefixes[i] == NULL) continue;
8173 strncpy(buf, prefixes[i], JIM_PATH_LEN);
8174 buf[JIM_PATH_LEN-1] = '\0';
8175 prefixLen = strlen(buf);
8176 if (prefixLen && buf[prefixLen-1] == '/')
8177 buf[prefixLen-1] = '\0';
8178
8179 if ((dir = opendir(buf)) == NULL) continue;
8180 while ((de = readdir(dir)) != NULL) {
8181 char *fileName = de->d_name;
8182 int fileNameLen = strlen(fileName);
8183
8184 if (strncmp(fileName, "jim-", 4) == 0 &&
8185 strncmp(fileName+4, pkgName, pkgNameLen) == 0 &&
8186 *(fileName+4+pkgNameLen) == '-' &&
8187 fileNameLen > 4 && /* note that this is not really useful */
8188 (strncmp(fileName+fileNameLen-4, ".tcl", 4) == 0 ||
8189 strncmp(fileName+fileNameLen-4, ".dll", 4) == 0 ||
8190 strncmp(fileName+fileNameLen-3, ".so", 3) == 0))
8191 {
8192 char ver[6]; /* xx.yy<nulterm> */
8193 char *p = strrchr(fileName, '.');
8194 int verLen, fileVer;
8195
8196 verLen = p - (fileName+4+pkgNameLen+1);
8197 if (verLen < 3 || verLen > 5) continue;
8198 memcpy(ver, fileName+4+pkgNameLen+1, verLen);
8199 ver[verLen] = '\0';
8200 if (JimPackageVersionToInt(interp, ver, &fileVer, JIM_NONE)
8201 != JIM_OK) continue;
8202 if (JimPackageMatchVersion(pkgVer, fileVer, flags) &&
8203 (bestVer == -1 || bestVer < fileVer))
8204 {
8205 bestVer = fileVer;
8206 Jim_Free(bestPackage);
8207 bestPackage = Jim_Alloc(strlen(buf)+strlen(fileName)+2);
8208 sprintf(bestPackage, "%s/%s", buf, fileName);
8209 }
8210 }
8211 }
8212 closedir(dir);
8213 }
8214 return bestPackage;
8215 }
8216
8217 #else /* JIM_ANSIC */
8218
8219 static char *JimFindBestPackage(Jim_Interp *interp, char **prefixes,
8220 int prefixc, const char *pkgName, int pkgVer, int flags)
8221 {
8222 JIM_NOTUSED(interp);
8223 JIM_NOTUSED(prefixes);
8224 JIM_NOTUSED(prefixc);
8225 JIM_NOTUSED(pkgName);
8226 JIM_NOTUSED(pkgVer);
8227 JIM_NOTUSED(flags);
8228 return NULL;
8229 }
8230
8231 #endif /* JIM_ANSIC */
8232
8233 /* Search for a suitable package under every dir specified by jim_libpath
8234 * and load it if possible. If a suitable package was loaded with success
8235 * JIM_OK is returned, otherwise JIM_ERR is returned. */
8236 static int JimLoadPackage(Jim_Interp *interp, const char *name, int ver,
8237 int flags)
8238 {
8239 Jim_Obj *libPathObjPtr;
8240 char **prefixes, *best;
8241 int prefixc, i, retCode = JIM_OK;
8242
8243 libPathObjPtr = Jim_GetGlobalVariableStr(interp, "jim_libpath", JIM_NONE);
8244 if (libPathObjPtr == NULL) {
8245 prefixc = 0;
8246 libPathObjPtr = NULL;
8247 } else {
8248 Jim_IncrRefCount(libPathObjPtr);
8249 Jim_ListLength(interp, libPathObjPtr, &prefixc);
8250 }
8251
8252 prefixes = Jim_Alloc(sizeof(char*)*prefixc);
8253 for (i = 0; i < prefixc; i++) {
8254 Jim_Obj *prefixObjPtr;
8255 if (Jim_ListIndex(interp, libPathObjPtr, i,
8256 &prefixObjPtr, JIM_NONE) != JIM_OK)
8257 {
8258 prefixes[i] = NULL;
8259 continue;
8260 }
8261 prefixes[i] = Jim_StrDup(Jim_GetString(prefixObjPtr, NULL));
8262 }
8263 /* Scan every directory to find the "best" package. */
8264 best = JimFindBestPackage(interp, prefixes, prefixc, name, ver, flags);
8265 if (best != NULL) {
8266 char *p = strrchr(best, '.');
8267 /* Try to load/source it */
8268 if (p && strcmp(p, ".tcl") == 0) {
8269 retCode = Jim_EvalFile(interp, best);
8270 } else {
8271 retCode = Jim_LoadLibrary(interp, best);
8272 }
8273 } else {
8274 retCode = JIM_ERR;
8275 }
8276 Jim_Free(best);
8277 for (i = 0; i < prefixc; i++)
8278 Jim_Free(prefixes[i]);
8279 Jim_Free(prefixes);
8280 if (libPathObjPtr)
8281 Jim_DecrRefCount(interp, libPathObjPtr);
8282 return retCode;
8283 }
8284
8285 const char *Jim_PackageRequire(Jim_Interp *interp, const char *name,
8286 const char *ver, int flags)
8287 {
8288 Jim_HashEntry *he;
8289 int requiredVer;
8290
8291 /* Start with an empty error string */
8292 Jim_SetResultString(interp, "", 0);
8293
8294 if (JimPackageVersionToInt(interp, ver, &requiredVer, JIM_ERRMSG) != JIM_OK)
8295 return NULL;
8296 he = Jim_FindHashEntry(&interp->packages, name);
8297 if (he == NULL) {
8298 /* Try to load the package. */
8299 if (JimLoadPackage(interp, name, requiredVer, flags) == JIM_OK) {
8300 he = Jim_FindHashEntry(&interp->packages, name);
8301 if (he == NULL) {
8302 return "?";
8303 }
8304 return he->val;
8305 }
8306 /* No way... return an error. */
8307 if (flags & JIM_ERRMSG) {
8308 int len;
8309 Jim_GetString(Jim_GetResult(interp), &len);
8310 Jim_AppendStrings(interp, Jim_GetResult(interp), len ? "\n" : "",
8311 "Can't find package '", name, "'", NULL);
8312 }
8313 return NULL;
8314 } else {
8315 int actualVer;
8316 if (JimPackageVersionToInt(interp, he->val, &actualVer, JIM_ERRMSG)
8317 != JIM_OK)
8318 {
8319 return NULL;
8320 }
8321 /* Check if version matches. */
8322 if (JimPackageMatchVersion(requiredVer, actualVer, flags) == 0) {
8323 Jim_AppendStrings(interp, Jim_GetResult(interp),
8324 "Package '", name, "' already loaded, but with version ",
8325 he->val, NULL);
8326 return NULL;
8327 }
8328 return he->val;
8329 }
8330 }
8331
8332 /* -----------------------------------------------------------------------------
8333 * Eval
8334 * ---------------------------------------------------------------------------*/
8335 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
8336 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
8337
8338 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc,
8339 Jim_Obj *const *argv);
8340
8341 /* Handle calls to the [unknown] command */
8342 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
8343 {
8344 Jim_Obj **v, *sv[JIM_EVAL_SARGV_LEN];
8345 int retCode;
8346
8347 /* If JimUnknown() is recursively called (e.g. error in the unknown proc,
8348 * done here
8349 */
8350 if (interp->unknown_called) {
8351 return JIM_ERR;
8352 }
8353
8354 /* If the [unknown] command does not exists returns
8355 * just now */
8356 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
8357 return JIM_ERR;
8358
8359 /* The object interp->unknown just contains
8360 * the "unknown" string, it is used in order to
8361 * avoid to lookup the unknown command every time
8362 * but instread to cache the result. */
8363 if (argc+1 <= JIM_EVAL_SARGV_LEN)
8364 v = sv;
8365 else
8366 v = Jim_Alloc(sizeof(Jim_Obj*)*(argc+1));
8367 /* Make a copy of the arguments vector, but shifted on
8368 * the right of one position. The command name of the
8369 * command will be instead the first argument of the
8370 * [unknonw] call. */
8371 memcpy(v+1, argv, sizeof(Jim_Obj*)*argc);
8372 v[0] = interp->unknown;
8373 /* Call it */
8374 interp->unknown_called++;
8375 retCode = Jim_EvalObjVector(interp, argc+1, v);
8376 interp->unknown_called--;
8377
8378 /* Clean up */
8379 if (v != sv)
8380 Jim_Free(v);
8381 return retCode;
8382 }
8383
8384 /* Eval the object vector 'objv' composed of 'objc' elements.
8385 * Every element is used as single argument.
8386 * Jim_EvalObj() will call this function every time its object
8387 * argument is of "list" type, with no string representation.
8388 *
8389 * This is possible because the string representation of a
8390 * list object generated by the UpdateStringOfList is made
8391 * in a way that ensures that every list element is a different
8392 * command argument. */
8393 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
8394 {
8395 int i, retcode;
8396 Jim_Cmd *cmdPtr;
8397
8398 /* Incr refcount of arguments. */
8399 for (i = 0; i < objc; i++)
8400 Jim_IncrRefCount(objv[i]);
8401 /* Command lookup */
8402 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
8403 if (cmdPtr == NULL) {
8404 retcode = JimUnknown(interp, objc, objv);
8405 } else {
8406 /* Call it -- Make sure result is an empty object. */
8407 Jim_SetEmptyResult(interp);
8408 if (cmdPtr->cmdProc) {
8409 interp->cmdPrivData = cmdPtr->privData;
8410 retcode = cmdPtr->cmdProc(interp, objc, objv);
8411 if (retcode == JIM_ERR_ADDSTACK) {
8412 //JimAppendStackTrace(interp, "", script->fileName, token[i-argc*2].linenr);
8413 retcode = JIM_ERR;
8414 }
8415 } else {
8416 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
8417 if (retcode == JIM_ERR) {
8418 JimAppendStackTrace(interp,
8419 Jim_GetString(objv[0], NULL), "", 1);
8420 }
8421 }
8422 }
8423 /* Decr refcount of arguments and return the retcode */
8424 for (i = 0; i < objc; i++)
8425 Jim_DecrRefCount(interp, objv[i]);
8426 return retcode;
8427 }
8428
8429 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
8430 * via *objPtrPtr. This function is only called by Jim_EvalObj().
8431 * The returned object has refcount = 0. */
8432 int Jim_InterpolateTokens(Jim_Interp *interp, ScriptToken *token,
8433 int tokens, Jim_Obj **objPtrPtr)
8434 {
8435 int totlen = 0, i, retcode;
8436 Jim_Obj **intv;
8437 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
8438 Jim_Obj *objPtr;
8439 char *s;
8440
8441 if (tokens <= JIM_EVAL_SINTV_LEN)
8442 intv = sintv;
8443 else
8444 intv = Jim_Alloc(sizeof(Jim_Obj*)*
8445 tokens);
8446 /* Compute every token forming the argument
8447 * in the intv objects vector. */
8448 for (i = 0; i < tokens; i++) {
8449 switch(token[i].type) {
8450 case JIM_TT_ESC:
8451 case JIM_TT_STR:
8452 intv[i] = token[i].objPtr;
8453 break;
8454 case JIM_TT_VAR:
8455 intv[i] = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
8456 if (!intv[i]) {
8457 retcode = JIM_ERR;
8458 goto err;
8459 }
8460 break;
8461 case JIM_TT_DICTSUGAR:
8462 intv[i] = Jim_ExpandDictSugar(interp, token[i].objPtr);
8463 if (!intv[i]) {
8464 retcode = JIM_ERR;
8465 goto err;
8466 }
8467 break;
8468 case JIM_TT_CMD:
8469 retcode = Jim_EvalObj(interp, token[i].objPtr);
8470 if (retcode != JIM_OK)
8471 goto err;
8472 intv[i] = Jim_GetResult(interp);
8473 break;
8474 default:
8475 Jim_Panic(interp,
8476 "default token type reached "
8477 "in Jim_InterpolateTokens().");
8478 break;
8479 }
8480 Jim_IncrRefCount(intv[i]);
8481 /* Make sure there is a valid
8482 * string rep, and add the string
8483 * length to the total legnth. */
8484 Jim_GetString(intv[i], NULL);
8485 totlen += intv[i]->length;
8486 }
8487 /* Concatenate every token in an unique
8488 * object. */
8489 objPtr = Jim_NewStringObjNoAlloc(interp,
8490 NULL, 0);
8491 s = objPtr->bytes = Jim_Alloc(totlen+1);
8492 objPtr->length = totlen;
8493 for (i = 0; i < tokens; i++) {
8494 memcpy(s, intv[i]->bytes, intv[i]->length);
8495 s += intv[i]->length;
8496 Jim_DecrRefCount(interp, intv[i]);
8497 }
8498 objPtr->bytes[totlen] = '\0';
8499 /* Free the intv vector if not static. */
8500 if (tokens > JIM_EVAL_SINTV_LEN)
8501 Jim_Free(intv);
8502 *objPtrPtr = objPtr;
8503 return JIM_OK;
8504 err:
8505 i--;
8506 for (; i >= 0; i--)
8507 Jim_DecrRefCount(interp, intv[i]);
8508 if (tokens > JIM_EVAL_SINTV_LEN)
8509 Jim_Free(intv);
8510 return retcode;
8511 }
8512
8513 /* Helper of Jim_EvalObj() to perform argument expansion.
8514 * Basically this function append an argument to 'argv'
8515 * (and increments argc by reference accordingly), performing
8516 * expansion of the list object if 'expand' is non-zero, or
8517 * just adding objPtr to argv if 'expand' is zero. */
8518 void Jim_ExpandArgument(Jim_Interp *interp, Jim_Obj ***argv,
8519 int *argcPtr, int expand, Jim_Obj *objPtr)
8520 {
8521 if (!expand) {
8522 (*argv) = Jim_Realloc(*argv, sizeof(Jim_Obj*)*((*argcPtr)+1));
8523 /* refcount of objPtr not incremented because
8524 * we are actually transfering a reference from
8525 * the old 'argv' to the expanded one. */
8526 (*argv)[*argcPtr] = objPtr;
8527 (*argcPtr)++;
8528 } else {
8529 int len, i;
8530
8531 Jim_ListLength(interp, objPtr, &len);
8532 (*argv) = Jim_Realloc(*argv, sizeof(Jim_Obj*)*((*argcPtr)+len));
8533 for (i = 0; i < len; i++) {
8534 (*argv)[*argcPtr] = objPtr->internalRep.listValue.ele[i];
8535 Jim_IncrRefCount(objPtr->internalRep.listValue.ele[i]);
8536 (*argcPtr)++;
8537 }
8538 /* The original object reference is no longer needed,
8539 * after the expansion it is no longer present on
8540 * the argument vector, but the single elements are
8541 * in its place. */
8542 Jim_DecrRefCount(interp, objPtr);
8543 }
8544 }
8545
8546 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
8547 {
8548 int i, j = 0, len;
8549 ScriptObj *script;
8550 ScriptToken *token;
8551 int *cs; /* command structure array */
8552 int retcode = JIM_OK;
8553 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL, *tmpObjPtr;
8554
8555 interp->errorFlag = 0;
8556
8557 /* If the object is of type "list" and there is no
8558 * string representation for this object, we can call
8559 * a specialized version of Jim_EvalObj() */
8560 if (scriptObjPtr->typePtr == &listObjType &&
8561 scriptObjPtr->internalRep.listValue.len &&
8562 scriptObjPtr->bytes == NULL) {
8563 Jim_IncrRefCount(scriptObjPtr);
8564 retcode = Jim_EvalObjVector(interp,
8565 scriptObjPtr->internalRep.listValue.len,
8566 scriptObjPtr->internalRep.listValue.ele);
8567 Jim_DecrRefCount(interp, scriptObjPtr);
8568 return retcode;
8569 }
8570
8571 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
8572 script = Jim_GetScript(interp, scriptObjPtr);
8573 /* Now we have to make sure the internal repr will not be
8574 * freed on shimmering.
8575 *
8576 * Think for example to this:
8577 *
8578 * set x {llength $x; ... some more code ...}; eval $x
8579 *
8580 * In order to preserve the internal rep, we increment the
8581 * inUse field of the script internal rep structure. */
8582 script->inUse++;
8583
8584 token = script->token;
8585 len = script->len;
8586 cs = script->cmdStruct;
8587 i = 0; /* 'i' is the current token index. */
8588
8589 /* Reset the interpreter result. This is useful to
8590 * return the emtpy result in the case of empty program. */
8591 Jim_SetEmptyResult(interp);
8592
8593 /* Execute every command sequentially, returns on
8594 * error (i.e. if a command does not return JIM_OK) */
8595 while (i < len) {
8596 int expand = 0;
8597 int argc = *cs++; /* Get the number of arguments */
8598 Jim_Cmd *cmd;
8599
8600 /* Set the expand flag if needed. */
8601 if (argc == -1) {
8602 expand++;
8603 argc = *cs++;
8604 }
8605 /* Allocate the arguments vector */
8606 if (argc <= JIM_EVAL_SARGV_LEN)
8607 argv = sargv;
8608 else
8609 argv = Jim_Alloc(sizeof(Jim_Obj*)*argc);
8610 /* Populate the arguments objects. */
8611 for (j = 0; j < argc; j++) {
8612 int tokens = *cs++;
8613
8614 /* tokens is negative if expansion is needed.
8615 * for this argument. */
8616 if (tokens < 0) {
8617 tokens = (-tokens)-1;
8618 i++;
8619 }
8620 if (tokens == 1) {
8621 /* Fast path if the token does not
8622 * need interpolation */
8623 switch(token[i].type) {
8624 case JIM_TT_ESC:
8625 case JIM_TT_STR:
8626 argv[j] = token[i].objPtr;
8627 break;
8628 case JIM_TT_VAR:
8629 tmpObjPtr = Jim_GetVariable(interp, token[i].objPtr,
8630 JIM_ERRMSG);
8631 if (!tmpObjPtr) {
8632 retcode = JIM_ERR;
8633 goto err;
8634 }
8635 argv[j] = tmpObjPtr;
8636 break;
8637 case JIM_TT_DICTSUGAR:
8638 tmpObjPtr = Jim_ExpandDictSugar(interp, token[i].objPtr);
8639 if (!tmpObjPtr) {
8640 retcode = JIM_ERR;
8641 goto err;
8642 }
8643 argv[j] = tmpObjPtr;
8644 break;
8645 case JIM_TT_CMD:
8646 retcode = Jim_EvalObj(interp, token[i].objPtr);
8647 if (retcode != JIM_OK)
8648 goto err;
8649 argv[j] = Jim_GetResult(interp);
8650 break;
8651 default:
8652 Jim_Panic(interp,
8653 "default token type reached "
8654 "in Jim_EvalObj().");
8655 break;
8656 }
8657 Jim_IncrRefCount(argv[j]);
8658 i += 2;
8659 } else {
8660 /* For interpolation we call an helper
8661 * function doing the work for us. */
8662 if ((retcode = Jim_InterpolateTokens(interp,
8663 token+i, tokens, &tmpObjPtr)) != JIM_OK)
8664 {
8665 goto err;
8666 }
8667 argv[j] = tmpObjPtr;
8668 Jim_IncrRefCount(argv[j]);
8669 i += tokens+1;
8670 }
8671 }
8672 /* Handle {expand} expansion */
8673 if (expand) {
8674 int *ecs = cs - argc;
8675 int eargc = 0;
8676 Jim_Obj **eargv = NULL;
8677
8678 for (j = 0; j < argc; j++) {
8679 Jim_ExpandArgument( interp, &eargv, &eargc,
8680 ecs[j] < 0, argv[j]);
8681 }
8682 if (argv != sargv)
8683 Jim_Free(argv);
8684 argc = eargc;
8685 argv = eargv;
8686 j = argc;
8687 if (argc == 0) {
8688 /* Nothing to do with zero args. */
8689 Jim_Free(eargv);
8690 continue;
8691 }
8692 }
8693 /* Lookup the command to call */
8694 cmd = Jim_GetCommand(interp, argv[0], JIM_ERRMSG);
8695 if (cmd != NULL) {
8696 /* Call it -- Make sure result is an empty object. */
8697 Jim_SetEmptyResult(interp);
8698 if (cmd->cmdProc) {
8699 interp->cmdPrivData = cmd->privData;
8700 retcode = cmd->cmdProc(interp, argc, argv);
8701 if ((retcode == JIM_ERR)||(retcode == JIM_ERR_ADDSTACK)) {
8702 JimAppendStackTrace(interp, "", script->fileName, token[i-argc*2].linenr);
8703 retcode = JIM_ERR;
8704 }
8705 } else {
8706 retcode = JimCallProcedure(interp, cmd, argc, argv);
8707 if (retcode == JIM_ERR) {
8708 JimAppendStackTrace(interp,
8709 Jim_GetString(argv[0], NULL), script->fileName,
8710 token[i-argc*2].linenr);
8711 }
8712 }
8713 } else {
8714 /* Call [unknown] */
8715 retcode = JimUnknown(interp, argc, argv);
8716 if (retcode == JIM_ERR) {
8717 JimAppendStackTrace(interp,
8718 "", script->fileName,
8719 token[i-argc*2].linenr);
8720 }
8721 }
8722 if (retcode != JIM_OK) {
8723 i -= argc*2; /* point to the command name. */
8724 goto err;
8725 }
8726 /* Decrement the arguments count */
8727 for (j = 0; j < argc; j++) {
8728 Jim_DecrRefCount(interp, argv[j]);
8729 }
8730
8731 if (argv != sargv) {
8732 Jim_Free(argv);
8733 argv = NULL;
8734 }
8735 }
8736 /* Note that we don't have to decrement inUse, because the
8737 * following code transfers our use of the reference again to
8738 * the script object. */
8739 j = 0; /* on normal termination, the argv array is already
8740 Jim_DecrRefCount-ed. */
8741 err:
8742 /* Handle errors. */
8743 if (retcode == JIM_ERR && !interp->errorFlag) {
8744 interp->errorFlag = 1;
8745 JimSetErrorFileName(interp, script->fileName);
8746 JimSetErrorLineNumber(interp, token[i].linenr);
8747 JimResetStackTrace(interp);
8748 }
8749 Jim_FreeIntRep(interp, scriptObjPtr);
8750 scriptObjPtr->typePtr = &scriptObjType;
8751 Jim_SetIntRepPtr(scriptObjPtr, script);
8752 Jim_DecrRefCount(interp, scriptObjPtr);
8753 for (i = 0; i < j; i++) {
8754 Jim_DecrRefCount(interp, argv[i]);
8755 }
8756 if (argv != sargv)
8757 Jim_Free(argv);
8758 return retcode;
8759 }
8760
8761 /* Call a procedure implemented in Tcl.
8762 * It's possible to speed-up a lot this function, currently
8763 * the callframes are not cached, but allocated and
8764 * destroied every time. What is expecially costly is
8765 * to create/destroy the local vars hash table every time.
8766 *
8767 * This can be fixed just implementing callframes caching
8768 * in JimCreateCallFrame() and JimFreeCallFrame(). */
8769 int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc,
8770 Jim_Obj *const *argv)
8771 {
8772 int i, retcode;
8773 Jim_CallFrame *callFramePtr;
8774 int num_args;
8775
8776 /* Check arity */
8777 if (argc < cmd->arityMin || (cmd->arityMax != -1 &&
8778 argc > cmd->arityMax)) {
8779 Jim_Obj *objPtr = Jim_NewEmptyStringObj(interp);
8780 Jim_AppendStrings(interp, objPtr,
8781 "wrong # args: should be \"", Jim_GetString(argv[0], NULL),
8782 (cmd->arityMin > 1) ? " " : "",
8783 Jim_GetString(cmd->argListObjPtr, NULL), "\"", NULL);
8784 Jim_SetResult(interp, objPtr);
8785 return JIM_ERR;
8786 }
8787 /* Check if there are too nested calls */
8788 if (interp->numLevels == interp->maxNestingDepth) {
8789 Jim_SetResultString(interp,
8790 "Too many nested calls. Infinite recursion?", -1);
8791 return JIM_ERR;
8792 }
8793 /* Create a new callframe */
8794 callFramePtr = JimCreateCallFrame(interp);
8795 callFramePtr->parentCallFrame = interp->framePtr;
8796 callFramePtr->argv = argv;
8797 callFramePtr->argc = argc;
8798 callFramePtr->procArgsObjPtr = cmd->argListObjPtr;
8799 callFramePtr->procBodyObjPtr = cmd->bodyObjPtr;
8800 callFramePtr->staticVars = cmd->staticVars;
8801 Jim_IncrRefCount(cmd->argListObjPtr);
8802 Jim_IncrRefCount(cmd->bodyObjPtr);
8803 interp->framePtr = callFramePtr;
8804 interp->numLevels ++;
8805
8806 /* Set arguments */
8807 Jim_ListLength(interp, cmd->argListObjPtr, &num_args);
8808
8809 /* If last argument is 'args', don't set it here */
8810 if (cmd->arityMax == -1) {
8811 num_args--;
8812 }
8813
8814 for (i = 0; i < num_args; i++) {
8815 Jim_Obj *argObjPtr;
8816 Jim_Obj *nameObjPtr;
8817 Jim_Obj *valueObjPtr;
8818
8819 Jim_ListIndex(interp, cmd->argListObjPtr, i, &argObjPtr, JIM_NONE);
8820 if (i + 1 >= cmd->arityMin) {
8821 /* The name is the first element of the list */
8822 Jim_ListIndex(interp, argObjPtr, 0, &nameObjPtr, JIM_NONE);
8823 }
8824 else {
8825 /* The element arg is the name */
8826 nameObjPtr = argObjPtr;
8827 }
8828
8829 if (i + 1 >= argc) {
8830 /* No more values, so use default */
8831 /* The value is the second element of the list */
8832 Jim_ListIndex(interp, argObjPtr, 1, &valueObjPtr, JIM_NONE);
8833 }
8834 else {
8835 valueObjPtr = argv[i+1];
8836 }
8837 Jim_SetVariable(interp, nameObjPtr, valueObjPtr);
8838 }
8839 /* Set optional arguments */
8840 if (cmd->arityMax == -1) {
8841 Jim_Obj *listObjPtr, *objPtr;
8842
8843 i++;
8844 listObjPtr = Jim_NewListObj(interp, argv+i, argc-i);
8845 Jim_ListIndex(interp, cmd->argListObjPtr, num_args, &objPtr, JIM_NONE);
8846 Jim_SetVariable(interp, objPtr, listObjPtr);
8847 }
8848 /* Eval the body */
8849 retcode = Jim_EvalObj(interp, cmd->bodyObjPtr);
8850
8851 /* Destroy the callframe */
8852 interp->numLevels --;
8853 interp->framePtr = interp->framePtr->parentCallFrame;
8854 if (callFramePtr->vars.size != JIM_HT_INITIAL_SIZE) {
8855 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NONE);
8856 } else {
8857 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NOHT);
8858 }
8859 /* Handle the JIM_EVAL return code */
8860 if (retcode == JIM_EVAL && interp->evalRetcodeLevel != interp->numLevels) {
8861 int savedLevel = interp->evalRetcodeLevel;
8862
8863 interp->evalRetcodeLevel = interp->numLevels;
8864 while (retcode == JIM_EVAL) {
8865 Jim_Obj *resultScriptObjPtr = Jim_GetResult(interp);
8866 Jim_IncrRefCount(resultScriptObjPtr);
8867 retcode = Jim_EvalObj(interp, resultScriptObjPtr);
8868 Jim_DecrRefCount(interp, resultScriptObjPtr);
8869 }
8870 interp->evalRetcodeLevel = savedLevel;
8871 }
8872 /* Handle the JIM_RETURN return code */
8873 if (retcode == JIM_RETURN) {
8874 retcode = interp->returnCode;
8875 interp->returnCode = JIM_OK;
8876 }
8877 return retcode;
8878 }
8879
8880 int Jim_Eval_Named(Jim_Interp *interp, const char *script, const char *filename, int lineno)
8881 {
8882 int retval;
8883 Jim_Obj *scriptObjPtr;
8884
8885 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
8886 Jim_IncrRefCount(scriptObjPtr);
8887
8888
8889 if( filename ){
8890 JimSetSourceInfo( interp, scriptObjPtr, filename, lineno );
8891 }
8892
8893 retval = Jim_EvalObj(interp, scriptObjPtr);
8894 Jim_DecrRefCount(interp, scriptObjPtr);
8895 return retval;
8896 }
8897
8898 int Jim_Eval(Jim_Interp *interp, const char *script)
8899 {
8900 return Jim_Eval_Named( interp, script, NULL, 0 );
8901 }
8902
8903
8904
8905 /* Execute script in the scope of the global level */
8906 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
8907 {
8908 Jim_CallFrame *savedFramePtr;
8909 int retval;
8910
8911 savedFramePtr = interp->framePtr;
8912 interp->framePtr = interp->topFramePtr;
8913 retval = Jim_Eval(interp, script);
8914 interp->framePtr = savedFramePtr;
8915 return retval;
8916 }
8917
8918 int Jim_EvalObjBackground(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
8919 {
8920 Jim_CallFrame *savedFramePtr;
8921 int retval;
8922
8923 savedFramePtr = interp->framePtr;
8924 interp->framePtr = interp->topFramePtr;
8925 retval = Jim_EvalObj(interp, scriptObjPtr);
8926 interp->framePtr = savedFramePtr;
8927 /* Try to report the error (if any) via the bgerror proc */
8928 if (retval != JIM_OK) {
8929 Jim_Obj *objv[2];
8930
8931 objv[0] = Jim_NewStringObj(interp, "bgerror", -1);
8932 objv[1] = Jim_GetResult(interp);
8933 Jim_IncrRefCount(objv[0]);
8934 Jim_IncrRefCount(objv[1]);
8935 if (Jim_EvalObjVector(interp, 2, objv) != JIM_OK) {
8936 /* Report the error to stderr. */
8937 Jim_fprintf( interp, interp->cookie_stderr, "Background error:" JIM_NL);
8938 Jim_PrintErrorMessage(interp);
8939 }
8940 Jim_DecrRefCount(interp, objv[0]);
8941 Jim_DecrRefCount(interp, objv[1]);
8942 }
8943 return retval;
8944 }
8945
8946 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
8947 {
8948 char *prg = NULL;
8949 FILE *fp;
8950 int nread, totread, maxlen, buflen;
8951 int retval;
8952 Jim_Obj *scriptObjPtr;
8953
8954 if ((fp = fopen(filename, "r")) == NULL) {
8955 const int cwd_len=2048;
8956 char *cwd=malloc(cwd_len);
8957 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8958 if (!getcwd( cwd, cwd_len )) strcpy(cwd, "unknown");
8959 Jim_AppendStrings(interp, Jim_GetResult(interp),
8960 "Error loading script \"", filename, "\"",
8961 " cwd: ", cwd,
8962 " err: ", strerror(errno), NULL);
8963 free(cwd);
8964 return JIM_ERR;
8965 }
8966 buflen = 1024;
8967 maxlen = totread = 0;
8968 while (1) {
8969 if (maxlen < totread+buflen+1) {
8970 maxlen = totread+buflen+1;
8971 prg = Jim_Realloc(prg, maxlen);
8972 }
8973 /* do not use Jim_fread() - this is really a file */
8974 if ((nread = fread(prg+totread, 1, buflen, fp)) == 0) break;
8975 totread += nread;
8976 }
8977 prg[totread] = '\0';
8978 /* do not use Jim_fclose() - this is really a file */
8979 fclose(fp);
8980
8981 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, prg, totread);
8982 JimSetSourceInfo(interp, scriptObjPtr, filename, 1);
8983 Jim_IncrRefCount(scriptObjPtr);
8984 retval = Jim_EvalObj(interp, scriptObjPtr);
8985 Jim_DecrRefCount(interp, scriptObjPtr);
8986 return retval;
8987 }
8988
8989 /* -----------------------------------------------------------------------------
8990 * Subst
8991 * ---------------------------------------------------------------------------*/
8992 static int JimParseSubstStr(struct JimParserCtx *pc)
8993 {
8994 pc->tstart = pc->p;
8995 pc->tline = pc->linenr;
8996 while (*pc->p && *pc->p != '$' && *pc->p != '[') {
8997 pc->p++; pc->len--;
8998 }
8999 pc->tend = pc->p-1;
9000 pc->tt = JIM_TT_ESC;
9001 return JIM_OK;
9002 }
9003
9004 static int JimParseSubst(struct JimParserCtx *pc, int flags)
9005 {
9006 int retval;
9007
9008 if (pc->len == 0) {
9009 pc->tstart = pc->tend = pc->p;
9010 pc->tline = pc->linenr;
9011 pc->tt = JIM_TT_EOL;
9012 pc->eof = 1;
9013 return JIM_OK;
9014 }
9015 switch(*pc->p) {
9016 case '[':
9017 retval = JimParseCmd(pc);
9018 if (flags & JIM_SUBST_NOCMD) {
9019 pc->tstart--;
9020 pc->tend++;
9021 pc->tt = (flags & JIM_SUBST_NOESC) ?
9022 JIM_TT_STR : JIM_TT_ESC;
9023 }
9024 return retval;
9025 break;
9026 case '$':
9027 if (JimParseVar(pc) == JIM_ERR) {
9028 pc->tstart = pc->tend = pc->p++; pc->len--;
9029 pc->tline = pc->linenr;
9030 pc->tt = JIM_TT_STR;
9031 } else {
9032 if (flags & JIM_SUBST_NOVAR) {
9033 pc->tstart--;
9034 if (flags & JIM_SUBST_NOESC)
9035 pc->tt = JIM_TT_STR;
9036 else
9037 pc->tt = JIM_TT_ESC;
9038 if (*pc->tstart == '{') {
9039 pc->tstart--;
9040 if (*(pc->tend+1))
9041 pc->tend++;
9042 }
9043 }
9044 }
9045 break;
9046 default:
9047 retval = JimParseSubstStr(pc);
9048 if (flags & JIM_SUBST_NOESC)
9049 pc->tt = JIM_TT_STR;
9050 return retval;
9051 break;
9052 }
9053 return JIM_OK;
9054 }
9055
9056 /* The subst object type reuses most of the data structures and functions
9057 * of the script object. Script's data structures are a bit more complex
9058 * for what is needed for [subst]itution tasks, but the reuse helps to
9059 * deal with a single data structure at the cost of some more memory
9060 * usage for substitutions. */
9061 static Jim_ObjType substObjType = {
9062 "subst",
9063 FreeScriptInternalRep,
9064 DupScriptInternalRep,
9065 NULL,
9066 JIM_TYPE_REFERENCES,
9067 };
9068
9069 /* This method takes the string representation of an object
9070 * as a Tcl string where to perform [subst]itution, and generates
9071 * the pre-parsed internal representation. */
9072 int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
9073 {
9074 int scriptTextLen;
9075 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
9076 struct JimParserCtx parser;
9077 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
9078
9079 script->len = 0;
9080 script->csLen = 0;
9081 script->commands = 0;
9082 script->token = NULL;
9083 script->cmdStruct = NULL;
9084 script->inUse = 1;
9085 script->substFlags = flags;
9086 script->fileName = NULL;
9087
9088 JimParserInit(&parser, scriptText, scriptTextLen, 1);
9089 while(1) {
9090 char *token;
9091 int len, type, linenr;
9092
9093 JimParseSubst(&parser, flags);
9094 if (JimParserEof(&parser)) break;
9095 token = JimParserGetToken(&parser, &len, &type, &linenr);
9096 ScriptObjAddToken(interp, script, token, len, type,
9097 NULL, linenr);
9098 }
9099 /* Free the old internal rep and set the new one. */
9100 Jim_FreeIntRep(interp, objPtr);
9101 Jim_SetIntRepPtr(objPtr, script);
9102 objPtr->typePtr = &scriptObjType;
9103 return JIM_OK;
9104 }
9105
9106 ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
9107 {
9108 struct ScriptObj *script = Jim_GetIntRepPtr(objPtr);
9109
9110 if (objPtr->typePtr != &substObjType || script->substFlags != flags)
9111 SetSubstFromAny(interp, objPtr, flags);
9112 return (ScriptObj*) Jim_GetIntRepPtr(objPtr);
9113 }
9114
9115 /* Performs commands,variables,blackslashes substitution,
9116 * storing the result object (with refcount 0) into
9117 * resObjPtrPtr. */
9118 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr,
9119 Jim_Obj **resObjPtrPtr, int flags)
9120 {
9121 ScriptObj *script;
9122 ScriptToken *token;
9123 int i, len, retcode = JIM_OK;
9124 Jim_Obj *resObjPtr, *savedResultObjPtr;
9125
9126 script = Jim_GetSubst(interp, substObjPtr, flags);
9127 #ifdef JIM_OPTIMIZATION
9128 /* Fast path for a very common case with array-alike syntax,
9129 * that's: $foo($bar) */
9130 if (script->len == 1 && script->token[0].type == JIM_TT_VAR) {
9131 Jim_Obj *varObjPtr = script->token[0].objPtr;
9132
9133 Jim_IncrRefCount(varObjPtr);
9134 resObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
9135 if (resObjPtr == NULL) {
9136 Jim_DecrRefCount(interp, varObjPtr);
9137 return JIM_ERR;
9138 }
9139 Jim_DecrRefCount(interp, varObjPtr);
9140 *resObjPtrPtr = resObjPtr;
9141 return JIM_OK;
9142 }
9143 #endif
9144
9145 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
9146 /* In order to preserve the internal rep, we increment the
9147 * inUse field of the script internal rep structure. */
9148 script->inUse++;
9149
9150 token = script->token;
9151 len = script->len;
9152
9153 /* Save the interp old result, to set it again before
9154 * to return. */
9155 savedResultObjPtr = interp->result;
9156 Jim_IncrRefCount(savedResultObjPtr);
9157
9158 /* Perform the substitution. Starts with an empty object
9159 * and adds every token (performing the appropriate
9160 * var/command/escape substitution). */
9161 resObjPtr = Jim_NewStringObj(interp, "", 0);
9162 for (i = 0; i < len; i++) {
9163 Jim_Obj *objPtr;
9164
9165 switch(token[i].type) {
9166 case JIM_TT_STR:
9167 case JIM_TT_ESC:
9168 Jim_AppendObj(interp, resObjPtr, token[i].objPtr);
9169 break;
9170 case JIM_TT_VAR:
9171 objPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
9172 if (objPtr == NULL) goto err;
9173 Jim_IncrRefCount(objPtr);
9174 Jim_AppendObj(interp, resObjPtr, objPtr);
9175 Jim_DecrRefCount(interp, objPtr);
9176 break;
9177 case JIM_TT_DICTSUGAR:
9178 objPtr = Jim_ExpandDictSugar(interp, token[i].objPtr);
9179 if (!objPtr) {
9180 retcode = JIM_ERR;
9181 goto err;
9182 }
9183 break;
9184 case JIM_TT_CMD:
9185 if (Jim_EvalObj(interp, token[i].objPtr) != JIM_OK)
9186 goto err;
9187 Jim_AppendObj(interp, resObjPtr, interp->result);
9188 break;
9189 default:
9190 Jim_Panic(interp,
9191 "default token type (%d) reached "
9192 "in Jim_SubstObj().", token[i].type);
9193 break;
9194 }
9195 }
9196 ok:
9197 if (retcode == JIM_OK)
9198 Jim_SetResult(interp, savedResultObjPtr);
9199 Jim_DecrRefCount(interp, savedResultObjPtr);
9200 /* Note that we don't have to decrement inUse, because the
9201 * following code transfers our use of the reference again to
9202 * the script object. */
9203 Jim_FreeIntRep(interp, substObjPtr);
9204 substObjPtr->typePtr = &scriptObjType;
9205 Jim_SetIntRepPtr(substObjPtr, script);
9206 Jim_DecrRefCount(interp, substObjPtr);
9207 *resObjPtrPtr = resObjPtr;
9208 return retcode;
9209 err:
9210 Jim_FreeNewObj(interp, resObjPtr);
9211 retcode = JIM_ERR;
9212 goto ok;
9213 }
9214
9215 /* -----------------------------------------------------------------------------
9216 * API Input/Export functions
9217 * ---------------------------------------------------------------------------*/
9218
9219 int Jim_GetApi(Jim_Interp *interp, const char *funcname, void *targetPtrPtr)
9220 {
9221 Jim_HashEntry *he;
9222
9223 he = Jim_FindHashEntry(&interp->stub, funcname);
9224 if (!he)
9225 return JIM_ERR;
9226 memcpy(targetPtrPtr, &he->val, sizeof(void*));
9227 return JIM_OK;
9228 }
9229
9230 int Jim_RegisterApi(Jim_Interp *interp, const char *funcname, void *funcptr)
9231 {
9232 return Jim_AddHashEntry(&interp->stub, funcname, funcptr);
9233 }
9234
9235 #define JIM_REGISTER_API(name) \
9236 Jim_RegisterApi(interp, "Jim_" #name, (void *)Jim_ ## name)
9237
9238 void JimRegisterCoreApi(Jim_Interp *interp)
9239 {
9240 interp->getApiFuncPtr = Jim_GetApi;
9241 JIM_REGISTER_API(Alloc);
9242 JIM_REGISTER_API(Free);
9243 JIM_REGISTER_API(Eval);
9244 JIM_REGISTER_API(Eval_Named);
9245 JIM_REGISTER_API(EvalGlobal);
9246 JIM_REGISTER_API(EvalFile);
9247 JIM_REGISTER_API(EvalObj);
9248 JIM_REGISTER_API(EvalObjBackground);
9249 JIM_REGISTER_API(EvalObjVector);
9250 JIM_REGISTER_API(InitHashTable);
9251 JIM_REGISTER_API(ExpandHashTable);
9252 JIM_REGISTER_API(AddHashEntry);
9253 JIM_REGISTER_API(ReplaceHashEntry);
9254 JIM_REGISTER_API(DeleteHashEntry);
9255 JIM_REGISTER_API(FreeHashTable);
9256 JIM_REGISTER_API(FindHashEntry);
9257 JIM_REGISTER_API(ResizeHashTable);
9258 JIM_REGISTER_API(GetHashTableIterator);
9259 JIM_REGISTER_API(NextHashEntry);
9260 JIM_REGISTER_API(NewObj);
9261 JIM_REGISTER_API(FreeObj);
9262 JIM_REGISTER_API(InvalidateStringRep);
9263 JIM_REGISTER_API(InitStringRep);
9264 JIM_REGISTER_API(DuplicateObj);
9265 JIM_REGISTER_API(GetString);
9266 JIM_REGISTER_API(Length);
9267 JIM_REGISTER_API(InvalidateStringRep);
9268 JIM_REGISTER_API(NewStringObj);
9269 JIM_REGISTER_API(NewStringObjNoAlloc);
9270 JIM_REGISTER_API(AppendString);
9271 JIM_REGISTER_API(AppendString_sprintf);
9272 JIM_REGISTER_API(AppendObj);
9273 JIM_REGISTER_API(AppendStrings);
9274 JIM_REGISTER_API(StringEqObj);
9275 JIM_REGISTER_API(StringMatchObj);
9276 JIM_REGISTER_API(StringRangeObj);
9277 JIM_REGISTER_API(FormatString);
9278 JIM_REGISTER_API(CompareStringImmediate);
9279 JIM_REGISTER_API(NewReference);
9280 JIM_REGISTER_API(GetReference);
9281 JIM_REGISTER_API(SetFinalizer);
9282 JIM_REGISTER_API(GetFinalizer);
9283 JIM_REGISTER_API(CreateInterp);
9284 JIM_REGISTER_API(FreeInterp);
9285 JIM_REGISTER_API(GetExitCode);
9286 JIM_REGISTER_API(SetStdin);
9287 JIM_REGISTER_API(SetStdout);
9288 JIM_REGISTER_API(SetStderr);
9289 JIM_REGISTER_API(CreateCommand);
9290 JIM_REGISTER_API(CreateProcedure);
9291 JIM_REGISTER_API(DeleteCommand);
9292 JIM_REGISTER_API(RenameCommand);
9293 JIM_REGISTER_API(GetCommand);
9294 JIM_REGISTER_API(SetVariable);
9295 JIM_REGISTER_API(SetVariableStr);
9296 JIM_REGISTER_API(SetGlobalVariableStr);
9297 JIM_REGISTER_API(SetVariableStrWithStr);
9298 JIM_REGISTER_API(SetVariableLink);
9299 JIM_REGISTER_API(GetVariable);
9300 JIM_REGISTER_API(GetCallFrameByLevel);
9301 JIM_REGISTER_API(Collect);
9302 JIM_REGISTER_API(CollectIfNeeded);
9303 JIM_REGISTER_API(GetIndex);
9304 JIM_REGISTER_API(NewListObj);
9305 JIM_REGISTER_API(ListAppendElement);
9306 JIM_REGISTER_API(ListAppendList);
9307 JIM_REGISTER_API(ListLength);
9308 JIM_REGISTER_API(ListIndex);
9309 JIM_REGISTER_API(SetListIndex);
9310 JIM_REGISTER_API(ConcatObj);
9311 JIM_REGISTER_API(NewDictObj);
9312 JIM_REGISTER_API(DictKey);
9313 JIM_REGISTER_API(DictKeysVector);
9314 JIM_REGISTER_API(GetIndex);
9315 JIM_REGISTER_API(GetReturnCode);
9316 JIM_REGISTER_API(EvalExpression);
9317 JIM_REGISTER_API(GetBoolFromExpr);
9318 JIM_REGISTER_API(GetWide);
9319 JIM_REGISTER_API(GetLong);
9320 JIM_REGISTER_API(SetWide);
9321 JIM_REGISTER_API(NewIntObj);
9322 JIM_REGISTER_API(GetDouble);
9323 JIM_REGISTER_API(SetDouble);
9324 JIM_REGISTER_API(NewDoubleObj);
9325 JIM_REGISTER_API(WrongNumArgs);
9326 JIM_REGISTER_API(SetDictKeysVector);
9327 JIM_REGISTER_API(SubstObj);
9328 JIM_REGISTER_API(RegisterApi);
9329 JIM_REGISTER_API(PrintErrorMessage);
9330 JIM_REGISTER_API(InteractivePrompt);
9331 JIM_REGISTER_API(RegisterCoreCommands);
9332 JIM_REGISTER_API(GetSharedString);
9333 JIM_REGISTER_API(ReleaseSharedString);
9334 JIM_REGISTER_API(Panic);
9335 JIM_REGISTER_API(StrDup);
9336 JIM_REGISTER_API(UnsetVariable);
9337 JIM_REGISTER_API(GetVariableStr);
9338 JIM_REGISTER_API(GetGlobalVariable);
9339 JIM_REGISTER_API(GetGlobalVariableStr);
9340 JIM_REGISTER_API(GetAssocData);
9341 JIM_REGISTER_API(SetAssocData);
9342 JIM_REGISTER_API(DeleteAssocData);
9343 JIM_REGISTER_API(GetEnum);
9344 JIM_REGISTER_API(ScriptIsComplete);
9345 JIM_REGISTER_API(PackageRequire);
9346 JIM_REGISTER_API(PackageProvide);
9347 JIM_REGISTER_API(InitStack);
9348 JIM_REGISTER_API(FreeStack);
9349 JIM_REGISTER_API(StackLen);
9350 JIM_REGISTER_API(StackPush);
9351 JIM_REGISTER_API(StackPop);
9352 JIM_REGISTER_API(StackPeek);
9353 JIM_REGISTER_API(FreeStackElements);
9354 JIM_REGISTER_API(fprintf );
9355 JIM_REGISTER_API(vfprintf );
9356 JIM_REGISTER_API(fwrite );
9357 JIM_REGISTER_API(fread );
9358 JIM_REGISTER_API(fflush );
9359 JIM_REGISTER_API(fgets );
9360 JIM_REGISTER_API(GetNvp);
9361 JIM_REGISTER_API(Nvp_name2value);
9362 JIM_REGISTER_API(Nvp_name2value_simple);
9363 JIM_REGISTER_API(Nvp_name2value_obj);
9364 JIM_REGISTER_API(Nvp_name2value_nocase);
9365 JIM_REGISTER_API(Nvp_name2value_obj_nocase);
9366
9367 JIM_REGISTER_API(Nvp_value2name);
9368 JIM_REGISTER_API(Nvp_value2name_simple);
9369 JIM_REGISTER_API(Nvp_value2name_obj);
9370
9371 JIM_REGISTER_API(GetOpt_Setup);
9372 JIM_REGISTER_API(GetOpt_Debug);
9373 JIM_REGISTER_API(GetOpt_Obj);
9374 JIM_REGISTER_API(GetOpt_String);
9375 JIM_REGISTER_API(GetOpt_Double);
9376 JIM_REGISTER_API(GetOpt_Wide);
9377 JIM_REGISTER_API(GetOpt_Nvp);
9378 JIM_REGISTER_API(GetOpt_NvpUnknown);
9379 JIM_REGISTER_API(GetOpt_Enum);
9380
9381 JIM_REGISTER_API(Debug_ArgvString);
9382 JIM_REGISTER_API(SetResult_sprintf);
9383 JIM_REGISTER_API(SetResult_NvpUnknown);
9384
9385 }
9386
9387 /* -----------------------------------------------------------------------------
9388 * Core commands utility functions
9389 * ---------------------------------------------------------------------------*/
9390 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv,
9391 const char *msg)
9392 {
9393 int i;
9394 Jim_Obj *objPtr = Jim_NewEmptyStringObj(interp);
9395
9396 Jim_AppendString(interp, objPtr, "wrong # args: should be \"", -1);
9397 for (i = 0; i < argc; i++) {
9398 Jim_AppendObj(interp, objPtr, argv[i]);
9399 if (!(i+1 == argc && msg[0] == '\0'))
9400 Jim_AppendString(interp, objPtr, " ", 1);
9401 }
9402 Jim_AppendString(interp, objPtr, msg, -1);
9403 Jim_AppendString(interp, objPtr, "\"", 1);
9404 Jim_SetResult(interp, objPtr);
9405 }
9406
9407 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr)
9408 {
9409 Jim_HashTableIterator *htiter;
9410 Jim_HashEntry *he;
9411 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
9412 const char *pattern;
9413 int patternLen;
9414
9415 pattern = patternObjPtr ? Jim_GetString(patternObjPtr, &patternLen) : NULL;
9416 htiter = Jim_GetHashTableIterator(&interp->commands);
9417 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
9418 if (pattern && !JimStringMatch(pattern, patternLen, he->key,
9419 strlen((const char*)he->key), 0))
9420 continue;
9421 Jim_ListAppendElement(interp, listObjPtr,
9422 Jim_NewStringObj(interp, he->key, -1));
9423 }
9424 Jim_FreeHashTableIterator(htiter);
9425 return listObjPtr;
9426 }
9427
9428 #define JIM_VARLIST_GLOBALS 0
9429 #define JIM_VARLIST_LOCALS 1
9430 #define JIM_VARLIST_VARS 2
9431
9432 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr,
9433 int mode)
9434 {
9435 Jim_HashTableIterator *htiter;
9436 Jim_HashEntry *he;
9437 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
9438 const char *pattern;
9439 int patternLen;
9440
9441 pattern = patternObjPtr ? Jim_GetString(patternObjPtr, &patternLen) : NULL;
9442 if (mode == JIM_VARLIST_GLOBALS) {
9443 htiter = Jim_GetHashTableIterator(&interp->topFramePtr->vars);
9444 } else {
9445 /* For [info locals], if we are at top level an emtpy list
9446 * is returned. I don't agree, but we aim at compatibility (SS) */
9447 if (mode == JIM_VARLIST_LOCALS &&
9448 interp->framePtr == interp->topFramePtr)
9449 return listObjPtr;
9450 htiter = Jim_GetHashTableIterator(&interp->framePtr->vars);
9451 }
9452 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
9453 Jim_Var *varPtr = (Jim_Var*) he->val;
9454 if (mode == JIM_VARLIST_LOCALS) {
9455 if (varPtr->linkFramePtr != NULL)
9456 continue;
9457 }
9458 if (pattern && !JimStringMatch(pattern, patternLen, he->key,
9459 strlen((const char*)he->key), 0))
9460 continue;
9461 Jim_ListAppendElement(interp, listObjPtr,
9462 Jim_NewStringObj(interp, he->key, -1));
9463 }
9464 Jim_FreeHashTableIterator(htiter);
9465 return listObjPtr;
9466 }
9467
9468 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
9469 Jim_Obj **objPtrPtr)
9470 {
9471 Jim_CallFrame *targetCallFrame;
9472
9473 if (JimGetCallFrameByInteger(interp, levelObjPtr, &targetCallFrame)
9474 != JIM_OK)
9475 return JIM_ERR;
9476 /* No proc call at toplevel callframe */
9477 if (targetCallFrame == interp->topFramePtr) {
9478 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
9479 Jim_AppendStrings(interp, Jim_GetResult(interp),
9480 "bad level \"",
9481 Jim_GetString(levelObjPtr, NULL), "\"", NULL);
9482 return JIM_ERR;
9483 }
9484 *objPtrPtr = Jim_NewListObj(interp,
9485 targetCallFrame->argv,
9486 targetCallFrame->argc);
9487 return JIM_OK;
9488 }
9489
9490 /* -----------------------------------------------------------------------------
9491 * Core commands
9492 * ---------------------------------------------------------------------------*/
9493
9494 /* fake [puts] -- not the real puts, just for debugging. */
9495 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc,
9496 Jim_Obj *const *argv)
9497 {
9498 const char *str;
9499 int len, nonewline = 0;
9500
9501 if (argc != 2 && argc != 3) {
9502 Jim_WrongNumArgs(interp, 1, argv, "-nonewline string");
9503 return JIM_ERR;
9504 }
9505 if (argc == 3) {
9506 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline"))
9507 {
9508 Jim_SetResultString(interp, "The second argument must "
9509 "be -nonewline", -1);
9510 return JIM_OK;
9511 } else {
9512 nonewline = 1;
9513 argv++;
9514 }
9515 }
9516 str = Jim_GetString(argv[1], &len);
9517 Jim_fwrite(interp, str, 1, len, interp->cookie_stdout);
9518 if (!nonewline) Jim_fprintf( interp, interp->cookie_stdout, JIM_NL);
9519 return JIM_OK;
9520 }
9521
9522 /* Helper for [+] and [*] */
9523 static int Jim_AddMulHelper(Jim_Interp *interp, int argc,
9524 Jim_Obj *const *argv, int op)
9525 {
9526 jim_wide wideValue, res;
9527 double doubleValue, doubleRes;
9528 int i;
9529
9530 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
9531
9532 for (i = 1; i < argc; i++) {
9533 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
9534 goto trydouble;
9535 if (op == JIM_EXPROP_ADD)
9536 res += wideValue;
9537 else
9538 res *= wideValue;
9539 }
9540 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9541 return JIM_OK;
9542 trydouble:
9543 doubleRes = (double) res;
9544 for (;i < argc; i++) {
9545 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
9546 return JIM_ERR;
9547 if (op == JIM_EXPROP_ADD)
9548 doubleRes += doubleValue;
9549 else
9550 doubleRes *= doubleValue;
9551 }
9552 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
9553 return JIM_OK;
9554 }
9555
9556 /* Helper for [-] and [/] */
9557 static int Jim_SubDivHelper(Jim_Interp *interp, int argc,
9558 Jim_Obj *const *argv, int op)
9559 {
9560 jim_wide wideValue, res = 0;
9561 double doubleValue, doubleRes = 0;
9562 int i = 2;
9563
9564 if (argc < 2) {
9565 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
9566 return JIM_ERR;
9567 } else if (argc == 2) {
9568 /* The arity = 2 case is different. For [- x] returns -x,
9569 * while [/ x] returns 1/x. */
9570 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
9571 if (Jim_GetDouble(interp, argv[1], &doubleValue) !=
9572 JIM_OK)
9573 {
9574 return JIM_ERR;
9575 } else {
9576 if (op == JIM_EXPROP_SUB)
9577 doubleRes = -doubleValue;
9578 else
9579 doubleRes = 1.0/doubleValue;
9580 Jim_SetResult(interp, Jim_NewDoubleObj(interp,
9581 doubleRes));
9582 return JIM_OK;
9583 }
9584 }
9585 if (op == JIM_EXPROP_SUB) {
9586 res = -wideValue;
9587 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9588 } else {
9589 doubleRes = 1.0/wideValue;
9590 Jim_SetResult(interp, Jim_NewDoubleObj(interp,
9591 doubleRes));
9592 }
9593 return JIM_OK;
9594 } else {
9595 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
9596 if (Jim_GetDouble(interp, argv[1], &doubleRes)
9597 != JIM_OK) {
9598 return JIM_ERR;
9599 } else {
9600 goto trydouble;
9601 }
9602 }
9603 }
9604 for (i = 2; i < argc; i++) {
9605 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
9606 doubleRes = (double) res;
9607 goto trydouble;
9608 }
9609 if (op == JIM_EXPROP_SUB)
9610 res -= wideValue;
9611 else
9612 res /= wideValue;
9613 }
9614 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9615 return JIM_OK;
9616 trydouble:
9617 for (;i < argc; i++) {
9618 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
9619 return JIM_ERR;
9620 if (op == JIM_EXPROP_SUB)
9621 doubleRes -= doubleValue;
9622 else
9623 doubleRes /= doubleValue;
9624 }
9625 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
9626 return JIM_OK;
9627 }
9628
9629
9630 /* [+] */
9631 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc,
9632 Jim_Obj *const *argv)
9633 {
9634 return Jim_AddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
9635 }
9636
9637 /* [*] */
9638 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc,
9639 Jim_Obj *const *argv)
9640 {
9641 return Jim_AddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
9642 }
9643
9644 /* [-] */
9645 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc,
9646 Jim_Obj *const *argv)
9647 {
9648 return Jim_SubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
9649 }
9650
9651 /* [/] */
9652 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc,
9653 Jim_Obj *const *argv)
9654 {
9655 return Jim_SubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
9656 }
9657
9658 /* [set] */
9659 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc,
9660 Jim_Obj *const *argv)
9661 {
9662 if (argc != 2 && argc != 3) {
9663 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
9664 return JIM_ERR;
9665 }
9666 if (argc == 2) {
9667 Jim_Obj *objPtr;
9668 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
9669 if (!objPtr)
9670 return JIM_ERR;
9671 Jim_SetResult(interp, objPtr);
9672 return JIM_OK;
9673 }
9674 /* argc == 3 case. */
9675 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
9676 return JIM_ERR;
9677 Jim_SetResult(interp, argv[2]);
9678 return JIM_OK;
9679 }
9680
9681 /* [unset] */
9682 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc,
9683 Jim_Obj *const *argv)
9684 {
9685 int i;
9686
9687 if (argc < 2) {
9688 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
9689 return JIM_ERR;
9690 }
9691 for (i = 1; i < argc; i++) {
9692 if (Jim_UnsetVariable(interp, argv[i], JIM_ERRMSG) != JIM_OK)
9693 return JIM_ERR;
9694 }
9695 return JIM_OK;
9696 }
9697
9698 /* [incr] */
9699 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc,
9700 Jim_Obj *const *argv)
9701 {
9702 jim_wide wideValue, increment = 1;
9703 Jim_Obj *intObjPtr;
9704
9705 if (argc != 2 && argc != 3) {
9706 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
9707 return JIM_ERR;
9708 }
9709 if (argc == 3) {
9710 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
9711 return JIM_ERR;
9712 }
9713 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
9714 if (!intObjPtr) return JIM_ERR;
9715 if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK)
9716 return JIM_ERR;
9717 if (Jim_IsShared(intObjPtr)) {
9718 intObjPtr = Jim_NewIntObj(interp, wideValue+increment);
9719 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
9720 Jim_FreeNewObj(interp, intObjPtr);
9721 return JIM_ERR;
9722 }
9723 } else {
9724 Jim_SetWide(interp, intObjPtr, wideValue+increment);
9725 /* The following step is required in order to invalidate the
9726 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
9727 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
9728 return JIM_ERR;
9729 }
9730 }
9731 Jim_SetResult(interp, intObjPtr);
9732 return JIM_OK;
9733 }
9734
9735 /* [while] */
9736 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc,
9737 Jim_Obj *const *argv)
9738 {
9739 if (argc != 3) {
9740 Jim_WrongNumArgs(interp, 1, argv, "condition body");
9741 return JIM_ERR;
9742 }
9743 /* Try to run a specialized version of while if the expression
9744 * is in one of the following forms:
9745 *
9746 * $a < CONST, $a < $b
9747 * $a <= CONST, $a <= $b
9748 * $a > CONST, $a > $b
9749 * $a >= CONST, $a >= $b
9750 * $a != CONST, $a != $b
9751 * $a == CONST, $a == $b
9752 * $a
9753 * !$a
9754 * CONST
9755 */
9756
9757 #ifdef JIM_OPTIMIZATION
9758 {
9759 ExprByteCode *expr;
9760 Jim_Obj *varAObjPtr = NULL, *varBObjPtr = NULL, *objPtr;
9761 int exprLen, retval;
9762
9763 /* STEP 1 -- Check if there are the conditions to run the specialized
9764 * version of while */
9765
9766 if ((expr = Jim_GetExpression(interp, argv[1])) == NULL) goto noopt;
9767 if (expr->len <= 0 || expr->len > 3) goto noopt;
9768 switch(expr->len) {
9769 case 1:
9770 if (expr->opcode[0] != JIM_EXPROP_VARIABLE &&
9771 expr->opcode[0] != JIM_EXPROP_NUMBER)
9772 goto noopt;
9773 break;
9774 case 2:
9775 if (expr->opcode[1] != JIM_EXPROP_NOT ||
9776 expr->opcode[0] != JIM_EXPROP_VARIABLE)
9777 goto noopt;
9778 break;
9779 case 3:
9780 if (expr->opcode[0] != JIM_EXPROP_VARIABLE ||
9781 (expr->opcode[1] != JIM_EXPROP_NUMBER &&
9782 expr->opcode[1] != JIM_EXPROP_VARIABLE))
9783 goto noopt;
9784 switch(expr->opcode[2]) {
9785 case JIM_EXPROP_LT:
9786 case JIM_EXPROP_LTE:
9787 case JIM_EXPROP_GT:
9788 case JIM_EXPROP_GTE:
9789 case JIM_EXPROP_NUMEQ:
9790 case JIM_EXPROP_NUMNE:
9791 /* nothing to do */
9792 break;
9793 default:
9794 goto noopt;
9795 }
9796 break;
9797 default:
9798 Jim_Panic(interp,
9799 "Unexpected default reached in Jim_WhileCoreCommand()");
9800 break;
9801 }
9802
9803 /* STEP 2 -- conditions meet. Initialization. Take different
9804 * branches for different expression lengths. */
9805 exprLen = expr->len;
9806
9807 if (exprLen == 1) {
9808 jim_wide wideValue;
9809
9810 if (expr->opcode[0] == JIM_EXPROP_VARIABLE) {
9811 varAObjPtr = expr->obj[0];
9812 Jim_IncrRefCount(varAObjPtr);
9813 } else {
9814 if (Jim_GetWide(interp, expr->obj[0], &wideValue) != JIM_OK)
9815 goto noopt;
9816 }
9817 while (1) {
9818 if (varAObjPtr) {
9819 if (!(objPtr =
9820 Jim_GetVariable(interp, varAObjPtr, JIM_NONE)) ||
9821 Jim_GetWide(interp, objPtr, &wideValue) != JIM_OK)
9822 {
9823 Jim_DecrRefCount(interp, varAObjPtr);
9824 goto noopt;
9825 }
9826 }
9827 if (!wideValue) break;
9828 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9829 switch(retval) {
9830 case JIM_BREAK:
9831 if (varAObjPtr)
9832 Jim_DecrRefCount(interp, varAObjPtr);
9833 goto out;
9834 break;
9835 case JIM_CONTINUE:
9836 continue;
9837 break;
9838 default:
9839 if (varAObjPtr)
9840 Jim_DecrRefCount(interp, varAObjPtr);
9841 return retval;
9842 }
9843 }
9844 }
9845 if (varAObjPtr)
9846 Jim_DecrRefCount(interp, varAObjPtr);
9847 } else if (exprLen == 3) {
9848 jim_wide wideValueA, wideValueB, cmpRes = 0;
9849 int cmpType = expr->opcode[2];
9850
9851 varAObjPtr = expr->obj[0];
9852 Jim_IncrRefCount(varAObjPtr);
9853 if (expr->opcode[1] == JIM_EXPROP_VARIABLE) {
9854 varBObjPtr = expr->obj[1];
9855 Jim_IncrRefCount(varBObjPtr);
9856 } else {
9857 if (Jim_GetWide(interp, expr->obj[1], &wideValueB) != JIM_OK)
9858 goto noopt;
9859 }
9860 while (1) {
9861 if (!(objPtr = Jim_GetVariable(interp, varAObjPtr, JIM_NONE)) ||
9862 Jim_GetWide(interp, objPtr, &wideValueA) != JIM_OK)
9863 {
9864 Jim_DecrRefCount(interp, varAObjPtr);
9865 if (varBObjPtr)
9866 Jim_DecrRefCount(interp, varBObjPtr);
9867 goto noopt;
9868 }
9869 if (varBObjPtr) {
9870 if (!(objPtr =
9871 Jim_GetVariable(interp, varBObjPtr, JIM_NONE)) ||
9872 Jim_GetWide(interp, objPtr, &wideValueB) != JIM_OK)
9873 {
9874 Jim_DecrRefCount(interp, varAObjPtr);
9875 if (varBObjPtr)
9876 Jim_DecrRefCount(interp, varBObjPtr);
9877 goto noopt;
9878 }
9879 }
9880 switch(cmpType) {
9881 case JIM_EXPROP_LT:
9882 cmpRes = wideValueA < wideValueB; break;
9883 case JIM_EXPROP_LTE:
9884 cmpRes = wideValueA <= wideValueB; break;
9885 case JIM_EXPROP_GT:
9886 cmpRes = wideValueA > wideValueB; break;
9887 case JIM_EXPROP_GTE:
9888 cmpRes = wideValueA >= wideValueB; break;
9889 case JIM_EXPROP_NUMEQ:
9890 cmpRes = wideValueA == wideValueB; break;
9891 case JIM_EXPROP_NUMNE:
9892 cmpRes = wideValueA != wideValueB; break;
9893 }
9894 if (!cmpRes) break;
9895 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9896 switch(retval) {
9897 case JIM_BREAK:
9898 Jim_DecrRefCount(interp, varAObjPtr);
9899 if (varBObjPtr)
9900 Jim_DecrRefCount(interp, varBObjPtr);
9901 goto out;
9902 break;
9903 case JIM_CONTINUE:
9904 continue;
9905 break;
9906 default:
9907 Jim_DecrRefCount(interp, varAObjPtr);
9908 if (varBObjPtr)
9909 Jim_DecrRefCount(interp, varBObjPtr);
9910 return retval;
9911 }
9912 }
9913 }
9914 Jim_DecrRefCount(interp, varAObjPtr);
9915 if (varBObjPtr)
9916 Jim_DecrRefCount(interp, varBObjPtr);
9917 } else {
9918 /* TODO: case for len == 2 */
9919 goto noopt;
9920 }
9921 Jim_SetEmptyResult(interp);
9922 return JIM_OK;
9923 }
9924 noopt:
9925 #endif
9926
9927 /* The general purpose implementation of while starts here */
9928 while (1) {
9929 int boolean, retval;
9930
9931 if ((retval = Jim_GetBoolFromExpr(interp, argv[1],
9932 &boolean)) != JIM_OK)
9933 return retval;
9934 if (!boolean) break;
9935 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9936 switch(retval) {
9937 case JIM_BREAK:
9938 goto out;
9939 break;
9940 case JIM_CONTINUE:
9941 continue;
9942 break;
9943 default:
9944 return retval;
9945 }
9946 }
9947 }
9948 out:
9949 Jim_SetEmptyResult(interp);
9950 return JIM_OK;
9951 }
9952
9953 /* [for] */
9954 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc,
9955 Jim_Obj *const *argv)
9956 {
9957 int retval;
9958
9959 if (argc != 5) {
9960 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
9961 return JIM_ERR;
9962 }
9963 /* Check if the for is on the form:
9964 * for {set i CONST} {$i < CONST} {incr i}
9965 * for {set i CONST} {$i < $j} {incr i}
9966 * for {set i CONST} {$i <= CONST} {incr i}
9967 * for {set i CONST} {$i <= $j} {incr i}
9968 * XXX: NOTE: if variable traces are implemented, this optimization
9969 * need to be modified to check for the proc epoch at every variable
9970 * update. */
9971 #ifdef JIM_OPTIMIZATION
9972 {
9973 ScriptObj *initScript, *incrScript;
9974 ExprByteCode *expr;
9975 jim_wide start, stop, currentVal;
9976 unsigned jim_wide procEpoch = interp->procEpoch;
9977 Jim_Obj *varNamePtr, *stopVarNamePtr = NULL, *objPtr;
9978 int cmpType;
9979 struct Jim_Cmd *cmdPtr;
9980
9981 /* Do it only if there aren't shared arguments */
9982 if (argv[1] == argv[2] || argv[2] == argv[3] || argv[1] == argv[3])
9983 goto evalstart;
9984 initScript = Jim_GetScript(interp, argv[1]);
9985 expr = Jim_GetExpression(interp, argv[2]);
9986 incrScript = Jim_GetScript(interp, argv[3]);
9987
9988 /* Ensure proper lengths to start */
9989 if (initScript->len != 6) goto evalstart;
9990 if (incrScript->len != 4) goto evalstart;
9991 if (expr->len != 3) goto evalstart;
9992 /* Ensure proper token types. */
9993 if (initScript->token[2].type != JIM_TT_ESC ||
9994 initScript->token[4].type != JIM_TT_ESC ||
9995 incrScript->token[2].type != JIM_TT_ESC ||
9996 expr->opcode[0] != JIM_EXPROP_VARIABLE ||
9997 (expr->opcode[1] != JIM_EXPROP_NUMBER &&
9998 expr->opcode[1] != JIM_EXPROP_VARIABLE) ||
9999 (expr->opcode[2] != JIM_EXPROP_LT &&
10000 expr->opcode[2] != JIM_EXPROP_LTE))
10001 goto evalstart;
10002 cmpType = expr->opcode[2];
10003 /* Initialization command must be [set] */
10004 cmdPtr = Jim_GetCommand(interp, initScript->token[0].objPtr, JIM_NONE);
10005 if (cmdPtr == NULL || cmdPtr->cmdProc != Jim_SetCoreCommand)
10006 goto evalstart;
10007 /* Update command must be incr */
10008 cmdPtr = Jim_GetCommand(interp, incrScript->token[0].objPtr, JIM_NONE);
10009 if (cmdPtr == NULL || cmdPtr->cmdProc != Jim_IncrCoreCommand)
10010 goto evalstart;
10011 /* set, incr, expression must be about the same variable */
10012 if (!Jim_StringEqObj(initScript->token[2].objPtr,
10013 incrScript->token[2].objPtr, 0))
10014 goto evalstart;
10015 if (!Jim_StringEqObj(initScript->token[2].objPtr,
10016 expr->obj[0], 0))
10017 goto evalstart;
10018 /* Check that the initialization and comparison are valid integers */
10019 if (Jim_GetWide(interp, initScript->token[4].objPtr, &start) == JIM_ERR)
10020 goto evalstart;
10021 if (expr->opcode[1] == JIM_EXPROP_NUMBER &&
10022 Jim_GetWide(interp, expr->obj[1], &stop) == JIM_ERR)
10023 {
10024 goto evalstart;
10025 }
10026
10027 /* Initialization */
10028 varNamePtr = expr->obj[0];
10029 if (expr->opcode[1] == JIM_EXPROP_VARIABLE) {
10030 stopVarNamePtr = expr->obj[1];
10031 Jim_IncrRefCount(stopVarNamePtr);
10032 }
10033 Jim_IncrRefCount(varNamePtr);
10034
10035 /* --- OPTIMIZED FOR --- */
10036 /* Start to loop */
10037 objPtr = Jim_NewIntObj(interp, start);
10038 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
10039 Jim_DecrRefCount(interp, varNamePtr);
10040 if (stopVarNamePtr) Jim_DecrRefCount(interp, stopVarNamePtr);
10041 Jim_FreeNewObj(interp, objPtr);
10042 goto evalstart;
10043 }
10044 while (1) {
10045 /* === Check condition === */
10046 /* Common code: */
10047 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
10048 if (objPtr == NULL ||
10049 Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK)
10050 {
10051 Jim_DecrRefCount(interp, varNamePtr);
10052 if (stopVarNamePtr) Jim_DecrRefCount(interp, stopVarNamePtr);
10053 goto testcond;
10054 }
10055 /* Immediate or Variable? get the 'stop' value if the latter. */
10056 if (stopVarNamePtr) {
10057 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
10058 if (objPtr == NULL ||
10059 Jim_GetWide(interp, objPtr, &stop) != JIM_OK)
10060 {
10061 Jim_DecrRefCount(interp, varNamePtr);
10062 Jim_DecrRefCount(interp, stopVarNamePtr);
10063 goto testcond;
10064 }
10065 }
10066 if (cmpType == JIM_EXPROP_LT) {
10067 if (currentVal >= stop) break;
10068 } else {
10069 if (currentVal > stop) break;
10070 }
10071 /* Eval body */
10072 if ((retval = Jim_EvalObj(interp, argv[4])) != JIM_OK) {
10073 switch(retval) {
10074 case JIM_BREAK:
10075 if (stopVarNamePtr)
10076 Jim_DecrRefCount(interp, stopVarNamePtr);
10077 Jim_DecrRefCount(interp, varNamePtr);
10078 goto out;
10079 case JIM_CONTINUE:
10080 /* nothing to do */
10081 break;
10082 default:
10083 if (stopVarNamePtr)
10084 Jim_DecrRefCount(interp, stopVarNamePtr);
10085 Jim_DecrRefCount(interp, varNamePtr);
10086 return retval;
10087 }
10088 }
10089 /* If there was a change in procedures/command continue
10090 * with the usual [for] command implementation */
10091 if (procEpoch != interp->procEpoch) {
10092 if (stopVarNamePtr)
10093 Jim_DecrRefCount(interp, stopVarNamePtr);
10094 Jim_DecrRefCount(interp, varNamePtr);
10095 goto evalnext;
10096 }
10097 /* Increment */
10098 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
10099 if (objPtr->refCount == 1 && objPtr->typePtr == &intObjType) {
10100 objPtr->internalRep.wideValue ++;
10101 Jim_InvalidateStringRep(objPtr);
10102 } else {
10103 Jim_Obj *auxObjPtr;
10104
10105 if (Jim_GetWide(interp, objPtr, &currentVal) == JIM_ERR) {
10106 if (stopVarNamePtr)
10107 Jim_DecrRefCount(interp, stopVarNamePtr);
10108 Jim_DecrRefCount(interp, varNamePtr);
10109 goto evalnext;
10110 }
10111 auxObjPtr = Jim_NewIntObj(interp, currentVal+1);
10112 if (Jim_SetVariable(interp, varNamePtr, auxObjPtr) == JIM_ERR) {
10113 if (stopVarNamePtr)
10114 Jim_DecrRefCount(interp, stopVarNamePtr);
10115 Jim_DecrRefCount(interp, varNamePtr);
10116 Jim_FreeNewObj(interp, auxObjPtr);
10117 goto evalnext;
10118 }
10119 }
10120 }
10121 if (stopVarNamePtr)
10122 Jim_DecrRefCount(interp, stopVarNamePtr);
10123 Jim_DecrRefCount(interp, varNamePtr);
10124 Jim_SetEmptyResult(interp);
10125 return JIM_OK;
10126 }
10127 #endif
10128 evalstart:
10129 /* Eval start */
10130 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK)
10131 return retval;
10132 while (1) {
10133 int boolean;
10134 testcond:
10135 /* Test the condition */
10136 if ((retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean))
10137 != JIM_OK)
10138 return retval;
10139 if (!boolean) break;
10140 /* Eval body */
10141 if ((retval = Jim_EvalObj(interp, argv[4])) != JIM_OK) {
10142 switch(retval) {
10143 case JIM_BREAK:
10144 goto out;
10145 break;
10146 case JIM_CONTINUE:
10147 /* Nothing to do */
10148 break;
10149 default:
10150 return retval;
10151 }
10152 }
10153 evalnext:
10154 /* Eval next */
10155 if ((retval = Jim_EvalObj(interp, argv[3])) != JIM_OK) {
10156 switch(retval) {
10157 case JIM_BREAK:
10158 goto out;
10159 break;
10160 case JIM_CONTINUE:
10161 continue;
10162 break;
10163 default:
10164 return retval;
10165 }
10166 }
10167 }
10168 out:
10169 Jim_SetEmptyResult(interp);
10170 return JIM_OK;
10171 }
10172
10173 /* foreach + lmap implementation. */
10174 static int JimForeachMapHelper(Jim_Interp *interp, int argc,
10175 Jim_Obj *const *argv, int doMap)
10176 {
10177 int result = JIM_ERR, i, nbrOfLists, *listsIdx, *listsEnd;
10178 int nbrOfLoops = 0;
10179 Jim_Obj *emptyStr, *script, *mapRes = NULL;
10180
10181 if (argc < 4 || argc % 2 != 0) {
10182 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
10183 return JIM_ERR;
10184 }
10185 if (doMap) {
10186 mapRes = Jim_NewListObj(interp, NULL, 0);
10187 Jim_IncrRefCount(mapRes);
10188 }
10189 emptyStr = Jim_NewEmptyStringObj(interp);
10190 Jim_IncrRefCount(emptyStr);
10191 script = argv[argc-1]; /* Last argument is a script */
10192 nbrOfLists = (argc - 1 - 1) / 2; /* argc - 'foreach' - script */
10193 listsIdx = (int*)Jim_Alloc(nbrOfLists * sizeof(int));
10194 listsEnd = (int*)Jim_Alloc(nbrOfLists*2 * sizeof(int));
10195 /* Initialize iterators and remember max nbr elements each list */
10196 memset(listsIdx, 0, nbrOfLists * sizeof(int));
10197 /* Remember lengths of all lists and calculate how much rounds to loop */
10198 for (i=0; i < nbrOfLists*2; i += 2) {
10199 div_t cnt;
10200 int count;
10201 Jim_ListLength(interp, argv[i+1], &listsEnd[i]);
10202 Jim_ListLength(interp, argv[i+2], &listsEnd[i+1]);
10203 if (listsEnd[i] == 0) {
10204 Jim_SetResultString(interp, "foreach varlist is empty", -1);
10205 goto err;
10206 }
10207 cnt = div(listsEnd[i+1], listsEnd[i]);
10208 count = cnt.quot + (cnt.rem ? 1 : 0);
10209 if (count > nbrOfLoops)
10210 nbrOfLoops = count;
10211 }
10212 for (; nbrOfLoops-- > 0; ) {
10213 for (i=0; i < nbrOfLists; ++i) {
10214 int varIdx = 0, var = i * 2;
10215 while (varIdx < listsEnd[var]) {
10216 Jim_Obj *varName, *ele;
10217 int lst = i * 2 + 1;
10218 if (Jim_ListIndex(interp, argv[var+1], varIdx, &varName, JIM_ERRMSG)
10219 != JIM_OK)
10220 goto err;
10221 if (listsIdx[i] < listsEnd[lst]) {
10222 if (Jim_ListIndex(interp, argv[lst+1], listsIdx[i], &ele, JIM_ERRMSG)
10223 != JIM_OK)
10224 goto err;
10225 if (Jim_SetVariable(interp, varName, ele) != JIM_OK) {
10226 Jim_SetResultString(interp, "couldn't set loop variable: ", -1);
10227 goto err;
10228 }
10229 ++listsIdx[i]; /* Remember next iterator of current list */
10230 } else if (Jim_SetVariable(interp, varName, emptyStr) != JIM_OK) {
10231 Jim_SetResultString(interp, "couldn't set loop variable: ", -1);
10232 goto err;
10233 }
10234 ++varIdx; /* Next variable */
10235 }
10236 }
10237 switch (result = Jim_EvalObj(interp, script)) {
10238 case JIM_OK:
10239 if (doMap)
10240 Jim_ListAppendElement(interp, mapRes, interp->result);
10241 break;
10242 case JIM_CONTINUE:
10243 break;
10244 case JIM_BREAK:
10245 goto out;
10246 break;
10247 default:
10248 goto err;
10249 }
10250 }
10251 out:
10252 result = JIM_OK;
10253 if (doMap)
10254 Jim_SetResult(interp, mapRes);
10255 else
10256 Jim_SetEmptyResult(interp);
10257 err:
10258 if (doMap)
10259 Jim_DecrRefCount(interp, mapRes);
10260 Jim_DecrRefCount(interp, emptyStr);
10261 Jim_Free(listsIdx);
10262 Jim_Free(listsEnd);
10263 return result;
10264 }
10265
10266 /* [foreach] */
10267 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc,
10268 Jim_Obj *const *argv)
10269 {
10270 return JimForeachMapHelper(interp, argc, argv, 0);
10271 }
10272
10273 /* [lmap] */
10274 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc,
10275 Jim_Obj *const *argv)
10276 {
10277 return JimForeachMapHelper(interp, argc, argv, 1);
10278 }
10279
10280 /* [if] */
10281 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc,
10282 Jim_Obj *const *argv)
10283 {
10284 int boolean, retval, current = 1, falsebody = 0;
10285 if (argc >= 3) {
10286 while (1) {
10287 /* Far not enough arguments given! */
10288 if (current >= argc) goto err;
10289 if ((retval = Jim_GetBoolFromExpr(interp,
10290 argv[current++], &boolean))
10291 != JIM_OK)
10292 return retval;
10293 /* There lacks something, isn't it? */
10294 if (current >= argc) goto err;
10295 if (Jim_CompareStringImmediate(interp, argv[current],
10296 "then")) current++;
10297 /* Tsk tsk, no then-clause? */
10298 if (current >= argc) goto err;
10299 if (boolean)
10300 return Jim_EvalObj(interp, argv[current]);
10301 /* Ok: no else-clause follows */
10302 if (++current >= argc) {
10303 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10304 return JIM_OK;
10305 }
10306 falsebody = current++;
10307 if (Jim_CompareStringImmediate(interp, argv[falsebody],
10308 "else")) {
10309 /* IIICKS - else-clause isn't last cmd? */
10310 if (current != argc-1) goto err;
10311 return Jim_EvalObj(interp, argv[current]);
10312 } else if (Jim_CompareStringImmediate(interp,
10313 argv[falsebody], "elseif"))
10314 /* Ok: elseif follows meaning all the stuff
10315 * again (how boring...) */
10316 continue;
10317 /* OOPS - else-clause is not last cmd?*/
10318 else if (falsebody != argc-1)
10319 goto err;
10320 return Jim_EvalObj(interp, argv[falsebody]);
10321 }
10322 return JIM_OK;
10323 }
10324 err:
10325 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
10326 return JIM_ERR;
10327 }
10328
10329 enum {SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD, SWITCH_UNKNOWN};
10330
10331 /* [switch] */
10332 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc,
10333 Jim_Obj *const *argv)
10334 {
10335 int retcode = JIM_ERR, matchOpt = SWITCH_EXACT, opt=1, patCount, i;
10336 Jim_Obj *command = 0, *const *caseList = 0, *strObj;
10337 Jim_Obj *script = 0;
10338 if (argc < 3) goto wrongnumargs;
10339 for (opt=1; opt < argc; ++opt) {
10340 const char *option = Jim_GetString(argv[opt], 0);
10341 if (*option != '-') break;
10342 else if (strncmp(option, "--", 2) == 0) { ++opt; break; }
10343 else if (strncmp(option, "-exact", 2) == 0) matchOpt = SWITCH_EXACT;
10344 else if (strncmp(option, "-glob", 2) == 0) matchOpt = SWITCH_GLOB;
10345 else if (strncmp(option, "-regexp", 2) == 0) matchOpt = SWITCH_RE;
10346 else if (strncmp(option, "-command", 2) == 0) { matchOpt = SWITCH_CMD;
10347 if ((argc - opt) < 2) goto wrongnumargs;
10348 command = argv[++opt];
10349 } else {
10350 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10351 Jim_AppendStrings(interp, Jim_GetResult(interp),
10352 "bad option \"", option, "\": must be -exact, -glob, "
10353 "-regexp, -command procname or --", 0);
10354 goto err;
10355 }
10356 if ((argc - opt) < 2) goto wrongnumargs;
10357 }
10358 strObj = argv[opt++];
10359 patCount = argc - opt;
10360 if (patCount == 1) {
10361 Jim_Obj **vector;
10362 JimListGetElements(interp, argv[opt], &patCount, &vector);
10363 caseList = vector;
10364 } else
10365 caseList = &argv[opt];
10366 if (patCount == 0 || patCount % 2 != 0) goto wrongnumargs;
10367 for (i=0; script == 0 && i < patCount; i += 2) {
10368 Jim_Obj *patObj = caseList[i];
10369 if (!Jim_CompareStringImmediate(interp, patObj, "default")
10370 || i < (patCount-2)) {
10371 switch (matchOpt) {
10372 case SWITCH_EXACT:
10373 if (Jim_StringEqObj(strObj, patObj, 0))
10374 script = caseList[i+1];
10375 break;
10376 case SWITCH_GLOB:
10377 if (Jim_StringMatchObj(patObj, strObj, 0))
10378 script = caseList[i+1];
10379 break;
10380 case SWITCH_RE:
10381 command = Jim_NewStringObj(interp, "regexp", -1);
10382 /* Fall thru intentionally */
10383 case SWITCH_CMD: {
10384 Jim_Obj *parms[] = {command, patObj, strObj};
10385 int rc = Jim_EvalObjVector(interp, 3, parms);
10386 long matching;
10387 /* After the execution of a command we need to
10388 * make sure to reconvert the object into a list
10389 * again. Only for the single-list style [switch]. */
10390 if (argc-opt == 1) {
10391 Jim_Obj **vector;
10392 JimListGetElements(interp, argv[opt], &patCount,
10393 &vector);
10394 caseList = vector;
10395 }
10396 /* command is here already decref'd */
10397 if (rc != JIM_OK) {
10398 retcode = rc;
10399 goto err;
10400 }
10401 rc = Jim_GetLong(interp, Jim_GetResult(interp), &matching);
10402 if (rc != JIM_OK) {
10403 retcode = rc;
10404 goto err;
10405 }
10406 if (matching)
10407 script = caseList[i+1];
10408 break;
10409 }
10410 default:
10411 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10412 Jim_AppendStrings(interp, Jim_GetResult(interp),
10413 "internal error: no such option implemented", 0);
10414 goto err;
10415 }
10416 } else {
10417 script = caseList[i+1];
10418 }
10419 }
10420 for(; i < patCount && Jim_CompareStringImmediate(interp, script, "-");
10421 i += 2)
10422 script = caseList[i+1];
10423 if (script && Jim_CompareStringImmediate(interp, script, "-")) {
10424 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10425 Jim_AppendStrings(interp, Jim_GetResult(interp),
10426 "no body specified for pattern \"",
10427 Jim_GetString(caseList[i-2], 0), "\"", 0);
10428 goto err;
10429 }
10430 retcode = JIM_OK;
10431 Jim_SetEmptyResult(interp);
10432 if (script != 0)
10433 retcode = Jim_EvalObj(interp, script);
10434 return retcode;
10435 wrongnumargs:
10436 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
10437 "pattern body ... ?default body? or "
10438 "{pattern body ?pattern body ...?}");
10439 err:
10440 return retcode;
10441 }
10442
10443 /* [list] */
10444 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc,
10445 Jim_Obj *const *argv)
10446 {
10447 Jim_Obj *listObjPtr;
10448
10449 listObjPtr = Jim_NewListObj(interp, argv+1, argc-1);
10450 Jim_SetResult(interp, listObjPtr);
10451 return JIM_OK;
10452 }
10453
10454 /* [lindex] */
10455 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc,
10456 Jim_Obj *const *argv)
10457 {
10458 Jim_Obj *objPtr, *listObjPtr;
10459 int i;
10460 int index;
10461
10462 if (argc < 3) {
10463 Jim_WrongNumArgs(interp, 1, argv, "list index ?...?");
10464 return JIM_ERR;
10465 }
10466 objPtr = argv[1];
10467 Jim_IncrRefCount(objPtr);
10468 for (i = 2; i < argc; i++) {
10469 listObjPtr = objPtr;
10470 if (Jim_GetIndex(interp, argv[i], &index) != JIM_OK) {
10471 Jim_DecrRefCount(interp, listObjPtr);
10472 return JIM_ERR;
10473 }
10474 if (Jim_ListIndex(interp, listObjPtr, index, &objPtr,
10475 JIM_NONE) != JIM_OK) {
10476 /* Returns an empty object if the index
10477 * is out of range. */
10478 Jim_DecrRefCount(interp, listObjPtr);
10479 Jim_SetEmptyResult(interp);
10480 return JIM_OK;
10481 }
10482 Jim_IncrRefCount(objPtr);
10483 Jim_DecrRefCount(interp, listObjPtr);
10484 }
10485 Jim_SetResult(interp, objPtr);
10486 Jim_DecrRefCount(interp, objPtr);
10487 return JIM_OK;
10488 }
10489
10490 /* [llength] */
10491 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc,
10492 Jim_Obj *const *argv)
10493 {
10494 int len;
10495
10496 if (argc != 2) {
10497 Jim_WrongNumArgs(interp, 1, argv, "list");
10498 return JIM_ERR;
10499 }
10500 Jim_ListLength(interp, argv[1], &len);
10501 Jim_SetResult(interp, Jim_NewIntObj(interp, len));
10502 return JIM_OK;
10503 }
10504
10505 /* [lappend] */
10506 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc,
10507 Jim_Obj *const *argv)
10508 {
10509 Jim_Obj *listObjPtr;
10510 int shared, i;
10511
10512 if (argc < 2) {
10513 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
10514 return JIM_ERR;
10515 }
10516 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_NONE);
10517 if (!listObjPtr) {
10518 /* Create the list if it does not exists */
10519 listObjPtr = Jim_NewListObj(interp, NULL, 0);
10520 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
10521 Jim_FreeNewObj(interp, listObjPtr);
10522 return JIM_ERR;
10523 }
10524 }
10525 shared = Jim_IsShared(listObjPtr);
10526 if (shared)
10527 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
10528 for (i = 2; i < argc; i++)
10529 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
10530 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
10531 if (shared)
10532 Jim_FreeNewObj(interp, listObjPtr);
10533 return JIM_ERR;
10534 }
10535 Jim_SetResult(interp, listObjPtr);
10536 return JIM_OK;
10537 }
10538
10539 /* [linsert] */
10540 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc,
10541 Jim_Obj *const *argv)
10542 {
10543 int index, len;
10544 Jim_Obj *listPtr;
10545
10546 if (argc < 4) {
10547 Jim_WrongNumArgs(interp, 1, argv, "list index element "
10548 "?element ...?");
10549 return JIM_ERR;
10550 }
10551 listPtr = argv[1];
10552 if (Jim_IsShared(listPtr))
10553 listPtr = Jim_DuplicateObj(interp, listPtr);
10554 if (Jim_GetIndex(interp, argv[2], &index) != JIM_OK)
10555 goto err;
10556 Jim_ListLength(interp, listPtr, &len);
10557 if (index >= len)
10558 index = len;
10559 else if (index < 0)
10560 index = len + index + 1;
10561 Jim_ListInsertElements(interp, listPtr, index, argc-3, &argv[3]);
10562 Jim_SetResult(interp, listPtr);
10563 return JIM_OK;
10564 err:
10565 if (listPtr != argv[1]) {
10566 Jim_FreeNewObj(interp, listPtr);
10567 }
10568 return JIM_ERR;
10569 }
10570
10571 /* [lset] */
10572 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc,
10573 Jim_Obj *const *argv)
10574 {
10575 if (argc < 3) {
10576 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
10577 return JIM_ERR;
10578 } else if (argc == 3) {
10579 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
10580 return JIM_ERR;
10581 Jim_SetResult(interp, argv[2]);
10582 return JIM_OK;
10583 }
10584 if (Jim_SetListIndex(interp, argv[1], argv+2, argc-3, argv[argc-1])
10585 == JIM_ERR) return JIM_ERR;
10586 return JIM_OK;
10587 }
10588
10589 /* [lsort] */
10590 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
10591 {
10592 const char *options[] = {
10593 "-ascii", "-nocase", "-increasing", "-decreasing", NULL
10594 };
10595 enum {OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING};
10596 Jim_Obj *resObj;
10597 int i, lsortType = JIM_LSORT_ASCII; /* default sort type */
10598 int decreasing = 0;
10599
10600 if (argc < 2) {
10601 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
10602 return JIM_ERR;
10603 }
10604 for (i = 1; i < (argc-1); i++) {
10605 int option;
10606
10607 if (Jim_GetEnum(interp, argv[i], options, &option, "option", JIM_ERRMSG)
10608 != JIM_OK)
10609 return JIM_ERR;
10610 switch(option) {
10611 case OPT_ASCII: lsortType = JIM_LSORT_ASCII; break;
10612 case OPT_NOCASE: lsortType = JIM_LSORT_NOCASE; break;
10613 case OPT_INCREASING: decreasing = 0; break;
10614 case OPT_DECREASING: decreasing = 1; break;
10615 }
10616 }
10617 if (decreasing) {
10618 switch(lsortType) {
10619 case JIM_LSORT_ASCII: lsortType = JIM_LSORT_ASCII_DECR; break;
10620 case JIM_LSORT_NOCASE: lsortType = JIM_LSORT_NOCASE_DECR; break;
10621 }
10622 }
10623 resObj = Jim_DuplicateObj(interp, argv[argc-1]);
10624 ListSortElements(interp, resObj, lsortType);
10625 Jim_SetResult(interp, resObj);
10626 return JIM_OK;
10627 }
10628
10629 /* [append] */
10630 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc,
10631 Jim_Obj *const *argv)
10632 {
10633 Jim_Obj *stringObjPtr;
10634 int shared, i;
10635
10636 if (argc < 2) {
10637 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
10638 return JIM_ERR;
10639 }
10640 if (argc == 2) {
10641 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
10642 if (!stringObjPtr) return JIM_ERR;
10643 } else {
10644 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_NONE);
10645 if (!stringObjPtr) {
10646 /* Create the string if it does not exists */
10647 stringObjPtr = Jim_NewEmptyStringObj(interp);
10648 if (Jim_SetVariable(interp, argv[1], stringObjPtr)
10649 != JIM_OK) {
10650 Jim_FreeNewObj(interp, stringObjPtr);
10651 return JIM_ERR;
10652 }
10653 }
10654 }
10655 shared = Jim_IsShared(stringObjPtr);
10656 if (shared)
10657 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
10658 for (i = 2; i < argc; i++)
10659 Jim_AppendObj(interp, stringObjPtr, argv[i]);
10660 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
10661 if (shared)
10662 Jim_FreeNewObj(interp, stringObjPtr);
10663 return JIM_ERR;
10664 }
10665 Jim_SetResult(interp, stringObjPtr);
10666 return JIM_OK;
10667 }
10668
10669 /* [debug] */
10670 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc,
10671 Jim_Obj *const *argv)
10672 {
10673 const char *options[] = {
10674 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
10675 "exprbc",
10676 NULL
10677 };
10678 enum {
10679 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
10680 OPT_EXPRLEN, OPT_EXPRBC
10681 };
10682 int option;
10683
10684 if (argc < 2) {
10685 Jim_WrongNumArgs(interp, 1, argv, "option ?...?");
10686 return JIM_ERR;
10687 }
10688 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
10689 JIM_ERRMSG) != JIM_OK)
10690 return JIM_ERR;
10691 if (option == OPT_REFCOUNT) {
10692 if (argc != 3) {
10693 Jim_WrongNumArgs(interp, 2, argv, "object");
10694 return JIM_ERR;
10695 }
10696 Jim_SetResult(interp, Jim_NewIntObj(interp, argv[2]->refCount));
10697 return JIM_OK;
10698 } else if (option == OPT_OBJCOUNT) {
10699 int freeobj = 0, liveobj = 0;
10700 char buf[256];
10701 Jim_Obj *objPtr;
10702
10703 if (argc != 2) {
10704 Jim_WrongNumArgs(interp, 2, argv, "");
10705 return JIM_ERR;
10706 }
10707 /* Count the number of free objects. */
10708 objPtr = interp->freeList;
10709 while (objPtr) {
10710 freeobj++;
10711 objPtr = objPtr->nextObjPtr;
10712 }
10713 /* Count the number of live objects. */
10714 objPtr = interp->liveList;
10715 while (objPtr) {
10716 liveobj++;
10717 objPtr = objPtr->nextObjPtr;
10718 }
10719 /* Set the result string and return. */
10720 sprintf(buf, "free %d used %d", freeobj, liveobj);
10721 Jim_SetResultString(interp, buf, -1);
10722 return JIM_OK;
10723 } else if (option == OPT_OBJECTS) {
10724 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
10725 /* Count the number of live objects. */
10726 objPtr = interp->liveList;
10727 listObjPtr = Jim_NewListObj(interp, NULL, 0);
10728 while (objPtr) {
10729 char buf[128];
10730 const char *type = objPtr->typePtr ?
10731 objPtr->typePtr->name : "";
10732 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
10733 sprintf(buf, "%p", objPtr);
10734 Jim_ListAppendElement(interp, subListObjPtr,
10735 Jim_NewStringObj(interp, buf, -1));
10736 Jim_ListAppendElement(interp, subListObjPtr,
10737 Jim_NewStringObj(interp, type, -1));
10738 Jim_ListAppendElement(interp, subListObjPtr,
10739 Jim_NewIntObj(interp, objPtr->refCount));
10740 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
10741 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
10742 objPtr = objPtr->nextObjPtr;
10743 }
10744 Jim_SetResult(interp, listObjPtr);
10745 return JIM_OK;
10746 } else if (option == OPT_INVSTR) {
10747 Jim_Obj *objPtr;
10748
10749 if (argc != 3) {
10750 Jim_WrongNumArgs(interp, 2, argv, "object");
10751 return JIM_ERR;
10752 }
10753 objPtr = argv[2];
10754 if (objPtr->typePtr != NULL)
10755 Jim_InvalidateStringRep(objPtr);
10756 Jim_SetEmptyResult(interp);
10757 return JIM_OK;
10758 } else if (option == OPT_SCRIPTLEN) {
10759 ScriptObj *script;
10760 if (argc != 3) {
10761 Jim_WrongNumArgs(interp, 2, argv, "script");
10762 return JIM_ERR;
10763 }
10764 script = Jim_GetScript(interp, argv[2]);
10765 Jim_SetResult(interp, Jim_NewIntObj(interp, script->len));
10766 return JIM_OK;
10767 } else if (option == OPT_EXPRLEN) {
10768 ExprByteCode *expr;
10769 if (argc != 3) {
10770 Jim_WrongNumArgs(interp, 2, argv, "expression");
10771 return JIM_ERR;
10772 }
10773 expr = Jim_GetExpression(interp, argv[2]);
10774 if (expr == NULL)
10775 return JIM_ERR;
10776 Jim_SetResult(interp, Jim_NewIntObj(interp, expr->len));
10777 return JIM_OK;
10778 } else if (option == OPT_EXPRBC) {
10779 Jim_Obj *objPtr;
10780 ExprByteCode *expr;
10781 int i;
10782
10783 if (argc != 3) {
10784 Jim_WrongNumArgs(interp, 2, argv, "expression");
10785 return JIM_ERR;
10786 }
10787 expr = Jim_GetExpression(interp, argv[2]);
10788 if (expr == NULL)
10789 return JIM_ERR;
10790 objPtr = Jim_NewListObj(interp, NULL, 0);
10791 for (i = 0; i < expr->len; i++) {
10792 const char *type;
10793 Jim_ExprOperator *op;
10794
10795 switch(expr->opcode[i]) {
10796 case JIM_EXPROP_NUMBER: type = "number"; break;
10797 case JIM_EXPROP_COMMAND: type = "command"; break;
10798 case JIM_EXPROP_VARIABLE: type = "variable"; break;
10799 case JIM_EXPROP_DICTSUGAR: type = "dictsugar"; break;
10800 case JIM_EXPROP_SUBST: type = "subst"; break;
10801 case JIM_EXPROP_STRING: type = "string"; break;
10802 default:
10803 op = JimExprOperatorInfo(Jim_GetString(expr->obj[i], NULL));
10804 if (op == NULL) {
10805 type = "private";
10806 } else {
10807 type = "operator";
10808 }
10809 break;
10810 }
10811 Jim_ListAppendElement(interp, objPtr,
10812 Jim_NewStringObj(interp, type, -1));
10813 Jim_ListAppendElement(interp, objPtr, expr->obj[i]);
10814 }
10815 Jim_SetResult(interp, objPtr);
10816 return JIM_OK;
10817 } else {
10818 Jim_SetResultString(interp,
10819 "bad option. Valid options are refcount, "
10820 "objcount, objects, invstr", -1);
10821 return JIM_ERR;
10822 }
10823 return JIM_OK; /* unreached */
10824 }
10825
10826 /* [eval] */
10827 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc,
10828 Jim_Obj *const *argv)
10829 {
10830 if (argc == 2) {
10831 return Jim_EvalObj(interp, argv[1]);
10832 } else if (argc > 2) {
10833 Jim_Obj *objPtr;
10834 int retcode;
10835
10836 objPtr = Jim_ConcatObj(interp, argc-1, argv+1);
10837 Jim_IncrRefCount(objPtr);
10838 retcode = Jim_EvalObj(interp, objPtr);
10839 Jim_DecrRefCount(interp, objPtr);
10840 return retcode;
10841 } else {
10842 Jim_WrongNumArgs(interp, 1, argv, "script ?...?");
10843 return JIM_ERR;
10844 }
10845 }
10846
10847 /* [uplevel] */
10848 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc,
10849 Jim_Obj *const *argv)
10850 {
10851 if (argc >= 2) {
10852 int retcode, newLevel, oldLevel;
10853 Jim_CallFrame *savedCallFrame, *targetCallFrame;
10854 Jim_Obj *objPtr;
10855 const char *str;
10856
10857 /* Save the old callframe pointer */
10858 savedCallFrame = interp->framePtr;
10859
10860 /* Lookup the target frame pointer */
10861 str = Jim_GetString(argv[1], NULL);
10862 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#')
10863 {
10864 if (Jim_GetCallFrameByLevel(interp, argv[1],
10865 &targetCallFrame,
10866 &newLevel) != JIM_OK)
10867 return JIM_ERR;
10868 argc--;
10869 argv++;
10870 } else {
10871 if (Jim_GetCallFrameByLevel(interp, NULL,
10872 &targetCallFrame,
10873 &newLevel) != JIM_OK)
10874 return JIM_ERR;
10875 }
10876 if (argc < 2) {
10877 argc++;
10878 argv--;
10879 Jim_WrongNumArgs(interp, 1, argv,
10880 "?level? command ?arg ...?");
10881 return JIM_ERR;
10882 }
10883 /* Eval the code in the target callframe. */
10884 interp->framePtr = targetCallFrame;
10885 oldLevel = interp->numLevels;
10886 interp->numLevels = newLevel;
10887 if (argc == 2) {
10888 retcode = Jim_EvalObj(interp, argv[1]);
10889 } else {
10890 objPtr = Jim_ConcatObj(interp, argc-1, argv+1);
10891 Jim_IncrRefCount(objPtr);
10892 retcode = Jim_EvalObj(interp, objPtr);
10893 Jim_DecrRefCount(interp, objPtr);
10894 }
10895 interp->numLevels = oldLevel;
10896 interp->framePtr = savedCallFrame;
10897 return retcode;
10898 } else {
10899 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
10900 return JIM_ERR;
10901 }
10902 }
10903
10904 /* [expr] */
10905 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc,
10906 Jim_Obj *const *argv)
10907 {
10908 Jim_Obj *exprResultPtr;
10909 int retcode;
10910
10911 if (argc == 2) {
10912 retcode = Jim_EvalExpression(interp, argv[1], &exprResultPtr);
10913 } else if (argc > 2) {
10914 Jim_Obj *objPtr;
10915
10916 objPtr = Jim_ConcatObj(interp, argc-1, argv+1);
10917 Jim_IncrRefCount(objPtr);
10918 retcode = Jim_EvalExpression(interp, objPtr, &exprResultPtr);
10919 Jim_DecrRefCount(interp, objPtr);
10920 } else {
10921 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
10922 return JIM_ERR;
10923 }
10924 if (retcode != JIM_OK) return retcode;
10925 Jim_SetResult(interp, exprResultPtr);
10926 Jim_DecrRefCount(interp, exprResultPtr);
10927 return JIM_OK;
10928 }
10929
10930 /* [break] */
10931 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc,
10932 Jim_Obj *const *argv)
10933 {
10934 if (argc != 1) {
10935 Jim_WrongNumArgs(interp, 1, argv, "");
10936 return JIM_ERR;
10937 }
10938 return JIM_BREAK;
10939 }
10940
10941 /* [continue] */
10942 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc,
10943 Jim_Obj *const *argv)
10944 {
10945 if (argc != 1) {
10946 Jim_WrongNumArgs(interp, 1, argv, "");
10947 return JIM_ERR;
10948 }
10949 return JIM_CONTINUE;
10950 }
10951
10952 /* [return] */
10953 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc,
10954 Jim_Obj *const *argv)
10955 {
10956 if (argc == 1) {
10957 return JIM_RETURN;
10958 } else if (argc == 2) {
10959 Jim_SetResult(interp, argv[1]);
10960 interp->returnCode = JIM_OK;
10961 return JIM_RETURN;
10962 } else if (argc == 3 || argc == 4) {
10963 int returnCode;
10964 if (Jim_GetReturnCode(interp, argv[2], &returnCode) == JIM_ERR)
10965 return JIM_ERR;
10966 interp->returnCode = returnCode;
10967 if (argc == 4)
10968 Jim_SetResult(interp, argv[3]);
10969 return JIM_RETURN;
10970 } else {
10971 Jim_WrongNumArgs(interp, 1, argv, "?-code code? ?result?");
10972 return JIM_ERR;
10973 }
10974 return JIM_RETURN; /* unreached */
10975 }
10976
10977 /* [tailcall] */
10978 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc,
10979 Jim_Obj *const *argv)
10980 {
10981 Jim_Obj *objPtr;
10982
10983 objPtr = Jim_NewListObj(interp, argv+1, argc-1);
10984 Jim_SetResult(interp, objPtr);
10985 return JIM_EVAL;
10986 }
10987
10988 /* [proc] */
10989 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc,
10990 Jim_Obj *const *argv)
10991 {
10992 int argListLen;
10993 int arityMin, arityMax;
10994
10995 if (argc != 4 && argc != 5) {
10996 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
10997 return JIM_ERR;
10998 }
10999 Jim_ListLength(interp, argv[2], &argListLen);
11000 arityMin = arityMax = argListLen+1;
11001
11002 if (argListLen) {
11003 const char *str;
11004 int len;
11005 Jim_Obj *argPtr;
11006
11007 /* Check for 'args' and adjust arityMin and arityMax if necessary */
11008 Jim_ListIndex(interp, argv[2], argListLen-1, &argPtr, JIM_NONE);
11009 str = Jim_GetString(argPtr, &len);
11010 if (len == 4 && memcmp(str, "args", 4) == 0) {
11011 arityMin--;
11012 arityMax = -1;
11013 }
11014
11015 /* Check for default arguments and reduce arityMin if necessary */
11016 while (arityMin > 1) {
11017 int len;
11018 Jim_ListIndex(interp, argv[2], arityMin - 2, &argPtr, JIM_NONE);
11019 Jim_ListLength(interp, argPtr, &len);
11020 if (len != 2) {
11021 /* No default argument */
11022 break;
11023 }
11024 arityMin--;
11025 }
11026 }
11027 if (argc == 4) {
11028 return Jim_CreateProcedure(interp, Jim_GetString(argv[1], NULL),
11029 argv[2], NULL, argv[3], arityMin, arityMax);
11030 } else {
11031 return Jim_CreateProcedure(interp, Jim_GetString(argv[1], NULL),
11032 argv[2], argv[3], argv[4], arityMin, arityMax);
11033 }
11034 }
11035
11036 /* [concat] */
11037 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc,
11038 Jim_Obj *const *argv)
11039 {
11040 Jim_SetResult(interp, Jim_ConcatObj(interp, argc-1, argv+1));
11041 return JIM_OK;
11042 }
11043
11044 /* [upvar] */
11045 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc,
11046 Jim_Obj *const *argv)
11047 {
11048 const char *str;
11049 int i;
11050 Jim_CallFrame *targetCallFrame;
11051
11052 /* Lookup the target frame pointer */
11053 str = Jim_GetString(argv[1], NULL);
11054 if (argc > 3 &&
11055 ((str[0] >= '0' && str[0] <= '9') || str[0] == '#'))
11056 {
11057 if (Jim_GetCallFrameByLevel(interp, argv[1],
11058 &targetCallFrame, NULL) != JIM_OK)
11059 return JIM_ERR;
11060 argc--;
11061 argv++;
11062 } else {
11063 if (Jim_GetCallFrameByLevel(interp, NULL,
11064 &targetCallFrame, NULL) != JIM_OK)
11065 return JIM_ERR;
11066 }
11067 /* Check for arity */
11068 if (argc < 3 || ((argc-1)%2) != 0) {
11069 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
11070 return JIM_ERR;
11071 }
11072 /* Now... for every other/local couple: */
11073 for (i = 1; i < argc; i += 2) {
11074 if (Jim_SetVariableLink(interp, argv[i+1], argv[i],
11075 targetCallFrame) != JIM_OK) return JIM_ERR;
11076 }
11077 return JIM_OK;
11078 }
11079
11080 /* [global] */
11081 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc,
11082 Jim_Obj *const *argv)
11083 {
11084 int i;
11085
11086 if (argc < 2) {
11087 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
11088 return JIM_ERR;
11089 }
11090 /* Link every var to the toplevel having the same name */
11091 if (interp->numLevels == 0) return JIM_OK; /* global at toplevel... */
11092 for (i = 1; i < argc; i++) {
11093 if (Jim_SetVariableLink(interp, argv[i], argv[i],
11094 interp->topFramePtr) != JIM_OK) return JIM_ERR;
11095 }
11096 return JIM_OK;
11097 }
11098
11099 /* does the [string map] operation. On error NULL is returned,
11100 * otherwise a new string object with the result, having refcount = 0,
11101 * is returned. */
11102 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
11103 Jim_Obj *objPtr, int nocase)
11104 {
11105 int numMaps;
11106 const char **key, *str, *noMatchStart = NULL;
11107 Jim_Obj **value;
11108 int *keyLen, strLen, i;
11109 Jim_Obj *resultObjPtr;
11110
11111 Jim_ListLength(interp, mapListObjPtr, &numMaps);
11112 if (numMaps % 2) {
11113 Jim_SetResultString(interp,
11114 "list must contain an even number of elements", -1);
11115 return NULL;
11116 }
11117 /* Initialization */
11118 numMaps /= 2;
11119 key = Jim_Alloc(sizeof(char*)*numMaps);
11120 keyLen = Jim_Alloc(sizeof(int)*numMaps);
11121 value = Jim_Alloc(sizeof(Jim_Obj*)*numMaps);
11122 resultObjPtr = Jim_NewStringObj(interp, "", 0);
11123 for (i = 0; i < numMaps; i++) {
11124 Jim_Obj *eleObjPtr;
11125
11126 Jim_ListIndex(interp, mapListObjPtr, i*2, &eleObjPtr, JIM_NONE);
11127 key[i] = Jim_GetString(eleObjPtr, &keyLen[i]);
11128 Jim_ListIndex(interp, mapListObjPtr, i*2+1, &eleObjPtr, JIM_NONE);
11129 value[i] = eleObjPtr;
11130 }
11131 str = Jim_GetString(objPtr, &strLen);
11132 /* Map it */
11133 while(strLen) {
11134 for (i = 0; i < numMaps; i++) {
11135 if (strLen >= keyLen[i] && keyLen[i]) {
11136 if (!JimStringCompare(str, keyLen[i], key[i], keyLen[i],
11137 nocase))
11138 {
11139 if (noMatchStart) {
11140 Jim_AppendString(interp, resultObjPtr,
11141 noMatchStart, str-noMatchStart);
11142 noMatchStart = NULL;
11143 }
11144 Jim_AppendObj(interp, resultObjPtr, value[i]);
11145 str += keyLen[i];
11146 strLen -= keyLen[i];
11147 break;
11148 }
11149 }
11150 }
11151 if (i == numMaps) { /* no match */
11152 if (noMatchStart == NULL)
11153 noMatchStart = str;
11154 str ++;
11155 strLen --;
11156 }
11157 }
11158 if (noMatchStart) {
11159 Jim_AppendString(interp, resultObjPtr,
11160 noMatchStart, str-noMatchStart);
11161 }
11162 Jim_Free((void*)key);
11163 Jim_Free(keyLen);
11164 Jim_Free(value);
11165 return resultObjPtr;
11166 }
11167
11168 /* [string] */
11169 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc,
11170 Jim_Obj *const *argv)
11171 {
11172 int option;
11173 const char *options[] = {
11174 "length", "compare", "match", "equal", "range", "map", "repeat",
11175 "index", "first", "tolower", "toupper", NULL
11176 };
11177 enum {
11178 OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_RANGE,
11179 OPT_MAP, OPT_REPEAT, OPT_INDEX, OPT_FIRST, OPT_TOLOWER, OPT_TOUPPER
11180 };
11181
11182 if (argc < 2) {
11183 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
11184 return JIM_ERR;
11185 }
11186 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
11187 JIM_ERRMSG) != JIM_OK)
11188 return JIM_ERR;
11189
11190 if (option == OPT_LENGTH) {
11191 int len;
11192
11193 if (argc != 3) {
11194 Jim_WrongNumArgs(interp, 2, argv, "string");
11195 return JIM_ERR;
11196 }
11197 Jim_GetString(argv[2], &len);
11198 Jim_SetResult(interp, Jim_NewIntObj(interp, len));
11199 return JIM_OK;
11200 } else if (option == OPT_COMPARE) {
11201 int nocase = 0;
11202 if ((argc != 4 && argc != 5) ||
11203 (argc == 5 && Jim_CompareStringImmediate(interp,
11204 argv[2], "-nocase") == 0)) {
11205 Jim_WrongNumArgs(interp, 2, argv, "string1 string2");
11206 return JIM_ERR;
11207 }
11208 if (argc == 5) {
11209 nocase = 1;
11210 argv++;
11211 }
11212 Jim_SetResult(interp, Jim_NewIntObj(interp,
11213 Jim_StringCompareObj(argv[2],
11214 argv[3], nocase)));
11215 return JIM_OK;
11216 } else if (option == OPT_MATCH) {
11217 int nocase = 0;
11218 if ((argc != 4 && argc != 5) ||
11219 (argc == 5 && Jim_CompareStringImmediate(interp,
11220 argv[2], "-nocase") == 0)) {
11221 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern "
11222 "string");
11223 return JIM_ERR;
11224 }
11225 if (argc == 5) {
11226 nocase = 1;
11227 argv++;
11228 }
11229 Jim_SetResult(interp,
11230 Jim_NewIntObj(interp, Jim_StringMatchObj(argv[2],
11231 argv[3], nocase)));
11232 return JIM_OK;
11233 } else if (option == OPT_EQUAL) {
11234 if (argc != 4) {
11235 Jim_WrongNumArgs(interp, 2, argv, "string1 string2");
11236 return JIM_ERR;
11237 }
11238 Jim_SetResult(interp,
11239 Jim_NewIntObj(interp, Jim_StringEqObj(argv[2],
11240 argv[3], 0)));
11241 return JIM_OK;
11242 } else if (option == OPT_RANGE) {
11243 Jim_Obj *objPtr;
11244
11245 if (argc != 5) {
11246 Jim_WrongNumArgs(interp, 2, argv, "string first last");
11247 return JIM_ERR;
11248 }
11249 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
11250 if (objPtr == NULL)
11251 return JIM_ERR;
11252 Jim_SetResult(interp, objPtr);
11253 return JIM_OK;
11254 } else if (option == OPT_MAP) {
11255 int nocase = 0;
11256 Jim_Obj *objPtr;
11257
11258 if ((argc != 4 && argc != 5) ||
11259 (argc == 5 && Jim_CompareStringImmediate(interp,
11260 argv[2], "-nocase") == 0)) {
11261 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList "
11262 "string");
11263 return JIM_ERR;
11264 }
11265 if (argc == 5) {
11266 nocase = 1;
11267 argv++;
11268 }
11269 objPtr = JimStringMap(interp, argv[2], argv[3], nocase);
11270 if (objPtr == NULL)
11271 return JIM_ERR;
11272 Jim_SetResult(interp, objPtr);
11273 return JIM_OK;
11274 } else if (option == OPT_REPEAT) {
11275 Jim_Obj *objPtr;
11276 jim_wide count;
11277
11278 if (argc != 4) {
11279 Jim_WrongNumArgs(interp, 2, argv, "string count");
11280 return JIM_ERR;
11281 }
11282 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK)
11283 return JIM_ERR;
11284 objPtr = Jim_NewStringObj(interp, "", 0);
11285 while (count--) {
11286 Jim_AppendObj(interp, objPtr, argv[2]);
11287 }
11288 Jim_SetResult(interp, objPtr);
11289 return JIM_OK;
11290 } else if (option == OPT_INDEX) {
11291 int index, len;
11292 const char *str;
11293
11294 if (argc != 4) {
11295 Jim_WrongNumArgs(interp, 2, argv, "string index");
11296 return JIM_ERR;
11297 }
11298 if (Jim_GetIndex(interp, argv[3], &index) != JIM_OK)
11299 return JIM_ERR;
11300 str = Jim_GetString(argv[2], &len);
11301 if (index != INT_MIN && index != INT_MAX)
11302 index = JimRelToAbsIndex(len, index);
11303 if (index < 0 || index >= len) {
11304 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11305 return JIM_OK;
11306 } else {
11307 Jim_SetResult(interp, Jim_NewStringObj(interp, str+index, 1));
11308 return JIM_OK;
11309 }
11310 } else if (option == OPT_FIRST) {
11311 int index = 0, l1, l2;
11312 const char *s1, *s2;
11313
11314 if (argc != 4 && argc != 5) {
11315 Jim_WrongNumArgs(interp, 2, argv, "subString string ?startIndex?");
11316 return JIM_ERR;
11317 }
11318 s1 = Jim_GetString(argv[2], &l1);
11319 s2 = Jim_GetString(argv[3], &l2);
11320 if (argc == 5) {
11321 if (Jim_GetIndex(interp, argv[4], &index) != JIM_OK)
11322 return JIM_ERR;
11323 index = JimRelToAbsIndex(l2, index);
11324 }
11325 Jim_SetResult(interp, Jim_NewIntObj(interp,
11326 JimStringFirst(s1, l1, s2, l2, index)));
11327 return JIM_OK;
11328 } else if (option == OPT_TOLOWER) {
11329 if (argc != 3) {
11330 Jim_WrongNumArgs(interp, 2, argv, "string");
11331 return JIM_ERR;
11332 }
11333 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
11334 } else if (option == OPT_TOUPPER) {
11335 if (argc != 3) {
11336 Jim_WrongNumArgs(interp, 2, argv, "string");
11337 return JIM_ERR;
11338 }
11339 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
11340 }
11341 return JIM_OK;
11342 }
11343
11344 /* [time] */
11345 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc,
11346 Jim_Obj *const *argv)
11347 {
11348 long i, count = 1;
11349 jim_wide start, elapsed;
11350 char buf [256];
11351 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
11352
11353 if (argc < 2) {
11354 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
11355 return JIM_ERR;
11356 }
11357 if (argc == 3) {
11358 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
11359 return JIM_ERR;
11360 }
11361 if (count < 0)
11362 return JIM_OK;
11363 i = count;
11364 start = JimClock();
11365 while (i-- > 0) {
11366 int retval;
11367
11368 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK)
11369 return retval;
11370 }
11371 elapsed = JimClock() - start;
11372 sprintf(buf, fmt, elapsed/count);
11373 Jim_SetResultString(interp, buf, -1);
11374 return JIM_OK;
11375 }
11376
11377 /* [exit] */
11378 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc,
11379 Jim_Obj *const *argv)
11380 {
11381 long exitCode = 0;
11382
11383 if (argc > 2) {
11384 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
11385 return JIM_ERR;
11386 }
11387 if (argc == 2) {
11388 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
11389 return JIM_ERR;
11390 }
11391 interp->exitCode = exitCode;
11392 return JIM_EXIT;
11393 }
11394
11395 /* [catch] */
11396 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc,
11397 Jim_Obj *const *argv)
11398 {
11399 int exitCode = 0;
11400
11401 if (argc != 2 && argc != 3) {
11402 Jim_WrongNumArgs(interp, 1, argv, "script ?varName?");
11403 return JIM_ERR;
11404 }
11405 exitCode = Jim_EvalObj(interp, argv[1]);
11406 if (argc == 3) {
11407 if (Jim_SetVariable(interp, argv[2], Jim_GetResult(interp))
11408 != JIM_OK)
11409 return JIM_ERR;
11410 }
11411 Jim_SetResult(interp, Jim_NewIntObj(interp, exitCode));
11412 return JIM_OK;
11413 }
11414
11415 /* [ref] */
11416 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc,
11417 Jim_Obj *const *argv)
11418 {
11419 if (argc != 3 && argc != 4) {
11420 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
11421 return JIM_ERR;
11422 }
11423 if (argc == 3) {
11424 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
11425 } else {
11426 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2],
11427 argv[3]));
11428 }
11429 return JIM_OK;
11430 }
11431
11432 /* [getref] */
11433 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc,
11434 Jim_Obj *const *argv)
11435 {
11436 Jim_Reference *refPtr;
11437
11438 if (argc != 2) {
11439 Jim_WrongNumArgs(interp, 1, argv, "reference");
11440 return JIM_ERR;
11441 }
11442 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
11443 return JIM_ERR;
11444 Jim_SetResult(interp, refPtr->objPtr);
11445 return JIM_OK;
11446 }
11447
11448 /* [setref] */
11449 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc,
11450 Jim_Obj *const *argv)
11451 {
11452 Jim_Reference *refPtr;
11453
11454 if (argc != 3) {
11455 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
11456 return JIM_ERR;
11457 }
11458 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
11459 return JIM_ERR;
11460 Jim_IncrRefCount(argv[2]);
11461 Jim_DecrRefCount(interp, refPtr->objPtr);
11462 refPtr->objPtr = argv[2];
11463 Jim_SetResult(interp, argv[2]);
11464 return JIM_OK;
11465 }
11466
11467 /* [collect] */
11468 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc,
11469 Jim_Obj *const *argv)
11470 {
11471 if (argc != 1) {
11472 Jim_WrongNumArgs(interp, 1, argv, "");
11473 return JIM_ERR;
11474 }
11475 Jim_SetResult(interp, Jim_NewIntObj(interp, Jim_Collect(interp)));
11476 return JIM_OK;
11477 }
11478
11479 /* [finalize] reference ?newValue? */
11480 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc,
11481 Jim_Obj *const *argv)
11482 {
11483 if (argc != 2 && argc != 3) {
11484 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
11485 return JIM_ERR;
11486 }
11487 if (argc == 2) {
11488 Jim_Obj *cmdNamePtr;
11489
11490 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
11491 return JIM_ERR;
11492 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
11493 Jim_SetResult(interp, cmdNamePtr);
11494 } else {
11495 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
11496 return JIM_ERR;
11497 Jim_SetResult(interp, argv[2]);
11498 }
11499 return JIM_OK;
11500 }
11501
11502 /* TODO */
11503 /* [info references] (list of all the references/finalizers) */
11504
11505 /* [rename] */
11506 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc,
11507 Jim_Obj *const *argv)
11508 {
11509 const char *oldName, *newName;
11510
11511 if (argc != 3) {
11512 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
11513 return JIM_ERR;
11514 }
11515 oldName = Jim_GetString(argv[1], NULL);
11516 newName = Jim_GetString(argv[2], NULL);
11517 if (Jim_RenameCommand(interp, oldName, newName) != JIM_OK) {
11518 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11519 Jim_AppendStrings(interp, Jim_GetResult(interp),
11520 "can't rename \"", oldName, "\": ",
11521 "command doesn't exist", NULL);
11522 return JIM_ERR;
11523 }
11524 return JIM_OK;
11525 }
11526
11527 /* [dict] */
11528 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc,
11529 Jim_Obj *const *argv)
11530 {
11531 int option;
11532 const char *options[] = {
11533 "create", "get", "set", "unset", "exists", NULL
11534 };
11535 enum {
11536 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXIST
11537 };
11538
11539 if (argc < 2) {
11540 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
11541 return JIM_ERR;
11542 }
11543
11544 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
11545 JIM_ERRMSG) != JIM_OK)
11546 return JIM_ERR;
11547
11548 if (option == OPT_CREATE) {
11549 Jim_Obj *objPtr;
11550
11551 if (argc % 2) {
11552 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
11553 return JIM_ERR;
11554 }
11555 objPtr = Jim_NewDictObj(interp, argv+2, argc-2);
11556 Jim_SetResult(interp, objPtr);
11557 return JIM_OK;
11558 } else if (option == OPT_GET) {
11559 Jim_Obj *objPtr;
11560
11561 if (Jim_DictKeysVector(interp, argv[2], argv+3, argc-3, &objPtr,
11562 JIM_ERRMSG) != JIM_OK)
11563 return JIM_ERR;
11564 Jim_SetResult(interp, objPtr);
11565 return JIM_OK;
11566 } else if (option == OPT_SET) {
11567 if (argc < 5) {
11568 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
11569 return JIM_ERR;
11570 }
11571 return Jim_SetDictKeysVector(interp, argv[2], argv+3, argc-4,
11572 argv[argc-1]);
11573 } else if (option == OPT_UNSET) {
11574 if (argc < 4) {
11575 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
11576 return JIM_ERR;
11577 }
11578 return Jim_SetDictKeysVector(interp, argv[2], argv+3, argc-3,
11579 NULL);
11580 } else if (option == OPT_EXIST) {
11581 Jim_Obj *objPtr;
11582 int exists;
11583
11584 if (Jim_DictKeysVector(interp, argv[2], argv+3, argc-3, &objPtr,
11585 JIM_ERRMSG) == JIM_OK)
11586 exists = 1;
11587 else
11588 exists = 0;
11589 Jim_SetResult(interp, Jim_NewIntObj(interp, exists));
11590 return JIM_OK;
11591 } else {
11592 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11593 Jim_AppendStrings(interp, Jim_GetResult(interp),
11594 "bad option \"", Jim_GetString(argv[1], NULL), "\":",
11595 " must be create, get, set", NULL);
11596 return JIM_ERR;
11597 }
11598 return JIM_OK;
11599 }
11600
11601 /* [load] */
11602 static int Jim_LoadCoreCommand(Jim_Interp *interp, int argc,
11603 Jim_Obj *const *argv)
11604 {
11605 if (argc < 2) {
11606 Jim_WrongNumArgs(interp, 1, argv, "libaryFile");
11607 return JIM_ERR;
11608 }
11609 return Jim_LoadLibrary(interp, Jim_GetString(argv[1], NULL));
11610 }
11611
11612 /* [subst] */
11613 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc,
11614 Jim_Obj *const *argv)
11615 {
11616 int i, flags = 0;
11617 Jim_Obj *objPtr;
11618
11619 if (argc < 2) {
11620 Jim_WrongNumArgs(interp, 1, argv,
11621 "?-nobackslashes? ?-nocommands? ?-novariables? string");
11622 return JIM_ERR;
11623 }
11624 i = argc-2;
11625 while(i--) {
11626 if (Jim_CompareStringImmediate(interp, argv[i+1],
11627 "-nobackslashes"))
11628 flags |= JIM_SUBST_NOESC;
11629 else if (Jim_CompareStringImmediate(interp, argv[i+1],
11630 "-novariables"))
11631 flags |= JIM_SUBST_NOVAR;
11632 else if (Jim_CompareStringImmediate(interp, argv[i+1],
11633 "-nocommands"))
11634 flags |= JIM_SUBST_NOCMD;
11635 else {
11636 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11637 Jim_AppendStrings(interp, Jim_GetResult(interp),
11638 "bad option \"", Jim_GetString(argv[i+1], NULL),
11639 "\": must be -nobackslashes, -nocommands, or "
11640 "-novariables", NULL);
11641 return JIM_ERR;
11642 }
11643 }
11644 if (Jim_SubstObj(interp, argv[argc-1], &objPtr, flags) != JIM_OK)
11645 return JIM_ERR;
11646 Jim_SetResult(interp, objPtr);
11647 return JIM_OK;
11648 }
11649
11650 /* [info] */
11651 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc,
11652 Jim_Obj *const *argv)
11653 {
11654 int cmd, result = JIM_OK;
11655 static const char *commands[] = {
11656 "body", "commands", "exists", "globals", "level", "locals",
11657 "vars", "version", "complete", "args", "hostname", NULL
11658 };
11659 enum {INFO_BODY, INFO_COMMANDS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
11660 INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_COMPLETE, INFO_ARGS, INFO_HOSTNAME};
11661
11662 if (argc < 2) {
11663 Jim_WrongNumArgs(interp, 1, argv, "command ?args ...?");
11664 return JIM_ERR;
11665 }
11666 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "command", JIM_ERRMSG)
11667 != JIM_OK) {
11668 return JIM_ERR;
11669 }
11670
11671 if (cmd == INFO_COMMANDS) {
11672 if (argc != 2 && argc != 3) {
11673 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
11674 return JIM_ERR;
11675 }
11676 if (argc == 3)
11677 Jim_SetResult(interp,JimCommandsList(interp, argv[2]));
11678 else
11679 Jim_SetResult(interp, JimCommandsList(interp, NULL));
11680 } else if (cmd == INFO_EXISTS) {
11681 Jim_Obj *exists;
11682 if (argc != 3) {
11683 Jim_WrongNumArgs(interp, 2, argv, "varName");
11684 return JIM_ERR;
11685 }
11686 exists = Jim_GetVariable(interp, argv[2], 0);
11687 Jim_SetResult(interp, Jim_NewIntObj(interp, exists != 0));
11688 } else if (cmd == INFO_GLOBALS || cmd == INFO_LOCALS || cmd == INFO_VARS) {
11689 int mode;
11690 switch (cmd) {
11691 case INFO_GLOBALS: mode = JIM_VARLIST_GLOBALS; break;
11692 case INFO_LOCALS: mode = JIM_VARLIST_LOCALS; break;
11693 case INFO_VARS: mode = JIM_VARLIST_VARS; break;
11694 default: mode = 0; /* avoid warning */; break;
11695 }
11696 if (argc != 2 && argc != 3) {
11697 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
11698 return JIM_ERR;
11699 }
11700 if (argc == 3)
11701 Jim_SetResult(interp,JimVariablesList(interp, argv[2], mode));
11702 else
11703 Jim_SetResult(interp, JimVariablesList(interp, NULL, mode));
11704 } else if (cmd == INFO_LEVEL) {
11705 Jim_Obj *objPtr;
11706 switch (argc) {
11707 case 2:
11708 Jim_SetResult(interp,
11709 Jim_NewIntObj(interp, interp->numLevels));
11710 break;
11711 case 3:
11712 if (JimInfoLevel(interp, argv[2], &objPtr) != JIM_OK)
11713 return JIM_ERR;
11714 Jim_SetResult(interp, objPtr);
11715 break;
11716 default:
11717 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
11718 return JIM_ERR;
11719 }
11720 } else if (cmd == INFO_BODY || cmd == INFO_ARGS) {
11721 Jim_Cmd *cmdPtr;
11722
11723 if (argc != 3) {
11724 Jim_WrongNumArgs(interp, 2, argv, "procname");
11725 return JIM_ERR;
11726 }
11727 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL)
11728 return JIM_ERR;
11729 if (cmdPtr->cmdProc != NULL) {
11730 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11731 Jim_AppendStrings(interp, Jim_GetResult(interp),
11732 "command \"", Jim_GetString(argv[2], NULL),
11733 "\" is not a procedure", NULL);
11734 return JIM_ERR;
11735 }
11736 if (cmd == INFO_BODY)
11737 Jim_SetResult(interp, cmdPtr->bodyObjPtr);
11738 else
11739 Jim_SetResult(interp, cmdPtr->argListObjPtr);
11740 } else if (cmd == INFO_VERSION) {
11741 char buf[(JIM_INTEGER_SPACE * 2) + 1];
11742 sprintf(buf, "%d.%d",
11743 JIM_VERSION / 100, JIM_VERSION % 100);
11744 Jim_SetResultString(interp, buf, -1);
11745 } else if (cmd == INFO_COMPLETE) {
11746 const char *s;
11747 int len;
11748
11749 if (argc != 3) {
11750 Jim_WrongNumArgs(interp, 2, argv, "script");
11751 return JIM_ERR;
11752 }
11753 s = Jim_GetString(argv[2], &len);
11754 Jim_SetResult(interp,
11755 Jim_NewIntObj(interp, Jim_ScriptIsComplete(s, len, NULL)));
11756 } else if (cmd == INFO_HOSTNAME) {
11757 /* Redirect to os.hostname if it exists */
11758 Jim_Obj *command = Jim_NewStringObj(interp, "os.gethostname", -1);
11759 result = Jim_EvalObjVector(interp, 1, &command);
11760 }
11761 return result;
11762 }
11763
11764 /* [split] */
11765 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc,
11766 Jim_Obj *const *argv)
11767 {
11768 const char *str, *splitChars, *noMatchStart;
11769 int splitLen, strLen, i;
11770 Jim_Obj *resObjPtr;
11771
11772 if (argc != 2 && argc != 3) {
11773 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
11774 return JIM_ERR;
11775 }
11776 /* Init */
11777 if (argc == 2) {
11778 splitChars = " \n\t\r";
11779 splitLen = 4;
11780 } else {
11781 splitChars = Jim_GetString(argv[2], &splitLen);
11782 }
11783 str = Jim_GetString(argv[1], &strLen);
11784 if (!strLen) return JIM_OK;
11785 noMatchStart = str;
11786 resObjPtr = Jim_NewListObj(interp, NULL, 0);
11787 /* Split */
11788 if (splitLen) {
11789 while (strLen) {
11790 for (i = 0; i < splitLen; i++) {
11791 if (*str == splitChars[i]) {
11792 Jim_Obj *objPtr;
11793
11794 objPtr = Jim_NewStringObj(interp, noMatchStart,
11795 (str-noMatchStart));
11796 Jim_ListAppendElement(interp, resObjPtr, objPtr);
11797 noMatchStart = str+1;
11798 break;
11799 }
11800 }
11801 str ++;
11802 strLen --;
11803 }
11804 Jim_ListAppendElement(interp, resObjPtr,
11805 Jim_NewStringObj(interp, noMatchStart, (str-noMatchStart)));
11806 } else {
11807 /* This handles the special case of splitchars eq {}. This
11808 * is trivial but we want to perform object sharing as Tcl does. */
11809 Jim_Obj *objCache[256];
11810 const unsigned char *u = (unsigned char*) str;
11811 memset(objCache, 0, sizeof(objCache));
11812 for (i = 0; i < strLen; i++) {
11813 int c = u[i];
11814
11815 if (objCache[c] == NULL)
11816 objCache[c] = Jim_NewStringObj(interp, (char*)u+i, 1);
11817 Jim_ListAppendElement(interp, resObjPtr, objCache[c]);
11818 }
11819 }
11820 Jim_SetResult(interp, resObjPtr);
11821 return JIM_OK;
11822 }
11823
11824 /* [join] */
11825 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc,
11826 Jim_Obj *const *argv)
11827 {
11828 const char *joinStr;
11829 int joinStrLen, i, listLen;
11830 Jim_Obj *resObjPtr;
11831
11832 if (argc != 2 && argc != 3) {
11833 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
11834 return JIM_ERR;
11835 }
11836 /* Init */
11837 if (argc == 2) {
11838 joinStr = " ";
11839 joinStrLen = 1;
11840 } else {
11841 joinStr = Jim_GetString(argv[2], &joinStrLen);
11842 }
11843 Jim_ListLength(interp, argv[1], &listLen);
11844 resObjPtr = Jim_NewStringObj(interp, NULL, 0);
11845 /* Split */
11846 for (i = 0; i < listLen; i++) {
11847 Jim_Obj *objPtr;
11848
11849 Jim_ListIndex(interp, argv[1], i, &objPtr, JIM_NONE);
11850 Jim_AppendObj(interp, resObjPtr, objPtr);
11851 if (i+1 != listLen) {
11852 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
11853 }
11854 }
11855 Jim_SetResult(interp, resObjPtr);
11856 return JIM_OK;
11857 }
11858
11859 /* [format] */
11860 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc,
11861 Jim_Obj *const *argv)
11862 {
11863 Jim_Obj *objPtr;
11864
11865 if (argc < 2) {
11866 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
11867 return JIM_ERR;
11868 }
11869 objPtr = Jim_FormatString(interp, argv[1], argc-2, argv+2);
11870 if (objPtr == NULL)
11871 return JIM_ERR;
11872 Jim_SetResult(interp, objPtr);
11873 return JIM_OK;
11874 }
11875
11876 /* [scan] */
11877 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc,
11878 Jim_Obj *const *argv)
11879 {
11880 Jim_Obj *listPtr, **outVec;
11881 int outc, i, count = 0;
11882
11883 if (argc < 3) {
11884 Jim_WrongNumArgs(interp, 1, argv, "string formatString ?varName ...?");
11885 return JIM_ERR;
11886 }
11887 if (argv[2]->typePtr != &scanFmtStringObjType)
11888 SetScanFmtFromAny(interp, argv[2]);
11889 if (FormatGetError(argv[2]) != 0) {
11890 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
11891 return JIM_ERR;
11892 }
11893 if (argc > 3) {
11894 int maxPos = FormatGetMaxPos(argv[2]);
11895 int count = FormatGetCnvCount(argv[2]);
11896 if (maxPos > argc-3) {
11897 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
11898 return JIM_ERR;
11899 } else if (count != 0 && count < argc-3) {
11900 Jim_SetResultString(interp, "variable is not assigned by any "
11901 "conversion specifiers", -1);
11902 return JIM_ERR;
11903 } else if (count > argc-3) {
11904 Jim_SetResultString(interp, "different numbers of variable names and "
11905 "field specifiers", -1);
11906 return JIM_ERR;
11907 }
11908 }
11909 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
11910 if (listPtr == 0)
11911 return JIM_ERR;
11912 if (argc > 3) {
11913 int len = 0;
11914 if (listPtr != 0 && listPtr != (Jim_Obj*)EOF)
11915 Jim_ListLength(interp, listPtr, &len);
11916 if (listPtr == (Jim_Obj*)EOF || len == 0) { // XXX
11917 Jim_SetResult(interp, Jim_NewIntObj(interp, -1));
11918 return JIM_OK;
11919 }
11920 JimListGetElements(interp, listPtr, &outc, &outVec);
11921 for (i = 0; i < outc; ++i) {
11922 if (Jim_Length(outVec[i]) > 0) {
11923 ++count;
11924 if (Jim_SetVariable(interp, argv[3+i], outVec[i]) != JIM_OK)
11925 goto err;
11926 }
11927 }
11928 Jim_FreeNewObj(interp, listPtr);
11929 Jim_SetResult(interp, Jim_NewIntObj(interp, count));
11930 } else {
11931 if (listPtr == (Jim_Obj*)EOF) {
11932 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
11933 return JIM_OK;
11934 }
11935 Jim_SetResult(interp, listPtr);
11936 }
11937 return JIM_OK;
11938 err:
11939 Jim_FreeNewObj(interp, listPtr);
11940 return JIM_ERR;
11941 }
11942
11943 /* [error] */
11944 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc,
11945 Jim_Obj *const *argv)
11946 {
11947 if (argc != 2) {
11948 Jim_WrongNumArgs(interp, 1, argv, "message");
11949 return JIM_ERR;
11950 }
11951 Jim_SetResult(interp, argv[1]);
11952 return JIM_ERR;
11953 }
11954
11955 /* [lrange] */
11956 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc,
11957 Jim_Obj *const *argv)
11958 {
11959 Jim_Obj *objPtr;
11960
11961 if (argc != 4) {
11962 Jim_WrongNumArgs(interp, 1, argv, "list first last");
11963 return JIM_ERR;
11964 }
11965 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
11966 return JIM_ERR;
11967 Jim_SetResult(interp, objPtr);
11968 return JIM_OK;
11969 }
11970
11971 /* [env] */
11972 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc,
11973 Jim_Obj *const *argv)
11974 {
11975 const char *key;
11976 char *val;
11977
11978 if (argc == 1) {
11979 extern char **environ;
11980
11981 int i;
11982 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
11983
11984 for (i = 0; environ[i]; i++) {
11985 const char *equals = strchr(environ[i], '=');
11986 if (equals) {
11987 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, environ[i], equals - environ[i]));
11988 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
11989 }
11990 }
11991
11992 Jim_SetResult(interp, listObjPtr);
11993 return JIM_OK;
11994 }
11995
11996 if (argc != 2) {
11997 Jim_WrongNumArgs(interp, 1, argv, "varName");
11998 return JIM_ERR;
11999 }
12000 key = Jim_GetString(argv[1], NULL);
12001 val = getenv(key);
12002 if (val == NULL) {
12003 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
12004 Jim_AppendStrings(interp, Jim_GetResult(interp),
12005 "environment variable \"",
12006 key, "\" does not exist", NULL);
12007 return JIM_ERR;
12008 }
12009 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
12010 return JIM_OK;
12011 }
12012
12013 /* [source] */
12014 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc,
12015 Jim_Obj *const *argv)
12016 {
12017 int retval;
12018
12019 if (argc != 2) {
12020 Jim_WrongNumArgs(interp, 1, argv, "fileName");
12021 return JIM_ERR;
12022 }
12023 retval = Jim_EvalFile(interp, Jim_GetString(argv[1], NULL));
12024 if (retval == JIM_ERR) {
12025 return JIM_ERR_ADDSTACK;
12026 }
12027 if (retval == JIM_RETURN)
12028 return JIM_OK;
12029 return retval;
12030 }
12031
12032 /* [lreverse] */
12033 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc,
12034 Jim_Obj *const *argv)
12035 {
12036 Jim_Obj *revObjPtr, **ele;
12037 int len;
12038
12039 if (argc != 2) {
12040 Jim_WrongNumArgs(interp, 1, argv, "list");
12041 return JIM_ERR;
12042 }
12043 JimListGetElements(interp, argv[1], &len, &ele);
12044 len--;
12045 revObjPtr = Jim_NewListObj(interp, NULL, 0);
12046 while (len >= 0)
12047 ListAppendElement(revObjPtr, ele[len--]);
12048 Jim_SetResult(interp, revObjPtr);
12049 return JIM_OK;
12050 }
12051
12052 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
12053 {
12054 jim_wide len;
12055
12056 if (step == 0) return -1;
12057 if (start == end) return 0;
12058 else if (step > 0 && start > end) return -1;
12059 else if (step < 0 && end > start) return -1;
12060 len = end-start;
12061 if (len < 0) len = -len; /* abs(len) */
12062 if (step < 0) step = -step; /* abs(step) */
12063 len = 1 + ((len-1)/step);
12064 /* We can truncate safely to INT_MAX, the range command
12065 * will always return an error for a such long range
12066 * because Tcl lists can't be so long. */
12067 if (len > INT_MAX) len = INT_MAX;
12068 return (int)((len < 0) ? -1 : len);
12069 }
12070
12071 /* [range] */
12072 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc,
12073 Jim_Obj *const *argv)
12074 {
12075 jim_wide start = 0, end, step = 1;
12076 int len, i;
12077 Jim_Obj *objPtr;
12078
12079 if (argc < 2 || argc > 4) {
12080 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
12081 return JIM_ERR;
12082 }
12083 if (argc == 2) {
12084 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
12085 return JIM_ERR;
12086 } else {
12087 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
12088 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
12089 return JIM_ERR;
12090 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
12091 return JIM_ERR;
12092 }
12093 if ((len = JimRangeLen(start, end, step)) == -1) {
12094 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
12095 return JIM_ERR;
12096 }
12097 objPtr = Jim_NewListObj(interp, NULL, 0);
12098 for (i = 0; i < len; i++)
12099 ListAppendElement(objPtr, Jim_NewIntObj(interp, start+i*step));
12100 Jim_SetResult(interp, objPtr);
12101 return JIM_OK;
12102 }
12103
12104 /* [rand] */
12105 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc,
12106 Jim_Obj *const *argv)
12107 {
12108 jim_wide min = 0, max, len, maxMul;
12109
12110 if (argc < 1 || argc > 3) {
12111 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
12112 return JIM_ERR;
12113 }
12114 if (argc == 1) {
12115 max = JIM_WIDE_MAX;
12116 } else if (argc == 2) {
12117 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
12118 return JIM_ERR;
12119 } else if (argc == 3) {
12120 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
12121 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
12122 return JIM_ERR;
12123 }
12124 len = max-min;
12125 if (len < 0) {
12126 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
12127 return JIM_ERR;
12128 }
12129 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
12130 while (1) {
12131 jim_wide r;
12132
12133 JimRandomBytes(interp, &r, sizeof(jim_wide));
12134 if (r < 0 || r >= maxMul) continue;
12135 r = (len == 0) ? 0 : r%len;
12136 Jim_SetResult(interp, Jim_NewIntObj(interp, min+r));
12137 return JIM_OK;
12138 }
12139 }
12140
12141 /* [package] */
12142 static int Jim_PackageCoreCommand(Jim_Interp *interp, int argc,
12143 Jim_Obj *const *argv)
12144 {
12145 int option;
12146 const char *options[] = {
12147 "require", "provide", NULL
12148 };
12149 enum {OPT_REQUIRE, OPT_PROVIDE};
12150
12151 if (argc < 2) {
12152 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
12153 return JIM_ERR;
12154 }
12155 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
12156 JIM_ERRMSG) != JIM_OK)
12157 return JIM_ERR;
12158
12159 if (option == OPT_REQUIRE) {
12160 int exact = 0;
12161 const char *ver;
12162
12163 if (Jim_CompareStringImmediate(interp, argv[2], "-exact")) {
12164 exact = 1;
12165 argv++;
12166 argc--;
12167 }
12168 if (argc != 3 && argc != 4) {
12169 Jim_WrongNumArgs(interp, 2, argv, "?-exact? package ?version?");
12170 return JIM_ERR;
12171 }
12172 ver = Jim_PackageRequire(interp, Jim_GetString(argv[2], NULL),
12173 argc == 4 ? Jim_GetString(argv[3], NULL) : "",
12174 JIM_ERRMSG);
12175 if (ver == NULL)
12176 return JIM_ERR_ADDSTACK;
12177 Jim_SetResultString(interp, ver, -1);
12178 } else if (option == OPT_PROVIDE) {
12179 if (argc != 4) {
12180 Jim_WrongNumArgs(interp, 2, argv, "package version");
12181 return JIM_ERR;
12182 }
12183 return Jim_PackageProvide(interp, Jim_GetString(argv[2], NULL),
12184 Jim_GetString(argv[3], NULL), JIM_ERRMSG);
12185 }
12186 return JIM_OK;
12187 }
12188
12189 static struct {
12190 const char *name;
12191 Jim_CmdProc cmdProc;
12192 } Jim_CoreCommandsTable[] = {
12193 {"set", Jim_SetCoreCommand},
12194 {"unset", Jim_UnsetCoreCommand},
12195 {"puts", Jim_PutsCoreCommand},
12196 {"+", Jim_AddCoreCommand},
12197 {"*", Jim_MulCoreCommand},
12198 {"-", Jim_SubCoreCommand},
12199 {"/", Jim_DivCoreCommand},
12200 {"incr", Jim_IncrCoreCommand},
12201 {"while", Jim_WhileCoreCommand},
12202 {"for", Jim_ForCoreCommand},
12203 {"foreach", Jim_ForeachCoreCommand},
12204 {"lmap", Jim_LmapCoreCommand},
12205 {"if", Jim_IfCoreCommand},
12206 {"switch", Jim_SwitchCoreCommand},
12207 {"list", Jim_ListCoreCommand},
12208 {"lindex", Jim_LindexCoreCommand},
12209 {"lset", Jim_LsetCoreCommand},
12210 {"llength", Jim_LlengthCoreCommand},
12211 {"lappend", Jim_LappendCoreCommand},
12212 {"linsert", Jim_LinsertCoreCommand},
12213 {"lsort", Jim_LsortCoreCommand},
12214 {"append", Jim_AppendCoreCommand},
12215 {"debug", Jim_DebugCoreCommand},
12216 {"eval", Jim_EvalCoreCommand},
12217 {"uplevel", Jim_UplevelCoreCommand},
12218 {"expr", Jim_ExprCoreCommand},
12219 {"break", Jim_BreakCoreCommand},
12220 {"continue", Jim_ContinueCoreCommand},
12221 {"proc", Jim_ProcCoreCommand},
12222 {"concat", Jim_ConcatCoreCommand},
12223 {"return", Jim_ReturnCoreCommand},
12224 {"upvar", Jim_UpvarCoreCommand},
12225 {"global", Jim_GlobalCoreCommand},
12226 {"string", Jim_StringCoreCommand},
12227 {"time", Jim_TimeCoreCommand},
12228 {"exit", Jim_ExitCoreCommand},
12229 {"catch", Jim_CatchCoreCommand},
12230 {"ref", Jim_RefCoreCommand},
12231 {"getref", Jim_GetrefCoreCommand},
12232 {"setref", Jim_SetrefCoreCommand},
12233 {"finalize", Jim_FinalizeCoreCommand},
12234 {"collect", Jim_CollectCoreCommand},
12235 {"rename", Jim_RenameCoreCommand},
12236 {"dict", Jim_DictCoreCommand},
12237 {"load", Jim_LoadCoreCommand},
12238 {"subst", Jim_SubstCoreCommand},
12239 {"info", Jim_InfoCoreCommand},
12240 {"split", Jim_SplitCoreCommand},
12241 {"join", Jim_JoinCoreCommand},
12242 {"format", Jim_FormatCoreCommand},
12243 {"scan", Jim_ScanCoreCommand},
12244 {"error", Jim_ErrorCoreCommand},
12245 {"lrange", Jim_LrangeCoreCommand},
12246 {"env", Jim_EnvCoreCommand},
12247 {"source", Jim_SourceCoreCommand},
12248 {"lreverse", Jim_LreverseCoreCommand},
12249 {"range", Jim_RangeCoreCommand},
12250 {"rand", Jim_RandCoreCommand},
12251 {"package", Jim_PackageCoreCommand},
12252 {"tailcall", Jim_TailcallCoreCommand},
12253 {NULL, NULL},
12254 };
12255
12256 /* Some Jim core command is actually a procedure written in Jim itself. */
12257 static void Jim_RegisterCoreProcedures(Jim_Interp *interp)
12258 {
12259 Jim_Eval(interp, (char*)
12260 "proc lambda {arglist args} {\n"
12261 " set name [ref {} function lambdaFinalizer]\n"
12262 " uplevel 1 [list proc $name $arglist {expand}$args]\n"
12263 " return $name\n"
12264 "}\n"
12265 "proc lambdaFinalizer {name val} {\n"
12266 " rename $name {}\n"
12267 "}\n"
12268 );
12269 }
12270
12271 void Jim_RegisterCoreCommands(Jim_Interp *interp)
12272 {
12273 int i = 0;
12274
12275 while(Jim_CoreCommandsTable[i].name != NULL) {
12276 Jim_CreateCommand(interp,
12277 Jim_CoreCommandsTable[i].name,
12278 Jim_CoreCommandsTable[i].cmdProc,
12279 NULL, NULL);
12280 i++;
12281 }
12282 Jim_RegisterCoreProcedures(interp);
12283 }
12284
12285 /* -----------------------------------------------------------------------------
12286 * Interactive prompt
12287 * ---------------------------------------------------------------------------*/
12288 void Jim_PrintErrorMessage(Jim_Interp *interp)
12289 {
12290 int len, i;
12291
12292 if (*interp->errorFileName) {
12293 Jim_fprintf(interp, interp->cookie_stderr, "Runtime error, file \"%s\", line %d:" JIM_NL " ",
12294 interp->errorFileName, interp->errorLine);
12295 }
12296 Jim_fprintf(interp,interp->cookie_stderr, "%s" JIM_NL,
12297 Jim_GetString(interp->result, NULL));
12298 Jim_ListLength(interp, interp->stackTrace, &len);
12299 for (i = len-3; i >= 0; i-= 3) {
12300 Jim_Obj *objPtr;
12301 const char *proc, *file, *line;
12302
12303 Jim_ListIndex(interp, interp->stackTrace, i, &objPtr, JIM_NONE);
12304 proc = Jim_GetString(objPtr, NULL);
12305 Jim_ListIndex(interp, interp->stackTrace, i+1, &objPtr,
12306 JIM_NONE);
12307 file = Jim_GetString(objPtr, NULL);
12308 Jim_ListIndex(interp, interp->stackTrace, i+2, &objPtr,
12309 JIM_NONE);
12310 line = Jim_GetString(objPtr, NULL);
12311 if (*proc) {
12312 Jim_fprintf( interp, interp->cookie_stderr,
12313 "in procedure '%s' ", proc);
12314 }
12315 if (*file) {
12316 Jim_fprintf( interp, interp->cookie_stderr,
12317 "called at file \"%s\", line %s",
12318 file, line);
12319 }
12320 if (*file || *proc) {
12321 Jim_fprintf( interp, interp->cookie_stderr, JIM_NL);
12322 }
12323 }
12324 }
12325
12326 int Jim_InteractivePrompt(Jim_Interp *interp)
12327 {
12328 int retcode = JIM_OK;
12329 Jim_Obj *scriptObjPtr;
12330
12331 Jim_fprintf(interp,interp->cookie_stdout, "Welcome to Jim version %d.%d, "
12332 "Copyright (c) 2005-8 Salvatore Sanfilippo" JIM_NL,
12333 JIM_VERSION / 100, JIM_VERSION % 100);
12334 Jim_SetVariableStrWithStr(interp, "jim_interactive", "1");
12335 while (1) {
12336 char buf[1024];
12337 const char *result;
12338 const char *retcodestr[] = {
12339 "ok", "error", "return", "break", "continue", "eval", "exit"
12340 };
12341 int reslen;
12342
12343 if (retcode != 0) {
12344 if (retcode >= 2 && retcode <= 6)
12345 Jim_fprintf(interp,interp->cookie_stdout, "[%s] . ", retcodestr[retcode]);
12346 else
12347 Jim_fprintf(interp,interp->cookie_stdout, "[%d] . ", retcode);
12348 } else
12349 Jim_fprintf( interp, interp->cookie_stdout, ". ");
12350 Jim_fflush( interp, interp->cookie_stdout);
12351 scriptObjPtr = Jim_NewStringObj(interp, "", 0);
12352 Jim_IncrRefCount(scriptObjPtr);
12353 while(1) {
12354 const char *str;
12355 char state;
12356 int len;
12357
12358 if ( Jim_fgets(interp, buf, 1024, interp->cookie_stdin) == NULL) {
12359 Jim_DecrRefCount(interp, scriptObjPtr);
12360 goto out;
12361 }
12362 Jim_AppendString(interp, scriptObjPtr, buf, -1);
12363 str = Jim_GetString(scriptObjPtr, &len);
12364 if (Jim_ScriptIsComplete(str, len, &state))
12365 break;
12366 Jim_fprintf( interp, interp->cookie_stdout, "%c> ", state);
12367 Jim_fflush( interp, interp->cookie_stdout);
12368 }
12369 retcode = Jim_EvalObj(interp, scriptObjPtr);
12370 Jim_DecrRefCount(interp, scriptObjPtr);
12371 result = Jim_GetString(Jim_GetResult(interp), &reslen);
12372 if (retcode == JIM_ERR) {
12373 Jim_PrintErrorMessage(interp);
12374 } else if (retcode == JIM_EXIT) {
12375 exit(Jim_GetExitCode(interp));
12376 } else {
12377 if (reslen) {
12378 Jim_fwrite( interp, result, 1, reslen, interp->cookie_stdout);
12379 Jim_fprintf( interp,interp->cookie_stdout, JIM_NL);
12380 }
12381 }
12382 }
12383 out:
12384 return 0;
12385 }
12386
12387 /* -----------------------------------------------------------------------------
12388 * Jim's idea of STDIO..
12389 * ---------------------------------------------------------------------------*/
12390
12391 int Jim_fprintf( Jim_Interp *interp, void *cookie, const char *fmt, ... )
12392 {
12393 int r;
12394
12395 va_list ap;
12396 va_start(ap,fmt);
12397 r = Jim_vfprintf( interp, cookie, fmt,ap );
12398 va_end(ap);
12399 return r;
12400 }
12401
12402 int Jim_vfprintf( Jim_Interp *interp, void *cookie, const char *fmt, va_list ap )
12403 {
12404 if( (interp == NULL) || (interp->cb_vfprintf == NULL) ){
12405 errno = ENOTSUP;
12406 return -1;
12407 }
12408 return (*(interp->cb_vfprintf))( cookie, fmt, ap );
12409 }
12410
12411 size_t Jim_fwrite( Jim_Interp *interp, const void *ptr, size_t size, size_t n, void *cookie )
12412 {
12413 if( (interp == NULL) || (interp->cb_fwrite == NULL) ){
12414 errno = ENOTSUP;
12415 return 0;
12416 }
12417 return (*(interp->cb_fwrite))( ptr, size, n, cookie);
12418 }
12419
12420 size_t Jim_fread( Jim_Interp *interp, void *ptr, size_t size, size_t n, void *cookie )
12421 {
12422 if( (interp == NULL) || (interp->cb_fread == NULL) ){
12423 errno = ENOTSUP;
12424 return 0;
12425 }
12426 return (*(interp->cb_fread))( ptr, size, n, cookie);
12427 }
12428
12429 int Jim_fflush( Jim_Interp *interp, void *cookie )
12430 {
12431 if( (interp == NULL) || (interp->cb_fflush == NULL) ){
12432 /* pretend all is well */
12433 return 0;
12434 }
12435 return (*(interp->cb_fflush))( cookie );
12436 }
12437
12438 char* Jim_fgets( Jim_Interp *interp, char *s, int size, void *cookie )
12439 {
12440 if( (interp == NULL) || (interp->cb_fgets == NULL) ){
12441 errno = ENOTSUP;
12442 return NULL;
12443 }
12444 return (*(interp->cb_fgets))( s, size, cookie );
12445 }
12446 Jim_Nvp *
12447 Jim_Nvp_name2value_simple( const Jim_Nvp *p, const char *name )
12448 {
12449 while( p->name ){
12450 if( 0 == strcmp( name, p->name ) ){
12451 break;
12452 }
12453 p++;
12454 }
12455 return ((Jim_Nvp *)(p));
12456 }
12457
12458 Jim_Nvp *
12459 Jim_Nvp_name2value_nocase_simple( const Jim_Nvp *p, const char *name )
12460 {
12461 while( p->name ){
12462 if( 0 == strcasecmp( name, p->name ) ){
12463 break;
12464 }
12465 p++;
12466 }
12467 return ((Jim_Nvp *)(p));
12468 }
12469
12470 int
12471 Jim_Nvp_name2value_obj( Jim_Interp *interp,
12472 const Jim_Nvp *p,
12473 Jim_Obj *o,
12474 Jim_Nvp **result )
12475 {
12476 return Jim_Nvp_name2value( interp, p, Jim_GetString( o, NULL ), result );
12477 }
12478
12479
12480 int
12481 Jim_Nvp_name2value( Jim_Interp *interp,
12482 const Jim_Nvp *_p,
12483 const char *name,
12484 Jim_Nvp **result)
12485 {
12486 const Jim_Nvp *p;
12487
12488 p = Jim_Nvp_name2value_simple( _p, name );
12489
12490 /* result */
12491 if( result ){
12492 *result = (Jim_Nvp *)(p);
12493 }
12494
12495 /* found? */
12496 if( p->name ){
12497 return JIM_OK;
12498 } else {
12499 return JIM_ERR;
12500 }
12501 }
12502
12503 int
12504 Jim_Nvp_name2value_obj_nocase( Jim_Interp *interp, const Jim_Nvp *p, Jim_Obj *o, Jim_Nvp **puthere )
12505 {
12506 return Jim_Nvp_name2value_nocase( interp, p, Jim_GetString( o, NULL ), puthere );
12507 }
12508
12509 int
12510 Jim_Nvp_name2value_nocase( Jim_Interp *interp, const Jim_Nvp *_p, const char *name, Jim_Nvp **puthere )
12511 {
12512 const Jim_Nvp *p;
12513
12514 p = Jim_Nvp_name2value_nocase_simple( _p, name );
12515
12516 if( puthere ){
12517 *puthere = (Jim_Nvp *)(p);
12518 }
12519 /* found */
12520 if( p->name ){
12521 return JIM_OK;
12522 } else {
12523 return JIM_ERR;
12524 }
12525 }
12526
12527
12528 int
12529 Jim_Nvp_value2name_obj( Jim_Interp *interp, const Jim_Nvp *p, Jim_Obj *o, Jim_Nvp **result )
12530 {
12531 int e;;
12532 jim_wide w;
12533
12534 e = Jim_GetWide( interp, o, &w );
12535 if( e != JIM_OK ){
12536 return e;
12537 }
12538
12539 return Jim_Nvp_value2name( interp, p, w, result );
12540 }
12541
12542 Jim_Nvp *
12543 Jim_Nvp_value2name_simple( const Jim_Nvp *p, int value )
12544 {
12545 while( p->name ){
12546 if( value == p->value ){
12547 break;
12548 }
12549 p++;
12550 }
12551 return ((Jim_Nvp *)(p));
12552 }
12553
12554
12555 int
12556 Jim_Nvp_value2name( Jim_Interp *interp, const Jim_Nvp *_p, int value, Jim_Nvp **result )
12557 {
12558 const Jim_Nvp *p;
12559
12560 p = Jim_Nvp_value2name_simple( _p, value );
12561
12562 if( result ){
12563 *result = (Jim_Nvp *)(p);
12564 }
12565
12566 if( p->name ){
12567 return JIM_OK;
12568 } else {
12569 return JIM_ERR;
12570 }
12571 }
12572
12573
12574 int
12575 Jim_GetOpt_Setup( Jim_GetOptInfo *p, Jim_Interp *interp, int argc, Jim_Obj * const * argv)
12576 {
12577 memset( p, 0, sizeof(*p) );
12578 p->interp = interp;
12579 p->argc = argc;
12580 p->argv = argv;
12581
12582 return JIM_OK;
12583 }
12584
12585 void
12586 Jim_GetOpt_Debug( Jim_GetOptInfo *p )
12587 {
12588 int x;
12589
12590 Jim_fprintf( p->interp, p->interp->cookie_stderr, "---args---\n");
12591 for( x = 0 ; x < p->argc ; x++ ){
12592 Jim_fprintf( p->interp, p->interp->cookie_stderr,
12593 "%2d) %s\n",
12594 x,
12595 Jim_GetString( p->argv[x], NULL ) );
12596 }
12597 Jim_fprintf( p->interp, p->interp->cookie_stderr, "-------\n");
12598 }
12599
12600
12601 int
12602 Jim_GetOpt_Obj( Jim_GetOptInfo *goi, Jim_Obj **puthere )
12603 {
12604 Jim_Obj *o;
12605
12606 o = NULL; // failure
12607 if( goi->argc ){
12608 // success
12609 o = goi->argv[0];
12610 goi->argc -= 1;
12611 goi->argv += 1;
12612 }
12613 if( puthere ){
12614 *puthere = o;
12615 }
12616 if( o != NULL ){
12617 return JIM_OK;
12618 } else {
12619 return JIM_ERR;
12620 }
12621 }
12622
12623 int
12624 Jim_GetOpt_String( Jim_GetOptInfo *goi, char **puthere, int *len )
12625 {
12626 int r;
12627 Jim_Obj *o;
12628 const char *cp;
12629
12630
12631 r = Jim_GetOpt_Obj( goi, &o );
12632 if( r == JIM_OK ){
12633 cp = Jim_GetString( o, len );
12634 if( puthere ){
12635 /* remove const */
12636 *puthere = (char *)(cp);
12637 }
12638 }
12639 return r;
12640 }
12641
12642 int
12643 Jim_GetOpt_Double( Jim_GetOptInfo *goi, double *puthere )
12644 {
12645 int r;
12646 Jim_Obj *o;
12647 double _safe;
12648
12649 if( puthere == NULL ){
12650 puthere = &_safe;
12651 }
12652
12653 r = Jim_GetOpt_Obj( goi, &o );
12654 if( r == JIM_OK ){
12655 r = Jim_GetDouble( goi->interp, o, puthere );
12656 if( r != JIM_OK ){
12657 Jim_SetResult_sprintf( goi->interp,
12658 "not a number: %s",
12659 Jim_GetString( o, NULL ) );
12660 }
12661 }
12662 return r;
12663 }
12664
12665 int
12666 Jim_GetOpt_Wide( Jim_GetOptInfo *goi, jim_wide *puthere )
12667 {
12668 int r;
12669 Jim_Obj *o;
12670 jim_wide _safe;
12671
12672 if( puthere == NULL ){
12673 puthere = &_safe;
12674 }
12675
12676 r = Jim_GetOpt_Obj( goi, &o );
12677 if( r == JIM_OK ){
12678 r = Jim_GetWide( goi->interp, o, puthere );
12679 }
12680 return r;
12681 }
12682
12683 int Jim_GetOpt_Nvp( Jim_GetOptInfo *goi,
12684 const Jim_Nvp *nvp,
12685 Jim_Nvp **puthere)
12686 {
12687 Jim_Nvp *_safe;
12688 Jim_Obj *o;
12689 int e;
12690
12691 if( puthere == NULL ){
12692 puthere = &_safe;
12693 }
12694
12695 e = Jim_GetOpt_Obj( goi, &o );
12696 if( e == JIM_OK ){
12697 e = Jim_Nvp_name2value_obj( goi->interp,
12698 nvp,
12699 o,
12700 puthere );
12701 }
12702
12703 return e;
12704 }
12705
12706 void
12707 Jim_GetOpt_NvpUnknown( Jim_GetOptInfo *goi,
12708 const Jim_Nvp *nvptable,
12709 int hadprefix )
12710 {
12711 if( hadprefix ){
12712 Jim_SetResult_NvpUnknown( goi->interp,
12713 goi->argv[-2],
12714 goi->argv[-1],
12715 nvptable );
12716 } else {
12717 Jim_SetResult_NvpUnknown( goi->interp,
12718 NULL,
12719 goi->argv[-1],
12720 nvptable );
12721 }
12722 }
12723
12724
12725 int
12726 Jim_GetOpt_Enum( Jim_GetOptInfo *goi,
12727 const char * const * lookup,
12728 int *puthere)
12729 {
12730 int _safe;
12731 Jim_Obj *o;
12732 int e;
12733
12734 if( puthere == NULL ){
12735 puthere = &_safe;
12736 }
12737 e = Jim_GetOpt_Obj( goi, &o );
12738 if( e == JIM_OK ){
12739 e = Jim_GetEnum( goi->interp,
12740 o,
12741 lookup,
12742 puthere,
12743 "option",
12744 JIM_ERRMSG );
12745 }
12746 return e;
12747 }
12748
12749
12750
12751 int
12752 Jim_SetResult_sprintf( Jim_Interp *interp, const char *fmt,... )
12753 {
12754 va_list ap;
12755 char *buf;
12756
12757 va_start(ap,fmt);
12758 buf = jim_vasprintf( fmt, ap );
12759 va_end(ap);
12760 if( buf ){
12761 Jim_SetResultString( interp, buf, -1 );
12762 jim_vasprintf_done(buf);
12763 }
12764 return JIM_OK;
12765 }
12766
12767
12768 void
12769 Jim_SetResult_NvpUnknown( Jim_Interp *interp,
12770 Jim_Obj *param_name,
12771 Jim_Obj *param_value,
12772 const Jim_Nvp *nvp )
12773 {
12774 if( param_name ){
12775 Jim_SetResult_sprintf( interp,
12776 "%s: Unknown: %s, try one of: ",
12777 Jim_GetString( param_name, NULL ),
12778 Jim_GetString( param_value, NULL ) );
12779 } else {
12780 Jim_SetResult_sprintf( interp,
12781 "Unknown param: %s, try one of: ",
12782 Jim_GetString( param_value, NULL ) );
12783 }
12784 while( nvp->name ){
12785 const char *a;
12786 const char *b;
12787
12788 if( (nvp+1)->name ){
12789 a = nvp->name;
12790 b = ", ";
12791 } else {
12792 a = "or ";
12793 b = nvp->name;
12794 }
12795 Jim_AppendStrings( interp,
12796 Jim_GetResult(interp),
12797 a, b, NULL );
12798 nvp++;
12799 }
12800 }
12801
12802
12803 static Jim_Obj *debug_string_obj;
12804
12805 const char *
12806 Jim_Debug_ArgvString( Jim_Interp *interp, int argc, Jim_Obj *const *argv )
12807 {
12808 int x;
12809
12810 if( debug_string_obj ){
12811 Jim_FreeObj( interp, debug_string_obj );
12812 }
12813
12814 debug_string_obj = Jim_NewEmptyStringObj( interp );
12815 for( x = 0 ; x < argc ; x++ ){
12816 Jim_AppendStrings( interp,
12817 debug_string_obj,
12818 Jim_GetString( argv[x], NULL ),
12819 " ",
12820 NULL );
12821 }
12822
12823 return Jim_GetString( debug_string_obj, NULL );
12824 }
12825
12826
12827
12828 /*
12829 * Local Variables: ***
12830 * c-basic-offset: 4 ***
12831 * tab-width: 4 ***
12832 * End: ***
12833 */

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)