arm11 burst writes are now only enabled for writes larger than 1 word. Single word...
[dnglaze.git] / src / helper / jim.c
blob48e21e9ee248a90fd179807bb1dcb2d7a6ce1ee4
1 /* Jim - A small embeddable Tcl interpreter
3 * Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
4 * Copyright 2005 Clemens Hintze <c.hintze@gmx.net>
5 * Copyright 2005 patthoyts - Pat Thoyts <patthoyts@users.sf.net>
6 * Copyright 2008,2009 oharboe - Øyvind Harboe - oyvind.harboe@zylin.com
7 * Copyright 2008 Andrew Lunn <andrew@lunn.ch>
8 * Copyright 2008 Duane Ellis <openocd@duaneellis.com>
9 * Copyright 2008 Uwe Klein <uklein@klein-messgeraete.de>
10 * Copyright 2008 Steve Bennett <steveb@workware.net.au>
11 * Copyright 2009 Nico Coesel <ncoesel@dealogic.nl>
12 * Copyright 2009 Zachary T Welch zw@superlucidity.net
13 * Copyright 2009 David Brownell
15 * The FreeBSD license
17 * Redistribution and use in source and binary forms, with or without
18 * modification, are permitted provided that the following conditions
19 * are met:
21 * 1. Redistributions of source code must retain the above copyright
22 * notice, this list of conditions and the following disclaimer.
23 * 2. Redistributions in binary form must reproduce the above
24 * copyright notice, this list of conditions and the following
25 * disclaimer in the documentation and/or other materials
26 * provided with the distribution.
28 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
29 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
30 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
31 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
32 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
33 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
34 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
35 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
36 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
37 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
38 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
39 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
41 * The views and conclusions contained in the software and documentation
42 * are those of the authors and should not be interpreted as representing
43 * official policies, either expressed or implied, of the Jim Tcl Project.
44 **/
45 #ifdef HAVE_CONFIG_H
46 #include "config.h"
47 #endif
49 #define __JIM_CORE__
50 #define JIM_OPTIMIZATION /* comment to avoid optimizations and reduce size */
52 #ifdef __ECOS
53 #include <pkgconf/jimtcl.h>
54 #include <stdio.h>
55 #include <stdlib.h>
56 #include <string.h>
57 #include <stdarg.h>
58 #include <ctype.h>
59 #include <limits.h>
60 #include <assert.h>
61 #include <errno.h>
62 #include <time.h>
63 #endif
64 #ifndef JIM_ANSIC
65 #define JIM_DYNLIB /* Dynamic library support for UNIX and WIN32 */
66 #endif /* JIM_ANSIC */
68 #include <stdarg.h>
69 #include <limits.h>
71 /* Include the platform dependent libraries for
72 * dynamic loading of libraries. */
73 #ifdef JIM_DYNLIB
74 #if defined(_WIN32) || defined(WIN32)
75 #ifndef WIN32
76 #define WIN32 1
77 #endif
78 #ifndef STRICT
79 #define STRICT
80 #endif
81 #define WIN32_LEAN_AND_MEAN
82 #include <windows.h>
83 #if _MSC_VER >= 1000
84 #pragma warning(disable:4146)
85 #endif /* _MSC_VER */
86 #else
87 #include <dlfcn.h>
88 #endif /* WIN32 */
89 #endif /* JIM_DYNLIB */
91 #ifdef __ECOS
92 #include <cyg/jimtcl/jim.h>
93 #else
94 #include "jim.h"
95 #endif
97 #ifdef HAVE_BACKTRACE
98 #include <execinfo.h>
99 #endif
101 /* -----------------------------------------------------------------------------
102 * Global variables
103 * ---------------------------------------------------------------------------*/
105 /* A shared empty string for the objects string representation.
106 * Jim_InvalidateStringRep knows about it and don't try to free. */
107 static char *JimEmptyStringRep = (char*) "";
109 /* -----------------------------------------------------------------------------
110 * Required prototypes of not exported functions
111 * ---------------------------------------------------------------------------*/
112 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf);
113 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int flags);
114 static void JimRegisterCoreApi(Jim_Interp *interp);
116 static Jim_HashTableType *getJimVariablesHashTableType(void);
118 /* -----------------------------------------------------------------------------
119 * Utility functions
120 * ---------------------------------------------------------------------------*/
122 static char *
123 jim_vasprintf(const char *fmt, va_list ap)
125 #ifndef HAVE_VASPRINTF
126 /* yucky way */
127 static char buf[2048];
128 vsnprintf(buf, sizeof(buf), fmt, ap);
129 /* garentee termination */
130 buf[sizeof(buf)-1] = 0;
131 #else
132 char *buf;
133 int result;
134 result = vasprintf(&buf, fmt, ap);
135 if (result < 0) exit(-1);
136 #endif
137 return buf;
140 static void
141 jim_vasprintf_done(void *buf)
143 #ifndef HAVE_VASPRINTF
144 (void)(buf);
145 #else
146 free(buf);
147 #endif
152 * Convert a string to a jim_wide INTEGER.
153 * This function originates from BSD.
155 * Ignores `locale' stuff. Assumes that the upper and lower case
156 * alphabets and digits are each contiguous.
158 #ifdef HAVE_LONG_LONG_INT
159 #define JimIsAscii(c) (((c) & ~0x7f) == 0)
160 static jim_wide JimStrtoll(const char *nptr, char **endptr, register int base)
162 register const char *s;
163 register unsigned jim_wide acc;
164 register unsigned char c;
165 register unsigned jim_wide qbase, cutoff;
166 register int neg, any, cutlim;
169 * Skip white space and pick up leading +/- sign if any.
170 * If base is 0, allow 0x for hex and 0 for octal, else
171 * assume decimal; if base is already 16, allow 0x.
173 s = nptr;
174 do {
175 c = *s++;
176 } while (isspace(c));
177 if (c == '-') {
178 neg = 1;
179 c = *s++;
180 } else {
181 neg = 0;
182 if (c == '+')
183 c = *s++;
185 if ((base == 0 || base == 16) &&
186 c == '0' && (*s == 'x' || *s == 'X')) {
187 c = s[1];
188 s += 2;
189 base = 16;
191 if (base == 0)
192 base = c == '0' ? 8 : 10;
195 * Compute the cutoff value between legal numbers and illegal
196 * numbers. That is the largest legal value, divided by the
197 * base. An input number that is greater than this value, if
198 * followed by a legal input character, is too big. One that
199 * is equal to this value may be valid or not; the limit
200 * between valid and invalid numbers is then based on the last
201 * digit. For instance, if the range for quads is
202 * [-9223372036854775808..9223372036854775807] and the input base
203 * is 10, cutoff will be set to 922337203685477580 and cutlim to
204 * either 7 (neg == 0) or 8 (neg == 1), meaning that if we have
205 * accumulated a value > 922337203685477580, or equal but the
206 * next digit is > 7 (or 8), the number is too big, and we will
207 * return a range error.
209 * Set any if any `digits' consumed; make it negative to indicate
210 * overflow.
212 qbase = (unsigned)base;
213 cutoff = neg ? (unsigned jim_wide)-(LLONG_MIN + LLONG_MAX) + LLONG_MAX
214 : LLONG_MAX;
215 cutlim = (int)(cutoff % qbase);
216 cutoff /= qbase;
217 for (acc = 0, any = 0;; c = *s++) {
218 if (!JimIsAscii(c))
219 break;
220 if (isdigit(c))
221 c -= '0';
222 else if (isalpha(c))
223 c -= isupper(c) ? 'A' - 10 : 'a' - 10;
224 else
225 break;
226 if (c >= base)
227 break;
228 if (any < 0 || acc > cutoff || (acc == cutoff && c > cutlim))
229 any = -1;
230 else {
231 any = 1;
232 acc *= qbase;
233 acc += c;
236 if (any < 0) {
237 acc = neg ? LLONG_MIN : LLONG_MAX;
238 errno = ERANGE;
239 } else if (neg)
240 acc = -acc;
241 if (endptr != 0)
242 *endptr = (char *)(any ? s - 1 : nptr);
243 return (acc);
245 #endif
247 /* Glob-style pattern matching. */
248 static int JimStringMatch(const char *pattern, int patternLen,
249 const char *string, int stringLen, int nocase)
251 while (patternLen) {
252 switch (pattern[0]) {
253 case '*':
254 while (pattern[1] == '*') {
255 pattern++;
256 patternLen--;
258 if (patternLen == 1)
259 return 1; /* match */
260 while (stringLen) {
261 if (JimStringMatch(pattern + 1, patternLen-1,
262 string, stringLen, nocase))
263 return 1; /* match */
264 string++;
265 stringLen--;
267 return 0; /* no match */
268 break;
269 case '?':
270 if (stringLen == 0)
271 return 0; /* no match */
272 string++;
273 stringLen--;
274 break;
275 case '[':
277 int not, match;
279 pattern++;
280 patternLen--;
281 not = pattern[0] == '^';
282 if (not) {
283 pattern++;
284 patternLen--;
286 match = 0;
287 while (1) {
288 if (pattern[0] == '\\') {
289 pattern++;
290 patternLen--;
291 if (pattern[0] == string[0])
292 match = 1;
293 } else if (pattern[0] == ']') {
294 break;
295 } else if (patternLen == 0) {
296 pattern--;
297 patternLen++;
298 break;
299 } else if (pattern[1] == '-' && patternLen >= 3) {
300 int start = pattern[0];
301 int end = pattern[2];
302 int c = string[0];
303 if (start > end) {
304 int t = start;
305 start = end;
306 end = t;
308 if (nocase) {
309 start = tolower(start);
310 end = tolower(end);
311 c = tolower(c);
313 pattern += 2;
314 patternLen -= 2;
315 if (c >= start && c <= end)
316 match = 1;
317 } else {
318 if (!nocase) {
319 if (pattern[0] == string[0])
320 match = 1;
321 } else {
322 if (tolower((int)pattern[0]) == tolower((int)string[0]))
323 match = 1;
326 pattern++;
327 patternLen--;
329 if (not)
330 match = !match;
331 if (!match)
332 return 0; /* no match */
333 string++;
334 stringLen--;
335 break;
337 case '\\':
338 if (patternLen >= 2) {
339 pattern++;
340 patternLen--;
342 /* fall through */
343 default:
344 if (!nocase) {
345 if (pattern[0] != string[0])
346 return 0; /* no match */
347 } else {
348 if (tolower((int)pattern[0]) != tolower((int)string[0]))
349 return 0; /* no match */
351 string++;
352 stringLen--;
353 break;
355 pattern++;
356 patternLen--;
357 if (stringLen == 0) {
358 while (*pattern == '*') {
359 pattern++;
360 patternLen--;
362 break;
365 if (patternLen == 0 && stringLen == 0)
366 return 1;
367 return 0;
370 int JimStringCompare(const char *s1, int l1, const char *s2, int l2,
371 int nocase)
373 unsigned char *u1 = (unsigned char*) s1, *u2 = (unsigned char*) s2;
375 if (nocase == 0) {
376 while (l1 && l2) {
377 if (*u1 != *u2)
378 return (int)*u1-*u2;
379 u1++; u2++; l1--; l2--;
381 if (!l1 && !l2) return 0;
382 return l1-l2;
383 } else {
384 while (l1 && l2) {
385 if (tolower((int)*u1) != tolower((int)*u2))
386 return tolower((int)*u1)-tolower((int)*u2);
387 u1++; u2++; l1--; l2--;
389 if (!l1 && !l2) return 0;
390 return l1-l2;
394 /* Search 's1' inside 's2', starting to search from char 'index' of 's2'.
395 * The index of the first occurrence of s1 in s2 is returned.
396 * If s1 is not found inside s2, -1 is returned. */
397 int JimStringFirst(const char *s1, int l1, const char *s2, int l2, int index)
399 int i;
401 if (!l1 || !l2 || l1 > l2) return -1;
402 if (index < 0) index = 0;
403 s2 += index;
404 for (i = index; i <= l2-l1; i++) {
405 if (memcmp(s2, s1, l1) == 0)
406 return i;
407 s2++;
409 return -1;
412 int Jim_WideToString(char *buf, jim_wide wideValue)
414 const char *fmt = "%" JIM_WIDE_MODIFIER;
415 return sprintf(buf, fmt, wideValue);
418 int Jim_StringToWide(const char *str, jim_wide *widePtr, int base)
420 char *endptr;
422 #ifdef HAVE_LONG_LONG_INT
423 *widePtr = JimStrtoll(str, &endptr, base);
424 #else
425 *widePtr = strtol(str, &endptr, base);
426 #endif
427 if ((str[0] == '\0') || (str == endptr))
428 return JIM_ERR;
429 if (endptr[0] != '\0') {
430 while (*endptr) {
431 if (!isspace((int)*endptr))
432 return JIM_ERR;
433 endptr++;
436 return JIM_OK;
439 int Jim_StringToIndex(const char *str, int *intPtr)
441 char *endptr;
443 *intPtr = strtol(str, &endptr, 10);
444 if ((str[0] == '\0') || (str == endptr))
445 return JIM_ERR;
446 if (endptr[0] != '\0') {
447 while (*endptr) {
448 if (!isspace((int)*endptr))
449 return JIM_ERR;
450 endptr++;
453 return JIM_OK;
456 /* The string representation of references has two features in order
457 * to make the GC faster. The first is that every reference starts
458 * with a non common character '~', in order to make the string matching
459 * fater. The second is that the reference string rep his 32 characters
460 * in length, this allows to avoid to check every object with a string
461 * repr < 32, and usually there are many of this objects. */
463 #define JIM_REFERENCE_SPACE (35 + JIM_REFERENCE_TAGLEN)
465 static int JimFormatReference(char *buf, Jim_Reference *refPtr, jim_wide id)
467 const char *fmt = "<reference.<%s>.%020" JIM_WIDE_MODIFIER ">";
468 sprintf(buf, fmt, refPtr->tag, id);
469 return JIM_REFERENCE_SPACE;
472 int Jim_DoubleToString(char *buf, double doubleValue)
474 char *s;
475 int len;
477 len = sprintf(buf, "%.17g", doubleValue);
478 s = buf;
479 while (*s) {
480 if (*s == '.') return len;
481 s++;
483 /* Add a final ".0" if it's a number. But not
484 * for NaN or InF */
485 if (isdigit((int)buf[0])
486 || ((buf[0] == '-' || buf[0] == '+')
487 && isdigit((int)buf[1]))) {
488 s[0] = '.';
489 s[1] = '0';
490 s[2] = '\0';
491 return len + 2;
493 return len;
496 int Jim_StringToDouble(const char *str, double *doublePtr)
498 char *endptr;
500 *doublePtr = strtod(str, &endptr);
501 if (str[0] == '\0' || endptr[0] != '\0' || (str == endptr))
502 return JIM_ERR;
503 return JIM_OK;
506 static jim_wide JimPowWide(jim_wide b, jim_wide e)
508 jim_wide i, res = 1;
509 if ((b == 0 && e != 0) || (e < 0)) return 0;
510 for (i = 0; i < e; i++) {res *= b;}
511 return res;
514 /* -----------------------------------------------------------------------------
515 * Special functions
516 * ---------------------------------------------------------------------------*/
518 /* Note that 'interp' may be NULL if not available in the
519 * context of the panic. It's only useful to get the error
520 * file descriptor, it will default to stderr otherwise. */
521 void Jim_Panic(Jim_Interp *interp, const char *fmt, ...)
523 va_list ap;
525 va_start(ap, fmt);
527 * Send it here first.. Assuming STDIO still works
529 fprintf(stderr, JIM_NL "JIM INTERPRETER PANIC: ");
530 vfprintf(stderr, fmt, ap);
531 fprintf(stderr, JIM_NL JIM_NL);
532 va_end(ap);
534 #ifdef HAVE_BACKTRACE
536 void *array[40];
537 int size, i;
538 char **strings;
540 size = backtrace(array, 40);
541 strings = backtrace_symbols(array, size);
542 for (i = 0; i < size; i++)
543 fprintf(fp,"[backtrace] %s" JIM_NL, strings[i]);
544 fprintf(fp,"[backtrace] Include the above lines and the output" JIM_NL);
545 fprintf(fp,"[backtrace] of 'nm <executable>' in the bug report." JIM_NL);
547 #endif
549 /* This may actually crash... we do it last */
550 if (interp && interp->cookie_stderr) {
551 Jim_fprintf(interp, interp->cookie_stderr, JIM_NL "JIM INTERPRETER PANIC: ");
552 Jim_vfprintf(interp, interp->cookie_stderr, fmt, ap);
553 Jim_fprintf(interp, interp->cookie_stderr, JIM_NL JIM_NL);
555 abort();
558 /* -----------------------------------------------------------------------------
559 * Memory allocation
560 * ---------------------------------------------------------------------------*/
562 /* Macro used for memory debugging.
563 * In order for they to work you have to rename Jim_Alloc into _Jim_Alloc
564 * and similary for Jim_Realloc and Jim_Free */
565 #if 0
566 #define Jim_Alloc(s) (printf("%s %d: Jim_Alloc(%d)\n",__FILE__,__LINE__,s),_Jim_Alloc(s))
567 #define Jim_Free(p) (printf("%s %d: Jim_Free(%p)\n",__FILE__,__LINE__,p),_Jim_Free(p))
568 #define Jim_Realloc(p,s) (printf("%s %d: Jim_Realloc(%p,%d)\n",__FILE__,__LINE__,p,s),_Jim_Realloc(p,s))
569 #endif
571 void *Jim_Alloc(int size)
573 /* We allocate zero length arrayes, etc. to use a single orthogonal codepath */
574 if (size == 0)
575 size = 1;
576 void *p = malloc(size);
577 if (p == NULL)
578 Jim_Panic(NULL,"malloc: Out of memory");
579 return p;
582 void Jim_Free(void *ptr) {
583 free(ptr);
586 void *Jim_Realloc(void *ptr, int size)
588 /* We allocate zero length arrayes, etc. to use a single orthogonal codepath */
589 if (size == 0)
590 size = 1;
591 void *p = realloc(ptr, size);
592 if (p == NULL)
593 Jim_Panic(NULL,"realloc: Out of memory");
594 return p;
597 char *Jim_StrDup(const char *s)
599 int l = strlen(s);
600 char *copy = Jim_Alloc(l + 1);
602 memcpy(copy, s, l + 1);
603 return copy;
606 char *Jim_StrDupLen(const char *s, int l)
608 char *copy = Jim_Alloc(l + 1);
610 memcpy(copy, s, l + 1);
611 copy[l] = 0; /* Just to be sure, original could be substring */
612 return copy;
615 /* -----------------------------------------------------------------------------
616 * Time related functions
617 * ---------------------------------------------------------------------------*/
618 /* Returns microseconds of CPU used since start. */
619 static jim_wide JimClock(void)
621 #if (defined WIN32) && !(defined JIM_ANSIC)
622 LARGE_INTEGER t, f;
623 QueryPerformanceFrequency(&f);
624 QueryPerformanceCounter(&t);
625 return (long)((t.QuadPart * 1000000) / f.QuadPart);
626 #else /* !WIN32 */
627 clock_t clocks = clock();
629 return (long)(clocks*(1000000/CLOCKS_PER_SEC));
630 #endif /* WIN32 */
633 /* -----------------------------------------------------------------------------
634 * Hash Tables
635 * ---------------------------------------------------------------------------*/
637 /* -------------------------- private prototypes ---------------------------- */
638 static int JimExpandHashTableIfNeeded(Jim_HashTable *ht);
639 static unsigned int JimHashTableNextPower(unsigned int size);
640 static int JimInsertHashEntry(Jim_HashTable *ht, const void *key);
642 /* -------------------------- hash functions -------------------------------- */
644 /* Thomas Wang's 32 bit Mix Function */
645 unsigned int Jim_IntHashFunction(unsigned int key)
647 key += ~(key << 15);
648 key ^= (key >> 10);
649 key += (key << 3);
650 key ^= (key >> 6);
651 key += ~(key << 11);
652 key ^= (key >> 16);
653 return key;
656 /* Identity hash function for integer keys */
657 unsigned int Jim_IdentityHashFunction(unsigned int key)
659 return key;
662 /* Generic hash function (we are using to multiply by 9 and add the byte
663 * as Tcl) */
664 unsigned int Jim_GenHashFunction(const unsigned char *buf, int len)
666 unsigned int h = 0;
667 while (len--)
668 h += (h << 3)+*buf++;
669 return h;
672 /* ----------------------------- API implementation ------------------------- */
673 /* reset an hashtable already initialized with ht_init().
674 * NOTE: This function should only called by ht_destroy(). */
675 static void JimResetHashTable(Jim_HashTable *ht)
677 ht->table = NULL;
678 ht->size = 0;
679 ht->sizemask = 0;
680 ht->used = 0;
681 ht->collisions = 0;
684 /* Initialize the hash table */
685 int Jim_InitHashTable(Jim_HashTable *ht, Jim_HashTableType *type,
686 void *privDataPtr)
688 JimResetHashTable(ht);
689 ht->type = type;
690 ht->privdata = privDataPtr;
691 return JIM_OK;
694 /* Resize the table to the minimal size that contains all the elements,
695 * but with the invariant of a USER/BUCKETS ration near to <= 1 */
696 int Jim_ResizeHashTable(Jim_HashTable *ht)
698 int minimal = ht->used;
700 if (minimal < JIM_HT_INITIAL_SIZE)
701 minimal = JIM_HT_INITIAL_SIZE;
702 return Jim_ExpandHashTable(ht, minimal);
705 /* Expand or create the hashtable */
706 int Jim_ExpandHashTable(Jim_HashTable *ht, unsigned int size)
708 Jim_HashTable n; /* the new hashtable */
709 unsigned int realsize = JimHashTableNextPower(size), i;
711 /* the size is invalid if it is smaller than the number of
712 * elements already inside the hashtable */
713 if (ht->used >= size)
714 return JIM_ERR;
716 Jim_InitHashTable(&n, ht->type, ht->privdata);
717 n.size = realsize;
718 n.sizemask = realsize-1;
719 n.table = Jim_Alloc(realsize*sizeof(Jim_HashEntry*));
721 /* Initialize all the pointers to NULL */
722 memset(n.table, 0, realsize*sizeof(Jim_HashEntry*));
724 /* Copy all the elements from the old to the new table:
725 * note that if the old hash table is empty ht->size is zero,
726 * so Jim_ExpandHashTable just creates an hash table. */
727 n.used = ht->used;
728 for (i = 0; i < ht->size && ht->used > 0; i++) {
729 Jim_HashEntry *he, *nextHe;
731 if (ht->table[i] == NULL) continue;
733 /* For each hash entry on this slot... */
734 he = ht->table[i];
735 while (he) {
736 unsigned int h;
738 nextHe = he->next;
739 /* Get the new element index */
740 h = Jim_HashKey(ht, he->key) & n.sizemask;
741 he->next = n.table[h];
742 n.table[h] = he;
743 ht->used--;
744 /* Pass to the next element */
745 he = nextHe;
748 assert(ht->used == 0);
749 Jim_Free(ht->table);
751 /* Remap the new hashtable in the old */
752 *ht = n;
753 return JIM_OK;
756 /* Add an element to the target hash table */
757 int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val)
759 int index;
760 Jim_HashEntry *entry;
762 /* Get the index of the new element, or -1 if
763 * the element already exists. */
764 if ((index = JimInsertHashEntry(ht, key)) == -1)
765 return JIM_ERR;
767 /* Allocates the memory and stores key */
768 entry = Jim_Alloc(sizeof(*entry));
769 entry->next = ht->table[index];
770 ht->table[index] = entry;
772 /* Set the hash entry fields. */
773 Jim_SetHashKey(ht, entry, key);
774 Jim_SetHashVal(ht, entry, val);
775 ht->used++;
776 return JIM_OK;
779 /* Add an element, discarding the old if the key already exists */
780 int Jim_ReplaceHashEntry(Jim_HashTable *ht, const void *key, void *val)
782 Jim_HashEntry *entry;
784 /* Try to add the element. If the key
785 * does not exists Jim_AddHashEntry will suceed. */
786 if (Jim_AddHashEntry(ht, key, val) == JIM_OK)
787 return JIM_OK;
788 /* It already exists, get the entry */
789 entry = Jim_FindHashEntry(ht, key);
790 /* Free the old value and set the new one */
791 Jim_FreeEntryVal(ht, entry);
792 Jim_SetHashVal(ht, entry, val);
793 return JIM_OK;
796 /* Search and remove an element */
797 int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key)
799 unsigned int h;
800 Jim_HashEntry *he, *prevHe;
802 if (ht->size == 0)
803 return JIM_ERR;
804 h = Jim_HashKey(ht, key) & ht->sizemask;
805 he = ht->table[h];
807 prevHe = NULL;
808 while (he) {
809 if (Jim_CompareHashKeys(ht, key, he->key)) {
810 /* Unlink the element from the list */
811 if (prevHe)
812 prevHe->next = he->next;
813 else
814 ht->table[h] = he->next;
815 Jim_FreeEntryKey(ht, he);
816 Jim_FreeEntryVal(ht, he);
817 Jim_Free(he);
818 ht->used--;
819 return JIM_OK;
821 prevHe = he;
822 he = he->next;
824 return JIM_ERR; /* not found */
827 /* Destroy an entire hash table */
828 int Jim_FreeHashTable(Jim_HashTable *ht)
830 unsigned int i;
832 /* Free all the elements */
833 for (i = 0; i < ht->size && ht->used > 0; i++) {
834 Jim_HashEntry *he, *nextHe;
836 if ((he = ht->table[i]) == NULL) continue;
837 while (he) {
838 nextHe = he->next;
839 Jim_FreeEntryKey(ht, he);
840 Jim_FreeEntryVal(ht, he);
841 Jim_Free(he);
842 ht->used--;
843 he = nextHe;
846 /* Free the table and the allocated cache structure */
847 Jim_Free(ht->table);
848 /* Re-initialize the table */
849 JimResetHashTable(ht);
850 return JIM_OK; /* never fails */
853 Jim_HashEntry *Jim_FindHashEntry(Jim_HashTable *ht, const void *key)
855 Jim_HashEntry *he;
856 unsigned int h;
858 if (ht->size == 0) return NULL;
859 h = Jim_HashKey(ht, key) & ht->sizemask;
860 he = ht->table[h];
861 while (he) {
862 if (Jim_CompareHashKeys(ht, key, he->key))
863 return he;
864 he = he->next;
866 return NULL;
869 Jim_HashTableIterator *Jim_GetHashTableIterator(Jim_HashTable *ht)
871 Jim_HashTableIterator *iter = Jim_Alloc(sizeof(*iter));
873 iter->ht = ht;
874 iter->index = -1;
875 iter->entry = NULL;
876 iter->nextEntry = NULL;
877 return iter;
880 Jim_HashEntry *Jim_NextHashEntry(Jim_HashTableIterator *iter)
882 while (1) {
883 if (iter->entry == NULL) {
884 iter->index++;
885 if (iter->index >=
886 (signed)iter->ht->size) break;
887 iter->entry = iter->ht->table[iter->index];
888 } else {
889 iter->entry = iter->nextEntry;
891 if (iter->entry) {
892 /* We need to save the 'next' here, the iterator user
893 * may delete the entry we are returning. */
894 iter->nextEntry = iter->entry->next;
895 return iter->entry;
898 return NULL;
901 /* ------------------------- private functions ------------------------------ */
903 /* Expand the hash table if needed */
904 static int JimExpandHashTableIfNeeded(Jim_HashTable *ht)
906 /* If the hash table is empty expand it to the intial size,
907 * if the table is "full" dobule its size. */
908 if (ht->size == 0)
909 return Jim_ExpandHashTable(ht, JIM_HT_INITIAL_SIZE);
910 if (ht->size == ht->used)
911 return Jim_ExpandHashTable(ht, ht->size*2);
912 return JIM_OK;
915 /* Our hash table capability is a power of two */
916 static unsigned int JimHashTableNextPower(unsigned int size)
918 unsigned int i = JIM_HT_INITIAL_SIZE;
920 if (size >= 2147483648U)
921 return 2147483648U;
922 while (1) {
923 if (i >= size)
924 return i;
925 i *= 2;
929 /* Returns the index of a free slot that can be populated with
930 * an hash entry for the given 'key'.
931 * If the key already exists, -1 is returned. */
932 static int JimInsertHashEntry(Jim_HashTable *ht, const void *key)
934 unsigned int h;
935 Jim_HashEntry *he;
937 /* Expand the hashtable if needed */
938 if (JimExpandHashTableIfNeeded(ht) == JIM_ERR)
939 return -1;
940 /* Compute the key hash value */
941 h = Jim_HashKey(ht, key) & ht->sizemask;
942 /* Search if this slot does not already contain the given key */
943 he = ht->table[h];
944 while (he) {
945 if (Jim_CompareHashKeys(ht, key, he->key))
946 return -1;
947 he = he->next;
949 return h;
952 /* ----------------------- StringCopy Hash Table Type ------------------------*/
954 static unsigned int JimStringCopyHTHashFunction(const void *key)
956 return Jim_GenHashFunction(key, strlen(key));
959 static const void *JimStringCopyHTKeyDup(void *privdata, const void *key)
961 int len = strlen(key);
962 char *copy = Jim_Alloc(len + 1);
963 JIM_NOTUSED(privdata);
965 memcpy(copy, key, len);
966 copy[len] = '\0';
967 return copy;
970 static void *JimStringKeyValCopyHTValDup(void *privdata, const void *val)
972 int len = strlen(val);
973 char *copy = Jim_Alloc(len + 1);
974 JIM_NOTUSED(privdata);
976 memcpy(copy, val, len);
977 copy[len] = '\0';
978 return copy;
981 static int JimStringCopyHTKeyCompare(void *privdata, const void *key1,
982 const void *key2)
984 JIM_NOTUSED(privdata);
986 return strcmp(key1, key2) == 0;
989 static void JimStringCopyHTKeyDestructor(void *privdata, const void *key)
991 JIM_NOTUSED(privdata);
993 Jim_Free((void*)key); /* ATTENTION: const cast */
996 static void JimStringKeyValCopyHTValDestructor(void *privdata, void *val)
998 JIM_NOTUSED(privdata);
1000 Jim_Free((void*)val); /* ATTENTION: const cast */
1003 static Jim_HashTableType JimStringCopyHashTableType = {
1004 JimStringCopyHTHashFunction, /* hash function */
1005 JimStringCopyHTKeyDup, /* key dup */
1006 NULL, /* val dup */
1007 JimStringCopyHTKeyCompare, /* key compare */
1008 JimStringCopyHTKeyDestructor, /* key destructor */
1009 NULL /* val destructor */
1012 /* This is like StringCopy but does not auto-duplicate the key.
1013 * It's used for intepreter's shared strings. */
1014 static Jim_HashTableType JimSharedStringsHashTableType = {
1015 JimStringCopyHTHashFunction, /* hash function */
1016 NULL, /* key dup */
1017 NULL, /* val dup */
1018 JimStringCopyHTKeyCompare, /* key compare */
1019 JimStringCopyHTKeyDestructor, /* key destructor */
1020 NULL /* val destructor */
1023 /* This is like StringCopy but also automatically handle dynamic
1024 * allocated C strings as values. */
1025 static Jim_HashTableType JimStringKeyValCopyHashTableType = {
1026 JimStringCopyHTHashFunction, /* hash function */
1027 JimStringCopyHTKeyDup, /* key dup */
1028 JimStringKeyValCopyHTValDup, /* val dup */
1029 JimStringCopyHTKeyCompare, /* key compare */
1030 JimStringCopyHTKeyDestructor, /* key destructor */
1031 JimStringKeyValCopyHTValDestructor, /* val destructor */
1034 typedef struct AssocDataValue {
1035 Jim_InterpDeleteProc *delProc;
1036 void *data;
1037 } AssocDataValue;
1039 static void JimAssocDataHashTableValueDestructor(void *privdata, void *data)
1041 AssocDataValue *assocPtr = (AssocDataValue *)data;
1042 if (assocPtr->delProc != NULL)
1043 assocPtr->delProc((Jim_Interp *)privdata, assocPtr->data);
1044 Jim_Free(data);
1047 static Jim_HashTableType JimAssocDataHashTableType = {
1048 JimStringCopyHTHashFunction, /* hash function */
1049 JimStringCopyHTKeyDup, /* key dup */
1050 NULL, /* val dup */
1051 JimStringCopyHTKeyCompare, /* key compare */
1052 JimStringCopyHTKeyDestructor, /* key destructor */
1053 JimAssocDataHashTableValueDestructor /* val destructor */
1056 /* -----------------------------------------------------------------------------
1057 * Stack - This is a simple generic stack implementation. It is used for
1058 * example in the 'expr' expression compiler.
1059 * ---------------------------------------------------------------------------*/
1060 void Jim_InitStack(Jim_Stack *stack)
1062 stack->len = 0;
1063 stack->maxlen = 0;
1064 stack->vector = NULL;
1067 void Jim_FreeStack(Jim_Stack *stack)
1069 Jim_Free(stack->vector);
1072 int Jim_StackLen(Jim_Stack *stack)
1074 return stack->len;
1077 void Jim_StackPush(Jim_Stack *stack, void *element) {
1078 int neededLen = stack->len + 1;
1079 if (neededLen > stack->maxlen) {
1080 stack->maxlen = neededLen*2;
1081 stack->vector = Jim_Realloc(stack->vector, sizeof(void*)*stack->maxlen);
1083 stack->vector[stack->len] = element;
1084 stack->len++;
1087 void *Jim_StackPop(Jim_Stack *stack)
1089 if (stack->len == 0) return NULL;
1090 stack->len--;
1091 return stack->vector[stack->len];
1094 void *Jim_StackPeek(Jim_Stack *stack)
1096 if (stack->len == 0) return NULL;
1097 return stack->vector[stack->len-1];
1100 void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc)(void *ptr))
1102 int i;
1104 for (i = 0; i < stack->len; i++)
1105 freeFunc(stack->vector[i]);
1108 /* -----------------------------------------------------------------------------
1109 * Parser
1110 * ---------------------------------------------------------------------------*/
1112 /* Token types */
1113 #define JIM_TT_NONE -1 /* No token returned */
1114 #define JIM_TT_STR 0 /* simple string */
1115 #define JIM_TT_ESC 1 /* string that needs escape chars conversion */
1116 #define JIM_TT_VAR 2 /* var substitution */
1117 #define JIM_TT_DICTSUGAR 3 /* Syntax sugar for [dict get], $foo(bar) */
1118 #define JIM_TT_CMD 4 /* command substitution */
1119 #define JIM_TT_SEP 5 /* word separator */
1120 #define JIM_TT_EOL 6 /* line separator */
1122 /* Additional token types needed for expressions */
1123 #define JIM_TT_SUBEXPR_START 7
1124 #define JIM_TT_SUBEXPR_END 8
1125 #define JIM_TT_EXPR_NUMBER 9
1126 #define JIM_TT_EXPR_OPERATOR 10
1128 /* Parser states */
1129 #define JIM_PS_DEF 0 /* Default state */
1130 #define JIM_PS_QUOTE 1 /* Inside "" */
1132 /* Parser context structure. The same context is used both to parse
1133 * Tcl scripts and lists. */
1134 struct JimParserCtx {
1135 const char *prg; /* Program text */
1136 const char *p; /* Pointer to the point of the program we are parsing */
1137 int len; /* Left length of 'prg' */
1138 int linenr; /* Current line number */
1139 const char *tstart;
1140 const char *tend; /* Returned token is at tstart-tend in 'prg'. */
1141 int tline; /* Line number of the returned token */
1142 int tt; /* Token type */
1143 int eof; /* Non zero if EOF condition is true. */
1144 int state; /* Parser state */
1145 int comment; /* Non zero if the next chars may be a comment. */
1148 #define JimParserEof(c) ((c)->eof)
1149 #define JimParserTstart(c) ((c)->tstart)
1150 #define JimParserTend(c) ((c)->tend)
1151 #define JimParserTtype(c) ((c)->tt)
1152 #define JimParserTline(c) ((c)->tline)
1154 static int JimParseScript(struct JimParserCtx *pc);
1155 static int JimParseSep(struct JimParserCtx *pc);
1156 static int JimParseEol(struct JimParserCtx *pc);
1157 static int JimParseCmd(struct JimParserCtx *pc);
1158 static int JimParseVar(struct JimParserCtx *pc);
1159 static int JimParseBrace(struct JimParserCtx *pc);
1160 static int JimParseStr(struct JimParserCtx *pc);
1161 static int JimParseComment(struct JimParserCtx *pc);
1162 static char *JimParserGetToken(struct JimParserCtx *pc,
1163 int *lenPtr, int *typePtr, int *linePtr);
1165 /* Initialize a parser context.
1166 * 'prg' is a pointer to the program text, linenr is the line
1167 * number of the first line contained in the program. */
1168 void JimParserInit(struct JimParserCtx *pc, const char *prg,
1169 int len, int linenr)
1171 pc->prg = prg;
1172 pc->p = prg;
1173 pc->len = len;
1174 pc->tstart = NULL;
1175 pc->tend = NULL;
1176 pc->tline = 0;
1177 pc->tt = JIM_TT_NONE;
1178 pc->eof = 0;
1179 pc->state = JIM_PS_DEF;
1180 pc->linenr = linenr;
1181 pc->comment = 1;
1184 int JimParseScript(struct JimParserCtx *pc)
1186 while (1) { /* the while is used to reiterate with continue if needed */
1187 if (!pc->len) {
1188 pc->tstart = pc->p;
1189 pc->tend = pc->p-1;
1190 pc->tline = pc->linenr;
1191 pc->tt = JIM_TT_EOL;
1192 pc->eof = 1;
1193 return JIM_OK;
1195 switch (*(pc->p)) {
1196 case '\\':
1197 if (*(pc->p + 1) == '\n')
1198 return JimParseSep(pc);
1199 else {
1200 pc->comment = 0;
1201 return JimParseStr(pc);
1203 break;
1204 case ' ':
1205 case '\t':
1206 case '\r':
1207 if (pc->state == JIM_PS_DEF)
1208 return JimParseSep(pc);
1209 else {
1210 pc->comment = 0;
1211 return JimParseStr(pc);
1213 break;
1214 case '\n':
1215 case ';':
1216 pc->comment = 1;
1217 if (pc->state == JIM_PS_DEF)
1218 return JimParseEol(pc);
1219 else
1220 return JimParseStr(pc);
1221 break;
1222 case '[':
1223 pc->comment = 0;
1224 return JimParseCmd(pc);
1225 break;
1226 case '$':
1227 pc->comment = 0;
1228 if (JimParseVar(pc) == JIM_ERR) {
1229 pc->tstart = pc->tend = pc->p++; pc->len--;
1230 pc->tline = pc->linenr;
1231 pc->tt = JIM_TT_STR;
1232 return JIM_OK;
1233 } else
1234 return JIM_OK;
1235 break;
1236 case '#':
1237 if (pc->comment) {
1238 JimParseComment(pc);
1239 continue;
1240 } else {
1241 return JimParseStr(pc);
1243 default:
1244 pc->comment = 0;
1245 return JimParseStr(pc);
1246 break;
1248 return JIM_OK;
1252 int JimParseSep(struct JimParserCtx *pc)
1254 pc->tstart = pc->p;
1255 pc->tline = pc->linenr;
1256 while (*pc->p == ' ' || *pc->p == '\t' || *pc->p == '\r' ||
1257 (*pc->p == '\\' && *(pc->p + 1) == '\n')) {
1258 if (*pc->p == '\\') {
1259 pc->p++; pc->len--;
1260 pc->linenr++;
1262 pc->p++; pc->len--;
1264 pc->tend = pc->p-1;
1265 pc->tt = JIM_TT_SEP;
1266 return JIM_OK;
1269 int JimParseEol(struct JimParserCtx *pc)
1271 pc->tstart = pc->p;
1272 pc->tline = pc->linenr;
1273 while (*pc->p == ' ' || *pc->p == '\n' ||
1274 *pc->p == '\t' || *pc->p == '\r' || *pc->p == ';') {
1275 if (*pc->p == '\n')
1276 pc->linenr++;
1277 pc->p++; pc->len--;
1279 pc->tend = pc->p-1;
1280 pc->tt = JIM_TT_EOL;
1281 return JIM_OK;
1284 /* Todo. Don't stop if ']' appears inside {} or quoted.
1285 * Also should handle the case of puts [string length "]"] */
1286 int JimParseCmd(struct JimParserCtx *pc)
1288 int level = 1;
1289 int blevel = 0;
1291 pc->tstart = ++pc->p; pc->len--;
1292 pc->tline = pc->linenr;
1293 while (1) {
1294 if (pc->len == 0) {
1295 break;
1296 } else if (*pc->p == '[' && blevel == 0) {
1297 level++;
1298 } else if (*pc->p == ']' && blevel == 0) {
1299 level--;
1300 if (!level) break;
1301 } else if (*pc->p == '\\') {
1302 pc->p++; pc->len--;
1303 } else if (*pc->p == '{') {
1304 blevel++;
1305 } else if (*pc->p == '}') {
1306 if (blevel != 0)
1307 blevel--;
1308 } else if (*pc->p == '\n')
1309 pc->linenr++;
1310 pc->p++; pc->len--;
1312 pc->tend = pc->p-1;
1313 pc->tt = JIM_TT_CMD;
1314 if (*pc->p == ']') {
1315 pc->p++; pc->len--;
1317 return JIM_OK;
1320 int JimParseVar(struct JimParserCtx *pc)
1322 int brace = 0, stop = 0, ttype = JIM_TT_VAR;
1324 pc->tstart = ++pc->p; pc->len--; /* skip the $ */
1325 pc->tline = pc->linenr;
1326 if (*pc->p == '{') {
1327 pc->tstart = ++pc->p; pc->len--;
1328 brace = 1;
1330 if (brace) {
1331 while (!stop) {
1332 if (*pc->p == '}' || pc->len == 0) {
1333 pc->tend = pc->p-1;
1334 stop = 1;
1335 if (pc->len == 0)
1336 break;
1338 else if (*pc->p == '\n')
1339 pc->linenr++;
1340 pc->p++; pc->len--;
1342 } else {
1343 /* Include leading colons */
1344 while (*pc->p == ':') {
1345 pc->p++;
1346 pc->len--;
1348 while (!stop) {
1349 if (!((*pc->p >= 'a' && *pc->p <= 'z') ||
1350 (*pc->p >= 'A' && *pc->p <= 'Z') ||
1351 (*pc->p >= '0' && *pc->p <= '9') || *pc->p == '_'))
1352 stop = 1;
1353 else {
1354 pc->p++; pc->len--;
1357 /* Parse [dict get] syntax sugar. */
1358 if (*pc->p == '(') {
1359 while (*pc->p != ')' && pc->len) {
1360 pc->p++; pc->len--;
1361 if (*pc->p == '\\' && pc->len >= 2) {
1362 pc->p += 2; pc->len -= 2;
1365 if (*pc->p != '\0') {
1366 pc->p++; pc->len--;
1368 ttype = JIM_TT_DICTSUGAR;
1370 pc->tend = pc->p-1;
1372 /* Check if we parsed just the '$' character.
1373 * That's not a variable so an error is returned
1374 * to tell the state machine to consider this '$' just
1375 * a string. */
1376 if (pc->tstart == pc->p) {
1377 pc->p--; pc->len++;
1378 return JIM_ERR;
1380 pc->tt = ttype;
1381 return JIM_OK;
1384 int JimParseBrace(struct JimParserCtx *pc)
1386 int level = 1;
1388 pc->tstart = ++pc->p; pc->len--;
1389 pc->tline = pc->linenr;
1390 while (1) {
1391 if (*pc->p == '\\' && pc->len >= 2) {
1392 pc->p++; pc->len--;
1393 if (*pc->p == '\n')
1394 pc->linenr++;
1395 } else if (*pc->p == '{') {
1396 level++;
1397 } else if (pc->len == 0 || *pc->p == '}') {
1398 level--;
1399 if (pc->len == 0 || level == 0) {
1400 pc->tend = pc->p-1;
1401 if (pc->len != 0) {
1402 pc->p++; pc->len--;
1404 pc->tt = JIM_TT_STR;
1405 return JIM_OK;
1407 } else if (*pc->p == '\n') {
1408 pc->linenr++;
1410 pc->p++; pc->len--;
1412 return JIM_OK; /* unreached */
1415 int JimParseStr(struct JimParserCtx *pc)
1417 int newword = (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1418 pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR);
1419 if (newword && *pc->p == '{') {
1420 return JimParseBrace(pc);
1421 } else if (newword && *pc->p == '"') {
1422 pc->state = JIM_PS_QUOTE;
1423 pc->p++; pc->len--;
1425 pc->tstart = pc->p;
1426 pc->tline = pc->linenr;
1427 while (1) {
1428 if (pc->len == 0) {
1429 pc->tend = pc->p-1;
1430 pc->tt = JIM_TT_ESC;
1431 return JIM_OK;
1433 switch (*pc->p) {
1434 case '\\':
1435 if (pc->state == JIM_PS_DEF &&
1436 *(pc->p + 1) == '\n') {
1437 pc->tend = pc->p-1;
1438 pc->tt = JIM_TT_ESC;
1439 return JIM_OK;
1441 if (pc->len >= 2) {
1442 pc->p++; pc->len--;
1444 break;
1445 case '$':
1446 case '[':
1447 pc->tend = pc->p-1;
1448 pc->tt = JIM_TT_ESC;
1449 return JIM_OK;
1450 case ' ':
1451 case '\t':
1452 case '\n':
1453 case '\r':
1454 case ';':
1455 if (pc->state == JIM_PS_DEF) {
1456 pc->tend = pc->p-1;
1457 pc->tt = JIM_TT_ESC;
1458 return JIM_OK;
1459 } else if (*pc->p == '\n') {
1460 pc->linenr++;
1462 break;
1463 case '"':
1464 if (pc->state == JIM_PS_QUOTE) {
1465 pc->tend = pc->p-1;
1466 pc->tt = JIM_TT_ESC;
1467 pc->p++; pc->len--;
1468 pc->state = JIM_PS_DEF;
1469 return JIM_OK;
1471 break;
1473 pc->p++; pc->len--;
1475 return JIM_OK; /* unreached */
1478 int JimParseComment(struct JimParserCtx *pc)
1480 while (*pc->p) {
1481 if (*pc->p == '\n') {
1482 pc->linenr++;
1483 if (*(pc->p-1) != '\\') {
1484 pc->p++; pc->len--;
1485 return JIM_OK;
1488 pc->p++; pc->len--;
1490 return JIM_OK;
1493 /* xdigitval and odigitval are helper functions for JimParserGetToken() */
1494 static int xdigitval(int c)
1496 if (c >= '0' && c <= '9') return c-'0';
1497 if (c >= 'a' && c <= 'f') return c-'a'+10;
1498 if (c >= 'A' && c <= 'F') return c-'A'+10;
1499 return -1;
1502 static int odigitval(int c)
1504 if (c >= '0' && c <= '7') return c-'0';
1505 return -1;
1508 /* Perform Tcl escape substitution of 's', storing the result
1509 * string into 'dest'. The escaped string is guaranteed to
1510 * be the same length or shorted than the source string.
1511 * Slen is the length of the string at 's', if it's -1 the string
1512 * length will be calculated by the function.
1514 * The function returns the length of the resulting string. */
1515 static int JimEscape(char *dest, const char *s, int slen)
1517 char *p = dest;
1518 int i, len;
1520 if (slen == -1)
1521 slen = strlen(s);
1523 for (i = 0; i < slen; i++) {
1524 switch (s[i]) {
1525 case '\\':
1526 switch (s[i + 1]) {
1527 case 'a': *p++ = 0x7; i++; break;
1528 case 'b': *p++ = 0x8; i++; break;
1529 case 'f': *p++ = 0xc; i++; break;
1530 case 'n': *p++ = 0xa; i++; break;
1531 case 'r': *p++ = 0xd; i++; break;
1532 case 't': *p++ = 0x9; i++; break;
1533 case 'v': *p++ = 0xb; i++; break;
1534 case '\0': *p++ = '\\'; i++; break;
1535 case '\n': *p++ = ' '; i++; break;
1536 default:
1537 if (s[i + 1] == 'x') {
1538 int val = 0;
1539 int c = xdigitval(s[i + 2]);
1540 if (c == -1) {
1541 *p++ = 'x';
1542 i++;
1543 break;
1545 val = c;
1546 c = xdigitval(s[i + 3]);
1547 if (c == -1) {
1548 *p++ = val;
1549 i += 2;
1550 break;
1552 val = (val*16) + c;
1553 *p++ = val;
1554 i += 3;
1555 break;
1556 } else if (s[i + 1] >= '0' && s[i + 1] <= '7')
1558 int val = 0;
1559 int c = odigitval(s[i + 1]);
1560 val = c;
1561 c = odigitval(s[i + 2]);
1562 if (c == -1) {
1563 *p++ = val;
1564 i ++;
1565 break;
1567 val = (val*8) + c;
1568 c = odigitval(s[i + 3]);
1569 if (c == -1) {
1570 *p++ = val;
1571 i += 2;
1572 break;
1574 val = (val*8) + c;
1575 *p++ = val;
1576 i += 3;
1577 } else {
1578 *p++ = s[i + 1];
1579 i++;
1581 break;
1583 break;
1584 default:
1585 *p++ = s[i];
1586 break;
1589 len = p-dest;
1590 *p++ = '\0';
1591 return len;
1594 /* Returns a dynamically allocated copy of the current token in the
1595 * parser context. The function perform conversion of escapes if
1596 * the token is of type JIM_TT_ESC.
1598 * Note that after the conversion, tokens that are grouped with
1599 * braces in the source code, are always recognizable from the
1600 * identical string obtained in a different way from the type.
1602 * For exmple the string:
1604 * {expand}$a
1606 * will return as first token "expand", of type JIM_TT_STR
1608 * While the string:
1610 * expand$a
1612 * will return as first token "expand", of type JIM_TT_ESC
1614 char *JimParserGetToken(struct JimParserCtx *pc,
1615 int *lenPtr, int *typePtr, int *linePtr)
1617 const char *start, *end;
1618 char *token;
1619 int len;
1621 start = JimParserTstart(pc);
1622 end = JimParserTend(pc);
1623 if (start > end) {
1624 if (lenPtr) *lenPtr = 0;
1625 if (typePtr) *typePtr = JimParserTtype(pc);
1626 if (linePtr) *linePtr = JimParserTline(pc);
1627 token = Jim_Alloc(1);
1628 token[0] = '\0';
1629 return token;
1631 len = (end-start) + 1;
1632 token = Jim_Alloc(len + 1);
1633 if (JimParserTtype(pc) != JIM_TT_ESC) {
1634 /* No escape conversion needed? Just copy it. */
1635 memcpy(token, start, len);
1636 token[len] = '\0';
1637 } else {
1638 /* Else convert the escape chars. */
1639 len = JimEscape(token, start, len);
1641 if (lenPtr) *lenPtr = len;
1642 if (typePtr) *typePtr = JimParserTtype(pc);
1643 if (linePtr) *linePtr = JimParserTline(pc);
1644 return token;
1647 /* The following functin is not really part of the parsing engine of Jim,
1648 * but it somewhat related. Given an string and its length, it tries
1649 * to guess if the script is complete or there are instead " " or { }
1650 * open and not completed. This is useful for interactive shells
1651 * implementation and for [info complete].
1653 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
1654 * '{' on scripts incomplete missing one or more '}' to be balanced.
1655 * '"' on scripts incomplete missing a '"' char.
1657 * If the script is complete, 1 is returned, otherwise 0. */
1658 int Jim_ScriptIsComplete(const char *s, int len, char *stateCharPtr)
1660 int level = 0;
1661 int state = ' ';
1663 while (len) {
1664 switch (*s) {
1665 case '\\':
1666 if (len > 1)
1667 s++;
1668 break;
1669 case '"':
1670 if (state == ' ') {
1671 state = '"';
1672 } else if (state == '"') {
1673 state = ' ';
1675 break;
1676 case '{':
1677 if (state == '{') {
1678 level++;
1679 } else if (state == ' ') {
1680 state = '{';
1681 level++;
1683 break;
1684 case '}':
1685 if (state == '{') {
1686 level--;
1687 if (level == 0)
1688 state = ' ';
1690 break;
1692 s++;
1693 len--;
1695 if (stateCharPtr)
1696 *stateCharPtr = state;
1697 return state == ' ';
1700 /* -----------------------------------------------------------------------------
1701 * Tcl Lists parsing
1702 * ---------------------------------------------------------------------------*/
1703 static int JimParseListSep(struct JimParserCtx *pc);
1704 static int JimParseListStr(struct JimParserCtx *pc);
1706 int JimParseList(struct JimParserCtx *pc)
1708 if (pc->len == 0) {
1709 pc->tstart = pc->tend = pc->p;
1710 pc->tline = pc->linenr;
1711 pc->tt = JIM_TT_EOL;
1712 pc->eof = 1;
1713 return JIM_OK;
1715 switch (*pc->p) {
1716 case ' ':
1717 case '\n':
1718 case '\t':
1719 case '\r':
1720 if (pc->state == JIM_PS_DEF)
1721 return JimParseListSep(pc);
1722 else
1723 return JimParseListStr(pc);
1724 break;
1725 default:
1726 return JimParseListStr(pc);
1727 break;
1729 return JIM_OK;
1732 int JimParseListSep(struct JimParserCtx *pc)
1734 pc->tstart = pc->p;
1735 pc->tline = pc->linenr;
1736 while (*pc->p == ' ' || *pc->p == '\t' || *pc->p == '\r' || *pc->p == '\n')
1738 pc->p++; pc->len--;
1740 pc->tend = pc->p-1;
1741 pc->tt = JIM_TT_SEP;
1742 return JIM_OK;
1745 int JimParseListStr(struct JimParserCtx *pc)
1747 int newword = (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1748 pc->tt == JIM_TT_NONE);
1749 if (newword && *pc->p == '{') {
1750 return JimParseBrace(pc);
1751 } else if (newword && *pc->p == '"') {
1752 pc->state = JIM_PS_QUOTE;
1753 pc->p++; pc->len--;
1755 pc->tstart = pc->p;
1756 pc->tline = pc->linenr;
1757 while (1) {
1758 if (pc->len == 0) {
1759 pc->tend = pc->p-1;
1760 pc->tt = JIM_TT_ESC;
1761 return JIM_OK;
1763 switch (*pc->p) {
1764 case '\\':
1765 pc->p++; pc->len--;
1766 break;
1767 case ' ':
1768 case '\t':
1769 case '\n':
1770 case '\r':
1771 if (pc->state == JIM_PS_DEF) {
1772 pc->tend = pc->p-1;
1773 pc->tt = JIM_TT_ESC;
1774 return JIM_OK;
1775 } else if (*pc->p == '\n') {
1776 pc->linenr++;
1778 break;
1779 case '"':
1780 if (pc->state == JIM_PS_QUOTE) {
1781 pc->tend = pc->p-1;
1782 pc->tt = JIM_TT_ESC;
1783 pc->p++; pc->len--;
1784 pc->state = JIM_PS_DEF;
1785 return JIM_OK;
1787 break;
1789 pc->p++; pc->len--;
1791 return JIM_OK; /* unreached */
1794 /* -----------------------------------------------------------------------------
1795 * Jim_Obj related functions
1796 * ---------------------------------------------------------------------------*/
1798 /* Return a new initialized object. */
1799 Jim_Obj *Jim_NewObj(Jim_Interp *interp)
1801 Jim_Obj *objPtr;
1803 /* -- Check if there are objects in the free list -- */
1804 if (interp->freeList != NULL) {
1805 /* -- Unlink the object from the free list -- */
1806 objPtr = interp->freeList;
1807 interp->freeList = objPtr->nextObjPtr;
1808 } else {
1809 /* -- No ready to use objects: allocate a new one -- */
1810 objPtr = Jim_Alloc(sizeof(*objPtr));
1813 /* Object is returned with refCount of 0. Every
1814 * kind of GC implemented should take care to don't try
1815 * to scan objects with refCount == 0. */
1816 objPtr->refCount = 0;
1817 /* All the other fields are left not initialized to save time.
1818 * The caller will probably want set they to the right
1819 * value anyway. */
1821 /* -- Put the object into the live list -- */
1822 objPtr->prevObjPtr = NULL;
1823 objPtr->nextObjPtr = interp->liveList;
1824 if (interp->liveList)
1825 interp->liveList->prevObjPtr = objPtr;
1826 interp->liveList = objPtr;
1828 return objPtr;
1831 /* Free an object. Actually objects are never freed, but
1832 * just moved to the free objects list, where they will be
1833 * reused by Jim_NewObj(). */
1834 void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr)
1836 /* Check if the object was already freed, panic. */
1837 if (objPtr->refCount != 0) {
1838 Jim_Panic(interp,"!!!Object %p freed with bad refcount %d", objPtr,
1839 objPtr->refCount);
1841 /* Free the internal representation */
1842 Jim_FreeIntRep(interp, objPtr);
1843 /* Free the string representation */
1844 if (objPtr->bytes != NULL) {
1845 if (objPtr->bytes != JimEmptyStringRep)
1846 Jim_Free(objPtr->bytes);
1848 /* Unlink the object from the live objects list */
1849 if (objPtr->prevObjPtr)
1850 objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr;
1851 if (objPtr->nextObjPtr)
1852 objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr;
1853 if (interp->liveList == objPtr)
1854 interp->liveList = objPtr->nextObjPtr;
1855 /* Link the object into the free objects list */
1856 objPtr->prevObjPtr = NULL;
1857 objPtr->nextObjPtr = interp->freeList;
1858 if (interp->freeList)
1859 interp->freeList->prevObjPtr = objPtr;
1860 interp->freeList = objPtr;
1861 objPtr->refCount = -1;
1864 /* Invalidate the string representation of an object. */
1865 void Jim_InvalidateStringRep(Jim_Obj *objPtr)
1867 if (objPtr->bytes != NULL) {
1868 if (objPtr->bytes != JimEmptyStringRep)
1869 Jim_Free(objPtr->bytes);
1871 objPtr->bytes = NULL;
1874 #define Jim_SetStringRep(o, b, l) \
1875 do { (o)->bytes = b; (o)->length = l; } while (0)
1877 /* Set the initial string representation for an object.
1878 * Does not try to free an old one. */
1879 void Jim_InitStringRep(Jim_Obj *objPtr, const char *bytes, int length)
1881 if (length == 0) {
1882 objPtr->bytes = JimEmptyStringRep;
1883 objPtr->length = 0;
1884 } else {
1885 objPtr->bytes = Jim_Alloc(length + 1);
1886 objPtr->length = length;
1887 memcpy(objPtr->bytes, bytes, length);
1888 objPtr->bytes[length] = '\0';
1892 /* Duplicate an object. The returned object has refcount = 0. */
1893 Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
1895 Jim_Obj *dupPtr;
1897 dupPtr = Jim_NewObj(interp);
1898 if (objPtr->bytes == NULL) {
1899 /* Object does not have a valid string representation. */
1900 dupPtr->bytes = NULL;
1901 } else {
1902 Jim_InitStringRep(dupPtr, objPtr->bytes, objPtr->length);
1904 if (objPtr->typePtr != NULL) {
1905 if (objPtr->typePtr->dupIntRepProc == NULL) {
1906 dupPtr->internalRep = objPtr->internalRep;
1907 } else {
1908 objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr);
1910 dupPtr->typePtr = objPtr->typePtr;
1911 } else {
1912 dupPtr->typePtr = NULL;
1914 return dupPtr;
1917 /* Return the string representation for objPtr. If the object
1918 * string representation is invalid, calls the method to create
1919 * a new one starting from the internal representation of the object. */
1920 const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr)
1922 if (objPtr->bytes == NULL) {
1923 /* Invalid string repr. Generate it. */
1924 if (objPtr->typePtr->updateStringProc == NULL) {
1925 Jim_Panic(NULL,"UpdataStringProc called against '%s' type.",
1926 objPtr->typePtr->name);
1928 objPtr->typePtr->updateStringProc(objPtr);
1930 if (lenPtr)
1931 *lenPtr = objPtr->length;
1932 return objPtr->bytes;
1935 /* Just returns the length of the object's string rep */
1936 int Jim_Length(Jim_Obj *objPtr)
1938 int len;
1940 Jim_GetString(objPtr, &len);
1941 return len;
1944 /* -----------------------------------------------------------------------------
1945 * String Object
1946 * ---------------------------------------------------------------------------*/
1947 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
1948 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
1950 static Jim_ObjType stringObjType = {
1951 "string",
1952 NULL,
1953 DupStringInternalRep,
1954 NULL,
1955 JIM_TYPE_REFERENCES,
1958 void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
1960 JIM_NOTUSED(interp);
1962 /* This is a bit subtle: the only caller of this function
1963 * should be Jim_DuplicateObj(), that will copy the
1964 * string representaion. After the copy, the duplicated
1965 * object will not have more room in teh buffer than
1966 * srcPtr->length bytes. So we just set it to length. */
1967 dupPtr->internalRep.strValue.maxLength = srcPtr->length;
1970 int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
1972 /* Get a fresh string representation. */
1973 (void) Jim_GetString(objPtr, NULL);
1974 /* Free any other internal representation. */
1975 Jim_FreeIntRep(interp, objPtr);
1976 /* Set it as string, i.e. just set the maxLength field. */
1977 objPtr->typePtr = &stringObjType;
1978 objPtr->internalRep.strValue.maxLength = objPtr->length;
1979 return JIM_OK;
1982 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
1984 Jim_Obj *objPtr = Jim_NewObj(interp);
1986 if (len == -1)
1987 len = strlen(s);
1988 /* Alloc/Set the string rep. */
1989 if (len == 0) {
1990 objPtr->bytes = JimEmptyStringRep;
1991 objPtr->length = 0;
1992 } else {
1993 objPtr->bytes = Jim_Alloc(len + 1);
1994 objPtr->length = len;
1995 memcpy(objPtr->bytes, s, len);
1996 objPtr->bytes[len] = '\0';
1999 /* No typePtr field for the vanilla string object. */
2000 objPtr->typePtr = NULL;
2001 return objPtr;
2004 /* This version does not try to duplicate the 's' pointer, but
2005 * use it directly. */
2006 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
2008 Jim_Obj *objPtr = Jim_NewObj(interp);
2010 if (len == -1)
2011 len = strlen(s);
2012 Jim_SetStringRep(objPtr, s, len);
2013 objPtr->typePtr = NULL;
2014 return objPtr;
2017 /* Low-level string append. Use it only against objects
2018 * of type "string". */
2019 void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
2021 int needlen;
2023 if (len == -1)
2024 len = strlen(str);
2025 needlen = objPtr->length + len;
2026 if (objPtr->internalRep.strValue.maxLength < needlen ||
2027 objPtr->internalRep.strValue.maxLength == 0) {
2028 if (objPtr->bytes == JimEmptyStringRep) {
2029 objPtr->bytes = Jim_Alloc((needlen*2) + 1);
2030 } else {
2031 objPtr->bytes = Jim_Realloc(objPtr->bytes, (needlen*2) + 1);
2033 objPtr->internalRep.strValue.maxLength = needlen*2;
2035 memcpy(objPtr->bytes + objPtr->length, str, len);
2036 objPtr->bytes[objPtr->length + len] = '\0';
2037 objPtr->length += len;
2040 /* Low-level wrapper to append an object. */
2041 void StringAppendObj(Jim_Obj *objPtr, Jim_Obj *appendObjPtr)
2043 int len;
2044 const char *str;
2046 str = Jim_GetString(appendObjPtr, &len);
2047 StringAppendString(objPtr, str, len);
2050 /* Higher level API to append strings to objects. */
2051 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str,
2052 int len)
2054 if (Jim_IsShared(objPtr))
2055 Jim_Panic(interp,"Jim_AppendString called with shared object");
2056 if (objPtr->typePtr != &stringObjType)
2057 SetStringFromAny(interp, objPtr);
2058 StringAppendString(objPtr, str, len);
2061 void Jim_AppendString_sprintf(Jim_Interp *interp, Jim_Obj *objPtr, const char *fmt, ...)
2063 char *buf;
2064 va_list ap;
2066 va_start(ap, fmt);
2067 buf = jim_vasprintf(fmt, ap);
2068 va_end(ap);
2070 if (buf) {
2071 Jim_AppendString(interp, objPtr, buf, -1);
2072 jim_vasprintf_done(buf);
2077 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr,
2078 Jim_Obj *appendObjPtr)
2080 int len;
2081 const char *str;
2083 str = Jim_GetString(appendObjPtr, &len);
2084 Jim_AppendString(interp, objPtr, str, len);
2087 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2089 va_list ap;
2091 if (objPtr->typePtr != &stringObjType)
2092 SetStringFromAny(interp, objPtr);
2093 va_start(ap, objPtr);
2094 while (1) {
2095 char *s = va_arg(ap, char*);
2097 if (s == NULL) break;
2098 Jim_AppendString(interp, objPtr, s, -1);
2100 va_end(ap);
2103 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr, int nocase)
2105 const char *aStr, *bStr;
2106 int aLen, bLen, i;
2108 if (aObjPtr == bObjPtr) return 1;
2109 aStr = Jim_GetString(aObjPtr, &aLen);
2110 bStr = Jim_GetString(bObjPtr, &bLen);
2111 if (aLen != bLen) return 0;
2112 if (nocase == 0)
2113 return memcmp(aStr, bStr, aLen) == 0;
2114 for (i = 0; i < aLen; i++) {
2115 if (tolower((int)aStr[i]) != tolower((int)bStr[i]))
2116 return 0;
2118 return 1;
2121 int Jim_StringMatchObj(Jim_Obj *patternObjPtr, Jim_Obj *objPtr,
2122 int nocase)
2124 const char *pattern, *string;
2125 int patternLen, stringLen;
2127 pattern = Jim_GetString(patternObjPtr, &patternLen);
2128 string = Jim_GetString(objPtr, &stringLen);
2129 return JimStringMatch(pattern, patternLen, string, stringLen, nocase);
2132 int Jim_StringCompareObj(Jim_Obj *firstObjPtr,
2133 Jim_Obj *secondObjPtr, int nocase)
2135 const char *s1, *s2;
2136 int l1, l2;
2138 s1 = Jim_GetString(firstObjPtr, &l1);
2139 s2 = Jim_GetString(secondObjPtr, &l2);
2140 return JimStringCompare(s1, l1, s2, l2, nocase);
2143 /* Convert a range, as returned by Jim_GetRange(), into
2144 * an absolute index into an object of the specified length.
2145 * This function may return negative values, or values
2146 * bigger or equal to the length of the list if the index
2147 * is out of range. */
2148 static int JimRelToAbsIndex(int len, int index)
2150 if (index < 0)
2151 return len + index;
2152 return index;
2155 /* Convert a pair of index as normalize by JimRelToAbsIndex(),
2156 * into a range stored in *firstPtr, *lastPtr, *rangeLenPtr, suitable
2157 * for implementation of commands like [string range] and [lrange].
2159 * The resulting range is guaranteed to address valid elements of
2160 * the structure. */
2161 static void JimRelToAbsRange(int len, int first, int last,
2162 int *firstPtr, int *lastPtr, int *rangeLenPtr)
2164 int rangeLen;
2166 if (first > last) {
2167 rangeLen = 0;
2168 } else {
2169 rangeLen = last-first + 1;
2170 if (rangeLen) {
2171 if (first < 0) {
2172 rangeLen += first;
2173 first = 0;
2175 if (last >= len) {
2176 rangeLen -= (last-(len-1));
2177 last = len-1;
2181 if (rangeLen < 0) rangeLen = 0;
2183 *firstPtr = first;
2184 *lastPtr = last;
2185 *rangeLenPtr = rangeLen;
2188 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2189 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2191 int first, last;
2192 const char *str;
2193 int len, rangeLen;
2195 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
2196 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
2197 return NULL;
2198 str = Jim_GetString(strObjPtr, &len);
2199 first = JimRelToAbsIndex(len, first);
2200 last = JimRelToAbsIndex(len, last);
2201 JimRelToAbsRange(len, first, last, &first, &last, &rangeLen);
2202 return Jim_NewStringObj(interp, str + first, rangeLen);
2205 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2207 char *buf;
2208 int i;
2209 if (strObjPtr->typePtr != &stringObjType) {
2210 SetStringFromAny(interp, strObjPtr);
2213 buf = Jim_Alloc(strObjPtr->length + 1);
2215 memcpy(buf, strObjPtr->bytes, strObjPtr->length + 1);
2216 for (i = 0; i < strObjPtr->length; i++)
2217 buf[i] = tolower(buf[i]);
2218 return Jim_NewStringObjNoAlloc(interp, buf, strObjPtr->length);
2221 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2223 char *buf;
2224 int i;
2225 if (strObjPtr->typePtr != &stringObjType) {
2226 SetStringFromAny(interp, strObjPtr);
2229 buf = Jim_Alloc(strObjPtr->length + 1);
2231 memcpy(buf, strObjPtr->bytes, strObjPtr->length + 1);
2232 for (i = 0; i < strObjPtr->length; i++)
2233 buf[i] = toupper(buf[i]);
2234 return Jim_NewStringObjNoAlloc(interp, buf, strObjPtr->length);
2237 /* This is the core of the [format] command.
2238 * TODO: Lots of things work - via a hack
2239 * However, no format item can be >= JIM_MAX_FMT
2241 #define JIM_MAX_FMT 2048
2242 static Jim_Obj *Jim_FormatString_Inner(Jim_Interp *interp, Jim_Obj *fmtObjPtr,
2243 int objc, Jim_Obj *const *objv, char *sprintf_buf)
2245 const char *fmt, *_fmt;
2246 int fmtLen;
2247 Jim_Obj *resObjPtr;
2250 fmt = Jim_GetString(fmtObjPtr, &fmtLen);
2251 _fmt = fmt;
2252 resObjPtr = Jim_NewStringObj(interp, "", 0);
2253 while (fmtLen) {
2254 const char *p = fmt;
2255 char spec[2], c;
2256 jim_wide wideValue;
2257 double doubleValue;
2258 /* we cheat and use Sprintf()! */
2259 char fmt_str[100];
2260 char *cp;
2261 int width;
2262 int ljust;
2263 int zpad;
2264 int spad;
2265 int altfm;
2266 int forceplus;
2267 int prec;
2268 int inprec;
2269 int haveprec;
2270 int accum;
2272 while (*fmt != '%' && fmtLen) {
2273 fmt++; fmtLen--;
2275 Jim_AppendString(interp, resObjPtr, p, fmt-p);
2276 if (fmtLen == 0)
2277 break;
2278 fmt++; fmtLen--; /* skip '%' */
2279 zpad = 0;
2280 spad = 0;
2281 width = -1;
2282 ljust = 0;
2283 altfm = 0;
2284 forceplus = 0;
2285 inprec = 0;
2286 haveprec = 0;
2287 prec = -1; /* not found yet */
2288 next_fmt:
2289 if (fmtLen <= 0) {
2290 break;
2292 switch (*fmt) {
2293 /* terminals */
2294 case 'b': /* binary - not all printfs() do this */
2295 case 's': /* string */
2296 case 'i': /* integer */
2297 case 'd': /* decimal */
2298 case 'x': /* hex */
2299 case 'X': /* CAP hex */
2300 case 'c': /* char */
2301 case 'o': /* octal */
2302 case 'u': /* unsigned */
2303 case 'f': /* float */
2304 break;
2306 /* non-terminals */
2307 case '0': /* zero pad */
2308 zpad = 1;
2309 fmt++; fmtLen--;
2310 goto next_fmt;
2311 break;
2312 case '+':
2313 forceplus = 1;
2314 fmt++; fmtLen--;
2315 goto next_fmt;
2316 break;
2317 case ' ': /* sign space */
2318 spad = 1;
2319 fmt++; fmtLen--;
2320 goto next_fmt;
2321 break;
2322 case '-':
2323 ljust = 1;
2324 fmt++; fmtLen--;
2325 goto next_fmt;
2326 break;
2327 case '#':
2328 altfm = 1;
2329 fmt++; fmtLen--;
2330 goto next_fmt;
2332 case '.':
2333 inprec = 1;
2334 fmt++; fmtLen--;
2335 goto next_fmt;
2336 break;
2337 case '1':
2338 case '2':
2339 case '3':
2340 case '4':
2341 case '5':
2342 case '6':
2343 case '7':
2344 case '8':
2345 case '9':
2346 accum = 0;
2347 while (isdigit(*fmt) && (fmtLen > 0)) {
2348 accum = (accum * 10) + (*fmt - '0');
2349 fmt++; fmtLen--;
2351 if (inprec) {
2352 haveprec = 1;
2353 prec = accum;
2354 } else {
2355 width = accum;
2357 goto next_fmt;
2358 case '*':
2359 /* suck up the next item as an integer */
2360 fmt++; fmtLen--;
2361 objc--;
2362 if (objc <= 0) {
2363 goto not_enough_args;
2365 if (Jim_GetWide(interp,objv[0],&wideValue)== JIM_ERR) {
2366 Jim_FreeNewObj(interp, resObjPtr);
2367 return NULL;
2369 if (inprec) {
2370 haveprec = 1;
2371 prec = wideValue;
2372 if (prec < 0) {
2373 /* man 3 printf says */
2374 /* if prec is negative, it is zero */
2375 prec = 0;
2377 } else {
2378 width = wideValue;
2379 if (width < 0) {
2380 ljust = 1;
2381 width = -width;
2384 objv++;
2385 goto next_fmt;
2386 break;
2390 if (*fmt != '%') {
2391 if (objc == 0) {
2392 not_enough_args:
2393 Jim_FreeNewObj(interp, resObjPtr);
2394 Jim_SetResultString(interp,
2395 "not enough arguments for all format specifiers", -1);
2396 return NULL;
2397 } else {
2398 objc--;
2403 * Create the formatter
2404 * cause we cheat and use sprintf()
2406 cp = fmt_str;
2407 *cp++ = '%';
2408 if (altfm) {
2409 *cp++ = '#';
2411 if (forceplus) {
2412 *cp++ = '+';
2413 } else if (spad) {
2414 /* PLUS overrides */
2415 *cp++ = ' ';
2417 if (ljust) {
2418 *cp++ = '-';
2420 if (zpad) {
2421 *cp++ = '0';
2423 if (width > 0) {
2424 sprintf(cp, "%d", width);
2425 /* skip ahead */
2426 cp = strchr(cp,0);
2428 /* did we find a period? */
2429 if (inprec) {
2430 /* then add it */
2431 *cp++ = '.';
2432 /* did something occur after the period? */
2433 if (haveprec) {
2434 sprintf(cp, "%d", prec);
2436 cp = strchr(cp,0);
2438 *cp = 0;
2440 /* here we do the work */
2441 /* actually - we make sprintf() do it for us */
2442 switch (*fmt) {
2443 case 's':
2444 *cp++ = 's';
2445 *cp = 0;
2446 /* BUG: we do not handled embeded NULLs */
2447 snprintf(sprintf_buf, JIM_MAX_FMT, fmt_str, Jim_GetString(objv[0], NULL));
2448 break;
2449 case 'c':
2450 *cp++ = 'c';
2451 *cp = 0;
2452 if (Jim_GetWide(interp, objv[0], &wideValue) == JIM_ERR) {
2453 Jim_FreeNewObj(interp, resObjPtr);
2454 return NULL;
2456 c = (char) wideValue;
2457 snprintf(sprintf_buf, JIM_MAX_FMT, fmt_str, c);
2458 break;
2459 case 'f':
2460 case 'F':
2461 case 'g':
2462 case 'G':
2463 case 'e':
2464 case 'E':
2465 *cp++ = *fmt;
2466 *cp = 0;
2467 if (Jim_GetDouble(interp, objv[0], &doubleValue) == JIM_ERR) {
2468 Jim_FreeNewObj(interp, resObjPtr);
2469 return NULL;
2471 snprintf(sprintf_buf, JIM_MAX_FMT, fmt_str, doubleValue);
2472 break;
2473 case 'b':
2474 case 'd':
2475 case 'o':
2476 case 'i':
2477 case 'u':
2478 case 'x':
2479 case 'X':
2480 /* jim widevaluse are 64bit */
2481 if (sizeof(jim_wide) == sizeof(long long)) {
2482 *cp++ = 'l';
2483 *cp++ = 'l';
2484 } else {
2485 *cp++ = 'l';
2487 *cp++ = *fmt;
2488 *cp = 0;
2489 if (Jim_GetWide(interp, objv[0], &wideValue) == JIM_ERR) {
2490 Jim_FreeNewObj(interp, resObjPtr);
2491 return NULL;
2493 snprintf(sprintf_buf, JIM_MAX_FMT, fmt_str, wideValue);
2494 break;
2495 case '%':
2496 sprintf_buf[0] = '%';
2497 sprintf_buf[1] = 0;
2498 objv--; /* undo the objv++ below */
2499 break;
2500 default:
2501 spec[0] = *fmt; spec[1] = '\0';
2502 Jim_FreeNewObj(interp, resObjPtr);
2503 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
2504 Jim_AppendStrings(interp, Jim_GetResult(interp),
2505 "bad field specifier \"", spec, "\"", NULL);
2506 return NULL;
2508 /* force terminate */
2509 #if 0
2510 printf("FMT was: %s\n", fmt_str);
2511 printf("RES was: |%s|\n", sprintf_buf);
2512 #endif
2514 sprintf_buf[ JIM_MAX_FMT - 1] = 0;
2515 Jim_AppendString(interp, resObjPtr, sprintf_buf, strlen(sprintf_buf));
2516 /* next obj */
2517 objv++;
2518 fmt++;
2519 fmtLen--;
2521 return resObjPtr;
2524 Jim_Obj *Jim_FormatString(Jim_Interp *interp, Jim_Obj *fmtObjPtr,
2525 int objc, Jim_Obj *const *objv)
2527 char *sprintf_buf = malloc(JIM_MAX_FMT);
2528 Jim_Obj *t = Jim_FormatString_Inner(interp, fmtObjPtr, objc, objv, sprintf_buf);
2529 free(sprintf_buf);
2530 return t;
2533 /* -----------------------------------------------------------------------------
2534 * Compared String Object
2535 * ---------------------------------------------------------------------------*/
2537 /* This is strange object that allows to compare a C literal string
2538 * with a Jim object in very short time if the same comparison is done
2539 * multiple times. For example every time the [if] command is executed,
2540 * Jim has to check if a given argument is "else". This comparions if
2541 * the code has no errors are true most of the times, so we can cache
2542 * inside the object the pointer of the string of the last matching
2543 * comparison. Because most C compilers perform literal sharing,
2544 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
2545 * this works pretty well even if comparisons are at different places
2546 * inside the C code. */
2548 static Jim_ObjType comparedStringObjType = {
2549 "compared-string",
2550 NULL,
2551 NULL,
2552 NULL,
2553 JIM_TYPE_REFERENCES,
2556 /* The only way this object is exposed to the API is via the following
2557 * function. Returns true if the string and the object string repr.
2558 * are the same, otherwise zero is returned.
2560 * Note: this isn't binary safe, but it hardly needs to be.*/
2561 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr,
2562 const char *str)
2564 if (objPtr->typePtr == &comparedStringObjType &&
2565 objPtr->internalRep.ptr == str)
2566 return 1;
2567 else {
2568 const char *objStr = Jim_GetString(objPtr, NULL);
2569 if (strcmp(str, objStr) != 0) return 0;
2570 if (objPtr->typePtr != &comparedStringObjType) {
2571 Jim_FreeIntRep(interp, objPtr);
2572 objPtr->typePtr = &comparedStringObjType;
2574 objPtr->internalRep.ptr = (char*)str; /*ATTENTION: const cast */
2575 return 1;
2579 int qsortCompareStringPointers(const void *a, const void *b)
2581 char * const *sa = (char * const *)a;
2582 char * const *sb = (char * const *)b;
2583 return strcmp(*sa, *sb);
2586 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
2587 const char * const *tablePtr, int *indexPtr, const char *name, int flags)
2589 const char * const *entryPtr = NULL;
2590 char **tablePtrSorted;
2591 int i, count = 0;
2593 *indexPtr = -1;
2594 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
2595 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
2596 *indexPtr = i;
2597 return JIM_OK;
2599 count++; /* If nothing matches, this will reach the len of tablePtr */
2601 if (flags & JIM_ERRMSG) {
2602 if (name == NULL)
2603 name = "option";
2604 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
2605 Jim_AppendStrings(interp, Jim_GetResult(interp),
2606 "bad ", name, " \"", Jim_GetString(objPtr, NULL), "\": must be one of ",
2607 NULL);
2608 tablePtrSorted = Jim_Alloc(sizeof(char*)*count);
2609 memcpy(tablePtrSorted, tablePtr, sizeof(char*)*count);
2610 qsort(tablePtrSorted, count, sizeof(char*), qsortCompareStringPointers);
2611 for (i = 0; i < count; i++) {
2612 if (i + 1 == count && count > 1)
2613 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
2614 Jim_AppendString(interp, Jim_GetResult(interp),
2615 tablePtrSorted[i], -1);
2616 if (i + 1 != count)
2617 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
2619 Jim_Free(tablePtrSorted);
2621 return JIM_ERR;
2624 int Jim_GetNvp(Jim_Interp *interp,
2625 Jim_Obj *objPtr,
2626 const Jim_Nvp *nvp_table,
2627 const Jim_Nvp ** result)
2629 Jim_Nvp *n;
2630 int e;
2632 e = Jim_Nvp_name2value_obj(interp, nvp_table, objPtr, &n);
2633 if (e == JIM_ERR) {
2634 return e;
2637 /* Success? found? */
2638 if (n->name) {
2639 /* remove const */
2640 *result = (Jim_Nvp *)n;
2641 return JIM_OK;
2642 } else {
2643 return JIM_ERR;
2647 /* -----------------------------------------------------------------------------
2648 * Source Object
2650 * This object is just a string from the language point of view, but
2651 * in the internal representation it contains the filename and line number
2652 * where this given token was read. This information is used by
2653 * Jim_EvalObj() if the object passed happens to be of type "source".
2655 * This allows to propagate the information about line numbers and file
2656 * names and give error messages with absolute line numbers.
2658 * Note that this object uses shared strings for filenames, and the
2659 * pointer to the filename together with the line number is taken into
2660 * the space for the "inline" internal represenation of the Jim_Object,
2661 * so there is almost memory zero-overhead.
2663 * Also the object will be converted to something else if the given
2664 * token it represents in the source file is not something to be
2665 * evaluated (not a script), and will be specialized in some other way,
2666 * so the time overhead is alzo null.
2667 * ---------------------------------------------------------------------------*/
2669 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2670 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2672 static Jim_ObjType sourceObjType = {
2673 "source",
2674 FreeSourceInternalRep,
2675 DupSourceInternalRep,
2676 NULL,
2677 JIM_TYPE_REFERENCES,
2680 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2682 Jim_ReleaseSharedString(interp,
2683 objPtr->internalRep.sourceValue.fileName);
2686 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2688 dupPtr->internalRep.sourceValue.fileName =
2689 Jim_GetSharedString(interp,
2690 srcPtr->internalRep.sourceValue.fileName);
2691 dupPtr->internalRep.sourceValue.lineNumber =
2692 dupPtr->internalRep.sourceValue.lineNumber;
2693 dupPtr->typePtr = &sourceObjType;
2696 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
2697 const char *fileName, int lineNumber)
2699 if (Jim_IsShared(objPtr))
2700 Jim_Panic(interp,"JimSetSourceInfo called with shared object");
2701 if (objPtr->typePtr != NULL)
2702 Jim_Panic(interp,"JimSetSourceInfo called with typePtr != NULL");
2703 objPtr->internalRep.sourceValue.fileName =
2704 Jim_GetSharedString(interp, fileName);
2705 objPtr->internalRep.sourceValue.lineNumber = lineNumber;
2706 objPtr->typePtr = &sourceObjType;
2709 /* -----------------------------------------------------------------------------
2710 * Script Object
2711 * ---------------------------------------------------------------------------*/
2713 #define JIM_CMDSTRUCT_EXPAND -1
2715 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2716 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2717 static int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2719 static Jim_ObjType scriptObjType = {
2720 "script",
2721 FreeScriptInternalRep,
2722 DupScriptInternalRep,
2723 NULL,
2724 JIM_TYPE_REFERENCES,
2727 /* The ScriptToken structure represents every token into a scriptObj.
2728 * Every token contains an associated Jim_Obj that can be specialized
2729 * by commands operating on it. */
2730 typedef struct ScriptToken {
2731 int type;
2732 Jim_Obj *objPtr;
2733 int linenr;
2734 } ScriptToken;
2736 /* This is the script object internal representation. An array of
2737 * ScriptToken structures, with an associated command structure array.
2738 * The command structure is a pre-computed representation of the
2739 * command length and arguments structure as a simple liner array
2740 * of integers.
2742 * For example the script:
2744 * puts hello
2745 * set $i $x$y [foo]BAR
2747 * will produce a ScriptObj with the following Tokens:
2749 * ESC puts
2750 * SEP
2751 * ESC hello
2752 * EOL
2753 * ESC set
2754 * EOL
2755 * VAR i
2756 * SEP
2757 * VAR x
2758 * VAR y
2759 * SEP
2760 * CMD foo
2761 * ESC BAR
2762 * EOL
2764 * This is a description of the tokens, separators, and of lines.
2765 * The command structure instead represents the number of arguments
2766 * of every command, followed by the tokens of which every argument
2767 * is composed. So for the example script, the cmdstruct array will
2768 * contain:
2770 * 2 1 1 4 1 1 2 2
2772 * Because "puts hello" has two args (2), composed of single tokens (1 1)
2773 * While "set $i $x$y [foo]BAR" has four (4) args, the first two
2774 * composed of single tokens (1 1) and the last two of double tokens
2775 * (2 2).
2777 * The precomputation of the command structure makes Jim_Eval() faster,
2778 * and simpler because there aren't dynamic lengths / allocations.
2780 * -- {expand} handling --
2782 * Expand is handled in a special way. When a command
2783 * contains at least an argument with the {expand} prefix,
2784 * the command structure presents a -1 before the integer
2785 * describing the number of arguments. This is used in order
2786 * to send the command exection to a different path in case
2787 * of {expand} and guarantee a fast path for the more common
2788 * case. Also, the integers describing the number of tokens
2789 * are expressed with negative sign, to allow for fast check
2790 * of what's an {expand}-prefixed argument and what not.
2792 * For example the command:
2794 * list {expand}{1 2}
2796 * Will produce the following cmdstruct array:
2798 * -1 2 1 -2
2800 * -- the substFlags field of the structure --
2802 * The scriptObj structure is used to represent both "script" objects
2803 * and "subst" objects. In the second case, the cmdStruct related
2804 * fields are not used at all, but there is an additional field used
2805 * that is 'substFlags': this represents the flags used to turn
2806 * the string into the intenral representation used to perform the
2807 * substitution. If this flags are not what the application requires
2808 * the scriptObj is created again. For example the script:
2810 * subst -nocommands $string
2811 * subst -novariables $string
2813 * Will recreate the internal representation of the $string object
2814 * two times.
2816 typedef struct ScriptObj {
2817 int len; /* Length as number of tokens. */
2818 int commands; /* number of top-level commands in script. */
2819 ScriptToken *token; /* Tokens array. */
2820 int *cmdStruct; /* commands structure */
2821 int csLen; /* length of the cmdStruct array. */
2822 int substFlags; /* flags used for the compilation of "subst" objects */
2823 int inUse; /* Used to share a ScriptObj. Currently
2824 only used by Jim_EvalObj() as protection against
2825 shimmering of the currently evaluated object. */
2826 char *fileName;
2827 } ScriptObj;
2829 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2831 int i;
2832 struct ScriptObj *script = (void*) objPtr->internalRep.ptr;
2834 if (!script)
2835 return;
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);
2843 Jim_Free(script->token);
2844 Jim_Free(script->cmdStruct);
2845 Jim_Free(script->fileName);
2846 Jim_Free(script);
2849 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2851 JIM_NOTUSED(interp);
2852 JIM_NOTUSED(srcPtr);
2854 /* Just returns an simple string. */
2855 dupPtr->typePtr = NULL;
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)
2862 int prevtype;
2863 struct ScriptToken *token;
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;
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);
2885 } else if (prevtype != JIM_TT_EOL && prevtype != JIM_TT_SEP &&
2886 type == JIM_TT_ESC && len == 0)
2888 /* Don't add empty tokens used in interpolation */
2889 Jim_Free(strtoken);
2890 return;
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;
2911 /* Add an integer into the command structure field of the script object. */
2912 static void ScriptObjAddInt(struct ScriptObj *script, int val)
2914 script->csLen++;
2915 script->cmdStruct = Jim_Realloc(script->cmdStruct,
2916 sizeof(int)*script->csLen);
2917 script->cmdStruct[script->csLen-1] = val;
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)
2925 int i;
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;
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;
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;
2953 return NULL;
2956 /* Share literals of a script recursively sharing sub-scripts literals. */
2957 static void ScriptShareLiterals(Jim_Interp *interp, ScriptObj *script,
2958 ScriptObj *topLevelScript)
2960 int i, j;
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;
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;
2984 /* Try to share locally */
2985 for (i = 0; i < script->len; i++) {
2986 char *str = script->token[i].objPtr->bytes;
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))
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;
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)
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;
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;
3037 JimParserInit(&parser, scriptText, scriptTextLen, initialLineNumber);
3038 while (!JimParserEof(&parser)) {
3039 char *token;
3040 int len, type, linenr;
3042 JimParseScript(&parser);
3043 token = JimParserGetToken(&parser, &len, &type, &linenr);
3044 ScriptObjAddToken(interp, script, token, len, type,
3045 propagateSourceInfo ? script->fileName : NULL,
3046 linenr);
3048 token = script->token;
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)
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++;
3075 if (token[end].type == JIM_TT_SEP)
3076 args++;
3077 end++;
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)
3092 if (tokens == 1 && expand)
3093 expand = 0;
3094 ScriptObjAddInt(script,
3095 expand ? -tokens : tokens);
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, "*")))
3104 expand++;
3106 tokens++;
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);
3122 } else if (propagateSourceInfo) {
3123 ScriptShareLiterals(interp, script, NULL);
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;
3132 ScriptObj *Jim_GetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3134 if (objPtr->typePtr != &scriptObjType) {
3135 SetScriptFromAny(interp, objPtr);
3137 return (ScriptObj*) Jim_GetIntRepPtr(objPtr);
3140 /* -----------------------------------------------------------------------------
3141 * Commands
3142 * ---------------------------------------------------------------------------*/
3144 /* Commands HashTable Type.
3146 * Keys are dynamic allocated strings, Values are Jim_Cmd structures. */
3147 static void Jim_CommandsHT_ValDestructor(void *interp, void *val)
3149 Jim_Cmd *cmdPtr = (void*) val;
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);
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);
3162 Jim_Free(val);
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 */
3174 /* ------------------------- Commands related functions --------------------- */
3176 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdName,
3177 Jim_CmdProc cmdProc, void *privData, Jim_DelCmdProc delProc)
3179 Jim_HashEntry *he;
3180 Jim_Cmd *cmdPtr;
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);
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);
3204 /* Store the new details for this proc */
3205 cmdPtr->delProc = delProc;
3206 cmdPtr->cmdProc = cmdProc;
3207 cmdPtr->privData = privData;
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;
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)
3219 Jim_Cmd *cmdPtr;
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;
3231 /* Create the statics hash table. */
3232 if (staticsListObjPtr) {
3233 int len, i;
3235 Jim_ListLength(interp, staticsListObjPtr, &len);
3236 if (len != 0) {
3237 cmdPtr->staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3238 Jim_InitHashTable(cmdPtr->staticVars, getJimVariablesHashTableType(),
3239 interp);
3240 for (i = 0; i < len; i++) {
3241 Jim_Obj *objPtr=NULL, *initObjPtr=NULL, *nameObjPtr=NULL;
3242 Jim_Var *varPtr;
3243 int subLen;
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;
3265 } else {
3266 Jim_ListIndex(interp, objPtr, 1, &initObjPtr, JIM_NONE);
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)
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;
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;
3296 /* Add the new command */
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);
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;
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;
3320 int Jim_DeleteCommand(Jim_Interp *interp, const char *cmdName)
3322 if (Jim_DeleteHashEntry(&interp->commands, cmdName) == JIM_ERR)
3323 return JIM_ERR;
3324 Jim_InterpIncrProcEpoch(interp);
3325 return JIM_OK;
3328 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName,
3329 const char *newName)
3331 Jim_Cmd *cmdPtr;
3332 Jim_HashEntry *he;
3333 Jim_Cmd *copyCmdPtr;
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;
3362 /* -----------------------------------------------------------------------------
3363 * Command object
3364 * ---------------------------------------------------------------------------*/
3366 static int SetCommandFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3368 static Jim_ObjType commandObjType = {
3369 "command",
3370 NULL,
3371 NULL,
3372 NULL,
3373 JIM_TYPE_REFERENCES,
3376 int SetCommandFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
3378 Jim_HashEntry *he;
3379 const char *cmdName;
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;
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;
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)
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);
3412 return NULL;
3414 return objPtr->internalRep.cmdValue.cmdPtr;
3417 /* -----------------------------------------------------------------------------
3418 * Variables
3419 * ---------------------------------------------------------------------------*/
3421 /* Variables HashTable Type.
3423 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3424 static void JimVariablesHTValDestructor(void *interp, void *val)
3426 Jim_Var *varPtr = (void*) val;
3428 Jim_DecrRefCount(interp, varPtr->objPtr);
3429 Jim_Free(val);
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 */
3441 static Jim_HashTableType *getJimVariablesHashTableType(void)
3443 return &JimVariablesHashTableType;
3446 /* -----------------------------------------------------------------------------
3447 * Variable object
3448 * ---------------------------------------------------------------------------*/
3450 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
3452 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3454 static Jim_ObjType variableObjType = {
3455 "variable",
3456 NULL,
3457 NULL,
3458 NULL,
3459 JIM_TYPE_REFERENCES,
3462 /* Return true if the string "str" looks like syntax sugar for [dict]. I.e.
3463 * is in the form "varname(key)". */
3464 static int Jim_NameIsDictSugar(const char *str, int len)
3466 if (len == -1)
3467 len = strlen(str);
3468 if (len && str[len-1] == ')' && strchr(str, '(') != NULL)
3469 return 1;
3470 return 0;
3473 /* This method should be called only by the variable API.
3474 * It returns JIM_OK on success (variable already exists),
3475 * JIM_ERR if it does not exists, JIM_DICT_GLUE if it's not
3476 * a variable name, but syntax glue for [dict] i.e. the last
3477 * character is ')' */
3478 int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3480 Jim_HashEntry *he;
3481 const char *varName;
3482 int len;
3484 /* Check if the object is already an uptodate variable */
3485 if (objPtr->typePtr == &variableObjType &&
3486 objPtr->internalRep.varValue.callFrameId == interp->framePtr->id)
3487 return JIM_OK; /* nothing to do */
3488 /* Get the string representation */
3489 varName = Jim_GetString(objPtr, &len);
3490 /* Make sure it's not syntax glue to get/set dict. */
3491 if (Jim_NameIsDictSugar(varName, len))
3492 return JIM_DICT_SUGAR;
3493 if (varName[0] == ':' && varName[1] == ':') {
3494 he = Jim_FindHashEntry(&interp->topFramePtr->vars, varName + 2);
3495 if (he == NULL) {
3496 return JIM_ERR;
3499 else {
3500 /* Lookup this name into the variables hash table */
3501 he = Jim_FindHashEntry(&interp->framePtr->vars, varName);
3502 if (he == NULL) {
3503 /* Try with static vars. */
3504 if (interp->framePtr->staticVars == NULL)
3505 return JIM_ERR;
3506 if (!(he = Jim_FindHashEntry(interp->framePtr->staticVars, varName)))
3507 return JIM_ERR;
3510 /* Free the old internal repr and set the new one. */
3511 Jim_FreeIntRep(interp, objPtr);
3512 objPtr->typePtr = &variableObjType;
3513 objPtr->internalRep.varValue.callFrameId = interp->framePtr->id;
3514 objPtr->internalRep.varValue.varPtr = (void*)he->val;
3515 return JIM_OK;
3518 /* -------------------- Variables related functions ------------------------- */
3519 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr,
3520 Jim_Obj *valObjPtr);
3521 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr);
3523 /* For now that's dummy. Variables lookup should be optimized
3524 * in many ways, with caching of lookups, and possibly with
3525 * a table of pre-allocated vars in every CallFrame for local vars.
3526 * All the caching should also have an 'epoch' mechanism similar
3527 * to the one used by Tcl for procedures lookup caching. */
3529 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
3531 const char *name;
3532 Jim_Var *var;
3533 int err;
3535 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3536 /* Check for [dict] syntax sugar. */
3537 if (err == JIM_DICT_SUGAR)
3538 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
3539 /* New variable to create */
3540 name = Jim_GetString(nameObjPtr, NULL);
3542 var = Jim_Alloc(sizeof(*var));
3543 var->objPtr = valObjPtr;
3544 Jim_IncrRefCount(valObjPtr);
3545 var->linkFramePtr = NULL;
3546 /* Insert the new variable */
3547 if (name[0] == ':' && name[1] == ':') {
3548 /* Into to the top evel frame */
3549 Jim_AddHashEntry(&interp->topFramePtr->vars, name + 2, var);
3551 else {
3552 Jim_AddHashEntry(&interp->framePtr->vars, name, var);
3554 /* Make the object int rep a variable */
3555 Jim_FreeIntRep(interp, nameObjPtr);
3556 nameObjPtr->typePtr = &variableObjType;
3557 nameObjPtr->internalRep.varValue.callFrameId =
3558 interp->framePtr->id;
3559 nameObjPtr->internalRep.varValue.varPtr = var;
3560 } else {
3561 var = nameObjPtr->internalRep.varValue.varPtr;
3562 if (var->linkFramePtr == NULL) {
3563 Jim_IncrRefCount(valObjPtr);
3564 Jim_DecrRefCount(interp, var->objPtr);
3565 var->objPtr = valObjPtr;
3566 } else { /* Else handle the link */
3567 Jim_CallFrame *savedCallFrame;
3569 savedCallFrame = interp->framePtr;
3570 interp->framePtr = var->linkFramePtr;
3571 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
3572 interp->framePtr = savedCallFrame;
3573 if (err != JIM_OK)
3574 return err;
3577 return JIM_OK;
3580 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
3582 Jim_Obj *nameObjPtr;
3583 int result;
3585 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3586 Jim_IncrRefCount(nameObjPtr);
3587 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
3588 Jim_DecrRefCount(interp, nameObjPtr);
3589 return result;
3592 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
3594 Jim_CallFrame *savedFramePtr;
3595 int result;
3597 savedFramePtr = interp->framePtr;
3598 interp->framePtr = interp->topFramePtr;
3599 result = Jim_SetVariableStr(interp, name, objPtr);
3600 interp->framePtr = savedFramePtr;
3601 return result;
3604 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
3606 Jim_Obj *nameObjPtr, *valObjPtr;
3607 int result;
3609 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3610 valObjPtr = Jim_NewStringObj(interp, val, -1);
3611 Jim_IncrRefCount(nameObjPtr);
3612 Jim_IncrRefCount(valObjPtr);
3613 result = Jim_SetVariable(interp, nameObjPtr, valObjPtr);
3614 Jim_DecrRefCount(interp, nameObjPtr);
3615 Jim_DecrRefCount(interp, valObjPtr);
3616 return result;
3619 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
3620 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
3622 const char *varName;
3623 int len;
3625 /* Check for cycles. */
3626 if (interp->framePtr == targetCallFrame) {
3627 Jim_Obj *objPtr = targetNameObjPtr;
3628 Jim_Var *varPtr;
3629 /* Cycles are only possible with 'uplevel 0' */
3630 while (1) {
3631 if (Jim_StringEqObj(objPtr, nameObjPtr, 0)) {
3632 Jim_SetResultString(interp,
3633 "can't upvar from variable to itself", -1);
3634 return JIM_ERR;
3636 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
3637 break;
3638 varPtr = objPtr->internalRep.varValue.varPtr;
3639 if (varPtr->linkFramePtr != targetCallFrame) break;
3640 objPtr = varPtr->objPtr;
3643 varName = Jim_GetString(nameObjPtr, &len);
3644 if (Jim_NameIsDictSugar(varName, len)) {
3645 Jim_SetResultString(interp,
3646 "Dict key syntax invalid as link source", -1);
3647 return JIM_ERR;
3649 /* Perform the binding */
3650 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
3651 /* We are now sure 'nameObjPtr' type is variableObjType */
3652 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
3653 return JIM_OK;
3656 /* Return the Jim_Obj pointer associated with a variable name,
3657 * or NULL if the variable was not found in the current context.
3658 * The same optimization discussed in the comment to the
3659 * 'SetVariable' function should apply here. */
3660 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
3662 int err;
3664 /* All the rest is handled here */
3665 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3666 /* Check for [dict] syntax sugar. */
3667 if (err == JIM_DICT_SUGAR)
3668 return JimDictSugarGet(interp, nameObjPtr);
3669 if (flags & JIM_ERRMSG) {
3670 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3671 Jim_AppendStrings(interp, Jim_GetResult(interp),
3672 "can't read \"", nameObjPtr->bytes,
3673 "\": no such variable", NULL);
3675 return NULL;
3676 } else {
3677 Jim_Var *varPtr;
3678 Jim_Obj *objPtr;
3679 Jim_CallFrame *savedCallFrame;
3681 varPtr = nameObjPtr->internalRep.varValue.varPtr;
3682 if (varPtr->linkFramePtr == NULL)
3683 return varPtr->objPtr;
3684 /* The variable is a link? Resolve it. */
3685 savedCallFrame = interp->framePtr;
3686 interp->framePtr = varPtr->linkFramePtr;
3687 objPtr = Jim_GetVariable(interp, varPtr->objPtr, JIM_NONE);
3688 if (objPtr == NULL && flags & JIM_ERRMSG) {
3689 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3690 Jim_AppendStrings(interp, Jim_GetResult(interp),
3691 "can't read \"", nameObjPtr->bytes,
3692 "\": no such variable", NULL);
3694 interp->framePtr = savedCallFrame;
3695 return objPtr;
3699 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr,
3700 int flags)
3702 Jim_CallFrame *savedFramePtr;
3703 Jim_Obj *objPtr;
3705 savedFramePtr = interp->framePtr;
3706 interp->framePtr = interp->topFramePtr;
3707 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
3708 interp->framePtr = savedFramePtr;
3710 return objPtr;
3713 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
3715 Jim_Obj *nameObjPtr, *varObjPtr;
3717 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3718 Jim_IncrRefCount(nameObjPtr);
3719 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
3720 Jim_DecrRefCount(interp, nameObjPtr);
3721 return varObjPtr;
3724 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name,
3725 int flags)
3727 Jim_CallFrame *savedFramePtr;
3728 Jim_Obj *objPtr;
3730 savedFramePtr = interp->framePtr;
3731 interp->framePtr = interp->topFramePtr;
3732 objPtr = Jim_GetVariableStr(interp, name, flags);
3733 interp->framePtr = savedFramePtr;
3735 return objPtr;
3738 /* Unset a variable.
3739 * Note: On success unset invalidates all the variable objects created
3740 * in the current call frame incrementing. */
3741 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
3743 const char *name;
3744 Jim_Var *varPtr;
3745 int err;
3747 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3748 /* Check for [dict] syntax sugar. */
3749 if (err == JIM_DICT_SUGAR)
3750 return JimDictSugarSet(interp, nameObjPtr, NULL);
3751 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3752 Jim_AppendStrings(interp, Jim_GetResult(interp),
3753 "can't unset \"", nameObjPtr->bytes,
3754 "\": no such variable", NULL);
3755 return JIM_ERR; /* var not found */
3757 varPtr = nameObjPtr->internalRep.varValue.varPtr;
3758 /* If it's a link call UnsetVariable recursively */
3759 if (varPtr->linkFramePtr) {
3760 int retval;
3762 Jim_CallFrame *savedCallFrame;
3764 savedCallFrame = interp->framePtr;
3765 interp->framePtr = varPtr->linkFramePtr;
3766 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
3767 interp->framePtr = savedCallFrame;
3768 if (retval != JIM_OK && flags & JIM_ERRMSG) {
3769 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3770 Jim_AppendStrings(interp, Jim_GetResult(interp),
3771 "can't unset \"", nameObjPtr->bytes,
3772 "\": no such variable", NULL);
3774 return retval;
3775 } else {
3776 name = Jim_GetString(nameObjPtr, NULL);
3777 if (Jim_DeleteHashEntry(&interp->framePtr->vars, name)
3778 != JIM_OK) return JIM_ERR;
3779 /* Change the callframe id, invalidating var lookup caching */
3780 JimChangeCallFrameId(interp, interp->framePtr);
3781 return JIM_OK;
3785 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
3787 /* Given a variable name for [dict] operation syntax sugar,
3788 * this function returns two objects, the first with the name
3789 * of the variable to set, and the second with the rispective key.
3790 * For example "foo(bar)" will return objects with string repr. of
3791 * "foo" and "bar".
3793 * The returned objects have refcount = 1. The function can't fail. */
3794 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
3795 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
3797 const char *str, *p;
3798 char *t;
3799 int len, keyLen, nameLen;
3800 Jim_Obj *varObjPtr, *keyObjPtr;
3802 str = Jim_GetString(objPtr, &len);
3803 p = strchr(str, '(');
3804 p++;
3805 keyLen = len-((p-str) + 1);
3806 nameLen = (p-str)-1;
3807 /* Create the objects with the variable name and key. */
3808 t = Jim_Alloc(nameLen + 1);
3809 memcpy(t, str, nameLen);
3810 t[nameLen] = '\0';
3811 varObjPtr = Jim_NewStringObjNoAlloc(interp, t, nameLen);
3813 t = Jim_Alloc(keyLen + 1);
3814 memcpy(t, p, keyLen);
3815 t[keyLen] = '\0';
3816 keyObjPtr = Jim_NewStringObjNoAlloc(interp, t, keyLen);
3818 Jim_IncrRefCount(varObjPtr);
3819 Jim_IncrRefCount(keyObjPtr);
3820 *varPtrPtr = varObjPtr;
3821 *keyPtrPtr = keyObjPtr;
3824 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
3825 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
3826 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr,
3827 Jim_Obj *valObjPtr)
3829 Jim_Obj *varObjPtr, *keyObjPtr;
3830 int err = JIM_OK;
3832 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3833 err = Jim_SetDictKeysVector(interp, varObjPtr, &keyObjPtr, 1,
3834 valObjPtr);
3835 Jim_DecrRefCount(interp, varObjPtr);
3836 Jim_DecrRefCount(interp, keyObjPtr);
3837 return err;
3840 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
3841 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr)
3843 Jim_Obj *varObjPtr, *keyObjPtr, *dictObjPtr, *resObjPtr;
3845 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3846 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
3847 if (!dictObjPtr) {
3848 resObjPtr = NULL;
3849 goto err;
3851 if (Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_ERRMSG)
3852 != JIM_OK) {
3853 resObjPtr = NULL;
3855 err:
3856 Jim_DecrRefCount(interp, varObjPtr);
3857 Jim_DecrRefCount(interp, keyObjPtr);
3858 return resObjPtr;
3861 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
3863 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3864 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr,
3865 Jim_Obj *dupPtr);
3867 static Jim_ObjType dictSubstObjType = {
3868 "dict-substitution",
3869 FreeDictSubstInternalRep,
3870 DupDictSubstInternalRep,
3871 NULL,
3872 JIM_TYPE_NONE,
3875 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3877 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
3878 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
3881 void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr,
3882 Jim_Obj *dupPtr)
3884 JIM_NOTUSED(interp);
3886 dupPtr->internalRep.dictSubstValue.varNameObjPtr =
3887 srcPtr->internalRep.dictSubstValue.varNameObjPtr;
3888 dupPtr->internalRep.dictSubstValue.indexObjPtr =
3889 srcPtr->internalRep.dictSubstValue.indexObjPtr;
3890 dupPtr->typePtr = &dictSubstObjType;
3893 /* This function is used to expand [dict get] sugar in the form
3894 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
3895 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
3896 * object that is *guaranteed* to be in the form VARNAME(INDEX).
3897 * The 'index' part is [subst]ituted, and is used to lookup a key inside
3898 * the [dict]ionary contained in variable VARNAME. */
3899 Jim_Obj *Jim_ExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
3901 Jim_Obj *varObjPtr, *keyObjPtr, *dictObjPtr, *resObjPtr;
3902 Jim_Obj *substKeyObjPtr = NULL;
3904 if (objPtr->typePtr != &dictSubstObjType) {
3905 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3906 Jim_FreeIntRep(interp, objPtr);
3907 objPtr->typePtr = &dictSubstObjType;
3908 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
3909 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
3911 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
3912 &substKeyObjPtr, JIM_NONE)
3913 != JIM_OK) {
3914 substKeyObjPtr = NULL;
3915 goto err;
3917 Jim_IncrRefCount(substKeyObjPtr);
3918 dictObjPtr = Jim_GetVariable(interp,
3919 objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_ERRMSG);
3920 if (!dictObjPtr) {
3921 resObjPtr = NULL;
3922 goto err;
3924 if (Jim_DictKey(interp, dictObjPtr, substKeyObjPtr, &resObjPtr, JIM_ERRMSG)
3925 != JIM_OK) {
3926 resObjPtr = NULL;
3927 goto err;
3929 err:
3930 if (substKeyObjPtr) Jim_DecrRefCount(interp, substKeyObjPtr);
3931 return resObjPtr;
3934 /* -----------------------------------------------------------------------------
3935 * CallFrame
3936 * ---------------------------------------------------------------------------*/
3938 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp)
3940 Jim_CallFrame *cf;
3941 if (interp->freeFramesList) {
3942 cf = interp->freeFramesList;
3943 interp->freeFramesList = cf->nextFramePtr;
3944 } else {
3945 cf = Jim_Alloc(sizeof(*cf));
3946 cf->vars.table = NULL;
3949 cf->id = interp->callFrameEpoch++;
3950 cf->parentCallFrame = NULL;
3951 cf->argv = NULL;
3952 cf->argc = 0;
3953 cf->procArgsObjPtr = NULL;
3954 cf->procBodyObjPtr = NULL;
3955 cf->nextFramePtr = NULL;
3956 cf->staticVars = NULL;
3957 if (cf->vars.table == NULL)
3958 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
3959 return cf;
3962 /* Used to invalidate every caching related to callframe stability. */
3963 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf)
3965 cf->id = interp->callFrameEpoch++;
3968 #define JIM_FCF_NONE 0 /* no flags */
3969 #define JIM_FCF_NOHT 1 /* don't free the hash table */
3970 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf,
3971 int flags)
3973 if (cf->procArgsObjPtr) Jim_DecrRefCount(interp, cf->procArgsObjPtr);
3974 if (cf->procBodyObjPtr) Jim_DecrRefCount(interp, cf->procBodyObjPtr);
3975 if (!(flags & JIM_FCF_NOHT))
3976 Jim_FreeHashTable(&cf->vars);
3977 else {
3978 int i;
3979 Jim_HashEntry **table = cf->vars.table, *he;
3981 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
3982 he = table[i];
3983 while (he != NULL) {
3984 Jim_HashEntry *nextEntry = he->next;
3985 Jim_Var *varPtr = (void*) he->val;
3987 Jim_DecrRefCount(interp, varPtr->objPtr);
3988 Jim_Free(he->val);
3989 Jim_Free((void*)he->key); /* ATTENTION: const cast */
3990 Jim_Free(he);
3991 table[i] = NULL;
3992 he = nextEntry;
3995 cf->vars.used = 0;
3997 cf->nextFramePtr = interp->freeFramesList;
3998 interp->freeFramesList = cf;
4001 /* -----------------------------------------------------------------------------
4002 * References
4003 * ---------------------------------------------------------------------------*/
4005 /* References HashTable Type.
4007 * Keys are jim_wide integers, dynamically allocated for now but in the
4008 * future it's worth to cache this 8 bytes objects. Values are poitners
4009 * to Jim_References. */
4010 static void JimReferencesHTValDestructor(void *interp, void *val)
4012 Jim_Reference *refPtr = (void*) val;
4014 Jim_DecrRefCount(interp, refPtr->objPtr);
4015 if (refPtr->finalizerCmdNamePtr != NULL) {
4016 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
4018 Jim_Free(val);
4021 unsigned int JimReferencesHTHashFunction(const void *key)
4023 /* Only the least significant bits are used. */
4024 const jim_wide *widePtr = key;
4025 unsigned int intValue = (unsigned int) *widePtr;
4026 return Jim_IntHashFunction(intValue);
4029 unsigned int JimReferencesHTDoubleHashFunction(const void *key)
4031 /* Only the least significant bits are used. */
4032 const jim_wide *widePtr = key;
4033 unsigned int intValue = (unsigned int) *widePtr;
4034 return intValue; /* identity function. */
4037 const void *JimReferencesHTKeyDup(void *privdata, const void *key)
4039 void *copy = Jim_Alloc(sizeof(jim_wide));
4040 JIM_NOTUSED(privdata);
4042 memcpy(copy, key, sizeof(jim_wide));
4043 return copy;
4046 int JimReferencesHTKeyCompare(void *privdata, const void *key1,
4047 const void *key2)
4049 JIM_NOTUSED(privdata);
4051 return memcmp(key1, key2, sizeof(jim_wide)) == 0;
4054 void JimReferencesHTKeyDestructor(void *privdata, const void *key)
4056 JIM_NOTUSED(privdata);
4058 Jim_Free((void*)key);
4061 static Jim_HashTableType JimReferencesHashTableType = {
4062 JimReferencesHTHashFunction, /* hash function */
4063 JimReferencesHTKeyDup, /* key dup */
4064 NULL, /* val dup */
4065 JimReferencesHTKeyCompare, /* key compare */
4066 JimReferencesHTKeyDestructor, /* key destructor */
4067 JimReferencesHTValDestructor /* val destructor */
4070 /* -----------------------------------------------------------------------------
4071 * Reference object type and References API
4072 * ---------------------------------------------------------------------------*/
4074 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
4076 static Jim_ObjType referenceObjType = {
4077 "reference",
4078 NULL,
4079 NULL,
4080 UpdateStringOfReference,
4081 JIM_TYPE_REFERENCES,
4084 void UpdateStringOfReference(struct Jim_Obj *objPtr)
4086 int len;
4087 char buf[JIM_REFERENCE_SPACE + 1];
4088 Jim_Reference *refPtr;
4090 refPtr = objPtr->internalRep.refValue.refPtr;
4091 len = JimFormatReference(buf, refPtr, objPtr->internalRep.refValue.id);
4092 objPtr->bytes = Jim_Alloc(len + 1);
4093 memcpy(objPtr->bytes, buf, len + 1);
4094 objPtr->length = len;
4097 /* returns true if 'c' is a valid reference tag character.
4098 * i.e. inside the range [_a-zA-Z0-9] */
4099 static int isrefchar(int c)
4101 if (c == '_' || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') ||
4102 (c >= '0' && c <= '9')) return 1;
4103 return 0;
4106 int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4108 jim_wide wideValue;
4109 int i, len;
4110 const char *str, *start, *end;
4111 char refId[21];
4112 Jim_Reference *refPtr;
4113 Jim_HashEntry *he;
4115 /* Get the string representation */
4116 str = Jim_GetString(objPtr, &len);
4117 /* Check if it looks like a reference */
4118 if (len < JIM_REFERENCE_SPACE) goto badformat;
4119 /* Trim spaces */
4120 start = str;
4121 end = str + len-1;
4122 while (*start == ' ') start++;
4123 while (*end == ' ' && end > start) end--;
4124 if (end-start + 1 != JIM_REFERENCE_SPACE) goto badformat;
4125 /* <reference.<1234567>.%020> */
4126 if (memcmp(start, "<reference.<", 12) != 0) goto badformat;
4127 if (start[12 + JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>') goto badformat;
4128 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
4129 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
4130 if (!isrefchar(start[12 + i])) goto badformat;
4132 /* Extract info from the refernece. */
4133 memcpy(refId, start + 14 + JIM_REFERENCE_TAGLEN, 20);
4134 refId[20] = '\0';
4135 /* Try to convert the ID into a jim_wide */
4136 if (Jim_StringToWide(refId, &wideValue, 10) != JIM_OK) goto badformat;
4137 /* Check if the reference really exists! */
4138 he = Jim_FindHashEntry(&interp->references, &wideValue);
4139 if (he == NULL) {
4140 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4141 Jim_AppendStrings(interp, Jim_GetResult(interp),
4142 "Invalid reference ID \"", str, "\"", NULL);
4143 return JIM_ERR;
4145 refPtr = he->val;
4146 /* Free the old internal repr and set the new one. */
4147 Jim_FreeIntRep(interp, objPtr);
4148 objPtr->typePtr = &referenceObjType;
4149 objPtr->internalRep.refValue.id = wideValue;
4150 objPtr->internalRep.refValue.refPtr = refPtr;
4151 return JIM_OK;
4153 badformat:
4154 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4155 Jim_AppendStrings(interp, Jim_GetResult(interp),
4156 "expected reference but got \"", str, "\"", NULL);
4157 return JIM_ERR;
4160 /* Returns a new reference pointing to objPtr, having cmdNamePtr
4161 * as finalizer command (or NULL if there is no finalizer).
4162 * The returned reference object has refcount = 0. */
4163 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr,
4164 Jim_Obj *cmdNamePtr)
4166 struct Jim_Reference *refPtr;
4167 jim_wide wideValue = interp->referenceNextId;
4168 Jim_Obj *refObjPtr;
4169 const char *tag;
4170 int tagLen, i;
4172 /* Perform the Garbage Collection if needed. */
4173 Jim_CollectIfNeeded(interp);
4175 refPtr = Jim_Alloc(sizeof(*refPtr));
4176 refPtr->objPtr = objPtr;
4177 Jim_IncrRefCount(objPtr);
4178 refPtr->finalizerCmdNamePtr = cmdNamePtr;
4179 if (cmdNamePtr)
4180 Jim_IncrRefCount(cmdNamePtr);
4181 Jim_AddHashEntry(&interp->references, &wideValue, refPtr);
4182 refObjPtr = Jim_NewObj(interp);
4183 refObjPtr->typePtr = &referenceObjType;
4184 refObjPtr->bytes = NULL;
4185 refObjPtr->internalRep.refValue.id = interp->referenceNextId;
4186 refObjPtr->internalRep.refValue.refPtr = refPtr;
4187 interp->referenceNextId++;
4188 /* Set the tag. Trimmered at JIM_REFERENCE_TAGLEN. Everything
4189 * that does not pass the 'isrefchar' test is replaced with '_' */
4190 tag = Jim_GetString(tagPtr, &tagLen);
4191 if (tagLen > JIM_REFERENCE_TAGLEN)
4192 tagLen = JIM_REFERENCE_TAGLEN;
4193 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
4194 if (i < tagLen)
4195 refPtr->tag[i] = tag[i];
4196 else
4197 refPtr->tag[i] = '_';
4199 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
4200 return refObjPtr;
4203 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
4205 if (objPtr->typePtr != &referenceObjType &&
4206 SetReferenceFromAny(interp, objPtr) == JIM_ERR)
4207 return NULL;
4208 return objPtr->internalRep.refValue.refPtr;
4211 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
4213 Jim_Reference *refPtr;
4215 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
4216 return JIM_ERR;
4217 Jim_IncrRefCount(cmdNamePtr);
4218 if (refPtr->finalizerCmdNamePtr)
4219 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
4220 refPtr->finalizerCmdNamePtr = cmdNamePtr;
4221 return JIM_OK;
4224 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
4226 Jim_Reference *refPtr;
4228 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
4229 return JIM_ERR;
4230 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
4231 return JIM_OK;
4234 /* -----------------------------------------------------------------------------
4235 * References Garbage Collection
4236 * ---------------------------------------------------------------------------*/
4238 /* This the hash table type for the "MARK" phase of the GC */
4239 static Jim_HashTableType JimRefMarkHashTableType = {
4240 JimReferencesHTHashFunction, /* hash function */
4241 JimReferencesHTKeyDup, /* key dup */
4242 NULL, /* val dup */
4243 JimReferencesHTKeyCompare, /* key compare */
4244 JimReferencesHTKeyDestructor, /* key destructor */
4245 NULL /* val destructor */
4248 /* #define JIM_DEBUG_GC 1 */
4250 /* Performs the garbage collection. */
4251 int Jim_Collect(Jim_Interp *interp)
4253 Jim_HashTable marks;
4254 Jim_HashTableIterator *htiter;
4255 Jim_HashEntry *he;
4256 Jim_Obj *objPtr;
4257 int collected = 0;
4259 /* Avoid recursive calls */
4260 if (interp->lastCollectId == -1) {
4261 /* Jim_Collect() already running. Return just now. */
4262 return 0;
4264 interp->lastCollectId = -1;
4266 /* Mark all the references found into the 'mark' hash table.
4267 * The references are searched in every live object that
4268 * is of a type that can contain references. */
4269 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
4270 objPtr = interp->liveList;
4271 while (objPtr) {
4272 if (objPtr->typePtr == NULL ||
4273 objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
4274 const char *str, *p;
4275 int len;
4277 /* If the object is of type reference, to get the
4278 * Id is simple... */
4279 if (objPtr->typePtr == &referenceObjType) {
4280 Jim_AddHashEntry(&marks,
4281 &objPtr->internalRep.refValue.id, NULL);
4282 #ifdef JIM_DEBUG_GC
4283 Jim_fprintf(interp,interp->cookie_stdout,
4284 "MARK (reference): %d refcount: %d" JIM_NL,
4285 (int) objPtr->internalRep.refValue.id,
4286 objPtr->refCount);
4287 #endif
4288 objPtr = objPtr->nextObjPtr;
4289 continue;
4291 /* Get the string repr of the object we want
4292 * to scan for references. */
4293 p = str = Jim_GetString(objPtr, &len);
4294 /* Skip objects too little to contain references. */
4295 if (len < JIM_REFERENCE_SPACE) {
4296 objPtr = objPtr->nextObjPtr;
4297 continue;
4299 /* Extract references from the object string repr. */
4300 while (1) {
4301 int i;
4302 jim_wide id;
4303 char buf[21];
4305 if ((p = strstr(p, "<reference.<")) == NULL)
4306 break;
4307 /* Check if it's a valid reference. */
4308 if (len-(p-str) < JIM_REFERENCE_SPACE) break;
4309 if (p[41] != '>' || p[19] != '>' || p[20] != '.') break;
4310 for (i = 21; i <= 40; i++)
4311 if (!isdigit((int)p[i]))
4312 break;
4313 /* Get the ID */
4314 memcpy(buf, p + 21, 20);
4315 buf[20] = '\0';
4316 Jim_StringToWide(buf, &id, 10);
4318 /* Ok, a reference for the given ID
4319 * was found. Mark it. */
4320 Jim_AddHashEntry(&marks, &id, NULL);
4321 #ifdef JIM_DEBUG_GC
4322 Jim_fprintf(interp,interp->cookie_stdout,"MARK: %d" JIM_NL, (int)id);
4323 #endif
4324 p += JIM_REFERENCE_SPACE;
4327 objPtr = objPtr->nextObjPtr;
4330 /* Run the references hash table to destroy every reference that
4331 * is not referenced outside (not present in the mark HT). */
4332 htiter = Jim_GetHashTableIterator(&interp->references);
4333 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
4334 const jim_wide *refId;
4335 Jim_Reference *refPtr;
4337 refId = he->key;
4338 /* Check if in the mark phase we encountered
4339 * this reference. */
4340 if (Jim_FindHashEntry(&marks, refId) == NULL) {
4341 #ifdef JIM_DEBUG_GC
4342 Jim_fprintf(interp,interp->cookie_stdout,"COLLECTING %d" JIM_NL, (int)*refId);
4343 #endif
4344 collected++;
4345 /* Drop the reference, but call the
4346 * finalizer first if registered. */
4347 refPtr = he->val;
4348 if (refPtr->finalizerCmdNamePtr) {
4349 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE + 1);
4350 Jim_Obj *objv[3], *oldResult;
4352 JimFormatReference(refstr, refPtr, *refId);
4354 objv[0] = refPtr->finalizerCmdNamePtr;
4355 objv[1] = Jim_NewStringObjNoAlloc(interp,
4356 refstr, 32);
4357 objv[2] = refPtr->objPtr;
4358 Jim_IncrRefCount(objv[0]);
4359 Jim_IncrRefCount(objv[1]);
4360 Jim_IncrRefCount(objv[2]);
4362 /* Drop the reference itself */
4363 Jim_DeleteHashEntry(&interp->references, refId);
4365 /* Call the finalizer. Errors ignored. */
4366 oldResult = interp->result;
4367 Jim_IncrRefCount(oldResult);
4368 Jim_EvalObjVector(interp, 3, objv);
4369 Jim_SetResult(interp, oldResult);
4370 Jim_DecrRefCount(interp, oldResult);
4372 Jim_DecrRefCount(interp, objv[0]);
4373 Jim_DecrRefCount(interp, objv[1]);
4374 Jim_DecrRefCount(interp, objv[2]);
4375 } else {
4376 Jim_DeleteHashEntry(&interp->references, refId);
4380 Jim_FreeHashTableIterator(htiter);
4381 Jim_FreeHashTable(&marks);
4382 interp->lastCollectId = interp->referenceNextId;
4383 interp->lastCollectTime = time(NULL);
4384 return collected;
4387 #define JIM_COLLECT_ID_PERIOD 5000
4388 #define JIM_COLLECT_TIME_PERIOD 300
4390 void Jim_CollectIfNeeded(Jim_Interp *interp)
4392 jim_wide elapsedId;
4393 int elapsedTime;
4395 elapsedId = interp->referenceNextId - interp->lastCollectId;
4396 elapsedTime = time(NULL) - interp->lastCollectTime;
4399 if (elapsedId > JIM_COLLECT_ID_PERIOD ||
4400 elapsedTime > JIM_COLLECT_TIME_PERIOD) {
4401 Jim_Collect(interp);
4405 /* -----------------------------------------------------------------------------
4406 * Interpreter related functions
4407 * ---------------------------------------------------------------------------*/
4409 Jim_Interp *Jim_CreateInterp(void)
4411 Jim_Interp *i = Jim_Alloc(sizeof(*i));
4412 Jim_Obj *pathPtr;
4414 i->errorLine = 0;
4415 i->errorFileName = Jim_StrDup("");
4416 i->numLevels = 0;
4417 i->maxNestingDepth = JIM_MAX_NESTING_DEPTH;
4418 i->returnCode = JIM_OK;
4419 i->exitCode = 0;
4420 i->procEpoch = 0;
4421 i->callFrameEpoch = 0;
4422 i->liveList = i->freeList = NULL;
4423 i->scriptFileName = Jim_StrDup("");
4424 i->referenceNextId = 0;
4425 i->lastCollectId = 0;
4426 i->lastCollectTime = time(NULL);
4427 i->freeFramesList = NULL;
4428 i->prngState = NULL;
4429 i->evalRetcodeLevel = -1;
4430 i->cookie_stdin = stdin;
4431 i->cookie_stdout = stdout;
4432 i->cookie_stderr = stderr;
4433 i->cb_fwrite = ((size_t (*)(const void *, size_t, size_t, void *))(fwrite));
4434 i->cb_fread = ((size_t (*)(void *, size_t, size_t, void *))(fread));
4435 i->cb_vfprintf = ((int (*)(void *, const char *fmt, va_list))(vfprintf));
4436 i->cb_fflush = ((int (*)(void *))(fflush));
4437 i->cb_fgets = ((char * (*)(char *, int, void *))(fgets));
4439 /* Note that we can create objects only after the
4440 * interpreter liveList and freeList pointers are
4441 * initialized to NULL. */
4442 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
4443 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
4444 Jim_InitHashTable(&i->sharedStrings, &JimSharedStringsHashTableType,
4445 NULL);
4446 Jim_InitHashTable(&i->stub, &JimStringCopyHashTableType, NULL);
4447 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
4448 Jim_InitHashTable(&i->packages, &JimStringKeyValCopyHashTableType, NULL);
4449 i->framePtr = i->topFramePtr = JimCreateCallFrame(i);
4450 i->emptyObj = Jim_NewEmptyStringObj(i);
4451 i->result = i->emptyObj;
4452 i->stackTrace = Jim_NewListObj(i, NULL, 0);
4453 i->unknown = Jim_NewStringObj(i, "unknown", -1);
4454 i->unknown_called = 0;
4455 Jim_IncrRefCount(i->emptyObj);
4456 Jim_IncrRefCount(i->result);
4457 Jim_IncrRefCount(i->stackTrace);
4458 Jim_IncrRefCount(i->unknown);
4460 /* Initialize key variables every interpreter should contain */
4461 pathPtr = Jim_NewStringObj(i, "./", -1);
4462 Jim_SetVariableStr(i, "jim_libpath", pathPtr);
4463 Jim_SetVariableStrWithStr(i, "jim_interactive", "0");
4465 /* Export the core API to extensions */
4466 JimRegisterCoreApi(i);
4467 return i;
4470 /* This is the only function Jim exports directly without
4471 * to use the STUB system. It is only used by embedders
4472 * in order to get an interpreter with the Jim API pointers
4473 * registered. */
4474 Jim_Interp *ExportedJimCreateInterp(void)
4476 return Jim_CreateInterp();
4479 void Jim_FreeInterp(Jim_Interp *i)
4481 Jim_CallFrame *cf = i->framePtr, *prevcf, *nextcf;
4482 Jim_Obj *objPtr, *nextObjPtr;
4484 Jim_DecrRefCount(i, i->emptyObj);
4485 Jim_DecrRefCount(i, i->result);
4486 Jim_DecrRefCount(i, i->stackTrace);
4487 Jim_DecrRefCount(i, i->unknown);
4488 Jim_Free((void*)i->errorFileName);
4489 Jim_Free((void*)i->scriptFileName);
4490 Jim_FreeHashTable(&i->commands);
4491 Jim_FreeHashTable(&i->references);
4492 Jim_FreeHashTable(&i->stub);
4493 Jim_FreeHashTable(&i->assocData);
4494 Jim_FreeHashTable(&i->packages);
4495 Jim_Free(i->prngState);
4496 /* Free the call frames list */
4497 while (cf) {
4498 prevcf = cf->parentCallFrame;
4499 JimFreeCallFrame(i, cf, JIM_FCF_NONE);
4500 cf = prevcf;
4502 /* Check that the live object list is empty, otherwise
4503 * there is a memory leak. */
4504 if (i->liveList != NULL) {
4505 Jim_Obj *objPtr = i->liveList;
4507 Jim_fprintf(i, i->cookie_stdout,JIM_NL "-------------------------------------" JIM_NL);
4508 Jim_fprintf(i, i->cookie_stdout,"Objects still in the free list:" JIM_NL);
4509 while (objPtr) {
4510 const char *type = objPtr->typePtr ?
4511 objPtr->typePtr->name : "";
4512 Jim_fprintf(i, i->cookie_stdout,"%p \"%-10s\": '%.20s' (refCount: %d)" JIM_NL,
4513 objPtr, type,
4514 objPtr->bytes ? objPtr->bytes
4515 : "(null)", objPtr->refCount);
4516 if (objPtr->typePtr == &sourceObjType) {
4517 Jim_fprintf(i, i->cookie_stdout, "FILE %s LINE %d" JIM_NL,
4518 objPtr->internalRep.sourceValue.fileName,
4519 objPtr->internalRep.sourceValue.lineNumber);
4521 objPtr = objPtr->nextObjPtr;
4523 Jim_fprintf(i, i->cookie_stdout, "-------------------------------------" JIM_NL JIM_NL);
4524 Jim_Panic(i,"Live list non empty freeing the interpreter! Leak?");
4526 /* Free all the freed objects. */
4527 objPtr = i->freeList;
4528 while (objPtr) {
4529 nextObjPtr = objPtr->nextObjPtr;
4530 Jim_Free(objPtr);
4531 objPtr = nextObjPtr;
4533 /* Free cached CallFrame structures */
4534 cf = i->freeFramesList;
4535 while (cf) {
4536 nextcf = cf->nextFramePtr;
4537 if (cf->vars.table != NULL)
4538 Jim_Free(cf->vars.table);
4539 Jim_Free(cf);
4540 cf = nextcf;
4542 /* Free the sharedString hash table. Make sure to free it
4543 * after every other Jim_Object was freed. */
4544 Jim_FreeHashTable(&i->sharedStrings);
4545 /* Free the interpreter structure. */
4546 Jim_Free(i);
4549 /* Store the call frame relative to the level represented by
4550 * levelObjPtr into *framePtrPtr. If levelObjPtr == NULL, the
4551 * level is assumed to be '1'.
4553 * If a newLevelptr int pointer is specified, the function stores
4554 * the absolute level integer value of the new target callframe into
4555 * *newLevelPtr. (this is used to adjust interp->numLevels
4556 * in the implementation of [uplevel], so that [info level] will
4557 * return a correct information).
4559 * This function accepts the 'level' argument in the form
4560 * of the commands [uplevel] and [upvar].
4562 * For a function accepting a relative integer as level suitable
4563 * for implementation of [info level ?level?] check the
4564 * GetCallFrameByInteger() function. */
4565 int Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
4566 Jim_CallFrame **framePtrPtr, int *newLevelPtr)
4568 long level;
4569 const char *str;
4570 Jim_CallFrame *framePtr;
4572 if (newLevelPtr) *newLevelPtr = interp->numLevels;
4573 if (levelObjPtr) {
4574 str = Jim_GetString(levelObjPtr, NULL);
4575 if (str[0] == '#') {
4576 char *endptr;
4577 /* speedup for the toplevel (level #0) */
4578 if (str[1] == '0' && str[2] == '\0') {
4579 if (newLevelPtr) *newLevelPtr = 0;
4580 *framePtrPtr = interp->topFramePtr;
4581 return JIM_OK;
4584 level = strtol(str + 1, &endptr, 0);
4585 if (str[1] == '\0' || endptr[0] != '\0' || level < 0)
4586 goto badlevel;
4587 /* An 'absolute' level is converted into the
4588 * 'number of levels to go back' format. */
4589 level = interp->numLevels - level;
4590 if (level < 0) goto badlevel;
4591 } else {
4592 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0)
4593 goto badlevel;
4595 } else {
4596 str = "1"; /* Needed to format the error message. */
4597 level = 1;
4599 /* Lookup */
4600 framePtr = interp->framePtr;
4601 if (newLevelPtr) *newLevelPtr = (*newLevelPtr)-level;
4602 while (level--) {
4603 framePtr = framePtr->parentCallFrame;
4604 if (framePtr == NULL) goto badlevel;
4606 *framePtrPtr = framePtr;
4607 return JIM_OK;
4608 badlevel:
4609 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4610 Jim_AppendStrings(interp, Jim_GetResult(interp),
4611 "bad level \"", str, "\"", NULL);
4612 return JIM_ERR;
4615 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
4616 * as a relative integer like in the [info level ?level?] command. */
4617 static int JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr,
4618 Jim_CallFrame **framePtrPtr)
4620 jim_wide level;
4621 jim_wide relLevel; /* level relative to the current one. */
4622 Jim_CallFrame *framePtr;
4624 if (Jim_GetWide(interp, levelObjPtr, &level) != JIM_OK)
4625 goto badlevel;
4626 if (level > 0) {
4627 /* An 'absolute' level is converted into the
4628 * 'number of levels to go back' format. */
4629 relLevel = interp->numLevels - level;
4630 } else {
4631 relLevel = -level;
4633 /* Lookup */
4634 framePtr = interp->framePtr;
4635 while (relLevel--) {
4636 framePtr = framePtr->parentCallFrame;
4637 if (framePtr == NULL) goto badlevel;
4639 *framePtrPtr = framePtr;
4640 return JIM_OK;
4641 badlevel:
4642 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4643 Jim_AppendStrings(interp, Jim_GetResult(interp),
4644 "bad level \"", Jim_GetString(levelObjPtr, NULL), "\"", NULL);
4645 return JIM_ERR;
4648 static void JimSetErrorFileName(Jim_Interp *interp, char *filename)
4650 Jim_Free((void*)interp->errorFileName);
4651 interp->errorFileName = Jim_StrDup(filename);
4654 static void JimSetErrorLineNumber(Jim_Interp *interp, int linenr)
4656 interp->errorLine = linenr;
4659 static void JimResetStackTrace(Jim_Interp *interp)
4661 Jim_DecrRefCount(interp, interp->stackTrace);
4662 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
4663 Jim_IncrRefCount(interp->stackTrace);
4666 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
4667 const char *filename, int linenr)
4669 /* No need to add this dummy entry to the stack trace */
4670 if (strcmp(procname, "unknown") == 0) {
4671 return;
4674 if (Jim_IsShared(interp->stackTrace)) {
4675 interp->stackTrace =
4676 Jim_DuplicateObj(interp, interp->stackTrace);
4677 Jim_IncrRefCount(interp->stackTrace);
4679 Jim_ListAppendElement(interp, interp->stackTrace,
4680 Jim_NewStringObj(interp, procname, -1));
4681 Jim_ListAppendElement(interp, interp->stackTrace,
4682 Jim_NewStringObj(interp, filename, -1));
4683 Jim_ListAppendElement(interp, interp->stackTrace,
4684 Jim_NewIntObj(interp, linenr));
4687 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc *delProc, void *data)
4689 AssocDataValue *assocEntryPtr = (AssocDataValue *)Jim_Alloc(sizeof(AssocDataValue));
4690 assocEntryPtr->delProc = delProc;
4691 assocEntryPtr->data = data;
4692 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
4695 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
4697 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
4698 if (entryPtr != NULL) {
4699 AssocDataValue *assocEntryPtr = (AssocDataValue *)entryPtr->val;
4700 return assocEntryPtr->data;
4702 return NULL;
4705 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
4707 return Jim_DeleteHashEntry(&interp->assocData, key);
4710 int Jim_GetExitCode(Jim_Interp *interp) {
4711 return interp->exitCode;
4714 void *Jim_SetStdin(Jim_Interp *interp, void *fp)
4716 if (fp != NULL) interp->cookie_stdin = fp;
4717 return interp->cookie_stdin;
4720 void *Jim_SetStdout(Jim_Interp *interp, void *fp)
4722 if (fp != NULL) interp->cookie_stdout = fp;
4723 return interp->cookie_stdout;
4726 void *Jim_SetStderr(Jim_Interp *interp, void *fp)
4728 if (fp != NULL) interp->cookie_stderr = fp;
4729 return interp->cookie_stderr;
4732 /* -----------------------------------------------------------------------------
4733 * Shared strings.
4734 * Every interpreter has an hash table where to put shared dynamically
4735 * allocate strings that are likely to be used a lot of times.
4736 * For example, in the 'source' object type, there is a pointer to
4737 * the filename associated with that object. Every script has a lot
4738 * of this objects with the identical file name, so it is wise to share
4739 * this info.
4741 * The API is trivial: Jim_GetSharedString(interp, "foobar")
4742 * returns the pointer to the shared string. Every time a reference
4743 * to the string is no longer used, the user should call
4744 * Jim_ReleaseSharedString(interp, stringPointer). Once no one is using
4745 * a given string, it is removed from the hash table.
4746 * ---------------------------------------------------------------------------*/
4747 const char *Jim_GetSharedString(Jim_Interp *interp, const char *str)
4749 Jim_HashEntry *he = Jim_FindHashEntry(&interp->sharedStrings, str);
4751 if (he == NULL) {
4752 char *strCopy = Jim_StrDup(str);
4754 Jim_AddHashEntry(&interp->sharedStrings, strCopy, (void*)1);
4755 return strCopy;
4756 } else {
4757 long refCount = (long) he->val;
4759 refCount++;
4760 he->val = (void*) refCount;
4761 return he->key;
4765 void Jim_ReleaseSharedString(Jim_Interp *interp, const char *str)
4767 long refCount;
4768 Jim_HashEntry *he = Jim_FindHashEntry(&interp->sharedStrings, str);
4770 if (he == NULL)
4771 Jim_Panic(interp,"Jim_ReleaseSharedString called with "
4772 "unknown shared string '%s'", str);
4773 refCount = (long) he->val;
4774 refCount--;
4775 if (refCount == 0) {
4776 Jim_DeleteHashEntry(&interp->sharedStrings, str);
4777 } else {
4778 he->val = (void*) refCount;
4782 /* -----------------------------------------------------------------------------
4783 * Integer object
4784 * ---------------------------------------------------------------------------*/
4785 #define JIM_INTEGER_SPACE 24
4787 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
4788 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
4790 static Jim_ObjType intObjType = {
4791 "int",
4792 NULL,
4793 NULL,
4794 UpdateStringOfInt,
4795 JIM_TYPE_NONE,
4798 void UpdateStringOfInt(struct Jim_Obj *objPtr)
4800 int len;
4801 char buf[JIM_INTEGER_SPACE + 1];
4803 len = Jim_WideToString(buf, objPtr->internalRep.wideValue);
4804 objPtr->bytes = Jim_Alloc(len + 1);
4805 memcpy(objPtr->bytes, buf, len + 1);
4806 objPtr->length = len;
4809 int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4811 jim_wide wideValue;
4812 const char *str;
4814 /* Get the string representation */
4815 str = Jim_GetString(objPtr, NULL);
4816 /* Try to convert into a jim_wide */
4817 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
4818 if (flags & JIM_ERRMSG) {
4819 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4820 Jim_AppendStrings(interp, Jim_GetResult(interp),
4821 "expected integer but got \"", str, "\"", NULL);
4823 return JIM_ERR;
4825 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) &&
4826 errno == ERANGE) {
4827 Jim_SetResultString(interp,
4828 "Integer value too big to be represented", -1);
4829 return JIM_ERR;
4831 /* Free the old internal repr and set the new one. */
4832 Jim_FreeIntRep(interp, objPtr);
4833 objPtr->typePtr = &intObjType;
4834 objPtr->internalRep.wideValue = wideValue;
4835 return JIM_OK;
4838 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide *widePtr)
4840 if (objPtr->typePtr != &intObjType &&
4841 SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
4842 return JIM_ERR;
4843 *widePtr = objPtr->internalRep.wideValue;
4844 return JIM_OK;
4847 /* Get a wide but does not set an error if the format is bad. */
4848 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr,
4849 jim_wide *widePtr)
4851 if (objPtr->typePtr != &intObjType &&
4852 SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
4853 return JIM_ERR;
4854 *widePtr = objPtr->internalRep.wideValue;
4855 return JIM_OK;
4858 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
4860 jim_wide wideValue;
4861 int retval;
4863 retval = Jim_GetWide(interp, objPtr, &wideValue);
4864 if (retval == JIM_OK) {
4865 *longPtr = (long) wideValue;
4866 return JIM_OK;
4868 return JIM_ERR;
4871 void Jim_SetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide wideValue)
4873 if (Jim_IsShared(objPtr))
4874 Jim_Panic(interp,"Jim_SetWide called with shared object");
4875 if (objPtr->typePtr != &intObjType) {
4876 Jim_FreeIntRep(interp, objPtr);
4877 objPtr->typePtr = &intObjType;
4879 Jim_InvalidateStringRep(objPtr);
4880 objPtr->internalRep.wideValue = wideValue;
4883 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
4885 Jim_Obj *objPtr;
4887 objPtr = Jim_NewObj(interp);
4888 objPtr->typePtr = &intObjType;
4889 objPtr->bytes = NULL;
4890 objPtr->internalRep.wideValue = wideValue;
4891 return objPtr;
4894 /* -----------------------------------------------------------------------------
4895 * Double object
4896 * ---------------------------------------------------------------------------*/
4897 #define JIM_DOUBLE_SPACE 30
4899 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
4900 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
4902 static Jim_ObjType doubleObjType = {
4903 "double",
4904 NULL,
4905 NULL,
4906 UpdateStringOfDouble,
4907 JIM_TYPE_NONE,
4910 void UpdateStringOfDouble(struct Jim_Obj *objPtr)
4912 int len;
4913 char buf[JIM_DOUBLE_SPACE + 1];
4915 len = Jim_DoubleToString(buf, objPtr->internalRep.doubleValue);
4916 objPtr->bytes = Jim_Alloc(len + 1);
4917 memcpy(objPtr->bytes, buf, len + 1);
4918 objPtr->length = len;
4921 int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4923 double doubleValue;
4924 const char *str;
4926 /* Get the string representation */
4927 str = Jim_GetString(objPtr, NULL);
4928 /* Try to convert into a double */
4929 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
4930 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4931 Jim_AppendStrings(interp, Jim_GetResult(interp),
4932 "expected number but got '", str, "'", NULL);
4933 return JIM_ERR;
4935 /* Free the old internal repr and set the new one. */
4936 Jim_FreeIntRep(interp, objPtr);
4937 objPtr->typePtr = &doubleObjType;
4938 objPtr->internalRep.doubleValue = doubleValue;
4939 return JIM_OK;
4942 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
4944 if (objPtr->typePtr != &doubleObjType &&
4945 SetDoubleFromAny(interp, objPtr) == JIM_ERR)
4946 return JIM_ERR;
4947 *doublePtr = objPtr->internalRep.doubleValue;
4948 return JIM_OK;
4951 void Jim_SetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double doubleValue)
4953 if (Jim_IsShared(objPtr))
4954 Jim_Panic(interp,"Jim_SetDouble called with shared object");
4955 if (objPtr->typePtr != &doubleObjType) {
4956 Jim_FreeIntRep(interp, objPtr);
4957 objPtr->typePtr = &doubleObjType;
4959 Jim_InvalidateStringRep(objPtr);
4960 objPtr->internalRep.doubleValue = doubleValue;
4963 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
4965 Jim_Obj *objPtr;
4967 objPtr = Jim_NewObj(interp);
4968 objPtr->typePtr = &doubleObjType;
4969 objPtr->bytes = NULL;
4970 objPtr->internalRep.doubleValue = doubleValue;
4971 return objPtr;
4974 /* -----------------------------------------------------------------------------
4975 * List object
4976 * ---------------------------------------------------------------------------*/
4977 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
4978 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
4979 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
4980 static void UpdateStringOfList(struct Jim_Obj *objPtr);
4981 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4983 /* Note that while the elements of the list may contain references,
4984 * the list object itself can't. This basically means that the
4985 * list object string representation as a whole can't contain references
4986 * that are not presents in the single elements. */
4987 static Jim_ObjType listObjType = {
4988 "list",
4989 FreeListInternalRep,
4990 DupListInternalRep,
4991 UpdateStringOfList,
4992 JIM_TYPE_NONE,
4995 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4997 int i;
4999 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5000 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
5002 Jim_Free(objPtr->internalRep.listValue.ele);
5005 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
5007 int i;
5008 JIM_NOTUSED(interp);
5010 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
5011 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
5012 dupPtr->internalRep.listValue.ele =
5013 Jim_Alloc(sizeof(Jim_Obj*)*srcPtr->internalRep.listValue.maxLen);
5014 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
5015 sizeof(Jim_Obj*)*srcPtr->internalRep.listValue.len);
5016 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
5017 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
5019 dupPtr->typePtr = &listObjType;
5022 /* The following function checks if a given string can be encoded
5023 * into a list element without any kind of quoting, surrounded by braces,
5024 * or using escapes to quote. */
5025 #define JIM_ELESTR_SIMPLE 0
5026 #define JIM_ELESTR_BRACE 1
5027 #define JIM_ELESTR_QUOTE 2
5028 static int ListElementQuotingType(const char *s, int len)
5030 int i, level, trySimple = 1;
5032 /* Try with the SIMPLE case */
5033 if (len == 0) return JIM_ELESTR_BRACE;
5034 if (s[0] == '"' || s[0] == '{') {
5035 trySimple = 0;
5036 goto testbrace;
5038 for (i = 0; i < len; i++) {
5039 switch (s[i]) {
5040 case ' ':
5041 case '$':
5042 case '"':
5043 case '[':
5044 case ']':
5045 case ';':
5046 case '\\':
5047 case '\r':
5048 case '\n':
5049 case '\t':
5050 case '\f':
5051 case '\v':
5052 trySimple = 0;
5053 case '{':
5054 case '}':
5055 goto testbrace;
5058 return JIM_ELESTR_SIMPLE;
5060 testbrace:
5061 /* Test if it's possible to do with braces */
5062 if (s[len-1] == '\\' ||
5063 s[len-1] == ']') return JIM_ELESTR_QUOTE;
5064 level = 0;
5065 for (i = 0; i < len; i++) {
5066 switch (s[i]) {
5067 case '{': level++; break;
5068 case '}': level--;
5069 if (level < 0) return JIM_ELESTR_QUOTE;
5070 break;
5071 case '\\':
5072 if (s[i + 1] == '\n')
5073 return JIM_ELESTR_QUOTE;
5074 else
5075 if (s[i + 1] != '\0') i++;
5076 break;
5079 if (level == 0) {
5080 if (!trySimple) return JIM_ELESTR_BRACE;
5081 for (i = 0; i < len; i++) {
5082 switch (s[i]) {
5083 case ' ':
5084 case '$':
5085 case '"':
5086 case '[':
5087 case ']':
5088 case ';':
5089 case '\\':
5090 case '\r':
5091 case '\n':
5092 case '\t':
5093 case '\f':
5094 case '\v':
5095 return JIM_ELESTR_BRACE;
5096 break;
5099 return JIM_ELESTR_SIMPLE;
5101 return JIM_ELESTR_QUOTE;
5104 /* Returns the malloc-ed representation of a string
5105 * using backslash to quote special chars. */
5106 char *BackslashQuoteString(const char *s, int len, int *qlenPtr)
5108 char *q = Jim_Alloc(len*2 + 1), *p;
5110 p = q;
5111 while (*s) {
5112 switch (*s) {
5113 case ' ':
5114 case '$':
5115 case '"':
5116 case '[':
5117 case ']':
5118 case '{':
5119 case '}':
5120 case ';':
5121 case '\\':
5122 *p++ = '\\';
5123 *p++ = *s++;
5124 break;
5125 case '\n': *p++ = '\\'; *p++ = 'n'; s++; break;
5126 case '\r': *p++ = '\\'; *p++ = 'r'; s++; break;
5127 case '\t': *p++ = '\\'; *p++ = 't'; s++; break;
5128 case '\f': *p++ = '\\'; *p++ = 'f'; s++; break;
5129 case '\v': *p++ = '\\'; *p++ = 'v'; s++; break;
5130 default:
5131 *p++ = *s++;
5132 break;
5135 *p = '\0';
5136 *qlenPtr = p-q;
5137 return q;
5140 void UpdateStringOfList(struct Jim_Obj *objPtr)
5142 int i, bufLen, realLength;
5143 const char *strRep;
5144 char *p;
5145 int *quotingType;
5146 Jim_Obj **ele = objPtr->internalRep.listValue.ele;
5148 /* (Over) Estimate the space needed. */
5149 quotingType = Jim_Alloc(sizeof(int)*objPtr->internalRep.listValue.len + 1);
5150 bufLen = 0;
5151 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5152 int len;
5154 strRep = Jim_GetString(ele[i], &len);
5155 quotingType[i] = ListElementQuotingType(strRep, len);
5156 switch (quotingType[i]) {
5157 case JIM_ELESTR_SIMPLE: bufLen += len; break;
5158 case JIM_ELESTR_BRACE: bufLen += len + 2; break;
5159 case JIM_ELESTR_QUOTE: bufLen += len*2; break;
5161 bufLen++; /* elements separator. */
5163 bufLen++;
5165 /* Generate the string rep. */
5166 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
5167 realLength = 0;
5168 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5169 int len, qlen;
5170 const char *strRep = Jim_GetString(ele[i], &len);
5171 char *q;
5173 switch (quotingType[i]) {
5174 case JIM_ELESTR_SIMPLE:
5175 memcpy(p, strRep, len);
5176 p += len;
5177 realLength += len;
5178 break;
5179 case JIM_ELESTR_BRACE:
5180 *p++ = '{';
5181 memcpy(p, strRep, len);
5182 p += len;
5183 *p++ = '}';
5184 realLength += len + 2;
5185 break;
5186 case JIM_ELESTR_QUOTE:
5187 q = BackslashQuoteString(strRep, len, &qlen);
5188 memcpy(p, q, qlen);
5189 Jim_Free(q);
5190 p += qlen;
5191 realLength += qlen;
5192 break;
5194 /* Add a separating space */
5195 if (i + 1 != objPtr->internalRep.listValue.len) {
5196 *p++ = ' ';
5197 realLength ++;
5200 *p = '\0'; /* nul term. */
5201 objPtr->length = realLength;
5202 Jim_Free(quotingType);
5205 int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
5207 struct JimParserCtx parser;
5208 const char *str;
5209 int strLen;
5211 /* Get the string representation */
5212 str = Jim_GetString(objPtr, &strLen);
5214 /* Free the old internal repr just now and initialize the
5215 * new one just now. The string->list conversion can't fail. */
5216 Jim_FreeIntRep(interp, objPtr);
5217 objPtr->typePtr = &listObjType;
5218 objPtr->internalRep.listValue.len = 0;
5219 objPtr->internalRep.listValue.maxLen = 0;
5220 objPtr->internalRep.listValue.ele = NULL;
5222 /* Convert into a list */
5223 JimParserInit(&parser, str, strLen, 1);
5224 while (!JimParserEof(&parser)) {
5225 char *token;
5226 int tokenLen, type;
5227 Jim_Obj *elementPtr;
5229 JimParseList(&parser);
5230 if (JimParserTtype(&parser) != JIM_TT_STR &&
5231 JimParserTtype(&parser) != JIM_TT_ESC)
5232 continue;
5233 token = JimParserGetToken(&parser, &tokenLen, &type, NULL);
5234 elementPtr = Jim_NewStringObjNoAlloc(interp, token, tokenLen);
5235 ListAppendElement(objPtr, elementPtr);
5237 return JIM_OK;
5240 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements,
5241 int len)
5243 Jim_Obj *objPtr;
5244 int i;
5246 objPtr = Jim_NewObj(interp);
5247 objPtr->typePtr = &listObjType;
5248 objPtr->bytes = NULL;
5249 objPtr->internalRep.listValue.ele = NULL;
5250 objPtr->internalRep.listValue.len = 0;
5251 objPtr->internalRep.listValue.maxLen = 0;
5252 for (i = 0; i < len; i++) {
5253 ListAppendElement(objPtr, elements[i]);
5255 return objPtr;
5258 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
5259 * length of the vector. Note that the user of this function should make
5260 * sure that the list object can't shimmer while the vector returned
5261 * is in use, this vector is the one stored inside the internal representation
5262 * of the list object. This function is not exported, extensions should
5263 * always access to the List object elements using Jim_ListIndex(). */
5264 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *argc,
5265 Jim_Obj ***listVec)
5267 Jim_ListLength(interp, listObj, argc);
5268 assert(listObj->typePtr == &listObjType);
5269 *listVec = listObj->internalRep.listValue.ele;
5272 /* ListSortElements type values */
5273 enum {JIM_LSORT_ASCII, JIM_LSORT_NOCASE, JIM_LSORT_ASCII_DECR,
5274 JIM_LSORT_NOCASE_DECR};
5276 /* Sort the internal rep of a list. */
5277 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5279 return Jim_StringCompareObj(*lhsObj, *rhsObj, 0);
5282 static int ListSortStringDecr(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5284 return Jim_StringCompareObj(*lhsObj, *rhsObj, 0) * -1;
5287 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5289 return Jim_StringCompareObj(*lhsObj, *rhsObj, 1);
5292 static int ListSortStringNoCaseDecr(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5294 return Jim_StringCompareObj(*lhsObj, *rhsObj, 1) * -1;
5297 /* Sort a list *in place*. MUST be called with non-shared objects. */
5298 static void ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, int type)
5300 typedef int (qsort_comparator)(const void *, const void *);
5301 int (*fn)(Jim_Obj**, Jim_Obj**);
5302 Jim_Obj **vector;
5303 int len;
5305 if (Jim_IsShared(listObjPtr))
5306 Jim_Panic(interp,"Jim_ListSortElements called with shared object");
5307 if (listObjPtr->typePtr != &listObjType)
5308 SetListFromAny(interp, listObjPtr);
5310 vector = listObjPtr->internalRep.listValue.ele;
5311 len = listObjPtr->internalRep.listValue.len;
5312 switch (type) {
5313 case JIM_LSORT_ASCII: fn = ListSortString; break;
5314 case JIM_LSORT_NOCASE: fn = ListSortStringNoCase; break;
5315 case JIM_LSORT_ASCII_DECR: fn = ListSortStringDecr; break;
5316 case JIM_LSORT_NOCASE_DECR: fn = ListSortStringNoCaseDecr; break;
5317 default:
5318 fn = NULL; /* avoid warning */
5319 Jim_Panic(interp,"ListSort called with invalid sort type");
5321 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *)fn);
5322 Jim_InvalidateStringRep(listObjPtr);
5325 /* This is the low-level function to append an element to a list.
5326 * The higher-level Jim_ListAppendElement() performs shared object
5327 * check and invalidate the string repr. This version is used
5328 * in the internals of the List Object and is not exported.
5330 * NOTE: this function can be called only against objects
5331 * with internal type of List. */
5332 void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
5334 int requiredLen = listPtr->internalRep.listValue.len + 1;
5336 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5337 int maxLen = requiredLen * 2;
5339 listPtr->internalRep.listValue.ele =
5340 Jim_Realloc(listPtr->internalRep.listValue.ele,
5341 sizeof(Jim_Obj*)*maxLen);
5342 listPtr->internalRep.listValue.maxLen = maxLen;
5344 listPtr->internalRep.listValue.ele[listPtr->internalRep.listValue.len] =
5345 objPtr;
5346 listPtr->internalRep.listValue.len ++;
5347 Jim_IncrRefCount(objPtr);
5350 /* This is the low-level function to insert elements into a list.
5351 * The higher-level Jim_ListInsertElements() performs shared object
5352 * check and invalidate the string repr. This version is used
5353 * in the internals of the List Object and is not exported.
5355 * NOTE: this function can be called only against objects
5356 * with internal type of List. */
5357 void ListInsertElements(Jim_Obj *listPtr, int index, int elemc,
5358 Jim_Obj *const *elemVec)
5360 int currentLen = listPtr->internalRep.listValue.len;
5361 int requiredLen = currentLen + elemc;
5362 int i;
5363 Jim_Obj **point;
5365 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5366 int maxLen = requiredLen * 2;
5368 listPtr->internalRep.listValue.ele =
5369 Jim_Realloc(listPtr->internalRep.listValue.ele,
5370 sizeof(Jim_Obj*)*maxLen);
5371 listPtr->internalRep.listValue.maxLen = maxLen;
5373 point = listPtr->internalRep.listValue.ele + index;
5374 memmove(point + elemc, point, (currentLen-index) * sizeof(Jim_Obj*));
5375 for (i = 0; i < elemc; ++i) {
5376 point[i] = elemVec[i];
5377 Jim_IncrRefCount(point[i]);
5379 listPtr->internalRep.listValue.len += elemc;
5382 /* Appends every element of appendListPtr into listPtr.
5383 * Both have to be of the list type. */
5384 void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
5386 int i, oldLen = listPtr->internalRep.listValue.len;
5387 int appendLen = appendListPtr->internalRep.listValue.len;
5388 int requiredLen = oldLen + appendLen;
5390 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5391 int maxLen = requiredLen * 2;
5393 listPtr->internalRep.listValue.ele =
5394 Jim_Realloc(listPtr->internalRep.listValue.ele,
5395 sizeof(Jim_Obj*)*maxLen);
5396 listPtr->internalRep.listValue.maxLen = maxLen;
5398 for (i = 0; i < appendLen; i++) {
5399 Jim_Obj *objPtr = appendListPtr->internalRep.listValue.ele[i];
5400 listPtr->internalRep.listValue.ele[oldLen + i] = objPtr;
5401 Jim_IncrRefCount(objPtr);
5403 listPtr->internalRep.listValue.len += appendLen;
5406 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
5408 if (Jim_IsShared(listPtr))
5409 Jim_Panic(interp,"Jim_ListAppendElement called with shared object");
5410 if (listPtr->typePtr != &listObjType)
5411 SetListFromAny(interp, listPtr);
5412 Jim_InvalidateStringRep(listPtr);
5413 ListAppendElement(listPtr, objPtr);
5416 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
5418 if (Jim_IsShared(listPtr))
5419 Jim_Panic(interp,"Jim_ListAppendList called with shared object");
5420 if (listPtr->typePtr != &listObjType)
5421 SetListFromAny(interp, listPtr);
5422 Jim_InvalidateStringRep(listPtr);
5423 ListAppendList(listPtr, appendListPtr);
5426 void Jim_ListLength(Jim_Interp *interp, Jim_Obj *listPtr, int *intPtr)
5428 if (listPtr->typePtr != &listObjType)
5429 SetListFromAny(interp, listPtr);
5430 *intPtr = listPtr->internalRep.listValue.len;
5433 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5434 int objc, Jim_Obj *const *objVec)
5436 if (Jim_IsShared(listPtr))
5437 Jim_Panic(interp,"Jim_ListInsertElement called with shared object");
5438 if (listPtr->typePtr != &listObjType)
5439 SetListFromAny(interp, listPtr);
5440 if (index >= 0 && index > listPtr->internalRep.listValue.len)
5441 index = listPtr->internalRep.listValue.len;
5442 else if (index < 0)
5443 index = 0;
5444 Jim_InvalidateStringRep(listPtr);
5445 ListInsertElements(listPtr, index, objc, objVec);
5448 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5449 Jim_Obj **objPtrPtr, int flags)
5451 if (listPtr->typePtr != &listObjType)
5452 SetListFromAny(interp, listPtr);
5453 if ((index >= 0 && index >= listPtr->internalRep.listValue.len) ||
5454 (index < 0 && (-index-1) >= listPtr->internalRep.listValue.len)) {
5455 if (flags & JIM_ERRMSG) {
5456 Jim_SetResultString(interp,
5457 "list index out of range", -1);
5459 return JIM_ERR;
5461 if (index < 0)
5462 index = listPtr->internalRep.listValue.len + index;
5463 *objPtrPtr = listPtr->internalRep.listValue.ele[index];
5464 return JIM_OK;
5467 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5468 Jim_Obj *newObjPtr, int flags)
5470 if (listPtr->typePtr != &listObjType)
5471 SetListFromAny(interp, listPtr);
5472 if ((index >= 0 && index >= listPtr->internalRep.listValue.len) ||
5473 (index < 0 && (-index-1) >= listPtr->internalRep.listValue.len)) {
5474 if (flags & JIM_ERRMSG) {
5475 Jim_SetResultString(interp,
5476 "list index out of range", -1);
5478 return JIM_ERR;
5480 if (index < 0)
5481 index = listPtr->internalRep.listValue.len + index;
5482 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[index]);
5483 listPtr->internalRep.listValue.ele[index] = newObjPtr;
5484 Jim_IncrRefCount(newObjPtr);
5485 return JIM_OK;
5488 /* Modify the list stored into the variable named 'varNamePtr'
5489 * setting the element specified by the 'indexc' indexes objects in 'indexv',
5490 * with the new element 'newObjptr'. */
5491 int Jim_SetListIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
5492 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
5494 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
5495 int shared, i, index;
5497 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
5498 if (objPtr == NULL)
5499 return JIM_ERR;
5500 if ((shared = Jim_IsShared(objPtr)))
5501 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
5502 for (i = 0; i < indexc-1; i++) {
5503 listObjPtr = objPtr;
5504 if (Jim_GetIndex(interp, indexv[i], &index) != JIM_OK)
5505 goto err;
5506 if (Jim_ListIndex(interp, listObjPtr, index, &objPtr,
5507 JIM_ERRMSG) != JIM_OK) {
5508 goto err;
5510 if (Jim_IsShared(objPtr)) {
5511 objPtr = Jim_DuplicateObj(interp, objPtr);
5512 ListSetIndex(interp, listObjPtr, index, objPtr, JIM_NONE);
5514 Jim_InvalidateStringRep(listObjPtr);
5516 if (Jim_GetIndex(interp, indexv[indexc-1], &index) != JIM_OK)
5517 goto err;
5518 if (ListSetIndex(interp, objPtr, index, newObjPtr, JIM_ERRMSG) == JIM_ERR)
5519 goto err;
5520 Jim_InvalidateStringRep(objPtr);
5521 Jim_InvalidateStringRep(varObjPtr);
5522 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
5523 goto err;
5524 Jim_SetResult(interp, varObjPtr);
5525 return JIM_OK;
5526 err:
5527 if (shared) {
5528 Jim_FreeNewObj(interp, varObjPtr);
5530 return JIM_ERR;
5533 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
5535 int i;
5537 /* If all the objects in objv are lists without string rep.
5538 * it's possible to return a list as result, that's the
5539 * concatenation of all the lists. */
5540 for (i = 0; i < objc; i++) {
5541 if (objv[i]->typePtr != &listObjType || objv[i]->bytes)
5542 break;
5544 if (i == objc) {
5545 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
5546 for (i = 0; i < objc; i++)
5547 Jim_ListAppendList(interp, objPtr, objv[i]);
5548 return objPtr;
5549 } else {
5550 /* Else... we have to glue strings together */
5551 int len = 0, objLen;
5552 char *bytes, *p;
5554 /* Compute the length */
5555 for (i = 0; i < objc; i++) {
5556 Jim_GetString(objv[i], &objLen);
5557 len += objLen;
5559 if (objc) len += objc-1;
5560 /* Create the string rep, and a stinrg object holding it. */
5561 p = bytes = Jim_Alloc(len + 1);
5562 for (i = 0; i < objc; i++) {
5563 const char *s = Jim_GetString(objv[i], &objLen);
5564 while (objLen && (*s == ' ' || *s == '\t' || *s == '\n'))
5566 s++; objLen--; len--;
5568 while (objLen && (s[objLen-1] == ' ' ||
5569 s[objLen-1] == '\n' || s[objLen-1] == '\t')) {
5570 objLen--; len--;
5572 memcpy(p, s, objLen);
5573 p += objLen;
5574 if (objLen && i + 1 != objc) {
5575 *p++ = ' ';
5576 } else if (i + 1 != objc) {
5577 /* Drop the space calcuated for this
5578 * element that is instead null. */
5579 len--;
5582 *p = '\0';
5583 return Jim_NewStringObjNoAlloc(interp, bytes, len);
5587 /* Returns a list composed of the elements in the specified range.
5588 * first and start are directly accepted as Jim_Objects and
5589 * processed for the end?-index? case. */
5590 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
5592 int first, last;
5593 int len, rangeLen;
5595 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
5596 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
5597 return NULL;
5598 Jim_ListLength(interp, listObjPtr, &len); /* will convert into list */
5599 first = JimRelToAbsIndex(len, first);
5600 last = JimRelToAbsIndex(len, last);
5601 JimRelToAbsRange(len, first, last, &first, &last, &rangeLen);
5602 return Jim_NewListObj(interp,
5603 listObjPtr->internalRep.listValue.ele + first, rangeLen);
5606 /* -----------------------------------------------------------------------------
5607 * Dict object
5608 * ---------------------------------------------------------------------------*/
5609 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
5610 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
5611 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
5612 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
5614 /* Dict HashTable Type.
5616 * Keys and Values are Jim objects. */
5618 unsigned int JimObjectHTHashFunction(const void *key)
5620 const char *str;
5621 Jim_Obj *objPtr = (Jim_Obj*) key;
5622 int len, h;
5624 str = Jim_GetString(objPtr, &len);
5625 h = Jim_GenHashFunction((unsigned char*)str, len);
5626 return h;
5629 int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
5631 JIM_NOTUSED(privdata);
5633 return Jim_StringEqObj((Jim_Obj*)key1, (Jim_Obj*)key2, 0);
5636 static void JimObjectHTKeyValDestructor(void *interp, void *val)
5638 Jim_Obj *objPtr = val;
5640 Jim_DecrRefCount(interp, objPtr);
5643 static Jim_HashTableType JimDictHashTableType = {
5644 JimObjectHTHashFunction, /* hash function */
5645 NULL, /* key dup */
5646 NULL, /* val dup */
5647 JimObjectHTKeyCompare, /* key compare */
5648 (void(*)(void*, const void*)) /* ATTENTION: const cast */
5649 JimObjectHTKeyValDestructor, /* key destructor */
5650 JimObjectHTKeyValDestructor /* val destructor */
5653 /* Note that while the elements of the dict may contain references,
5654 * the list object itself can't. This basically means that the
5655 * dict object string representation as a whole can't contain references
5656 * that are not presents in the single elements. */
5657 static Jim_ObjType dictObjType = {
5658 "dict",
5659 FreeDictInternalRep,
5660 DupDictInternalRep,
5661 UpdateStringOfDict,
5662 JIM_TYPE_NONE,
5665 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
5667 JIM_NOTUSED(interp);
5669 Jim_FreeHashTable(objPtr->internalRep.ptr);
5670 Jim_Free(objPtr->internalRep.ptr);
5673 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
5675 Jim_HashTable *ht, *dupHt;
5676 Jim_HashTableIterator *htiter;
5677 Jim_HashEntry *he;
5679 /* Create a new hash table */
5680 ht = srcPtr->internalRep.ptr;
5681 dupHt = Jim_Alloc(sizeof(*dupHt));
5682 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
5683 if (ht->size != 0)
5684 Jim_ExpandHashTable(dupHt, ht->size);
5685 /* Copy every element from the source to the dup hash table */
5686 htiter = Jim_GetHashTableIterator(ht);
5687 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
5688 const Jim_Obj *keyObjPtr = he->key;
5689 Jim_Obj *valObjPtr = he->val;
5691 Jim_IncrRefCount((Jim_Obj*)keyObjPtr); /* ATTENTION: const cast */
5692 Jim_IncrRefCount(valObjPtr);
5693 Jim_AddHashEntry(dupHt, keyObjPtr, valObjPtr);
5695 Jim_FreeHashTableIterator(htiter);
5697 dupPtr->internalRep.ptr = dupHt;
5698 dupPtr->typePtr = &dictObjType;
5701 void UpdateStringOfDict(struct Jim_Obj *objPtr)
5703 int i, bufLen, realLength;
5704 const char *strRep;
5705 char *p;
5706 int *quotingType, objc;
5707 Jim_HashTable *ht;
5708 Jim_HashTableIterator *htiter;
5709 Jim_HashEntry *he;
5710 Jim_Obj **objv;
5712 /* Trun the hash table into a flat vector of Jim_Objects. */
5713 ht = objPtr->internalRep.ptr;
5714 objc = ht->used*2;
5715 objv = Jim_Alloc(objc*sizeof(Jim_Obj*));
5716 htiter = Jim_GetHashTableIterator(ht);
5717 i = 0;
5718 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
5719 objv[i++] = (Jim_Obj*)he->key; /* ATTENTION: const cast */
5720 objv[i++] = he->val;
5722 Jim_FreeHashTableIterator(htiter);
5723 /* (Over) Estimate the space needed. */
5724 quotingType = Jim_Alloc(sizeof(int)*objc);
5725 bufLen = 0;
5726 for (i = 0; i < objc; i++) {
5727 int len;
5729 strRep = Jim_GetString(objv[i], &len);
5730 quotingType[i] = ListElementQuotingType(strRep, len);
5731 switch (quotingType[i]) {
5732 case JIM_ELESTR_SIMPLE: bufLen += len; break;
5733 case JIM_ELESTR_BRACE: bufLen += len + 2; break;
5734 case JIM_ELESTR_QUOTE: bufLen += len*2; break;
5736 bufLen++; /* elements separator. */
5738 bufLen++;
5740 /* Generate the string rep. */
5741 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
5742 realLength = 0;
5743 for (i = 0; i < objc; i++) {
5744 int len, qlen;
5745 const char *strRep = Jim_GetString(objv[i], &len);
5746 char *q;
5748 switch (quotingType[i]) {
5749 case JIM_ELESTR_SIMPLE:
5750 memcpy(p, strRep, len);
5751 p += len;
5752 realLength += len;
5753 break;
5754 case JIM_ELESTR_BRACE:
5755 *p++ = '{';
5756 memcpy(p, strRep, len);
5757 p += len;
5758 *p++ = '}';
5759 realLength += len + 2;
5760 break;
5761 case JIM_ELESTR_QUOTE:
5762 q = BackslashQuoteString(strRep, len, &qlen);
5763 memcpy(p, q, qlen);
5764 Jim_Free(q);
5765 p += qlen;
5766 realLength += qlen;
5767 break;
5769 /* Add a separating space */
5770 if (i + 1 != objc) {
5771 *p++ = ' ';
5772 realLength ++;
5775 *p = '\0'; /* nul term. */
5776 objPtr->length = realLength;
5777 Jim_Free(quotingType);
5778 Jim_Free(objv);
5781 int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
5783 struct JimParserCtx parser;
5784 Jim_HashTable *ht;
5785 Jim_Obj *objv[2];
5786 const char *str;
5787 int i, strLen;
5789 /* Get the string representation */
5790 str = Jim_GetString(objPtr, &strLen);
5792 /* Free the old internal repr just now and initialize the
5793 * new one just now. The string->list conversion can't fail. */
5794 Jim_FreeIntRep(interp, objPtr);
5795 ht = Jim_Alloc(sizeof(*ht));
5796 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
5797 objPtr->typePtr = &dictObjType;
5798 objPtr->internalRep.ptr = ht;
5800 /* Convert into a dict */
5801 JimParserInit(&parser, str, strLen, 1);
5802 i = 0;
5803 while (!JimParserEof(&parser)) {
5804 char *token;
5805 int tokenLen, type;
5807 JimParseList(&parser);
5808 if (JimParserTtype(&parser) != JIM_TT_STR &&
5809 JimParserTtype(&parser) != JIM_TT_ESC)
5810 continue;
5811 token = JimParserGetToken(&parser, &tokenLen, &type, NULL);
5812 objv[i++] = Jim_NewStringObjNoAlloc(interp, token, tokenLen);
5813 if (i == 2) {
5814 i = 0;
5815 Jim_IncrRefCount(objv[0]);
5816 Jim_IncrRefCount(objv[1]);
5817 if (Jim_AddHashEntry(ht, objv[0], objv[1]) != JIM_OK) {
5818 Jim_HashEntry *he;
5819 he = Jim_FindHashEntry(ht, objv[0]);
5820 Jim_DecrRefCount(interp, objv[0]);
5821 /* ATTENTION: const cast */
5822 Jim_DecrRefCount(interp, (Jim_Obj*)he->val);
5823 he->val = objv[1];
5827 if (i) {
5828 Jim_FreeNewObj(interp, objv[0]);
5829 objPtr->typePtr = NULL;
5830 Jim_FreeHashTable(ht);
5831 Jim_SetResultString(interp, "invalid dictionary value: must be a list with an even number of elements", -1);
5832 return JIM_ERR;
5834 return JIM_OK;
5837 /* Dict object API */
5839 /* Add an element to a dict. objPtr must be of the "dict" type.
5840 * The higer-level exported function is Jim_DictAddElement().
5841 * If an element with the specified key already exists, the value
5842 * associated is replaced with the new one.
5844 * if valueObjPtr == NULL, the key is instead removed if it exists. */
5845 static void DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
5846 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
5848 Jim_HashTable *ht = objPtr->internalRep.ptr;
5850 if (valueObjPtr == NULL) { /* unset */
5851 Jim_DeleteHashEntry(ht, keyObjPtr);
5852 return;
5854 Jim_IncrRefCount(keyObjPtr);
5855 Jim_IncrRefCount(valueObjPtr);
5856 if (Jim_AddHashEntry(ht, keyObjPtr, valueObjPtr) != JIM_OK) {
5857 Jim_HashEntry *he = Jim_FindHashEntry(ht, keyObjPtr);
5858 Jim_DecrRefCount(interp, keyObjPtr);
5859 /* ATTENTION: const cast */
5860 Jim_DecrRefCount(interp, (Jim_Obj*)he->val);
5861 he->val = valueObjPtr;
5865 /* Add an element, higher-level interface for DictAddElement().
5866 * If valueObjPtr == NULL, the key is removed if it exists. */
5867 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
5868 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
5870 if (Jim_IsShared(objPtr))
5871 Jim_Panic(interp,"Jim_DictAddElement called with shared object");
5872 if (objPtr->typePtr != &dictObjType) {
5873 if (SetDictFromAny(interp, objPtr) != JIM_OK)
5874 return JIM_ERR;
5876 DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
5877 Jim_InvalidateStringRep(objPtr);
5878 return JIM_OK;
5881 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
5883 Jim_Obj *objPtr;
5884 int i;
5886 if (len % 2)
5887 Jim_Panic(interp,"Jim_NewDicObj() 'len' argument must be even");
5889 objPtr = Jim_NewObj(interp);
5890 objPtr->typePtr = &dictObjType;
5891 objPtr->bytes = NULL;
5892 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
5893 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
5894 for (i = 0; i < len; i += 2)
5895 DictAddElement(interp, objPtr, elements[i], elements[i + 1]);
5896 return objPtr;
5899 /* Return the value associated to the specified dict key */
5900 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
5901 Jim_Obj **objPtrPtr, int flags)
5903 Jim_HashEntry *he;
5904 Jim_HashTable *ht;
5906 if (dictPtr->typePtr != &dictObjType) {
5907 if (SetDictFromAny(interp, dictPtr) != JIM_OK)
5908 return JIM_ERR;
5910 ht = dictPtr->internalRep.ptr;
5911 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
5912 if (flags & JIM_ERRMSG) {
5913 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
5914 Jim_AppendStrings(interp, Jim_GetResult(interp),
5915 "key \"", Jim_GetString(keyPtr, NULL),
5916 "\" not found in dictionary", NULL);
5918 return JIM_ERR;
5920 *objPtrPtr = he->val;
5921 return JIM_OK;
5924 /* Return the value associated to the specified dict keys */
5925 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
5926 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
5928 Jim_Obj *objPtr = NULL;
5929 int i;
5931 if (keyc == 0) {
5932 *objPtrPtr = dictPtr;
5933 return JIM_OK;
5936 for (i = 0; i < keyc; i++) {
5937 if (Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags)
5938 != JIM_OK)
5939 return JIM_ERR;
5940 dictPtr = objPtr;
5942 *objPtrPtr = objPtr;
5943 return JIM_OK;
5946 /* Modify the dict stored into the variable named 'varNamePtr'
5947 * setting the element specified by the 'keyc' keys objects in 'keyv',
5948 * with the new value of the element 'newObjPtr'.
5950 * If newObjPtr == NULL the operation is to remove the given key
5951 * from the dictionary. */
5952 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
5953 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr)
5955 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
5956 int shared, i;
5958 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
5959 if (objPtr == NULL) {
5960 if (newObjPtr == NULL) /* Cannot remove a key from non existing var */
5961 return JIM_ERR;
5962 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
5963 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
5964 Jim_FreeNewObj(interp, varObjPtr);
5965 return JIM_ERR;
5968 if ((shared = Jim_IsShared(objPtr)))
5969 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
5970 for (i = 0; i < keyc-1; i++) {
5971 dictObjPtr = objPtr;
5973 /* Check if it's a valid dictionary */
5974 if (dictObjPtr->typePtr != &dictObjType) {
5975 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK)
5976 goto err;
5978 /* Check if the given key exists. */
5979 Jim_InvalidateStringRep(dictObjPtr);
5980 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
5981 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK)
5983 /* This key exists at the current level.
5984 * Make sure it's not shared!. */
5985 if (Jim_IsShared(objPtr)) {
5986 objPtr = Jim_DuplicateObj(interp, objPtr);
5987 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
5989 } else {
5990 /* Key not found. If it's an [unset] operation
5991 * this is an error. Only the last key may not
5992 * exist. */
5993 if (newObjPtr == NULL)
5994 goto err;
5995 /* Otherwise set an empty dictionary
5996 * as key's value. */
5997 objPtr = Jim_NewDictObj(interp, NULL, 0);
5998 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
6001 if (Jim_DictAddElement(interp, objPtr, keyv[keyc-1], newObjPtr)
6002 != JIM_OK)
6003 goto err;
6004 Jim_InvalidateStringRep(objPtr);
6005 Jim_InvalidateStringRep(varObjPtr);
6006 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
6007 goto err;
6008 Jim_SetResult(interp, varObjPtr);
6009 return JIM_OK;
6010 err:
6011 if (shared) {
6012 Jim_FreeNewObj(interp, varObjPtr);
6014 return JIM_ERR;
6017 /* -----------------------------------------------------------------------------
6018 * Index object
6019 * ---------------------------------------------------------------------------*/
6020 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
6021 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6023 static Jim_ObjType indexObjType = {
6024 "index",
6025 NULL,
6026 NULL,
6027 UpdateStringOfIndex,
6028 JIM_TYPE_NONE,
6031 void UpdateStringOfIndex(struct Jim_Obj *objPtr)
6033 int len;
6034 char buf[JIM_INTEGER_SPACE + 1];
6036 if (objPtr->internalRep.indexValue >= 0)
6037 len = sprintf(buf, "%d", objPtr->internalRep.indexValue);
6038 else if (objPtr->internalRep.indexValue == -1)
6039 len = sprintf(buf, "end");
6040 else {
6041 len = sprintf(buf, "end%d", objPtr->internalRep.indexValue + 1);
6043 objPtr->bytes = Jim_Alloc(len + 1);
6044 memcpy(objPtr->bytes, buf, len + 1);
6045 objPtr->length = len;
6048 int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6050 int index, end = 0;
6051 const char *str;
6053 /* Get the string representation */
6054 str = Jim_GetString(objPtr, NULL);
6055 /* Try to convert into an index */
6056 if (!strcmp(str, "end")) {
6057 index = 0;
6058 end = 1;
6059 } else {
6060 if (!strncmp(str, "end-", 4)) {
6061 str += 4;
6062 end = 1;
6064 if (Jim_StringToIndex(str, &index) != JIM_OK) {
6065 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
6066 Jim_AppendStrings(interp, Jim_GetResult(interp),
6067 "bad index \"", Jim_GetString(objPtr, NULL), "\": "
6068 "must be integer or end?-integer?", NULL);
6069 return JIM_ERR;
6072 if (end) {
6073 if (index < 0)
6074 index = INT_MAX;
6075 else
6076 index = -(index + 1);
6077 } else if (!end && index < 0)
6078 index = -INT_MAX;
6079 /* Free the old internal repr and set the new one. */
6080 Jim_FreeIntRep(interp, objPtr);
6081 objPtr->typePtr = &indexObjType;
6082 objPtr->internalRep.indexValue = index;
6083 return JIM_OK;
6086 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
6088 /* Avoid shimmering if the object is an integer. */
6089 if (objPtr->typePtr == &intObjType) {
6090 jim_wide val = objPtr->internalRep.wideValue;
6091 if (!(val < LONG_MIN) && !(val > LONG_MAX)) {
6092 *indexPtr = (val < 0) ? -INT_MAX : (long)val;;
6093 return JIM_OK;
6096 if (objPtr->typePtr != &indexObjType &&
6097 SetIndexFromAny(interp, objPtr) == JIM_ERR)
6098 return JIM_ERR;
6099 *indexPtr = objPtr->internalRep.indexValue;
6100 return JIM_OK;
6103 /* -----------------------------------------------------------------------------
6104 * Return Code Object.
6105 * ---------------------------------------------------------------------------*/
6107 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
6109 static Jim_ObjType returnCodeObjType = {
6110 "return-code",
6111 NULL,
6112 NULL,
6113 NULL,
6114 JIM_TYPE_NONE,
6117 int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6119 const char *str;
6120 int strLen, returnCode;
6121 jim_wide wideValue;
6123 /* Get the string representation */
6124 str = Jim_GetString(objPtr, &strLen);
6125 /* Try to convert into an integer */
6126 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
6127 returnCode = (int) wideValue;
6128 else if (!JimStringCompare(str, strLen, "ok", 2, JIM_NOCASE))
6129 returnCode = JIM_OK;
6130 else if (!JimStringCompare(str, strLen, "error", 5, JIM_NOCASE))
6131 returnCode = JIM_ERR;
6132 else if (!JimStringCompare(str, strLen, "return", 6, JIM_NOCASE))
6133 returnCode = JIM_RETURN;
6134 else if (!JimStringCompare(str, strLen, "break", 5, JIM_NOCASE))
6135 returnCode = JIM_BREAK;
6136 else if (!JimStringCompare(str, strLen, "continue", 8, JIM_NOCASE))
6137 returnCode = JIM_CONTINUE;
6138 else if (!JimStringCompare(str, strLen, "eval", 4, JIM_NOCASE))
6139 returnCode = JIM_EVAL;
6140 else if (!JimStringCompare(str, strLen, "exit", 4, JIM_NOCASE))
6141 returnCode = JIM_EXIT;
6142 else {
6143 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
6144 Jim_AppendStrings(interp, Jim_GetResult(interp),
6145 "expected return code but got '", str, "'",
6146 NULL);
6147 return JIM_ERR;
6149 /* Free the old internal repr and set the new one. */
6150 Jim_FreeIntRep(interp, objPtr);
6151 objPtr->typePtr = &returnCodeObjType;
6152 objPtr->internalRep.returnCode = returnCode;
6153 return JIM_OK;
6156 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
6158 if (objPtr->typePtr != &returnCodeObjType &&
6159 SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
6160 return JIM_ERR;
6161 *intPtr = objPtr->internalRep.returnCode;
6162 return JIM_OK;
6165 /* -----------------------------------------------------------------------------
6166 * Expression Parsing
6167 * ---------------------------------------------------------------------------*/
6168 static int JimParseExprOperator(struct JimParserCtx *pc);
6169 static int JimParseExprNumber(struct JimParserCtx *pc);
6170 static int JimParseExprIrrational(struct JimParserCtx *pc);
6172 /* Exrp's Stack machine operators opcodes. */
6174 /* Binary operators (numbers) */
6175 #define JIM_EXPROP_BINARY_NUM_FIRST 0 /* first */
6176 #define JIM_EXPROP_MUL 0
6177 #define JIM_EXPROP_DIV 1
6178 #define JIM_EXPROP_MOD 2
6179 #define JIM_EXPROP_SUB 3
6180 #define JIM_EXPROP_ADD 4
6181 #define JIM_EXPROP_LSHIFT 5
6182 #define JIM_EXPROP_RSHIFT 6
6183 #define JIM_EXPROP_ROTL 7
6184 #define JIM_EXPROP_ROTR 8
6185 #define JIM_EXPROP_LT 9
6186 #define JIM_EXPROP_GT 10
6187 #define JIM_EXPROP_LTE 11
6188 #define JIM_EXPROP_GTE 12
6189 #define JIM_EXPROP_NUMEQ 13
6190 #define JIM_EXPROP_NUMNE 14
6191 #define JIM_EXPROP_BITAND 15
6192 #define JIM_EXPROP_BITXOR 16
6193 #define JIM_EXPROP_BITOR 17
6194 #define JIM_EXPROP_LOGICAND 18
6195 #define JIM_EXPROP_LOGICOR 19
6196 #define JIM_EXPROP_LOGICAND_LEFT 20
6197 #define JIM_EXPROP_LOGICOR_LEFT 21
6198 #define JIM_EXPROP_POW 22
6199 #define JIM_EXPROP_BINARY_NUM_LAST 22 /* last */
6201 /* Binary operators (strings) */
6202 #define JIM_EXPROP_STREQ 23
6203 #define JIM_EXPROP_STRNE 24
6205 /* Unary operators (numbers) */
6206 #define JIM_EXPROP_NOT 25
6207 #define JIM_EXPROP_BITNOT 26
6208 #define JIM_EXPROP_UNARYMINUS 27
6209 #define JIM_EXPROP_UNARYPLUS 28
6210 #define JIM_EXPROP_LOGICAND_RIGHT 29
6211 #define JIM_EXPROP_LOGICOR_RIGHT 30
6213 /* Ternary operators */
6214 #define JIM_EXPROP_TERNARY 31
6216 /* Operands */
6217 #define JIM_EXPROP_NUMBER 32
6218 #define JIM_EXPROP_COMMAND 33
6219 #define JIM_EXPROP_VARIABLE 34
6220 #define JIM_EXPROP_DICTSUGAR 35
6221 #define JIM_EXPROP_SUBST 36
6222 #define JIM_EXPROP_STRING 37
6224 /* Operators table */
6225 typedef struct Jim_ExprOperator {
6226 const char *name;
6227 int precedence;
6228 int arity;
6229 int opcode;
6230 } Jim_ExprOperator;
6232 /* name - precedence - arity - opcode */
6233 static struct Jim_ExprOperator Jim_ExprOperators[] = {
6234 {"!", 300, 1, JIM_EXPROP_NOT},
6235 {"~", 300, 1, JIM_EXPROP_BITNOT},
6236 {"unarymin", 300, 1, JIM_EXPROP_UNARYMINUS},
6237 {"unaryplus", 300, 1, JIM_EXPROP_UNARYPLUS},
6239 {"**", 250, 2, JIM_EXPROP_POW},
6241 {"*", 200, 2, JIM_EXPROP_MUL},
6242 {"/", 200, 2, JIM_EXPROP_DIV},
6243 {"%", 200, 2, JIM_EXPROP_MOD},
6245 {"-", 100, 2, JIM_EXPROP_SUB},
6246 {"+", 100, 2, JIM_EXPROP_ADD},
6248 {"<<<", 90, 3, JIM_EXPROP_ROTL},
6249 {">>>", 90, 3, JIM_EXPROP_ROTR},
6250 {"<<", 90, 2, JIM_EXPROP_LSHIFT},
6251 {">>", 90, 2, JIM_EXPROP_RSHIFT},
6253 {"<", 80, 2, JIM_EXPROP_LT},
6254 {">", 80, 2, JIM_EXPROP_GT},
6255 {"<=", 80, 2, JIM_EXPROP_LTE},
6256 {">=", 80, 2, JIM_EXPROP_GTE},
6258 {"==", 70, 2, JIM_EXPROP_NUMEQ},
6259 {"!=", 70, 2, JIM_EXPROP_NUMNE},
6261 {"eq", 60, 2, JIM_EXPROP_STREQ},
6262 {"ne", 60, 2, JIM_EXPROP_STRNE},
6264 {"&", 50, 2, JIM_EXPROP_BITAND},
6265 {"^", 49, 2, JIM_EXPROP_BITXOR},
6266 {"|", 48, 2, JIM_EXPROP_BITOR},
6268 {"&&", 10, 2, JIM_EXPROP_LOGICAND},
6269 {"||", 10, 2, JIM_EXPROP_LOGICOR},
6271 {"?", 5, 3, JIM_EXPROP_TERNARY},
6272 /* private operators */
6273 {NULL, 10, 2, JIM_EXPROP_LOGICAND_LEFT},
6274 {NULL, 10, 1, JIM_EXPROP_LOGICAND_RIGHT},
6275 {NULL, 10, 2, JIM_EXPROP_LOGICOR_LEFT},
6276 {NULL, 10, 1, JIM_EXPROP_LOGICOR_RIGHT},
6279 #define JIM_EXPR_OPERATORS_NUM \
6280 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
6282 int JimParseExpression(struct JimParserCtx *pc)
6284 /* Discard spaces and quoted newline */
6285 while (*(pc->p) == ' ' ||
6286 *(pc->p) == '\t' ||
6287 *(pc->p) == '\r' ||
6288 *(pc->p) == '\n' ||
6289 (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) {
6290 pc->p++; pc->len--;
6293 if (pc->len == 0) {
6294 pc->tstart = pc->tend = pc->p;
6295 pc->tline = pc->linenr;
6296 pc->tt = JIM_TT_EOL;
6297 pc->eof = 1;
6298 return JIM_OK;
6300 switch (*(pc->p)) {
6301 case '(':
6302 pc->tstart = pc->tend = pc->p;
6303 pc->tline = pc->linenr;
6304 pc->tt = JIM_TT_SUBEXPR_START;
6305 pc->p++; pc->len--;
6306 break;
6307 case ')':
6308 pc->tstart = pc->tend = pc->p;
6309 pc->tline = pc->linenr;
6310 pc->tt = JIM_TT_SUBEXPR_END;
6311 pc->p++; pc->len--;
6312 break;
6313 case '[':
6314 return JimParseCmd(pc);
6315 break;
6316 case '$':
6317 if (JimParseVar(pc) == JIM_ERR)
6318 return JimParseExprOperator(pc);
6319 else
6320 return JIM_OK;
6321 break;
6322 case '-':
6323 if ((pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_EXPR_OPERATOR) &&
6324 isdigit((int)*(pc->p + 1)))
6325 return JimParseExprNumber(pc);
6326 else
6327 return JimParseExprOperator(pc);
6328 break;
6329 case '0': case '1': case '2': case '3': case '4':
6330 case '5': case '6': case '7': case '8': case '9': case '.':
6331 return JimParseExprNumber(pc);
6332 break;
6333 case '"':
6334 case '{':
6335 /* Here it's possible to reuse the List String parsing. */
6336 pc->tt = JIM_TT_NONE; /* Make sure it's sensed as a new word. */
6337 return JimParseListStr(pc);
6338 break;
6339 case 'N': case 'I':
6340 case 'n': case 'i':
6341 if (JimParseExprIrrational(pc) == JIM_ERR)
6342 return JimParseExprOperator(pc);
6343 break;
6344 default:
6345 return JimParseExprOperator(pc);
6346 break;
6348 return JIM_OK;
6351 int JimParseExprNumber(struct JimParserCtx *pc)
6353 int allowdot = 1;
6354 int allowhex = 0;
6356 pc->tstart = pc->p;
6357 pc->tline = pc->linenr;
6358 if (*pc->p == '-') {
6359 pc->p++; pc->len--;
6361 while (isdigit((int)*pc->p)
6362 || (allowhex && isxdigit((int)*pc->p))
6363 || (allowdot && *pc->p == '.')
6364 || (pc->p-pc->tstart == 1 && *pc->tstart == '0' &&
6365 (*pc->p == 'x' || *pc->p == 'X'))
6368 if ((*pc->p == 'x') || (*pc->p == 'X')) {
6369 allowhex = 1;
6370 allowdot = 0;
6372 if (*pc->p == '.')
6373 allowdot = 0;
6374 pc->p++; pc->len--;
6375 if (!allowdot && *pc->p == 'e' && *(pc->p + 1) == '-') {
6376 pc->p += 2; pc->len -= 2;
6379 pc->tend = pc->p-1;
6380 pc->tt = JIM_TT_EXPR_NUMBER;
6381 return JIM_OK;
6384 int JimParseExprIrrational(struct JimParserCtx *pc)
6386 const char *Tokens[] = {"NaN", "nan", "NAN", "Inf", "inf", "INF", NULL};
6387 const char **token;
6388 for (token = Tokens; *token != NULL; token++) {
6389 int len = strlen(*token);
6390 if (strncmp(*token, pc->p, len) == 0) {
6391 pc->tstart = pc->p;
6392 pc->tend = pc->p + len - 1;
6393 pc->p += len; pc->len -= len;
6394 pc->tline = pc->linenr;
6395 pc->tt = JIM_TT_EXPR_NUMBER;
6396 return JIM_OK;
6399 return JIM_ERR;
6402 int JimParseExprOperator(struct JimParserCtx *pc)
6404 int i;
6405 int bestIdx = -1, bestLen = 0;
6407 /* Try to get the longest match. */
6408 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
6409 const char *opname;
6410 int oplen;
6412 opname = Jim_ExprOperators[i].name;
6413 if (opname == NULL) continue;
6414 oplen = strlen(opname);
6416 if (strncmp(opname, pc->p, oplen) == 0 && oplen > bestLen) {
6417 bestIdx = i;
6418 bestLen = oplen;
6421 if (bestIdx == -1) return JIM_ERR;
6422 pc->tstart = pc->p;
6423 pc->tend = pc->p + bestLen - 1;
6424 pc->p += bestLen; pc->len -= bestLen;
6425 pc->tline = pc->linenr;
6426 pc->tt = JIM_TT_EXPR_OPERATOR;
6427 return JIM_OK;
6430 struct Jim_ExprOperator *JimExprOperatorInfo(const char *opname)
6432 int i;
6433 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++)
6434 if (Jim_ExprOperators[i].name &&
6435 strcmp(opname, Jim_ExprOperators[i].name) == 0)
6436 return &Jim_ExprOperators[i];
6437 return NULL;
6440 struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
6442 int i;
6443 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++)
6444 if (Jim_ExprOperators[i].opcode == opcode)
6445 return &Jim_ExprOperators[i];
6446 return NULL;
6449 /* -----------------------------------------------------------------------------
6450 * Expression Object
6451 * ---------------------------------------------------------------------------*/
6452 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6453 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6454 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6456 static Jim_ObjType exprObjType = {
6457 "expression",
6458 FreeExprInternalRep,
6459 DupExprInternalRep,
6460 NULL,
6461 JIM_TYPE_REFERENCES,
6464 /* Expr bytecode structure */
6465 typedef struct ExprByteCode {
6466 int *opcode; /* Integer array of opcodes. */
6467 Jim_Obj **obj; /* Array of associated Jim Objects. */
6468 int len; /* Bytecode length */
6469 int inUse; /* Used for sharing. */
6470 } ExprByteCode;
6472 void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6474 int i;
6475 ExprByteCode *expr = (void*) objPtr->internalRep.ptr;
6477 expr->inUse--;
6478 if (expr->inUse != 0) return;
6479 for (i = 0; i < expr->len; i++)
6480 Jim_DecrRefCount(interp, expr->obj[i]);
6481 Jim_Free(expr->opcode);
6482 Jim_Free(expr->obj);
6483 Jim_Free(expr);
6486 void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6488 JIM_NOTUSED(interp);
6489 JIM_NOTUSED(srcPtr);
6491 /* Just returns an simple string. */
6492 dupPtr->typePtr = NULL;
6495 /* Add a new instruction to an expression bytecode structure. */
6496 static void ExprObjAddInstr(Jim_Interp *interp, ExprByteCode *expr,
6497 int opcode, char *str, int len)
6499 expr->opcode = Jim_Realloc(expr->opcode, sizeof(int)*(expr->len + 1));
6500 expr->obj = Jim_Realloc(expr->obj, sizeof(Jim_Obj*)*(expr->len + 1));
6501 expr->opcode[expr->len] = opcode;
6502 expr->obj[expr->len] = Jim_NewStringObjNoAlloc(interp, str, len);
6503 Jim_IncrRefCount(expr->obj[expr->len]);
6504 expr->len++;
6507 /* Check if an expr program looks correct. */
6508 static int ExprCheckCorrectness(ExprByteCode *expr)
6510 int i;
6511 int stacklen = 0;
6513 /* Try to check if there are stack underflows,
6514 * and make sure at the end of the program there is
6515 * a single result on the stack. */
6516 for (i = 0; i < expr->len; i++) {
6517 switch (expr->opcode[i]) {
6518 case JIM_EXPROP_NUMBER:
6519 case JIM_EXPROP_STRING:
6520 case JIM_EXPROP_SUBST:
6521 case JIM_EXPROP_VARIABLE:
6522 case JIM_EXPROP_DICTSUGAR:
6523 case JIM_EXPROP_COMMAND:
6524 stacklen++;
6525 break;
6526 case JIM_EXPROP_NOT:
6527 case JIM_EXPROP_BITNOT:
6528 case JIM_EXPROP_UNARYMINUS:
6529 case JIM_EXPROP_UNARYPLUS:
6530 /* Unary operations */
6531 if (stacklen < 1) return JIM_ERR;
6532 break;
6533 case JIM_EXPROP_ADD:
6534 case JIM_EXPROP_SUB:
6535 case JIM_EXPROP_MUL:
6536 case JIM_EXPROP_DIV:
6537 case JIM_EXPROP_MOD:
6538 case JIM_EXPROP_LT:
6539 case JIM_EXPROP_GT:
6540 case JIM_EXPROP_LTE:
6541 case JIM_EXPROP_GTE:
6542 case JIM_EXPROP_ROTL:
6543 case JIM_EXPROP_ROTR:
6544 case JIM_EXPROP_LSHIFT:
6545 case JIM_EXPROP_RSHIFT:
6546 case JIM_EXPROP_NUMEQ:
6547 case JIM_EXPROP_NUMNE:
6548 case JIM_EXPROP_STREQ:
6549 case JIM_EXPROP_STRNE:
6550 case JIM_EXPROP_BITAND:
6551 case JIM_EXPROP_BITXOR:
6552 case JIM_EXPROP_BITOR:
6553 case JIM_EXPROP_LOGICAND:
6554 case JIM_EXPROP_LOGICOR:
6555 case JIM_EXPROP_POW:
6556 /* binary operations */
6557 if (stacklen < 2) return JIM_ERR;
6558 stacklen--;
6559 break;
6560 default:
6561 Jim_Panic(NULL,"Default opcode reached ExprCheckCorrectness");
6562 break;
6565 if (stacklen != 1) return JIM_ERR;
6566 return JIM_OK;
6569 static void ExprShareLiterals(Jim_Interp *interp, ExprByteCode *expr,
6570 ScriptObj *topLevelScript)
6572 int i;
6574 return;
6575 for (i = 0; i < expr->len; i++) {
6576 Jim_Obj *foundObjPtr;
6578 if (expr->obj[i] == NULL) continue;
6579 foundObjPtr = ScriptSearchLiteral(interp, topLevelScript,
6580 NULL, expr->obj[i]);
6581 if (foundObjPtr != NULL) {
6582 Jim_IncrRefCount(foundObjPtr);
6583 Jim_DecrRefCount(interp, expr->obj[i]);
6584 expr->obj[i] = foundObjPtr;
6589 /* This procedure converts every occurrence of || and && opereators
6590 * in lazy unary versions.
6592 * a b || is converted into:
6594 * a <offset> |L b |R
6596 * a b && is converted into:
6598 * a <offset> &L b &R
6600 * "|L" checks if 'a' is true:
6601 * 1) if it is true pushes 1 and skips <offset> istructions to reach
6602 * the opcode just after |R.
6603 * 2) if it is false does nothing.
6604 * "|R" checks if 'b' is true:
6605 * 1) if it is true pushes 1, otherwise pushes 0.
6607 * "&L" checks if 'a' is true:
6608 * 1) if it is true does nothing.
6609 * 2) If it is false pushes 0 and skips <offset> istructions to reach
6610 * the opcode just after &R
6611 * "&R" checks if 'a' is true:
6612 * if it is true pushes 1, otherwise pushes 0.
6614 static void ExprMakeLazy(Jim_Interp *interp, ExprByteCode *expr)
6616 while (1) {
6617 int index = -1, leftindex, arity, i, offset;
6618 Jim_ExprOperator *op;
6620 /* Search for || or && */
6621 for (i = 0; i < expr->len; i++) {
6622 if (expr->opcode[i] == JIM_EXPROP_LOGICAND ||
6623 expr->opcode[i] == JIM_EXPROP_LOGICOR) {
6624 index = i;
6625 break;
6628 if (index == -1) return;
6629 /* Search for the end of the first operator */
6630 leftindex = index-1;
6631 arity = 1;
6632 while (arity) {
6633 switch (expr->opcode[leftindex]) {
6634 case JIM_EXPROP_NUMBER:
6635 case JIM_EXPROP_COMMAND:
6636 case JIM_EXPROP_VARIABLE:
6637 case JIM_EXPROP_DICTSUGAR:
6638 case JIM_EXPROP_SUBST:
6639 case JIM_EXPROP_STRING:
6640 break;
6641 default:
6642 op = JimExprOperatorInfoByOpcode(expr->opcode[leftindex]);
6643 if (op == NULL) {
6644 Jim_Panic(interp,"Default reached in ExprMakeLazy()");
6646 arity += op->arity;
6647 break;
6649 arity--;
6650 leftindex--;
6652 leftindex++;
6653 expr->opcode = Jim_Realloc(expr->opcode, sizeof(int)*(expr->len + 2));
6654 expr->obj = Jim_Realloc(expr->obj, sizeof(Jim_Obj*)*(expr->len + 2));
6655 memmove(&expr->opcode[leftindex + 2], &expr->opcode[leftindex],
6656 sizeof(int)*(expr->len-leftindex));
6657 memmove(&expr->obj[leftindex + 2], &expr->obj[leftindex],
6658 sizeof(Jim_Obj*)*(expr->len-leftindex));
6659 expr->len += 2;
6660 index += 2;
6661 offset = (index-leftindex)-1;
6662 Jim_DecrRefCount(interp, expr->obj[index]);
6663 if (expr->opcode[index] == JIM_EXPROP_LOGICAND) {
6664 expr->opcode[leftindex + 1] = JIM_EXPROP_LOGICAND_LEFT;
6665 expr->opcode[index] = JIM_EXPROP_LOGICAND_RIGHT;
6666 expr->obj[leftindex + 1] = Jim_NewStringObj(interp, "&L", -1);
6667 expr->obj[index] = Jim_NewStringObj(interp, "&R", -1);
6668 } else {
6669 expr->opcode[leftindex + 1] = JIM_EXPROP_LOGICOR_LEFT;
6670 expr->opcode[index] = JIM_EXPROP_LOGICOR_RIGHT;
6671 expr->obj[leftindex + 1] = Jim_NewStringObj(interp, "|L", -1);
6672 expr->obj[index] = Jim_NewStringObj(interp, "|R", -1);
6674 expr->opcode[leftindex] = JIM_EXPROP_NUMBER;
6675 expr->obj[leftindex] = Jim_NewIntObj(interp, offset);
6676 Jim_IncrRefCount(expr->obj[index]);
6677 Jim_IncrRefCount(expr->obj[leftindex]);
6678 Jim_IncrRefCount(expr->obj[leftindex + 1]);
6682 /* This method takes the string representation of an expression
6683 * and generates a program for the Expr's stack-based VM. */
6684 int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6686 int exprTextLen;
6687 const char *exprText = Jim_GetString(objPtr, &exprTextLen);
6688 struct JimParserCtx parser;
6689 int i, shareLiterals;
6690 ExprByteCode *expr = Jim_Alloc(sizeof(*expr));
6691 Jim_Stack stack;
6692 Jim_ExprOperator *op;
6694 /* Perform literal sharing with the current procedure
6695 * running only if this expression appears to be not generated
6696 * at runtime. */
6697 shareLiterals = objPtr->typePtr == &sourceObjType;
6699 expr->opcode = NULL;
6700 expr->obj = NULL;
6701 expr->len = 0;
6702 expr->inUse = 1;
6704 Jim_InitStack(&stack);
6705 JimParserInit(&parser, exprText, exprTextLen, 1);
6706 while (!JimParserEof(&parser)) {
6707 char *token;
6708 int len, type;
6710 if (JimParseExpression(&parser) != JIM_OK) {
6711 Jim_SetResultString(interp, "Syntax error in expression", -1);
6712 goto err;
6714 token = JimParserGetToken(&parser, &len, &type, NULL);
6715 if (type == JIM_TT_EOL) {
6716 Jim_Free(token);
6717 break;
6719 switch (type) {
6720 case JIM_TT_STR:
6721 ExprObjAddInstr(interp, expr, JIM_EXPROP_STRING, token, len);
6722 break;
6723 case JIM_TT_ESC:
6724 ExprObjAddInstr(interp, expr, JIM_EXPROP_SUBST, token, len);
6725 break;
6726 case JIM_TT_VAR:
6727 ExprObjAddInstr(interp, expr, JIM_EXPROP_VARIABLE, token, len);
6728 break;
6729 case JIM_TT_DICTSUGAR:
6730 ExprObjAddInstr(interp, expr, JIM_EXPROP_DICTSUGAR, token, len);
6731 break;
6732 case JIM_TT_CMD:
6733 ExprObjAddInstr(interp, expr, JIM_EXPROP_COMMAND, token, len);
6734 break;
6735 case JIM_TT_EXPR_NUMBER:
6736 ExprObjAddInstr(interp, expr, JIM_EXPROP_NUMBER, token, len);
6737 break;
6738 case JIM_TT_EXPR_OPERATOR:
6739 op = JimExprOperatorInfo(token);
6740 while (1) {
6741 Jim_ExprOperator *stackTopOp;
6743 if (Jim_StackPeek(&stack) != NULL) {
6744 stackTopOp = JimExprOperatorInfo(Jim_StackPeek(&stack));
6745 } else {
6746 stackTopOp = NULL;
6748 if (Jim_StackLen(&stack) && op->arity != 1 &&
6749 stackTopOp && stackTopOp->precedence >= op->precedence)
6751 ExprObjAddInstr(interp, expr, stackTopOp->opcode,
6752 Jim_StackPeek(&stack), -1);
6753 Jim_StackPop(&stack);
6754 } else {
6755 break;
6758 Jim_StackPush(&stack, token);
6759 break;
6760 case JIM_TT_SUBEXPR_START:
6761 Jim_StackPush(&stack, Jim_StrDup("("));
6762 Jim_Free(token);
6763 break;
6764 case JIM_TT_SUBEXPR_END:
6766 int found = 0;
6767 while (Jim_StackLen(&stack)) {
6768 char *opstr = Jim_StackPop(&stack);
6769 if (!strcmp(opstr, "(")) {
6770 Jim_Free(opstr);
6771 found = 1;
6772 break;
6774 op = JimExprOperatorInfo(opstr);
6775 ExprObjAddInstr(interp, expr, op->opcode, opstr, -1);
6777 if (!found) {
6778 Jim_SetResultString(interp,
6779 "Unexpected close parenthesis", -1);
6780 goto err;
6783 Jim_Free(token);
6784 break;
6785 default:
6786 Jim_Panic(interp,"Default reached in SetExprFromAny()");
6787 break;
6790 while (Jim_StackLen(&stack)) {
6791 char *opstr = Jim_StackPop(&stack);
6792 op = JimExprOperatorInfo(opstr);
6793 if (op == NULL && !strcmp(opstr, "(")) {
6794 Jim_Free(opstr);
6795 Jim_SetResultString(interp, "Missing close parenthesis", -1);
6796 goto err;
6798 ExprObjAddInstr(interp, expr, op->opcode, opstr, -1);
6800 /* Check program correctness. */
6801 if (ExprCheckCorrectness(expr) != JIM_OK) {
6802 Jim_SetResultString(interp, "Invalid expression", -1);
6803 goto err;
6806 /* Free the stack used for the compilation. */
6807 Jim_FreeStackElements(&stack, Jim_Free);
6808 Jim_FreeStack(&stack);
6810 /* Convert || and && operators in unary |L |R and &L &R for lazyness */
6811 ExprMakeLazy(interp, expr);
6813 /* Perform literal sharing */
6814 if (shareLiterals && interp->framePtr->procBodyObjPtr) {
6815 Jim_Obj *bodyObjPtr = interp->framePtr->procBodyObjPtr;
6816 if (bodyObjPtr->typePtr == &scriptObjType) {
6817 ScriptObj *bodyScript = bodyObjPtr->internalRep.ptr;
6818 ExprShareLiterals(interp, expr, bodyScript);
6822 /* Free the old internal rep and set the new one. */
6823 Jim_FreeIntRep(interp, objPtr);
6824 Jim_SetIntRepPtr(objPtr, expr);
6825 objPtr->typePtr = &exprObjType;
6826 return JIM_OK;
6828 err: /* we jump here on syntax/compile errors. */
6829 Jim_FreeStackElements(&stack, Jim_Free);
6830 Jim_FreeStack(&stack);
6831 Jim_Free(expr->opcode);
6832 for (i = 0; i < expr->len; i++) {
6833 Jim_DecrRefCount(interp,expr->obj[i]);
6835 Jim_Free(expr->obj);
6836 Jim_Free(expr);
6837 return JIM_ERR;
6840 ExprByteCode *Jim_GetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
6842 if (objPtr->typePtr != &exprObjType) {
6843 if (SetExprFromAny(interp, objPtr) != JIM_OK)
6844 return NULL;
6846 return (ExprByteCode*) Jim_GetIntRepPtr(objPtr);
6849 /* -----------------------------------------------------------------------------
6850 * Expressions evaluation.
6851 * Jim uses a specialized stack-based virtual machine for expressions,
6852 * that takes advantage of the fact that expr's operators
6853 * can't be redefined.
6855 * Jim_EvalExpression() uses the bytecode compiled by
6856 * SetExprFromAny() method of the "expression" object.
6858 * On success a Tcl Object containing the result of the evaluation
6859 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
6860 * returned.
6861 * On error the function returns a retcode != to JIM_OK and set a suitable
6862 * error on the interp.
6863 * ---------------------------------------------------------------------------*/
6864 #define JIM_EE_STATICSTACK_LEN 10
6866 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr,
6867 Jim_Obj **exprResultPtrPtr)
6869 ExprByteCode *expr;
6870 Jim_Obj **stack, *staticStack[JIM_EE_STATICSTACK_LEN];
6871 int stacklen = 0, i, error = 0, errRetCode = JIM_ERR;
6873 Jim_IncrRefCount(exprObjPtr);
6874 expr = Jim_GetExpression(interp, exprObjPtr);
6875 if (!expr) {
6876 Jim_DecrRefCount(interp, exprObjPtr);
6877 return JIM_ERR; /* error in expression. */
6879 /* In order to avoid that the internal repr gets freed due to
6880 * shimmering of the exprObjPtr's object, we make the internal rep
6881 * shared. */
6882 expr->inUse++;
6884 /* The stack-based expr VM itself */
6886 /* Stack allocation. Expr programs have the feature that
6887 * a program of length N can't require a stack longer than
6888 * N. */
6889 if (expr->len > JIM_EE_STATICSTACK_LEN)
6890 stack = Jim_Alloc(sizeof(Jim_Obj*)*expr->len);
6891 else
6892 stack = staticStack;
6894 /* Execute every istruction */
6895 for (i = 0; i < expr->len; i++) {
6896 Jim_Obj *A, *B, *objPtr;
6897 jim_wide wA, wB, wC;
6898 double dA, dB, dC;
6899 const char *sA, *sB;
6900 int Alen, Blen, retcode;
6901 int opcode = expr->opcode[i];
6903 if (opcode == JIM_EXPROP_NUMBER || opcode == JIM_EXPROP_STRING) {
6904 stack[stacklen++] = expr->obj[i];
6905 Jim_IncrRefCount(expr->obj[i]);
6906 } else if (opcode == JIM_EXPROP_VARIABLE) {
6907 objPtr = Jim_GetVariable(interp, expr->obj[i], JIM_ERRMSG);
6908 if (objPtr == NULL) {
6909 error = 1;
6910 goto err;
6912 stack[stacklen++] = objPtr;
6913 Jim_IncrRefCount(objPtr);
6914 } else if (opcode == JIM_EXPROP_SUBST) {
6915 if ((retcode = Jim_SubstObj(interp, expr->obj[i],
6916 &objPtr, JIM_NONE)) != JIM_OK)
6918 error = 1;
6919 errRetCode = retcode;
6920 goto err;
6922 stack[stacklen++] = objPtr;
6923 Jim_IncrRefCount(objPtr);
6924 } else if (opcode == JIM_EXPROP_DICTSUGAR) {
6925 objPtr = Jim_ExpandDictSugar(interp, expr->obj[i]);
6926 if (objPtr == NULL) {
6927 error = 1;
6928 goto err;
6930 stack[stacklen++] = objPtr;
6931 Jim_IncrRefCount(objPtr);
6932 } else if (opcode == JIM_EXPROP_COMMAND) {
6933 if ((retcode = Jim_EvalObj(interp, expr->obj[i])) != JIM_OK) {
6934 error = 1;
6935 errRetCode = retcode;
6936 goto err;
6938 stack[stacklen++] = interp->result;
6939 Jim_IncrRefCount(interp->result);
6940 } else if (opcode >= JIM_EXPROP_BINARY_NUM_FIRST &&
6941 opcode <= JIM_EXPROP_BINARY_NUM_LAST)
6943 /* Note that there isn't to increment the
6944 * refcount of objects. the references are moved
6945 * from stack to A and B. */
6946 B = stack[--stacklen];
6947 A = stack[--stacklen];
6949 /* --- Integer --- */
6950 if ((A->typePtr == &doubleObjType && !A->bytes) ||
6951 (B->typePtr == &doubleObjType && !B->bytes) ||
6952 JimGetWideNoErr(interp, A, &wA) != JIM_OK ||
6953 JimGetWideNoErr(interp, B, &wB) != JIM_OK) {
6954 goto trydouble;
6956 Jim_DecrRefCount(interp, A);
6957 Jim_DecrRefCount(interp, B);
6958 switch (expr->opcode[i]) {
6959 case JIM_EXPROP_ADD: wC = wA + wB; break;
6960 case JIM_EXPROP_SUB: wC = wA-wB; break;
6961 case JIM_EXPROP_MUL: wC = wA*wB; break;
6962 case JIM_EXPROP_LT: wC = wA < wB; break;
6963 case JIM_EXPROP_GT: wC = wA > wB; break;
6964 case JIM_EXPROP_LTE: wC = wA <= wB; break;
6965 case JIM_EXPROP_GTE: wC = wA >= wB; break;
6966 case JIM_EXPROP_LSHIFT: wC = wA << wB; break;
6967 case JIM_EXPROP_RSHIFT: wC = wA >> wB; break;
6968 case JIM_EXPROP_NUMEQ: wC = wA == wB; break;
6969 case JIM_EXPROP_NUMNE: wC = wA != wB; break;
6970 case JIM_EXPROP_BITAND: wC = wA&wB; break;
6971 case JIM_EXPROP_BITXOR: wC = wA^wB; break;
6972 case JIM_EXPROP_BITOR: wC = wA | wB; break;
6973 case JIM_EXPROP_POW: wC = JimPowWide(wA,wB); break;
6974 case JIM_EXPROP_LOGICAND_LEFT:
6975 if (wA == 0) {
6976 i += (int)wB;
6977 wC = 0;
6978 } else {
6979 continue;
6981 break;
6982 case JIM_EXPROP_LOGICOR_LEFT:
6983 if (wA != 0) {
6984 i += (int)wB;
6985 wC = 1;
6986 } else {
6987 continue;
6989 break;
6990 case JIM_EXPROP_DIV:
6991 if (wB == 0) goto divbyzero;
6992 wC = wA/wB;
6993 break;
6994 case JIM_EXPROP_MOD:
6995 if (wB == 0) goto divbyzero;
6996 wC = wA%wB;
6997 break;
6998 case JIM_EXPROP_ROTL: {
6999 /* uint32_t would be better. But not everyone has inttypes.h?*/
7000 unsigned long uA = (unsigned long)wA;
7001 #ifdef _MSC_VER
7002 wC = _rotl(uA,(unsigned long)wB);
7003 #else
7004 const unsigned int S = sizeof(unsigned long) * 8;
7005 wC = (unsigned long)((uA << wB) | (uA >> (S-wB)));
7006 #endif
7007 break;
7009 case JIM_EXPROP_ROTR: {
7010 unsigned long uA = (unsigned long)wA;
7011 #ifdef _MSC_VER
7012 wC = _rotr(uA,(unsigned long)wB);
7013 #else
7014 const unsigned int S = sizeof(unsigned long) * 8;
7015 wC = (unsigned long)((uA >> wB) | (uA << (S-wB)));
7016 #endif
7017 break;
7020 default:
7021 wC = 0; /* avoid gcc warning */
7022 break;
7024 stack[stacklen] = Jim_NewIntObj(interp, wC);
7025 Jim_IncrRefCount(stack[stacklen]);
7026 stacklen++;
7027 continue;
7028 trydouble:
7029 /* --- Double --- */
7030 if (Jim_GetDouble(interp, A, &dA) != JIM_OK ||
7031 Jim_GetDouble(interp, B, &dB) != JIM_OK) {
7033 /* Hmmm! For compatibility, maybe convert != and == into ne and eq */
7034 if (expr->opcode[i] == JIM_EXPROP_NUMNE) {
7035 opcode = JIM_EXPROP_STRNE;
7036 goto retry_as_string;
7038 else if (expr->opcode[i] == JIM_EXPROP_NUMEQ) {
7039 opcode = JIM_EXPROP_STREQ;
7040 goto retry_as_string;
7042 Jim_DecrRefCount(interp, A);
7043 Jim_DecrRefCount(interp, B);
7044 error = 1;
7045 goto err;
7047 Jim_DecrRefCount(interp, A);
7048 Jim_DecrRefCount(interp, B);
7049 switch (expr->opcode[i]) {
7050 case JIM_EXPROP_ROTL:
7051 case JIM_EXPROP_ROTR:
7052 case JIM_EXPROP_LSHIFT:
7053 case JIM_EXPROP_RSHIFT:
7054 case JIM_EXPROP_BITAND:
7055 case JIM_EXPROP_BITXOR:
7056 case JIM_EXPROP_BITOR:
7057 case JIM_EXPROP_MOD:
7058 case JIM_EXPROP_POW:
7059 Jim_SetResultString(interp,
7060 "Got floating-point value where integer was expected", -1);
7061 error = 1;
7062 goto err;
7063 break;
7064 case JIM_EXPROP_ADD: dC = dA + dB; break;
7065 case JIM_EXPROP_SUB: dC = dA-dB; break;
7066 case JIM_EXPROP_MUL: dC = dA*dB; break;
7067 case JIM_EXPROP_LT: dC = dA < dB; break;
7068 case JIM_EXPROP_GT: dC = dA > dB; break;
7069 case JIM_EXPROP_LTE: dC = dA <= dB; break;
7070 case JIM_EXPROP_GTE: dC = dA >= dB; break;
7071 case JIM_EXPROP_NUMEQ: dC = dA == dB; break;
7072 case JIM_EXPROP_NUMNE: dC = dA != dB; break;
7073 case JIM_EXPROP_LOGICAND_LEFT:
7074 if (dA == 0) {
7075 i += (int)dB;
7076 dC = 0;
7077 } else {
7078 continue;
7080 break;
7081 case JIM_EXPROP_LOGICOR_LEFT:
7082 if (dA != 0) {
7083 i += (int)dB;
7084 dC = 1;
7085 } else {
7086 continue;
7088 break;
7089 case JIM_EXPROP_DIV:
7090 if (dB == 0) goto divbyzero;
7091 dC = dA/dB;
7092 break;
7093 default:
7094 dC = 0; /* avoid gcc warning */
7095 break;
7097 stack[stacklen] = Jim_NewDoubleObj(interp, dC);
7098 Jim_IncrRefCount(stack[stacklen]);
7099 stacklen++;
7100 } else if (opcode == JIM_EXPROP_STREQ || opcode == JIM_EXPROP_STRNE) {
7101 B = stack[--stacklen];
7102 A = stack[--stacklen];
7103 retry_as_string:
7104 sA = Jim_GetString(A, &Alen);
7105 sB = Jim_GetString(B, &Blen);
7106 switch (opcode) {
7107 case JIM_EXPROP_STREQ:
7108 if (Alen == Blen && memcmp(sA, sB, Alen) ==0)
7109 wC = 1;
7110 else
7111 wC = 0;
7112 break;
7113 case JIM_EXPROP_STRNE:
7114 if (Alen != Blen || memcmp(sA, sB, Alen) != 0)
7115 wC = 1;
7116 else
7117 wC = 0;
7118 break;
7119 default:
7120 wC = 0; /* avoid gcc warning */
7121 break;
7123 Jim_DecrRefCount(interp, A);
7124 Jim_DecrRefCount(interp, B);
7125 stack[stacklen] = Jim_NewIntObj(interp, wC);
7126 Jim_IncrRefCount(stack[stacklen]);
7127 stacklen++;
7128 } else if (opcode == JIM_EXPROP_NOT ||
7129 opcode == JIM_EXPROP_BITNOT ||
7130 opcode == JIM_EXPROP_LOGICAND_RIGHT ||
7131 opcode == JIM_EXPROP_LOGICOR_RIGHT) {
7132 /* Note that there isn't to increment the
7133 * refcount of objects. the references are moved
7134 * from stack to A and B. */
7135 A = stack[--stacklen];
7137 /* --- Integer --- */
7138 if ((A->typePtr == &doubleObjType && !A->bytes) ||
7139 JimGetWideNoErr(interp, A, &wA) != JIM_OK) {
7140 goto trydouble_unary;
7142 Jim_DecrRefCount(interp, A);
7143 switch (expr->opcode[i]) {
7144 case JIM_EXPROP_NOT: wC = !wA; break;
7145 case JIM_EXPROP_BITNOT: wC = ~wA; break;
7146 case JIM_EXPROP_LOGICAND_RIGHT:
7147 case JIM_EXPROP_LOGICOR_RIGHT: wC = (wA != 0); break;
7148 default:
7149 wC = 0; /* avoid gcc warning */
7150 break;
7152 stack[stacklen] = Jim_NewIntObj(interp, wC);
7153 Jim_IncrRefCount(stack[stacklen]);
7154 stacklen++;
7155 continue;
7156 trydouble_unary:
7157 /* --- Double --- */
7158 if (Jim_GetDouble(interp, A, &dA) != JIM_OK) {
7159 Jim_DecrRefCount(interp, A);
7160 error = 1;
7161 goto err;
7163 Jim_DecrRefCount(interp, A);
7164 switch (expr->opcode[i]) {
7165 case JIM_EXPROP_NOT: dC = !dA; break;
7166 case JIM_EXPROP_LOGICAND_RIGHT:
7167 case JIM_EXPROP_LOGICOR_RIGHT: dC = (dA != 0); break;
7168 case JIM_EXPROP_BITNOT:
7169 Jim_SetResultString(interp,
7170 "Got floating-point value where integer was expected", -1);
7171 error = 1;
7172 goto err;
7173 break;
7174 default:
7175 dC = 0; /* avoid gcc warning */
7176 break;
7178 stack[stacklen] = Jim_NewDoubleObj(interp, dC);
7179 Jim_IncrRefCount(stack[stacklen]);
7180 stacklen++;
7181 } else {
7182 Jim_Panic(interp,"Unknown opcode in Jim_EvalExpression");
7185 err:
7186 /* There is no need to decerement the inUse field because
7187 * this reference is transfered back into the exprObjPtr. */
7188 Jim_FreeIntRep(interp, exprObjPtr);
7189 exprObjPtr->typePtr = &exprObjType;
7190 Jim_SetIntRepPtr(exprObjPtr, expr);
7191 Jim_DecrRefCount(interp, exprObjPtr);
7192 if (!error) {
7193 *exprResultPtrPtr = stack[0];
7194 Jim_IncrRefCount(stack[0]);
7195 errRetCode = JIM_OK;
7197 for (i = 0; i < stacklen; i++) {
7198 Jim_DecrRefCount(interp, stack[i]);
7200 if (stack != staticStack)
7201 Jim_Free(stack);
7202 return errRetCode;
7203 divbyzero:
7204 error = 1;
7205 Jim_SetResultString(interp, "Division by zero", -1);
7206 goto err;
7209 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
7211 int retcode;
7212 jim_wide wideValue;
7213 double doubleValue;
7214 Jim_Obj *exprResultPtr;
7216 retcode = Jim_EvalExpression(interp, exprObjPtr, &exprResultPtr);
7217 if (retcode != JIM_OK)
7218 return retcode;
7219 if (JimGetWideNoErr(interp, exprResultPtr, &wideValue) != JIM_OK) {
7220 if (Jim_GetDouble(interp, exprResultPtr, &doubleValue) != JIM_OK)
7222 Jim_DecrRefCount(interp, exprResultPtr);
7223 return JIM_ERR;
7224 } else {
7225 Jim_DecrRefCount(interp, exprResultPtr);
7226 *boolPtr = doubleValue != 0;
7227 return JIM_OK;
7230 Jim_DecrRefCount(interp, exprResultPtr);
7231 *boolPtr = wideValue != 0;
7232 return JIM_OK;
7235 /* -----------------------------------------------------------------------------
7236 * ScanFormat String Object
7237 * ---------------------------------------------------------------------------*/
7239 /* This Jim_Obj will held a parsed representation of a format string passed to
7240 * the Jim_ScanString command. For error diagnostics, the scanformat string has
7241 * to be parsed in its entirely first and then, if correct, can be used for
7242 * scanning. To avoid endless re-parsing, the parsed representation will be
7243 * stored in an internal representation and re-used for performance reason. */
7245 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
7246 * scanformat string. This part will later be used to extract information
7247 * out from the string to be parsed by Jim_ScanString */
7249 typedef struct ScanFmtPartDescr {
7250 char type; /* Type of conversion (e.g. c, d, f) */
7251 char modifier; /* Modify type (e.g. l - long, h - short */
7252 size_t width; /* Maximal width of input to be converted */
7253 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
7254 char *arg; /* Specification of a CHARSET conversion */
7255 char *prefix; /* Prefix to be scanned literally before conversion */
7256 } ScanFmtPartDescr;
7258 /* The ScanFmtStringObj will held the internal representation of a scanformat
7259 * string parsed and separated in part descriptions. Furthermore it contains
7260 * the original string representation of the scanformat string to allow for
7261 * fast update of the Jim_Obj's string representation part.
7263 * As add-on the internal object representation add some scratch pad area
7264 * for usage by Jim_ScanString to avoid endless allocating and freeing of
7265 * memory for purpose of string scanning.
7267 * The error member points to a static allocated string in case of a mal-
7268 * formed scanformat string or it contains '0' (NULL) in case of a valid
7269 * parse representation.
7271 * The whole memory of the internal representation is allocated as a single
7272 * area of memory that will be internally separated. So freeing and duplicating
7273 * of such an object is cheap */
7275 typedef struct ScanFmtStringObj {
7276 jim_wide size; /* Size of internal repr in bytes */
7277 char *stringRep; /* Original string representation */
7278 size_t count; /* Number of ScanFmtPartDescr contained */
7279 size_t convCount; /* Number of conversions that will assign */
7280 size_t maxPos; /* Max position index if XPG3 is used */
7281 const char *error; /* Ptr to error text (NULL if no error */
7282 char *scratch; /* Some scratch pad used by Jim_ScanString */
7283 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
7284 } ScanFmtStringObj;
7287 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
7288 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
7289 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
7291 static Jim_ObjType scanFmtStringObjType = {
7292 "scanformatstring",
7293 FreeScanFmtInternalRep,
7294 DupScanFmtInternalRep,
7295 UpdateStringOfScanFmt,
7296 JIM_TYPE_NONE,
7299 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
7301 JIM_NOTUSED(interp);
7302 Jim_Free((char*)objPtr->internalRep.ptr);
7303 objPtr->internalRep.ptr = 0;
7306 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
7308 size_t size = (size_t)((ScanFmtStringObj*)srcPtr->internalRep.ptr)->size;
7309 ScanFmtStringObj *newVec = (ScanFmtStringObj*)Jim_Alloc(size);
7311 JIM_NOTUSED(interp);
7312 memcpy(newVec, srcPtr->internalRep.ptr, size);
7313 dupPtr->internalRep.ptr = newVec;
7314 dupPtr->typePtr = &scanFmtStringObjType;
7317 void UpdateStringOfScanFmt(Jim_Obj *objPtr)
7319 char *bytes = ((ScanFmtStringObj*)objPtr->internalRep.ptr)->stringRep;
7321 objPtr->bytes = Jim_StrDup(bytes);
7322 objPtr->length = strlen(bytes);
7325 /* SetScanFmtFromAny will parse a given string and create the internal
7326 * representation of the format specification. In case of an error
7327 * the error data member of the internal representation will be set
7328 * to an descriptive error text and the function will be left with
7329 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
7330 * specification */
7332 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7334 ScanFmtStringObj *fmtObj;
7335 char *buffer;
7336 int maxCount, i, approxSize, lastPos = -1;
7337 const char *fmt = objPtr->bytes;
7338 int maxFmtLen = objPtr->length;
7339 const char *fmtEnd = fmt + maxFmtLen;
7340 int curr;
7342 Jim_FreeIntRep(interp, objPtr);
7343 /* Count how many conversions could take place maximally */
7344 for (i = 0, maxCount = 0; i < maxFmtLen; ++i)
7345 if (fmt[i] == '%')
7346 ++maxCount;
7347 /* Calculate an approximation of the memory necessary */
7348 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
7349 + (maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
7350 + maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
7351 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
7352 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
7353 + (maxCount +1) * sizeof(char) /* '\0' for every partial */
7354 + 1; /* safety byte */
7355 fmtObj = (ScanFmtStringObj*)Jim_Alloc(approxSize);
7356 memset(fmtObj, 0, approxSize);
7357 fmtObj->size = approxSize;
7358 fmtObj->maxPos = 0;
7359 fmtObj->scratch = (char*)&fmtObj->descr[maxCount + 1];
7360 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
7361 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
7362 buffer = fmtObj->stringRep + maxFmtLen + 1;
7363 objPtr->internalRep.ptr = fmtObj;
7364 objPtr->typePtr = &scanFmtStringObjType;
7365 for (i = 0, curr = 0; fmt < fmtEnd; ++fmt) {
7366 int width = 0, skip;
7367 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
7368 fmtObj->count++;
7369 descr->width = 0; /* Assume width unspecified */
7370 /* Overread and store any "literal" prefix */
7371 if (*fmt != '%' || fmt[1] == '%') {
7372 descr->type = 0;
7373 descr->prefix = &buffer[i];
7374 for (; fmt < fmtEnd; ++fmt) {
7375 if (*fmt == '%') {
7376 if (fmt[1] != '%') break;
7377 ++fmt;
7379 buffer[i++] = *fmt;
7381 buffer[i++] = 0;
7383 /* Skip the conversion introducing '%' sign */
7384 ++fmt;
7385 /* End reached due to non-conversion literal only? */
7386 if (fmt >= fmtEnd)
7387 goto done;
7388 descr->pos = 0; /* Assume "natural" positioning */
7389 if (*fmt == '*') {
7390 descr->pos = -1; /* Okay, conversion will not be assigned */
7391 ++fmt;
7392 } else
7393 fmtObj->convCount++; /* Otherwise count as assign-conversion */
7394 /* Check if next token is a number (could be width or pos */
7395 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
7396 fmt += skip;
7397 /* Was the number a XPG3 position specifier? */
7398 if (descr->pos != -1 && *fmt == '$') {
7399 int prev;
7400 ++fmt;
7401 descr->pos = width;
7402 width = 0;
7403 /* Look if "natural" postioning and XPG3 one was mixed */
7404 if ((lastPos == 0 && descr->pos > 0)
7405 || (lastPos > 0 && descr->pos == 0)) {
7406 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
7407 return JIM_ERR;
7409 /* Look if this position was already used */
7410 for (prev = 0; prev < curr; ++prev) {
7411 if (fmtObj->descr[prev].pos == -1) continue;
7412 if (fmtObj->descr[prev].pos == descr->pos) {
7413 fmtObj->error = "same \"%n$\" conversion specifier "
7414 "used more than once";
7415 return JIM_ERR;
7418 /* Try to find a width after the XPG3 specifier */
7419 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
7420 descr->width = width;
7421 fmt += skip;
7423 if (descr->pos > 0 && (size_t)descr->pos > fmtObj->maxPos)
7424 fmtObj->maxPos = descr->pos;
7425 } else {
7426 /* Number was not a XPG3, so it has to be a width */
7427 descr->width = width;
7430 /* If positioning mode was undetermined yet, fix this */
7431 if (lastPos == -1)
7432 lastPos = descr->pos;
7433 /* Handle CHARSET conversion type ... */
7434 if (*fmt == '[') {
7435 int swapped = 1, beg = i, end, j;
7436 descr->type = '[';
7437 descr->arg = &buffer[i];
7438 ++fmt;
7439 if (*fmt == '^') buffer[i++] = *fmt++;
7440 if (*fmt == ']') buffer[i++] = *fmt++;
7441 while (*fmt && *fmt != ']') buffer[i++] = *fmt++;
7442 if (*fmt != ']') {
7443 fmtObj->error = "unmatched [ in format string";
7444 return JIM_ERR;
7446 end = i;
7447 buffer[i++] = 0;
7448 /* In case a range fence was given "backwards", swap it */
7449 while (swapped) {
7450 swapped = 0;
7451 for (j = beg + 1; j < end-1; ++j) {
7452 if (buffer[j] == '-' && buffer[j-1] > buffer[j + 1]) {
7453 char tmp = buffer[j-1];
7454 buffer[j-1] = buffer[j + 1];
7455 buffer[j + 1] = tmp;
7456 swapped = 1;
7460 } else {
7461 /* Remember any valid modifier if given */
7462 if (strchr("hlL", *fmt) != 0)
7463 descr->modifier = tolower((int)*fmt++);
7465 descr->type = *fmt;
7466 if (strchr("efgcsndoxui", *fmt) == 0) {
7467 fmtObj->error = "bad scan conversion character";
7468 return JIM_ERR;
7469 } else if (*fmt == 'c' && descr->width != 0) {
7470 fmtObj->error = "field width may not be specified in %c "
7471 "conversion";
7472 return JIM_ERR;
7473 } else if (*fmt == 'u' && descr->modifier == 'l') {
7474 fmtObj->error = "unsigned wide not supported";
7475 return JIM_ERR;
7478 curr++;
7480 done:
7481 if (fmtObj->convCount == 0) {
7482 fmtObj->error = "no any conversion specifier given";
7483 return JIM_ERR;
7485 return JIM_OK;
7488 /* Some accessor macros to allow lowlevel access to fields of internal repr */
7490 #define FormatGetCnvCount(_fo_) \
7491 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
7492 #define FormatGetMaxPos(_fo_) \
7493 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
7494 #define FormatGetError(_fo_) \
7495 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
7497 /* Some Bit testing/setting/cleaning routines. For now only used in handling
7498 * charsets ([a-z123]) within scanning. Later on perhaps a base for a
7499 * bitvector implementation in Jim? */
7501 static int JimTestBit(const char *bitvec, char ch)
7503 div_t pos = div(ch-1, 8);
7504 return bitvec[pos.quot] & (1 << pos.rem);
7507 static void JimSetBit(char *bitvec, char ch)
7509 div_t pos = div(ch-1, 8);
7510 bitvec[pos.quot] |= (1 << pos.rem);
7513 #if 0 /* currently not used */
7514 static void JimClearBit(char *bitvec, char ch)
7516 div_t pos = div(ch-1, 8);
7517 bitvec[pos.quot] &= ~(1 << pos.rem);
7519 #endif
7521 /* JimScanAString is used to scan an unspecified string that ends with
7522 * next WS, or a string that is specified via a charset. The charset
7523 * is currently implemented in a way to only allow for usage with
7524 * ASCII. Whenever we will switch to UNICODE, another idea has to
7525 * be born :-/
7527 * FIXME: Works only with ASCII */
7529 static Jim_Obj *
7530 JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
7532 size_t i;
7533 Jim_Obj *result;
7534 char charset[256/8 + 1]; /* A Charset may contain max 256 chars */
7535 char *buffer = Jim_Alloc(strlen(str) + 1), *anchor = buffer;
7537 /* First init charset to nothing or all, depending if a specified
7538 * or an unspecified string has to be parsed */
7539 memset(charset, (sdescr ? 0 : 255), sizeof(charset));
7540 if (sdescr) {
7541 /* There was a set description given, that means we are parsing
7542 * a specified string. So we have to build a corresponding
7543 * charset reflecting the description */
7544 int notFlag = 0;
7545 /* Should the set be negated at the end? */
7546 if (*sdescr == '^') {
7547 notFlag = 1;
7548 ++sdescr;
7550 /* Here '-' is meant literally and not to define a range */
7551 if (*sdescr == '-') {
7552 JimSetBit(charset, '-');
7553 ++sdescr;
7555 while (*sdescr) {
7556 if (sdescr[1] == '-' && sdescr[2] != 0) {
7557 /* Handle range definitions */
7558 int i;
7559 for (i = sdescr[0]; i <= sdescr[2]; ++i)
7560 JimSetBit(charset, (char)i);
7561 sdescr += 3;
7562 } else {
7563 /* Handle verbatim character definitions */
7564 JimSetBit(charset, *sdescr++);
7567 /* Negate the charset if there was a NOT given */
7568 for (i = 0; notFlag && i < sizeof(charset); ++i)
7569 charset[i] = ~charset[i];
7571 /* And after all the mess above, the real work begin ... */
7572 while (str && *str) {
7573 if (!sdescr && isspace((int)*str))
7574 break; /* EOS via WS if unspecified */
7575 if (JimTestBit(charset, *str)) *buffer++ = *str++;
7576 else break; /* EOS via mismatch if specified scanning */
7578 *buffer = 0; /* Close the string properly ... */
7579 result = Jim_NewStringObj(interp, anchor, -1);
7580 Jim_Free(anchor); /* ... and free it afer usage */
7581 return result;
7584 /* ScanOneEntry will scan one entry out of the string passed as argument.
7585 * It use the sscanf() function for this task. After extracting and
7586 * converting of the value, the count of scanned characters will be
7587 * returned of -1 in case of no conversion tool place and string was
7588 * already scanned thru */
7590 static int ScanOneEntry(Jim_Interp *interp, const char *str, long pos,
7591 ScanFmtStringObj *fmtObj, long index, Jim_Obj **valObjPtr)
7593 # define MAX_SIZE (sizeof(jim_wide) > sizeof(double) \
7594 ? sizeof(jim_wide) \
7595 : sizeof(double))
7596 char buffer[MAX_SIZE];
7597 char *value = buffer;
7598 const char *tok;
7599 const ScanFmtPartDescr *descr = &fmtObj->descr[index];
7600 size_t sLen = strlen(&str[pos]), scanned = 0;
7601 size_t anchor = pos;
7602 int i;
7604 /* First pessimiticly assume, we will not scan anything :-) */
7605 *valObjPtr = 0;
7606 if (descr->prefix) {
7607 /* There was a prefix given before the conversion, skip it and adjust
7608 * the string-to-be-parsed accordingly */
7609 for (i = 0; str[pos] && descr->prefix[i]; ++i) {
7610 /* If prefix require, skip WS */
7611 if (isspace((int)descr->prefix[i]))
7612 while (str[pos] && isspace((int)str[pos])) ++pos;
7613 else if (descr->prefix[i] != str[pos])
7614 break; /* Prefix do not match here, leave the loop */
7615 else
7616 ++pos; /* Prefix matched so far, next round */
7618 if (str[pos] == 0)
7619 return -1; /* All of str consumed: EOF condition */
7620 else if (descr->prefix[i] != 0)
7621 return 0; /* Not whole prefix consumed, no conversion possible */
7623 /* For all but following conversion, skip leading WS */
7624 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
7625 while (isspace((int)str[pos])) ++pos;
7626 /* Determine how much skipped/scanned so far */
7627 scanned = pos - anchor;
7628 if (descr->type == 'n') {
7629 /* Return pseudo conversion means: how much scanned so far? */
7630 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
7631 } else if (str[pos] == 0) {
7632 /* Cannot scan anything, as str is totally consumed */
7633 return -1;
7634 } else {
7635 /* Processing of conversions follows ... */
7636 if (descr->width > 0) {
7637 /* Do not try to scan as fas as possible but only the given width.
7638 * To ensure this, we copy the part that should be scanned. */
7639 size_t tLen = descr->width > sLen ? sLen : descr->width;
7640 tok = Jim_StrDupLen(&str[pos], tLen);
7641 } else {
7642 /* As no width was given, simply refer to the original string */
7643 tok = &str[pos];
7645 switch (descr->type) {
7646 case 'c':
7647 *valObjPtr = Jim_NewIntObj(interp, *tok);
7648 scanned += 1;
7649 break;
7650 case 'd': case 'o': case 'x': case 'u': case 'i': {
7651 jim_wide jwvalue = 0;
7652 long lvalue = 0;
7653 char *endp; /* Position where the number finished */
7654 int base = descr->type == 'o' ? 8
7655 : descr->type == 'x' ? 16
7656 : descr->type == 'i' ? 0
7657 : 10;
7659 do {
7660 /* Try to scan a number with the given base */
7661 if (descr->modifier == 'l')
7663 #ifdef HAVE_LONG_LONG_INT
7664 jwvalue = JimStrtoll(tok, &endp, base),
7665 #else
7666 jwvalue = strtol(tok, &endp, base),
7667 #endif
7668 memcpy(value, &jwvalue, sizeof(jim_wide));
7670 else
7672 if (descr->type == 'u')
7673 lvalue = strtoul(tok, &endp, base);
7674 else
7675 lvalue = strtol(tok, &endp, base);
7676 memcpy(value, &lvalue, sizeof(lvalue));
7678 /* If scanning failed, and base was undetermined, simply
7679 * put it to 10 and try once more. This should catch the
7680 * case where %i begin to parse a number prefix (e.g.
7681 * '0x' but no further digits follows. This will be
7682 * handled as a ZERO followed by a char 'x' by Tcl */
7683 if (endp == tok && base == 0) base = 10;
7684 else break;
7685 } while (1);
7686 if (endp != tok) {
7687 /* There was some number sucessfully scanned! */
7688 if (descr->modifier == 'l')
7689 *valObjPtr = Jim_NewIntObj(interp, jwvalue);
7690 else
7691 *valObjPtr = Jim_NewIntObj(interp, lvalue);
7692 /* Adjust the number-of-chars scanned so far */
7693 scanned += endp - tok;
7694 } else {
7695 /* Nothing was scanned. We have to determine if this
7696 * happened due to e.g. prefix mismatch or input str
7697 * exhausted */
7698 scanned = *tok ? 0 : -1;
7700 break;
7702 case 's': case '[': {
7703 *valObjPtr = JimScanAString(interp, descr->arg, tok);
7704 scanned += Jim_Length(*valObjPtr);
7705 break;
7707 case 'e': case 'f': case 'g': {
7708 char *endp;
7710 double dvalue = strtod(tok, &endp);
7711 memcpy(value, &dvalue, sizeof(double));
7712 if (endp != tok) {
7713 /* There was some number sucessfully scanned! */
7714 *valObjPtr = Jim_NewDoubleObj(interp, dvalue);
7715 /* Adjust the number-of-chars scanned so far */
7716 scanned += endp - tok;
7717 } else {
7718 /* Nothing was scanned. We have to determine if this
7719 * happened due to e.g. prefix mismatch or input str
7720 * exhausted */
7721 scanned = *tok ? 0 : -1;
7723 break;
7726 /* If a substring was allocated (due to pre-defined width) do not
7727 * forget to free it */
7728 if (tok != &str[pos])
7729 Jim_Free((char*)tok);
7731 return scanned;
7734 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
7735 * string and returns all converted (and not ignored) values in a list back
7736 * to the caller. If an error occured, a NULL pointer will be returned */
7738 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr,
7739 Jim_Obj *fmtObjPtr, int flags)
7741 size_t i, pos;
7742 int scanned = 1;
7743 const char *str = Jim_GetString(strObjPtr, 0);
7744 Jim_Obj *resultList = 0;
7745 Jim_Obj **resultVec =NULL;
7746 int resultc;
7747 Jim_Obj *emptyStr = 0;
7748 ScanFmtStringObj *fmtObj;
7750 /* If format specification is not an object, convert it! */
7751 if (fmtObjPtr->typePtr != &scanFmtStringObjType)
7752 SetScanFmtFromAny(interp, fmtObjPtr);
7753 fmtObj = (ScanFmtStringObj*)fmtObjPtr->internalRep.ptr;
7754 /* Check if format specification was valid */
7755 if (fmtObj->error != 0) {
7756 if (flags & JIM_ERRMSG)
7757 Jim_SetResultString(interp, fmtObj->error, -1);
7758 return 0;
7760 /* Allocate a new "shared" empty string for all unassigned conversions */
7761 emptyStr = Jim_NewEmptyStringObj(interp);
7762 Jim_IncrRefCount(emptyStr);
7763 /* Create a list and fill it with empty strings up to max specified XPG3 */
7764 resultList = Jim_NewListObj(interp, 0, 0);
7765 if (fmtObj->maxPos > 0) {
7766 for (i = 0; i < fmtObj->maxPos; ++i)
7767 Jim_ListAppendElement(interp, resultList, emptyStr);
7768 JimListGetElements(interp, resultList, &resultc, &resultVec);
7770 /* Now handle every partial format description */
7771 for (i = 0, pos = 0; i < fmtObj->count; ++i) {
7772 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
7773 Jim_Obj *value = 0;
7774 /* Only last type may be "literal" w/o conversion - skip it! */
7775 if (descr->type == 0) continue;
7776 /* As long as any conversion could be done, we will proceed */
7777 if (scanned > 0)
7778 scanned = ScanOneEntry(interp, str, pos, fmtObj, i, &value);
7779 /* In case our first try results in EOF, we will leave */
7780 if (scanned == -1 && i == 0)
7781 goto eof;
7782 /* Advance next pos-to-be-scanned for the amount scanned already */
7783 pos += scanned;
7784 /* value == 0 means no conversion took place so take empty string */
7785 if (value == 0)
7786 value = Jim_NewEmptyStringObj(interp);
7787 /* If value is a non-assignable one, skip it */
7788 if (descr->pos == -1) {
7789 Jim_FreeNewObj(interp, value);
7790 } else if (descr->pos == 0)
7791 /* Otherwise append it to the result list if no XPG3 was given */
7792 Jim_ListAppendElement(interp, resultList, value);
7793 else if (resultVec[descr->pos-1] == emptyStr) {
7794 /* But due to given XPG3, put the value into the corr. slot */
7795 Jim_DecrRefCount(interp, resultVec[descr->pos-1]);
7796 Jim_IncrRefCount(value);
7797 resultVec[descr->pos-1] = value;
7798 } else {
7799 /* Otherwise, the slot was already used - free obj and ERROR */
7800 Jim_FreeNewObj(interp, value);
7801 goto err;
7804 Jim_DecrRefCount(interp, emptyStr);
7805 return resultList;
7806 eof:
7807 Jim_DecrRefCount(interp, emptyStr);
7808 Jim_FreeNewObj(interp, resultList);
7809 return (Jim_Obj*)EOF;
7810 err:
7811 Jim_DecrRefCount(interp, emptyStr);
7812 Jim_FreeNewObj(interp, resultList);
7813 return 0;
7816 /* -----------------------------------------------------------------------------
7817 * Pseudo Random Number Generation
7818 * ---------------------------------------------------------------------------*/
7819 static void JimPrngSeed(Jim_Interp *interp, const unsigned char *seed,
7820 int seedLen);
7822 /* Initialize the sbox with the numbers from 0 to 255 */
7823 static void JimPrngInit(Jim_Interp *interp)
7825 int i;
7826 unsigned int seed[256];
7828 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
7829 for (i = 0; i < 256; i++)
7830 seed[i] = (rand() ^ time(NULL) ^ clock());
7831 JimPrngSeed(interp, (unsigned char*) seed, sizeof(int)*256);
7834 /* Generates N bytes of random data */
7835 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
7837 Jim_PrngState *prng;
7838 unsigned char *destByte = (unsigned char*) dest;
7839 unsigned int si, sj, x;
7841 /* initialization, only needed the first time */
7842 if (interp->prngState == NULL)
7843 JimPrngInit(interp);
7844 prng = interp->prngState;
7845 /* generates 'len' bytes of pseudo-random numbers */
7846 for (x = 0; x < len; x++) {
7847 prng->i = (prng->i + 1) & 0xff;
7848 si = prng->sbox[prng->i];
7849 prng->j = (prng->j + si) & 0xff;
7850 sj = prng->sbox[prng->j];
7851 prng->sbox[prng->i] = sj;
7852 prng->sbox[prng->j] = si;
7853 *destByte++ = prng->sbox[(si + sj)&0xff];
7857 /* Re-seed the generator with user-provided bytes */
7858 static void JimPrngSeed(Jim_Interp *interp, const unsigned char *seed,
7859 int seedLen)
7861 int i;
7862 unsigned char buf[256];
7863 Jim_PrngState *prng;
7865 /* initialization, only needed the first time */
7866 if (interp->prngState == NULL)
7867 JimPrngInit(interp);
7868 prng = interp->prngState;
7870 /* Set the sbox[i] with i */
7871 for (i = 0; i < 256; i++)
7872 prng->sbox[i] = i;
7873 /* Now use the seed to perform a random permutation of the sbox */
7874 for (i = 0; i < seedLen; i++) {
7875 unsigned char t;
7877 t = prng->sbox[i&0xFF];
7878 prng->sbox[i&0xFF] = prng->sbox[seed[i]];
7879 prng->sbox[seed[i]] = t;
7881 prng->i = prng->j = 0;
7882 /* discard the first 256 bytes of stream. */
7883 JimRandomBytes(interp, buf, 256);
7886 /* -----------------------------------------------------------------------------
7887 * Dynamic libraries support (WIN32 not supported)
7888 * ---------------------------------------------------------------------------*/
7890 #ifdef JIM_DYNLIB
7891 #ifdef WIN32
7892 #define RTLD_LAZY 0
7893 void * dlopen(const char *path, int mode)
7895 JIM_NOTUSED(mode);
7897 return (void *)LoadLibraryA(path);
7899 int dlclose(void *handle)
7901 FreeLibrary((HANDLE)handle);
7902 return 0;
7904 void *dlsym(void *handle, const char *symbol)
7906 return GetProcAddress((HMODULE)handle, symbol);
7908 static char win32_dlerror_string[121];
7909 const char *dlerror(void)
7911 FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM, NULL, GetLastError(),
7912 LANG_NEUTRAL, win32_dlerror_string, 120, NULL);
7913 return win32_dlerror_string;
7915 #endif /* WIN32 */
7917 int Jim_LoadLibrary(Jim_Interp *interp, const char *pathName)
7919 Jim_Obj *libPathObjPtr;
7920 int prefixc, i;
7921 void *handle;
7922 int (*onload)(Jim_Interp *interp);
7924 libPathObjPtr = Jim_GetGlobalVariableStr(interp, "jim_libpath", JIM_NONE);
7925 if (libPathObjPtr == NULL) {
7926 prefixc = 0;
7927 libPathObjPtr = NULL;
7928 } else {
7929 Jim_IncrRefCount(libPathObjPtr);
7930 Jim_ListLength(interp, libPathObjPtr, &prefixc);
7933 for (i = -1; i < prefixc; i++) {
7934 if (i < 0) {
7935 handle = dlopen(pathName, RTLD_LAZY);
7936 } else {
7937 FILE *fp;
7938 char buf[JIM_PATH_LEN];
7939 const char *prefix;
7940 int prefixlen;
7941 Jim_Obj *prefixObjPtr;
7943 buf[0] = '\0';
7944 if (Jim_ListIndex(interp, libPathObjPtr, i,
7945 &prefixObjPtr, JIM_NONE) != JIM_OK)
7946 continue;
7947 prefix = Jim_GetString(prefixObjPtr, &prefixlen);
7948 if (prefixlen + strlen(pathName) + 1 >= JIM_PATH_LEN)
7949 continue;
7950 if (*pathName == '/') {
7951 strcpy(buf, pathName);
7953 else if (prefixlen && prefix[prefixlen-1] == '/')
7954 sprintf(buf, "%s%s", prefix, pathName);
7955 else
7956 sprintf(buf, "%s/%s", prefix, pathName);
7957 fp = fopen(buf, "r");
7958 if (fp == NULL)
7959 continue;
7960 fclose(fp);
7961 handle = dlopen(buf, RTLD_LAZY);
7963 if (handle == NULL) {
7964 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
7965 Jim_AppendStrings(interp, Jim_GetResult(interp),
7966 "error loading extension \"", pathName,
7967 "\": ", dlerror(), NULL);
7968 if (i < 0)
7969 continue;
7970 goto err;
7972 if ((onload = dlsym(handle, "Jim_OnLoad")) == NULL) {
7973 Jim_SetResultString(interp,
7974 "No Jim_OnLoad symbol found on extension", -1);
7975 goto err;
7977 if (onload(interp) == JIM_ERR) {
7978 dlclose(handle);
7979 goto err;
7981 Jim_SetEmptyResult(interp);
7982 if (libPathObjPtr != NULL)
7983 Jim_DecrRefCount(interp, libPathObjPtr);
7984 return JIM_OK;
7986 err:
7987 if (libPathObjPtr != NULL)
7988 Jim_DecrRefCount(interp, libPathObjPtr);
7989 return JIM_ERR;
7991 #else /* JIM_DYNLIB */
7992 int Jim_LoadLibrary(Jim_Interp *interp, const char *pathName)
7994 JIM_NOTUSED(interp);
7995 JIM_NOTUSED(pathName);
7997 Jim_SetResultString(interp, "the Jim binary has no support for [load]", -1);
7998 return JIM_ERR;
8000 #endif/* JIM_DYNLIB */
8002 /* -----------------------------------------------------------------------------
8003 * Packages handling
8004 * ---------------------------------------------------------------------------*/
8006 #define JIM_PKG_ANY_VERSION -1
8008 /* Convert a string of the type "1.2" into an integer.
8009 * MAJOR.MINOR is converted as MAJOR*100 + MINOR, so "1.2" is converted
8010 * to the integer with value 102 */
8011 static int JimPackageVersionToInt(Jim_Interp *interp, const char *v,
8012 int *intPtr, int flags)
8014 char *copy;
8015 jim_wide major, minor;
8016 char *majorStr, *minorStr, *p;
8018 if (v[0] == '\0') {
8019 *intPtr = JIM_PKG_ANY_VERSION;
8020 return JIM_OK;
8023 copy = Jim_StrDup(v);
8024 p = strchr(copy, '.');
8025 if (p == NULL) goto badfmt;
8026 *p = '\0';
8027 majorStr = copy;
8028 minorStr = p + 1;
8030 if (Jim_StringToWide(majorStr, &major, 10) != JIM_OK ||
8031 Jim_StringToWide(minorStr, &minor, 10) != JIM_OK)
8032 goto badfmt;
8033 *intPtr = (int)(major*100 + minor);
8034 Jim_Free(copy);
8035 return JIM_OK;
8037 badfmt:
8038 Jim_Free(copy);
8039 if (flags & JIM_ERRMSG) {
8040 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8041 Jim_AppendStrings(interp, Jim_GetResult(interp),
8042 "invalid package version '", v, "'", NULL);
8044 return JIM_ERR;
8047 #define JIM_MATCHVER_EXACT (1 << JIM_PRIV_FLAG_SHIFT)
8048 static int JimPackageMatchVersion(int needed, int actual, int flags)
8050 if (needed == JIM_PKG_ANY_VERSION) return 1;
8051 if (flags & JIM_MATCHVER_EXACT) {
8052 return needed == actual;
8053 } else {
8054 return needed/100 == actual/100 && (needed <= actual);
8058 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver,
8059 int flags)
8061 int intVersion;
8062 /* Check if the version format is ok */
8063 if (JimPackageVersionToInt(interp, ver, &intVersion, JIM_ERRMSG) != JIM_OK)
8064 return JIM_ERR;
8065 /* If the package was already provided returns an error. */
8066 if (Jim_FindHashEntry(&interp->packages, name) != NULL) {
8067 if (flags & JIM_ERRMSG) {
8068 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8069 Jim_AppendStrings(interp, Jim_GetResult(interp),
8070 "package '", name, "' was already provided", NULL);
8072 return JIM_ERR;
8074 Jim_AddHashEntry(&interp->packages, name, (char*) ver);
8075 return JIM_OK;
8078 #ifndef JIM_ANSIC
8080 #ifndef WIN32
8081 # include <sys/types.h>
8082 # include <dirent.h>
8083 #else
8084 # include <io.h>
8085 /* Posix dirent.h compatiblity layer for WIN32.
8086 * Copyright Kevlin Henney, 1997, 2003. All rights reserved.
8087 * Copyright Salvatore Sanfilippo ,2005.
8089 * Permission to use, copy, modify, and distribute this software and its
8090 * documentation for any purpose is hereby granted without fee, provided
8091 * that this copyright and permissions notice appear in all copies and
8092 * derivatives.
8094 * This software is supplied "as is" without express or implied warranty.
8095 * This software was modified by Salvatore Sanfilippo for the Jim Interpreter.
8098 struct dirent {
8099 char *d_name;
8102 typedef struct DIR {
8103 long handle; /* -1 for failed rewind */
8104 struct _finddata_t info;
8105 struct dirent result; /* d_name null iff first time */
8106 char *name; /* null-terminated char string */
8107 } DIR;
8109 DIR *opendir(const char *name)
8111 DIR *dir = 0;
8113 if (name && name[0]) {
8114 size_t base_length = strlen(name);
8115 const char *all = /* search pattern must end with suitable wildcard */
8116 strchr("/\\", name[base_length - 1]) ? "*" : "/*";
8118 if ((dir = (DIR *) Jim_Alloc(sizeof *dir)) != 0 &&
8119 (dir->name = (char *) Jim_Alloc(base_length + strlen(all) + 1)) != 0)
8121 strcat(strcpy(dir->name, name), all);
8123 if ((dir->handle = (long) _findfirst(dir->name, &dir->info)) != -1)
8124 dir->result.d_name = 0;
8125 else { /* rollback */
8126 Jim_Free(dir->name);
8127 Jim_Free(dir);
8128 dir = 0;
8130 } else { /* rollback */
8131 Jim_Free(dir);
8132 dir = 0;
8133 errno = ENOMEM;
8135 } else {
8136 errno = EINVAL;
8138 return dir;
8141 int closedir(DIR *dir)
8143 int result = -1;
8145 if (dir) {
8146 if (dir->handle != -1)
8147 result = _findclose(dir->handle);
8148 Jim_Free(dir->name);
8149 Jim_Free(dir);
8151 if (result == -1) /* map all errors to EBADF */
8152 errno = EBADF;
8153 return result;
8156 struct dirent *readdir(DIR *dir)
8158 struct dirent *result = 0;
8160 if (dir && dir->handle != -1) {
8161 if (!dir->result.d_name || _findnext(dir->handle, &dir->info) != -1) {
8162 result = &dir->result;
8163 result->d_name = dir->info.name;
8165 } else {
8166 errno = EBADF;
8168 return result;
8171 #endif /* WIN32 */
8173 static char *JimFindBestPackage(Jim_Interp *interp, char **prefixes,
8174 int prefixc, const char *pkgName, int pkgVer, int flags)
8176 int bestVer = -1, i;
8177 int pkgNameLen = strlen(pkgName);
8178 char *bestPackage = NULL;
8179 struct dirent *de;
8181 for (i = 0; i < prefixc; i++) {
8182 DIR *dir;
8183 char buf[JIM_PATH_LEN];
8184 int prefixLen;
8186 if (prefixes[i] == NULL) continue;
8187 strncpy(buf, prefixes[i], JIM_PATH_LEN);
8188 buf[JIM_PATH_LEN-1] = '\0';
8189 prefixLen = strlen(buf);
8190 if (prefixLen && buf[prefixLen-1] == '/')
8191 buf[prefixLen-1] = '\0';
8193 if ((dir = opendir(buf)) == NULL) continue;
8194 while ((de = readdir(dir)) != NULL) {
8195 char *fileName = de->d_name;
8196 int fileNameLen = strlen(fileName);
8198 if (strncmp(fileName, "jim-", 4) == 0 &&
8199 strncmp(fileName + 4, pkgName, pkgNameLen) == 0 &&
8200 *(fileName + 4+pkgNameLen) == '-' &&
8201 fileNameLen > 4 && /* note that this is not really useful */
8202 (strncmp(fileName + fileNameLen-4, ".tcl", 4) == 0 ||
8203 strncmp(fileName + fileNameLen-4, ".dll", 4) == 0 ||
8204 strncmp(fileName + fileNameLen-3, ".so", 3) == 0))
8206 char ver[6]; /* xx.yy < nulterm> */
8207 char *p = strrchr(fileName, '.');
8208 int verLen, fileVer;
8210 verLen = p - (fileName + 4+pkgNameLen + 1);
8211 if (verLen < 3 || verLen > 5) continue;
8212 memcpy(ver, fileName + 4+pkgNameLen + 1, verLen);
8213 ver[verLen] = '\0';
8214 if (JimPackageVersionToInt(interp, ver, &fileVer, JIM_NONE)
8215 != JIM_OK) continue;
8216 if (JimPackageMatchVersion(pkgVer, fileVer, flags) &&
8217 (bestVer == -1 || bestVer < fileVer))
8219 bestVer = fileVer;
8220 Jim_Free(bestPackage);
8221 bestPackage = Jim_Alloc(strlen(buf) + strlen(fileName) + 2);
8222 sprintf(bestPackage, "%s/%s", buf, fileName);
8226 closedir(dir);
8228 return bestPackage;
8231 #else /* JIM_ANSIC */
8233 static char *JimFindBestPackage(Jim_Interp *interp, char **prefixes,
8234 int prefixc, const char *pkgName, int pkgVer, int flags)
8236 JIM_NOTUSED(interp);
8237 JIM_NOTUSED(prefixes);
8238 JIM_NOTUSED(prefixc);
8239 JIM_NOTUSED(pkgName);
8240 JIM_NOTUSED(pkgVer);
8241 JIM_NOTUSED(flags);
8242 return NULL;
8245 #endif /* JIM_ANSIC */
8247 /* Search for a suitable package under every dir specified by jim_libpath
8248 * and load it if possible. If a suitable package was loaded with success
8249 * JIM_OK is returned, otherwise JIM_ERR is returned. */
8250 static int JimLoadPackage(Jim_Interp *interp, const char *name, int ver,
8251 int flags)
8253 Jim_Obj *libPathObjPtr;
8254 char **prefixes, *best;
8255 int prefixc, i, retCode = JIM_OK;
8257 libPathObjPtr = Jim_GetGlobalVariableStr(interp, "jim_libpath", JIM_NONE);
8258 if (libPathObjPtr == NULL) {
8259 prefixc = 0;
8260 libPathObjPtr = NULL;
8261 } else {
8262 Jim_IncrRefCount(libPathObjPtr);
8263 Jim_ListLength(interp, libPathObjPtr, &prefixc);
8266 prefixes = Jim_Alloc(sizeof(char*)*prefixc);
8267 for (i = 0; i < prefixc; i++) {
8268 Jim_Obj *prefixObjPtr;
8269 if (Jim_ListIndex(interp, libPathObjPtr, i,
8270 &prefixObjPtr, JIM_NONE) != JIM_OK)
8272 prefixes[i] = NULL;
8273 continue;
8275 prefixes[i] = Jim_StrDup(Jim_GetString(prefixObjPtr, NULL));
8277 /* Scan every directory to find the "best" package. */
8278 best = JimFindBestPackage(interp, prefixes, prefixc, name, ver, flags);
8279 if (best != NULL) {
8280 char *p = strrchr(best, '.');
8281 /* Try to load/source it */
8282 if (p && strcmp(p, ".tcl") == 0) {
8283 retCode = Jim_EvalFile(interp, best);
8284 } else {
8285 retCode = Jim_LoadLibrary(interp, best);
8287 } else {
8288 retCode = JIM_ERR;
8290 Jim_Free(best);
8291 for (i = 0; i < prefixc; i++)
8292 Jim_Free(prefixes[i]);
8293 Jim_Free(prefixes);
8294 if (libPathObjPtr)
8295 Jim_DecrRefCount(interp, libPathObjPtr);
8296 return retCode;
8299 const char *Jim_PackageRequire(Jim_Interp *interp, const char *name,
8300 const char *ver, int flags)
8302 Jim_HashEntry *he;
8303 int requiredVer;
8305 /* Start with an empty error string */
8306 Jim_SetResultString(interp, "", 0);
8308 if (JimPackageVersionToInt(interp, ver, &requiredVer, JIM_ERRMSG) != JIM_OK)
8309 return NULL;
8310 he = Jim_FindHashEntry(&interp->packages, name);
8311 if (he == NULL) {
8312 /* Try to load the package. */
8313 if (JimLoadPackage(interp, name, requiredVer, flags) == JIM_OK) {
8314 he = Jim_FindHashEntry(&interp->packages, name);
8315 if (he == NULL) {
8316 return "?";
8318 return he->val;
8320 /* No way... return an error. */
8321 if (flags & JIM_ERRMSG) {
8322 int len;
8323 Jim_GetString(Jim_GetResult(interp), &len);
8324 Jim_AppendStrings(interp, Jim_GetResult(interp), len ? "\n" : "",
8325 "Can't find package '", name, "'", NULL);
8327 return NULL;
8328 } else {
8329 int actualVer;
8330 if (JimPackageVersionToInt(interp, he->val, &actualVer, JIM_ERRMSG)
8331 != JIM_OK)
8333 return NULL;
8335 /* Check if version matches. */
8336 if (JimPackageMatchVersion(requiredVer, actualVer, flags) == 0) {
8337 Jim_AppendStrings(interp, Jim_GetResult(interp),
8338 "Package '", name, "' already loaded, but with version ",
8339 he->val, NULL);
8340 return NULL;
8342 return he->val;
8346 /* -----------------------------------------------------------------------------
8347 * Eval
8348 * ---------------------------------------------------------------------------*/
8349 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
8350 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
8352 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc,
8353 Jim_Obj *const *argv);
8355 /* Handle calls to the [unknown] command */
8356 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
8358 Jim_Obj **v, *sv[JIM_EVAL_SARGV_LEN];
8359 int retCode;
8361 /* If JimUnknown() is recursively called (e.g. error in the unknown proc,
8362 * done here
8364 if (interp->unknown_called) {
8365 return JIM_ERR;
8368 /* If the [unknown] command does not exists returns
8369 * just now */
8370 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
8371 return JIM_ERR;
8373 /* The object interp->unknown just contains
8374 * the "unknown" string, it is used in order to
8375 * avoid to lookup the unknown command every time
8376 * but instread to cache the result. */
8377 if (argc + 1 <= JIM_EVAL_SARGV_LEN)
8378 v = sv;
8379 else
8380 v = Jim_Alloc(sizeof(Jim_Obj*)*(argc + 1));
8381 /* Make a copy of the arguments vector, but shifted on
8382 * the right of one position. The command name of the
8383 * command will be instead the first argument of the
8384 * [unknonw] call. */
8385 memcpy(v + 1, argv, sizeof(Jim_Obj*)*argc);
8386 v[0] = interp->unknown;
8387 /* Call it */
8388 interp->unknown_called++;
8389 retCode = Jim_EvalObjVector(interp, argc + 1, v);
8390 interp->unknown_called--;
8392 /* Clean up */
8393 if (v != sv)
8394 Jim_Free(v);
8395 return retCode;
8398 /* Eval the object vector 'objv' composed of 'objc' elements.
8399 * Every element is used as single argument.
8400 * Jim_EvalObj() will call this function every time its object
8401 * argument is of "list" type, with no string representation.
8403 * This is possible because the string representation of a
8404 * list object generated by the UpdateStringOfList is made
8405 * in a way that ensures that every list element is a different
8406 * command argument. */
8407 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
8409 int i, retcode;
8410 Jim_Cmd *cmdPtr;
8412 /* Incr refcount of arguments. */
8413 for (i = 0; i < objc; i++)
8414 Jim_IncrRefCount(objv[i]);
8415 /* Command lookup */
8416 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
8417 if (cmdPtr == NULL) {
8418 retcode = JimUnknown(interp, objc, objv);
8419 } else {
8420 /* Call it -- Make sure result is an empty object. */
8421 Jim_SetEmptyResult(interp);
8422 if (cmdPtr->cmdProc) {
8423 interp->cmdPrivData = cmdPtr->privData;
8424 retcode = cmdPtr->cmdProc(interp, objc, objv);
8425 if (retcode == JIM_ERR_ADDSTACK) {
8426 //JimAppendStackTrace(interp, "", script->fileName, token[i-argc*2].linenr);
8427 retcode = JIM_ERR;
8429 } else {
8430 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
8431 if (retcode == JIM_ERR) {
8432 JimAppendStackTrace(interp,
8433 Jim_GetString(objv[0], NULL), "", 1);
8437 /* Decr refcount of arguments and return the retcode */
8438 for (i = 0; i < objc; i++)
8439 Jim_DecrRefCount(interp, objv[i]);
8440 return retcode;
8443 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
8444 * via *objPtrPtr. This function is only called by Jim_EvalObj().
8445 * The returned object has refcount = 0. */
8446 int Jim_InterpolateTokens(Jim_Interp *interp, ScriptToken *token,
8447 int tokens, Jim_Obj **objPtrPtr)
8449 int totlen = 0, i, retcode;
8450 Jim_Obj **intv;
8451 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
8452 Jim_Obj *objPtr;
8453 char *s;
8455 if (tokens <= JIM_EVAL_SINTV_LEN)
8456 intv = sintv;
8457 else
8458 intv = Jim_Alloc(sizeof(Jim_Obj*)*
8459 tokens);
8460 /* Compute every token forming the argument
8461 * in the intv objects vector. */
8462 for (i = 0; i < tokens; i++) {
8463 switch (token[i].type) {
8464 case JIM_TT_ESC:
8465 case JIM_TT_STR:
8466 intv[i] = token[i].objPtr;
8467 break;
8468 case JIM_TT_VAR:
8469 intv[i] = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
8470 if (!intv[i]) {
8471 retcode = JIM_ERR;
8472 goto err;
8474 break;
8475 case JIM_TT_DICTSUGAR:
8476 intv[i] = Jim_ExpandDictSugar(interp, token[i].objPtr);
8477 if (!intv[i]) {
8478 retcode = JIM_ERR;
8479 goto err;
8481 break;
8482 case JIM_TT_CMD:
8483 retcode = Jim_EvalObj(interp, token[i].objPtr);
8484 if (retcode != JIM_OK)
8485 goto err;
8486 intv[i] = Jim_GetResult(interp);
8487 break;
8488 default:
8489 Jim_Panic(interp,
8490 "default token type reached "
8491 "in Jim_InterpolateTokens().");
8492 break;
8494 Jim_IncrRefCount(intv[i]);
8495 /* Make sure there is a valid
8496 * string rep, and add the string
8497 * length to the total legnth. */
8498 Jim_GetString(intv[i], NULL);
8499 totlen += intv[i]->length;
8501 /* Concatenate every token in an unique
8502 * object. */
8503 objPtr = Jim_NewStringObjNoAlloc(interp,
8504 NULL, 0);
8505 s = objPtr->bytes = Jim_Alloc(totlen + 1);
8506 objPtr->length = totlen;
8507 for (i = 0; i < tokens; i++) {
8508 memcpy(s, intv[i]->bytes, intv[i]->length);
8509 s += intv[i]->length;
8510 Jim_DecrRefCount(interp, intv[i]);
8512 objPtr->bytes[totlen] = '\0';
8513 /* Free the intv vector if not static. */
8514 if (tokens > JIM_EVAL_SINTV_LEN)
8515 Jim_Free(intv);
8516 *objPtrPtr = objPtr;
8517 return JIM_OK;
8518 err:
8519 i--;
8520 for (; i >= 0; i--)
8521 Jim_DecrRefCount(interp, intv[i]);
8522 if (tokens > JIM_EVAL_SINTV_LEN)
8523 Jim_Free(intv);
8524 return retcode;
8527 /* Helper of Jim_EvalObj() to perform argument expansion.
8528 * Basically this function append an argument to 'argv'
8529 * (and increments argc by reference accordingly), performing
8530 * expansion of the list object if 'expand' is non-zero, or
8531 * just adding objPtr to argv if 'expand' is zero. */
8532 void Jim_ExpandArgument(Jim_Interp *interp, Jim_Obj ***argv,
8533 int *argcPtr, int expand, Jim_Obj *objPtr)
8535 if (!expand) {
8536 (*argv) = Jim_Realloc(*argv, sizeof(Jim_Obj*)*((*argcPtr) + 1));
8537 /* refcount of objPtr not incremented because
8538 * we are actually transfering a reference from
8539 * the old 'argv' to the expanded one. */
8540 (*argv)[*argcPtr] = objPtr;
8541 (*argcPtr)++;
8542 } else {
8543 int len, i;
8545 Jim_ListLength(interp, objPtr, &len);
8546 (*argv) = Jim_Realloc(*argv, sizeof(Jim_Obj*)*((*argcPtr) + len));
8547 for (i = 0; i < len; i++) {
8548 (*argv)[*argcPtr] = objPtr->internalRep.listValue.ele[i];
8549 Jim_IncrRefCount(objPtr->internalRep.listValue.ele[i]);
8550 (*argcPtr)++;
8552 /* The original object reference is no longer needed,
8553 * after the expansion it is no longer present on
8554 * the argument vector, but the single elements are
8555 * in its place. */
8556 Jim_DecrRefCount(interp, objPtr);
8560 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
8562 int i, j = 0, len;
8563 ScriptObj *script;
8564 ScriptToken *token;
8565 int *cs; /* command structure array */
8566 int retcode = JIM_OK;
8567 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL, *tmpObjPtr;
8569 interp->errorFlag = 0;
8571 /* If the object is of type "list" and there is no
8572 * string representation for this object, we can call
8573 * a specialized version of Jim_EvalObj() */
8574 if (scriptObjPtr->typePtr == &listObjType &&
8575 scriptObjPtr->internalRep.listValue.len &&
8576 scriptObjPtr->bytes == NULL) {
8577 Jim_IncrRefCount(scriptObjPtr);
8578 retcode = Jim_EvalObjVector(interp,
8579 scriptObjPtr->internalRep.listValue.len,
8580 scriptObjPtr->internalRep.listValue.ele);
8581 Jim_DecrRefCount(interp, scriptObjPtr);
8582 return retcode;
8585 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
8586 script = Jim_GetScript(interp, scriptObjPtr);
8587 /* Now we have to make sure the internal repr will not be
8588 * freed on shimmering.
8590 * Think for example to this:
8592 * set x {llength $x; ... some more code ...}; eval $x
8594 * In order to preserve the internal rep, we increment the
8595 * inUse field of the script internal rep structure. */
8596 script->inUse++;
8598 token = script->token;
8599 len = script->len;
8600 cs = script->cmdStruct;
8601 i = 0; /* 'i' is the current token index. */
8603 /* Reset the interpreter result. This is useful to
8604 * return the emtpy result in the case of empty program. */
8605 Jim_SetEmptyResult(interp);
8607 /* Execute every command sequentially, returns on
8608 * error (i.e. if a command does not return JIM_OK) */
8609 while (i < len) {
8610 int expand = 0;
8611 int argc = *cs++; /* Get the number of arguments */
8612 Jim_Cmd *cmd;
8614 /* Set the expand flag if needed. */
8615 if (argc == -1) {
8616 expand++;
8617 argc = *cs++;
8619 /* Allocate the arguments vector */
8620 if (argc <= JIM_EVAL_SARGV_LEN)
8621 argv = sargv;
8622 else
8623 argv = Jim_Alloc(sizeof(Jim_Obj*)*argc);
8624 /* Populate the arguments objects. */
8625 for (j = 0; j < argc; j++) {
8626 int tokens = *cs++;
8628 /* tokens is negative if expansion is needed.
8629 * for this argument. */
8630 if (tokens < 0) {
8631 tokens = (-tokens)-1;
8632 i++;
8634 if (tokens == 1) {
8635 /* Fast path if the token does not
8636 * need interpolation */
8637 switch (token[i].type) {
8638 case JIM_TT_ESC:
8639 case JIM_TT_STR:
8640 argv[j] = token[i].objPtr;
8641 break;
8642 case JIM_TT_VAR:
8643 tmpObjPtr = Jim_GetVariable(interp, token[i].objPtr,
8644 JIM_ERRMSG);
8645 if (!tmpObjPtr) {
8646 retcode = JIM_ERR;
8647 goto err;
8649 argv[j] = tmpObjPtr;
8650 break;
8651 case JIM_TT_DICTSUGAR:
8652 tmpObjPtr = Jim_ExpandDictSugar(interp, token[i].objPtr);
8653 if (!tmpObjPtr) {
8654 retcode = JIM_ERR;
8655 goto err;
8657 argv[j] = tmpObjPtr;
8658 break;
8659 case JIM_TT_CMD:
8660 retcode = Jim_EvalObj(interp, token[i].objPtr);
8661 if (retcode != JIM_OK)
8662 goto err;
8663 argv[j] = Jim_GetResult(interp);
8664 break;
8665 default:
8666 Jim_Panic(interp,
8667 "default token type reached "
8668 "in Jim_EvalObj().");
8669 break;
8671 Jim_IncrRefCount(argv[j]);
8672 i += 2;
8673 } else {
8674 /* For interpolation we call an helper
8675 * function doing the work for us. */
8676 if ((retcode = Jim_InterpolateTokens(interp,
8677 token + i, tokens, &tmpObjPtr)) != JIM_OK)
8679 goto err;
8681 argv[j] = tmpObjPtr;
8682 Jim_IncrRefCount(argv[j]);
8683 i += tokens + 1;
8686 /* Handle {expand} expansion */
8687 if (expand) {
8688 int *ecs = cs - argc;
8689 int eargc = 0;
8690 Jim_Obj **eargv = NULL;
8692 for (j = 0; j < argc; j++) {
8693 Jim_ExpandArgument(interp, &eargv, &eargc,
8694 ecs[j] < 0, argv[j]);
8696 if (argv != sargv)
8697 Jim_Free(argv);
8698 argc = eargc;
8699 argv = eargv;
8700 j = argc;
8701 if (argc == 0) {
8702 /* Nothing to do with zero args. */
8703 Jim_Free(eargv);
8704 continue;
8707 /* Lookup the command to call */
8708 cmd = Jim_GetCommand(interp, argv[0], JIM_ERRMSG);
8709 if (cmd != NULL) {
8710 /* Call it -- Make sure result is an empty object. */
8711 Jim_SetEmptyResult(interp);
8712 if (cmd->cmdProc) {
8713 interp->cmdPrivData = cmd->privData;
8714 retcode = cmd->cmdProc(interp, argc, argv);
8715 if ((retcode == JIM_ERR)||(retcode == JIM_ERR_ADDSTACK)) {
8716 JimAppendStackTrace(interp, "", script->fileName, token[i-argc*2].linenr);
8717 retcode = JIM_ERR;
8719 } else {
8720 retcode = JimCallProcedure(interp, cmd, argc, argv);
8721 if (retcode == JIM_ERR) {
8722 JimAppendStackTrace(interp,
8723 Jim_GetString(argv[0], NULL), script->fileName,
8724 token[i-argc*2].linenr);
8727 } else {
8728 /* Call [unknown] */
8729 retcode = JimUnknown(interp, argc, argv);
8730 if (retcode == JIM_ERR) {
8731 JimAppendStackTrace(interp,
8732 "", script->fileName,
8733 token[i-argc*2].linenr);
8736 if (retcode != JIM_OK) {
8737 i -= argc*2; /* point to the command name. */
8738 goto err;
8740 /* Decrement the arguments count */
8741 for (j = 0; j < argc; j++) {
8742 Jim_DecrRefCount(interp, argv[j]);
8745 if (argv != sargv) {
8746 Jim_Free(argv);
8747 argv = NULL;
8750 /* Note that we don't have to decrement inUse, because the
8751 * following code transfers our use of the reference again to
8752 * the script object. */
8753 j = 0; /* on normal termination, the argv array is already
8754 Jim_DecrRefCount-ed. */
8755 err:
8756 /* Handle errors. */
8757 if (retcode == JIM_ERR && !interp->errorFlag) {
8758 interp->errorFlag = 1;
8759 JimSetErrorFileName(interp, script->fileName);
8760 JimSetErrorLineNumber(interp, token[i].linenr);
8761 JimResetStackTrace(interp);
8763 Jim_FreeIntRep(interp, scriptObjPtr);
8764 scriptObjPtr->typePtr = &scriptObjType;
8765 Jim_SetIntRepPtr(scriptObjPtr, script);
8766 Jim_DecrRefCount(interp, scriptObjPtr);
8767 for (i = 0; i < j; i++) {
8768 Jim_DecrRefCount(interp, argv[i]);
8770 if (argv != sargv)
8771 Jim_Free(argv);
8772 return retcode;
8775 /* Call a procedure implemented in Tcl.
8776 * It's possible to speed-up a lot this function, currently
8777 * the callframes are not cached, but allocated and
8778 * destroied every time. What is expecially costly is
8779 * to create/destroy the local vars hash table every time.
8781 * This can be fixed just implementing callframes caching
8782 * in JimCreateCallFrame() and JimFreeCallFrame(). */
8783 int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc,
8784 Jim_Obj *const *argv)
8786 int i, retcode;
8787 Jim_CallFrame *callFramePtr;
8788 int num_args;
8790 /* Check arity */
8791 if (argc < cmd->arityMin || (cmd->arityMax != -1 &&
8792 argc > cmd->arityMax)) {
8793 Jim_Obj *objPtr = Jim_NewEmptyStringObj(interp);
8794 Jim_AppendStrings(interp, objPtr,
8795 "wrong # args: should be \"", Jim_GetString(argv[0], NULL),
8796 (cmd->arityMin > 1) ? " " : "",
8797 Jim_GetString(cmd->argListObjPtr, NULL), "\"", NULL);
8798 Jim_SetResult(interp, objPtr);
8799 return JIM_ERR;
8801 /* Check if there are too nested calls */
8802 if (interp->numLevels == interp->maxNestingDepth) {
8803 Jim_SetResultString(interp,
8804 "Too many nested calls. Infinite recursion?", -1);
8805 return JIM_ERR;
8807 /* Create a new callframe */
8808 callFramePtr = JimCreateCallFrame(interp);
8809 callFramePtr->parentCallFrame = interp->framePtr;
8810 callFramePtr->argv = argv;
8811 callFramePtr->argc = argc;
8812 callFramePtr->procArgsObjPtr = cmd->argListObjPtr;
8813 callFramePtr->procBodyObjPtr = cmd->bodyObjPtr;
8814 callFramePtr->staticVars = cmd->staticVars;
8815 Jim_IncrRefCount(cmd->argListObjPtr);
8816 Jim_IncrRefCount(cmd->bodyObjPtr);
8817 interp->framePtr = callFramePtr;
8818 interp->numLevels ++;
8820 /* Set arguments */
8821 Jim_ListLength(interp, cmd->argListObjPtr, &num_args);
8823 /* If last argument is 'args', don't set it here */
8824 if (cmd->arityMax == -1) {
8825 num_args--;
8828 for (i = 0; i < num_args; i++) {
8829 Jim_Obj *argObjPtr=NULL;
8830 Jim_Obj *nameObjPtr=NULL;
8831 Jim_Obj *valueObjPtr=NULL;
8833 Jim_ListIndex(interp, cmd->argListObjPtr, i, &argObjPtr, JIM_NONE);
8834 if (i + 1 >= cmd->arityMin) {
8835 /* The name is the first element of the list */
8836 Jim_ListIndex(interp, argObjPtr, 0, &nameObjPtr, JIM_NONE);
8838 else {
8839 /* The element arg is the name */
8840 nameObjPtr = argObjPtr;
8843 if (i + 1 >= argc) {
8844 /* No more values, so use default */
8845 /* The value is the second element of the list */
8846 Jim_ListIndex(interp, argObjPtr, 1, &valueObjPtr, JIM_NONE);
8848 else {
8849 valueObjPtr = argv[i + 1];
8851 Jim_SetVariable(interp, nameObjPtr, valueObjPtr);
8853 /* Set optional arguments */
8854 if (cmd->arityMax == -1) {
8855 Jim_Obj *listObjPtr=NULL, *objPtr=NULL;
8857 i++;
8858 listObjPtr = Jim_NewListObj(interp, argv + i, argc-i);
8859 Jim_ListIndex(interp, cmd->argListObjPtr, num_args, &objPtr, JIM_NONE);
8860 Jim_SetVariable(interp, objPtr, listObjPtr);
8862 /* Eval the body */
8863 retcode = Jim_EvalObj(interp, cmd->bodyObjPtr);
8865 /* Destroy the callframe */
8866 interp->numLevels --;
8867 interp->framePtr = interp->framePtr->parentCallFrame;
8868 if (callFramePtr->vars.size != JIM_HT_INITIAL_SIZE) {
8869 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NONE);
8870 } else {
8871 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NOHT);
8873 /* Handle the JIM_EVAL return code */
8874 if (retcode == JIM_EVAL && interp->evalRetcodeLevel != interp->numLevels) {
8875 int savedLevel = interp->evalRetcodeLevel;
8877 interp->evalRetcodeLevel = interp->numLevels;
8878 while (retcode == JIM_EVAL) {
8879 Jim_Obj *resultScriptObjPtr = Jim_GetResult(interp);
8880 Jim_IncrRefCount(resultScriptObjPtr);
8881 retcode = Jim_EvalObj(interp, resultScriptObjPtr);
8882 Jim_DecrRefCount(interp, resultScriptObjPtr);
8884 interp->evalRetcodeLevel = savedLevel;
8886 /* Handle the JIM_RETURN return code */
8887 if (retcode == JIM_RETURN) {
8888 retcode = interp->returnCode;
8889 interp->returnCode = JIM_OK;
8891 return retcode;
8894 int Jim_Eval_Named(Jim_Interp *interp, const char *script, const char *filename, int lineno)
8896 int retval;
8897 Jim_Obj *scriptObjPtr;
8899 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
8900 Jim_IncrRefCount(scriptObjPtr);
8903 if (filename) {
8904 JimSetSourceInfo(interp, scriptObjPtr, filename, lineno);
8907 retval = Jim_EvalObj(interp, scriptObjPtr);
8908 Jim_DecrRefCount(interp, scriptObjPtr);
8909 return retval;
8912 int Jim_Eval(Jim_Interp *interp, const char *script)
8914 return Jim_Eval_Named(interp, script, NULL, 0);
8919 /* Execute script in the scope of the global level */
8920 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
8922 Jim_CallFrame *savedFramePtr;
8923 int retval;
8925 savedFramePtr = interp->framePtr;
8926 interp->framePtr = interp->topFramePtr;
8927 retval = Jim_Eval(interp, script);
8928 interp->framePtr = savedFramePtr;
8929 return retval;
8932 int Jim_EvalObjBackground(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
8934 Jim_CallFrame *savedFramePtr;
8935 int retval;
8937 savedFramePtr = interp->framePtr;
8938 interp->framePtr = interp->topFramePtr;
8939 retval = Jim_EvalObj(interp, scriptObjPtr);
8940 interp->framePtr = savedFramePtr;
8941 /* Try to report the error (if any) via the bgerror proc */
8942 if (retval != JIM_OK) {
8943 Jim_Obj *objv[2];
8945 objv[0] = Jim_NewStringObj(interp, "bgerror", -1);
8946 objv[1] = Jim_GetResult(interp);
8947 Jim_IncrRefCount(objv[0]);
8948 Jim_IncrRefCount(objv[1]);
8949 if (Jim_EvalObjVector(interp, 2, objv) != JIM_OK) {
8950 /* Report the error to stderr. */
8951 Jim_fprintf(interp, interp->cookie_stderr, "Background error:" JIM_NL);
8952 Jim_PrintErrorMessage(interp);
8954 Jim_DecrRefCount(interp, objv[0]);
8955 Jim_DecrRefCount(interp, objv[1]);
8957 return retval;
8960 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
8962 char *prg = NULL;
8963 FILE *fp;
8964 int nread, totread, maxlen, buflen;
8965 int retval;
8966 Jim_Obj *scriptObjPtr;
8968 if ((fp = fopen(filename, "r")) == NULL) {
8969 const int cwd_len = 2048;
8970 char *cwd = malloc(cwd_len);
8971 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8972 if (!getcwd(cwd, cwd_len)) strcpy(cwd, "unknown");
8973 Jim_AppendStrings(interp, Jim_GetResult(interp),
8974 "Error loading script \"", filename, "\"",
8975 " cwd: ", cwd,
8976 " err: ", strerror(errno), NULL);
8977 free(cwd);
8978 return JIM_ERR;
8980 buflen = 1024;
8981 maxlen = totread = 0;
8982 while (1) {
8983 if (maxlen < totread + buflen + 1) {
8984 maxlen = totread + buflen + 1;
8985 prg = Jim_Realloc(prg, maxlen);
8987 /* do not use Jim_fread() - this is really a file */
8988 if ((nread = fread(prg + totread, 1, buflen, fp)) == 0) break;
8989 totread += nread;
8991 prg[totread] = '\0';
8992 /* do not use Jim_fclose() - this is really a file */
8993 fclose(fp);
8995 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, prg, totread);
8996 JimSetSourceInfo(interp, scriptObjPtr, filename, 1);
8997 Jim_IncrRefCount(scriptObjPtr);
8998 retval = Jim_EvalObj(interp, scriptObjPtr);
8999 Jim_DecrRefCount(interp, scriptObjPtr);
9000 return retval;
9003 /* -----------------------------------------------------------------------------
9004 * Subst
9005 * ---------------------------------------------------------------------------*/
9006 static int JimParseSubstStr(struct JimParserCtx *pc)
9008 pc->tstart = pc->p;
9009 pc->tline = pc->linenr;
9010 while (*pc->p && *pc->p != '$' && *pc->p != '[') {
9011 pc->p++; pc->len--;
9013 pc->tend = pc->p-1;
9014 pc->tt = JIM_TT_ESC;
9015 return JIM_OK;
9018 static int JimParseSubst(struct JimParserCtx *pc, int flags)
9020 int retval;
9022 if (pc->len == 0) {
9023 pc->tstart = pc->tend = pc->p;
9024 pc->tline = pc->linenr;
9025 pc->tt = JIM_TT_EOL;
9026 pc->eof = 1;
9027 return JIM_OK;
9029 switch (*pc->p) {
9030 case '[':
9031 retval = JimParseCmd(pc);
9032 if (flags & JIM_SUBST_NOCMD) {
9033 pc->tstart--;
9034 pc->tend++;
9035 pc->tt = (flags & JIM_SUBST_NOESC) ?
9036 JIM_TT_STR : JIM_TT_ESC;
9038 return retval;
9039 break;
9040 case '$':
9041 if (JimParseVar(pc) == JIM_ERR) {
9042 pc->tstart = pc->tend = pc->p++; pc->len--;
9043 pc->tline = pc->linenr;
9044 pc->tt = JIM_TT_STR;
9045 } else {
9046 if (flags & JIM_SUBST_NOVAR) {
9047 pc->tstart--;
9048 if (flags & JIM_SUBST_NOESC)
9049 pc->tt = JIM_TT_STR;
9050 else
9051 pc->tt = JIM_TT_ESC;
9052 if (*pc->tstart == '{') {
9053 pc->tstart--;
9054 if (*(pc->tend + 1))
9055 pc->tend++;
9059 break;
9060 default:
9061 retval = JimParseSubstStr(pc);
9062 if (flags & JIM_SUBST_NOESC)
9063 pc->tt = JIM_TT_STR;
9064 return retval;
9065 break;
9067 return JIM_OK;
9070 /* The subst object type reuses most of the data structures and functions
9071 * of the script object. Script's data structures are a bit more complex
9072 * for what is needed for [subst]itution tasks, but the reuse helps to
9073 * deal with a single data structure at the cost of some more memory
9074 * usage for substitutions. */
9075 static Jim_ObjType substObjType = {
9076 "subst",
9077 FreeScriptInternalRep,
9078 DupScriptInternalRep,
9079 NULL,
9080 JIM_TYPE_REFERENCES,
9083 /* This method takes the string representation of an object
9084 * as a Tcl string where to perform [subst]itution, and generates
9085 * the pre-parsed internal representation. */
9086 int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
9088 int scriptTextLen;
9089 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
9090 struct JimParserCtx parser;
9091 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
9093 script->len = 0;
9094 script->csLen = 0;
9095 script->commands = 0;
9096 script->token = NULL;
9097 script->cmdStruct = NULL;
9098 script->inUse = 1;
9099 script->substFlags = flags;
9100 script->fileName = NULL;
9102 JimParserInit(&parser, scriptText, scriptTextLen, 1);
9103 while (1) {
9104 char *token;
9105 int len, type, linenr;
9107 JimParseSubst(&parser, flags);
9108 if (JimParserEof(&parser)) break;
9109 token = JimParserGetToken(&parser, &len, &type, &linenr);
9110 ScriptObjAddToken(interp, script, token, len, type,
9111 NULL, linenr);
9113 /* Free the old internal rep and set the new one. */
9114 Jim_FreeIntRep(interp, objPtr);
9115 Jim_SetIntRepPtr(objPtr, script);
9116 objPtr->typePtr = &scriptObjType;
9117 return JIM_OK;
9120 ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
9122 struct ScriptObj *script = Jim_GetIntRepPtr(objPtr);
9124 if (objPtr->typePtr != &substObjType || script->substFlags != flags)
9125 SetSubstFromAny(interp, objPtr, flags);
9126 return (ScriptObj*) Jim_GetIntRepPtr(objPtr);
9129 /* Performs commands,variables,blackslashes substitution,
9130 * storing the result object (with refcount 0) into
9131 * resObjPtrPtr. */
9132 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr,
9133 Jim_Obj **resObjPtrPtr, int flags)
9135 ScriptObj *script;
9136 ScriptToken *token;
9137 int i, len, retcode = JIM_OK;
9138 Jim_Obj *resObjPtr, *savedResultObjPtr;
9140 script = Jim_GetSubst(interp, substObjPtr, flags);
9141 #ifdef JIM_OPTIMIZATION
9142 /* Fast path for a very common case with array-alike syntax,
9143 * that's: $foo($bar) */
9144 if (script->len == 1 && script->token[0].type == JIM_TT_VAR) {
9145 Jim_Obj *varObjPtr = script->token[0].objPtr;
9147 Jim_IncrRefCount(varObjPtr);
9148 resObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
9149 if (resObjPtr == NULL) {
9150 Jim_DecrRefCount(interp, varObjPtr);
9151 return JIM_ERR;
9153 Jim_DecrRefCount(interp, varObjPtr);
9154 *resObjPtrPtr = resObjPtr;
9155 return JIM_OK;
9157 #endif
9159 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
9160 /* In order to preserve the internal rep, we increment the
9161 * inUse field of the script internal rep structure. */
9162 script->inUse++;
9164 token = script->token;
9165 len = script->len;
9167 /* Save the interp old result, to set it again before
9168 * to return. */
9169 savedResultObjPtr = interp->result;
9170 Jim_IncrRefCount(savedResultObjPtr);
9172 /* Perform the substitution. Starts with an empty object
9173 * and adds every token (performing the appropriate
9174 * var/command/escape substitution). */
9175 resObjPtr = Jim_NewStringObj(interp, "", 0);
9176 for (i = 0; i < len; i++) {
9177 Jim_Obj *objPtr;
9179 switch (token[i].type) {
9180 case JIM_TT_STR:
9181 case JIM_TT_ESC:
9182 Jim_AppendObj(interp, resObjPtr, token[i].objPtr);
9183 break;
9184 case JIM_TT_VAR:
9185 objPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
9186 if (objPtr == NULL) goto err;
9187 Jim_IncrRefCount(objPtr);
9188 Jim_AppendObj(interp, resObjPtr, objPtr);
9189 Jim_DecrRefCount(interp, objPtr);
9190 break;
9191 case JIM_TT_DICTSUGAR:
9192 objPtr = Jim_ExpandDictSugar(interp, token[i].objPtr);
9193 if (!objPtr) {
9194 retcode = JIM_ERR;
9195 goto err;
9197 break;
9198 case JIM_TT_CMD:
9199 if (Jim_EvalObj(interp, token[i].objPtr) != JIM_OK)
9200 goto err;
9201 Jim_AppendObj(interp, resObjPtr, interp->result);
9202 break;
9203 default:
9204 Jim_Panic(interp,
9205 "default token type (%d) reached "
9206 "in Jim_SubstObj().", token[i].type);
9207 break;
9211 if (retcode == JIM_OK)
9212 Jim_SetResult(interp, savedResultObjPtr);
9213 Jim_DecrRefCount(interp, savedResultObjPtr);
9214 /* Note that we don't have to decrement inUse, because the
9215 * following code transfers our use of the reference again to
9216 * the script object. */
9217 Jim_FreeIntRep(interp, substObjPtr);
9218 substObjPtr->typePtr = &scriptObjType;
9219 Jim_SetIntRepPtr(substObjPtr, script);
9220 Jim_DecrRefCount(interp, substObjPtr);
9221 *resObjPtrPtr = resObjPtr;
9222 return retcode;
9223 err:
9224 Jim_FreeNewObj(interp, resObjPtr);
9225 retcode = JIM_ERR;
9226 goto ok;
9229 /* -----------------------------------------------------------------------------
9230 * API Input/Export functions
9231 * ---------------------------------------------------------------------------*/
9233 int Jim_GetApi(Jim_Interp *interp, const char *funcname, void *targetPtrPtr)
9235 Jim_HashEntry *he;
9237 he = Jim_FindHashEntry(&interp->stub, funcname);
9238 if (!he)
9239 return JIM_ERR;
9240 memcpy(targetPtrPtr, &he->val, sizeof(void*));
9241 return JIM_OK;
9244 int Jim_RegisterApi(Jim_Interp *interp, const char *funcname, void *funcptr)
9246 return Jim_AddHashEntry(&interp->stub, funcname, funcptr);
9249 #define JIM_REGISTER_API(name) \
9250 Jim_RegisterApi(interp, "Jim_" #name, (void *)Jim_ ## name)
9252 void JimRegisterCoreApi(Jim_Interp *interp)
9254 interp->getApiFuncPtr = Jim_GetApi;
9255 JIM_REGISTER_API(Alloc);
9256 JIM_REGISTER_API(Free);
9257 JIM_REGISTER_API(Eval);
9258 JIM_REGISTER_API(Eval_Named);
9259 JIM_REGISTER_API(EvalGlobal);
9260 JIM_REGISTER_API(EvalFile);
9261 JIM_REGISTER_API(EvalObj);
9262 JIM_REGISTER_API(EvalObjBackground);
9263 JIM_REGISTER_API(EvalObjVector);
9264 JIM_REGISTER_API(InitHashTable);
9265 JIM_REGISTER_API(ExpandHashTable);
9266 JIM_REGISTER_API(AddHashEntry);
9267 JIM_REGISTER_API(ReplaceHashEntry);
9268 JIM_REGISTER_API(DeleteHashEntry);
9269 JIM_REGISTER_API(FreeHashTable);
9270 JIM_REGISTER_API(FindHashEntry);
9271 JIM_REGISTER_API(ResizeHashTable);
9272 JIM_REGISTER_API(GetHashTableIterator);
9273 JIM_REGISTER_API(NextHashEntry);
9274 JIM_REGISTER_API(NewObj);
9275 JIM_REGISTER_API(FreeObj);
9276 JIM_REGISTER_API(InvalidateStringRep);
9277 JIM_REGISTER_API(InitStringRep);
9278 JIM_REGISTER_API(DuplicateObj);
9279 JIM_REGISTER_API(GetString);
9280 JIM_REGISTER_API(Length);
9281 JIM_REGISTER_API(InvalidateStringRep);
9282 JIM_REGISTER_API(NewStringObj);
9283 JIM_REGISTER_API(NewStringObjNoAlloc);
9284 JIM_REGISTER_API(AppendString);
9285 JIM_REGISTER_API(AppendString_sprintf);
9286 JIM_REGISTER_API(AppendObj);
9287 JIM_REGISTER_API(AppendStrings);
9288 JIM_REGISTER_API(StringEqObj);
9289 JIM_REGISTER_API(StringMatchObj);
9290 JIM_REGISTER_API(StringRangeObj);
9291 JIM_REGISTER_API(FormatString);
9292 JIM_REGISTER_API(CompareStringImmediate);
9293 JIM_REGISTER_API(NewReference);
9294 JIM_REGISTER_API(GetReference);
9295 JIM_REGISTER_API(SetFinalizer);
9296 JIM_REGISTER_API(GetFinalizer);
9297 JIM_REGISTER_API(CreateInterp);
9298 JIM_REGISTER_API(FreeInterp);
9299 JIM_REGISTER_API(GetExitCode);
9300 JIM_REGISTER_API(SetStdin);
9301 JIM_REGISTER_API(SetStdout);
9302 JIM_REGISTER_API(SetStderr);
9303 JIM_REGISTER_API(CreateCommand);
9304 JIM_REGISTER_API(CreateProcedure);
9305 JIM_REGISTER_API(DeleteCommand);
9306 JIM_REGISTER_API(RenameCommand);
9307 JIM_REGISTER_API(GetCommand);
9308 JIM_REGISTER_API(SetVariable);
9309 JIM_REGISTER_API(SetVariableStr);
9310 JIM_REGISTER_API(SetGlobalVariableStr);
9311 JIM_REGISTER_API(SetVariableStrWithStr);
9312 JIM_REGISTER_API(SetVariableLink);
9313 JIM_REGISTER_API(GetVariable);
9314 JIM_REGISTER_API(GetCallFrameByLevel);
9315 JIM_REGISTER_API(Collect);
9316 JIM_REGISTER_API(CollectIfNeeded);
9317 JIM_REGISTER_API(GetIndex);
9318 JIM_REGISTER_API(NewListObj);
9319 JIM_REGISTER_API(ListAppendElement);
9320 JIM_REGISTER_API(ListAppendList);
9321 JIM_REGISTER_API(ListLength);
9322 JIM_REGISTER_API(ListIndex);
9323 JIM_REGISTER_API(SetListIndex);
9324 JIM_REGISTER_API(ConcatObj);
9325 JIM_REGISTER_API(NewDictObj);
9326 JIM_REGISTER_API(DictKey);
9327 JIM_REGISTER_API(DictKeysVector);
9328 JIM_REGISTER_API(GetIndex);
9329 JIM_REGISTER_API(GetReturnCode);
9330 JIM_REGISTER_API(EvalExpression);
9331 JIM_REGISTER_API(GetBoolFromExpr);
9332 JIM_REGISTER_API(GetWide);
9333 JIM_REGISTER_API(GetLong);
9334 JIM_REGISTER_API(SetWide);
9335 JIM_REGISTER_API(NewIntObj);
9336 JIM_REGISTER_API(GetDouble);
9337 JIM_REGISTER_API(SetDouble);
9338 JIM_REGISTER_API(NewDoubleObj);
9339 JIM_REGISTER_API(WrongNumArgs);
9340 JIM_REGISTER_API(SetDictKeysVector);
9341 JIM_REGISTER_API(SubstObj);
9342 JIM_REGISTER_API(RegisterApi);
9343 JIM_REGISTER_API(PrintErrorMessage);
9344 JIM_REGISTER_API(InteractivePrompt);
9345 JIM_REGISTER_API(RegisterCoreCommands);
9346 JIM_REGISTER_API(GetSharedString);
9347 JIM_REGISTER_API(ReleaseSharedString);
9348 JIM_REGISTER_API(Panic);
9349 JIM_REGISTER_API(StrDup);
9350 JIM_REGISTER_API(UnsetVariable);
9351 JIM_REGISTER_API(GetVariableStr);
9352 JIM_REGISTER_API(GetGlobalVariable);
9353 JIM_REGISTER_API(GetGlobalVariableStr);
9354 JIM_REGISTER_API(GetAssocData);
9355 JIM_REGISTER_API(SetAssocData);
9356 JIM_REGISTER_API(DeleteAssocData);
9357 JIM_REGISTER_API(GetEnum);
9358 JIM_REGISTER_API(ScriptIsComplete);
9359 JIM_REGISTER_API(PackageRequire);
9360 JIM_REGISTER_API(PackageProvide);
9361 JIM_REGISTER_API(InitStack);
9362 JIM_REGISTER_API(FreeStack);
9363 JIM_REGISTER_API(StackLen);
9364 JIM_REGISTER_API(StackPush);
9365 JIM_REGISTER_API(StackPop);
9366 JIM_REGISTER_API(StackPeek);
9367 JIM_REGISTER_API(FreeStackElements);
9368 JIM_REGISTER_API(fprintf);
9369 JIM_REGISTER_API(vfprintf);
9370 JIM_REGISTER_API(fwrite);
9371 JIM_REGISTER_API(fread);
9372 JIM_REGISTER_API(fflush);
9373 JIM_REGISTER_API(fgets);
9374 JIM_REGISTER_API(GetNvp);
9375 JIM_REGISTER_API(Nvp_name2value);
9376 JIM_REGISTER_API(Nvp_name2value_simple);
9377 JIM_REGISTER_API(Nvp_name2value_obj);
9378 JIM_REGISTER_API(Nvp_name2value_nocase);
9379 JIM_REGISTER_API(Nvp_name2value_obj_nocase);
9381 JIM_REGISTER_API(Nvp_value2name);
9382 JIM_REGISTER_API(Nvp_value2name_simple);
9383 JIM_REGISTER_API(Nvp_value2name_obj);
9385 JIM_REGISTER_API(GetOpt_Setup);
9386 JIM_REGISTER_API(GetOpt_Debug);
9387 JIM_REGISTER_API(GetOpt_Obj);
9388 JIM_REGISTER_API(GetOpt_String);
9389 JIM_REGISTER_API(GetOpt_Double);
9390 JIM_REGISTER_API(GetOpt_Wide);
9391 JIM_REGISTER_API(GetOpt_Nvp);
9392 JIM_REGISTER_API(GetOpt_NvpUnknown);
9393 JIM_REGISTER_API(GetOpt_Enum);
9395 JIM_REGISTER_API(Debug_ArgvString);
9396 JIM_REGISTER_API(SetResult_sprintf);
9397 JIM_REGISTER_API(SetResult_NvpUnknown);
9401 /* -----------------------------------------------------------------------------
9402 * Core commands utility functions
9403 * ---------------------------------------------------------------------------*/
9404 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv,
9405 const char *msg)
9407 int i;
9408 Jim_Obj *objPtr = Jim_NewEmptyStringObj(interp);
9410 Jim_AppendString(interp, objPtr, "wrong # args: should be \"", -1);
9411 for (i = 0; i < argc; i++) {
9412 Jim_AppendObj(interp, objPtr, argv[i]);
9413 if (!(i + 1 == argc && msg[0] == '\0'))
9414 Jim_AppendString(interp, objPtr, " ", 1);
9416 Jim_AppendString(interp, objPtr, msg, -1);
9417 Jim_AppendString(interp, objPtr, "\"", 1);
9418 Jim_SetResult(interp, objPtr);
9421 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr)
9423 Jim_HashTableIterator *htiter;
9424 Jim_HashEntry *he;
9425 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
9426 const char *pattern;
9427 int patternLen=0;
9429 pattern = patternObjPtr ? Jim_GetString(patternObjPtr, &patternLen) : NULL;
9430 htiter = Jim_GetHashTableIterator(&interp->commands);
9431 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
9432 if (pattern && !JimStringMatch(pattern, patternLen, he->key,
9433 strlen((const char*)he->key), 0))
9434 continue;
9435 Jim_ListAppendElement(interp, listObjPtr,
9436 Jim_NewStringObj(interp, he->key, -1));
9438 Jim_FreeHashTableIterator(htiter);
9439 return listObjPtr;
9442 #define JIM_VARLIST_GLOBALS 0
9443 #define JIM_VARLIST_LOCALS 1
9444 #define JIM_VARLIST_VARS 2
9446 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr,
9447 int mode)
9449 Jim_HashTableIterator *htiter;
9450 Jim_HashEntry *he;
9451 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
9452 const char *pattern;
9453 int patternLen=0;
9455 pattern = patternObjPtr ? Jim_GetString(patternObjPtr, &patternLen) : NULL;
9456 if (mode == JIM_VARLIST_GLOBALS) {
9457 htiter = Jim_GetHashTableIterator(&interp->topFramePtr->vars);
9458 } else {
9459 /* For [info locals], if we are at top level an emtpy list
9460 * is returned. I don't agree, but we aim at compatibility (SS) */
9461 if (mode == JIM_VARLIST_LOCALS &&
9462 interp->framePtr == interp->topFramePtr)
9463 return listObjPtr;
9464 htiter = Jim_GetHashTableIterator(&interp->framePtr->vars);
9466 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
9467 Jim_Var *varPtr = (Jim_Var*) he->val;
9468 if (mode == JIM_VARLIST_LOCALS) {
9469 if (varPtr->linkFramePtr != NULL)
9470 continue;
9472 if (pattern && !JimStringMatch(pattern, patternLen, he->key,
9473 strlen((const char*)he->key), 0))
9474 continue;
9475 Jim_ListAppendElement(interp, listObjPtr,
9476 Jim_NewStringObj(interp, he->key, -1));
9478 Jim_FreeHashTableIterator(htiter);
9479 return listObjPtr;
9482 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
9483 Jim_Obj **objPtrPtr)
9485 Jim_CallFrame *targetCallFrame;
9487 if (JimGetCallFrameByInteger(interp, levelObjPtr, &targetCallFrame)
9488 != JIM_OK)
9489 return JIM_ERR;
9490 /* No proc call at toplevel callframe */
9491 if (targetCallFrame == interp->topFramePtr) {
9492 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
9493 Jim_AppendStrings(interp, Jim_GetResult(interp),
9494 "bad level \"",
9495 Jim_GetString(levelObjPtr, NULL), "\"", NULL);
9496 return JIM_ERR;
9498 *objPtrPtr = Jim_NewListObj(interp,
9499 targetCallFrame->argv,
9500 targetCallFrame->argc);
9501 return JIM_OK;
9504 /* -----------------------------------------------------------------------------
9505 * Core commands
9506 * ---------------------------------------------------------------------------*/
9508 /* fake [puts] -- not the real puts, just for debugging. */
9509 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc,
9510 Jim_Obj *const *argv)
9512 const char *str;
9513 int len, nonewline = 0;
9515 if (argc != 2 && argc != 3) {
9516 Jim_WrongNumArgs(interp, 1, argv, "-nonewline string");
9517 return JIM_ERR;
9519 if (argc == 3) {
9520 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline"))
9522 Jim_SetResultString(interp, "The second argument must "
9523 "be -nonewline", -1);
9524 return JIM_OK;
9525 } else {
9526 nonewline = 1;
9527 argv++;
9530 str = Jim_GetString(argv[1], &len);
9531 Jim_fwrite(interp, str, 1, len, interp->cookie_stdout);
9532 if (!nonewline) Jim_fprintf(interp, interp->cookie_stdout, JIM_NL);
9533 return JIM_OK;
9536 /* Helper for [+] and [*] */
9537 static int Jim_AddMulHelper(Jim_Interp *interp, int argc,
9538 Jim_Obj *const *argv, int op)
9540 jim_wide wideValue, res;
9541 double doubleValue, doubleRes;
9542 int i;
9544 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
9546 for (i = 1; i < argc; i++) {
9547 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
9548 goto trydouble;
9549 if (op == JIM_EXPROP_ADD)
9550 res += wideValue;
9551 else
9552 res *= wideValue;
9554 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9555 return JIM_OK;
9556 trydouble:
9557 doubleRes = (double) res;
9558 for (;i < argc; i++) {
9559 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
9560 return JIM_ERR;
9561 if (op == JIM_EXPROP_ADD)
9562 doubleRes += doubleValue;
9563 else
9564 doubleRes *= doubleValue;
9566 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
9567 return JIM_OK;
9570 /* Helper for [-] and [/] */
9571 static int Jim_SubDivHelper(Jim_Interp *interp, int argc,
9572 Jim_Obj *const *argv, int op)
9574 jim_wide wideValue, res = 0;
9575 double doubleValue, doubleRes = 0;
9576 int i = 2;
9578 if (argc < 2) {
9579 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
9580 return JIM_ERR;
9581 } else if (argc == 2) {
9582 /* The arity = 2 case is different. For [- x] returns -x,
9583 * while [/ x] returns 1/x. */
9584 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
9585 if (Jim_GetDouble(interp, argv[1], &doubleValue) !=
9586 JIM_OK)
9588 return JIM_ERR;
9589 } else {
9590 if (op == JIM_EXPROP_SUB)
9591 doubleRes = -doubleValue;
9592 else
9593 doubleRes = 1.0/doubleValue;
9594 Jim_SetResult(interp, Jim_NewDoubleObj(interp,
9595 doubleRes));
9596 return JIM_OK;
9599 if (op == JIM_EXPROP_SUB) {
9600 res = -wideValue;
9601 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9602 } else {
9603 doubleRes = 1.0/wideValue;
9604 Jim_SetResult(interp, Jim_NewDoubleObj(interp,
9605 doubleRes));
9607 return JIM_OK;
9608 } else {
9609 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
9610 if (Jim_GetDouble(interp, argv[1], &doubleRes)
9611 != JIM_OK) {
9612 return JIM_ERR;
9613 } else {
9614 goto trydouble;
9618 for (i = 2; i < argc; i++) {
9619 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
9620 doubleRes = (double) res;
9621 goto trydouble;
9623 if (op == JIM_EXPROP_SUB)
9624 res -= wideValue;
9625 else
9626 res /= wideValue;
9628 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9629 return JIM_OK;
9630 trydouble:
9631 for (;i < argc; i++) {
9632 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
9633 return JIM_ERR;
9634 if (op == JIM_EXPROP_SUB)
9635 doubleRes -= doubleValue;
9636 else
9637 doubleRes /= doubleValue;
9639 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
9640 return JIM_OK;
9644 /* [+] */
9645 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc,
9646 Jim_Obj *const *argv)
9648 return Jim_AddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
9651 /* [*] */
9652 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc,
9653 Jim_Obj *const *argv)
9655 return Jim_AddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
9658 /* [-] */
9659 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc,
9660 Jim_Obj *const *argv)
9662 return Jim_SubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
9665 /* [/] */
9666 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc,
9667 Jim_Obj *const *argv)
9669 return Jim_SubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
9672 /* [set] */
9673 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc,
9674 Jim_Obj *const *argv)
9676 if (argc != 2 && argc != 3) {
9677 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
9678 return JIM_ERR;
9680 if (argc == 2) {
9681 Jim_Obj *objPtr;
9682 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
9683 if (!objPtr)
9684 return JIM_ERR;
9685 Jim_SetResult(interp, objPtr);
9686 return JIM_OK;
9688 /* argc == 3 case. */
9689 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
9690 return JIM_ERR;
9691 Jim_SetResult(interp, argv[2]);
9692 return JIM_OK;
9695 /* [unset] */
9696 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc,
9697 Jim_Obj *const *argv)
9699 int i;
9701 if (argc < 2) {
9702 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
9703 return JIM_ERR;
9705 for (i = 1; i < argc; i++) {
9706 if (Jim_UnsetVariable(interp, argv[i], JIM_ERRMSG) != JIM_OK)
9707 return JIM_ERR;
9709 return JIM_OK;
9712 /* [incr] */
9713 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc,
9714 Jim_Obj *const *argv)
9716 jim_wide wideValue, increment = 1;
9717 Jim_Obj *intObjPtr;
9719 if (argc != 2 && argc != 3) {
9720 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
9721 return JIM_ERR;
9723 if (argc == 3) {
9724 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
9725 return JIM_ERR;
9727 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
9728 if (!intObjPtr) return JIM_ERR;
9729 if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK)
9730 return JIM_ERR;
9731 if (Jim_IsShared(intObjPtr)) {
9732 intObjPtr = Jim_NewIntObj(interp, wideValue + increment);
9733 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
9734 Jim_FreeNewObj(interp, intObjPtr);
9735 return JIM_ERR;
9737 } else {
9738 Jim_SetWide(interp, intObjPtr, wideValue + increment);
9739 /* The following step is required in order to invalidate the
9740 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
9741 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
9742 return JIM_ERR;
9745 Jim_SetResult(interp, intObjPtr);
9746 return JIM_OK;
9749 /* [while] */
9750 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc,
9751 Jim_Obj *const *argv)
9753 if (argc != 3) {
9754 Jim_WrongNumArgs(interp, 1, argv, "condition body");
9755 return JIM_ERR;
9757 /* Try to run a specialized version of while if the expression
9758 * is in one of the following forms:
9760 * $a < CONST, $a < $b
9761 * $a <= CONST, $a <= $b
9762 * $a > CONST, $a > $b
9763 * $a >= CONST, $a >= $b
9764 * $a != CONST, $a != $b
9765 * $a == CONST, $a == $b
9766 * $a
9767 * !$a
9768 * CONST
9771 #ifdef JIM_OPTIMIZATION
9773 ExprByteCode *expr;
9774 Jim_Obj *varAObjPtr = NULL, *varBObjPtr = NULL, *objPtr;
9775 int exprLen, retval;
9777 /* STEP 1 -- Check if there are the conditions to run the specialized
9778 * version of while */
9780 if ((expr = Jim_GetExpression(interp, argv[1])) == NULL) goto noopt;
9781 if (expr->len <= 0 || expr->len > 3) goto noopt;
9782 switch (expr->len) {
9783 case 1:
9784 if (expr->opcode[0] != JIM_EXPROP_VARIABLE &&
9785 expr->opcode[0] != JIM_EXPROP_NUMBER)
9786 goto noopt;
9787 break;
9788 case 2:
9789 if (expr->opcode[1] != JIM_EXPROP_NOT ||
9790 expr->opcode[0] != JIM_EXPROP_VARIABLE)
9791 goto noopt;
9792 break;
9793 case 3:
9794 if (expr->opcode[0] != JIM_EXPROP_VARIABLE ||
9795 (expr->opcode[1] != JIM_EXPROP_NUMBER &&
9796 expr->opcode[1] != JIM_EXPROP_VARIABLE))
9797 goto noopt;
9798 switch (expr->opcode[2]) {
9799 case JIM_EXPROP_LT:
9800 case JIM_EXPROP_LTE:
9801 case JIM_EXPROP_GT:
9802 case JIM_EXPROP_GTE:
9803 case JIM_EXPROP_NUMEQ:
9804 case JIM_EXPROP_NUMNE:
9805 /* nothing to do */
9806 break;
9807 default:
9808 goto noopt;
9810 break;
9811 default:
9812 Jim_Panic(interp,
9813 "Unexpected default reached in Jim_WhileCoreCommand()");
9814 break;
9817 /* STEP 2 -- conditions meet. Initialization. Take different
9818 * branches for different expression lengths. */
9819 exprLen = expr->len;
9821 if (exprLen == 1) {
9822 jim_wide wideValue=0;
9824 if (expr->opcode[0] == JIM_EXPROP_VARIABLE) {
9825 varAObjPtr = expr->obj[0];
9826 Jim_IncrRefCount(varAObjPtr);
9827 } else {
9828 if (Jim_GetWide(interp, expr->obj[0], &wideValue) != JIM_OK)
9829 goto noopt;
9831 while (1) {
9832 if (varAObjPtr) {
9833 if (!(objPtr =
9834 Jim_GetVariable(interp, varAObjPtr, JIM_NONE)) ||
9835 Jim_GetWide(interp, objPtr, &wideValue) != JIM_OK)
9837 Jim_DecrRefCount(interp, varAObjPtr);
9838 goto noopt;
9841 if (!wideValue) break;
9842 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9843 switch (retval) {
9844 case JIM_BREAK:
9845 if (varAObjPtr)
9846 Jim_DecrRefCount(interp, varAObjPtr);
9847 goto out;
9848 break;
9849 case JIM_CONTINUE:
9850 continue;
9851 break;
9852 default:
9853 if (varAObjPtr)
9854 Jim_DecrRefCount(interp, varAObjPtr);
9855 return retval;
9859 if (varAObjPtr)
9860 Jim_DecrRefCount(interp, varAObjPtr);
9861 } else if (exprLen == 3) {
9862 jim_wide wideValueA, wideValueB=0, cmpRes = 0;
9863 int cmpType = expr->opcode[2];
9865 varAObjPtr = expr->obj[0];
9866 Jim_IncrRefCount(varAObjPtr);
9867 if (expr->opcode[1] == JIM_EXPROP_VARIABLE) {
9868 varBObjPtr = expr->obj[1];
9869 Jim_IncrRefCount(varBObjPtr);
9870 } else {
9871 if (Jim_GetWide(interp, expr->obj[1], &wideValueB) != JIM_OK)
9872 goto noopt;
9874 while (1) {
9875 if (!(objPtr = Jim_GetVariable(interp, varAObjPtr, JIM_NONE)) ||
9876 Jim_GetWide(interp, objPtr, &wideValueA) != JIM_OK)
9878 Jim_DecrRefCount(interp, varAObjPtr);
9879 if (varBObjPtr)
9880 Jim_DecrRefCount(interp, varBObjPtr);
9881 goto noopt;
9883 if (varBObjPtr) {
9884 if (!(objPtr =
9885 Jim_GetVariable(interp, varBObjPtr, JIM_NONE)) ||
9886 Jim_GetWide(interp, objPtr, &wideValueB) != JIM_OK)
9888 Jim_DecrRefCount(interp, varAObjPtr);
9889 if (varBObjPtr)
9890 Jim_DecrRefCount(interp, varBObjPtr);
9891 goto noopt;
9894 switch (cmpType) {
9895 case JIM_EXPROP_LT:
9896 cmpRes = wideValueA < wideValueB; break;
9897 case JIM_EXPROP_LTE:
9898 cmpRes = wideValueA <= wideValueB; break;
9899 case JIM_EXPROP_GT:
9900 cmpRes = wideValueA > wideValueB; break;
9901 case JIM_EXPROP_GTE:
9902 cmpRes = wideValueA >= wideValueB; break;
9903 case JIM_EXPROP_NUMEQ:
9904 cmpRes = wideValueA == wideValueB; break;
9905 case JIM_EXPROP_NUMNE:
9906 cmpRes = wideValueA != wideValueB; break;
9908 if (!cmpRes) break;
9909 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9910 switch (retval) {
9911 case JIM_BREAK:
9912 Jim_DecrRefCount(interp, varAObjPtr);
9913 if (varBObjPtr)
9914 Jim_DecrRefCount(interp, varBObjPtr);
9915 goto out;
9916 break;
9917 case JIM_CONTINUE:
9918 continue;
9919 break;
9920 default:
9921 Jim_DecrRefCount(interp, varAObjPtr);
9922 if (varBObjPtr)
9923 Jim_DecrRefCount(interp, varBObjPtr);
9924 return retval;
9928 Jim_DecrRefCount(interp, varAObjPtr);
9929 if (varBObjPtr)
9930 Jim_DecrRefCount(interp, varBObjPtr);
9931 } else {
9932 /* TODO: case for len == 2 */
9933 goto noopt;
9935 Jim_SetEmptyResult(interp);
9936 return JIM_OK;
9938 noopt:
9939 #endif
9941 /* The general purpose implementation of while starts here */
9942 while (1) {
9943 int boolean, retval;
9945 if ((retval = Jim_GetBoolFromExpr(interp, argv[1],
9946 &boolean)) != JIM_OK)
9947 return retval;
9948 if (!boolean) break;
9949 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9950 switch (retval) {
9951 case JIM_BREAK:
9952 goto out;
9953 break;
9954 case JIM_CONTINUE:
9955 continue;
9956 break;
9957 default:
9958 return retval;
9962 out:
9963 Jim_SetEmptyResult(interp);
9964 return JIM_OK;
9967 /* [for] */
9968 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc,
9969 Jim_Obj *const *argv)
9971 int retval;
9973 if (argc != 5) {
9974 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
9975 return JIM_ERR;
9977 /* Check if the for is on the form:
9978 * for {set i CONST} {$i < CONST} {incr i}
9979 * for {set i CONST} {$i < $j} {incr i}
9980 * for {set i CONST} {$i <= CONST} {incr i}
9981 * for {set i CONST} {$i <= $j} {incr i}
9982 * XXX: NOTE: if variable traces are implemented, this optimization
9983 * need to be modified to check for the proc epoch at every variable
9984 * update. */
9985 #ifdef JIM_OPTIMIZATION
9987 ScriptObj *initScript, *incrScript;
9988 ExprByteCode *expr;
9989 jim_wide start, stop=0, currentVal;
9990 unsigned jim_wide procEpoch = interp->procEpoch;
9991 Jim_Obj *varNamePtr, *stopVarNamePtr = NULL, *objPtr;
9992 int cmpType;
9993 struct Jim_Cmd *cmdPtr;
9995 /* Do it only if there aren't shared arguments */
9996 if (argv[1] == argv[2] || argv[2] == argv[3] || argv[1] == argv[3])
9997 goto evalstart;
9998 initScript = Jim_GetScript(interp, argv[1]);
9999 expr = Jim_GetExpression(interp, argv[2]);
10000 incrScript = Jim_GetScript(interp, argv[3]);
10002 /* Ensure proper lengths to start */
10003 if (initScript->len != 6) goto evalstart;
10004 if (incrScript->len != 4) goto evalstart;
10005 if (expr->len != 3) goto evalstart;
10006 /* Ensure proper token types. */
10007 if (initScript->token[2].type != JIM_TT_ESC ||
10008 initScript->token[4].type != JIM_TT_ESC ||
10009 incrScript->token[2].type != JIM_TT_ESC ||
10010 expr->opcode[0] != JIM_EXPROP_VARIABLE ||
10011 (expr->opcode[1] != JIM_EXPROP_NUMBER &&
10012 expr->opcode[1] != JIM_EXPROP_VARIABLE) ||
10013 (expr->opcode[2] != JIM_EXPROP_LT &&
10014 expr->opcode[2] != JIM_EXPROP_LTE))
10015 goto evalstart;
10016 cmpType = expr->opcode[2];
10017 /* Initialization command must be [set] */
10018 cmdPtr = Jim_GetCommand(interp, initScript->token[0].objPtr, JIM_NONE);
10019 if (cmdPtr == NULL || cmdPtr->cmdProc != Jim_SetCoreCommand)
10020 goto evalstart;
10021 /* Update command must be incr */
10022 cmdPtr = Jim_GetCommand(interp, incrScript->token[0].objPtr, JIM_NONE);
10023 if (cmdPtr == NULL || cmdPtr->cmdProc != Jim_IncrCoreCommand)
10024 goto evalstart;
10025 /* set, incr, expression must be about the same variable */
10026 if (!Jim_StringEqObj(initScript->token[2].objPtr,
10027 incrScript->token[2].objPtr, 0))
10028 goto evalstart;
10029 if (!Jim_StringEqObj(initScript->token[2].objPtr,
10030 expr->obj[0], 0))
10031 goto evalstart;
10032 /* Check that the initialization and comparison are valid integers */
10033 if (Jim_GetWide(interp, initScript->token[4].objPtr, &start) == JIM_ERR)
10034 goto evalstart;
10035 if (expr->opcode[1] == JIM_EXPROP_NUMBER &&
10036 Jim_GetWide(interp, expr->obj[1], &stop) == JIM_ERR)
10038 goto evalstart;
10041 /* Initialization */
10042 varNamePtr = expr->obj[0];
10043 if (expr->opcode[1] == JIM_EXPROP_VARIABLE) {
10044 stopVarNamePtr = expr->obj[1];
10045 Jim_IncrRefCount(stopVarNamePtr);
10047 Jim_IncrRefCount(varNamePtr);
10049 /* --- OPTIMIZED FOR --- */
10050 /* Start to loop */
10051 objPtr = Jim_NewIntObj(interp, start);
10052 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
10053 Jim_DecrRefCount(interp, varNamePtr);
10054 if (stopVarNamePtr) Jim_DecrRefCount(interp, stopVarNamePtr);
10055 Jim_FreeNewObj(interp, objPtr);
10056 goto evalstart;
10058 while (1) {
10059 /* === Check condition === */
10060 /* Common code: */
10061 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
10062 if (objPtr == NULL ||
10063 Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK)
10065 Jim_DecrRefCount(interp, varNamePtr);
10066 if (stopVarNamePtr) Jim_DecrRefCount(interp, stopVarNamePtr);
10067 goto testcond;
10069 /* Immediate or Variable? get the 'stop' value if the latter. */
10070 if (stopVarNamePtr) {
10071 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
10072 if (objPtr == NULL ||
10073 Jim_GetWide(interp, objPtr, &stop) != JIM_OK)
10075 Jim_DecrRefCount(interp, varNamePtr);
10076 Jim_DecrRefCount(interp, stopVarNamePtr);
10077 goto testcond;
10080 if (cmpType == JIM_EXPROP_LT) {
10081 if (currentVal >= stop) break;
10082 } else {
10083 if (currentVal > stop) break;
10085 /* Eval body */
10086 if ((retval = Jim_EvalObj(interp, argv[4])) != JIM_OK) {
10087 switch (retval) {
10088 case JIM_BREAK:
10089 if (stopVarNamePtr)
10090 Jim_DecrRefCount(interp, stopVarNamePtr);
10091 Jim_DecrRefCount(interp, varNamePtr);
10092 goto out;
10093 case JIM_CONTINUE:
10094 /* nothing to do */
10095 break;
10096 default:
10097 if (stopVarNamePtr)
10098 Jim_DecrRefCount(interp, stopVarNamePtr);
10099 Jim_DecrRefCount(interp, varNamePtr);
10100 return retval;
10103 /* If there was a change in procedures/command continue
10104 * with the usual [for] command implementation */
10105 if (procEpoch != interp->procEpoch) {
10106 if (stopVarNamePtr)
10107 Jim_DecrRefCount(interp, stopVarNamePtr);
10108 Jim_DecrRefCount(interp, varNamePtr);
10109 goto evalnext;
10111 /* Increment */
10112 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
10113 if (objPtr->refCount == 1 && objPtr->typePtr == &intObjType) {
10114 objPtr->internalRep.wideValue ++;
10115 Jim_InvalidateStringRep(objPtr);
10116 } else {
10117 Jim_Obj *auxObjPtr;
10119 if (Jim_GetWide(interp, objPtr, &currentVal) == JIM_ERR) {
10120 if (stopVarNamePtr)
10121 Jim_DecrRefCount(interp, stopVarNamePtr);
10122 Jim_DecrRefCount(interp, varNamePtr);
10123 goto evalnext;
10125 auxObjPtr = Jim_NewIntObj(interp, currentVal + 1);
10126 if (Jim_SetVariable(interp, varNamePtr, auxObjPtr) == JIM_ERR) {
10127 if (stopVarNamePtr)
10128 Jim_DecrRefCount(interp, stopVarNamePtr);
10129 Jim_DecrRefCount(interp, varNamePtr);
10130 Jim_FreeNewObj(interp, auxObjPtr);
10131 goto evalnext;
10135 if (stopVarNamePtr)
10136 Jim_DecrRefCount(interp, stopVarNamePtr);
10137 Jim_DecrRefCount(interp, varNamePtr);
10138 Jim_SetEmptyResult(interp);
10139 return JIM_OK;
10141 #endif
10142 evalstart:
10143 /* Eval start */
10144 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK)
10145 return retval;
10146 while (1) {
10147 int boolean;
10148 testcond:
10149 /* Test the condition */
10150 if ((retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean))
10151 != JIM_OK)
10152 return retval;
10153 if (!boolean) break;
10154 /* Eval body */
10155 if ((retval = Jim_EvalObj(interp, argv[4])) != JIM_OK) {
10156 switch (retval) {
10157 case JIM_BREAK:
10158 goto out;
10159 break;
10160 case JIM_CONTINUE:
10161 /* Nothing to do */
10162 break;
10163 default:
10164 return retval;
10167 evalnext:
10168 /* Eval next */
10169 if ((retval = Jim_EvalObj(interp, argv[3])) != JIM_OK) {
10170 switch (retval) {
10171 case JIM_BREAK:
10172 goto out;
10173 break;
10174 case JIM_CONTINUE:
10175 continue;
10176 break;
10177 default:
10178 return retval;
10182 out:
10183 Jim_SetEmptyResult(interp);
10184 return JIM_OK;
10187 /* foreach + lmap implementation. */
10188 static int JimForeachMapHelper(Jim_Interp *interp, int argc,
10189 Jim_Obj *const *argv, int doMap)
10191 int result = JIM_ERR, i, nbrOfLists, *listsIdx, *listsEnd;
10192 int nbrOfLoops = 0;
10193 Jim_Obj *emptyStr, *script, *mapRes = NULL;
10195 if (argc < 4 || argc % 2 != 0) {
10196 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
10197 return JIM_ERR;
10199 if (doMap) {
10200 mapRes = Jim_NewListObj(interp, NULL, 0);
10201 Jim_IncrRefCount(mapRes);
10203 emptyStr = Jim_NewEmptyStringObj(interp);
10204 Jim_IncrRefCount(emptyStr);
10205 script = argv[argc-1]; /* Last argument is a script */
10206 nbrOfLists = (argc - 1 - 1) / 2; /* argc - 'foreach' - script */
10207 listsIdx = (int*)Jim_Alloc(nbrOfLists * sizeof(int));
10208 listsEnd = (int*)Jim_Alloc(nbrOfLists*2 * sizeof(int));
10209 /* Initialize iterators and remember max nbr elements each list */
10210 memset(listsIdx, 0, nbrOfLists * sizeof(int));
10211 /* Remember lengths of all lists and calculate how much rounds to loop */
10212 for (i = 0; i < nbrOfLists*2; i += 2) {
10213 div_t cnt;
10214 int count;
10215 Jim_ListLength(interp, argv[i + 1], &listsEnd[i]);
10216 Jim_ListLength(interp, argv[i + 2], &listsEnd[i + 1]);
10217 if (listsEnd[i] == 0) {
10218 Jim_SetResultString(interp, "foreach varlist is empty", -1);
10219 goto err;
10221 cnt = div(listsEnd[i + 1], listsEnd[i]);
10222 count = cnt.quot + (cnt.rem ? 1 : 0);
10223 if (count > nbrOfLoops)
10224 nbrOfLoops = count;
10226 for (; nbrOfLoops-- > 0;) {
10227 for (i = 0; i < nbrOfLists; ++i) {
10228 int varIdx = 0, var = i * 2;
10229 while (varIdx < listsEnd[var]) {
10230 Jim_Obj *varName, *ele;
10231 int lst = i * 2 + 1;
10232 if (Jim_ListIndex(interp, argv[var + 1], varIdx, &varName, JIM_ERRMSG)
10233 != JIM_OK)
10234 goto err;
10235 if (listsIdx[i] < listsEnd[lst]) {
10236 if (Jim_ListIndex(interp, argv[lst + 1], listsIdx[i], &ele, JIM_ERRMSG)
10237 != JIM_OK)
10238 goto err;
10239 if (Jim_SetVariable(interp, varName, ele) != JIM_OK) {
10240 Jim_SetResultString(interp, "couldn't set loop variable: ", -1);
10241 goto err;
10243 ++listsIdx[i]; /* Remember next iterator of current list */
10244 } else if (Jim_SetVariable(interp, varName, emptyStr) != JIM_OK) {
10245 Jim_SetResultString(interp, "couldn't set loop variable: ", -1);
10246 goto err;
10248 ++varIdx; /* Next variable */
10251 switch (result = Jim_EvalObj(interp, script)) {
10252 case JIM_OK:
10253 if (doMap)
10254 Jim_ListAppendElement(interp, mapRes, interp->result);
10255 break;
10256 case JIM_CONTINUE:
10257 break;
10258 case JIM_BREAK:
10259 goto out;
10260 break;
10261 default:
10262 goto err;
10265 out:
10266 result = JIM_OK;
10267 if (doMap)
10268 Jim_SetResult(interp, mapRes);
10269 else
10270 Jim_SetEmptyResult(interp);
10271 err:
10272 if (doMap)
10273 Jim_DecrRefCount(interp, mapRes);
10274 Jim_DecrRefCount(interp, emptyStr);
10275 Jim_Free(listsIdx);
10276 Jim_Free(listsEnd);
10277 return result;
10280 /* [foreach] */
10281 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc,
10282 Jim_Obj *const *argv)
10284 return JimForeachMapHelper(interp, argc, argv, 0);
10287 /* [lmap] */
10288 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc,
10289 Jim_Obj *const *argv)
10291 return JimForeachMapHelper(interp, argc, argv, 1);
10294 /* [if] */
10295 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc,
10296 Jim_Obj *const *argv)
10298 int boolean, retval, current = 1, falsebody = 0;
10299 if (argc >= 3) {
10300 while (1) {
10301 /* Far not enough arguments given! */
10302 if (current >= argc) goto err;
10303 if ((retval = Jim_GetBoolFromExpr(interp,
10304 argv[current++], &boolean))
10305 != JIM_OK)
10306 return retval;
10307 /* There lacks something, isn't it? */
10308 if (current >= argc) goto err;
10309 if (Jim_CompareStringImmediate(interp, argv[current],
10310 "then")) current++;
10311 /* Tsk tsk, no then-clause? */
10312 if (current >= argc) goto err;
10313 if (boolean)
10314 return Jim_EvalObj(interp, argv[current]);
10315 /* Ok: no else-clause follows */
10316 if (++current >= argc) {
10317 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10318 return JIM_OK;
10320 falsebody = current++;
10321 if (Jim_CompareStringImmediate(interp, argv[falsebody],
10322 "else")) {
10323 /* IIICKS - else-clause isn't last cmd? */
10324 if (current != argc-1) goto err;
10325 return Jim_EvalObj(interp, argv[current]);
10326 } else if (Jim_CompareStringImmediate(interp,
10327 argv[falsebody], "elseif"))
10328 /* Ok: elseif follows meaning all the stuff
10329 * again (how boring...) */
10330 continue;
10331 /* OOPS - else-clause is not last cmd?*/
10332 else if (falsebody != argc-1)
10333 goto err;
10334 return Jim_EvalObj(interp, argv[falsebody]);
10336 return JIM_OK;
10338 err:
10339 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
10340 return JIM_ERR;
10343 enum {SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD, SWITCH_UNKNOWN};
10345 /* [switch] */
10346 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc,
10347 Jim_Obj *const *argv)
10349 int retcode = JIM_ERR, matchOpt = SWITCH_EXACT, opt = 1, patCount, i;
10350 Jim_Obj *command = 0, *const *caseList = 0, *strObj;
10351 Jim_Obj *script = 0;
10352 if (argc < 3) goto wrongnumargs;
10353 for (opt = 1; opt < argc; ++opt) {
10354 const char *option = Jim_GetString(argv[opt], 0);
10355 if (*option != '-') break;
10356 else if (strncmp(option, "--", 2) == 0) { ++opt; break; }
10357 else if (strncmp(option, "-exact", 2) == 0) matchOpt = SWITCH_EXACT;
10358 else if (strncmp(option, "-glob", 2) == 0) matchOpt = SWITCH_GLOB;
10359 else if (strncmp(option, "-regexp", 2) == 0) matchOpt = SWITCH_RE;
10360 else if (strncmp(option, "-command", 2) == 0) { matchOpt = SWITCH_CMD;
10361 if ((argc - opt) < 2) goto wrongnumargs;
10362 command = argv[++opt];
10363 } else {
10364 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10365 Jim_AppendStrings(interp, Jim_GetResult(interp),
10366 "bad option \"", option, "\": must be -exact, -glob, "
10367 "-regexp, -command procname or --", 0);
10368 goto err;
10370 if ((argc - opt) < 2) goto wrongnumargs;
10372 strObj = argv[opt++];
10373 patCount = argc - opt;
10374 if (patCount == 1) {
10375 Jim_Obj **vector;
10376 JimListGetElements(interp, argv[opt], &patCount, &vector);
10377 caseList = vector;
10378 } else
10379 caseList = &argv[opt];
10380 if (patCount == 0 || patCount % 2 != 0) goto wrongnumargs;
10381 for (i = 0; script == 0 && i < patCount; i += 2) {
10382 Jim_Obj *patObj = caseList[i];
10383 if (!Jim_CompareStringImmediate(interp, patObj, "default")
10384 || i < (patCount-2)) {
10385 switch (matchOpt) {
10386 case SWITCH_EXACT:
10387 if (Jim_StringEqObj(strObj, patObj, 0))
10388 script = caseList[i + 1];
10389 break;
10390 case SWITCH_GLOB:
10391 if (Jim_StringMatchObj(patObj, strObj, 0))
10392 script = caseList[i + 1];
10393 break;
10394 case SWITCH_RE:
10395 command = Jim_NewStringObj(interp, "regexp", -1);
10396 /* Fall thru intentionally */
10397 case SWITCH_CMD: {
10398 Jim_Obj *parms[] = {command, patObj, strObj};
10399 int rc = Jim_EvalObjVector(interp, 3, parms);
10400 long matching;
10401 /* After the execution of a command we need to
10402 * make sure to reconvert the object into a list
10403 * again. Only for the single-list style [switch]. */
10404 if (argc-opt == 1) {
10405 Jim_Obj **vector;
10406 JimListGetElements(interp, argv[opt], &patCount,
10407 &vector);
10408 caseList = vector;
10410 /* command is here already decref'd */
10411 if (rc != JIM_OK) {
10412 retcode = rc;
10413 goto err;
10415 rc = Jim_GetLong(interp, Jim_GetResult(interp), &matching);
10416 if (rc != JIM_OK) {
10417 retcode = rc;
10418 goto err;
10420 if (matching)
10421 script = caseList[i + 1];
10422 break;
10424 default:
10425 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10426 Jim_AppendStrings(interp, Jim_GetResult(interp),
10427 "internal error: no such option implemented", 0);
10428 goto err;
10430 } else {
10431 script = caseList[i + 1];
10434 for (; i < patCount && Jim_CompareStringImmediate(interp, script, "-");
10435 i += 2)
10436 script = caseList[i + 1];
10437 if (script && Jim_CompareStringImmediate(interp, script, "-")) {
10438 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10439 Jim_AppendStrings(interp, Jim_GetResult(interp),
10440 "no body specified for pattern \"",
10441 Jim_GetString(caseList[i-2], 0), "\"", 0);
10442 goto err;
10444 retcode = JIM_OK;
10445 Jim_SetEmptyResult(interp);
10446 if (script != 0)
10447 retcode = Jim_EvalObj(interp, script);
10448 return retcode;
10449 wrongnumargs:
10450 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
10451 "pattern body ... ?default body? or "
10452 "{pattern body ?pattern body ...?}");
10453 err:
10454 return retcode;
10457 /* [list] */
10458 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc,
10459 Jim_Obj *const *argv)
10461 Jim_Obj *listObjPtr;
10463 listObjPtr = Jim_NewListObj(interp, argv + 1, argc-1);
10464 Jim_SetResult(interp, listObjPtr);
10465 return JIM_OK;
10468 /* [lindex] */
10469 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc,
10470 Jim_Obj *const *argv)
10472 Jim_Obj *objPtr, *listObjPtr;
10473 int i;
10474 int index;
10476 if (argc < 3) {
10477 Jim_WrongNumArgs(interp, 1, argv, "list index ?...?");
10478 return JIM_ERR;
10480 objPtr = argv[1];
10481 Jim_IncrRefCount(objPtr);
10482 for (i = 2; i < argc; i++) {
10483 listObjPtr = objPtr;
10484 if (Jim_GetIndex(interp, argv[i], &index) != JIM_OK) {
10485 Jim_DecrRefCount(interp, listObjPtr);
10486 return JIM_ERR;
10488 if (Jim_ListIndex(interp, listObjPtr, index, &objPtr,
10489 JIM_NONE) != JIM_OK) {
10490 /* Returns an empty object if the index
10491 * is out of range. */
10492 Jim_DecrRefCount(interp, listObjPtr);
10493 Jim_SetEmptyResult(interp);
10494 return JIM_OK;
10496 Jim_IncrRefCount(objPtr);
10497 Jim_DecrRefCount(interp, listObjPtr);
10499 Jim_SetResult(interp, objPtr);
10500 Jim_DecrRefCount(interp, objPtr);
10501 return JIM_OK;
10504 /* [llength] */
10505 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc,
10506 Jim_Obj *const *argv)
10508 int len;
10510 if (argc != 2) {
10511 Jim_WrongNumArgs(interp, 1, argv, "list");
10512 return JIM_ERR;
10514 Jim_ListLength(interp, argv[1], &len);
10515 Jim_SetResult(interp, Jim_NewIntObj(interp, len));
10516 return JIM_OK;
10519 /* [lappend] */
10520 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc,
10521 Jim_Obj *const *argv)
10523 Jim_Obj *listObjPtr;
10524 int shared, i;
10526 if (argc < 2) {
10527 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
10528 return JIM_ERR;
10530 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_NONE);
10531 if (!listObjPtr) {
10532 /* Create the list if it does not exists */
10533 listObjPtr = Jim_NewListObj(interp, NULL, 0);
10534 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
10535 Jim_FreeNewObj(interp, listObjPtr);
10536 return JIM_ERR;
10539 shared = Jim_IsShared(listObjPtr);
10540 if (shared)
10541 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
10542 for (i = 2; i < argc; i++)
10543 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
10544 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
10545 if (shared)
10546 Jim_FreeNewObj(interp, listObjPtr);
10547 return JIM_ERR;
10549 Jim_SetResult(interp, listObjPtr);
10550 return JIM_OK;
10553 /* [linsert] */
10554 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc,
10555 Jim_Obj *const *argv)
10557 int index, len;
10558 Jim_Obj *listPtr;
10560 if (argc < 4) {
10561 Jim_WrongNumArgs(interp, 1, argv, "list index element "
10562 "?element ...?");
10563 return JIM_ERR;
10565 listPtr = argv[1];
10566 if (Jim_IsShared(listPtr))
10567 listPtr = Jim_DuplicateObj(interp, listPtr);
10568 if (Jim_GetIndex(interp, argv[2], &index) != JIM_OK)
10569 goto err;
10570 Jim_ListLength(interp, listPtr, &len);
10571 if (index >= len)
10572 index = len;
10573 else if (index < 0)
10574 index = len + index + 1;
10575 Jim_ListInsertElements(interp, listPtr, index, argc-3, &argv[3]);
10576 Jim_SetResult(interp, listPtr);
10577 return JIM_OK;
10578 err:
10579 if (listPtr != argv[1]) {
10580 Jim_FreeNewObj(interp, listPtr);
10582 return JIM_ERR;
10585 /* [lset] */
10586 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc,
10587 Jim_Obj *const *argv)
10589 if (argc < 3) {
10590 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
10591 return JIM_ERR;
10592 } else if (argc == 3) {
10593 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
10594 return JIM_ERR;
10595 Jim_SetResult(interp, argv[2]);
10596 return JIM_OK;
10598 if (Jim_SetListIndex(interp, argv[1], argv + 2, argc-3, argv[argc-1])
10599 == JIM_ERR) return JIM_ERR;
10600 return JIM_OK;
10603 /* [lsort] */
10604 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
10606 const char *options[] = {
10607 "-ascii", "-nocase", "-increasing", "-decreasing", NULL
10609 enum {OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING};
10610 Jim_Obj *resObj;
10611 int i, lsortType = JIM_LSORT_ASCII; /* default sort type */
10612 int decreasing = 0;
10614 if (argc < 2) {
10615 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
10616 return JIM_ERR;
10618 for (i = 1; i < (argc-1); i++) {
10619 int option;
10621 if (Jim_GetEnum(interp, argv[i], options, &option, "option", JIM_ERRMSG)
10622 != JIM_OK)
10623 return JIM_ERR;
10624 switch (option) {
10625 case OPT_ASCII: lsortType = JIM_LSORT_ASCII; break;
10626 case OPT_NOCASE: lsortType = JIM_LSORT_NOCASE; break;
10627 case OPT_INCREASING: decreasing = 0; break;
10628 case OPT_DECREASING: decreasing = 1; break;
10631 if (decreasing) {
10632 switch (lsortType) {
10633 case JIM_LSORT_ASCII: lsortType = JIM_LSORT_ASCII_DECR; break;
10634 case JIM_LSORT_NOCASE: lsortType = JIM_LSORT_NOCASE_DECR; break;
10637 resObj = Jim_DuplicateObj(interp, argv[argc-1]);
10638 ListSortElements(interp, resObj, lsortType);
10639 Jim_SetResult(interp, resObj);
10640 return JIM_OK;
10643 /* [append] */
10644 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc,
10645 Jim_Obj *const *argv)
10647 Jim_Obj *stringObjPtr;
10648 int shared, i;
10650 if (argc < 2) {
10651 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
10652 return JIM_ERR;
10654 if (argc == 2) {
10655 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
10656 if (!stringObjPtr) return JIM_ERR;
10657 } else {
10658 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_NONE);
10659 if (!stringObjPtr) {
10660 /* Create the string if it does not exists */
10661 stringObjPtr = Jim_NewEmptyStringObj(interp);
10662 if (Jim_SetVariable(interp, argv[1], stringObjPtr)
10663 != JIM_OK) {
10664 Jim_FreeNewObj(interp, stringObjPtr);
10665 return JIM_ERR;
10669 shared = Jim_IsShared(stringObjPtr);
10670 if (shared)
10671 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
10672 for (i = 2; i < argc; i++)
10673 Jim_AppendObj(interp, stringObjPtr, argv[i]);
10674 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
10675 if (shared)
10676 Jim_FreeNewObj(interp, stringObjPtr);
10677 return JIM_ERR;
10679 Jim_SetResult(interp, stringObjPtr);
10680 return JIM_OK;
10683 /* [debug] */
10684 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc,
10685 Jim_Obj *const *argv)
10687 const char *options[] = {
10688 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
10689 "exprbc",
10690 NULL
10692 enum {
10693 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
10694 OPT_EXPRLEN, OPT_EXPRBC
10696 int option;
10698 if (argc < 2) {
10699 Jim_WrongNumArgs(interp, 1, argv, "option ?...?");
10700 return JIM_ERR;
10702 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
10703 JIM_ERRMSG) != JIM_OK)
10704 return JIM_ERR;
10705 if (option == OPT_REFCOUNT) {
10706 if (argc != 3) {
10707 Jim_WrongNumArgs(interp, 2, argv, "object");
10708 return JIM_ERR;
10710 Jim_SetResult(interp, Jim_NewIntObj(interp, argv[2]->refCount));
10711 return JIM_OK;
10712 } else if (option == OPT_OBJCOUNT) {
10713 int freeobj = 0, liveobj = 0;
10714 char buf[256];
10715 Jim_Obj *objPtr;
10717 if (argc != 2) {
10718 Jim_WrongNumArgs(interp, 2, argv, "");
10719 return JIM_ERR;
10721 /* Count the number of free objects. */
10722 objPtr = interp->freeList;
10723 while (objPtr) {
10724 freeobj++;
10725 objPtr = objPtr->nextObjPtr;
10727 /* Count the number of live objects. */
10728 objPtr = interp->liveList;
10729 while (objPtr) {
10730 liveobj++;
10731 objPtr = objPtr->nextObjPtr;
10733 /* Set the result string and return. */
10734 sprintf(buf, "free %d used %d", freeobj, liveobj);
10735 Jim_SetResultString(interp, buf, -1);
10736 return JIM_OK;
10737 } else if (option == OPT_OBJECTS) {
10738 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
10739 /* Count the number of live objects. */
10740 objPtr = interp->liveList;
10741 listObjPtr = Jim_NewListObj(interp, NULL, 0);
10742 while (objPtr) {
10743 char buf[128];
10744 const char *type = objPtr->typePtr ?
10745 objPtr->typePtr->name : "";
10746 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
10747 sprintf(buf, "%p", objPtr);
10748 Jim_ListAppendElement(interp, subListObjPtr,
10749 Jim_NewStringObj(interp, buf, -1));
10750 Jim_ListAppendElement(interp, subListObjPtr,
10751 Jim_NewStringObj(interp, type, -1));
10752 Jim_ListAppendElement(interp, subListObjPtr,
10753 Jim_NewIntObj(interp, objPtr->refCount));
10754 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
10755 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
10756 objPtr = objPtr->nextObjPtr;
10758 Jim_SetResult(interp, listObjPtr);
10759 return JIM_OK;
10760 } else if (option == OPT_INVSTR) {
10761 Jim_Obj *objPtr;
10763 if (argc != 3) {
10764 Jim_WrongNumArgs(interp, 2, argv, "object");
10765 return JIM_ERR;
10767 objPtr = argv[2];
10768 if (objPtr->typePtr != NULL)
10769 Jim_InvalidateStringRep(objPtr);
10770 Jim_SetEmptyResult(interp);
10771 return JIM_OK;
10772 } else if (option == OPT_SCRIPTLEN) {
10773 ScriptObj *script;
10774 if (argc != 3) {
10775 Jim_WrongNumArgs(interp, 2, argv, "script");
10776 return JIM_ERR;
10778 script = Jim_GetScript(interp, argv[2]);
10779 Jim_SetResult(interp, Jim_NewIntObj(interp, script->len));
10780 return JIM_OK;
10781 } else if (option == OPT_EXPRLEN) {
10782 ExprByteCode *expr;
10783 if (argc != 3) {
10784 Jim_WrongNumArgs(interp, 2, argv, "expression");
10785 return JIM_ERR;
10787 expr = Jim_GetExpression(interp, argv[2]);
10788 if (expr == NULL)
10789 return JIM_ERR;
10790 Jim_SetResult(interp, Jim_NewIntObj(interp, expr->len));
10791 return JIM_OK;
10792 } else if (option == OPT_EXPRBC) {
10793 Jim_Obj *objPtr;
10794 ExprByteCode *expr;
10795 int i;
10797 if (argc != 3) {
10798 Jim_WrongNumArgs(interp, 2, argv, "expression");
10799 return JIM_ERR;
10801 expr = Jim_GetExpression(interp, argv[2]);
10802 if (expr == NULL)
10803 return JIM_ERR;
10804 objPtr = Jim_NewListObj(interp, NULL, 0);
10805 for (i = 0; i < expr->len; i++) {
10806 const char *type;
10807 Jim_ExprOperator *op;
10809 switch (expr->opcode[i]) {
10810 case JIM_EXPROP_NUMBER: type = "number"; break;
10811 case JIM_EXPROP_COMMAND: type = "command"; break;
10812 case JIM_EXPROP_VARIABLE: type = "variable"; break;
10813 case JIM_EXPROP_DICTSUGAR: type = "dictsugar"; break;
10814 case JIM_EXPROP_SUBST: type = "subst"; break;
10815 case JIM_EXPROP_STRING: type = "string"; break;
10816 default:
10817 op = JimExprOperatorInfo(Jim_GetString(expr->obj[i], NULL));
10818 if (op == NULL) {
10819 type = "private";
10820 } else {
10821 type = "operator";
10823 break;
10825 Jim_ListAppendElement(interp, objPtr,
10826 Jim_NewStringObj(interp, type, -1));
10827 Jim_ListAppendElement(interp, objPtr, expr->obj[i]);
10829 Jim_SetResult(interp, objPtr);
10830 return JIM_OK;
10831 } else {
10832 Jim_SetResultString(interp,
10833 "bad option. Valid options are refcount, "
10834 "objcount, objects, invstr", -1);
10835 return JIM_ERR;
10837 return JIM_OK; /* unreached */
10840 /* [eval] */
10841 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc,
10842 Jim_Obj *const *argv)
10844 if (argc == 2) {
10845 return Jim_EvalObj(interp, argv[1]);
10846 } else if (argc > 2) {
10847 Jim_Obj *objPtr;
10848 int retcode;
10850 objPtr = Jim_ConcatObj(interp, argc-1, argv + 1);
10851 Jim_IncrRefCount(objPtr);
10852 retcode = Jim_EvalObj(interp, objPtr);
10853 Jim_DecrRefCount(interp, objPtr);
10854 return retcode;
10855 } else {
10856 Jim_WrongNumArgs(interp, 1, argv, "script ?...?");
10857 return JIM_ERR;
10861 /* [uplevel] */
10862 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc,
10863 Jim_Obj *const *argv)
10865 if (argc >= 2) {
10866 int retcode, newLevel, oldLevel;
10867 Jim_CallFrame *savedCallFrame, *targetCallFrame;
10868 Jim_Obj *objPtr;
10869 const char *str;
10871 /* Save the old callframe pointer */
10872 savedCallFrame = interp->framePtr;
10874 /* Lookup the target frame pointer */
10875 str = Jim_GetString(argv[1], NULL);
10876 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#')
10878 if (Jim_GetCallFrameByLevel(interp, argv[1],
10879 &targetCallFrame,
10880 &newLevel) != JIM_OK)
10881 return JIM_ERR;
10882 argc--;
10883 argv++;
10884 } else {
10885 if (Jim_GetCallFrameByLevel(interp, NULL,
10886 &targetCallFrame,
10887 &newLevel) != JIM_OK)
10888 return JIM_ERR;
10890 if (argc < 2) {
10891 argc++;
10892 argv--;
10893 Jim_WrongNumArgs(interp, 1, argv,
10894 "?level? command ?arg ...?");
10895 return JIM_ERR;
10897 /* Eval the code in the target callframe. */
10898 interp->framePtr = targetCallFrame;
10899 oldLevel = interp->numLevels;
10900 interp->numLevels = newLevel;
10901 if (argc == 2) {
10902 retcode = Jim_EvalObj(interp, argv[1]);
10903 } else {
10904 objPtr = Jim_ConcatObj(interp, argc-1, argv + 1);
10905 Jim_IncrRefCount(objPtr);
10906 retcode = Jim_EvalObj(interp, objPtr);
10907 Jim_DecrRefCount(interp, objPtr);
10909 interp->numLevels = oldLevel;
10910 interp->framePtr = savedCallFrame;
10911 return retcode;
10912 } else {
10913 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
10914 return JIM_ERR;
10918 /* [expr] */
10919 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc,
10920 Jim_Obj *const *argv)
10922 Jim_Obj *exprResultPtr;
10923 int retcode;
10925 if (argc == 2) {
10926 retcode = Jim_EvalExpression(interp, argv[1], &exprResultPtr);
10927 } else if (argc > 2) {
10928 Jim_Obj *objPtr;
10930 objPtr = Jim_ConcatObj(interp, argc-1, argv + 1);
10931 Jim_IncrRefCount(objPtr);
10932 retcode = Jim_EvalExpression(interp, objPtr, &exprResultPtr);
10933 Jim_DecrRefCount(interp, objPtr);
10934 } else {
10935 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
10936 return JIM_ERR;
10938 if (retcode != JIM_OK) return retcode;
10939 Jim_SetResult(interp, exprResultPtr);
10940 Jim_DecrRefCount(interp, exprResultPtr);
10941 return JIM_OK;
10944 /* [break] */
10945 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc,
10946 Jim_Obj *const *argv)
10948 if (argc != 1) {
10949 Jim_WrongNumArgs(interp, 1, argv, "");
10950 return JIM_ERR;
10952 return JIM_BREAK;
10955 /* [continue] */
10956 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc,
10957 Jim_Obj *const *argv)
10959 if (argc != 1) {
10960 Jim_WrongNumArgs(interp, 1, argv, "");
10961 return JIM_ERR;
10963 return JIM_CONTINUE;
10966 /* [return] */
10967 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc,
10968 Jim_Obj *const *argv)
10970 if (argc == 1) {
10971 return JIM_RETURN;
10972 } else if (argc == 2) {
10973 Jim_SetResult(interp, argv[1]);
10974 interp->returnCode = JIM_OK;
10975 return JIM_RETURN;
10976 } else if (argc == 3 || argc == 4) {
10977 int returnCode;
10978 if (Jim_GetReturnCode(interp, argv[2], &returnCode) == JIM_ERR)
10979 return JIM_ERR;
10980 interp->returnCode = returnCode;
10981 if (argc == 4)
10982 Jim_SetResult(interp, argv[3]);
10983 return JIM_RETURN;
10984 } else {
10985 Jim_WrongNumArgs(interp, 1, argv, "?-code code? ?result?");
10986 return JIM_ERR;
10988 return JIM_RETURN; /* unreached */
10991 /* [tailcall] */
10992 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc,
10993 Jim_Obj *const *argv)
10995 Jim_Obj *objPtr;
10997 objPtr = Jim_NewListObj(interp, argv + 1, argc-1);
10998 Jim_SetResult(interp, objPtr);
10999 return JIM_EVAL;
11002 /* [proc] */
11003 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc,
11004 Jim_Obj *const *argv)
11006 int argListLen;
11007 int arityMin, arityMax;
11009 if (argc != 4 && argc != 5) {
11010 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
11011 return JIM_ERR;
11013 Jim_ListLength(interp, argv[2], &argListLen);
11014 arityMin = arityMax = argListLen + 1;
11016 if (argListLen) {
11017 const char *str;
11018 int len;
11019 Jim_Obj *argPtr=NULL;
11021 /* Check for 'args' and adjust arityMin and arityMax if necessary */
11022 Jim_ListIndex(interp, argv[2], argListLen-1, &argPtr, JIM_NONE);
11023 str = Jim_GetString(argPtr, &len);
11024 if (len == 4 && memcmp(str, "args", 4) == 0) {
11025 arityMin--;
11026 arityMax = -1;
11029 /* Check for default arguments and reduce arityMin if necessary */
11030 while (arityMin > 1) {
11031 int len;
11032 Jim_ListIndex(interp, argv[2], arityMin - 2, &argPtr, JIM_NONE);
11033 Jim_ListLength(interp, argPtr, &len);
11034 if (len != 2) {
11035 /* No default argument */
11036 break;
11038 arityMin--;
11041 if (argc == 4) {
11042 return Jim_CreateProcedure(interp, Jim_GetString(argv[1], NULL),
11043 argv[2], NULL, argv[3], arityMin, arityMax);
11044 } else {
11045 return Jim_CreateProcedure(interp, Jim_GetString(argv[1], NULL),
11046 argv[2], argv[3], argv[4], arityMin, arityMax);
11050 /* [concat] */
11051 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc,
11052 Jim_Obj *const *argv)
11054 Jim_SetResult(interp, Jim_ConcatObj(interp, argc-1, argv + 1));
11055 return JIM_OK;
11058 /* [upvar] */
11059 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc,
11060 Jim_Obj *const *argv)
11062 const char *str;
11063 int i;
11064 Jim_CallFrame *targetCallFrame;
11066 /* Lookup the target frame pointer */
11067 str = Jim_GetString(argv[1], NULL);
11068 if (argc > 3 &&
11069 ((str[0] >= '0' && str[0] <= '9') || str[0] == '#'))
11071 if (Jim_GetCallFrameByLevel(interp, argv[1],
11072 &targetCallFrame, NULL) != JIM_OK)
11073 return JIM_ERR;
11074 argc--;
11075 argv++;
11076 } else {
11077 if (Jim_GetCallFrameByLevel(interp, NULL,
11078 &targetCallFrame, NULL) != JIM_OK)
11079 return JIM_ERR;
11081 /* Check for arity */
11082 if (argc < 3 || ((argc-1)%2) != 0) {
11083 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
11084 return JIM_ERR;
11086 /* Now... for every other/local couple: */
11087 for (i = 1; i < argc; i += 2) {
11088 if (Jim_SetVariableLink(interp, argv[i + 1], argv[i],
11089 targetCallFrame) != JIM_OK) return JIM_ERR;
11091 return JIM_OK;
11094 /* [global] */
11095 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc,
11096 Jim_Obj *const *argv)
11098 int i;
11100 if (argc < 2) {
11101 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
11102 return JIM_ERR;
11104 /* Link every var to the toplevel having the same name */
11105 if (interp->numLevels == 0) return JIM_OK; /* global at toplevel... */
11106 for (i = 1; i < argc; i++) {
11107 if (Jim_SetVariableLink(interp, argv[i], argv[i],
11108 interp->topFramePtr) != JIM_OK) return JIM_ERR;
11110 return JIM_OK;
11113 /* does the [string map] operation. On error NULL is returned,
11114 * otherwise a new string object with the result, having refcount = 0,
11115 * is returned. */
11116 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
11117 Jim_Obj *objPtr, int nocase)
11119 int numMaps;
11120 const char **key, *str, *noMatchStart = NULL;
11121 Jim_Obj **value;
11122 int *keyLen, strLen, i;
11123 Jim_Obj *resultObjPtr;
11125 Jim_ListLength(interp, mapListObjPtr, &numMaps);
11126 if (numMaps % 2) {
11127 Jim_SetResultString(interp,
11128 "list must contain an even number of elements", -1);
11129 return NULL;
11131 /* Initialization */
11132 numMaps /= 2;
11133 key = Jim_Alloc(sizeof(char*)*numMaps);
11134 keyLen = Jim_Alloc(sizeof(int)*numMaps);
11135 value = Jim_Alloc(sizeof(Jim_Obj*)*numMaps);
11136 resultObjPtr = Jim_NewStringObj(interp, "", 0);
11137 for (i = 0; i < numMaps; i++) {
11138 Jim_Obj *eleObjPtr=NULL;
11140 Jim_ListIndex(interp, mapListObjPtr, i*2, &eleObjPtr, JIM_NONE);
11141 key[i] = Jim_GetString(eleObjPtr, &keyLen[i]);
11142 Jim_ListIndex(interp, mapListObjPtr, i*2 + 1, &eleObjPtr, JIM_NONE);
11143 value[i] = eleObjPtr;
11145 str = Jim_GetString(objPtr, &strLen);
11146 /* Map it */
11147 while (strLen) {
11148 for (i = 0; i < numMaps; i++) {
11149 if (strLen >= keyLen[i] && keyLen[i]) {
11150 if (!JimStringCompare(str, keyLen[i], key[i], keyLen[i],
11151 nocase))
11153 if (noMatchStart) {
11154 Jim_AppendString(interp, resultObjPtr,
11155 noMatchStart, str-noMatchStart);
11156 noMatchStart = NULL;
11158 Jim_AppendObj(interp, resultObjPtr, value[i]);
11159 str += keyLen[i];
11160 strLen -= keyLen[i];
11161 break;
11165 if (i == numMaps) { /* no match */
11166 if (noMatchStart == NULL)
11167 noMatchStart = str;
11168 str ++;
11169 strLen --;
11172 if (noMatchStart) {
11173 Jim_AppendString(interp, resultObjPtr,
11174 noMatchStart, str-noMatchStart);
11176 Jim_Free((void*)key);
11177 Jim_Free(keyLen);
11178 Jim_Free(value);
11179 return resultObjPtr;
11182 /* [string] */
11183 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc,
11184 Jim_Obj *const *argv)
11186 int option;
11187 const char *options[] = {
11188 "length", "compare", "match", "equal", "range", "map", "repeat",
11189 "index", "first", "tolower", "toupper", NULL
11191 enum {
11192 OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_RANGE,
11193 OPT_MAP, OPT_REPEAT, OPT_INDEX, OPT_FIRST, OPT_TOLOWER, OPT_TOUPPER
11196 if (argc < 2) {
11197 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
11198 return JIM_ERR;
11200 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
11201 JIM_ERRMSG) != JIM_OK)
11202 return JIM_ERR;
11204 if (option == OPT_LENGTH) {
11205 int len;
11207 if (argc != 3) {
11208 Jim_WrongNumArgs(interp, 2, argv, "string");
11209 return JIM_ERR;
11211 Jim_GetString(argv[2], &len);
11212 Jim_SetResult(interp, Jim_NewIntObj(interp, len));
11213 return JIM_OK;
11214 } else if (option == OPT_COMPARE) {
11215 int nocase = 0;
11216 if ((argc != 4 && argc != 5) ||
11217 (argc == 5 && Jim_CompareStringImmediate(interp,
11218 argv[2], "-nocase") == 0)) {
11219 Jim_WrongNumArgs(interp, 2, argv, "string1 string2");
11220 return JIM_ERR;
11222 if (argc == 5) {
11223 nocase = 1;
11224 argv++;
11226 Jim_SetResult(interp, Jim_NewIntObj(interp,
11227 Jim_StringCompareObj(argv[2],
11228 argv[3], nocase)));
11229 return JIM_OK;
11230 } else if (option == OPT_MATCH) {
11231 int nocase = 0;
11232 if ((argc != 4 && argc != 5) ||
11233 (argc == 5 && Jim_CompareStringImmediate(interp,
11234 argv[2], "-nocase") == 0)) {
11235 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern "
11236 "string");
11237 return JIM_ERR;
11239 if (argc == 5) {
11240 nocase = 1;
11241 argv++;
11243 Jim_SetResult(interp,
11244 Jim_NewIntObj(interp, Jim_StringMatchObj(argv[2],
11245 argv[3], nocase)));
11246 return JIM_OK;
11247 } else if (option == OPT_EQUAL) {
11248 if (argc != 4) {
11249 Jim_WrongNumArgs(interp, 2, argv, "string1 string2");
11250 return JIM_ERR;
11252 Jim_SetResult(interp,
11253 Jim_NewIntObj(interp, Jim_StringEqObj(argv[2],
11254 argv[3], 0)));
11255 return JIM_OK;
11256 } else if (option == OPT_RANGE) {
11257 Jim_Obj *objPtr;
11259 if (argc != 5) {
11260 Jim_WrongNumArgs(interp, 2, argv, "string first last");
11261 return JIM_ERR;
11263 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
11264 if (objPtr == NULL)
11265 return JIM_ERR;
11266 Jim_SetResult(interp, objPtr);
11267 return JIM_OK;
11268 } else if (option == OPT_MAP) {
11269 int nocase = 0;
11270 Jim_Obj *objPtr;
11272 if ((argc != 4 && argc != 5) ||
11273 (argc == 5 && Jim_CompareStringImmediate(interp,
11274 argv[2], "-nocase") == 0)) {
11275 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList "
11276 "string");
11277 return JIM_ERR;
11279 if (argc == 5) {
11280 nocase = 1;
11281 argv++;
11283 objPtr = JimStringMap(interp, argv[2], argv[3], nocase);
11284 if (objPtr == NULL)
11285 return JIM_ERR;
11286 Jim_SetResult(interp, objPtr);
11287 return JIM_OK;
11288 } else if (option == OPT_REPEAT) {
11289 Jim_Obj *objPtr;
11290 jim_wide count;
11292 if (argc != 4) {
11293 Jim_WrongNumArgs(interp, 2, argv, "string count");
11294 return JIM_ERR;
11296 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK)
11297 return JIM_ERR;
11298 objPtr = Jim_NewStringObj(interp, "", 0);
11299 while (count--) {
11300 Jim_AppendObj(interp, objPtr, argv[2]);
11302 Jim_SetResult(interp, objPtr);
11303 return JIM_OK;
11304 } else if (option == OPT_INDEX) {
11305 int index, len;
11306 const char *str;
11308 if (argc != 4) {
11309 Jim_WrongNumArgs(interp, 2, argv, "string index");
11310 return JIM_ERR;
11312 if (Jim_GetIndex(interp, argv[3], &index) != JIM_OK)
11313 return JIM_ERR;
11314 str = Jim_GetString(argv[2], &len);
11315 if (index != INT_MIN && index != INT_MAX)
11316 index = JimRelToAbsIndex(len, index);
11317 if (index < 0 || index >= len) {
11318 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11319 return JIM_OK;
11320 } else {
11321 Jim_SetResult(interp, Jim_NewStringObj(interp, str + index, 1));
11322 return JIM_OK;
11324 } else if (option == OPT_FIRST) {
11325 int index = 0, l1, l2;
11326 const char *s1, *s2;
11328 if (argc != 4 && argc != 5) {
11329 Jim_WrongNumArgs(interp, 2, argv, "subString string ?startIndex?");
11330 return JIM_ERR;
11332 s1 = Jim_GetString(argv[2], &l1);
11333 s2 = Jim_GetString(argv[3], &l2);
11334 if (argc == 5) {
11335 if (Jim_GetIndex(interp, argv[4], &index) != JIM_OK)
11336 return JIM_ERR;
11337 index = JimRelToAbsIndex(l2, index);
11339 Jim_SetResult(interp, Jim_NewIntObj(interp,
11340 JimStringFirst(s1, l1, s2, l2, index)));
11341 return JIM_OK;
11342 } else if (option == OPT_TOLOWER) {
11343 if (argc != 3) {
11344 Jim_WrongNumArgs(interp, 2, argv, "string");
11345 return JIM_ERR;
11347 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
11348 } else if (option == OPT_TOUPPER) {
11349 if (argc != 3) {
11350 Jim_WrongNumArgs(interp, 2, argv, "string");
11351 return JIM_ERR;
11353 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
11355 return JIM_OK;
11358 /* [time] */
11359 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc,
11360 Jim_Obj *const *argv)
11362 long i, count = 1;
11363 jim_wide start, elapsed;
11364 char buf [256];
11365 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
11367 if (argc < 2) {
11368 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
11369 return JIM_ERR;
11371 if (argc == 3) {
11372 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
11373 return JIM_ERR;
11375 if (count < 0)
11376 return JIM_OK;
11377 i = count;
11378 start = JimClock();
11379 while (i-- > 0) {
11380 int retval;
11382 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK)
11383 return retval;
11385 elapsed = JimClock() - start;
11386 sprintf(buf, fmt, elapsed/count);
11387 Jim_SetResultString(interp, buf, -1);
11388 return JIM_OK;
11391 /* [exit] */
11392 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc,
11393 Jim_Obj *const *argv)
11395 long exitCode = 0;
11397 if (argc > 2) {
11398 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
11399 return JIM_ERR;
11401 if (argc == 2) {
11402 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
11403 return JIM_ERR;
11405 interp->exitCode = exitCode;
11406 return JIM_EXIT;
11409 /* [catch] */
11410 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc,
11411 Jim_Obj *const *argv)
11413 int exitCode = 0;
11415 if (argc != 2 && argc != 3) {
11416 Jim_WrongNumArgs(interp, 1, argv, "script ?varName?");
11417 return JIM_ERR;
11419 exitCode = Jim_EvalObj(interp, argv[1]);
11420 if (argc == 3) {
11421 if (Jim_SetVariable(interp, argv[2], Jim_GetResult(interp))
11422 != JIM_OK)
11423 return JIM_ERR;
11425 Jim_SetResult(interp, Jim_NewIntObj(interp, exitCode));
11426 return JIM_OK;
11429 /* [ref] */
11430 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc,
11431 Jim_Obj *const *argv)
11433 if (argc != 3 && argc != 4) {
11434 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
11435 return JIM_ERR;
11437 if (argc == 3) {
11438 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
11439 } else {
11440 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2],
11441 argv[3]));
11443 return JIM_OK;
11446 /* [getref] */
11447 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc,
11448 Jim_Obj *const *argv)
11450 Jim_Reference *refPtr;
11452 if (argc != 2) {
11453 Jim_WrongNumArgs(interp, 1, argv, "reference");
11454 return JIM_ERR;
11456 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
11457 return JIM_ERR;
11458 Jim_SetResult(interp, refPtr->objPtr);
11459 return JIM_OK;
11462 /* [setref] */
11463 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc,
11464 Jim_Obj *const *argv)
11466 Jim_Reference *refPtr;
11468 if (argc != 3) {
11469 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
11470 return JIM_ERR;
11472 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
11473 return JIM_ERR;
11474 Jim_IncrRefCount(argv[2]);
11475 Jim_DecrRefCount(interp, refPtr->objPtr);
11476 refPtr->objPtr = argv[2];
11477 Jim_SetResult(interp, argv[2]);
11478 return JIM_OK;
11481 /* [collect] */
11482 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc,
11483 Jim_Obj *const *argv)
11485 if (argc != 1) {
11486 Jim_WrongNumArgs(interp, 1, argv, "");
11487 return JIM_ERR;
11489 Jim_SetResult(interp, Jim_NewIntObj(interp, Jim_Collect(interp)));
11490 return JIM_OK;
11493 /* [finalize] reference ?newValue? */
11494 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc,
11495 Jim_Obj *const *argv)
11497 if (argc != 2 && argc != 3) {
11498 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
11499 return JIM_ERR;
11501 if (argc == 2) {
11502 Jim_Obj *cmdNamePtr;
11504 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
11505 return JIM_ERR;
11506 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
11507 Jim_SetResult(interp, cmdNamePtr);
11508 } else {
11509 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
11510 return JIM_ERR;
11511 Jim_SetResult(interp, argv[2]);
11513 return JIM_OK;
11516 /* TODO */
11517 /* [info references] (list of all the references/finalizers) */
11519 /* [rename] */
11520 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc,
11521 Jim_Obj *const *argv)
11523 const char *oldName, *newName;
11525 if (argc != 3) {
11526 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
11527 return JIM_ERR;
11529 oldName = Jim_GetString(argv[1], NULL);
11530 newName = Jim_GetString(argv[2], NULL);
11531 if (Jim_RenameCommand(interp, oldName, newName) != JIM_OK) {
11532 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11533 Jim_AppendStrings(interp, Jim_GetResult(interp),
11534 "can't rename \"", oldName, "\": ",
11535 "command doesn't exist", NULL);
11536 return JIM_ERR;
11538 return JIM_OK;
11541 /* [dict] */
11542 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc,
11543 Jim_Obj *const *argv)
11545 int option;
11546 const char *options[] = {
11547 "create", "get", "set", "unset", "exists", NULL
11549 enum {
11550 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXIST
11553 if (argc < 2) {
11554 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
11555 return JIM_ERR;
11558 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
11559 JIM_ERRMSG) != JIM_OK)
11560 return JIM_ERR;
11562 if (option == OPT_CREATE) {
11563 Jim_Obj *objPtr;
11565 if (argc % 2) {
11566 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
11567 return JIM_ERR;
11569 objPtr = Jim_NewDictObj(interp, argv + 2, argc-2);
11570 Jim_SetResult(interp, objPtr);
11571 return JIM_OK;
11572 } else if (option == OPT_GET) {
11573 Jim_Obj *objPtr;
11575 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc-3, &objPtr,
11576 JIM_ERRMSG) != JIM_OK)
11577 return JIM_ERR;
11578 Jim_SetResult(interp, objPtr);
11579 return JIM_OK;
11580 } else if (option == OPT_SET) {
11581 if (argc < 5) {
11582 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
11583 return JIM_ERR;
11585 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc-4,
11586 argv[argc-1]);
11587 } else if (option == OPT_UNSET) {
11588 if (argc < 4) {
11589 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
11590 return JIM_ERR;
11592 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc-3,
11593 NULL);
11594 } else if (option == OPT_EXIST) {
11595 Jim_Obj *objPtr;
11596 int exists;
11598 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc-3, &objPtr,
11599 JIM_ERRMSG) == JIM_OK)
11600 exists = 1;
11601 else
11602 exists = 0;
11603 Jim_SetResult(interp, Jim_NewIntObj(interp, exists));
11604 return JIM_OK;
11605 } else {
11606 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11607 Jim_AppendStrings(interp, Jim_GetResult(interp),
11608 "bad option \"", Jim_GetString(argv[1], NULL), "\":",
11609 " must be create, get, set", NULL);
11610 return JIM_ERR;
11612 return JIM_OK;
11615 /* [load] */
11616 static int Jim_LoadCoreCommand(Jim_Interp *interp, int argc,
11617 Jim_Obj *const *argv)
11619 if (argc < 2) {
11620 Jim_WrongNumArgs(interp, 1, argv, "libaryFile");
11621 return JIM_ERR;
11623 return Jim_LoadLibrary(interp, Jim_GetString(argv[1], NULL));
11626 /* [subst] */
11627 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc,
11628 Jim_Obj *const *argv)
11630 int i, flags = 0;
11631 Jim_Obj *objPtr;
11633 if (argc < 2) {
11634 Jim_WrongNumArgs(interp, 1, argv,
11635 "?-nobackslashes? ?-nocommands? ?-novariables? string");
11636 return JIM_ERR;
11638 i = argc-2;
11639 while (i--) {
11640 if (Jim_CompareStringImmediate(interp, argv[i + 1],
11641 "-nobackslashes"))
11642 flags |= JIM_SUBST_NOESC;
11643 else if (Jim_CompareStringImmediate(interp, argv[i + 1],
11644 "-novariables"))
11645 flags |= JIM_SUBST_NOVAR;
11646 else if (Jim_CompareStringImmediate(interp, argv[i + 1],
11647 "-nocommands"))
11648 flags |= JIM_SUBST_NOCMD;
11649 else {
11650 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11651 Jim_AppendStrings(interp, Jim_GetResult(interp),
11652 "bad option \"", Jim_GetString(argv[i + 1], NULL),
11653 "\": must be -nobackslashes, -nocommands, or "
11654 "-novariables", NULL);
11655 return JIM_ERR;
11658 if (Jim_SubstObj(interp, argv[argc-1], &objPtr, flags) != JIM_OK)
11659 return JIM_ERR;
11660 Jim_SetResult(interp, objPtr);
11661 return JIM_OK;
11664 /* [info] */
11665 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc,
11666 Jim_Obj *const *argv)
11668 int cmd, result = JIM_OK;
11669 static const char *commands[] = {
11670 "body", "commands", "exists", "globals", "level", "locals",
11671 "vars", "version", "complete", "args", "hostname", NULL
11673 enum {INFO_BODY, INFO_COMMANDS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
11674 INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_COMPLETE, INFO_ARGS, INFO_HOSTNAME};
11676 if (argc < 2) {
11677 Jim_WrongNumArgs(interp, 1, argv, "command ?args ...?");
11678 return JIM_ERR;
11680 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "command", JIM_ERRMSG)
11681 != JIM_OK) {
11682 return JIM_ERR;
11685 if (cmd == INFO_COMMANDS) {
11686 if (argc != 2 && argc != 3) {
11687 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
11688 return JIM_ERR;
11690 if (argc == 3)
11691 Jim_SetResult(interp,JimCommandsList(interp, argv[2]));
11692 else
11693 Jim_SetResult(interp, JimCommandsList(interp, NULL));
11694 } else if (cmd == INFO_EXISTS) {
11695 Jim_Obj *exists;
11696 if (argc != 3) {
11697 Jim_WrongNumArgs(interp, 2, argv, "varName");
11698 return JIM_ERR;
11700 exists = Jim_GetVariable(interp, argv[2], 0);
11701 Jim_SetResult(interp, Jim_NewIntObj(interp, exists != 0));
11702 } else if (cmd == INFO_GLOBALS || cmd == INFO_LOCALS || cmd == INFO_VARS) {
11703 int mode;
11704 switch (cmd) {
11705 case INFO_GLOBALS: mode = JIM_VARLIST_GLOBALS; break;
11706 case INFO_LOCALS: mode = JIM_VARLIST_LOCALS; break;
11707 case INFO_VARS: mode = JIM_VARLIST_VARS; break;
11708 default: mode = 0; /* avoid warning */; break;
11710 if (argc != 2 && argc != 3) {
11711 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
11712 return JIM_ERR;
11714 if (argc == 3)
11715 Jim_SetResult(interp,JimVariablesList(interp, argv[2], mode));
11716 else
11717 Jim_SetResult(interp, JimVariablesList(interp, NULL, mode));
11718 } else if (cmd == INFO_LEVEL) {
11719 Jim_Obj *objPtr;
11720 switch (argc) {
11721 case 2:
11722 Jim_SetResult(interp,
11723 Jim_NewIntObj(interp, interp->numLevels));
11724 break;
11725 case 3:
11726 if (JimInfoLevel(interp, argv[2], &objPtr) != JIM_OK)
11727 return JIM_ERR;
11728 Jim_SetResult(interp, objPtr);
11729 break;
11730 default:
11731 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
11732 return JIM_ERR;
11734 } else if (cmd == INFO_BODY || cmd == INFO_ARGS) {
11735 Jim_Cmd *cmdPtr;
11737 if (argc != 3) {
11738 Jim_WrongNumArgs(interp, 2, argv, "procname");
11739 return JIM_ERR;
11741 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL)
11742 return JIM_ERR;
11743 if (cmdPtr->cmdProc != NULL) {
11744 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11745 Jim_AppendStrings(interp, Jim_GetResult(interp),
11746 "command \"", Jim_GetString(argv[2], NULL),
11747 "\" is not a procedure", NULL);
11748 return JIM_ERR;
11750 if (cmd == INFO_BODY)
11751 Jim_SetResult(interp, cmdPtr->bodyObjPtr);
11752 else
11753 Jim_SetResult(interp, cmdPtr->argListObjPtr);
11754 } else if (cmd == INFO_VERSION) {
11755 char buf[(JIM_INTEGER_SPACE * 2) + 1];
11756 sprintf(buf, "%d.%d",
11757 JIM_VERSION / 100, JIM_VERSION % 100);
11758 Jim_SetResultString(interp, buf, -1);
11759 } else if (cmd == INFO_COMPLETE) {
11760 const char *s;
11761 int len;
11763 if (argc != 3) {
11764 Jim_WrongNumArgs(interp, 2, argv, "script");
11765 return JIM_ERR;
11767 s = Jim_GetString(argv[2], &len);
11768 Jim_SetResult(interp,
11769 Jim_NewIntObj(interp, Jim_ScriptIsComplete(s, len, NULL)));
11770 } else if (cmd == INFO_HOSTNAME) {
11771 /* Redirect to os.hostname if it exists */
11772 Jim_Obj *command = Jim_NewStringObj(interp, "os.gethostname", -1);
11773 result = Jim_EvalObjVector(interp, 1, &command);
11775 return result;
11778 /* [split] */
11779 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc,
11780 Jim_Obj *const *argv)
11782 const char *str, *splitChars, *noMatchStart;
11783 int splitLen, strLen, i;
11784 Jim_Obj *resObjPtr;
11786 if (argc != 2 && argc != 3) {
11787 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
11788 return JIM_ERR;
11790 /* Init */
11791 if (argc == 2) {
11792 splitChars = " \n\t\r";
11793 splitLen = 4;
11794 } else {
11795 splitChars = Jim_GetString(argv[2], &splitLen);
11797 str = Jim_GetString(argv[1], &strLen);
11798 if (!strLen) return JIM_OK;
11799 noMatchStart = str;
11800 resObjPtr = Jim_NewListObj(interp, NULL, 0);
11801 /* Split */
11802 if (splitLen) {
11803 while (strLen) {
11804 for (i = 0; i < splitLen; i++) {
11805 if (*str == splitChars[i]) {
11806 Jim_Obj *objPtr;
11808 objPtr = Jim_NewStringObj(interp, noMatchStart,
11809 (str-noMatchStart));
11810 Jim_ListAppendElement(interp, resObjPtr, objPtr);
11811 noMatchStart = str + 1;
11812 break;
11815 str ++;
11816 strLen --;
11818 Jim_ListAppendElement(interp, resObjPtr,
11819 Jim_NewStringObj(interp, noMatchStart, (str-noMatchStart)));
11820 } else {
11821 /* This handles the special case of splitchars eq {}. This
11822 * is trivial but we want to perform object sharing as Tcl does. */
11823 Jim_Obj *objCache[256];
11824 const unsigned char *u = (unsigned char*) str;
11825 memset(objCache, 0, sizeof(objCache));
11826 for (i = 0; i < strLen; i++) {
11827 int c = u[i];
11829 if (objCache[c] == NULL)
11830 objCache[c] = Jim_NewStringObj(interp, (char*)u + i, 1);
11831 Jim_ListAppendElement(interp, resObjPtr, objCache[c]);
11834 Jim_SetResult(interp, resObjPtr);
11835 return JIM_OK;
11838 /* [join] */
11839 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc,
11840 Jim_Obj *const *argv)
11842 const char *joinStr;
11843 int joinStrLen, i, listLen;
11844 Jim_Obj *resObjPtr;
11846 if (argc != 2 && argc != 3) {
11847 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
11848 return JIM_ERR;
11850 /* Init */
11851 if (argc == 2) {
11852 joinStr = " ";
11853 joinStrLen = 1;
11854 } else {
11855 joinStr = Jim_GetString(argv[2], &joinStrLen);
11857 Jim_ListLength(interp, argv[1], &listLen);
11858 resObjPtr = Jim_NewStringObj(interp, NULL, 0);
11859 /* Split */
11860 for (i = 0; i < listLen; i++) {
11861 Jim_Obj *objPtr=NULL;
11863 Jim_ListIndex(interp, argv[1], i, &objPtr, JIM_NONE);
11864 Jim_AppendObj(interp, resObjPtr, objPtr);
11865 if (i + 1 != listLen) {
11866 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
11869 Jim_SetResult(interp, resObjPtr);
11870 return JIM_OK;
11873 /* [format] */
11874 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc,
11875 Jim_Obj *const *argv)
11877 Jim_Obj *objPtr;
11879 if (argc < 2) {
11880 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
11881 return JIM_ERR;
11883 objPtr = Jim_FormatString(interp, argv[1], argc-2, argv + 2);
11884 if (objPtr == NULL)
11885 return JIM_ERR;
11886 Jim_SetResult(interp, objPtr);
11887 return JIM_OK;
11890 /* [scan] */
11891 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc,
11892 Jim_Obj *const *argv)
11894 Jim_Obj *listPtr, **outVec;
11895 int outc, i, count = 0;
11897 if (argc < 3) {
11898 Jim_WrongNumArgs(interp, 1, argv, "string formatString ?varName ...?");
11899 return JIM_ERR;
11901 if (argv[2]->typePtr != &scanFmtStringObjType)
11902 SetScanFmtFromAny(interp, argv[2]);
11903 if (FormatGetError(argv[2]) != 0) {
11904 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
11905 return JIM_ERR;
11907 if (argc > 3) {
11908 int maxPos = FormatGetMaxPos(argv[2]);
11909 int count = FormatGetCnvCount(argv[2]);
11910 if (maxPos > argc-3) {
11911 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
11912 return JIM_ERR;
11913 } else if (count != 0 && count < argc-3) {
11914 Jim_SetResultString(interp, "variable is not assigned by any "
11915 "conversion specifiers", -1);
11916 return JIM_ERR;
11917 } else if (count > argc-3) {
11918 Jim_SetResultString(interp, "different numbers of variable names and "
11919 "field specifiers", -1);
11920 return JIM_ERR;
11923 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
11924 if (listPtr == 0)
11925 return JIM_ERR;
11926 if (argc > 3) {
11927 int len = 0;
11928 if (listPtr != 0 && listPtr != (Jim_Obj*)EOF)
11929 Jim_ListLength(interp, listPtr, &len);
11930 if (listPtr == (Jim_Obj*)EOF || len == 0) { // XXX
11931 Jim_SetResult(interp, Jim_NewIntObj(interp, -1));
11932 return JIM_OK;
11934 JimListGetElements(interp, listPtr, &outc, &outVec);
11935 for (i = 0; i < outc; ++i) {
11936 if (Jim_Length(outVec[i]) > 0) {
11937 ++count;
11938 if (Jim_SetVariable(interp, argv[3 + i], outVec[i]) != JIM_OK)
11939 goto err;
11942 Jim_FreeNewObj(interp, listPtr);
11943 Jim_SetResult(interp, Jim_NewIntObj(interp, count));
11944 } else {
11945 if (listPtr == (Jim_Obj*)EOF) {
11946 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
11947 return JIM_OK;
11949 Jim_SetResult(interp, listPtr);
11951 return JIM_OK;
11952 err:
11953 Jim_FreeNewObj(interp, listPtr);
11954 return JIM_ERR;
11957 /* [error] */
11958 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc,
11959 Jim_Obj *const *argv)
11961 if (argc != 2) {
11962 Jim_WrongNumArgs(interp, 1, argv, "message");
11963 return JIM_ERR;
11965 Jim_SetResult(interp, argv[1]);
11966 return JIM_ERR;
11969 /* [lrange] */
11970 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc,
11971 Jim_Obj *const *argv)
11973 Jim_Obj *objPtr;
11975 if (argc != 4) {
11976 Jim_WrongNumArgs(interp, 1, argv, "list first last");
11977 return JIM_ERR;
11979 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
11980 return JIM_ERR;
11981 Jim_SetResult(interp, objPtr);
11982 return JIM_OK;
11985 /* [env] */
11986 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc,
11987 Jim_Obj *const *argv)
11989 const char *key;
11990 char *val;
11992 if (argc == 1) {
11994 #ifdef NEED_ENVIRON_EXTERN
11995 extern char **environ;
11996 #endif
11998 int i;
11999 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
12001 for (i = 0; environ[i]; i++) {
12002 const char *equals = strchr(environ[i], '=');
12003 if (equals) {
12004 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, environ[i], equals - environ[i]));
12005 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
12009 Jim_SetResult(interp, listObjPtr);
12010 return JIM_OK;
12013 if (argc != 2) {
12014 Jim_WrongNumArgs(interp, 1, argv, "varName");
12015 return JIM_ERR;
12017 key = Jim_GetString(argv[1], NULL);
12018 val = getenv(key);
12019 if (val == NULL) {
12020 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
12021 Jim_AppendStrings(interp, Jim_GetResult(interp),
12022 "environment variable \"",
12023 key, "\" does not exist", NULL);
12024 return JIM_ERR;
12026 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
12027 return JIM_OK;
12030 /* [source] */
12031 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc,
12032 Jim_Obj *const *argv)
12034 int retval;
12036 if (argc != 2) {
12037 Jim_WrongNumArgs(interp, 1, argv, "fileName");
12038 return JIM_ERR;
12040 retval = Jim_EvalFile(interp, Jim_GetString(argv[1], NULL));
12041 if (retval == JIM_ERR) {
12042 return JIM_ERR_ADDSTACK;
12044 if (retval == JIM_RETURN)
12045 return JIM_OK;
12046 return retval;
12049 /* [lreverse] */
12050 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc,
12051 Jim_Obj *const *argv)
12053 Jim_Obj *revObjPtr, **ele;
12054 int len;
12056 if (argc != 2) {
12057 Jim_WrongNumArgs(interp, 1, argv, "list");
12058 return JIM_ERR;
12060 JimListGetElements(interp, argv[1], &len, &ele);
12061 len--;
12062 revObjPtr = Jim_NewListObj(interp, NULL, 0);
12063 while (len >= 0)
12064 ListAppendElement(revObjPtr, ele[len--]);
12065 Jim_SetResult(interp, revObjPtr);
12066 return JIM_OK;
12069 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
12071 jim_wide len;
12073 if (step == 0) return -1;
12074 if (start == end) return 0;
12075 else if (step > 0 && start > end) return -1;
12076 else if (step < 0 && end > start) return -1;
12077 len = end-start;
12078 if (len < 0) len = -len; /* abs(len) */
12079 if (step < 0) step = -step; /* abs(step) */
12080 len = 1 + ((len-1)/step);
12081 /* We can truncate safely to INT_MAX, the range command
12082 * will always return an error for a such long range
12083 * because Tcl lists can't be so long. */
12084 if (len > INT_MAX) len = INT_MAX;
12085 return (int)((len < 0) ? -1 : len);
12088 /* [range] */
12089 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc,
12090 Jim_Obj *const *argv)
12092 jim_wide start = 0, end, step = 1;
12093 int len, i;
12094 Jim_Obj *objPtr;
12096 if (argc < 2 || argc > 4) {
12097 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
12098 return JIM_ERR;
12100 if (argc == 2) {
12101 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
12102 return JIM_ERR;
12103 } else {
12104 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
12105 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
12106 return JIM_ERR;
12107 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
12108 return JIM_ERR;
12110 if ((len = JimRangeLen(start, end, step)) == -1) {
12111 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
12112 return JIM_ERR;
12114 objPtr = Jim_NewListObj(interp, NULL, 0);
12115 for (i = 0; i < len; i++)
12116 ListAppendElement(objPtr, Jim_NewIntObj(interp, start + i*step));
12117 Jim_SetResult(interp, objPtr);
12118 return JIM_OK;
12121 /* [rand] */
12122 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc,
12123 Jim_Obj *const *argv)
12125 jim_wide min = 0, max =0, len, maxMul;
12127 if (argc < 1 || argc > 3) {
12128 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
12129 return JIM_ERR;
12131 if (argc == 1) {
12132 max = JIM_WIDE_MAX;
12133 } else if (argc == 2) {
12134 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
12135 return JIM_ERR;
12136 } else if (argc == 3) {
12137 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
12138 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
12139 return JIM_ERR;
12141 len = max-min;
12142 if (len < 0) {
12143 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
12144 return JIM_ERR;
12146 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
12147 while (1) {
12148 jim_wide r;
12150 JimRandomBytes(interp, &r, sizeof(jim_wide));
12151 if (r < 0 || r >= maxMul) continue;
12152 r = (len == 0) ? 0 : r%len;
12153 Jim_SetResult(interp, Jim_NewIntObj(interp, min + r));
12154 return JIM_OK;
12158 /* [package] */
12159 static int Jim_PackageCoreCommand(Jim_Interp *interp, int argc,
12160 Jim_Obj *const *argv)
12162 int option;
12163 const char *options[] = {
12164 "require", "provide", NULL
12166 enum {OPT_REQUIRE, OPT_PROVIDE};
12168 if (argc < 2) {
12169 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
12170 return JIM_ERR;
12172 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
12173 JIM_ERRMSG) != JIM_OK)
12174 return JIM_ERR;
12176 if (option == OPT_REQUIRE) {
12177 int exact = 0;
12178 const char *ver;
12180 if (Jim_CompareStringImmediate(interp, argv[2], "-exact")) {
12181 exact = 1;
12182 argv++;
12183 argc--;
12185 if (argc != 3 && argc != 4) {
12186 Jim_WrongNumArgs(interp, 2, argv, "?-exact? package ?version?");
12187 return JIM_ERR;
12189 ver = Jim_PackageRequire(interp, Jim_GetString(argv[2], NULL),
12190 argc == 4 ? Jim_GetString(argv[3], NULL) : "",
12191 JIM_ERRMSG);
12192 if (ver == NULL)
12193 return JIM_ERR_ADDSTACK;
12194 Jim_SetResultString(interp, ver, -1);
12195 } else if (option == OPT_PROVIDE) {
12196 if (argc != 4) {
12197 Jim_WrongNumArgs(interp, 2, argv, "package version");
12198 return JIM_ERR;
12200 return Jim_PackageProvide(interp, Jim_GetString(argv[2], NULL),
12201 Jim_GetString(argv[3], NULL), JIM_ERRMSG);
12203 return JIM_OK;
12206 static struct {
12207 const char *name;
12208 Jim_CmdProc cmdProc;
12209 } Jim_CoreCommandsTable[] = {
12210 {"set", Jim_SetCoreCommand},
12211 {"unset", Jim_UnsetCoreCommand},
12212 {"puts", Jim_PutsCoreCommand},
12213 {"+", Jim_AddCoreCommand},
12214 {"*", Jim_MulCoreCommand},
12215 {"-", Jim_SubCoreCommand},
12216 {"/", Jim_DivCoreCommand},
12217 {"incr", Jim_IncrCoreCommand},
12218 {"while", Jim_WhileCoreCommand},
12219 {"for", Jim_ForCoreCommand},
12220 {"foreach", Jim_ForeachCoreCommand},
12221 {"lmap", Jim_LmapCoreCommand},
12222 {"if", Jim_IfCoreCommand},
12223 {"switch", Jim_SwitchCoreCommand},
12224 {"list", Jim_ListCoreCommand},
12225 {"lindex", Jim_LindexCoreCommand},
12226 {"lset", Jim_LsetCoreCommand},
12227 {"llength", Jim_LlengthCoreCommand},
12228 {"lappend", Jim_LappendCoreCommand},
12229 {"linsert", Jim_LinsertCoreCommand},
12230 {"lsort", Jim_LsortCoreCommand},
12231 {"append", Jim_AppendCoreCommand},
12232 {"debug", Jim_DebugCoreCommand},
12233 {"eval", Jim_EvalCoreCommand},
12234 {"uplevel", Jim_UplevelCoreCommand},
12235 {"expr", Jim_ExprCoreCommand},
12236 {"break", Jim_BreakCoreCommand},
12237 {"continue", Jim_ContinueCoreCommand},
12238 {"proc", Jim_ProcCoreCommand},
12239 {"concat", Jim_ConcatCoreCommand},
12240 {"return", Jim_ReturnCoreCommand},
12241 {"upvar", Jim_UpvarCoreCommand},
12242 {"global", Jim_GlobalCoreCommand},
12243 {"string", Jim_StringCoreCommand},
12244 {"time", Jim_TimeCoreCommand},
12245 {"exit", Jim_ExitCoreCommand},
12246 {"catch", Jim_CatchCoreCommand},
12247 {"ref", Jim_RefCoreCommand},
12248 {"getref", Jim_GetrefCoreCommand},
12249 {"setref", Jim_SetrefCoreCommand},
12250 {"finalize", Jim_FinalizeCoreCommand},
12251 {"collect", Jim_CollectCoreCommand},
12252 {"rename", Jim_RenameCoreCommand},
12253 {"dict", Jim_DictCoreCommand},
12254 {"load", Jim_LoadCoreCommand},
12255 {"subst", Jim_SubstCoreCommand},
12256 {"info", Jim_InfoCoreCommand},
12257 {"split", Jim_SplitCoreCommand},
12258 {"join", Jim_JoinCoreCommand},
12259 {"format", Jim_FormatCoreCommand},
12260 {"scan", Jim_ScanCoreCommand},
12261 {"error", Jim_ErrorCoreCommand},
12262 {"lrange", Jim_LrangeCoreCommand},
12263 {"env", Jim_EnvCoreCommand},
12264 {"source", Jim_SourceCoreCommand},
12265 {"lreverse", Jim_LreverseCoreCommand},
12266 {"range", Jim_RangeCoreCommand},
12267 {"rand", Jim_RandCoreCommand},
12268 {"package", Jim_PackageCoreCommand},
12269 {"tailcall", Jim_TailcallCoreCommand},
12270 {NULL, NULL},
12273 /* Some Jim core command is actually a procedure written in Jim itself. */
12274 static void Jim_RegisterCoreProcedures(Jim_Interp *interp)
12276 Jim_Eval(interp, (char*)
12277 "proc lambda {arglist args} {\n"
12278 " set name [ref {} function lambdaFinalizer]\n"
12279 " uplevel 1 [list proc $name $arglist {expand}$args]\n"
12280 " return $name\n"
12281 "}\n"
12282 "proc lambdaFinalizer {name val} {\n"
12283 " rename $name {}\n"
12284 "}\n"
12288 void Jim_RegisterCoreCommands(Jim_Interp *interp)
12290 int i = 0;
12292 while (Jim_CoreCommandsTable[i].name != NULL) {
12293 Jim_CreateCommand(interp,
12294 Jim_CoreCommandsTable[i].name,
12295 Jim_CoreCommandsTable[i].cmdProc,
12296 NULL, NULL);
12297 i++;
12299 Jim_RegisterCoreProcedures(interp);
12302 /* -----------------------------------------------------------------------------
12303 * Interactive prompt
12304 * ---------------------------------------------------------------------------*/
12305 void Jim_PrintErrorMessage(Jim_Interp *interp)
12307 int len, i;
12309 if (*interp->errorFileName) {
12310 Jim_fprintf(interp, interp->cookie_stderr, "Runtime error, file \"%s\", line %d:" JIM_NL " ",
12311 interp->errorFileName, interp->errorLine);
12313 Jim_fprintf(interp,interp->cookie_stderr, "%s" JIM_NL,
12314 Jim_GetString(interp->result, NULL));
12315 Jim_ListLength(interp, interp->stackTrace, &len);
12316 for (i = len-3; i >= 0; i-= 3) {
12317 Jim_Obj *objPtr=NULL;
12318 const char *proc, *file, *line;
12320 Jim_ListIndex(interp, interp->stackTrace, i, &objPtr, JIM_NONE);
12321 proc = Jim_GetString(objPtr, NULL);
12322 Jim_ListIndex(interp, interp->stackTrace, i + 1, &objPtr,
12323 JIM_NONE);
12324 file = Jim_GetString(objPtr, NULL);
12325 Jim_ListIndex(interp, interp->stackTrace, i + 2, &objPtr,
12326 JIM_NONE);
12327 line = Jim_GetString(objPtr, NULL);
12328 if (*proc) {
12329 Jim_fprintf(interp, interp->cookie_stderr,
12330 "in procedure '%s' ", proc);
12332 if (*file) {
12333 Jim_fprintf(interp, interp->cookie_stderr,
12334 "called at file \"%s\", line %s",
12335 file, line);
12337 if (*file || *proc) {
12338 Jim_fprintf(interp, interp->cookie_stderr, JIM_NL);
12343 int Jim_InteractivePrompt(Jim_Interp *interp)
12345 int retcode = JIM_OK;
12346 Jim_Obj *scriptObjPtr;
12348 Jim_fprintf(interp,interp->cookie_stdout, "Welcome to Jim version %d.%d, "
12349 "Copyright (c) 2005-8 Salvatore Sanfilippo" JIM_NL,
12350 JIM_VERSION / 100, JIM_VERSION % 100);
12351 Jim_SetVariableStrWithStr(interp, "jim_interactive", "1");
12352 while (1) {
12353 char buf[1024];
12354 const char *result;
12355 const char *retcodestr[] = {
12356 "ok", "error", "return", "break", "continue", "eval", "exit"
12358 int reslen;
12360 if (retcode != 0) {
12361 if (retcode >= 2 && retcode <= 6)
12362 Jim_fprintf(interp,interp->cookie_stdout, "[%s] . ", retcodestr[retcode]);
12363 else
12364 Jim_fprintf(interp,interp->cookie_stdout, "[%d] . ", retcode);
12365 } else
12366 Jim_fprintf(interp, interp->cookie_stdout, ". ");
12367 Jim_fflush(interp, interp->cookie_stdout);
12368 scriptObjPtr = Jim_NewStringObj(interp, "", 0);
12369 Jim_IncrRefCount(scriptObjPtr);
12370 while (1) {
12371 const char *str;
12372 char state;
12373 int len;
12375 if (Jim_fgets(interp, buf, 1024, interp->cookie_stdin) == NULL) {
12376 Jim_DecrRefCount(interp, scriptObjPtr);
12377 goto out;
12379 Jim_AppendString(interp, scriptObjPtr, buf, -1);
12380 str = Jim_GetString(scriptObjPtr, &len);
12381 if (Jim_ScriptIsComplete(str, len, &state))
12382 break;
12383 Jim_fprintf(interp, interp->cookie_stdout, "%c> ", state);
12384 Jim_fflush(interp, interp->cookie_stdout);
12386 retcode = Jim_EvalObj(interp, scriptObjPtr);
12387 Jim_DecrRefCount(interp, scriptObjPtr);
12388 result = Jim_GetString(Jim_GetResult(interp), &reslen);
12389 if (retcode == JIM_ERR) {
12390 Jim_PrintErrorMessage(interp);
12391 } else if (retcode == JIM_EXIT) {
12392 exit(Jim_GetExitCode(interp));
12393 } else {
12394 if (reslen) {
12395 Jim_fwrite(interp, result, 1, reslen, interp->cookie_stdout);
12396 Jim_fprintf(interp,interp->cookie_stdout, JIM_NL);
12400 out:
12401 return 0;
12404 /* -----------------------------------------------------------------------------
12405 * Jim's idea of STDIO..
12406 * ---------------------------------------------------------------------------*/
12408 int Jim_fprintf(Jim_Interp *interp, void *cookie, const char *fmt, ...)
12410 int r;
12412 va_list ap;
12413 va_start(ap,fmt);
12414 r = Jim_vfprintf(interp, cookie, fmt,ap);
12415 va_end(ap);
12416 return r;
12419 int Jim_vfprintf(Jim_Interp *interp, void *cookie, const char *fmt, va_list ap)
12421 if ((interp == NULL) || (interp->cb_vfprintf == NULL)) {
12422 errno = ENOTSUP;
12423 return -1;
12425 return (*(interp->cb_vfprintf))(cookie, fmt, ap);
12428 size_t Jim_fwrite(Jim_Interp *interp, const void *ptr, size_t size, size_t n, void *cookie)
12430 if ((interp == NULL) || (interp->cb_fwrite == NULL)) {
12431 errno = ENOTSUP;
12432 return 0;
12434 return (*(interp->cb_fwrite))(ptr, size, n, cookie);
12437 size_t Jim_fread(Jim_Interp *interp, void *ptr, size_t size, size_t n, void *cookie)
12439 if ((interp == NULL) || (interp->cb_fread == NULL)) {
12440 errno = ENOTSUP;
12441 return 0;
12443 return (*(interp->cb_fread))(ptr, size, n, cookie);
12446 int Jim_fflush(Jim_Interp *interp, void *cookie)
12448 if ((interp == NULL) || (interp->cb_fflush == NULL)) {
12449 /* pretend all is well */
12450 return 0;
12452 return (*(interp->cb_fflush))(cookie);
12455 char* Jim_fgets(Jim_Interp *interp, char *s, int size, void *cookie)
12457 if ((interp == NULL) || (interp->cb_fgets == NULL)) {
12458 errno = ENOTSUP;
12459 return NULL;
12461 return (*(interp->cb_fgets))(s, size, cookie);
12463 Jim_Nvp *
12464 Jim_Nvp_name2value_simple(const Jim_Nvp *p, const char *name)
12466 while (p->name) {
12467 if (0 == strcmp(name, p->name)) {
12468 break;
12470 p++;
12472 return ((Jim_Nvp *)(p));
12475 Jim_Nvp *
12476 Jim_Nvp_name2value_nocase_simple(const Jim_Nvp *p, const char *name)
12478 while (p->name) {
12479 if (0 == strcasecmp(name, p->name)) {
12480 break;
12482 p++;
12484 return ((Jim_Nvp *)(p));
12488 Jim_Nvp_name2value_obj(Jim_Interp *interp,
12489 const Jim_Nvp *p,
12490 Jim_Obj *o,
12491 Jim_Nvp **result)
12493 return Jim_Nvp_name2value(interp, p, Jim_GetString(o, NULL), result);
12498 Jim_Nvp_name2value(Jim_Interp *interp,
12499 const Jim_Nvp *_p,
12500 const char *name,
12501 Jim_Nvp **result)
12503 const Jim_Nvp *p;
12505 p = Jim_Nvp_name2value_simple(_p, name);
12507 /* result */
12508 if (result) {
12509 *result = (Jim_Nvp *)(p);
12512 /* found? */
12513 if (p->name) {
12514 return JIM_OK;
12515 } else {
12516 return JIM_ERR;
12521 Jim_Nvp_name2value_obj_nocase(Jim_Interp *interp, const Jim_Nvp *p, Jim_Obj *o, Jim_Nvp **puthere)
12523 return Jim_Nvp_name2value_nocase(interp, p, Jim_GetString(o, NULL), puthere);
12527 Jim_Nvp_name2value_nocase(Jim_Interp *interp, const Jim_Nvp *_p, const char *name, Jim_Nvp **puthere)
12529 const Jim_Nvp *p;
12531 p = Jim_Nvp_name2value_nocase_simple(_p, name);
12533 if (puthere) {
12534 *puthere = (Jim_Nvp *)(p);
12536 /* found */
12537 if (p->name) {
12538 return JIM_OK;
12539 } else {
12540 return JIM_ERR;
12546 Jim_Nvp_value2name_obj(Jim_Interp *interp, const Jim_Nvp *p, Jim_Obj *o, Jim_Nvp **result)
12548 int e;;
12549 jim_wide w;
12551 e = Jim_GetWide(interp, o, &w);
12552 if (e != JIM_OK) {
12553 return e;
12556 return Jim_Nvp_value2name(interp, p, w, result);
12559 Jim_Nvp *
12560 Jim_Nvp_value2name_simple(const Jim_Nvp *p, int value)
12562 while (p->name) {
12563 if (value == p->value) {
12564 break;
12566 p++;
12568 return ((Jim_Nvp *)(p));
12573 Jim_Nvp_value2name(Jim_Interp *interp, const Jim_Nvp *_p, int value, Jim_Nvp **result)
12575 const Jim_Nvp *p;
12577 p = Jim_Nvp_value2name_simple(_p, value);
12579 if (result) {
12580 *result = (Jim_Nvp *)(p);
12583 if (p->name) {
12584 return JIM_OK;
12585 } else {
12586 return JIM_ERR;
12592 Jim_GetOpt_Setup(Jim_GetOptInfo *p, Jim_Interp *interp, int argc, Jim_Obj * const * argv)
12594 memset(p, 0, sizeof(*p));
12595 p->interp = interp;
12596 p->argc = argc;
12597 p->argv = argv;
12599 return JIM_OK;
12602 void
12603 Jim_GetOpt_Debug(Jim_GetOptInfo *p)
12605 int x;
12607 Jim_fprintf(p->interp, p->interp->cookie_stderr, "---args---\n");
12608 for (x = 0 ; x < p->argc ; x++) {
12609 Jim_fprintf(p->interp, p->interp->cookie_stderr,
12610 "%2d) %s\n",
12612 Jim_GetString(p->argv[x], NULL));
12614 Jim_fprintf(p->interp, p->interp->cookie_stderr, "-------\n");
12619 Jim_GetOpt_Obj(Jim_GetOptInfo *goi, Jim_Obj **puthere)
12621 Jim_Obj *o;
12623 o = NULL; // failure
12624 if (goi->argc) {
12625 // success
12626 o = goi->argv[0];
12627 goi->argc -= 1;
12628 goi->argv += 1;
12630 if (puthere) {
12631 *puthere = o;
12633 if (o != NULL) {
12634 return JIM_OK;
12635 } else {
12636 return JIM_ERR;
12641 Jim_GetOpt_String(Jim_GetOptInfo *goi, char **puthere, int *len)
12643 int r;
12644 Jim_Obj *o;
12645 const char *cp;
12648 r = Jim_GetOpt_Obj(goi, &o);
12649 if (r == JIM_OK) {
12650 cp = Jim_GetString(o, len);
12651 if (puthere) {
12652 /* remove const */
12653 *puthere = (char *)(cp);
12656 return r;
12660 Jim_GetOpt_Double(Jim_GetOptInfo *goi, double *puthere)
12662 int r;
12663 Jim_Obj *o;
12664 double _safe;
12666 if (puthere == NULL) {
12667 puthere = &_safe;
12670 r = Jim_GetOpt_Obj(goi, &o);
12671 if (r == JIM_OK) {
12672 r = Jim_GetDouble(goi->interp, o, puthere);
12673 if (r != JIM_OK) {
12674 Jim_SetResult_sprintf(goi->interp,
12675 "not a number: %s",
12676 Jim_GetString(o, NULL));
12679 return r;
12683 Jim_GetOpt_Wide(Jim_GetOptInfo *goi, jim_wide *puthere)
12685 int r;
12686 Jim_Obj *o;
12687 jim_wide _safe;
12689 if (puthere == NULL) {
12690 puthere = &_safe;
12693 r = Jim_GetOpt_Obj(goi, &o);
12694 if (r == JIM_OK) {
12695 r = Jim_GetWide(goi->interp, o, puthere);
12697 return r;
12700 int Jim_GetOpt_Nvp(Jim_GetOptInfo *goi,
12701 const Jim_Nvp *nvp,
12702 Jim_Nvp **puthere)
12704 Jim_Nvp *_safe;
12705 Jim_Obj *o;
12706 int e;
12708 if (puthere == NULL) {
12709 puthere = &_safe;
12712 e = Jim_GetOpt_Obj(goi, &o);
12713 if (e == JIM_OK) {
12714 e = Jim_Nvp_name2value_obj(goi->interp,
12715 nvp,
12717 puthere);
12720 return e;
12723 void
12724 Jim_GetOpt_NvpUnknown(Jim_GetOptInfo *goi,
12725 const Jim_Nvp *nvptable,
12726 int hadprefix)
12728 if (hadprefix) {
12729 Jim_SetResult_NvpUnknown(goi->interp,
12730 goi->argv[-2],
12731 goi->argv[-1],
12732 nvptable);
12733 } else {
12734 Jim_SetResult_NvpUnknown(goi->interp,
12735 NULL,
12736 goi->argv[-1],
12737 nvptable);
12743 Jim_GetOpt_Enum(Jim_GetOptInfo *goi,
12744 const char * const * lookup,
12745 int *puthere)
12747 int _safe;
12748 Jim_Obj *o;
12749 int e;
12751 if (puthere == NULL) {
12752 puthere = &_safe;
12754 e = Jim_GetOpt_Obj(goi, &o);
12755 if (e == JIM_OK) {
12756 e = Jim_GetEnum(goi->interp,
12758 lookup,
12759 puthere,
12760 "option",
12761 JIM_ERRMSG);
12763 return e;
12769 Jim_SetResult_sprintf(Jim_Interp *interp, const char *fmt,...)
12771 va_list ap;
12772 char *buf;
12774 va_start(ap,fmt);
12775 buf = jim_vasprintf(fmt, ap);
12776 va_end(ap);
12777 if (buf) {
12778 Jim_SetResultString(interp, buf, -1);
12779 jim_vasprintf_done(buf);
12781 return JIM_OK;
12785 void
12786 Jim_SetResult_NvpUnknown(Jim_Interp *interp,
12787 Jim_Obj *param_name,
12788 Jim_Obj *param_value,
12789 const Jim_Nvp *nvp)
12791 if (param_name) {
12792 Jim_SetResult_sprintf(interp,
12793 "%s: Unknown: %s, try one of: ",
12794 Jim_GetString(param_name, NULL),
12795 Jim_GetString(param_value, NULL));
12796 } else {
12797 Jim_SetResult_sprintf(interp,
12798 "Unknown param: %s, try one of: ",
12799 Jim_GetString(param_value, NULL));
12801 while (nvp->name) {
12802 const char *a;
12803 const char *b;
12805 if ((nvp + 1)->name) {
12806 a = nvp->name;
12807 b = ", ";
12808 } else {
12809 a = "or ";
12810 b = nvp->name;
12812 Jim_AppendStrings(interp,
12813 Jim_GetResult(interp),
12814 a, b, NULL);
12815 nvp++;
12820 static Jim_Obj *debug_string_obj;
12822 const char *
12823 Jim_Debug_ArgvString(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12825 int x;
12827 if (debug_string_obj) {
12828 Jim_FreeObj(interp, debug_string_obj);
12831 debug_string_obj = Jim_NewEmptyStringObj(interp);
12832 for (x = 0 ; x < argc ; x++) {
12833 Jim_AppendStrings(interp,
12834 debug_string_obj,
12835 Jim_GetString(argv[x], NULL),
12836 " ",
12837 NULL);
12840 return Jim_GetString(debug_string_obj, NULL);