Remove some c++ style comments
[jimtcl.git] / jim.c
blob7c1a76bf3da43afc35c27760c4d446d96a306e98
2 /* Jim - A small embeddable Tcl interpreter
4 * Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
5 * Copyright 2005 Clemens Hintze <c.hintze@gmx.net>
6 * Copyright 2005 patthoyts - Pat Thoyts <patthoyts@users.sf.net>
7 * Copyright 2008,2009 oharboe - Øyvind Harboe - oyvind.harboe@zylin.com
8 * Copyright 2008 Andrew Lunn <andrew@lunn.ch>
9 * Copyright 2008 Duane Ellis <openocd@duaneellis.com>
10 * Copyright 2008 Uwe Klein <uklein@klein-messgeraete.de>
11 * Copyright 2008 Steve Bennett <steveb@workware.net.au>
12 * Copyright 2009 Nico Coesel <ncoesel@dealogic.nl>
13 * Copyright 2009 Zachary T Welch zw@superlucidity.net
14 * Copyright 2009 David Brownell
16 * Redistribution and use in source and binary forms, with or without
17 * modification, are permitted provided that the following conditions
18 * are met:
20 * 1. Redistributions of source code must retain the above copyright
21 * notice, this list of conditions and the following disclaimer.
22 * 2. Redistributions in binary form must reproduce the above
23 * copyright notice, this list of conditions and the following
24 * disclaimer in the documentation and/or other materials
25 * provided with the distribution.
27 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
28 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
29 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
30 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
31 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
32 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
33 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
34 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
35 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
36 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
37 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
38 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
40 * The views and conclusions contained in the software and documentation
41 * are those of the authors and should not be interpreted as representing
42 * official policies, either expressed or implied, of the Jim Tcl Project.
43 **/
44 #define JIM_OPTIMIZATION /* comment to avoid optimizations and reduce size */
46 #include <stdio.h>
47 #include <stdlib.h>
49 #include <string.h>
50 #include <stdarg.h>
51 #include <ctype.h>
52 #include <limits.h>
53 #include <assert.h>
54 #include <errno.h>
55 #include <time.h>
56 #include <setjmp.h>
58 #include "jim.h"
59 #include "jimautoconf.h"
60 #include "utf8.h"
62 #ifdef HAVE_SYS_TIME_H
63 #include <sys/time.h>
64 #endif
65 #ifdef HAVE_BACKTRACE
66 #include <execinfo.h>
67 #endif
68 #ifdef HAVE_CRT_EXTERNS_H
69 #include <crt_externs.h>
70 #endif
72 /* For INFINITY, even if math functions are not enabled */
73 #include <math.h>
75 /* We may decide to switch to using $[...] after all, so leave it as an option */
76 /*#define EXPRSUGAR_BRACKET*/
78 /* For the no-autoconf case */
79 #ifndef TCL_LIBRARY
80 #define TCL_LIBRARY "."
81 #endif
82 #ifndef TCL_PLATFORM_OS
83 #define TCL_PLATFORM_OS "unknown"
84 #endif
85 #ifndef TCL_PLATFORM_PLATFORM
86 #define TCL_PLATFORM_PLATFORM "unknown"
87 #endif
88 #ifndef TCL_PLATFORM_PATH_SEPARATOR
89 #define TCL_PLATFORM_PATH_SEPARATOR ":"
90 #endif
92 /*#define DEBUG_SHOW_SCRIPT*/
93 /*#define DEBUG_SHOW_SCRIPT_TOKENS*/
94 /*#define DEBUG_SHOW_SUBST*/
95 /*#define DEBUG_SHOW_EXPR*/
96 /*#define DEBUG_SHOW_EXPR_TOKENS*/
97 /*#define JIM_DEBUG_GC*/
98 #ifdef JIM_MAINTAINER
99 #define JIM_DEBUG_COMMAND
100 #define JIM_DEBUG_PANIC
101 #endif
103 const char *jim_tt_name(int type);
105 #ifdef JIM_DEBUG_PANIC
106 static void JimPanicDump(int panic_condition, const char *fmt, ...);
107 #define JimPanic(X) JimPanicDump X
108 #else
109 #define JimPanic(X)
110 #endif
112 /* -----------------------------------------------------------------------------
113 * Global variables
114 * ---------------------------------------------------------------------------*/
116 /* A shared empty string for the objects string representation.
117 * Jim_InvalidateStringRep knows about it and doesn't try to free it. */
118 static char JimEmptyStringRep[] = "";
120 /* -----------------------------------------------------------------------------
121 * Required prototypes of not exported functions
122 * ---------------------------------------------------------------------------*/
123 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf);
124 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int flags);
125 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int listindex, Jim_Obj *newObjPtr,
126 int flags);
127 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands);
128 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr);
129 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
130 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
131 const char *prefix, const char *const *tablePtr, const char *name);
132 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv);
133 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr);
134 static int JimSign(jim_wide w);
135 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr);
136 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen);
137 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len);
140 /* Fast access to the int (wide) value of an object which is known to be of int type */
141 #define JimWideValue(objPtr) (objPtr)->internalRep.wideValue
143 #define JimObjTypeName(O) ((O)->typePtr ? (O)->typePtr->name : "none")
145 static int utf8_tounicode_case(const char *s, int *uc, int upper)
147 int l = utf8_tounicode(s, uc);
148 if (upper) {
149 *uc = utf8_upper(*uc);
151 return l;
154 /* These can be used in addition to JIM_CASESENS/JIM_NOCASE */
155 #define JIM_CHARSET_SCAN 2
156 #define JIM_CHARSET_GLOB 0
159 * pattern points to a string like "[^a-z\ub5]"
161 * The pattern may contain trailing chars, which are ignored.
163 * The pattern is matched against unicode char 'c'.
165 * If (flags & JIM_NOCASE), case is ignored when matching.
166 * If (flags & JIM_CHARSET_SCAN), the considers ^ and ] special at the start
167 * of the charset, per scan, rather than glob/string match.
169 * If the unicode char 'c' matches that set, returns a pointer to the ']' character,
170 * or the null character if the ']' is missing.
172 * Returns NULL on no match.
174 static const char *JimCharsetMatch(const char *pattern, int c, int flags)
176 int not = 0;
177 int pchar;
178 int match = 0;
179 int nocase = 0;
181 if (flags & JIM_NOCASE) {
182 nocase++;
183 c = utf8_upper(c);
186 if (flags & JIM_CHARSET_SCAN) {
187 if (*pattern == '^') {
188 not++;
189 pattern++;
192 /* Special case. If the first char is ']', it is part of the set */
193 if (*pattern == ']') {
194 goto first;
198 while (*pattern && *pattern != ']') {
199 /* Exact match */
200 if (pattern[0] == '\\') {
201 first:
202 pattern += utf8_tounicode_case(pattern, &pchar, nocase);
204 else {
205 /* Is this a range? a-z */
206 int start;
207 int end;
209 pattern += utf8_tounicode_case(pattern, &start, nocase);
210 if (pattern[0] == '-' && pattern[1]) {
211 /* skip '-' */
212 pattern += utf8_tounicode(pattern, &pchar);
213 pattern += utf8_tounicode_case(pattern, &end, nocase);
215 /* Handle reversed range too */
216 if ((c >= start && c <= end) || (c >= end && c <= start)) {
217 match = 1;
219 continue;
221 pchar = start;
224 if (pchar == c) {
225 match = 1;
228 if (not) {
229 match = !match;
232 return match ? pattern : NULL;
235 /* Glob-style pattern matching. */
237 /* Note: string *must* be valid UTF-8 sequences
238 * slen is a char length, not byte counts.
240 static int JimGlobMatch(const char *pattern, const char *string, int nocase)
242 int c;
243 int pchar;
244 while (*pattern) {
245 switch (pattern[0]) {
246 case '*':
247 while (pattern[1] == '*') {
248 pattern++;
250 pattern++;
251 if (!pattern[0]) {
252 return 1; /* match */
254 while (*string) {
255 /* Recursive call - Does the remaining pattern match anywhere? */
256 if (JimGlobMatch(pattern, string, nocase))
257 return 1; /* match */
258 string += utf8_tounicode(string, &c);
260 return 0; /* no match */
262 case '?':
263 string += utf8_tounicode(string, &c);
264 break;
266 case '[': {
267 string += utf8_tounicode(string, &c);
268 pattern = JimCharsetMatch(pattern + 1, c, nocase ? JIM_NOCASE : 0);
269 if (!pattern) {
270 return 0;
272 if (!*pattern) {
273 /* Ran out of pattern (no ']') */
274 continue;
276 break;
278 case '\\':
279 if (pattern[1]) {
280 pattern++;
282 /* fall through */
283 default:
284 string += utf8_tounicode_case(string, &c, nocase);
285 utf8_tounicode_case(pattern, &pchar, nocase);
286 if (pchar != c) {
287 return 0;
289 break;
291 pattern += utf8_tounicode_case(pattern, &pchar, nocase);
292 if (!*string) {
293 while (*pattern == '*') {
294 pattern++;
296 break;
299 if (!*pattern && !*string) {
300 return 1;
302 return 0;
306 * string comparison works on binary data.
308 * Note that the lengths are byte lengths, not char lengths.
310 static int JimStringCompare(const char *s1, int l1, const char *s2, int l2)
312 if (l1 < l2) {
313 return memcmp(s1, s2, l1) <= 0 ? -1 : 1;
315 else if (l2 < l1) {
316 return memcmp(s1, s2, l2) >= 0 ? 1 : -1;
318 else {
319 return JimSign(memcmp(s1, s2, l1));
324 * Compare null terminated strings, up to a maximum of 'maxchars' characters,
325 * (or end of string if 'maxchars' is -1).
327 * Returns -1, 0, 1 for s1 < s2, s1 == s2, s1 > s2 respectively.
329 static int JimStringCompareLen(const char *s1, const char *s2, int maxchars, int nocase)
331 while (*s1 && *s2 && maxchars) {
332 int c1, c2;
333 s1 += utf8_tounicode_case(s1, &c1, nocase);
334 s2 += utf8_tounicode_case(s2, &c2, nocase);
335 if (c1 != c2) {
336 return JimSign(c1 - c2);
338 maxchars--;
340 if (!maxchars) {
341 return 0;
343 /* One string or both terminated */
344 if (*s1) {
345 return 1;
347 if (*s2) {
348 return -1;
350 return 0;
353 /* Search 's1' inside 's2', starting to search from char 'index' of 's2'.
354 * The index of the first occurrence of s1 in s2 is returned.
355 * If s1 is not found inside s2, -1 is returned. */
356 static int JimStringFirst(const char *s1, int l1, const char *s2, int l2, int idx)
358 int i;
359 int l1bytelen;
361 if (!l1 || !l2 || l1 > l2) {
362 return -1;
364 if (idx < 0)
365 idx = 0;
366 s2 += utf8_index(s2, idx);
368 l1bytelen = utf8_index(s1, l1);
370 for (i = idx; i <= l2 - l1; i++) {
371 int c;
372 if (memcmp(s2, s1, l1bytelen) == 0) {
373 return i;
375 s2 += utf8_tounicode(s2, &c);
377 return -1;
381 * Note: Lengths and return value are in bytes, not chars.
383 static int JimStringLast(const char *s1, int l1, const char *s2, int l2)
385 const char *p;
387 if (!l1 || !l2 || l1 > l2)
388 return -1;
390 /* Now search for the needle */
391 for (p = s2 + l2 - 1; p != s2 - 1; p--) {
392 if (*p == *s1 && memcmp(s1, p, l1) == 0) {
393 return p - s2;
396 return -1;
399 #ifdef JIM_UTF8
401 * Note: Lengths and return value are in chars.
403 static int JimStringLastUtf8(const char *s1, int l1, const char *s2, int l2)
405 int n = JimStringLast(s1, utf8_index(s1, l1), s2, utf8_index(s2, l2));
406 if (n > 0) {
407 n = utf8_strlen(s2, n);
409 return n;
411 #endif
413 int Jim_WideToString(char *buf, jim_wide wideValue)
415 const char *fmt = "%" JIM_WIDE_MODIFIER;
417 return sprintf(buf, fmt, wideValue);
421 * After an strtol()/strtod()-like conversion,
422 * check whether something was converted and that
423 * the only thing left is white space.
425 * Returns JIM_OK or JIM_ERR.
427 static int JimCheckConversion(const char *str, const char *endptr)
429 if (str[0] == '\0' || str == endptr) {
430 return JIM_ERR;
433 if (endptr[0] != '\0') {
434 while (*endptr) {
435 if (!isspace(UCHAR(*endptr))) {
436 return JIM_ERR;
438 endptr++;
441 return JIM_OK;
444 int Jim_StringToWide(const char *str, jim_wide * widePtr, int base)
446 char *endptr;
448 *widePtr = strtoull(str, &endptr, base);
450 return JimCheckConversion(str, endptr);
453 int Jim_DoubleToString(char *buf, double doubleValue)
455 int len;
456 char *buf0 = buf;
458 len = sprintf(buf, "%.12g", doubleValue);
460 /* Add a final ".0" if it's a number. But not
461 * for NaN or InF */
462 while (*buf) {
463 if (*buf == '.' || isalpha(UCHAR(*buf))) {
464 /* inf -> Inf, nan -> Nan */
465 if (*buf == 'i' || *buf == 'n') {
466 *buf = toupper(UCHAR(*buf));
468 if (*buf == 'I') {
469 /* Infinity -> Inf */
470 buf[3] = '\0';
471 len = buf - buf0 + 3;
473 return len;
475 buf++;
478 *buf++ = '.';
479 *buf++ = '0';
480 *buf = '\0';
482 return len + 2;
485 int Jim_StringToDouble(const char *str, double *doublePtr)
487 char *endptr;
489 /* Callers can check for underflow via ERANGE */
490 errno = 0;
492 *doublePtr = strtod(str, &endptr);
494 return JimCheckConversion(str, endptr);
497 static jim_wide JimPowWide(jim_wide b, jim_wide e)
499 jim_wide i, res = 1;
501 if ((b == 0 && e != 0) || (e < 0))
502 return 0;
503 for (i = 0; i < e; i++) {
504 res *= b;
506 return res;
509 /* -----------------------------------------------------------------------------
510 * Special functions
511 * ---------------------------------------------------------------------------*/
512 #ifdef JIM_DEBUG_PANIC
513 void JimPanicDump(int condition, const char *fmt, ...)
515 va_list ap;
517 if (!condition) {
518 return;
521 va_start(ap, fmt);
523 fprintf(stderr, JIM_NL "JIM INTERPRETER PANIC: ");
524 vfprintf(stderr, fmt, ap);
525 fprintf(stderr, JIM_NL JIM_NL);
526 va_end(ap);
528 #ifdef HAVE_BACKTRACE
530 void *array[40];
531 int size, i;
532 char **strings;
534 size = backtrace(array, 40);
535 strings = backtrace_symbols(array, size);
536 for (i = 0; i < size; i++)
537 fprintf(stderr, "[backtrace] %s" JIM_NL, strings[i]);
538 fprintf(stderr, "[backtrace] Include the above lines and the output" JIM_NL);
539 fprintf(stderr, "[backtrace] of 'nm <executable>' in the bug report." JIM_NL);
541 #endif
543 exit(1);
545 #endif
547 /* -----------------------------------------------------------------------------
548 * Memory allocation
549 * ---------------------------------------------------------------------------*/
551 void *Jim_Alloc(int size)
553 return size ? malloc(size) : NULL;
556 void Jim_Free(void *ptr)
558 free(ptr);
561 void *Jim_Realloc(void *ptr, int size)
563 return realloc(ptr, size);
566 char *Jim_StrDup(const char *s)
568 return strdup(s);
571 char *Jim_StrDupLen(const char *s, int l)
573 char *copy = Jim_Alloc(l + 1);
575 memcpy(copy, s, l + 1);
576 copy[l] = 0; /* Just to be sure, original could be substring */
577 return copy;
580 /* -----------------------------------------------------------------------------
581 * Time related functions
582 * ---------------------------------------------------------------------------*/
584 /* Returns microseconds of CPU used since start. */
585 static jim_wide JimClock(void)
587 struct timeval tv;
589 gettimeofday(&tv, NULL);
590 return (jim_wide) tv.tv_sec * 1000000 + tv.tv_usec;
593 /* -----------------------------------------------------------------------------
594 * Hash Tables
595 * ---------------------------------------------------------------------------*/
597 /* -------------------------- private prototypes ---------------------------- */
598 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht);
599 static unsigned int JimHashTableNextPower(unsigned int size);
600 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace);
602 /* -------------------------- hash functions -------------------------------- */
604 /* Thomas Wang's 32 bit Mix Function */
605 unsigned int Jim_IntHashFunction(unsigned int key)
607 key += ~(key << 15);
608 key ^= (key >> 10);
609 key += (key << 3);
610 key ^= (key >> 6);
611 key += ~(key << 11);
612 key ^= (key >> 16);
613 return key;
616 /* Generic hash function (we are using to multiply by 9 and add the byte
617 * as Tcl) */
618 unsigned int Jim_GenHashFunction(const unsigned char *buf, int len)
620 unsigned int h = 0;
622 while (len--)
623 h += (h << 3) + *buf++;
624 return h;
627 /* ----------------------------- API implementation ------------------------- */
629 /* reset a hashtable already initialized with ht_init().
630 * NOTE: This function should only called by ht_destroy(). */
631 static void JimResetHashTable(Jim_HashTable *ht)
633 ht->table = NULL;
634 ht->size = 0;
635 ht->sizemask = 0;
636 ht->used = 0;
637 ht->collisions = 0;
640 /* Initialize the hash table */
641 int Jim_InitHashTable(Jim_HashTable *ht, const Jim_HashTableType *type, void *privDataPtr)
643 JimResetHashTable(ht);
644 ht->type = type;
645 ht->privdata = privDataPtr;
646 return JIM_OK;
649 /* Resize the table to the minimal size that contains all the elements,
650 * but with the invariant of a USER/BUCKETS ration near to <= 1 */
651 void Jim_ResizeHashTable(Jim_HashTable *ht)
653 int minimal = ht->used;
655 if (minimal < JIM_HT_INITIAL_SIZE)
656 minimal = JIM_HT_INITIAL_SIZE;
657 Jim_ExpandHashTable(ht, minimal);
660 /* Expand or create the hashtable */
661 void Jim_ExpandHashTable(Jim_HashTable *ht, unsigned int size)
663 Jim_HashTable n; /* the new hashtable */
664 unsigned int realsize = JimHashTableNextPower(size), i;
666 /* the size is invalid if it is smaller than the number of
667 * elements already inside the hashtable */
668 if (size <= ht->used)
669 return;
671 Jim_InitHashTable(&n, ht->type, ht->privdata);
672 n.size = realsize;
673 n.sizemask = realsize - 1;
674 n.table = Jim_Alloc(realsize * sizeof(Jim_HashEntry *));
676 /* Initialize all the pointers to NULL */
677 memset(n.table, 0, realsize * sizeof(Jim_HashEntry *));
679 /* Copy all the elements from the old to the new table:
680 * note that if the old hash table is empty ht->used is zero,
681 * so Jim_ExpandHashTable just creates an empty hash table. */
682 n.used = ht->used;
683 for (i = 0; ht->used > 0; i++) {
684 Jim_HashEntry *he, *nextHe;
686 if (ht->table[i] == NULL)
687 continue;
689 /* For each hash entry on this slot... */
690 he = ht->table[i];
691 while (he) {
692 unsigned int h;
694 nextHe = he->next;
695 /* Get the new element index */
696 h = Jim_HashKey(ht, he->key) & n.sizemask;
697 he->next = n.table[h];
698 n.table[h] = he;
699 ht->used--;
700 /* Pass to the next element */
701 he = nextHe;
704 assert(ht->used == 0);
705 Jim_Free(ht->table);
707 /* Remap the new hashtable in the old */
708 *ht = n;
711 /* Add an element to the target hash table */
712 int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val)
714 Jim_HashEntry *entry;
716 /* Get the index of the new element, or -1 if
717 * the element already exists. */
718 entry = JimInsertHashEntry(ht, key, 0);
719 if (entry == NULL)
720 return JIM_ERR;
722 /* Set the hash entry fields. */
723 Jim_SetHashKey(ht, entry, key);
724 Jim_SetHashVal(ht, entry, val);
725 return JIM_OK;
728 /* Add an element, discarding the old if the key already exists */
729 int Jim_ReplaceHashEntry(Jim_HashTable *ht, const void *key, void *val)
731 int existed;
732 Jim_HashEntry *entry;
734 /* Get the index of the new element, or -1 if
735 * the element already exists. */
736 entry = JimInsertHashEntry(ht, key, 1);
737 if (entry->key) {
738 /* It already exists, so replace the value */
739 Jim_FreeEntryVal(ht, entry);
740 existed = 1;
742 else {
743 /* Doesn't exist, so set the key */
744 Jim_SetHashKey(ht, entry, key);
745 existed = 0;
747 Jim_SetHashVal(ht, entry, val);
749 return existed;
752 /* Search and remove an element */
753 int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key)
755 unsigned int h;
756 Jim_HashEntry *he, *prevHe;
758 if (ht->used == 0)
759 return JIM_ERR;
760 h = Jim_HashKey(ht, key) & ht->sizemask;
761 he = ht->table[h];
763 prevHe = NULL;
764 while (he) {
765 if (Jim_CompareHashKeys(ht, key, he->key)) {
766 /* Unlink the element from the list */
767 if (prevHe)
768 prevHe->next = he->next;
769 else
770 ht->table[h] = he->next;
771 Jim_FreeEntryKey(ht, he);
772 Jim_FreeEntryVal(ht, he);
773 Jim_Free(he);
774 ht->used--;
775 return JIM_OK;
777 prevHe = he;
778 he = he->next;
780 return JIM_ERR; /* not found */
783 /* Destroy an entire hash table */
784 int Jim_FreeHashTable(Jim_HashTable *ht)
786 unsigned int i;
788 /* Free all the elements */
789 for (i = 0; ht->used > 0; i++) {
790 Jim_HashEntry *he, *nextHe;
792 if ((he = ht->table[i]) == NULL)
793 continue;
794 while (he) {
795 nextHe = he->next;
796 Jim_FreeEntryKey(ht, he);
797 Jim_FreeEntryVal(ht, he);
798 Jim_Free(he);
799 ht->used--;
800 he = nextHe;
803 /* Free the table and the allocated cache structure */
804 Jim_Free(ht->table);
805 /* Re-initialize the table */
806 JimResetHashTable(ht);
807 return JIM_OK; /* never fails */
810 Jim_HashEntry *Jim_FindHashEntry(Jim_HashTable *ht, const void *key)
812 Jim_HashEntry *he;
813 unsigned int h;
815 if (ht->used == 0)
816 return NULL;
817 h = Jim_HashKey(ht, key) & ht->sizemask;
818 he = ht->table[h];
819 while (he) {
820 if (Jim_CompareHashKeys(ht, key, he->key))
821 return he;
822 he = he->next;
824 return NULL;
827 Jim_HashTableIterator *Jim_GetHashTableIterator(Jim_HashTable *ht)
829 Jim_HashTableIterator *iter = Jim_Alloc(sizeof(*iter));
831 iter->ht = ht;
832 iter->index = -1;
833 iter->entry = NULL;
834 iter->nextEntry = NULL;
835 return iter;
838 Jim_HashEntry *Jim_NextHashEntry(Jim_HashTableIterator *iter)
840 while (1) {
841 if (iter->entry == NULL) {
842 iter->index++;
843 if (iter->index >= (signed)iter->ht->size)
844 break;
845 iter->entry = iter->ht->table[iter->index];
847 else {
848 iter->entry = iter->nextEntry;
850 if (iter->entry) {
851 /* We need to save the 'next' here, the iterator user
852 * may delete the entry we are returning. */
853 iter->nextEntry = iter->entry->next;
854 return iter->entry;
857 return NULL;
860 /* ------------------------- private functions ------------------------------ */
862 /* Expand the hash table if needed */
863 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht)
865 /* If the hash table is empty expand it to the intial size,
866 * if the table is "full" dobule its size. */
867 if (ht->size == 0)
868 Jim_ExpandHashTable(ht, JIM_HT_INITIAL_SIZE);
869 if (ht->size == ht->used)
870 Jim_ExpandHashTable(ht, ht->size * 2);
873 /* Our hash table capability is a power of two */
874 static unsigned int JimHashTableNextPower(unsigned int size)
876 unsigned int i = JIM_HT_INITIAL_SIZE;
878 if (size >= 2147483648U)
879 return 2147483648U;
880 while (1) {
881 if (i >= size)
882 return i;
883 i *= 2;
887 /* Returns the index of a free slot that can be populated with
888 * an hash entry for the given 'key'.
889 * If the key already exists, -1 is returned. */
890 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace)
892 unsigned int h;
893 Jim_HashEntry *he;
895 /* Expand the hashtable if needed */
896 JimExpandHashTableIfNeeded(ht);
898 /* Compute the key hash value */
899 h = Jim_HashKey(ht, key) & ht->sizemask;
900 /* Search if this slot does not already contain the given key */
901 he = ht->table[h];
902 while (he) {
903 if (Jim_CompareHashKeys(ht, key, he->key))
904 return replace ? he : NULL;
905 he = he->next;
908 /* Allocates the memory and stores key */
909 he = Jim_Alloc(sizeof(*he));
910 he->next = ht->table[h];
911 ht->table[h] = he;
912 ht->used++;
913 he->key = NULL;
915 return he;
918 /* ----------------------- StringCopy Hash Table Type ------------------------*/
920 static unsigned int JimStringCopyHTHashFunction(const void *key)
922 return Jim_GenHashFunction(key, strlen(key));
925 static void *JimStringCopyHTDup(void *privdata, const void *key)
927 return strdup(key);
930 static int JimStringCopyHTKeyCompare(void *privdata, const void *key1, const void *key2)
932 return strcmp(key1, key2) == 0;
935 static void JimStringCopyHTKeyDestructor(void *privdata, void *key)
937 Jim_Free(key);
940 static const Jim_HashTableType JimPackageHashTableType = {
941 JimStringCopyHTHashFunction, /* hash function */
942 JimStringCopyHTDup, /* key dup */
943 NULL, /* val dup */
944 JimStringCopyHTKeyCompare, /* key compare */
945 JimStringCopyHTKeyDestructor, /* key destructor */
946 NULL /* val destructor */
949 typedef struct AssocDataValue
951 Jim_InterpDeleteProc *delProc;
952 void *data;
953 } AssocDataValue;
955 static void JimAssocDataHashTableValueDestructor(void *privdata, void *data)
957 AssocDataValue *assocPtr = (AssocDataValue *) data;
959 if (assocPtr->delProc != NULL)
960 assocPtr->delProc((Jim_Interp *)privdata, assocPtr->data);
961 Jim_Free(data);
964 static const Jim_HashTableType JimAssocDataHashTableType = {
965 JimStringCopyHTHashFunction, /* hash function */
966 JimStringCopyHTDup, /* key dup */
967 NULL, /* val dup */
968 JimStringCopyHTKeyCompare, /* key compare */
969 JimStringCopyHTKeyDestructor, /* key destructor */
970 JimAssocDataHashTableValueDestructor /* val destructor */
973 /* -----------------------------------------------------------------------------
974 * Stack - This is a simple generic stack implementation. It is used for
975 * example in the 'expr' expression compiler.
976 * ---------------------------------------------------------------------------*/
977 void Jim_InitStack(Jim_Stack *stack)
979 stack->len = 0;
980 stack->maxlen = 0;
981 stack->vector = NULL;
984 void Jim_FreeStack(Jim_Stack *stack)
986 Jim_Free(stack->vector);
989 int Jim_StackLen(Jim_Stack *stack)
991 return stack->len;
994 void Jim_StackPush(Jim_Stack *stack, void *element)
996 int neededLen = stack->len + 1;
998 if (neededLen > stack->maxlen) {
999 stack->maxlen = neededLen < 20 ? 20 : neededLen * 2;
1000 stack->vector = Jim_Realloc(stack->vector, sizeof(void *) * stack->maxlen);
1002 stack->vector[stack->len] = element;
1003 stack->len++;
1006 void *Jim_StackPop(Jim_Stack *stack)
1008 if (stack->len == 0)
1009 return NULL;
1010 stack->len--;
1011 return stack->vector[stack->len];
1014 void *Jim_StackPeek(Jim_Stack *stack)
1016 if (stack->len == 0)
1017 return NULL;
1018 return stack->vector[stack->len - 1];
1021 void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc) (void *ptr))
1023 int i;
1025 for (i = 0; i < stack->len; i++)
1026 freeFunc(stack->vector[i]);
1029 /* -----------------------------------------------------------------------------
1030 * Parser
1031 * ---------------------------------------------------------------------------*/
1033 /* Token types */
1034 #define JIM_TT_NONE 0 /* No token returned */
1035 #define JIM_TT_STR 1 /* simple string */
1036 #define JIM_TT_ESC 2 /* string that needs escape chars conversion */
1037 #define JIM_TT_VAR 3 /* var substitution */
1038 #define JIM_TT_DICTSUGAR 4 /* Syntax sugar for [dict get], $foo(bar) */
1039 #define JIM_TT_CMD 5 /* command substitution */
1040 /* Note: Keep these three together for TOKEN_IS_SEP() */
1041 #define JIM_TT_SEP 6 /* word separator. arg is # of tokens. -ve if {*} */
1042 #define JIM_TT_EOL 7 /* line separator */
1043 #define JIM_TT_EOF 8 /* end of script */
1045 #define JIM_TT_LINE 9 /* special 'start-of-line' token. arg is # of arguments to the command. -ve if {*} */
1046 #define JIM_TT_WORD 10 /* special 'start-of-word' token. arg is # of tokens to combine. -ve if {*} */
1048 /* Additional token types needed for expressions */
1049 #define JIM_TT_SUBEXPR_START 11
1050 #define JIM_TT_SUBEXPR_END 12
1051 #define JIM_TT_SUBEXPR_COMMA 13
1052 #define JIM_TT_EXPR_INT 14
1053 #define JIM_TT_EXPR_DOUBLE 15
1055 #define JIM_TT_EXPRSUGAR 16 /* $(expression) */
1057 /* Operator token types start here */
1058 #define JIM_TT_EXPR_OP 20
1060 #define TOKEN_IS_SEP(type) (type >= JIM_TT_SEP && type <= JIM_TT_EOF)
1062 /* Parser states */
1063 #define JIM_PS_DEF 0 /* Default state */
1064 #define JIM_PS_QUOTE 1 /* Inside "" */
1065 #define JIM_PS_DICTSUGAR 2 /* Tokenising abc(def) into 4 separate tokens */
1067 /* Parser context structure. The same context is used both to parse
1068 * Tcl scripts and lists. */
1069 struct JimParserCtx
1071 const char *p; /* Pointer to the point of the program we are parsing */
1072 int len; /* Remaining length */
1073 int linenr; /* Current line number */
1074 const char *tstart;
1075 const char *tend; /* Returned token is at tstart-tend in 'prg'. */
1076 int tline; /* Line number of the returned token */
1077 int tt; /* Token type */
1078 int eof; /* Non zero if EOF condition is true. */
1079 int state; /* Parser state */
1080 int comment; /* Non zero if the next chars may be a comment. */
1081 char missing; /* At end of parse, ' ' if complete, '{' if braces incomplete, '"' if quotes incomplete */
1082 int missingline; /* Line number starting the missing token */
1086 * Results of missing quotes, braces, etc. from parsing.
1088 struct JimParseResult {
1089 char missing; /* From JimParserCtx.missing */
1090 int line; /* From JimParserCtx.missingline */
1093 static int JimParseScript(struct JimParserCtx *pc);
1094 static int JimParseSep(struct JimParserCtx *pc);
1095 static int JimParseEol(struct JimParserCtx *pc);
1096 static int JimParseCmd(struct JimParserCtx *pc);
1097 static int JimParseQuote(struct JimParserCtx *pc);
1098 static int JimParseVar(struct JimParserCtx *pc);
1099 static int JimParseBrace(struct JimParserCtx *pc);
1100 static int JimParseStr(struct JimParserCtx *pc);
1101 static int JimParseComment(struct JimParserCtx *pc);
1102 static void JimParseSubCmd(struct JimParserCtx *pc);
1103 static int JimParseSubQuote(struct JimParserCtx *pc);
1104 static void JimParseSubCmd(struct JimParserCtx *pc);
1105 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc);
1107 /* Initialize a parser context.
1108 * 'prg' is a pointer to the program text, linenr is the line
1109 * number of the first line contained in the program. */
1110 static void JimParserInit(struct JimParserCtx *pc, const char *prg, int len, int linenr)
1112 pc->p = prg;
1113 pc->len = len;
1114 pc->tstart = NULL;
1115 pc->tend = NULL;
1116 pc->tline = 0;
1117 pc->tt = JIM_TT_NONE;
1118 pc->eof = 0;
1119 pc->state = JIM_PS_DEF;
1120 pc->linenr = linenr;
1121 pc->comment = 1;
1122 pc->missing = ' ';
1123 pc->missingline = linenr;
1126 static int JimParseScript(struct JimParserCtx *pc)
1128 while (1) { /* the while is used to reiterate with continue if needed */
1129 if (!pc->len) {
1130 pc->tstart = pc->p;
1131 pc->tend = pc->p - 1;
1132 pc->tline = pc->linenr;
1133 pc->tt = JIM_TT_EOL;
1134 pc->eof = 1;
1135 return JIM_OK;
1137 switch (*(pc->p)) {
1138 case '\\':
1139 if (*(pc->p + 1) == '\n' && pc->state == JIM_PS_DEF) {
1140 return JimParseSep(pc);
1142 pc->comment = 0;
1143 return JimParseStr(pc);
1144 case ' ':
1145 case '\t':
1146 case '\r':
1147 case '\f':
1148 if (pc->state == JIM_PS_DEF)
1149 return JimParseSep(pc);
1150 pc->comment = 0;
1151 return JimParseStr(pc);
1152 case '\n':
1153 case ';':
1154 pc->comment = 1;
1155 if (pc->state == JIM_PS_DEF)
1156 return JimParseEol(pc);
1157 return JimParseStr(pc);
1158 case '[':
1159 pc->comment = 0;
1160 return JimParseCmd(pc);
1161 case '$':
1162 pc->comment = 0;
1163 if (JimParseVar(pc) == JIM_ERR) {
1164 /* An orphan $. Create as a separate token */
1165 pc->tstart = pc->tend = pc->p++;
1166 pc->len--;
1167 pc->tt = JIM_TT_ESC;
1169 return JIM_OK;
1170 case '#':
1171 if (pc->comment) {
1172 JimParseComment(pc);
1173 continue;
1175 return JimParseStr(pc);
1176 default:
1177 pc->comment = 0;
1178 return JimParseStr(pc);
1180 return JIM_OK;
1184 static int JimParseSep(struct JimParserCtx *pc)
1186 pc->tstart = pc->p;
1187 pc->tline = pc->linenr;
1188 while (isspace(UCHAR(*pc->p)) || (*pc->p == '\\' && *(pc->p + 1) == '\n')) {
1189 if (*pc->p == '\n') {
1190 break;
1192 if (*pc->p == '\\') {
1193 pc->p++;
1194 pc->len--;
1195 pc->linenr++;
1197 pc->p++;
1198 pc->len--;
1200 pc->tend = pc->p - 1;
1201 pc->tt = JIM_TT_SEP;
1202 return JIM_OK;
1205 static int JimParseEol(struct JimParserCtx *pc)
1207 pc->tstart = pc->p;
1208 pc->tline = pc->linenr;
1209 while (isspace(UCHAR(*pc->p)) || *pc->p == ';') {
1210 if (*pc->p == '\n')
1211 pc->linenr++;
1212 pc->p++;
1213 pc->len--;
1215 pc->tend = pc->p - 1;
1216 pc->tt = JIM_TT_EOL;
1217 return JIM_OK;
1221 ** Here are the rules for parsing:
1222 ** {braced expression}
1223 ** - Count open and closing braces
1224 ** - Backslash escapes meaning of braces
1226 ** "quoted expression"
1227 ** - First double quote at start of word terminates the expression
1228 ** - Backslash escapes quote and bracket
1229 ** - [commands brackets] are counted/nested
1230 ** - command rules apply within [brackets], not quoting rules (i.e. quotes have their own rules)
1232 ** [command expression]
1233 ** - Count open and closing brackets
1234 ** - Backslash escapes quote, bracket and brace
1235 ** - [commands brackets] are counted/nested
1236 ** - "quoted expressions" are parsed according to quoting rules
1237 ** - {braced expressions} are parsed according to brace rules
1239 ** For everything, backslash escapes the next char, newline increments current line
1243 * Parses a braced expression starting at pc->p.
1245 * Positions the parser at the end of the braced expression,
1246 * sets pc->tend and possibly pc->missing.
1248 static void JimParseSubBrace(struct JimParserCtx *pc)
1250 int level = 1;
1252 /* Skip the brace */
1253 pc->p++;
1254 pc->len--;
1255 while (pc->len) {
1256 switch (*pc->p) {
1257 case '\\':
1258 if (pc->len > 1) {
1259 if (*++pc->p == '\n') {
1260 pc->linenr++;
1262 pc->len--;
1264 break;
1266 case '{':
1267 level++;
1268 break;
1270 case '}':
1271 if (--level == 0) {
1272 pc->tend = pc->p - 1;
1273 pc->p++;
1274 pc->len--;
1275 return;
1277 break;
1279 case '\n':
1280 pc->linenr++;
1281 break;
1283 pc->p++;
1284 pc->len--;
1286 pc->missing = '{';
1287 pc->missingline = pc->tline;
1288 pc->tend = pc->p - 1;
1292 * Parses a quoted expression starting at pc->p.
1294 * Positions the parser at the end of the quoted expression,
1295 * sets pc->tend and possibly pc->missing.
1297 * Returns the type of the token of the string,
1298 * either JIM_TT_ESC (if it contains values which need to be [subst]ed)
1299 * or JIM_TT_STR.
1301 static int JimParseSubQuote(struct JimParserCtx *pc)
1303 int tt = JIM_TT_STR;
1304 int line = pc->tline;
1306 /* Skip the quote */
1307 pc->p++;
1308 pc->len--;
1309 while (pc->len) {
1310 switch (*pc->p) {
1311 case '\\':
1312 if (pc->len > 1) {
1313 if (*++pc->p == '\n') {
1314 pc->linenr++;
1316 pc->len--;
1317 tt = JIM_TT_ESC;
1319 break;
1321 case '"':
1322 pc->tend = pc->p - 1;
1323 pc->p++;
1324 pc->len--;
1325 return tt;
1327 case '[':
1328 JimParseSubCmd(pc);
1329 tt = JIM_TT_ESC;
1330 continue;
1332 case '\n':
1333 pc->linenr++;
1334 break;
1336 case '$':
1337 tt = JIM_TT_ESC;
1338 break;
1340 pc->p++;
1341 pc->len--;
1343 pc->missing = '"';
1344 pc->missingline = line;
1345 pc->tend = pc->p - 1;
1346 return tt;
1350 * Parses a [command] expression starting at pc->p.
1352 * Positions the parser at the end of the command expression,
1353 * sets pc->tend and possibly pc->missing.
1355 static void JimParseSubCmd(struct JimParserCtx *pc)
1357 int level = 1;
1358 int startofword = 1;
1359 int line = pc->tline;
1361 /* Skip the bracket */
1362 pc->p++;
1363 pc->len--;
1364 while (pc->len) {
1365 switch (*pc->p) {
1366 case '\\':
1367 if (pc->len > 1) {
1368 if (*++pc->p == '\n') {
1369 pc->linenr++;
1371 pc->len--;
1373 break;
1375 case '[':
1376 level++;
1377 break;
1379 case ']':
1380 if (--level == 0) {
1381 pc->tend = pc->p - 1;
1382 pc->p++;
1383 pc->len--;
1384 return;
1386 break;
1388 case '"':
1389 if (startofword) {
1390 JimParseSubQuote(pc);
1391 continue;
1393 break;
1395 case '{':
1396 JimParseSubBrace(pc);
1397 startofword = 0;
1398 continue;
1400 case '\n':
1401 pc->linenr++;
1402 break;
1404 startofword = isspace(UCHAR(*pc->p));
1405 pc->p++;
1406 pc->len--;
1408 pc->missing = '[';
1409 pc->missingline = line;
1410 pc->tend = pc->p - 1;
1413 static int JimParseBrace(struct JimParserCtx *pc)
1415 pc->tstart = pc->p + 1;
1416 pc->tline = pc->linenr;
1417 pc->tt = JIM_TT_STR;
1418 JimParseSubBrace(pc);
1419 return JIM_OK;
1422 static int JimParseCmd(struct JimParserCtx *pc)
1424 pc->tstart = pc->p + 1;
1425 pc->tline = pc->linenr;
1426 pc->tt = JIM_TT_CMD;
1427 JimParseSubCmd(pc);
1428 return JIM_OK;
1431 static int JimParseQuote(struct JimParserCtx *pc)
1433 pc->tstart = pc->p + 1;
1434 pc->tline = pc->linenr;
1435 pc->tt = JimParseSubQuote(pc);
1436 return JIM_OK;
1439 static int JimParseVar(struct JimParserCtx *pc)
1441 /* skip the $ */
1442 pc->p++;
1443 pc->len--;
1445 #ifdef EXPRSUGAR_BRACKET
1446 if (*pc->p == '[') {
1447 /* Parse $[...] expr shorthand syntax */
1448 JimParseCmd(pc);
1449 pc->tt = JIM_TT_EXPRSUGAR;
1450 return JIM_OK;
1452 #endif
1454 pc->tstart = pc->p;
1455 pc->tt = JIM_TT_VAR;
1456 pc->tline = pc->linenr;
1458 if (*pc->p == '{') {
1459 pc->tstart = ++pc->p;
1460 pc->len--;
1462 while (pc->len && *pc->p != '}') {
1463 if (*pc->p == '\n') {
1464 pc->linenr++;
1466 pc->p++;
1467 pc->len--;
1469 pc->tend = pc->p - 1;
1470 if (pc->len) {
1471 pc->p++;
1472 pc->len--;
1475 else {
1476 while (1) {
1477 /* Skip double colon, but not single colon! */
1478 if (pc->p[0] == ':' && pc->p[1] == ':') {
1479 pc->p += 2;
1480 pc->len -= 2;
1481 continue;
1483 /* Note that any char >= 0x80 must be part of a utf-8 char.
1484 * We consider all unicode points outside of ASCII as letters
1486 if (isalnum(UCHAR(*pc->p)) || *pc->p == '_' || UCHAR(*pc->p) >= 0x80) {
1487 pc->p++;
1488 pc->len--;
1489 continue;
1491 break;
1493 /* Parse [dict get] syntax sugar. */
1494 if (*pc->p == '(') {
1495 int count = 1;
1496 const char *paren = NULL;
1498 pc->tt = JIM_TT_DICTSUGAR;
1500 while (count && pc->len) {
1501 pc->p++;
1502 pc->len--;
1503 if (*pc->p == '\\' && pc->len >= 1) {
1504 pc->p++;
1505 pc->len--;
1507 else if (*pc->p == '(') {
1508 count++;
1510 else if (*pc->p == ')') {
1511 paren = pc->p;
1512 count--;
1515 if (count == 0) {
1516 pc->p++;
1517 pc->len--;
1519 else if (paren) {
1520 /* Did not find a matching paren. Back up */
1521 paren++;
1522 pc->len += (pc->p - paren);
1523 pc->p = paren;
1525 #ifndef EXPRSUGAR_BRACKET
1526 if (*pc->tstart == '(') {
1527 pc->tt = JIM_TT_EXPRSUGAR;
1529 #endif
1531 pc->tend = pc->p - 1;
1533 /* Check if we parsed just the '$' character.
1534 * That's not a variable so an error is returned
1535 * to tell the state machine to consider this '$' just
1536 * a string. */
1537 if (pc->tstart == pc->p) {
1538 pc->p--;
1539 pc->len++;
1540 return JIM_ERR;
1542 return JIM_OK;
1545 static int JimParseStr(struct JimParserCtx *pc)
1547 if (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1548 pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR) {
1549 /* Starting a new word */
1550 if (*pc->p == '{') {
1551 return JimParseBrace(pc);
1553 if (*pc->p == '"') {
1554 pc->state = JIM_PS_QUOTE;
1555 pc->p++;
1556 pc->len--;
1557 /* In case the end quote is missing */
1558 pc->missingline = pc->tline;
1561 pc->tstart = pc->p;
1562 pc->tline = pc->linenr;
1563 while (1) {
1564 if (pc->len == 0) {
1565 if (pc->state == JIM_PS_QUOTE) {
1566 pc->missing = '"';
1568 pc->tend = pc->p - 1;
1569 pc->tt = JIM_TT_ESC;
1570 return JIM_OK;
1572 switch (*pc->p) {
1573 case '\\':
1574 if (pc->state == JIM_PS_DEF && *(pc->p + 1) == '\n') {
1575 pc->tend = pc->p - 1;
1576 pc->tt = JIM_TT_ESC;
1577 return JIM_OK;
1579 if (pc->len >= 2) {
1580 if (*(pc->p + 1) == '\n') {
1581 pc->linenr++;
1583 pc->p++;
1584 pc->len--;
1586 break;
1587 case '(':
1588 /* If the following token is not '$' just keep going */
1589 if (pc->len > 1 && pc->p[1] != '$') {
1590 break;
1592 case ')':
1593 /* Only need a separate ')' token if the previous was a var */
1594 if (*pc->p == '(' || pc->tt == JIM_TT_VAR) {
1595 if (pc->p == pc->tstart) {
1596 /* At the start of the token, so just return this char */
1597 pc->p++;
1598 pc->len--;
1600 pc->tend = pc->p - 1;
1601 pc->tt = JIM_TT_ESC;
1602 return JIM_OK;
1604 break;
1606 case '$':
1607 case '[':
1608 pc->tend = pc->p - 1;
1609 pc->tt = JIM_TT_ESC;
1610 return JIM_OK;
1611 case ' ':
1612 case '\t':
1613 case '\n':
1614 case '\r':
1615 case '\f':
1616 case ';':
1617 if (pc->state == JIM_PS_DEF) {
1618 pc->tend = pc->p - 1;
1619 pc->tt = JIM_TT_ESC;
1620 return JIM_OK;
1622 else if (*pc->p == '\n') {
1623 pc->linenr++;
1625 break;
1626 case '"':
1627 if (pc->state == JIM_PS_QUOTE) {
1628 pc->tend = pc->p - 1;
1629 pc->tt = JIM_TT_ESC;
1630 pc->p++;
1631 pc->len--;
1632 pc->state = JIM_PS_DEF;
1633 return JIM_OK;
1635 break;
1637 pc->p++;
1638 pc->len--;
1640 return JIM_OK; /* unreached */
1643 static int JimParseComment(struct JimParserCtx *pc)
1645 while (*pc->p) {
1646 if (*pc->p == '\n') {
1647 pc->linenr++;
1648 if (*(pc->p - 1) != '\\') {
1649 pc->p++;
1650 pc->len--;
1651 return JIM_OK;
1654 pc->p++;
1655 pc->len--;
1657 return JIM_OK;
1660 /* xdigitval and odigitval are helper functions for JimEscape() */
1661 static int xdigitval(int c)
1663 if (c >= '0' && c <= '9')
1664 return c - '0';
1665 if (c >= 'a' && c <= 'f')
1666 return c - 'a' + 10;
1667 if (c >= 'A' && c <= 'F')
1668 return c - 'A' + 10;
1669 return -1;
1672 static int odigitval(int c)
1674 if (c >= '0' && c <= '7')
1675 return c - '0';
1676 return -1;
1679 /* Perform Tcl escape substitution of 's', storing the result
1680 * string into 'dest'. The escaped string is guaranteed to
1681 * be the same length or shorted than the source string.
1682 * Slen is the length of the string at 's', if it's -1 the string
1683 * length will be calculated by the function.
1685 * The function returns the length of the resulting string. */
1686 static int JimEscape(char *dest, const char *s, int slen)
1688 char *p = dest;
1689 int i, len;
1691 if (slen == -1)
1692 slen = strlen(s);
1694 for (i = 0; i < slen; i++) {
1695 switch (s[i]) {
1696 case '\\':
1697 switch (s[i + 1]) {
1698 case 'a':
1699 *p++ = 0x7;
1700 i++;
1701 break;
1702 case 'b':
1703 *p++ = 0x8;
1704 i++;
1705 break;
1706 case 'f':
1707 *p++ = 0xc;
1708 i++;
1709 break;
1710 case 'n':
1711 *p++ = 0xa;
1712 i++;
1713 break;
1714 case 'r':
1715 *p++ = 0xd;
1716 i++;
1717 break;
1718 case 't':
1719 *p++ = 0x9;
1720 i++;
1721 break;
1722 case 'u':
1723 case 'U':
1724 case 'x':
1725 /* A unicode or hex sequence.
1726 * \x Expect 1-2 hex chars and convert to hex.
1727 * \u Expect 1-4 hex chars and convert to utf-8.
1728 * \U Expect 1-8 hex chars and convert to utf-8.
1729 * \u{NNN} supports 1-6 hex chars and convert to utf-8.
1730 * An invalid sequence means simply the escaped char.
1733 unsigned val = 0;
1734 int k;
1735 int maxchars = 2;
1737 i++;
1739 if (s[i] == 'U') {
1740 maxchars = 8;
1742 else if (s[i] == 'u') {
1743 if (s[i + 1] == '{') {
1744 maxchars = 6;
1745 i++;
1747 else {
1748 maxchars = 4;
1752 for (k = 0; k < maxchars; k++) {
1753 int c = xdigitval(s[i + k + 1]);
1754 if (c == -1) {
1755 break;
1757 val = (val << 4) | c;
1759 /* The \u{nnn} syntax supports up to 21 bit codepoints. */
1760 if (s[i] == '{') {
1761 if (k == 0 || val > 0x1fffff || s[i + k + 1] != '}') {
1762 /* Back up */
1763 i--;
1764 k = 0;
1766 else {
1767 /* Skip the closing brace */
1768 k++;
1771 if (k) {
1772 /* Got a valid sequence, so convert */
1773 if (s[i] == 'x') {
1774 *p++ = val;
1776 else {
1777 p += utf8_fromunicode(p, val);
1779 i += k;
1780 break;
1782 /* Not a valid codepoint, just an escaped char */
1783 *p++ = s[i];
1785 break;
1786 case 'v':
1787 *p++ = 0xb;
1788 i++;
1789 break;
1790 case '\0':
1791 *p++ = '\\';
1792 i++;
1793 break;
1794 case '\n':
1795 /* Replace all spaces and tabs after backslash newline with a single space*/
1796 *p++ = ' ';
1797 do {
1798 i++;
1799 } while (s[i + 1] == ' ' || s[i + 1] == '\t');
1800 break;
1801 case '0':
1802 case '1':
1803 case '2':
1804 case '3':
1805 case '4':
1806 case '5':
1807 case '6':
1808 case '7':
1809 /* octal escape */
1811 int val = 0;
1812 int c = odigitval(s[i + 1]);
1814 val = c;
1815 c = odigitval(s[i + 2]);
1816 if (c == -1) {
1817 *p++ = val;
1818 i++;
1819 break;
1821 val = (val * 8) + c;
1822 c = odigitval(s[i + 3]);
1823 if (c == -1) {
1824 *p++ = val;
1825 i += 2;
1826 break;
1828 val = (val * 8) + c;
1829 *p++ = val;
1830 i += 3;
1832 break;
1833 default:
1834 *p++ = s[i + 1];
1835 i++;
1836 break;
1838 break;
1839 default:
1840 *p++ = s[i];
1841 break;
1844 len = p - dest;
1845 *p = '\0';
1846 return len;
1849 /* Returns a dynamically allocated copy of the current token in the
1850 * parser context. The function performs conversion of escapes if
1851 * the token is of type JIM_TT_ESC.
1853 * Note that after the conversion, tokens that are grouped with
1854 * braces in the source code, are always recognizable from the
1855 * identical string obtained in a different way from the type.
1857 * For example the string:
1859 * {*}$a
1861 * will return as first token "*", of type JIM_TT_STR
1863 * While the string:
1865 * *$a
1867 * will return as first token "*", of type JIM_TT_ESC
1869 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc)
1871 const char *start, *end;
1872 char *token;
1873 int len;
1875 start = pc->tstart;
1876 end = pc->tend;
1877 if (start > end) {
1878 len = 0;
1879 token = Jim_Alloc(1);
1880 token[0] = '\0';
1882 else {
1883 len = (end - start) + 1;
1884 token = Jim_Alloc(len + 1);
1885 if (pc->tt != JIM_TT_ESC) {
1886 /* No escape conversion needed? Just copy it. */
1887 memcpy(token, start, len);
1888 token[len] = '\0';
1890 else {
1891 /* Else convert the escape chars. */
1892 len = JimEscape(token, start, len);
1896 return Jim_NewStringObjNoAlloc(interp, token, len);
1899 /* Parses the given string to determine if it represents a complete script.
1901 * This is useful for interactive shells implementation, for [info complete].
1903 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
1904 * '{' on scripts incomplete missing one or more '}' to be balanced.
1905 * '[' on scripts incomplete missing one or more ']' to be balanced.
1906 * '"' on scripts incomplete missing a '"' char.
1908 * If the script is complete, 1 is returned, otherwise 0.
1910 int Jim_ScriptIsComplete(const char *s, int len, char *stateCharPtr)
1912 struct JimParserCtx parser;
1914 JimParserInit(&parser, s, len, 1);
1915 while (!parser.eof) {
1916 JimParseScript(&parser);
1918 if (stateCharPtr) {
1919 *stateCharPtr = parser.missing;
1921 return parser.missing == ' ';
1924 /* -----------------------------------------------------------------------------
1925 * Tcl Lists parsing
1926 * ---------------------------------------------------------------------------*/
1927 static int JimParseListSep(struct JimParserCtx *pc);
1928 static int JimParseListStr(struct JimParserCtx *pc);
1929 static int JimParseListQuote(struct JimParserCtx *pc);
1931 static int JimParseList(struct JimParserCtx *pc)
1933 if (isspace(UCHAR(*pc->p))) {
1934 return JimParseListSep(pc);
1936 switch (*pc->p) {
1937 case '"':
1938 return JimParseListQuote(pc);
1940 case '{':
1941 return JimParseBrace(pc);
1943 default:
1944 if (pc->len) {
1945 return JimParseListStr(pc);
1947 break;
1950 pc->tstart = pc->tend = pc->p;
1951 pc->tline = pc->linenr;
1952 pc->tt = JIM_TT_EOL;
1953 pc->eof = 1;
1954 return JIM_OK;
1957 static int JimParseListSep(struct JimParserCtx *pc)
1959 pc->tstart = pc->p;
1960 pc->tline = pc->linenr;
1961 while (isspace(UCHAR(*pc->p))) {
1962 if (*pc->p == '\n') {
1963 pc->linenr++;
1965 pc->p++;
1966 pc->len--;
1968 pc->tend = pc->p - 1;
1969 pc->tt = JIM_TT_SEP;
1970 return JIM_OK;
1973 static int JimParseListQuote(struct JimParserCtx *pc)
1975 pc->p++;
1976 pc->len--;
1978 pc->tstart = pc->p;
1979 pc->tline = pc->linenr;
1980 pc->tt = JIM_TT_STR;
1982 while (pc->len) {
1983 switch (*pc->p) {
1984 case '\\':
1985 pc->tt = JIM_TT_ESC;
1986 if (--pc->len == 0) {
1987 /* Trailing backslash */
1988 pc->tend = pc->p;
1989 return JIM_OK;
1991 pc->p++;
1992 break;
1993 case '\n':
1994 pc->linenr++;
1995 break;
1996 case '"':
1997 pc->tend = pc->p - 1;
1998 pc->p++;
1999 pc->len--;
2000 return JIM_OK;
2002 pc->p++;
2003 pc->len--;
2006 pc->tend = pc->p - 1;
2007 return JIM_OK;
2010 static int JimParseListStr(struct JimParserCtx *pc)
2012 pc->tstart = pc->p;
2013 pc->tline = pc->linenr;
2014 pc->tt = JIM_TT_STR;
2016 while (pc->len) {
2017 if (isspace(UCHAR(*pc->p))) {
2018 pc->tend = pc->p - 1;
2019 return JIM_OK;
2021 if (*pc->p == '\\') {
2022 if (--pc->len == 0) {
2023 /* Trailing backslash */
2024 pc->tend = pc->p;
2025 return JIM_OK;
2027 pc->tt = JIM_TT_ESC;
2028 pc->p++;
2030 pc->p++;
2031 pc->len--;
2033 pc->tend = pc->p - 1;
2034 return JIM_OK;
2037 /* -----------------------------------------------------------------------------
2038 * Jim_Obj related functions
2039 * ---------------------------------------------------------------------------*/
2041 /* Return a new initialized object. */
2042 Jim_Obj *Jim_NewObj(Jim_Interp *interp)
2044 Jim_Obj *objPtr;
2046 /* -- Check if there are objects in the free list -- */
2047 if (interp->freeList != NULL) {
2048 /* -- Unlink the object from the free list -- */
2049 objPtr = interp->freeList;
2050 interp->freeList = objPtr->nextObjPtr;
2052 else {
2053 /* -- No ready to use objects: allocate a new one -- */
2054 objPtr = Jim_Alloc(sizeof(*objPtr));
2057 /* Object is returned with refCount of 0. Every
2058 * kind of GC implemented should take care to don't try
2059 * to scan objects with refCount == 0. */
2060 objPtr->refCount = 0;
2061 /* All the other fields are left not initialized to save time.
2062 * The caller will probably want to set them to the right
2063 * value anyway. */
2065 /* -- Put the object into the live list -- */
2066 objPtr->prevObjPtr = NULL;
2067 objPtr->nextObjPtr = interp->liveList;
2068 if (interp->liveList)
2069 interp->liveList->prevObjPtr = objPtr;
2070 interp->liveList = objPtr;
2072 return objPtr;
2075 /* Free an object. Actually objects are never freed, but
2076 * just moved to the free objects list, where they will be
2077 * reused by Jim_NewObj(). */
2078 void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr)
2080 /* Check if the object was already freed, panic. */
2081 JimPanic((objPtr->refCount != 0, "!!!Object %p freed with bad refcount %d, type=%s", objPtr,
2082 objPtr->refCount, objPtr->typePtr ? objPtr->typePtr->name : "<none>"));
2084 /* Free the internal representation */
2085 Jim_FreeIntRep(interp, objPtr);
2086 /* Free the string representation */
2087 if (objPtr->bytes != NULL) {
2088 if (objPtr->bytes != JimEmptyStringRep)
2089 Jim_Free(objPtr->bytes);
2091 /* Unlink the object from the live objects list */
2092 if (objPtr->prevObjPtr)
2093 objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr;
2094 if (objPtr->nextObjPtr)
2095 objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr;
2096 if (interp->liveList == objPtr)
2097 interp->liveList = objPtr->nextObjPtr;
2098 /* Link the object into the free objects list */
2099 objPtr->prevObjPtr = NULL;
2100 objPtr->nextObjPtr = interp->freeList;
2101 if (interp->freeList)
2102 interp->freeList->prevObjPtr = objPtr;
2103 interp->freeList = objPtr;
2104 objPtr->refCount = -1;
2107 /* Invalidate the string representation of an object. */
2108 void Jim_InvalidateStringRep(Jim_Obj *objPtr)
2110 if (objPtr->bytes != NULL) {
2111 if (objPtr->bytes != JimEmptyStringRep)
2112 Jim_Free(objPtr->bytes);
2114 objPtr->bytes = NULL;
2117 #define Jim_SetStringRep(o, b, l) \
2118 do { (o)->bytes = b; (o)->length = l; } while (0)
2120 /* Set the initial string representation for an object.
2121 * Does not try to free an old one. */
2122 void Jim_InitStringRep(Jim_Obj *objPtr, const char *bytes, int length)
2124 if (length == 0) {
2125 objPtr->bytes = JimEmptyStringRep;
2126 objPtr->length = 0;
2128 else {
2129 objPtr->bytes = Jim_Alloc(length + 1);
2130 objPtr->length = length;
2131 memcpy(objPtr->bytes, bytes, length);
2132 objPtr->bytes[length] = '\0';
2136 /* Duplicate an object. The returned object has refcount = 0. */
2137 Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
2139 Jim_Obj *dupPtr;
2141 dupPtr = Jim_NewObj(interp);
2142 if (objPtr->bytes == NULL) {
2143 /* Object does not have a valid string representation. */
2144 dupPtr->bytes = NULL;
2146 else {
2147 Jim_InitStringRep(dupPtr, objPtr->bytes, objPtr->length);
2150 /* By default, the new object has the same type as the old object */
2151 dupPtr->typePtr = objPtr->typePtr;
2152 if (objPtr->typePtr != NULL) {
2153 if (objPtr->typePtr->dupIntRepProc == NULL) {
2154 dupPtr->internalRep = objPtr->internalRep;
2156 else {
2157 /* The dup proc may set a different type, e.g. NULL */
2158 objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr);
2161 return dupPtr;
2164 /* Return the string representation for objPtr. If the object
2165 * string representation is invalid, calls the method to create
2166 * a new one starting from the internal representation of the object. */
2167 const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr)
2169 if (objPtr->bytes == NULL) {
2170 /* Invalid string repr. Generate it. */
2171 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2172 objPtr->typePtr->updateStringProc(objPtr);
2174 if (lenPtr)
2175 *lenPtr = objPtr->length;
2176 return objPtr->bytes;
2179 /* Just returns the length of the object's string rep */
2180 int Jim_Length(Jim_Obj *objPtr)
2182 if (objPtr->bytes == NULL) {
2183 /* Invalid string repr. Generate it. */
2184 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2185 objPtr->typePtr->updateStringProc(objPtr);
2187 return objPtr->length;
2190 /* Just returns the length of the object's string rep */
2191 const char *Jim_String(Jim_Obj *objPtr)
2193 if (objPtr->bytes == NULL) {
2194 /* Invalid string repr. Generate it. */
2195 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2196 objPtr->typePtr->updateStringProc(objPtr);
2198 return objPtr->bytes;
2201 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2202 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2204 static const Jim_ObjType dictSubstObjType = {
2205 "dict-substitution",
2206 FreeDictSubstInternalRep,
2207 DupDictSubstInternalRep,
2208 NULL,
2209 JIM_TYPE_NONE,
2212 static void FreeInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2214 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
2217 static const Jim_ObjType interpolatedObjType = {
2218 "interpolated",
2219 FreeInterpolatedInternalRep,
2220 NULL,
2221 NULL,
2222 JIM_TYPE_NONE,
2225 /* -----------------------------------------------------------------------------
2226 * String Object
2227 * ---------------------------------------------------------------------------*/
2228 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2229 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2231 static const Jim_ObjType stringObjType = {
2232 "string",
2233 NULL,
2234 DupStringInternalRep,
2235 NULL,
2236 JIM_TYPE_REFERENCES,
2239 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2241 JIM_NOTUSED(interp);
2243 /* This is a bit subtle: the only caller of this function
2244 * should be Jim_DuplicateObj(), that will copy the
2245 * string representaion. After the copy, the duplicated
2246 * object will not have more room in teh buffer than
2247 * srcPtr->length bytes. So we just set it to length. */
2248 dupPtr->internalRep.strValue.maxLength = srcPtr->length;
2250 dupPtr->internalRep.strValue.charLength = srcPtr->internalRep.strValue.charLength;
2253 static int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
2255 if (objPtr->typePtr != &stringObjType) {
2256 /* Get a fresh string representation. */
2257 if (objPtr->bytes == NULL) {
2258 /* Invalid string repr. Generate it. */
2259 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2260 objPtr->typePtr->updateStringProc(objPtr);
2262 /* Free any other internal representation. */
2263 Jim_FreeIntRep(interp, objPtr);
2264 /* Set it as string, i.e. just set the maxLength field. */
2265 objPtr->typePtr = &stringObjType;
2266 objPtr->internalRep.strValue.maxLength = objPtr->length;
2267 /* Don't know the utf-8 length yet */
2268 objPtr->internalRep.strValue.charLength = -1;
2270 return JIM_OK;
2274 * Returns the length of the object string in chars, not bytes.
2276 * These may be different for a utf-8 string.
2278 int Jim_Utf8Length(Jim_Interp *interp, Jim_Obj *objPtr)
2280 #ifdef JIM_UTF8
2281 SetStringFromAny(interp, objPtr);
2283 if (objPtr->internalRep.strValue.charLength < 0) {
2284 objPtr->internalRep.strValue.charLength = utf8_strlen(objPtr->bytes, objPtr->length);
2286 return objPtr->internalRep.strValue.charLength;
2287 #else
2288 return Jim_Length(objPtr);
2289 #endif
2292 /* len is in bytes -- see also Jim_NewStringObjUtf8() */
2293 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
2295 Jim_Obj *objPtr = Jim_NewObj(interp);
2297 /* Need to find out how many bytes the string requires */
2298 if (len == -1)
2299 len = strlen(s);
2300 /* Alloc/Set the string rep. */
2301 if (len == 0) {
2302 objPtr->bytes = JimEmptyStringRep;
2303 objPtr->length = 0;
2305 else {
2306 objPtr->bytes = Jim_Alloc(len + 1);
2307 objPtr->length = len;
2308 memcpy(objPtr->bytes, s, len);
2309 objPtr->bytes[len] = '\0';
2312 /* No typePtr field for the vanilla string object. */
2313 objPtr->typePtr = NULL;
2314 return objPtr;
2317 /* charlen is in characters -- see also Jim_NewStringObj() */
2318 Jim_Obj *Jim_NewStringObjUtf8(Jim_Interp *interp, const char *s, int charlen)
2320 #ifdef JIM_UTF8
2321 /* Need to find out how many bytes the string requires */
2322 int bytelen = utf8_index(s, charlen);
2324 Jim_Obj *objPtr = Jim_NewStringObj(interp, s, bytelen);
2326 /* Remember the utf8 length, so set the type */
2327 objPtr->typePtr = &stringObjType;
2328 objPtr->internalRep.strValue.maxLength = bytelen;
2329 objPtr->internalRep.strValue.charLength = charlen;
2331 return objPtr;
2332 #else
2333 return Jim_NewStringObj(interp, s, charlen);
2334 #endif
2337 /* This version does not try to duplicate the 's' pointer, but
2338 * use it directly. */
2339 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
2341 Jim_Obj *objPtr = Jim_NewObj(interp);
2343 if (len == -1)
2344 len = strlen(s);
2345 Jim_SetStringRep(objPtr, s, len);
2346 objPtr->typePtr = NULL;
2347 return objPtr;
2350 /* Low-level string append. Use it only against objects
2351 * of type "string". */
2352 static void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
2354 int needlen;
2356 if (len == -1)
2357 len = strlen(str);
2358 needlen = objPtr->length + len;
2359 if (objPtr->internalRep.strValue.maxLength < needlen ||
2360 objPtr->internalRep.strValue.maxLength == 0) {
2361 needlen *= 2;
2362 /* Inefficient to malloc() for less than 8 bytes */
2363 if (needlen < 7) {
2364 needlen = 7;
2366 if (objPtr->bytes == JimEmptyStringRep) {
2367 objPtr->bytes = Jim_Alloc(needlen + 1);
2369 else {
2370 objPtr->bytes = Jim_Realloc(objPtr->bytes, needlen + 1);
2372 objPtr->internalRep.strValue.maxLength = needlen;
2374 memcpy(objPtr->bytes + objPtr->length, str, len);
2375 objPtr->bytes[objPtr->length + len] = '\0';
2376 if (objPtr->internalRep.strValue.charLength >= 0) {
2377 /* Update the utf-8 char length */
2378 objPtr->internalRep.strValue.charLength += utf8_strlen(objPtr->bytes + objPtr->length, len);
2380 objPtr->length += len;
2383 /* Higher level API to append strings to objects. */
2384 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str, int len)
2386 JimPanic((Jim_IsShared(objPtr), "Jim_AppendString called with shared object"));
2387 SetStringFromAny(interp, objPtr);
2388 StringAppendString(objPtr, str, len);
2391 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *appendObjPtr)
2393 int len;
2394 const char *str;
2396 str = Jim_GetString(appendObjPtr, &len);
2397 Jim_AppendString(interp, objPtr, str, len);
2400 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2402 va_list ap;
2404 SetStringFromAny(interp, objPtr);
2405 va_start(ap, objPtr);
2406 while (1) {
2407 char *s = va_arg(ap, char *);
2409 if (s == NULL)
2410 break;
2411 Jim_AppendString(interp, objPtr, s, -1);
2413 va_end(ap);
2416 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr)
2418 const char *aStr, *bStr;
2419 int aLen, bLen;
2421 if (aObjPtr == bObjPtr)
2422 return 1;
2423 aStr = Jim_GetString(aObjPtr, &aLen);
2424 bStr = Jim_GetString(bObjPtr, &bLen);
2425 if (aLen != bLen)
2426 return 0;
2427 return JimStringCompare(aStr, aLen, bStr, bLen) == 0;
2430 int Jim_StringMatchObj(Jim_Interp *interp, Jim_Obj *patternObjPtr, Jim_Obj *objPtr, int nocase)
2432 return JimGlobMatch(Jim_String(patternObjPtr), Jim_String(objPtr), nocase);
2435 int Jim_StringCompareObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2437 int l1, l2;
2438 const char *s1 = Jim_GetString(firstObjPtr, &l1);
2439 const char *s2 = Jim_GetString(secondObjPtr, &l2);
2441 if (nocase) {
2442 /* Do a character compare for nocase */
2443 return JimStringCompareLen(s1, s2, -1, nocase);
2445 return JimStringCompare(s1, l1, s2, l2);
2449 * Like Jim_StringCompareObj() except compares to a maximum of the length of firstObjPtr.
2451 int Jim_StringCompareLenObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2453 const char *s1 = Jim_String(firstObjPtr);
2454 const char *s2 = Jim_String(secondObjPtr);
2456 return JimStringCompareLen(s1, s2, Jim_Utf8Length(interp, firstObjPtr), nocase);
2459 /* Convert a range, as returned by Jim_GetRange(), into
2460 * an absolute index into an object of the specified length.
2461 * This function may return negative values, or values
2462 * bigger or equal to the length of the list if the index
2463 * is out of range. */
2464 static int JimRelToAbsIndex(int len, int idx)
2466 if (idx < 0)
2467 return len + idx;
2468 return idx;
2471 /* Convert a pair of index (*firstPtr, *lastPtr) as normalized by JimRelToAbsIndex(),
2472 * into form suitable for implementation of commands like [string range] and [lrange].
2474 * The resulting range is guaranteed to address valid elements of
2475 * the structure.
2478 static void JimRelToAbsRange(int len, int *firstPtr, int *lastPtr, int *rangeLenPtr)
2480 int rangeLen;
2482 if (*firstPtr > *lastPtr) {
2483 rangeLen = 0;
2485 else {
2486 rangeLen = *lastPtr - *firstPtr + 1;
2487 if (rangeLen) {
2488 if (*firstPtr < 0) {
2489 rangeLen += *firstPtr;
2490 *firstPtr = 0;
2492 if (*lastPtr >= len) {
2493 rangeLen -= (*lastPtr - (len - 1));
2494 *lastPtr = len - 1;
2498 if (rangeLen < 0)
2499 rangeLen = 0;
2501 *rangeLenPtr = rangeLen;
2504 static int JimStringGetRange(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr,
2505 int len, int *first, int *last, int *range)
2507 if (Jim_GetIndex(interp, firstObjPtr, first) != JIM_OK) {
2508 return JIM_ERR;
2510 if (Jim_GetIndex(interp, lastObjPtr, last) != JIM_OK) {
2511 return JIM_ERR;
2513 *first = JimRelToAbsIndex(len, *first);
2514 *last = JimRelToAbsIndex(len, *last);
2515 JimRelToAbsRange(len, first, last, range);
2516 return JIM_OK;
2519 Jim_Obj *Jim_StringByteRangeObj(Jim_Interp *interp,
2520 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2522 int first, last;
2523 const char *str;
2524 int rangeLen;
2525 int bytelen;
2527 str = Jim_GetString(strObjPtr, &bytelen);
2529 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, bytelen, &first, &last, &rangeLen) != JIM_OK) {
2530 return NULL;
2533 if (first == 0 && rangeLen == bytelen) {
2534 return strObjPtr;
2536 return Jim_NewStringObj(interp, str + first, rangeLen);
2539 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2540 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2542 #ifdef JIM_UTF8
2543 int first, last;
2544 const char *str;
2545 int len, rangeLen;
2546 int bytelen;
2548 str = Jim_GetString(strObjPtr, &bytelen);
2549 len = Jim_Utf8Length(interp, strObjPtr);
2551 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2552 return NULL;
2555 if (first == 0 && rangeLen == len) {
2556 return strObjPtr;
2558 if (len == bytelen) {
2559 /* ASCII optimisation */
2560 return Jim_NewStringObj(interp, str + first, rangeLen);
2562 return Jim_NewStringObjUtf8(interp, str + utf8_index(str, first), rangeLen);
2563 #else
2564 return Jim_StringByteRangeObj(interp, strObjPtr, firstObjPtr, lastObjPtr);
2565 #endif
2568 Jim_Obj *JimStringReplaceObj(Jim_Interp *interp,
2569 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr, Jim_Obj *newStrObj)
2571 int first, last;
2572 const char *str;
2573 int len, rangeLen;
2574 Jim_Obj *objPtr;
2576 len = Jim_Utf8Length(interp, strObjPtr);
2578 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2579 return NULL;
2582 if (last <= first) {
2583 return strObjPtr;
2586 str = Jim_String(strObjPtr);
2588 /* Before part */
2589 objPtr = Jim_NewStringObjUtf8(interp, str, first);
2591 /* Replacement */
2592 if (newStrObj) {
2593 Jim_AppendObj(interp, objPtr, newStrObj);
2596 /* After part */
2597 Jim_AppendString(interp, objPtr, str + utf8_index(str, last + 1), len - last - 1);
2599 return objPtr;
2602 static void JimStrCopyUpperLower(char *dest, const char *str, int uc)
2604 while (*str) {
2605 int c;
2606 str += utf8_tounicode(str, &c);
2607 dest += utf8_fromunicode(dest, uc ? utf8_upper(c) : utf8_lower(c));
2609 *dest = 0;
2612 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2614 char *buf;
2615 int len;
2616 const char *str;
2618 SetStringFromAny(interp, strObjPtr);
2620 str = Jim_GetString(strObjPtr, &len);
2622 #ifdef JIM_UTF8
2623 /* Case mapping can change the utf-8 length of the string.
2624 * But at worst it will be by one extra byte per char
2626 len *= 2;
2627 #endif
2628 buf = Jim_Alloc(len + 1);
2629 JimStrCopyUpperLower(buf, str, 0);
2630 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2633 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2635 char *buf;
2636 const char *str;
2637 int len;
2639 if (strObjPtr->typePtr != &stringObjType) {
2640 SetStringFromAny(interp, strObjPtr);
2643 str = Jim_GetString(strObjPtr, &len);
2645 #ifdef JIM_UTF8
2646 /* Case mapping can change the utf-8 length of the string.
2647 * But at worst it will be by one extra byte per char
2649 len *= 2;
2650 #endif
2651 buf = Jim_Alloc(len + 1);
2652 JimStrCopyUpperLower(buf, str, 1);
2653 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2656 static Jim_Obj *JimStringToTitle(Jim_Interp *interp, Jim_Obj *strObjPtr)
2658 char *buf, *p;
2659 int len;
2660 int c;
2661 const char *str;
2663 str = Jim_GetString(strObjPtr, &len);
2664 if (len == 0) {
2665 return strObjPtr;
2667 #ifdef JIM_UTF8
2668 /* Case mapping can change the utf-8 length of the string.
2669 * But at worst it will be by one extra byte per char
2671 len *= 2;
2672 #endif
2673 buf = p = Jim_Alloc(len + 1);
2675 str += utf8_tounicode(str, &c);
2676 p += utf8_fromunicode(p, utf8_title(c));
2678 JimStrCopyUpperLower(p, str, 0);
2680 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2683 /* Similar to memchr() except searches a UTF-8 string 'str' of byte length 'len'
2684 * for unicode character 'c'.
2685 * Returns the position if found or NULL if not
2687 static const char *utf8_memchr(const char *str, int len, int c)
2689 #ifdef JIM_UTF8
2690 while (len) {
2691 int sc;
2692 int n = utf8_tounicode(str, &sc);
2693 if (sc == c) {
2694 return str;
2696 str += n;
2697 len -= n;
2699 return NULL;
2700 #else
2701 return memchr(str, c, len);
2702 #endif
2706 * Searches for the first non-trim char in string (str, len)
2708 * If none is found, returns just past the last char.
2710 * Lengths are in bytes.
2712 static const char *JimFindTrimLeft(const char *str, int len, const char *trimchars, int trimlen)
2714 while (len) {
2715 int c;
2716 int n = utf8_tounicode(str, &c);
2718 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2719 /* Not a trim char, so stop */
2720 break;
2722 str += n;
2723 len -= n;
2725 return str;
2729 * Searches backwards for a non-trim char in string (str, len).
2731 * Returns a pointer to just after the non-trim char, or NULL if not found.
2733 * Lengths are in bytes.
2735 static const char *JimFindTrimRight(const char *str, int len, const char *trimchars, int trimlen)
2737 str += len;
2739 while (len) {
2740 int c;
2741 int n = utf8_prev_len(str, len);
2743 len -= n;
2744 str -= n;
2746 n = utf8_tounicode(str, &c);
2748 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2749 return str + n;
2753 return NULL;
2756 static const char default_trim_chars[] = " \t\n\r";
2757 /* sizeof() here includes the null byte */
2758 static int default_trim_chars_len = sizeof(default_trim_chars);
2760 static Jim_Obj *JimStringTrimLeft(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2762 int len;
2763 const char *str = Jim_GetString(strObjPtr, &len);
2764 const char *trimchars = default_trim_chars;
2765 int trimcharslen = default_trim_chars_len;
2766 const char *newstr;
2768 if (trimcharsObjPtr) {
2769 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2772 newstr = JimFindTrimLeft(str, len, trimchars, trimcharslen);
2773 if (newstr == str) {
2774 return strObjPtr;
2777 return Jim_NewStringObj(interp, newstr, len - (newstr - str));
2780 static Jim_Obj *JimStringTrimRight(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2782 int len;
2783 const char *trimchars = default_trim_chars;
2784 int trimcharslen = default_trim_chars_len;
2785 const char *nontrim;
2787 if (trimcharsObjPtr) {
2788 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2791 SetStringFromAny(interp, strObjPtr);
2793 len = Jim_Length(strObjPtr);
2794 nontrim = JimFindTrimRight(strObjPtr->bytes, len, trimchars, trimcharslen);
2796 if (nontrim == NULL) {
2797 /* All trim, so return a zero-length string */
2798 return Jim_NewEmptyStringObj(interp);
2800 if (nontrim == strObjPtr->bytes + len) {
2801 return strObjPtr;
2804 if (Jim_IsShared(strObjPtr)) {
2805 strObjPtr = Jim_NewStringObj(interp, strObjPtr->bytes, (nontrim - strObjPtr->bytes));
2807 else {
2808 /* Can modify this string in place */
2809 strObjPtr->bytes[nontrim - strObjPtr->bytes] = 0;
2810 strObjPtr->length = (nontrim - strObjPtr->bytes);
2813 return strObjPtr;
2816 static Jim_Obj *JimStringTrim(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2818 /* First trim left. */
2819 Jim_Obj *objPtr = JimStringTrimLeft(interp, strObjPtr, trimcharsObjPtr);
2821 /* Now trim right */
2822 strObjPtr = JimStringTrimRight(interp, objPtr, trimcharsObjPtr);
2824 if (objPtr != strObjPtr) {
2825 /* Note that we don't want this object to be leaked */
2826 Jim_IncrRefCount(objPtr);
2827 Jim_DecrRefCount(interp, objPtr);
2830 return strObjPtr;
2834 static int JimStringIs(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *strClass, int strict)
2836 static const char * const strclassnames[] = {
2837 "integer", "alpha", "alnum", "ascii", "digit",
2838 "double", "lower", "upper", "space", "xdigit",
2839 "control", "print", "graph", "punct",
2840 NULL
2842 enum {
2843 STR_IS_INTEGER, STR_IS_ALPHA, STR_IS_ALNUM, STR_IS_ASCII, STR_IS_DIGIT,
2844 STR_IS_DOUBLE, STR_IS_LOWER, STR_IS_UPPER, STR_IS_SPACE, STR_IS_XDIGIT,
2845 STR_IS_CONTROL, STR_IS_PRINT, STR_IS_GRAPH, STR_IS_PUNCT
2847 int strclass;
2848 int len;
2849 int i;
2850 const char *str;
2851 int (*isclassfunc)(int c) = NULL;
2853 if (Jim_GetEnum(interp, strClass, strclassnames, &strclass, "class", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
2854 return JIM_ERR;
2857 str = Jim_GetString(strObjPtr, &len);
2858 if (len == 0) {
2859 Jim_SetResultInt(interp, !strict);
2860 return JIM_OK;
2863 switch (strclass) {
2864 case STR_IS_INTEGER:
2866 jim_wide w;
2867 Jim_SetResultInt(interp, JimGetWideNoErr(interp, strObjPtr, &w) == JIM_OK);
2868 return JIM_OK;
2871 case STR_IS_DOUBLE:
2873 double d;
2874 Jim_SetResultInt(interp, Jim_GetDouble(interp, strObjPtr, &d) == JIM_OK && errno != ERANGE);
2875 return JIM_OK;
2878 case STR_IS_ALPHA: isclassfunc = isalpha; break;
2879 case STR_IS_ALNUM: isclassfunc = isalnum; break;
2880 case STR_IS_ASCII: isclassfunc = isascii; break;
2881 case STR_IS_DIGIT: isclassfunc = isdigit; break;
2882 case STR_IS_LOWER: isclassfunc = islower; break;
2883 case STR_IS_UPPER: isclassfunc = isupper; break;
2884 case STR_IS_SPACE: isclassfunc = isspace; break;
2885 case STR_IS_XDIGIT: isclassfunc = isxdigit; break;
2886 case STR_IS_CONTROL: isclassfunc = iscntrl; break;
2887 case STR_IS_PRINT: isclassfunc = isprint; break;
2888 case STR_IS_GRAPH: isclassfunc = isgraph; break;
2889 case STR_IS_PUNCT: isclassfunc = ispunct; break;
2890 default:
2891 return JIM_ERR;
2894 for (i = 0; i < len; i++) {
2895 if (!isclassfunc(str[i])) {
2896 Jim_SetResultInt(interp, 0);
2897 return JIM_OK;
2900 Jim_SetResultInt(interp, 1);
2901 return JIM_OK;
2904 /* -----------------------------------------------------------------------------
2905 * Compared String Object
2906 * ---------------------------------------------------------------------------*/
2908 /* This is strange object that allows to compare a C literal string
2909 * with a Jim object in very short time if the same comparison is done
2910 * multiple times. For example every time the [if] command is executed,
2911 * Jim has to check if a given argument is "else". This comparions if
2912 * the code has no errors are true most of the times, so we can cache
2913 * inside the object the pointer of the string of the last matching
2914 * comparison. Because most C compilers perform literal sharing,
2915 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
2916 * this works pretty well even if comparisons are at different places
2917 * inside the C code. */
2919 static const Jim_ObjType comparedStringObjType = {
2920 "compared-string",
2921 NULL,
2922 NULL,
2923 NULL,
2924 JIM_TYPE_REFERENCES,
2927 /* The only way this object is exposed to the API is via the following
2928 * function. Returns true if the string and the object string repr.
2929 * are the same, otherwise zero is returned.
2931 * Note: this isn't binary safe, but it hardly needs to be.*/
2932 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr, const char *str)
2934 if (objPtr->typePtr == &comparedStringObjType && objPtr->internalRep.ptr == str)
2935 return 1;
2936 else {
2937 const char *objStr = Jim_String(objPtr);
2939 if (strcmp(str, objStr) != 0)
2940 return 0;
2941 if (objPtr->typePtr != &comparedStringObjType) {
2942 Jim_FreeIntRep(interp, objPtr);
2943 objPtr->typePtr = &comparedStringObjType;
2945 objPtr->internalRep.ptr = (char *)str; /*ATTENTION: const cast */
2946 return 1;
2950 static int qsortCompareStringPointers(const void *a, const void *b)
2952 char *const *sa = (char *const *)a;
2953 char *const *sb = (char *const *)b;
2955 return strcmp(*sa, *sb);
2959 /* -----------------------------------------------------------------------------
2960 * Source Object
2962 * This object is just a string from the language point of view, but
2963 * in the internal representation it contains the filename and line number
2964 * where this given token was read. This information is used by
2965 * Jim_EvalObj() if the object passed happens to be of type "source".
2967 * This allows to propagate the information about line numbers and file
2968 * names and give error messages with absolute line numbers.
2970 * Note that this object uses shared strings for filenames, and the
2971 * pointer to the filename together with the line number is taken into
2972 * the space for the "inline" internal representation of the Jim_Object,
2973 * so there is almost memory zero-overhead.
2975 * Also the object will be converted to something else if the given
2976 * token it represents in the source file is not something to be
2977 * evaluated (not a script), and will be specialized in some other way,
2978 * so the time overhead is also null.
2979 * ---------------------------------------------------------------------------*/
2981 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2982 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2984 static const Jim_ObjType sourceObjType = {
2985 "source",
2986 FreeSourceInternalRep,
2987 DupSourceInternalRep,
2988 NULL,
2989 JIM_TYPE_REFERENCES,
2992 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2994 Jim_DecrRefCount(interp, objPtr->internalRep.sourceValue.fileNameObj);
2997 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2999 dupPtr->internalRep = srcPtr->internalRep;
3000 Jim_IncrRefCount(dupPtr->internalRep.sourceValue.fileNameObj);
3003 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
3004 Jim_Obj *fileNameObj, int lineNumber)
3006 JimPanic((Jim_IsShared(objPtr), "JimSetSourceInfo called with shared object"));
3007 JimPanic((objPtr->typePtr != NULL, "JimSetSourceInfo called with typePtr != NULL"));
3008 Jim_IncrRefCount(fileNameObj);
3009 objPtr->internalRep.sourceValue.fileNameObj = fileNameObj;
3010 objPtr->internalRep.sourceValue.lineNumber = lineNumber;
3011 objPtr->typePtr = &sourceObjType;
3014 /* -----------------------------------------------------------------------------
3015 * Script Object
3016 * ---------------------------------------------------------------------------*/
3018 static const Jim_ObjType scriptLineObjType = {
3019 "scriptline",
3020 NULL,
3021 NULL,
3022 NULL,
3026 static Jim_Obj *JimNewScriptLineObj(Jim_Interp *interp, int argc, int line)
3028 Jim_Obj *objPtr;
3030 #ifdef DEBUG_SHOW_SCRIPT
3031 char buf[100];
3032 snprintf(buf, sizeof(buf), "line=%d, argc=%d", line, argc);
3033 objPtr = Jim_NewStringObj(interp, buf, -1);
3034 #else
3035 objPtr = Jim_NewEmptyStringObj(interp);
3036 #endif
3037 objPtr->typePtr = &scriptLineObjType;
3038 objPtr->internalRep.scriptLineValue.argc = argc;
3039 objPtr->internalRep.scriptLineValue.line = line;
3041 return objPtr;
3044 #define JIM_CMDSTRUCT_EXPAND -1
3046 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3047 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3048 static int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, struct JimParseResult *result);
3050 static const Jim_ObjType scriptObjType = {
3051 "script",
3052 FreeScriptInternalRep,
3053 DupScriptInternalRep,
3054 NULL,
3055 JIM_TYPE_REFERENCES,
3058 /* The ScriptToken structure represents every token into a scriptObj.
3059 * Every token contains an associated Jim_Obj that can be specialized
3060 * by commands operating on it. */
3061 typedef struct ScriptToken
3063 int type;
3064 Jim_Obj *objPtr;
3065 } ScriptToken;
3067 /* This is the script object internal representation. An array of
3068 * ScriptToken structures, including a pre-computed representation of the
3069 * command length and arguments.
3071 * For example the script:
3073 * puts hello
3074 * set $i $x$y [foo]BAR
3076 * will produce a ScriptObj with the following Tokens:
3078 * LIN 2
3079 * ESC puts
3080 * ESC hello
3081 * LIN 4
3082 * ESC set
3083 * VAR i
3084 * WRD 2
3085 * VAR x
3086 * VAR y
3087 * WRD 2
3088 * CMD foo
3089 * ESC BAR
3091 * "puts hello" has two args (LIN 2), composed of single tokens.
3092 * (Note that the WRD token is omitted for the common case of a single token.)
3094 * "set $i $x$y [foo]BAR" has four (LIN 4) args, the first word
3095 * has 1 token (ESC SET), and the last has two tokens (WRD 2 CMD foo ESC BAR)
3097 * The precomputation of the command structure makes Jim_Eval() faster,
3098 * and simpler because there aren't dynamic lengths / allocations.
3100 * -- {expand}/{*} handling --
3102 * Expand is handled in a special way.
3104 * If a "word" begins with {*}, the word token count is -ve.
3106 * For example the command:
3108 * list {*}{a b}
3110 * Will produce the following cmdstruct array:
3112 * LIN 2
3113 * ESC list
3114 * WRD -1
3115 * STR a b
3117 * Note that the 'LIN' token also contains the source information for the
3118 * first word of the line for error reporting purposes
3120 * -- the substFlags field of the structure --
3122 * The scriptObj structure is used to represent both "script" objects
3123 * and "subst" objects. In the second case, the there are no LIN and WRD
3124 * tokens. Instead SEP and EOL tokens are added as-is.
3125 * In addition, the field 'substFlags' is used to represent the flags used to turn
3126 * the string into the internal representation used to perform the
3127 * substitution. If this flags are not what the application requires
3128 * the scriptObj is created again. For example the script:
3130 * subst -nocommands $string
3131 * subst -novariables $string
3133 * Will recreate the internal representation of the $string object
3134 * two times.
3136 typedef struct ScriptObj
3138 int len; /* Length as number of tokens. */
3139 ScriptToken *token; /* Tokens array. */
3140 int substFlags; /* flags used for the compilation of "subst" objects */
3141 int inUse; /* Used to share a ScriptObj. Currently
3142 only used by Jim_EvalObj() as protection against
3143 shimmering of the currently evaluated object. */
3144 Jim_Obj *fileNameObj;
3145 int firstline; /* Line number of the first line */
3146 int linenr; /* Line number of the current line */
3147 } ScriptObj;
3149 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3151 int i;
3152 struct ScriptObj *script = (void *)objPtr->internalRep.ptr;
3154 script->inUse--;
3155 if (script->inUse != 0)
3156 return;
3157 for (i = 0; i < script->len; i++) {
3158 Jim_DecrRefCount(interp, script->token[i].objPtr);
3160 Jim_Free(script->token);
3161 Jim_DecrRefCount(interp, script->fileNameObj);
3162 Jim_Free(script);
3165 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3167 JIM_NOTUSED(interp);
3168 JIM_NOTUSED(srcPtr);
3170 /* Just returns an simple string. */
3171 dupPtr->typePtr = NULL;
3174 /* A simple parser token.
3175 * All the simple tokens for the script point into the same script string rep.
3177 typedef struct
3179 const char *token; /* Pointer to the start of the token */
3180 int len; /* Length of this token */
3181 int type; /* Token type */
3182 int line; /* Line number */
3183 } ParseToken;
3185 /* A list of parsed tokens representing a script.
3186 * Tokens are added to this list as the script is parsed.
3187 * It grows as needed.
3189 typedef struct
3191 /* Start with a statically allocated list of tokens which will be expanded with realloc if needed */
3192 ParseToken *list; /* Array of tokens */
3193 int size; /* Current size of the list */
3194 int count; /* Number of entries used */
3195 ParseToken static_list[20]; /* Small initial token space to avoid allocation */
3196 } ParseTokenList;
3198 static void ScriptTokenListInit(ParseTokenList *tokenlist)
3200 tokenlist->list = tokenlist->static_list;
3201 tokenlist->size = sizeof(tokenlist->static_list) / sizeof(ParseToken);
3202 tokenlist->count = 0;
3205 static void ScriptTokenListFree(ParseTokenList *tokenlist)
3207 if (tokenlist->list != tokenlist->static_list) {
3208 Jim_Free(tokenlist->list);
3213 * Adds the new token to the tokenlist.
3214 * The token has the given length, type and line number.
3215 * The token list is resized as necessary.
3217 static void ScriptAddToken(ParseTokenList *tokenlist, const char *token, int len, int type,
3218 int line)
3220 ParseToken *t;
3222 if (tokenlist->count == tokenlist->size) {
3223 /* Resize the list */
3224 tokenlist->size *= 2;
3225 if (tokenlist->list != tokenlist->static_list) {
3226 tokenlist->list =
3227 Jim_Realloc(tokenlist->list, tokenlist->size * sizeof(*tokenlist->list));
3229 else {
3230 /* The list needs to become allocated */
3231 tokenlist->list = Jim_Alloc(tokenlist->size * sizeof(*tokenlist->list));
3232 memcpy(tokenlist->list, tokenlist->static_list,
3233 tokenlist->count * sizeof(*tokenlist->list));
3236 t = &tokenlist->list[tokenlist->count++];
3237 t->token = token;
3238 t->len = len;
3239 t->type = type;
3240 t->line = line;
3243 /* Counts the number of adjoining non-separator.
3245 * Returns -ve if the first token is the expansion
3246 * operator (in which case the count doesn't include
3247 * that token).
3249 static int JimCountWordTokens(ParseToken *t)
3251 int expand = 1;
3252 int count = 0;
3254 /* Is the first word {*} or {expand}? */
3255 if (t->type == JIM_TT_STR && !TOKEN_IS_SEP(t[1].type)) {
3256 if ((t->len == 1 && *t->token == '*') || (t->len == 6 && strncmp(t->token, "expand", 6) == 0)) {
3257 /* Create an expand token */
3258 expand = -1;
3259 t++;
3263 /* Now count non-separator words */
3264 while (!TOKEN_IS_SEP(t->type)) {
3265 t++;
3266 count++;
3269 return count * expand;
3273 * Create a script/subst object from the given token.
3275 static Jim_Obj *JimMakeScriptObj(Jim_Interp *interp, const ParseToken *t)
3277 Jim_Obj *objPtr;
3279 if (t->type == JIM_TT_ESC && memchr(t->token, '\\', t->len) != NULL) {
3280 /* Convert the backlash escapes . */
3281 int len = t->len;
3282 char *str = Jim_Alloc(len + 1);
3283 len = JimEscape(str, t->token, len);
3284 objPtr = Jim_NewStringObjNoAlloc(interp, str, len);
3286 else {
3287 /* REVIST: Strictly, JIM_TT_STR should replace <backslash><newline><whitespace>
3288 * with a single space. This is currently not done.
3290 objPtr = Jim_NewStringObj(interp, t->token, t->len);
3292 return objPtr;
3296 * Takes a tokenlist and creates the allocated list of script tokens
3297 * in script->token, of length script->len.
3299 * Unnecessary tokens are discarded, and LINE and WORD tokens are inserted
3300 * as required.
3302 * Also sets script->line to the line number of the first token
3304 static void ScriptObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3305 ParseTokenList *tokenlist)
3307 int i;
3308 struct ScriptToken *token;
3309 /* Number of tokens so far for the current command */
3310 int lineargs = 0;
3311 /* This is the first token for the current command */
3312 ScriptToken *linefirst;
3313 int count;
3314 int linenr;
3316 #ifdef DEBUG_SHOW_SCRIPT_TOKENS
3317 printf("==== Tokens ====\n");
3318 for (i = 0; i < tokenlist->count; i++) {
3319 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist->list[i].line, jim_tt_name(tokenlist->list[i].type),
3320 tokenlist->list[i].len, tokenlist->list[i].token);
3322 #endif
3324 /* May need up to one extra script token for each EOL in the worst case */
3325 count = tokenlist->count;
3326 for (i = 0; i < tokenlist->count; i++) {
3327 if (tokenlist->list[i].type == JIM_TT_EOL) {
3328 count++;
3331 linenr = script->firstline = tokenlist->list[0].line;
3333 token = script->token = Jim_Alloc(sizeof(ScriptToken) * count);
3335 /* This is the first token for the current command */
3336 linefirst = token++;
3338 for (i = 0; i < tokenlist->count; ) {
3339 /* Look ahead to find out how many tokens make up the next word */
3340 int wordtokens;
3342 /* Skip any leading separators */
3343 while (tokenlist->list[i].type == JIM_TT_SEP) {
3344 i++;
3347 wordtokens = JimCountWordTokens(tokenlist->list + i);
3349 if (wordtokens == 0) {
3350 /* None, so at end of line */
3351 if (lineargs) {
3352 linefirst->type = JIM_TT_LINE;
3353 linefirst->objPtr = JimNewScriptLineObj(interp, lineargs, linenr);
3354 Jim_IncrRefCount(linefirst->objPtr);
3356 /* Reset for new line */
3357 lineargs = 0;
3358 linefirst = token++;
3360 i++;
3361 continue;
3363 else if (wordtokens != 1) {
3364 /* More than 1, or {expand}, so insert a WORD token */
3365 token->type = JIM_TT_WORD;
3366 token->objPtr = Jim_NewIntObj(interp, wordtokens);
3367 Jim_IncrRefCount(token->objPtr);
3368 token++;
3369 if (wordtokens < 0) {
3370 /* Skip the expand token */
3371 i++;
3372 wordtokens = -wordtokens - 1;
3373 lineargs--;
3377 if (lineargs == 0) {
3378 /* First real token on the line, so record the line number */
3379 linenr = tokenlist->list[i].line;
3381 lineargs++;
3383 /* Add each non-separator word token to the line */
3384 while (wordtokens--) {
3385 const ParseToken *t = &tokenlist->list[i++];
3387 token->type = t->type;
3388 token->objPtr = JimMakeScriptObj(interp, t);
3389 Jim_IncrRefCount(token->objPtr);
3391 /* Every object is initially a string, but the
3392 * internal type may be specialized during execution of the
3393 * script. */
3394 JimSetSourceInfo(interp, token->objPtr, script->fileNameObj, t->line);
3395 token++;
3399 if (lineargs == 0) {
3400 token--;
3403 script->len = token - script->token;
3405 assert(script->len < count);
3407 #ifdef DEBUG_SHOW_SCRIPT
3408 printf("==== Script (%s) ====\n", Jim_String(script->fileNameObj));
3409 for (i = 0; i < script->len; i++) {
3410 const ScriptToken *t = &script->token[i];
3411 printf("[%2d] %s %s\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
3413 #endif
3418 * Similar to ScriptObjAddTokens(), but for subst objects.
3420 static void SubstObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3421 ParseTokenList *tokenlist)
3423 int i;
3424 struct ScriptToken *token;
3426 token = script->token = Jim_Alloc(sizeof(ScriptToken) * tokenlist->count);
3428 for (i = 0; i < tokenlist->count; i++) {
3429 const ParseToken *t = &tokenlist->list[i];
3431 /* Create a token for 't' */
3432 token->type = t->type;
3433 token->objPtr = JimMakeScriptObj(interp, t);
3434 Jim_IncrRefCount(token->objPtr);
3435 token++;
3438 script->len = i;
3441 /* This method takes the string representation of an object
3442 * as a Tcl script, and generates the pre-parsed internal representation
3443 * of the script. */
3444 static int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, struct JimParseResult *result)
3446 int scriptTextLen;
3447 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
3448 struct JimParserCtx parser;
3449 struct ScriptObj *script;
3450 ParseTokenList tokenlist;
3451 int line = 1;
3453 /* Try to get information about filename / line number */
3454 if (objPtr->typePtr == &sourceObjType) {
3455 line = objPtr->internalRep.sourceValue.lineNumber;
3458 /* Initially parse the script into tokens (in tokenlist) */
3459 ScriptTokenListInit(&tokenlist);
3461 JimParserInit(&parser, scriptText, scriptTextLen, line);
3462 while (!parser.eof) {
3463 JimParseScript(&parser);
3464 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
3465 parser.tline);
3467 if (result && parser.missing != ' ') {
3468 ScriptTokenListFree(&tokenlist);
3469 result->missing = parser.missing;
3470 result->line = parser.missingline;
3471 return JIM_ERR;
3474 /* Add a final EOF token */
3475 ScriptAddToken(&tokenlist, scriptText + scriptTextLen, 0, JIM_TT_EOF, 0);
3477 /* Create the "real" script tokens from the initial token list */
3478 script = Jim_Alloc(sizeof(*script));
3479 memset(script, 0, sizeof(*script));
3480 script->inUse = 1;
3481 if (objPtr->typePtr == &sourceObjType) {
3482 script->fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
3484 else {
3485 script->fileNameObj = interp->emptyObj;
3487 Jim_IncrRefCount(script->fileNameObj);
3489 ScriptObjAddTokens(interp, script, &tokenlist);
3491 /* No longer need the token list */
3492 ScriptTokenListFree(&tokenlist);
3494 /* Free the old internal rep and set the new one. */
3495 Jim_FreeIntRep(interp, objPtr);
3496 Jim_SetIntRepPtr(objPtr, script);
3497 objPtr->typePtr = &scriptObjType;
3499 return JIM_OK;
3502 ScriptObj *Jim_GetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3504 struct ScriptObj *script = Jim_GetIntRepPtr(objPtr);
3506 if (objPtr->typePtr != &scriptObjType || script->substFlags) {
3507 SetScriptFromAny(interp, objPtr, NULL);
3509 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
3512 /* -----------------------------------------------------------------------------
3513 * Commands
3514 * ---------------------------------------------------------------------------*/
3515 static void JimIncrCmdRefCount(Jim_Cmd *cmdPtr)
3517 cmdPtr->inUse++;
3520 static void JimDecrCmdRefCount(Jim_Interp *interp, Jim_Cmd *cmdPtr)
3522 if (--cmdPtr->inUse == 0) {
3523 if (cmdPtr->isproc) {
3524 Jim_DecrRefCount(interp, cmdPtr->u.proc.argListObjPtr);
3525 Jim_DecrRefCount(interp, cmdPtr->u.proc.bodyObjPtr);
3526 if (cmdPtr->u.proc.staticVars) {
3527 Jim_FreeHashTable(cmdPtr->u.proc.staticVars);
3528 Jim_Free(cmdPtr->u.proc.staticVars);
3531 else {
3532 /* native (C) */
3533 if (cmdPtr->u.native.delProc) {
3534 cmdPtr->u.native.delProc(interp, cmdPtr->u.native.privData);
3537 if (cmdPtr->prevCmd) {
3538 /* Delete any pushed command too */
3539 JimDecrCmdRefCount(interp, cmdPtr->prevCmd);
3541 Jim_Free(cmdPtr);
3545 /* Variables HashTable Type.
3547 * Keys are dynamic allocated strings, Values are Jim_Var structures.
3550 /* Variables HashTable Type.
3552 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3553 static void JimVariablesHTValDestructor(void *interp, void *val)
3555 Jim_DecrRefCount(interp, ((Jim_Var *)val)->objPtr);
3556 Jim_Free(val);
3559 static const Jim_HashTableType JimVariablesHashTableType = {
3560 JimStringCopyHTHashFunction, /* hash function */
3561 JimStringCopyHTDup, /* key dup */
3562 NULL, /* val dup */
3563 JimStringCopyHTKeyCompare, /* key compare */
3564 JimStringCopyHTKeyDestructor, /* key destructor */
3565 JimVariablesHTValDestructor /* val destructor */
3568 /* Commands HashTable Type.
3570 * Keys are dynamic allocated strings, Values are Jim_Cmd structures. */
3571 static void JimCommandsHT_ValDestructor(void *interp, void *val)
3573 JimDecrCmdRefCount(interp, val);
3576 static const Jim_HashTableType JimCommandsHashTableType = {
3577 JimStringCopyHTHashFunction, /* hash function */
3578 JimStringCopyHTDup, /* key dup */
3579 NULL, /* val dup */
3580 JimStringCopyHTKeyCompare, /* key compare */
3581 JimStringCopyHTKeyDestructor, /* key destructor */
3582 JimCommandsHT_ValDestructor /* val destructor */
3585 /* ------------------------- Commands related functions --------------------- */
3587 static int JimCreateCommand(Jim_Interp *interp, const char *name, Jim_Cmd *cmd)
3589 /* It may already exist, so we try to delete the old one.
3590 * Note that reference count means that it won't be deleted yet if
3591 * it exists in the call stack.
3593 * BUT, if 'local' is in force, instead of deleting the existing
3594 * proc, we stash a reference to the old proc here.
3596 Jim_HashEntry *he = Jim_FindHashEntry(&interp->commands, name);
3597 if (he) {
3598 /* There was an old cmd with the same name,
3599 * so this requires a 'proc epoch' update. */
3601 /* If a procedure with the same name didn't exist there is no need
3602 * to increment the 'proc epoch' because creation of a new procedure
3603 * can never affect existing cached commands. We don't do
3604 * negative caching. */
3605 Jim_InterpIncrProcEpoch(interp);
3608 if (he && interp->local) {
3609 /* Push this command over the top of the previous one */
3610 cmd->prevCmd = he->u.val;
3611 he->u.val = cmd;
3613 else {
3614 if (he) {
3615 /* Replace the existing command */
3616 Jim_DeleteHashEntry(&interp->commands, name);
3619 Jim_AddHashEntry(&interp->commands, name, cmd);
3621 return JIM_OK;
3625 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdNameStr,
3626 Jim_CmdProc cmdProc, void *privData, Jim_DelCmdProc delProc)
3628 Jim_Cmd *cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3630 /* Store the new details for this command */
3631 memset(cmdPtr, 0, sizeof(*cmdPtr));
3632 cmdPtr->inUse = 1;
3633 cmdPtr->u.native.delProc = delProc;
3634 cmdPtr->u.native.cmdProc = cmdProc;
3635 cmdPtr->u.native.privData = privData;
3637 JimCreateCommand(interp, cmdNameStr, cmdPtr);
3639 return JIM_OK;
3642 static int JimCreateProcedureStatics(Jim_Interp *interp, Jim_Cmd *cmdPtr, Jim_Obj *staticsListObjPtr)
3644 int len, i;
3646 len = Jim_ListLength(interp, staticsListObjPtr);
3647 if (len == 0) {
3648 return JIM_OK;
3651 cmdPtr->u.proc.staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3652 Jim_InitHashTable(cmdPtr->u.proc.staticVars, &JimVariablesHashTableType, interp);
3653 for (i = 0; i < len; i++) {
3654 Jim_Obj *objPtr = NULL, *initObjPtr = NULL, *nameObjPtr = NULL;
3655 Jim_Var *varPtr;
3656 int subLen;
3658 Jim_ListIndex(interp, staticsListObjPtr, i, &objPtr, JIM_NONE);
3659 /* Check if it's composed of two elements. */
3660 subLen = Jim_ListLength(interp, objPtr);
3661 if (subLen == 1 || subLen == 2) {
3662 /* Try to get the variable value from the current
3663 * environment. */
3664 Jim_ListIndex(interp, objPtr, 0, &nameObjPtr, JIM_NONE);
3665 if (subLen == 1) {
3666 initObjPtr = Jim_GetVariable(interp, nameObjPtr, JIM_NONE);
3667 if (initObjPtr == NULL) {
3668 Jim_SetResultFormatted(interp,
3669 "variable for initialization of static \"%#s\" not found in the local context",
3670 nameObjPtr);
3671 return JIM_ERR;
3674 else {
3675 Jim_ListIndex(interp, objPtr, 1, &initObjPtr, JIM_NONE);
3677 if (JimValidName(interp, "static variable", nameObjPtr) != JIM_OK) {
3678 return JIM_ERR;
3681 varPtr = Jim_Alloc(sizeof(*varPtr));
3682 varPtr->objPtr = initObjPtr;
3683 Jim_IncrRefCount(initObjPtr);
3684 varPtr->linkFramePtr = NULL;
3685 if (Jim_AddHashEntry(cmdPtr->u.proc.staticVars,
3686 Jim_String(nameObjPtr), varPtr) != JIM_OK) {
3687 Jim_SetResultFormatted(interp,
3688 "static variable name \"%#s\" duplicated in statics list", nameObjPtr);
3689 Jim_DecrRefCount(interp, initObjPtr);
3690 Jim_Free(varPtr);
3691 return JIM_ERR;
3694 else {
3695 Jim_SetResultFormatted(interp, "too many fields in static specifier \"%#s\"",
3696 objPtr);
3697 return JIM_ERR;
3700 return JIM_OK;
3703 static int JimCreateProcedure(Jim_Interp *interp, Jim_Obj *cmdName,
3704 Jim_Obj *argListObjPtr, Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr)
3706 Jim_Cmd *cmdPtr;
3707 int argListLen;
3708 int i;
3710 if (JimValidName(interp, "procedure", cmdName) != JIM_OK) {
3711 return JIM_ERR;
3714 argListLen = Jim_ListLength(interp, argListObjPtr);
3716 /* Allocate space for both the command pointer and the arg list */
3717 cmdPtr = Jim_Alloc(sizeof(*cmdPtr) + sizeof(struct Jim_ProcArg) * argListLen);
3718 memset(cmdPtr, 0, sizeof(*cmdPtr));
3719 cmdPtr->inUse = 1;
3720 cmdPtr->isproc = 1;
3721 cmdPtr->u.proc.argListObjPtr = argListObjPtr;
3722 cmdPtr->u.proc.argListLen = argListLen;
3723 cmdPtr->u.proc.bodyObjPtr = bodyObjPtr;
3724 cmdPtr->u.proc.argsPos = -1;
3725 cmdPtr->u.proc.arglist = (struct Jim_ProcArg *)(cmdPtr + 1);
3726 Jim_IncrRefCount(argListObjPtr);
3727 Jim_IncrRefCount(bodyObjPtr);
3729 /* Create the statics hash table. */
3730 if (staticsListObjPtr && JimCreateProcedureStatics(interp, cmdPtr, staticsListObjPtr) != JIM_OK) {
3731 goto err;
3734 /* Parse the args out into arglist, validating as we go */
3735 /* Examine the argument list for default parameters and 'args' */
3736 for (i = 0; i < argListLen; i++) {
3737 Jim_Obj *argPtr;
3738 Jim_Obj *nameObjPtr;
3739 Jim_Obj *defaultObjPtr;
3740 int len;
3741 int n = 1;
3743 /* Examine a parameter */
3744 Jim_ListIndex(interp, argListObjPtr, i, &argPtr, JIM_NONE);
3745 len = Jim_ListLength(interp, argPtr);
3746 if (len == 0) {
3747 Jim_SetResultString(interp, "procedure has argument with no name", -1);
3748 goto err;
3750 if (len > 2) {
3751 Jim_SetResultString(interp, "procedure has argument with too many fields", -1);
3752 goto err;
3755 if (len == 2) {
3756 /* Optional parameter */
3757 Jim_ListIndex(interp, argPtr, 0, &nameObjPtr, JIM_NONE);
3758 Jim_ListIndex(interp, argPtr, 1, &defaultObjPtr, JIM_NONE);
3760 else {
3761 /* Required parameter */
3762 nameObjPtr = argPtr;
3763 defaultObjPtr = NULL;
3767 if (Jim_CompareStringImmediate(interp, nameObjPtr, "args")) {
3768 if (cmdPtr->u.proc.argsPos >= 0) {
3769 Jim_SetResultString(interp, "procedure has 'args' specified more than once", -1);
3770 goto err;
3772 cmdPtr->u.proc.argsPos = i;
3774 else {
3775 if (len == 2) {
3776 cmdPtr->u.proc.optArity += n;
3778 else {
3779 cmdPtr->u.proc.reqArity += n;
3783 cmdPtr->u.proc.arglist[i].nameObjPtr = nameObjPtr;
3784 cmdPtr->u.proc.arglist[i].defaultObjPtr = defaultObjPtr;
3787 /* Add the new command */
3788 JimCreateCommand(interp, Jim_String(cmdName), cmdPtr);
3790 /* Unlike Tcl, set the name of the proc as the result */
3791 Jim_SetResult(interp, cmdName);
3792 return JIM_OK;
3794 err:
3795 if (cmdPtr->u.proc.staticVars) {
3796 Jim_FreeHashTable(cmdPtr->u.proc.staticVars);
3798 Jim_Free(cmdPtr->u.proc.staticVars);
3799 Jim_DecrRefCount(interp, argListObjPtr);
3800 Jim_DecrRefCount(interp, bodyObjPtr);
3801 Jim_Free(cmdPtr);
3802 return JIM_ERR;
3805 int Jim_DeleteCommand(Jim_Interp *interp, const char *cmdName)
3807 if (Jim_DeleteHashEntry(&interp->commands, cmdName) == JIM_ERR)
3808 return JIM_ERR;
3809 Jim_InterpIncrProcEpoch(interp);
3810 return JIM_OK;
3813 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName, const char *newName)
3815 Jim_HashEntry *he;
3817 /* Does it exist? */
3818 he = Jim_FindHashEntry(&interp->commands, oldName);
3819 if (he == NULL) {
3820 Jim_SetResultFormatted(interp, "can't %s \"%s\": command doesn't exist",
3821 newName[0] ? "rename" : "delete", oldName);
3822 return JIM_ERR;
3825 if (newName[0] == '\0') /* Delete! */
3826 return Jim_DeleteCommand(interp, oldName);
3828 /* rename */
3829 if (Jim_FindHashEntry(&interp->commands, newName)) {
3830 Jim_SetResultFormatted(interp, "can't rename to \"%s\": command already exists", newName);
3831 return JIM_ERR;
3834 /* Add the new name first */
3835 JimIncrCmdRefCount(he->u.val);
3836 Jim_AddHashEntry(&interp->commands, newName, he->u.val);
3838 /* Now remove the old name */
3839 Jim_DeleteHashEntry(&interp->commands, oldName);
3841 /* Increment the epoch */
3842 Jim_InterpIncrProcEpoch(interp);
3843 return JIM_OK;
3846 /* -----------------------------------------------------------------------------
3847 * Command object
3848 * ---------------------------------------------------------------------------*/
3850 static const Jim_ObjType commandObjType = {
3851 "command",
3852 NULL,
3853 NULL,
3854 NULL,
3855 JIM_TYPE_REFERENCES,
3858 /* This function returns the command structure for the command name
3859 * stored in objPtr. It tries to specialize the objPtr to contain
3860 * a cached info instead to perform the lookup into the hash table
3861 * every time. The information cached may not be uptodate, in such
3862 * a case the lookup is performed and the cache updated.
3864 * Respects the 'upcall' setting
3866 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
3868 Jim_Cmd *cmd;
3870 if (objPtr->typePtr != &commandObjType ||
3871 objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch) {
3873 /* Not cached or out of date, so lookup */
3874 Jim_HashEntry *he = Jim_FindHashEntry(&interp->commands, Jim_String(objPtr));
3875 if (he == NULL) {
3876 if (flags & JIM_ERRMSG) {
3877 Jim_SetResultFormatted(interp, "invalid command name \"%#s\"", objPtr);
3879 return NULL;
3882 /* Free the old internal repr and set the new one. */
3883 Jim_FreeIntRep(interp, objPtr);
3884 objPtr->typePtr = &commandObjType;
3885 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
3886 objPtr->internalRep.cmdValue.cmdPtr = (void *)he->u.val;
3889 cmd = objPtr->internalRep.cmdValue.cmdPtr;
3890 while (cmd->u.proc.upcall) {
3891 cmd = cmd->prevCmd;
3893 return cmd;
3896 /* -----------------------------------------------------------------------------
3897 * Variables
3898 * ---------------------------------------------------------------------------*/
3900 /* -----------------------------------------------------------------------------
3901 * Variable object
3902 * ---------------------------------------------------------------------------*/
3904 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
3906 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3908 static const Jim_ObjType variableObjType = {
3909 "variable",
3910 NULL,
3911 NULL,
3912 NULL,
3913 JIM_TYPE_REFERENCES,
3917 * Check that the name does not contain embedded nulls.
3919 * Variable and procedure names are maniplated as null terminated strings, so
3920 * don't allow names with embedded nulls.
3922 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr)
3924 /* Variable names and proc names can't contain embedded nulls */
3925 if (nameObjPtr->typePtr != &variableObjType) {
3926 int len;
3927 const char *str = Jim_GetString(nameObjPtr, &len);
3928 if (memchr(str, '\0', len)) {
3929 Jim_SetResultFormatted(interp, "%s name contains embedded null", type);
3930 return JIM_ERR;
3933 return JIM_OK;
3936 /* This method should be called only by the variable API.
3937 * It returns JIM_OK on success (variable already exists),
3938 * JIM_ERR if it does not exists, JIM_DICT_SUGAR if it's not
3939 * a variable name, but syntax glue for [dict] i.e. the last
3940 * character is ')' */
3941 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3943 const char *varName;
3944 Jim_CallFrame *framePtr;
3945 Jim_HashEntry *he;
3946 int global;
3947 int len;
3949 /* Check if the object is already an uptodate variable */
3950 if (objPtr->typePtr == &variableObjType) {
3951 framePtr = objPtr->internalRep.varValue.global ? interp->topFramePtr : interp->framePtr;
3952 if (objPtr->internalRep.varValue.callFrameId == framePtr->id) {
3953 /* nothing to do */
3954 return JIM_OK;
3956 /* Need to re-resolve the variable in the updated callframe */
3958 else if (objPtr->typePtr == &dictSubstObjType) {
3959 return JIM_DICT_SUGAR;
3961 else if (JimValidName(interp, "variable", objPtr) != JIM_OK) {
3962 return JIM_ERR;
3966 varName = Jim_GetString(objPtr, &len);
3968 /* Make sure it's not syntax glue to get/set dict. */
3969 if (len && varName[len - 1] == ')' && strchr(varName, '(') != NULL) {
3970 return JIM_DICT_SUGAR;
3973 if (varName[0] == ':' && varName[1] == ':') {
3974 global = 1;
3975 varName += 2;
3976 framePtr = interp->topFramePtr;
3978 else {
3979 global = 0;
3980 framePtr = interp->framePtr;
3983 /* Resolve this name in the variables hash table */
3984 he = Jim_FindHashEntry(&framePtr->vars, varName);
3985 if (he == NULL && !global && framePtr->staticVars) {
3986 /* Try with static vars. */
3987 he = Jim_FindHashEntry(framePtr->staticVars, varName);
3989 if (he == NULL) {
3990 return JIM_ERR;
3993 /* Free the old internal repr and set the new one. */
3994 Jim_FreeIntRep(interp, objPtr);
3995 objPtr->typePtr = &variableObjType;
3996 objPtr->internalRep.varValue.callFrameId = framePtr->id;
3997 objPtr->internalRep.varValue.varPtr = he->u.val;
3998 objPtr->internalRep.varValue.global = global;
3999 return JIM_OK;
4002 /* -------------------- Variables related functions ------------------------- */
4003 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr, Jim_Obj *valObjPtr);
4004 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr, int flags);
4006 static Jim_Var *JimCreateVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4008 const char *name;
4009 Jim_CallFrame *framePtr;
4010 int global;
4012 /* New variable to create */
4013 Jim_Var *var = Jim_Alloc(sizeof(*var));
4015 var->objPtr = valObjPtr;
4016 Jim_IncrRefCount(valObjPtr);
4017 var->linkFramePtr = NULL;
4019 name = Jim_String(nameObjPtr);
4020 if (name[0] == ':' && name[1] == ':') {
4021 framePtr = interp->topFramePtr;
4022 name += 2;
4023 global = 1;
4025 else {
4026 framePtr = interp->framePtr;
4027 global = 0;
4030 /* Insert the new variable */
4031 Jim_AddHashEntry(&framePtr->vars, name, var);
4033 /* Make the object int rep a variable */
4034 Jim_FreeIntRep(interp, nameObjPtr);
4035 nameObjPtr->typePtr = &variableObjType;
4036 nameObjPtr->internalRep.varValue.callFrameId = framePtr->id;
4037 nameObjPtr->internalRep.varValue.varPtr = var;
4038 nameObjPtr->internalRep.varValue.global = global;
4040 return var;
4043 /* For now that's dummy. Variables lookup should be optimized
4044 * in many ways, with caching of lookups, and possibly with
4045 * a table of pre-allocated vars in every CallFrame for local vars.
4046 * All the caching should also have an 'epoch' mechanism similar
4047 * to the one used by Tcl for procedures lookup caching. */
4049 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4051 int err;
4052 Jim_Var *var;
4054 switch (SetVariableFromAny(interp, nameObjPtr)) {
4055 case JIM_DICT_SUGAR:
4056 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
4058 case JIM_ERR:
4059 if (JimValidName(interp, "variable", nameObjPtr) != JIM_OK) {
4060 return JIM_ERR;
4062 JimCreateVariable(interp, nameObjPtr, valObjPtr);
4063 break;
4065 case JIM_OK:
4066 var = nameObjPtr->internalRep.varValue.varPtr;
4067 if (var->linkFramePtr == NULL) {
4068 Jim_IncrRefCount(valObjPtr);
4069 Jim_DecrRefCount(interp, var->objPtr);
4070 var->objPtr = valObjPtr;
4072 else { /* Else handle the link */
4073 Jim_CallFrame *savedCallFrame;
4075 savedCallFrame = interp->framePtr;
4076 interp->framePtr = var->linkFramePtr;
4077 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
4078 interp->framePtr = savedCallFrame;
4079 if (err != JIM_OK)
4080 return err;
4083 return JIM_OK;
4086 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4088 Jim_Obj *nameObjPtr;
4089 int result;
4091 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4092 Jim_IncrRefCount(nameObjPtr);
4093 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
4094 Jim_DecrRefCount(interp, nameObjPtr);
4095 return result;
4098 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4100 Jim_CallFrame *savedFramePtr;
4101 int result;
4103 savedFramePtr = interp->framePtr;
4104 interp->framePtr = interp->topFramePtr;
4105 result = Jim_SetVariableStr(interp, name, objPtr);
4106 interp->framePtr = savedFramePtr;
4107 return result;
4110 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
4112 Jim_Obj *nameObjPtr, *valObjPtr;
4113 int result;
4115 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4116 valObjPtr = Jim_NewStringObj(interp, val, -1);
4117 Jim_IncrRefCount(nameObjPtr);
4118 Jim_IncrRefCount(valObjPtr);
4119 result = Jim_SetVariable(interp, nameObjPtr, valObjPtr);
4120 Jim_DecrRefCount(interp, nameObjPtr);
4121 Jim_DecrRefCount(interp, valObjPtr);
4122 return result;
4125 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
4126 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
4128 const char *varName;
4129 const char *targetName;
4130 Jim_CallFrame *framePtr;
4131 Jim_Var *varPtr;
4133 /* Check for an existing variable or link */
4134 switch (SetVariableFromAny(interp, nameObjPtr)) {
4135 case JIM_DICT_SUGAR:
4136 /* XXX: This message seem unnecessarily verbose, but it matches Tcl */
4137 Jim_SetResultFormatted(interp, "bad variable name \"%#s\": upvar won't create a scalar variable that looks like an array element", nameObjPtr);
4138 return JIM_ERR;
4140 case JIM_OK:
4141 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4143 if (varPtr->linkFramePtr == NULL) {
4144 Jim_SetResultFormatted(interp, "variable \"%#s\" already exists", nameObjPtr);
4145 return JIM_ERR;
4148 /* It exists, but is a link, so first delete the link */
4149 varPtr->linkFramePtr = NULL;
4150 break;
4153 /* Resolve the call frames for both variables */
4154 /* XXX: SetVariableFromAny() already did this! */
4155 varName = Jim_String(nameObjPtr);
4157 if (varName[0] == ':' && varName[1] == ':') {
4158 /* Linking a global var does nothing */
4159 varName += 2;
4160 framePtr = interp->topFramePtr;
4162 else {
4163 framePtr = interp->framePtr;
4166 targetName = Jim_String(targetNameObjPtr);
4167 if (targetName[0] == ':' && targetName[1] == ':') {
4168 targetNameObjPtr = Jim_NewStringObj(interp, targetName + 2, -1);
4169 targetCallFrame = interp->topFramePtr;
4171 Jim_IncrRefCount(targetNameObjPtr);
4173 if (framePtr->level < targetCallFrame->level) {
4174 Jim_SetResultFormatted(interp,
4175 "bad variable name \"%#s\": upvar won't create namespace variable that refers to procedure variable",
4176 nameObjPtr);
4177 Jim_DecrRefCount(interp, targetNameObjPtr);
4178 return JIM_ERR;
4181 /* Check for cycles. */
4182 if (framePtr == targetCallFrame) {
4183 Jim_Obj *objPtr = targetNameObjPtr;
4185 /* Cycles are only possible with 'uplevel 0' */
4186 while (1) {
4187 if (strcmp(Jim_String(objPtr), varName) == 0) {
4188 Jim_SetResultString(interp, "can't upvar from variable to itself", -1);
4189 Jim_DecrRefCount(interp, targetNameObjPtr);
4190 return JIM_ERR;
4192 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
4193 break;
4194 varPtr = objPtr->internalRep.varValue.varPtr;
4195 if (varPtr->linkFramePtr != targetCallFrame)
4196 break;
4197 objPtr = varPtr->objPtr;
4201 /* Perform the binding */
4202 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
4203 /* We are now sure 'nameObjPtr' type is variableObjType */
4204 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
4205 Jim_DecrRefCount(interp, targetNameObjPtr);
4206 return JIM_OK;
4209 /* Return the Jim_Obj pointer associated with a variable name,
4210 * or NULL if the variable was not found in the current context.
4211 * The same optimization discussed in the comment to the
4212 * 'SetVariable' function should apply here.
4214 * If JIM_UNSHARED is set and the variable is an array element (dict sugar)
4215 * in a dictionary which is shared, the array variable value is duplicated first.
4216 * This allows the array element to be updated (e.g. append, lappend) without
4217 * affecting other references to the dictionary.
4219 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4221 switch (SetVariableFromAny(interp, nameObjPtr)) {
4222 case JIM_OK:{
4223 Jim_Var *varPtr = nameObjPtr->internalRep.varValue.varPtr;
4225 if (varPtr->linkFramePtr == NULL) {
4226 return varPtr->objPtr;
4228 else {
4229 Jim_Obj *objPtr;
4231 /* The variable is a link? Resolve it. */
4232 Jim_CallFrame *savedCallFrame = interp->framePtr;
4234 interp->framePtr = varPtr->linkFramePtr;
4235 objPtr = Jim_GetVariable(interp, varPtr->objPtr, flags);
4236 interp->framePtr = savedCallFrame;
4237 if (objPtr) {
4238 return objPtr;
4240 /* Error, so fall through to the error message */
4243 break;
4245 case JIM_DICT_SUGAR:
4246 /* [dict] syntax sugar. */
4247 return JimDictSugarGet(interp, nameObjPtr, flags);
4249 if (flags & JIM_ERRMSG) {
4250 Jim_SetResultFormatted(interp, "can't read \"%#s\": no such variable", nameObjPtr);
4252 return NULL;
4255 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4257 Jim_CallFrame *savedFramePtr;
4258 Jim_Obj *objPtr;
4260 savedFramePtr = interp->framePtr;
4261 interp->framePtr = interp->topFramePtr;
4262 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4263 interp->framePtr = savedFramePtr;
4265 return objPtr;
4268 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
4270 Jim_Obj *nameObjPtr, *varObjPtr;
4272 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4273 Jim_IncrRefCount(nameObjPtr);
4274 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4275 Jim_DecrRefCount(interp, nameObjPtr);
4276 return varObjPtr;
4279 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name, int flags)
4281 Jim_CallFrame *savedFramePtr;
4282 Jim_Obj *objPtr;
4284 savedFramePtr = interp->framePtr;
4285 interp->framePtr = interp->topFramePtr;
4286 objPtr = Jim_GetVariableStr(interp, name, flags);
4287 interp->framePtr = savedFramePtr;
4289 return objPtr;
4292 /* Unset a variable.
4293 * Note: On success unset invalidates all the variable objects created
4294 * in the current call frame incrementing. */
4295 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4297 Jim_Var *varPtr;
4298 int retval;
4299 Jim_CallFrame *framePtr;
4301 retval = SetVariableFromAny(interp, nameObjPtr);
4302 if (retval == JIM_DICT_SUGAR) {
4303 /* [dict] syntax sugar. */
4304 return JimDictSugarSet(interp, nameObjPtr, NULL);
4306 else if (retval == JIM_OK) {
4307 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4309 /* If it's a link call UnsetVariable recursively */
4310 if (varPtr->linkFramePtr) {
4311 framePtr = interp->framePtr;
4312 interp->framePtr = varPtr->linkFramePtr;
4313 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
4314 interp->framePtr = framePtr;
4316 else {
4317 const char *name = Jim_String(nameObjPtr);
4318 if (nameObjPtr->internalRep.varValue.global) {
4319 name += 2;
4320 framePtr = interp->topFramePtr;
4322 else {
4323 framePtr = interp->framePtr;
4326 retval = Jim_DeleteHashEntry(&framePtr->vars, name);
4327 if (retval == JIM_OK) {
4328 /* Change the callframe id, invalidating var lookup caching */
4329 JimChangeCallFrameId(interp, framePtr);
4333 if (retval != JIM_OK && (flags & JIM_ERRMSG)) {
4334 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such variable", nameObjPtr);
4336 return retval;
4339 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
4341 /* Given a variable name for [dict] operation syntax sugar,
4342 * this function returns two objects, the first with the name
4343 * of the variable to set, and the second with the rispective key.
4344 * For example "foo(bar)" will return objects with string repr. of
4345 * "foo" and "bar".
4347 * The returned objects have refcount = 1. The function can't fail. */
4348 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
4349 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
4351 const char *str, *p;
4352 int len, keyLen;
4353 Jim_Obj *varObjPtr, *keyObjPtr;
4355 str = Jim_GetString(objPtr, &len);
4357 p = strchr(str, '(');
4358 JimPanic((p == NULL, "JimDictSugarParseVarKey() called for non-dict-sugar (%s)", str));
4360 varObjPtr = Jim_NewStringObj(interp, str, p - str);
4362 p++;
4363 keyLen = (str + len) - p;
4364 if (str[len - 1] == ')') {
4365 keyLen--;
4368 /* Create the objects with the variable name and key. */
4369 keyObjPtr = Jim_NewStringObj(interp, p, keyLen);
4371 Jim_IncrRefCount(varObjPtr);
4372 Jim_IncrRefCount(keyObjPtr);
4373 *varPtrPtr = varObjPtr;
4374 *keyPtrPtr = keyObjPtr;
4377 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
4378 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
4379 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *valObjPtr)
4381 int err;
4383 SetDictSubstFromAny(interp, objPtr);
4385 err = Jim_SetDictKeysVector(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4386 &objPtr->internalRep.dictSubstValue.indexObjPtr, 1, valObjPtr, JIM_ERRMSG);
4388 if (err == JIM_OK) {
4389 /* Don't keep an extra ref to the result */
4390 Jim_SetEmptyResult(interp);
4392 else {
4393 if (!valObjPtr) {
4394 /* Better error message for unset a(2) where a exists but a(2) doesn't */
4395 if (Jim_GetVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_NONE)) {
4396 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such element in array",
4397 objPtr);
4398 return err;
4401 /* Make the error more informative and Tcl-compatible */
4402 Jim_SetResultFormatted(interp, "can't %s \"%#s\": variable isn't array",
4403 (valObjPtr ? "set" : "unset"), objPtr);
4405 return err;
4409 * Expands the array variable (dict sugar) and returns the result, or NULL on error.
4411 * If JIM_UNSHARED is set and the dictionary is shared, it will be duplicated
4412 * and stored back to the variable before expansion.
4414 static Jim_Obj *JimDictExpandArrayVariable(Jim_Interp *interp, Jim_Obj *varObjPtr,
4415 Jim_Obj *keyObjPtr, int flags)
4417 Jim_Obj *dictObjPtr;
4418 Jim_Obj *resObjPtr = NULL;
4419 int ret;
4421 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
4422 if (!dictObjPtr) {
4423 return NULL;
4426 ret = Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_NONE);
4427 if (ret != JIM_OK) {
4428 resObjPtr = NULL;
4429 if (ret < 0) {
4430 Jim_SetResultFormatted(interp,
4431 "can't read \"%#s(%#s)\": variable isn't array", varObjPtr, keyObjPtr);
4433 else {
4434 Jim_SetResultFormatted(interp,
4435 "can't read \"%#s(%#s)\": no such element in array", varObjPtr, keyObjPtr);
4438 else if ((flags & JIM_UNSHARED) && Jim_IsShared(dictObjPtr)) {
4439 dictObjPtr = Jim_DuplicateObj(interp, dictObjPtr);
4440 if (Jim_SetVariable(interp, varObjPtr, dictObjPtr) != JIM_OK) {
4441 /* This can probably never happen */
4442 JimPanic((1, "SetVariable failed for JIM_UNSHARED"));
4444 /* We know that the key exists. Get the result in the now-unshared dictionary */
4445 Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_NONE);
4448 return resObjPtr;
4451 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
4452 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4454 SetDictSubstFromAny(interp, objPtr);
4456 return JimDictExpandArrayVariable(interp,
4457 objPtr->internalRep.dictSubstValue.varNameObjPtr,
4458 objPtr->internalRep.dictSubstValue.indexObjPtr, flags);
4461 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
4463 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4465 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
4466 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
4469 void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4471 JIM_NOTUSED(interp);
4473 dupPtr->internalRep.dictSubstValue.varNameObjPtr =
4474 srcPtr->internalRep.dictSubstValue.varNameObjPtr;
4475 dupPtr->internalRep.dictSubstValue.indexObjPtr = srcPtr->internalRep.dictSubstValue.indexObjPtr;
4476 dupPtr->typePtr = &dictSubstObjType;
4479 /* Note: The object *must* be in dict-sugar format */
4480 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4482 if (objPtr->typePtr != &dictSubstObjType) {
4483 Jim_Obj *varObjPtr, *keyObjPtr;
4485 if (objPtr->typePtr == &interpolatedObjType) {
4486 /* An interpolated object in dict-sugar form */
4488 varObjPtr = objPtr->internalRep.dictSubstValue.varNameObjPtr;
4489 keyObjPtr = objPtr->internalRep.dictSubstValue.indexObjPtr;
4491 Jim_IncrRefCount(varObjPtr);
4492 Jim_IncrRefCount(keyObjPtr);
4494 else {
4495 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
4498 Jim_FreeIntRep(interp, objPtr);
4499 objPtr->typePtr = &dictSubstObjType;
4500 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
4501 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
4505 /* This function is used to expand [dict get] sugar in the form
4506 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
4507 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
4508 * object that is *guaranteed* to be in the form VARNAME(INDEX).
4509 * The 'index' part is [subst]ituted, and is used to lookup a key inside
4510 * the [dict]ionary contained in variable VARNAME. */
4511 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4513 Jim_Obj *resObjPtr = NULL;
4514 Jim_Obj *substKeyObjPtr = NULL;
4516 SetDictSubstFromAny(interp, objPtr);
4518 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
4519 &substKeyObjPtr, JIM_NONE)
4520 != JIM_OK) {
4521 return NULL;
4523 Jim_IncrRefCount(substKeyObjPtr);
4524 resObjPtr =
4525 JimDictExpandArrayVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4526 substKeyObjPtr, 0);
4527 Jim_DecrRefCount(interp, substKeyObjPtr);
4529 return resObjPtr;
4532 static Jim_Obj *JimExpandExprSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4534 Jim_Obj *resultObjPtr;
4536 if (Jim_EvalExpression(interp, objPtr, &resultObjPtr) == JIM_OK) {
4537 /* Note that the result has a ref count of 1, but we need a ref count of 0 */
4538 resultObjPtr->refCount--;
4539 return resultObjPtr;
4541 return NULL;
4544 /* -----------------------------------------------------------------------------
4545 * CallFrame
4546 * ---------------------------------------------------------------------------*/
4548 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp, Jim_CallFrame *parent)
4550 Jim_CallFrame *cf;
4552 if (interp->freeFramesList) {
4553 cf = interp->freeFramesList;
4554 interp->freeFramesList = cf->next;
4556 else {
4557 cf = Jim_Alloc(sizeof(*cf));
4558 cf->vars.table = NULL;
4561 cf->id = interp->callFrameEpoch++;
4562 cf->parent = parent;
4563 cf->level = parent ? parent->level + 1 : 0;
4564 cf->argv = NULL;
4565 cf->argc = 0;
4566 cf->procArgsObjPtr = NULL;
4567 cf->procBodyObjPtr = NULL;
4568 cf->next = NULL;
4569 cf->staticVars = NULL;
4570 cf->localCommands = NULL;
4572 if (cf->vars.table == NULL)
4573 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
4574 return cf;
4577 /* Used to invalidate every caching related to callframe stability. */
4578 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf)
4580 cf->id = interp->callFrameEpoch++;
4583 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands)
4585 /* Delete any local procs */
4586 if (localCommands) {
4587 Jim_Obj *cmdNameObj;
4589 while ((cmdNameObj = Jim_StackPop(localCommands)) != NULL) {
4590 Jim_HashEntry *he;
4592 he = Jim_FindHashEntry(&interp->commands, Jim_String(cmdNameObj));
4594 if (he) {
4595 Jim_Cmd *cmd = he->u.val;
4596 if (cmd->prevCmd) {
4597 Jim_Cmd *prevCmd = cmd->prevCmd;
4598 cmd->prevCmd = NULL;
4600 /* Delete the old command */
4601 JimDecrCmdRefCount(interp, cmd);
4603 /* And restore the original */
4604 he->u.val = prevCmd;
4606 else {
4607 Jim_DeleteHashEntry(&interp->commands, Jim_String(cmdNameObj));
4608 Jim_InterpIncrProcEpoch(interp);
4611 Jim_DecrRefCount(interp, cmdNameObj);
4613 Jim_FreeStack(localCommands);
4614 Jim_Free(localCommands);
4616 return JIM_OK;
4620 #define JIM_FCF_NONE 0 /* no flags */
4621 #define JIM_FCF_NOHT 1 /* don't free the hash table */
4622 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int flags)
4624 if (cf->procArgsObjPtr)
4625 Jim_DecrRefCount(interp, cf->procArgsObjPtr);
4626 if (cf->procBodyObjPtr)
4627 Jim_DecrRefCount(interp, cf->procBodyObjPtr);
4628 if (!(flags & JIM_FCF_NOHT))
4629 Jim_FreeHashTable(&cf->vars);
4630 else {
4631 int i;
4632 Jim_HashEntry **table = cf->vars.table, *he;
4634 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
4635 he = table[i];
4636 while (he != NULL) {
4637 Jim_HashEntry *nextEntry = he->next;
4638 Jim_Var *varPtr = (void *)he->u.val;
4640 Jim_DecrRefCount(interp, varPtr->objPtr);
4641 Jim_Free(he->u.val);
4642 Jim_Free((void *)he->key); /* ATTENTION: const cast */
4643 Jim_Free(he);
4644 table[i] = NULL;
4645 he = nextEntry;
4648 cf->vars.used = 0;
4651 JimDeleteLocalProcs(interp, cf->localCommands);
4653 cf->next = interp->freeFramesList;
4654 interp->freeFramesList = cf;
4659 /* -----------------------------------------------------------------------------
4660 * References
4661 * ---------------------------------------------------------------------------*/
4662 #ifdef JIM_REFERENCES
4664 /* References HashTable Type.
4666 * Keys are unsigned long integers, dynamically allocated for now but in the
4667 * future it's worth to cache this 4 bytes objects. Values are pointers
4668 * to Jim_References. */
4669 static void JimReferencesHTValDestructor(void *interp, void *val)
4671 Jim_Reference *refPtr = (void *)val;
4673 Jim_DecrRefCount(interp, refPtr->objPtr);
4674 if (refPtr->finalizerCmdNamePtr != NULL) {
4675 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
4677 Jim_Free(val);
4680 static unsigned int JimReferencesHTHashFunction(const void *key)
4682 /* Only the least significant bits are used. */
4683 const unsigned long *widePtr = key;
4684 unsigned int intValue = (unsigned int)*widePtr;
4686 return Jim_IntHashFunction(intValue);
4689 static void *JimReferencesHTKeyDup(void *privdata, const void *key)
4691 void *copy = Jim_Alloc(sizeof(unsigned long));
4693 JIM_NOTUSED(privdata);
4695 memcpy(copy, key, sizeof(unsigned long));
4696 return copy;
4699 static int JimReferencesHTKeyCompare(void *privdata, const void *key1, const void *key2)
4701 JIM_NOTUSED(privdata);
4703 return memcmp(key1, key2, sizeof(unsigned long)) == 0;
4706 static void JimReferencesHTKeyDestructor(void *privdata, void *key)
4708 JIM_NOTUSED(privdata);
4710 Jim_Free(key);
4713 static const Jim_HashTableType JimReferencesHashTableType = {
4714 JimReferencesHTHashFunction, /* hash function */
4715 JimReferencesHTKeyDup, /* key dup */
4716 NULL, /* val dup */
4717 JimReferencesHTKeyCompare, /* key compare */
4718 JimReferencesHTKeyDestructor, /* key destructor */
4719 JimReferencesHTValDestructor /* val destructor */
4722 /* -----------------------------------------------------------------------------
4723 * Reference object type and References API
4724 * ---------------------------------------------------------------------------*/
4726 /* The string representation of references has two features in order
4727 * to make the GC faster. The first is that every reference starts
4728 * with a non common character '<', in order to make the string matching
4729 * faster. The second is that the reference string rep is 42 characters
4730 * in length, this allows to avoid to check every object with a string
4731 * repr < 42, and usually there aren't many of these objects. */
4733 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
4735 static int JimFormatReference(char *buf, Jim_Reference *refPtr, unsigned long id)
4737 const char *fmt = "<reference.<%s>.%020lu>";
4739 sprintf(buf, fmt, refPtr->tag, id);
4740 return JIM_REFERENCE_SPACE;
4743 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
4745 static const Jim_ObjType referenceObjType = {
4746 "reference",
4747 NULL,
4748 NULL,
4749 UpdateStringOfReference,
4750 JIM_TYPE_REFERENCES,
4753 void UpdateStringOfReference(struct Jim_Obj *objPtr)
4755 int len;
4756 char buf[JIM_REFERENCE_SPACE + 1];
4757 Jim_Reference *refPtr;
4759 refPtr = objPtr->internalRep.refValue.refPtr;
4760 len = JimFormatReference(buf, refPtr, objPtr->internalRep.refValue.id);
4761 objPtr->bytes = Jim_Alloc(len + 1);
4762 memcpy(objPtr->bytes, buf, len + 1);
4763 objPtr->length = len;
4766 /* returns true if 'c' is a valid reference tag character.
4767 * i.e. inside the range [_a-zA-Z0-9] */
4768 static int isrefchar(int c)
4770 return (c == '_' || isalnum(c));
4773 static int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4775 unsigned long value;
4776 int i, len;
4777 const char *str, *start, *end;
4778 char refId[21];
4779 Jim_Reference *refPtr;
4780 Jim_HashEntry *he;
4781 char *endptr;
4783 /* Get the string representation */
4784 str = Jim_GetString(objPtr, &len);
4785 /* Check if it looks like a reference */
4786 if (len < JIM_REFERENCE_SPACE)
4787 goto badformat;
4788 /* Trim spaces */
4789 start = str;
4790 end = str + len - 1;
4791 while (*start == ' ')
4792 start++;
4793 while (*end == ' ' && end > start)
4794 end--;
4795 if (end - start + 1 != JIM_REFERENCE_SPACE)
4796 goto badformat;
4797 /* <reference.<1234567>.%020> */
4798 if (memcmp(start, "<reference.<", 12) != 0)
4799 goto badformat;
4800 if (start[12 + JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>')
4801 goto badformat;
4802 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
4803 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
4804 if (!isrefchar(start[12 + i]))
4805 goto badformat;
4807 /* Extract info from the reference. */
4808 memcpy(refId, start + 14 + JIM_REFERENCE_TAGLEN, 20);
4809 refId[20] = '\0';
4810 /* Try to convert the ID into an unsigned long */
4811 value = strtoul(refId, &endptr, 10);
4812 if (JimCheckConversion(refId, endptr) != JIM_OK)
4813 goto badformat;
4814 /* Check if the reference really exists! */
4815 he = Jim_FindHashEntry(&interp->references, &value);
4816 if (he == NULL) {
4817 Jim_SetResultFormatted(interp, "invalid reference id \"%#s\"", objPtr);
4818 return JIM_ERR;
4820 refPtr = he->u.val;
4821 /* Free the old internal repr and set the new one. */
4822 Jim_FreeIntRep(interp, objPtr);
4823 objPtr->typePtr = &referenceObjType;
4824 objPtr->internalRep.refValue.id = value;
4825 objPtr->internalRep.refValue.refPtr = refPtr;
4826 return JIM_OK;
4828 badformat:
4829 Jim_SetResultFormatted(interp, "expected reference but got \"%#s\"", objPtr);
4830 return JIM_ERR;
4833 /* Returns a new reference pointing to objPtr, having cmdNamePtr
4834 * as finalizer command (or NULL if there is no finalizer).
4835 * The returned reference object has refcount = 0. */
4836 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr, Jim_Obj *cmdNamePtr)
4838 struct Jim_Reference *refPtr;
4839 unsigned long id;
4840 Jim_Obj *refObjPtr;
4841 const char *tag;
4842 int tagLen, i;
4844 /* Perform the Garbage Collection if needed. */
4845 Jim_CollectIfNeeded(interp);
4847 refPtr = Jim_Alloc(sizeof(*refPtr));
4848 refPtr->objPtr = objPtr;
4849 Jim_IncrRefCount(objPtr);
4850 refPtr->finalizerCmdNamePtr = cmdNamePtr;
4851 if (cmdNamePtr)
4852 Jim_IncrRefCount(cmdNamePtr);
4853 id = interp->referenceNextId++;
4854 Jim_AddHashEntry(&interp->references, &id, refPtr);
4855 refObjPtr = Jim_NewObj(interp);
4856 refObjPtr->typePtr = &referenceObjType;
4857 refObjPtr->bytes = NULL;
4858 refObjPtr->internalRep.refValue.id = id;
4859 refObjPtr->internalRep.refValue.refPtr = refPtr;
4860 interp->referenceNextId++;
4861 /* Set the tag. Trimmed at JIM_REFERENCE_TAGLEN. Everything
4862 * that does not pass the 'isrefchar' test is replaced with '_' */
4863 tag = Jim_GetString(tagPtr, &tagLen);
4864 if (tagLen > JIM_REFERENCE_TAGLEN)
4865 tagLen = JIM_REFERENCE_TAGLEN;
4866 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
4867 if (i < tagLen && isrefchar(tag[i]))
4868 refPtr->tag[i] = tag[i];
4869 else
4870 refPtr->tag[i] = '_';
4872 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
4873 return refObjPtr;
4876 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
4878 if (objPtr->typePtr != &referenceObjType && SetReferenceFromAny(interp, objPtr) == JIM_ERR)
4879 return NULL;
4880 return objPtr->internalRep.refValue.refPtr;
4883 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
4885 Jim_Reference *refPtr;
4887 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
4888 return JIM_ERR;
4889 Jim_IncrRefCount(cmdNamePtr);
4890 if (refPtr->finalizerCmdNamePtr)
4891 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
4892 refPtr->finalizerCmdNamePtr = cmdNamePtr;
4893 return JIM_OK;
4896 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
4898 Jim_Reference *refPtr;
4900 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
4901 return JIM_ERR;
4902 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
4903 return JIM_OK;
4906 /* -----------------------------------------------------------------------------
4907 * References Garbage Collection
4908 * ---------------------------------------------------------------------------*/
4910 /* This the hash table type for the "MARK" phase of the GC */
4911 static const Jim_HashTableType JimRefMarkHashTableType = {
4912 JimReferencesHTHashFunction, /* hash function */
4913 JimReferencesHTKeyDup, /* key dup */
4914 NULL, /* val dup */
4915 JimReferencesHTKeyCompare, /* key compare */
4916 JimReferencesHTKeyDestructor, /* key destructor */
4917 NULL /* val destructor */
4920 /* Performs the garbage collection. */
4921 int Jim_Collect(Jim_Interp *interp)
4923 int collected = 0;
4924 #ifndef JIM_BOOTSTRAP
4925 Jim_HashTable marks;
4926 Jim_HashTableIterator *htiter;
4927 Jim_HashEntry *he;
4928 Jim_Obj *objPtr;
4930 /* Avoid recursive calls */
4931 if (interp->lastCollectId == -1) {
4932 /* Jim_Collect() already running. Return just now. */
4933 return 0;
4935 interp->lastCollectId = -1;
4937 /* Mark all the references found into the 'mark' hash table.
4938 * The references are searched in every live object that
4939 * is of a type that can contain references. */
4940 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
4941 objPtr = interp->liveList;
4942 while (objPtr) {
4943 if (objPtr->typePtr == NULL || objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
4944 const char *str, *p;
4945 int len;
4947 /* If the object is of type reference, to get the
4948 * Id is simple... */
4949 if (objPtr->typePtr == &referenceObjType) {
4950 Jim_AddHashEntry(&marks, &objPtr->internalRep.refValue.id, NULL);
4951 #ifdef JIM_DEBUG_GC
4952 printf("MARK (reference): %d refcount: %d" JIM_NL,
4953 (int)objPtr->internalRep.refValue.id, objPtr->refCount);
4954 #endif
4955 objPtr = objPtr->nextObjPtr;
4956 continue;
4958 /* Get the string repr of the object we want
4959 * to scan for references. */
4960 p = str = Jim_GetString(objPtr, &len);
4961 /* Skip objects too little to contain references. */
4962 if (len < JIM_REFERENCE_SPACE) {
4963 objPtr = objPtr->nextObjPtr;
4964 continue;
4966 /* Extract references from the object string repr. */
4967 while (1) {
4968 int i;
4969 unsigned long id;
4971 if ((p = strstr(p, "<reference.<")) == NULL)
4972 break;
4973 /* Check if it's a valid reference. */
4974 if (len - (p - str) < JIM_REFERENCE_SPACE)
4975 break;
4976 if (p[41] != '>' || p[19] != '>' || p[20] != '.')
4977 break;
4978 for (i = 21; i <= 40; i++)
4979 if (!isdigit(UCHAR(p[i])))
4980 break;
4981 /* Get the ID */
4982 id = strtoul(p + 21, NULL, 10);
4984 /* Ok, a reference for the given ID
4985 * was found. Mark it. */
4986 Jim_AddHashEntry(&marks, &id, NULL);
4987 #ifdef JIM_DEBUG_GC
4988 printf("MARK: %d" JIM_NL, (int)id);
4989 #endif
4990 p += JIM_REFERENCE_SPACE;
4993 objPtr = objPtr->nextObjPtr;
4996 /* Run the references hash table to destroy every reference that
4997 * is not referenced outside (not present in the mark HT). */
4998 htiter = Jim_GetHashTableIterator(&interp->references);
4999 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
5000 const unsigned long *refId;
5001 Jim_Reference *refPtr;
5003 refId = he->key;
5004 /* Check if in the mark phase we encountered
5005 * this reference. */
5006 if (Jim_FindHashEntry(&marks, refId) == NULL) {
5007 #ifdef JIM_DEBUG_GC
5008 printf("COLLECTING %d" JIM_NL, (int)*refId);
5009 #endif
5010 collected++;
5011 /* Drop the reference, but call the
5012 * finalizer first if registered. */
5013 refPtr = he->u.val;
5014 if (refPtr->finalizerCmdNamePtr) {
5015 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE + 1);
5016 Jim_Obj *objv[3], *oldResult;
5018 JimFormatReference(refstr, refPtr, *refId);
5020 objv[0] = refPtr->finalizerCmdNamePtr;
5021 objv[1] = Jim_NewStringObjNoAlloc(interp, refstr, 32);
5022 objv[2] = refPtr->objPtr;
5024 /* Drop the reference itself */
5025 Jim_DeleteHashEntry(&interp->references, refId);
5027 /* Call the finalizer. Errors ignored. */
5028 oldResult = interp->result;
5029 Jim_IncrRefCount(oldResult);
5030 Jim_EvalObjVector(interp, 3, objv);
5031 Jim_SetResult(interp, oldResult);
5032 Jim_DecrRefCount(interp, oldResult);
5034 else {
5035 Jim_DeleteHashEntry(&interp->references, refId);
5039 Jim_FreeHashTableIterator(htiter);
5040 Jim_FreeHashTable(&marks);
5041 interp->lastCollectId = interp->referenceNextId;
5042 interp->lastCollectTime = time(NULL);
5043 #endif /* JIM_BOOTSTRAP */
5044 return collected;
5047 #define JIM_COLLECT_ID_PERIOD 5000
5048 #define JIM_COLLECT_TIME_PERIOD 300
5050 void Jim_CollectIfNeeded(Jim_Interp *interp)
5052 unsigned long elapsedId;
5053 int elapsedTime;
5055 elapsedId = interp->referenceNextId - interp->lastCollectId;
5056 elapsedTime = time(NULL) - interp->lastCollectTime;
5059 if (elapsedId > JIM_COLLECT_ID_PERIOD || elapsedTime > JIM_COLLECT_TIME_PERIOD) {
5060 Jim_Collect(interp);
5063 #endif
5065 static int JimIsBigEndian(void)
5067 union {
5068 unsigned short s;
5069 unsigned char c[2];
5070 } uval = {0x0102};
5072 return uval.c[0] == 1;
5075 /* -----------------------------------------------------------------------------
5076 * Interpreter related functions
5077 * ---------------------------------------------------------------------------*/
5079 Jim_Interp *Jim_CreateInterp(void)
5081 Jim_Interp *i = Jim_Alloc(sizeof(*i));
5083 memset(i, 0, sizeof(*i));
5085 i->maxCallFrameDepth = JIM_MAX_CALLFRAME_DEPTH;
5086 i->maxEvalDepth = JIM_MAX_EVAL_DEPTH;
5087 i->lastCollectTime = time(NULL);
5089 /* Note that we can create objects only after the
5090 * interpreter liveList and freeList pointers are
5091 * initialized to NULL. */
5092 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
5093 #ifdef JIM_REFERENCES
5094 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
5095 #endif
5096 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
5097 Jim_InitHashTable(&i->packages, &JimPackageHashTableType, NULL);
5098 i->framePtr = i->topFramePtr = JimCreateCallFrame(i, NULL);
5099 i->emptyObj = Jim_NewEmptyStringObj(i);
5100 i->trueObj = Jim_NewIntObj(i, 1);
5101 i->falseObj = Jim_NewIntObj(i, 0);
5102 i->errorFileNameObj = i->emptyObj;
5103 i->result = i->emptyObj;
5104 i->stackTrace = Jim_NewListObj(i, NULL, 0);
5105 i->unknown = Jim_NewStringObj(i, "unknown", -1);
5106 i->errorProc = i->emptyObj;
5107 i->currentScriptObj = Jim_NewEmptyStringObj(i);
5108 Jim_IncrRefCount(i->emptyObj);
5109 Jim_IncrRefCount(i->errorFileNameObj);
5110 Jim_IncrRefCount(i->result);
5111 Jim_IncrRefCount(i->stackTrace);
5112 Jim_IncrRefCount(i->unknown);
5113 Jim_IncrRefCount(i->currentScriptObj);
5114 Jim_IncrRefCount(i->errorProc);
5115 Jim_IncrRefCount(i->trueObj);
5116 Jim_IncrRefCount(i->falseObj);
5118 /* Initialize key variables every interpreter should contain */
5119 Jim_SetVariableStrWithStr(i, JIM_LIBPATH, TCL_LIBRARY);
5120 Jim_SetVariableStrWithStr(i, JIM_INTERACTIVE, "0");
5122 Jim_SetVariableStrWithStr(i, "tcl_platform(os)", TCL_PLATFORM_OS);
5123 Jim_SetVariableStrWithStr(i, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM);
5124 Jim_SetVariableStrWithStr(i, "tcl_platform(pathSeparator)", TCL_PLATFORM_PATH_SEPARATOR);
5125 Jim_SetVariableStrWithStr(i, "tcl_platform(byteOrder)", JimIsBigEndian() ? "bigEndian" : "littleEndian");
5126 Jim_SetVariableStrWithStr(i, "tcl_platform(threaded)", "0");
5127 Jim_SetVariableStr(i, "tcl_platform(pointerSize)", Jim_NewIntObj(i, sizeof(void *)));
5128 Jim_SetVariableStr(i, "tcl_platform(wordSize)", Jim_NewIntObj(i, sizeof(jim_wide)));
5130 return i;
5133 void Jim_FreeInterp(Jim_Interp *i)
5135 Jim_CallFrame *cf = i->framePtr, *prevcf, *nextcf;
5136 Jim_Obj *objPtr, *nextObjPtr;
5138 Jim_DecrRefCount(i, i->emptyObj);
5139 Jim_DecrRefCount(i, i->trueObj);
5140 Jim_DecrRefCount(i, i->falseObj);
5141 Jim_DecrRefCount(i, i->result);
5142 Jim_DecrRefCount(i, i->stackTrace);
5143 Jim_DecrRefCount(i, i->errorProc);
5144 Jim_DecrRefCount(i, i->unknown);
5145 Jim_DecrRefCount(i, i->errorFileNameObj);
5146 Jim_DecrRefCount(i, i->currentScriptObj);
5147 Jim_FreeHashTable(&i->commands);
5148 #ifdef JIM_REFERENCES
5149 Jim_FreeHashTable(&i->references);
5150 #endif
5151 Jim_FreeHashTable(&i->packages);
5152 Jim_Free(i->prngState);
5153 Jim_FreeHashTable(&i->assocData);
5155 /* Free the call frames list */
5156 while (cf) {
5157 prevcf = cf->parent;
5158 JimFreeCallFrame(i, cf, JIM_FCF_NONE);
5159 cf = prevcf;
5161 /* Check that the live object list is empty, otherwise
5162 * there is a memory leak. */
5163 if (i->liveList != NULL) {
5164 objPtr = i->liveList;
5166 printf(JIM_NL "-------------------------------------" JIM_NL);
5167 printf("Objects still in the free list:" JIM_NL);
5168 while (objPtr) {
5169 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "string";
5171 printf("%p (%d) %-10s: '%.20s'" JIM_NL,
5172 (void *)objPtr, objPtr->refCount, type, objPtr->bytes ? objPtr->bytes : "(null)");
5173 if (objPtr->typePtr == &sourceObjType) {
5174 printf("FILE %s LINE %d" JIM_NL,
5175 Jim_String(objPtr->internalRep.sourceValue.fileNameObj),
5176 objPtr->internalRep.sourceValue.lineNumber);
5178 objPtr = objPtr->nextObjPtr;
5180 printf("-------------------------------------" JIM_NL JIM_NL);
5181 JimPanic((1, "Live list non empty freeing the interpreter! Leak?"));
5183 /* Free all the freed objects. */
5184 objPtr = i->freeList;
5185 while (objPtr) {
5186 nextObjPtr = objPtr->nextObjPtr;
5187 Jim_Free(objPtr);
5188 objPtr = nextObjPtr;
5190 /* Free cached CallFrame structures */
5191 cf = i->freeFramesList;
5192 while (cf) {
5193 nextcf = cf->next;
5194 if (cf->vars.table != NULL)
5195 Jim_Free(cf->vars.table);
5196 Jim_Free(cf);
5197 cf = nextcf;
5199 #ifdef jim_ext_load
5200 Jim_FreeLoadHandles(i);
5201 #endif
5203 /* Free the interpreter structure. */
5204 Jim_Free(i);
5207 /* Returns the call frame relative to the level represented by
5208 * levelObjPtr. If levelObjPtr == NULL, the * level is assumed to be '1'.
5210 * This function accepts the 'level' argument in the form
5211 * of the commands [uplevel] and [upvar].
5213 * For a function accepting a relative integer as level suitable
5214 * for implementation of [info level ?level?] check the
5215 * JimGetCallFrameByInteger() function.
5217 * Returns NULL on error.
5219 Jim_CallFrame *Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5221 long level;
5222 const char *str;
5223 Jim_CallFrame *framePtr;
5225 if (levelObjPtr) {
5226 str = Jim_String(levelObjPtr);
5227 if (str[0] == '#') {
5228 char *endptr;
5230 level = strtol(str + 1, &endptr, 0);
5231 if (str[1] == '\0' || endptr[0] != '\0') {
5232 level = -1;
5235 else {
5236 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0) {
5237 level = -1;
5239 else {
5240 /* Convert from a relative to an absolute level */
5241 level = interp->framePtr->level - level;
5245 else {
5246 str = "1"; /* Needed to format the error message. */
5247 level = interp->framePtr->level - 1;
5250 if (level == 0) {
5251 return interp->topFramePtr;
5253 if (level > 0) {
5254 /* Lookup */
5255 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5256 if (framePtr->level == level) {
5257 return framePtr;
5262 Jim_SetResultFormatted(interp, "bad level \"%s\"", str);
5263 return NULL;
5266 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
5267 * as a relative integer like in the [info level ?level?] command.
5269 static Jim_CallFrame *JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5271 long level;
5272 Jim_CallFrame *framePtr;
5274 if (Jim_GetLong(interp, levelObjPtr, &level) == JIM_OK) {
5275 if (level <= 0) {
5276 /* Convert from a relative to an absolute level */
5277 level = interp->framePtr->level + level;
5280 if (level == 0) {
5281 return interp->topFramePtr;
5284 /* Lookup */
5285 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5286 if (framePtr->level == level) {
5287 return framePtr;
5292 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
5293 return NULL;
5296 static void JimResetStackTrace(Jim_Interp *interp)
5298 Jim_DecrRefCount(interp, interp->stackTrace);
5299 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
5300 Jim_IncrRefCount(interp->stackTrace);
5303 static void JimSetStackTrace(Jim_Interp *interp, Jim_Obj *stackTraceObj)
5305 int len;
5307 /* Increment reference first in case these are the same object */
5308 Jim_IncrRefCount(stackTraceObj);
5309 Jim_DecrRefCount(interp, interp->stackTrace);
5310 interp->stackTrace = stackTraceObj;
5311 interp->errorFlag = 1;
5313 /* This is a bit ugly.
5314 * If the filename of the last entry of the stack trace is empty,
5315 * the next stack level should be added.
5317 len = Jim_ListLength(interp, interp->stackTrace);
5318 if (len >= 3) {
5319 Jim_Obj *filenameObj;
5321 Jim_ListIndex(interp, interp->stackTrace, len - 2, &filenameObj, JIM_NONE);
5323 Jim_GetString(filenameObj, &len);
5325 if (!Jim_Length(filenameObj)) {
5326 interp->addStackTrace = 1;
5331 /* Returns 1 if the stack trace information was used or 0 if not */
5332 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
5333 Jim_Obj *fileNameObj, int linenr)
5335 if (strcmp(procname, "unknown") == 0) {
5336 procname = "";
5338 if (!*procname && !Jim_Length(fileNameObj)) {
5339 /* No useful info here */
5340 return;
5343 if (Jim_IsShared(interp->stackTrace)) {
5344 Jim_DecrRefCount(interp, interp->stackTrace);
5345 interp->stackTrace = Jim_DuplicateObj(interp, interp->stackTrace);
5346 Jim_IncrRefCount(interp->stackTrace);
5349 /* If we have no procname but the previous element did, merge with that frame */
5350 if (!*procname && Jim_Length(fileNameObj)) {
5351 /* Just a filename. Check the previous entry */
5352 int len = Jim_ListLength(interp, interp->stackTrace);
5354 if (len >= 3) {
5355 Jim_Obj *objPtr;
5356 if (Jim_ListIndex(interp, interp->stackTrace, len - 3, &objPtr, JIM_NONE) == JIM_OK && Jim_Length(objPtr)) {
5357 /* Yes, the previous level had procname */
5358 if (Jim_ListIndex(interp, interp->stackTrace, len - 2, &objPtr, JIM_NONE) == JIM_OK && !Jim_Length(objPtr)) {
5359 /* But no filename, so merge the new info with that frame */
5360 ListSetIndex(interp, interp->stackTrace, len - 2, fileNameObj, 0);
5361 ListSetIndex(interp, interp->stackTrace, len - 1, Jim_NewIntObj(interp, linenr), 0);
5362 return;
5368 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewStringObj(interp, procname, -1));
5369 Jim_ListAppendElement(interp, interp->stackTrace, fileNameObj);
5370 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewIntObj(interp, linenr));
5373 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc * delProc,
5374 void *data)
5376 AssocDataValue *assocEntryPtr = (AssocDataValue *) Jim_Alloc(sizeof(AssocDataValue));
5378 assocEntryPtr->delProc = delProc;
5379 assocEntryPtr->data = data;
5380 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
5383 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
5385 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
5387 if (entryPtr != NULL) {
5388 AssocDataValue *assocEntryPtr = (AssocDataValue *) entryPtr->u.val;
5390 return assocEntryPtr->data;
5392 return NULL;
5395 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
5397 return Jim_DeleteHashEntry(&interp->assocData, key);
5400 int Jim_GetExitCode(Jim_Interp *interp)
5402 return interp->exitCode;
5405 /* -----------------------------------------------------------------------------
5406 * Integer object
5407 * ---------------------------------------------------------------------------*/
5408 #define JIM_INTEGER_SPACE 24
5410 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
5411 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
5413 static const Jim_ObjType intObjType = {
5414 "int",
5415 NULL,
5416 NULL,
5417 UpdateStringOfInt,
5418 JIM_TYPE_NONE,
5421 /* A coerced double is closer to an int than a double.
5422 * It is an int value temporarily masquerading as a double value.
5423 * i.e. it has the same string value as an int and Jim_GetWide()
5424 * succeeds, but also Jim_GetDouble() returns the value directly.
5426 static const Jim_ObjType coercedDoubleObjType = {
5427 "coerced-double",
5428 NULL,
5429 NULL,
5430 UpdateStringOfInt,
5431 JIM_TYPE_NONE,
5435 void UpdateStringOfInt(struct Jim_Obj *objPtr)
5437 int len;
5438 char buf[JIM_INTEGER_SPACE + 1];
5440 len = Jim_WideToString(buf, JimWideValue(objPtr));
5441 objPtr->bytes = Jim_Alloc(len + 1);
5442 memcpy(objPtr->bytes, buf, len + 1);
5443 objPtr->length = len;
5446 int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
5448 jim_wide wideValue;
5449 const char *str;
5451 if (objPtr->typePtr == &coercedDoubleObjType) {
5452 /* Simple switcheroo */
5453 objPtr->typePtr = &intObjType;
5454 return JIM_OK;
5457 /* Get the string representation */
5458 str = Jim_String(objPtr);
5459 /* Try to convert into a jim_wide */
5460 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
5461 if (flags & JIM_ERRMSG) {
5462 Jim_SetResultFormatted(interp, "expected integer but got \"%#s\"", objPtr);
5464 return JIM_ERR;
5466 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) && errno == ERANGE) {
5467 Jim_SetResultString(interp, "Integer value too big to be represented", -1);
5468 return JIM_ERR;
5470 /* Free the old internal repr and set the new one. */
5471 Jim_FreeIntRep(interp, objPtr);
5472 objPtr->typePtr = &intObjType;
5473 objPtr->internalRep.wideValue = wideValue;
5474 return JIM_OK;
5477 #ifdef JIM_OPTIMIZATION
5478 static int JimIsWide(Jim_Obj *objPtr)
5480 return objPtr->typePtr == &intObjType;
5482 #endif
5484 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5486 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
5487 return JIM_ERR;
5488 *widePtr = JimWideValue(objPtr);
5489 return JIM_OK;
5492 /* Get a wide but does not set an error if the format is bad. */
5493 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5495 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
5496 return JIM_ERR;
5497 *widePtr = JimWideValue(objPtr);
5498 return JIM_OK;
5501 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
5503 jim_wide wideValue;
5504 int retval;
5506 retval = Jim_GetWide(interp, objPtr, &wideValue);
5507 if (retval == JIM_OK) {
5508 *longPtr = (long)wideValue;
5509 return JIM_OK;
5511 return JIM_ERR;
5514 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
5516 Jim_Obj *objPtr;
5518 objPtr = Jim_NewObj(interp);
5519 objPtr->typePtr = &intObjType;
5520 objPtr->bytes = NULL;
5521 objPtr->internalRep.wideValue = wideValue;
5522 return objPtr;
5525 /* -----------------------------------------------------------------------------
5526 * Double object
5527 * ---------------------------------------------------------------------------*/
5528 #define JIM_DOUBLE_SPACE 30
5530 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
5531 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
5533 static const Jim_ObjType doubleObjType = {
5534 "double",
5535 NULL,
5536 NULL,
5537 UpdateStringOfDouble,
5538 JIM_TYPE_NONE,
5541 void UpdateStringOfDouble(struct Jim_Obj *objPtr)
5543 int len;
5544 char buf[JIM_DOUBLE_SPACE + 1];
5546 len = Jim_DoubleToString(buf, objPtr->internalRep.doubleValue);
5547 objPtr->bytes = Jim_Alloc(len + 1);
5548 memcpy(objPtr->bytes, buf, len + 1);
5549 objPtr->length = len;
5552 int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5554 double doubleValue;
5555 jim_wide wideValue;
5556 const char *str;
5558 /* Preserve the string representation.
5559 * Needed so we can convert back to int without loss
5561 str = Jim_String(objPtr);
5563 #ifdef HAVE_LONG_LONG
5564 /* Assume a 53 bit mantissa */
5565 #define MIN_INT_IN_DOUBLE -(1LL << 53)
5566 #define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1)
5568 if (objPtr->typePtr == &intObjType
5569 && JimWideValue(objPtr) >= MIN_INT_IN_DOUBLE
5570 && JimWideValue(objPtr) <= MAX_INT_IN_DOUBLE) {
5572 /* Direct conversion to coerced double */
5573 objPtr->typePtr = &coercedDoubleObjType;
5574 return JIM_OK;
5576 else
5577 #endif
5578 if (Jim_StringToWide(str, &wideValue, 10) == JIM_OK) {
5579 /* Managed to convert to an int, so we can use this as a cooerced double */
5580 Jim_FreeIntRep(interp, objPtr);
5581 objPtr->typePtr = &coercedDoubleObjType;
5582 objPtr->internalRep.wideValue = wideValue;
5583 return JIM_OK;
5585 else {
5586 /* Try to convert into a double */
5587 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
5588 Jim_SetResultFormatted(interp, "expected number but got \"%#s\"", objPtr);
5589 return JIM_ERR;
5591 /* Free the old internal repr and set the new one. */
5592 Jim_FreeIntRep(interp, objPtr);
5594 objPtr->typePtr = &doubleObjType;
5595 objPtr->internalRep.doubleValue = doubleValue;
5596 return JIM_OK;
5599 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
5601 if (objPtr->typePtr == &coercedDoubleObjType) {
5602 *doublePtr = JimWideValue(objPtr);
5603 return JIM_OK;
5605 if (objPtr->typePtr != &doubleObjType && SetDoubleFromAny(interp, objPtr) == JIM_ERR)
5606 return JIM_ERR;
5608 if (objPtr->typePtr == &coercedDoubleObjType) {
5609 *doublePtr = JimWideValue(objPtr);
5611 else {
5612 *doublePtr = objPtr->internalRep.doubleValue;
5614 return JIM_OK;
5617 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
5619 Jim_Obj *objPtr;
5621 objPtr = Jim_NewObj(interp);
5622 objPtr->typePtr = &doubleObjType;
5623 objPtr->bytes = NULL;
5624 objPtr->internalRep.doubleValue = doubleValue;
5625 return objPtr;
5628 /* -----------------------------------------------------------------------------
5629 * List object
5630 * ---------------------------------------------------------------------------*/
5631 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec);
5632 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
5633 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
5634 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
5635 static void UpdateStringOfList(struct Jim_Obj *objPtr);
5636 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
5638 /* Note that while the elements of the list may contain references,
5639 * the list object itself can't. This basically means that the
5640 * list object string representation as a whole can't contain references
5641 * that are not presents in the single elements. */
5642 static const Jim_ObjType listObjType = {
5643 "list",
5644 FreeListInternalRep,
5645 DupListInternalRep,
5646 UpdateStringOfList,
5647 JIM_TYPE_NONE,
5650 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
5652 int i;
5654 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5655 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
5657 Jim_Free(objPtr->internalRep.listValue.ele);
5660 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
5662 int i;
5664 JIM_NOTUSED(interp);
5666 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
5667 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
5668 dupPtr->internalRep.listValue.ele =
5669 Jim_Alloc(sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.maxLen);
5670 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
5671 sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.len);
5672 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
5673 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
5675 dupPtr->typePtr = &listObjType;
5678 /* The following function checks if a given string can be encoded
5679 * into a list element without any kind of quoting, surrounded by braces,
5680 * or using escapes to quote. */
5681 #define JIM_ELESTR_SIMPLE 0
5682 #define JIM_ELESTR_BRACE 1
5683 #define JIM_ELESTR_QUOTE 2
5684 static int ListElementQuotingType(const char *s, int len)
5686 int i, level, blevel, trySimple = 1;
5688 /* Try with the SIMPLE case */
5689 if (len == 0)
5690 return JIM_ELESTR_BRACE;
5691 if (s[0] == '"' || s[0] == '{') {
5692 trySimple = 0;
5693 goto testbrace;
5695 for (i = 0; i < len; i++) {
5696 switch (s[i]) {
5697 case ' ':
5698 case '$':
5699 case '"':
5700 case '[':
5701 case ']':
5702 case ';':
5703 case '\\':
5704 case '\r':
5705 case '\n':
5706 case '\t':
5707 case '\f':
5708 case '\v':
5709 trySimple = 0;
5710 case '{':
5711 case '}':
5712 goto testbrace;
5715 return JIM_ELESTR_SIMPLE;
5717 testbrace:
5718 /* Test if it's possible to do with braces */
5719 if (s[len - 1] == '\\')
5720 return JIM_ELESTR_QUOTE;
5721 level = 0;
5722 blevel = 0;
5723 for (i = 0; i < len; i++) {
5724 switch (s[i]) {
5725 case '{':
5726 level++;
5727 break;
5728 case '}':
5729 level--;
5730 if (level < 0)
5731 return JIM_ELESTR_QUOTE;
5732 break;
5733 case '[':
5734 blevel++;
5735 break;
5736 case ']':
5737 blevel--;
5738 break;
5739 case '\\':
5740 if (s[i + 1] == '\n')
5741 return JIM_ELESTR_QUOTE;
5742 else if (s[i + 1] != '\0')
5743 i++;
5744 break;
5747 if (blevel < 0) {
5748 return JIM_ELESTR_QUOTE;
5751 if (level == 0) {
5752 if (!trySimple)
5753 return JIM_ELESTR_BRACE;
5754 for (i = 0; i < len; i++) {
5755 switch (s[i]) {
5756 case ' ':
5757 case '$':
5758 case '"':
5759 case '[':
5760 case ']':
5761 case ';':
5762 case '\\':
5763 case '\r':
5764 case '\n':
5765 case '\t':
5766 case '\f':
5767 case '\v':
5768 return JIM_ELESTR_BRACE;
5769 break;
5772 return JIM_ELESTR_SIMPLE;
5774 return JIM_ELESTR_QUOTE;
5777 /* Backslashes-escapes the null-terminated string 's' into the buffer at 'q'
5778 * The buffer must be at least strlen(s) * 2 + 1 bytes long for the worst-case
5779 * scenario.
5780 * Returns the length of the result.
5782 static int BackslashQuoteString(const char *s, char *q)
5784 char *p = q;
5786 while (*s) {
5787 switch (*s) {
5788 case ' ':
5789 case '$':
5790 case '"':
5791 case '[':
5792 case ']':
5793 case '{':
5794 case '}':
5795 case ';':
5796 case '\\':
5797 *p++ = '\\';
5798 *p++ = *s++;
5799 break;
5800 case '\n':
5801 *p++ = '\\';
5802 *p++ = 'n';
5803 s++;
5804 break;
5805 case '\r':
5806 *p++ = '\\';
5807 *p++ = 'r';
5808 s++;
5809 break;
5810 case '\t':
5811 *p++ = '\\';
5812 *p++ = 't';
5813 s++;
5814 break;
5815 case '\f':
5816 *p++ = '\\';
5817 *p++ = 'f';
5818 s++;
5819 break;
5820 case '\v':
5821 *p++ = '\\';
5822 *p++ = 'v';
5823 s++;
5824 break;
5825 default:
5826 *p++ = *s++;
5827 break;
5830 *p = '\0';
5832 return p - q;
5835 static void JimMakeListStringRep(Jim_Obj *objPtr, Jim_Obj **objv, int objc)
5837 int i, bufLen, realLength;
5838 const char *strRep;
5839 char *p;
5840 int *quotingType;
5842 /* (Over) Estimate the space needed. */
5843 quotingType = Jim_Alloc(sizeof(int) * objc + 1);
5844 bufLen = 0;
5845 for (i = 0; i < objc; i++) {
5846 int len;
5848 strRep = Jim_GetString(objv[i], &len);
5849 quotingType[i] = ListElementQuotingType(strRep, len);
5850 switch (quotingType[i]) {
5851 case JIM_ELESTR_SIMPLE:
5852 if (i != 0 || strRep[0] != '#') {
5853 bufLen += len;
5854 break;
5856 /* Special case '#' on first element needs braces */
5857 quotingType[i] = JIM_ELESTR_BRACE;
5858 /* fall through */
5859 case JIM_ELESTR_BRACE:
5860 bufLen += len + 2;
5861 break;
5862 case JIM_ELESTR_QUOTE:
5863 bufLen += len * 2;
5864 break;
5866 bufLen++; /* elements separator. */
5868 bufLen++;
5870 /* Generate the string rep. */
5871 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
5872 realLength = 0;
5873 for (i = 0; i < objc; i++) {
5874 int len, qlen;
5876 strRep = Jim_GetString(objv[i], &len);
5878 switch (quotingType[i]) {
5879 case JIM_ELESTR_SIMPLE:
5880 memcpy(p, strRep, len);
5881 p += len;
5882 realLength += len;
5883 break;
5884 case JIM_ELESTR_BRACE:
5885 *p++ = '{';
5886 memcpy(p, strRep, len);
5887 p += len;
5888 *p++ = '}';
5889 realLength += len + 2;
5890 break;
5891 case JIM_ELESTR_QUOTE:
5892 if (i == 0 && strRep[0] == '#') {
5893 *p++ = '\\';
5894 realLength++;
5896 qlen = BackslashQuoteString(strRep, p);
5897 p += qlen;
5898 realLength += qlen;
5899 break;
5901 /* Add a separating space */
5902 if (i + 1 != objc) {
5903 *p++ = ' ';
5904 realLength++;
5907 *p = '\0'; /* nul term. */
5908 objPtr->length = realLength;
5909 Jim_Free(quotingType);
5912 static void UpdateStringOfList(struct Jim_Obj *objPtr)
5914 JimMakeListStringRep(objPtr, objPtr->internalRep.listValue.ele, objPtr->internalRep.listValue.len);
5917 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
5919 struct JimParserCtx parser;
5920 const char *str;
5921 int strLen;
5922 Jim_Obj *fileNameObj;
5923 int linenr;
5925 if (objPtr->typePtr == &listObjType) {
5926 return JIM_OK;
5929 #if 0
5930 /* Optimise dict -> list. XXX: Is it worth it? */
5931 if (Jim_IsDict(objPtr)) {
5932 Jim_Obj **listObjPtrPtr;
5933 int len;
5934 int i;
5936 Jim_DictPairs(interp, objPtr, &listObjPtrPtr, &len);
5937 for (i = 0; i < len; i++) {
5938 Jim_IncrRefCount(listObjPtrPtr[i]);
5941 /* Now just switch the internal rep */
5942 Jim_FreeIntRep(interp, objPtr);
5943 objPtr->typePtr = &listObjType;
5944 objPtr->internalRep.listValue.len = len;
5945 objPtr->internalRep.listValue.maxLen = len;
5946 objPtr->internalRep.listValue.ele = listObjPtrPtr;
5948 return JIM_OK;
5950 #endif
5952 /* Try to preserve information about filename / line number */
5953 if (objPtr->typePtr == &sourceObjType) {
5954 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
5955 linenr = objPtr->internalRep.sourceValue.lineNumber;
5957 else {
5958 fileNameObj = interp->emptyObj;
5959 linenr = 1;
5961 Jim_IncrRefCount(fileNameObj);
5963 /* Get the string representation */
5964 str = Jim_GetString(objPtr, &strLen);
5966 /* Free the old internal repr just now and initialize the
5967 * new one just now. The string->list conversion can't fail. */
5968 Jim_FreeIntRep(interp, objPtr);
5969 objPtr->typePtr = &listObjType;
5970 objPtr->internalRep.listValue.len = 0;
5971 objPtr->internalRep.listValue.maxLen = 0;
5972 objPtr->internalRep.listValue.ele = NULL;
5974 /* Convert into a list */
5975 JimParserInit(&parser, str, strLen, linenr);
5976 while (!parser.eof) {
5977 Jim_Obj *elementPtr;
5979 JimParseList(&parser);
5980 if (parser.tt != JIM_TT_STR && parser.tt != JIM_TT_ESC)
5981 continue;
5982 elementPtr = JimParserGetTokenObj(interp, &parser);
5983 JimSetSourceInfo(interp, elementPtr, fileNameObj, parser.tline);
5984 ListAppendElement(objPtr, elementPtr);
5986 Jim_DecrRefCount(interp, fileNameObj);
5987 return JIM_OK;
5990 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
5992 Jim_Obj *objPtr;
5994 objPtr = Jim_NewObj(interp);
5995 objPtr->typePtr = &listObjType;
5996 objPtr->bytes = NULL;
5997 objPtr->internalRep.listValue.ele = NULL;
5998 objPtr->internalRep.listValue.len = 0;
5999 objPtr->internalRep.listValue.maxLen = 0;
6001 if (len) {
6002 ListInsertElements(objPtr, 0, len, elements);
6005 return objPtr;
6008 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
6009 * length of the vector. Note that the user of this function should make
6010 * sure that the list object can't shimmer while the vector returned
6011 * is in use, this vector is the one stored inside the internal representation
6012 * of the list object. This function is not exported, extensions should
6013 * always access to the List object elements using Jim_ListIndex(). */
6014 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *listLen,
6015 Jim_Obj ***listVec)
6017 *listLen = Jim_ListLength(interp, listObj);
6018 *listVec = listObj->internalRep.listValue.ele;
6021 /* Sorting uses ints, but commands may return wide */
6022 static int JimSign(jim_wide w)
6024 if (w == 0) {
6025 return 0;
6027 else if (w < 0) {
6028 return -1;
6030 return 1;
6033 /* ListSortElements type values */
6034 struct lsort_info {
6035 jmp_buf jmpbuf;
6036 Jim_Obj *command;
6037 Jim_Interp *interp;
6038 enum {
6039 JIM_LSORT_ASCII,
6040 JIM_LSORT_NOCASE,
6041 JIM_LSORT_INTEGER,
6042 JIM_LSORT_COMMAND
6043 } type;
6044 int order;
6045 int index;
6046 int indexed;
6047 int (*subfn)(Jim_Obj **, Jim_Obj **);
6050 static struct lsort_info *sort_info;
6052 static int ListSortIndexHelper(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6054 Jim_Obj *lObj, *rObj;
6056 if (Jim_ListIndex(sort_info->interp, *lhsObj, sort_info->index, &lObj, JIM_ERRMSG) != JIM_OK ||
6057 Jim_ListIndex(sort_info->interp, *rhsObj, sort_info->index, &rObj, JIM_ERRMSG) != JIM_OK) {
6058 longjmp(sort_info->jmpbuf, JIM_ERR);
6060 return sort_info->subfn(&lObj, &rObj);
6063 /* Sort the internal rep of a list. */
6064 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6066 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 0) * sort_info->order;
6069 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6071 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 1) * sort_info->order;
6074 static int ListSortInteger(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6076 jim_wide lhs = 0, rhs = 0;
6078 if (Jim_GetWide(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6079 Jim_GetWide(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6080 longjmp(sort_info->jmpbuf, JIM_ERR);
6083 return JimSign(lhs - rhs) * sort_info->order;
6086 static int ListSortCommand(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6088 Jim_Obj *compare_script;
6089 int rc;
6091 jim_wide ret = 0;
6093 /* This must be a valid list */
6094 compare_script = Jim_DuplicateObj(sort_info->interp, sort_info->command);
6095 Jim_ListAppendElement(sort_info->interp, compare_script, *lhsObj);
6096 Jim_ListAppendElement(sort_info->interp, compare_script, *rhsObj);
6098 rc = Jim_EvalObj(sort_info->interp, compare_script);
6100 if (rc != JIM_OK || Jim_GetWide(sort_info->interp, Jim_GetResult(sort_info->interp), &ret) != JIM_OK) {
6101 longjmp(sort_info->jmpbuf, rc);
6104 return JimSign(ret) * sort_info->order;
6107 /* Sort a list *in place*. MUST be called with non-shared objects. */
6108 static int ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, struct lsort_info *info)
6110 struct lsort_info *prev_info;
6112 typedef int (qsort_comparator) (const void *, const void *);
6113 int (*fn) (Jim_Obj **, Jim_Obj **);
6114 Jim_Obj **vector;
6115 int len;
6116 int rc;
6118 JimPanic((Jim_IsShared(listObjPtr), "Jim_ListSortElements called with shared object"));
6119 SetListFromAny(interp, listObjPtr);
6121 /* Allow lsort to be called reentrantly */
6122 prev_info = sort_info;
6123 sort_info = info;
6125 vector = listObjPtr->internalRep.listValue.ele;
6126 len = listObjPtr->internalRep.listValue.len;
6127 switch (info->type) {
6128 case JIM_LSORT_ASCII:
6129 fn = ListSortString;
6130 break;
6131 case JIM_LSORT_NOCASE:
6132 fn = ListSortStringNoCase;
6133 break;
6134 case JIM_LSORT_INTEGER:
6135 fn = ListSortInteger;
6136 break;
6137 case JIM_LSORT_COMMAND:
6138 fn = ListSortCommand;
6139 break;
6140 default:
6141 fn = NULL; /* avoid warning */
6142 JimPanic((1, "ListSort called with invalid sort type"));
6145 if (info->indexed) {
6146 /* Need to interpose a "list index" function */
6147 info->subfn = fn;
6148 fn = ListSortIndexHelper;
6151 if ((rc = setjmp(info->jmpbuf)) == 0) {
6152 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *) fn);
6154 Jim_InvalidateStringRep(listObjPtr);
6155 sort_info = prev_info;
6157 return rc;
6160 /* This is the low-level function to insert elements into a list.
6161 * The higher-level Jim_ListInsertElements() performs shared object
6162 * check and invalidate the string repr. This version is used
6163 * in the internals of the List Object and is not exported.
6165 * NOTE: this function can be called only against objects
6166 * with internal type of List.
6168 * An insertion point (idx) of -1 means end-of-list.
6170 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec)
6172 int currentLen = listPtr->internalRep.listValue.len;
6173 int requiredLen = currentLen + elemc;
6174 int i;
6175 Jim_Obj **point;
6177 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
6178 listPtr->internalRep.listValue.maxLen = requiredLen * 2;
6180 listPtr->internalRep.listValue.ele = Jim_Realloc(listPtr->internalRep.listValue.ele,
6181 sizeof(Jim_Obj *) * listPtr->internalRep.listValue.maxLen);
6183 if (idx < 0) {
6184 idx = currentLen;
6186 point = listPtr->internalRep.listValue.ele + idx;
6187 memmove(point + elemc, point, (currentLen - idx) * sizeof(Jim_Obj *));
6188 for (i = 0; i < elemc; ++i) {
6189 point[i] = elemVec[i];
6190 Jim_IncrRefCount(point[i]);
6192 listPtr->internalRep.listValue.len += elemc;
6195 /* Convenience call to ListInsertElements() to append a single element.
6197 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
6199 ListInsertElements(listPtr, -1, 1, &objPtr);
6202 /* Appends every element of appendListPtr into listPtr.
6203 * Both have to be of the list type.
6204 * Convenience call to ListInsertElements()
6206 static void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6208 ListInsertElements(listPtr, -1,
6209 appendListPtr->internalRep.listValue.len, appendListPtr->internalRep.listValue.ele);
6212 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
6214 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendElement called with shared object"));
6215 SetListFromAny(interp, listPtr);
6216 Jim_InvalidateStringRep(listPtr);
6217 ListAppendElement(listPtr, objPtr);
6220 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6222 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendList called with shared object"));
6223 SetListFromAny(interp, listPtr);
6224 SetListFromAny(interp, appendListPtr);
6225 Jim_InvalidateStringRep(listPtr);
6226 ListAppendList(listPtr, appendListPtr);
6229 int Jim_ListLength(Jim_Interp *interp, Jim_Obj *objPtr)
6231 SetListFromAny(interp, objPtr);
6232 return objPtr->internalRep.listValue.len;
6235 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6236 int objc, Jim_Obj *const *objVec)
6238 JimPanic((Jim_IsShared(listPtr), "Jim_ListInsertElement called with shared object"));
6239 SetListFromAny(interp, listPtr);
6240 if (idx >= 0 && idx > listPtr->internalRep.listValue.len)
6241 idx = listPtr->internalRep.listValue.len;
6242 else if (idx < 0)
6243 idx = 0;
6244 Jim_InvalidateStringRep(listPtr);
6245 ListInsertElements(listPtr, idx, objc, objVec);
6248 Jim_Obj *Jim_ListGetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx)
6250 SetListFromAny(interp, listPtr);
6251 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6252 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6253 return NULL;
6255 if (idx < 0)
6256 idx = listPtr->internalRep.listValue.len + idx;
6257 return listPtr->internalRep.listValue.ele[idx];
6260 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx, Jim_Obj **objPtrPtr, int flags)
6262 *objPtrPtr = Jim_ListGetIndex(interp, listPtr, idx);
6263 if (*objPtrPtr == NULL) {
6264 if (flags & JIM_ERRMSG) {
6265 Jim_SetResultString(interp, "list index out of range", -1);
6267 return JIM_ERR;
6269 return JIM_OK;
6272 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6273 Jim_Obj *newObjPtr, int flags)
6275 SetListFromAny(interp, listPtr);
6276 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6277 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6278 if (flags & JIM_ERRMSG) {
6279 Jim_SetResultString(interp, "list index out of range", -1);
6281 return JIM_ERR;
6283 if (idx < 0)
6284 idx = listPtr->internalRep.listValue.len + idx;
6285 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[idx]);
6286 listPtr->internalRep.listValue.ele[idx] = newObjPtr;
6287 Jim_IncrRefCount(newObjPtr);
6288 return JIM_OK;
6291 /* Modify the list stored into the variable named 'varNamePtr'
6292 * setting the element specified by the 'indexc' indexes objects in 'indexv',
6293 * with the new element 'newObjptr'. */
6294 int Jim_SetListIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
6295 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
6297 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
6298 int shared, i, idx;
6300 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG | JIM_UNSHARED);
6301 if (objPtr == NULL)
6302 return JIM_ERR;
6303 if ((shared = Jim_IsShared(objPtr)))
6304 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
6305 for (i = 0; i < indexc - 1; i++) {
6306 listObjPtr = objPtr;
6307 if (Jim_GetIndex(interp, indexv[i], &idx) != JIM_OK)
6308 goto err;
6309 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_ERRMSG) != JIM_OK) {
6310 goto err;
6312 if (Jim_IsShared(objPtr)) {
6313 objPtr = Jim_DuplicateObj(interp, objPtr);
6314 ListSetIndex(interp, listObjPtr, idx, objPtr, JIM_NONE);
6316 Jim_InvalidateStringRep(listObjPtr);
6318 if (Jim_GetIndex(interp, indexv[indexc - 1], &idx) != JIM_OK)
6319 goto err;
6320 if (ListSetIndex(interp, objPtr, idx, newObjPtr, JIM_ERRMSG) == JIM_ERR)
6321 goto err;
6322 Jim_InvalidateStringRep(objPtr);
6323 Jim_InvalidateStringRep(varObjPtr);
6324 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
6325 goto err;
6326 Jim_SetResult(interp, varObjPtr);
6327 return JIM_OK;
6328 err:
6329 if (shared) {
6330 Jim_FreeNewObj(interp, varObjPtr);
6332 return JIM_ERR;
6335 Jim_Obj *Jim_ListJoin(Jim_Interp *interp, Jim_Obj *listObjPtr, const char *joinStr, int joinStrLen)
6337 int i;
6338 int listLen = Jim_ListLength(interp, listObjPtr);
6339 Jim_Obj *resObjPtr = Jim_NewEmptyStringObj(interp);
6341 for (i = 0; i < listLen; ) {
6342 Jim_Obj *objPtr;
6344 Jim_ListIndex(interp, listObjPtr, i, &objPtr, JIM_NONE);
6345 Jim_AppendObj(interp, resObjPtr, objPtr);
6346 if (++i != listLen) {
6347 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
6350 return resObjPtr;
6353 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
6355 int i;
6357 /* If all the objects in objv are lists,
6358 * it's possible to return a list as result, that's the
6359 * concatenation of all the lists. */
6360 for (i = 0; i < objc; i++) {
6361 if (!Jim_IsList(objv[i]))
6362 break;
6364 if (i == objc) {
6365 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
6367 for (i = 0; i < objc; i++)
6368 ListAppendList(objPtr, objv[i]);
6369 return objPtr;
6371 else {
6372 /* Else... we have to glue strings together */
6373 int len = 0, objLen;
6374 char *bytes, *p;
6376 /* Compute the length */
6377 for (i = 0; i < objc; i++) {
6378 Jim_GetString(objv[i], &objLen);
6379 len += objLen;
6381 if (objc)
6382 len += objc - 1;
6383 /* Create the string rep, and a string object holding it. */
6384 p = bytes = Jim_Alloc(len + 1);
6385 for (i = 0; i < objc; i++) {
6386 const char *s = Jim_GetString(objv[i], &objLen);
6388 /* Remove leading space */
6389 while (objLen && (*s == ' ' || *s == '\t' || *s == '\n')) {
6390 s++;
6391 objLen--;
6392 len--;
6394 /* And trailing space */
6395 while (objLen && (s[objLen - 1] == ' ' ||
6396 s[objLen - 1] == '\n' || s[objLen - 1] == '\t')) {
6397 /* Handle trailing backslash-space case */
6398 if (objLen > 1 && s[objLen - 2] == '\\') {
6399 break;
6401 objLen--;
6402 len--;
6404 memcpy(p, s, objLen);
6405 p += objLen;
6406 if (objLen && i + 1 != objc) {
6407 *p++ = ' ';
6409 else if (i + 1 != objc) {
6410 /* Drop the space calcuated for this
6411 * element that is instead null. */
6412 len--;
6415 *p = '\0';
6416 return Jim_NewStringObjNoAlloc(interp, bytes, len);
6420 /* Returns a list composed of the elements in the specified range.
6421 * first and start are directly accepted as Jim_Objects and
6422 * processed for the end?-index? case. */
6423 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr,
6424 Jim_Obj *lastObjPtr)
6426 int first, last;
6427 int len, rangeLen;
6429 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
6430 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
6431 return NULL;
6432 len = Jim_ListLength(interp, listObjPtr); /* will convert into list */
6433 first = JimRelToAbsIndex(len, first);
6434 last = JimRelToAbsIndex(len, last);
6435 JimRelToAbsRange(len, &first, &last, &rangeLen);
6436 if (first == 0 && last == len) {
6437 return listObjPtr;
6439 return Jim_NewListObj(interp, listObjPtr->internalRep.listValue.ele + first, rangeLen);
6442 /* -----------------------------------------------------------------------------
6443 * Dict object
6444 * ---------------------------------------------------------------------------*/
6445 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6446 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6447 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
6448 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6450 /* Dict HashTable Type.
6452 * Keys and Values are Jim objects. */
6454 static unsigned int JimObjectHTHashFunction(const void *key)
6456 int len;
6457 const char *str = Jim_GetString((Jim_Obj *)key, &len);
6458 return Jim_GenHashFunction((const unsigned char *)str, len);
6461 static int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
6463 return Jim_StringEqObj((Jim_Obj *)key1, (Jim_Obj *)key2);
6466 static void JimObjectHTKeyValDestructor(void *interp, void *val)
6468 Jim_DecrRefCount(interp, (Jim_Obj *)val);
6471 static const Jim_HashTableType JimDictHashTableType = {
6472 JimObjectHTHashFunction, /* hash function */
6473 NULL, /* key dup */
6474 NULL, /* val dup */
6475 JimObjectHTKeyCompare, /* key compare */
6476 JimObjectHTKeyValDestructor, /* key destructor */
6477 JimObjectHTKeyValDestructor /* val destructor */
6480 /* Note that while the elements of the dict may contain references,
6481 * the list object itself can't. This basically means that the
6482 * dict object string representation as a whole can't contain references
6483 * that are not presents in the single elements. */
6484 static const Jim_ObjType dictObjType = {
6485 "dict",
6486 FreeDictInternalRep,
6487 DupDictInternalRep,
6488 UpdateStringOfDict,
6489 JIM_TYPE_NONE,
6492 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6494 JIM_NOTUSED(interp);
6496 Jim_FreeHashTable(objPtr->internalRep.ptr);
6497 Jim_Free(objPtr->internalRep.ptr);
6500 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6502 Jim_HashTable *ht, *dupHt;
6503 Jim_HashTableIterator *htiter;
6504 Jim_HashEntry *he;
6506 /* Create a new hash table */
6507 ht = srcPtr->internalRep.ptr;
6508 dupHt = Jim_Alloc(sizeof(*dupHt));
6509 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
6510 if (ht->size != 0)
6511 Jim_ExpandHashTable(dupHt, ht->size);
6512 /* Copy every element from the source to the dup hash table */
6513 htiter = Jim_GetHashTableIterator(ht);
6514 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
6515 const Jim_Obj *keyObjPtr = he->key;
6516 Jim_Obj *valObjPtr = he->u.val;
6518 Jim_IncrRefCount((Jim_Obj *)keyObjPtr); /* ATTENTION: const cast */
6519 Jim_IncrRefCount(valObjPtr);
6520 Jim_AddHashEntry(dupHt, keyObjPtr, valObjPtr);
6522 Jim_FreeHashTableIterator(htiter);
6524 dupPtr->internalRep.ptr = dupHt;
6525 dupPtr->typePtr = &dictObjType;
6528 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len)
6530 Jim_HashTable *ht;
6531 Jim_HashTableIterator *htiter;
6532 Jim_HashEntry *he;
6533 Jim_Obj **objv;
6534 int i;
6536 ht = dictPtr->internalRep.ptr;
6538 /* Turn the hash table into a flat vector of Jim_Objects. */
6539 objv = Jim_Alloc((ht->used * 2) * sizeof(Jim_Obj *));
6540 htiter = Jim_GetHashTableIterator(ht);
6541 i = 0;
6542 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
6543 objv[i++] = (Jim_Obj *)he->key;
6544 objv[i++] = he->u.val;
6546 *len = i;
6547 Jim_FreeHashTableIterator(htiter);
6548 return objv;
6551 static void UpdateStringOfDict(struct Jim_Obj *objPtr)
6553 /* Turn the hash table into a flat vector of Jim_Objects. */
6554 int len;
6555 Jim_Obj **objv = JimDictPairs(objPtr, &len);
6557 JimMakeListStringRep(objPtr, objv, len);
6559 Jim_Free(objv);
6562 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6564 int listlen;
6566 if (objPtr->typePtr == &dictObjType) {
6567 return JIM_OK;
6570 /* Get the string representation. Do this first so we don't
6571 * change order in case of fast conversion to dict.
6573 Jim_String(objPtr);
6575 /* For simplicity, convert a non-list object to a list and then to a dict */
6576 listlen = Jim_ListLength(interp, objPtr);
6577 if (listlen % 2) {
6578 Jim_SetResultString(interp,
6579 "invalid dictionary value: must be a list with an even number of elements", -1);
6580 return JIM_ERR;
6582 else {
6583 /* Now it is easy to convert to a dict from a list, and it can't fail */
6584 Jim_HashTable *ht;
6585 int i;
6587 ht = Jim_Alloc(sizeof(*ht));
6588 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
6590 for (i = 0; i < listlen; i += 2) {
6591 Jim_Obj *keyObjPtr;
6592 Jim_Obj *valObjPtr;
6594 Jim_ListIndex(interp, objPtr, i, &keyObjPtr, JIM_NONE);
6595 Jim_ListIndex(interp, objPtr, i + 1, &valObjPtr, JIM_NONE);
6597 Jim_IncrRefCount(keyObjPtr);
6598 Jim_IncrRefCount(valObjPtr);
6600 if (Jim_AddHashEntry(ht, keyObjPtr, valObjPtr) != JIM_OK) {
6601 Jim_HashEntry *he;
6603 he = Jim_FindHashEntry(ht, keyObjPtr);
6604 Jim_DecrRefCount(interp, keyObjPtr);
6605 /* ATTENTION: const cast */
6606 Jim_DecrRefCount(interp, (Jim_Obj *)he->u.val);
6607 he->u.val = valObjPtr;
6611 Jim_FreeIntRep(interp, objPtr);
6612 objPtr->typePtr = &dictObjType;
6613 objPtr->internalRep.ptr = ht;
6615 return JIM_OK;
6619 /* Dict object API */
6621 /* Add an element to a dict. objPtr must be of the "dict" type.
6622 * The higer-level exported function is Jim_DictAddElement().
6623 * If an element with the specified key already exists, the value
6624 * associated is replaced with the new one.
6626 * if valueObjPtr == NULL, the key is instead removed if it exists. */
6627 static int DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
6628 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
6630 Jim_HashTable *ht = objPtr->internalRep.ptr;
6632 if (valueObjPtr == NULL) { /* unset */
6633 return Jim_DeleteHashEntry(ht, keyObjPtr);
6635 Jim_IncrRefCount(keyObjPtr);
6636 Jim_IncrRefCount(valueObjPtr);
6637 if (Jim_ReplaceHashEntry(ht, keyObjPtr, valueObjPtr)) {
6638 /* Value existed, so need to decrement key ref count */
6639 Jim_DecrRefCount(interp, keyObjPtr);
6641 return JIM_OK;
6644 /* Add an element, higher-level interface for DictAddElement().
6645 * If valueObjPtr == NULL, the key is removed if it exists. */
6646 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
6647 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
6649 int retcode;
6651 JimPanic((Jim_IsShared(objPtr), "Jim_DictAddElement called with shared object"));
6652 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
6653 return JIM_ERR;
6655 retcode = DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
6656 Jim_InvalidateStringRep(objPtr);
6657 return retcode;
6660 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
6662 Jim_Obj *objPtr;
6663 int i;
6665 JimPanic((len % 2, "Jim_NewDictObj() 'len' argument must be even"));
6667 objPtr = Jim_NewObj(interp);
6668 objPtr->typePtr = &dictObjType;
6669 objPtr->bytes = NULL;
6670 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
6671 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
6672 for (i = 0; i < len; i += 2)
6673 DictAddElement(interp, objPtr, elements[i], elements[i + 1]);
6674 return objPtr;
6677 /* Return the value associated to the specified dict key
6678 * Note: Returns JIM_OK if OK, JIM_ERR if entry not found or -1 if can't create dict value
6680 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
6681 Jim_Obj **objPtrPtr, int flags)
6683 Jim_HashEntry *he;
6684 Jim_HashTable *ht;
6686 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
6687 return -1;
6689 ht = dictPtr->internalRep.ptr;
6690 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
6691 if (flags & JIM_ERRMSG) {
6692 Jim_SetResultFormatted(interp, "key \"%#s\" not found in dictionary", keyPtr);
6694 return JIM_ERR;
6696 *objPtrPtr = he->u.val;
6697 return JIM_OK;
6700 /* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */
6701 int Jim_DictPairs(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj ***objPtrPtr, int *len)
6703 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
6704 return JIM_ERR;
6706 *objPtrPtr = JimDictPairs(dictPtr, len);
6708 return JIM_OK;
6712 /* Return the value associated to the specified dict keys */
6713 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
6714 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
6716 int i;
6718 if (keyc == 0) {
6719 *objPtrPtr = dictPtr;
6720 return JIM_OK;
6723 for (i = 0; i < keyc; i++) {
6724 Jim_Obj *objPtr;
6726 int rc = Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags);
6727 if (rc != JIM_OK) {
6728 return rc;
6730 dictPtr = objPtr;
6732 *objPtrPtr = dictPtr;
6733 return JIM_OK;
6736 /* Modify the dict stored into the variable named 'varNamePtr'
6737 * setting the element specified by the 'keyc' keys objects in 'keyv',
6738 * with the new value of the element 'newObjPtr'.
6740 * If newObjPtr == NULL the operation is to remove the given key
6741 * from the dictionary.
6743 * If flags & JIM_ERRMSG, then failure to remove the key is considered an error
6744 * and JIM_ERR is returned. Otherwise it is ignored and JIM_OK is returned.
6746 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
6747 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr, int flags)
6749 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
6750 int shared, i;
6752 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, flags);
6753 if (objPtr == NULL) {
6754 if (newObjPtr == NULL && (flags & JIM_ERRMSG)) {
6755 /* Cannot remove a key from non existing var */
6756 return JIM_ERR;
6758 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
6759 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
6760 Jim_FreeNewObj(interp, varObjPtr);
6761 return JIM_ERR;
6764 if ((shared = Jim_IsShared(objPtr)))
6765 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
6766 for (i = 0; i < keyc; i++) {
6767 dictObjPtr = objPtr;
6769 /* Check if it's a valid dictionary */
6770 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK) {
6771 goto err;
6774 if (i == keyc - 1) {
6775 /* Last key: Note that error on unset with missing last key is OK */
6776 if (Jim_DictAddElement(interp, objPtr, keyv[keyc - 1], newObjPtr) != JIM_OK) {
6777 if (newObjPtr || (flags & JIM_ERRMSG)) {
6778 goto err;
6781 break;
6784 /* Check if the given key exists. */
6785 Jim_InvalidateStringRep(dictObjPtr);
6786 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
6787 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK) {
6788 /* This key exists at the current level.
6789 * Make sure it's not shared!. */
6790 if (Jim_IsShared(objPtr)) {
6791 objPtr = Jim_DuplicateObj(interp, objPtr);
6792 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
6795 else {
6796 /* Key not found. If it's an [unset] operation
6797 * this is an error. Only the last key may not
6798 * exist. */
6799 if (newObjPtr == NULL) {
6800 goto err;
6802 /* Otherwise set an empty dictionary
6803 * as key's value. */
6804 objPtr = Jim_NewDictObj(interp, NULL, 0);
6805 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
6808 Jim_InvalidateStringRep(objPtr);
6809 Jim_InvalidateStringRep(varObjPtr);
6810 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK) {
6811 goto err;
6813 Jim_SetResult(interp, varObjPtr);
6814 return JIM_OK;
6815 err:
6816 if (shared) {
6817 Jim_FreeNewObj(interp, varObjPtr);
6819 return JIM_ERR;
6822 /* -----------------------------------------------------------------------------
6823 * Index object
6824 * ---------------------------------------------------------------------------*/
6825 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
6826 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6828 static const Jim_ObjType indexObjType = {
6829 "index",
6830 NULL,
6831 NULL,
6832 UpdateStringOfIndex,
6833 JIM_TYPE_NONE,
6836 void UpdateStringOfIndex(struct Jim_Obj *objPtr)
6838 int len;
6839 char buf[JIM_INTEGER_SPACE + 1];
6841 if (objPtr->internalRep.intValue >= 0)
6842 len = sprintf(buf, "%d", objPtr->internalRep.intValue);
6843 else if (objPtr->internalRep.intValue == -1)
6844 len = sprintf(buf, "end");
6845 else {
6846 len = sprintf(buf, "end%d", objPtr->internalRep.intValue + 1);
6848 objPtr->bytes = Jim_Alloc(len + 1);
6849 memcpy(objPtr->bytes, buf, len + 1);
6850 objPtr->length = len;
6853 int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6855 int idx, end = 0;
6856 const char *str;
6857 char *endptr;
6859 /* Get the string representation */
6860 str = Jim_String(objPtr);
6862 /* Try to convert into an index */
6863 if (strncmp(str, "end", 3) == 0) {
6864 end = 1;
6865 str += 3;
6866 idx = 0;
6868 else {
6869 idx = strtol(str, &endptr, 0);
6871 if (endptr == str) {
6872 goto badindex;
6874 str = endptr;
6877 /* Now str may include or +<num> or -<num> */
6878 if (*str == '+' || *str == '-') {
6879 int sign = (*str == '+' ? 1 : -1);
6881 idx += sign * strtol(++str, &endptr, 0);
6882 if (str == endptr || *endptr) {
6883 goto badindex;
6885 str = endptr;
6887 /* The only thing left should be spaces */
6888 while (isspace(UCHAR(*str))) {
6889 str++;
6891 if (*str) {
6892 goto badindex;
6894 if (end) {
6895 if (idx > 0) {
6896 idx = INT_MAX;
6898 else {
6899 /* end-1 is repesented as -2 */
6900 idx--;
6903 else if (idx < 0) {
6904 idx = -INT_MAX;
6907 /* Free the old internal repr and set the new one. */
6908 Jim_FreeIntRep(interp, objPtr);
6909 objPtr->typePtr = &indexObjType;
6910 objPtr->internalRep.intValue = idx;
6911 return JIM_OK;
6913 badindex:
6914 Jim_SetResultFormatted(interp,
6915 "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr);
6916 return JIM_ERR;
6919 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
6921 /* Avoid shimmering if the object is an integer. */
6922 if (objPtr->typePtr == &intObjType) {
6923 jim_wide val = JimWideValue(objPtr);
6925 if (!(val < LONG_MIN) && !(val > LONG_MAX)) {
6926 *indexPtr = (val < 0) ? -INT_MAX : (long)val;;
6927 return JIM_OK;
6930 if (objPtr->typePtr != &indexObjType && SetIndexFromAny(interp, objPtr) == JIM_ERR)
6931 return JIM_ERR;
6932 *indexPtr = objPtr->internalRep.intValue;
6933 return JIM_OK;
6936 /* -----------------------------------------------------------------------------
6937 * Return Code Object.
6938 * ---------------------------------------------------------------------------*/
6940 /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
6941 static const char * const jimReturnCodes[] = {
6942 "ok",
6943 "error",
6944 "return",
6945 "break",
6946 "continue",
6947 "signal",
6948 "exit",
6949 "eval",
6950 NULL
6953 #define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes))
6955 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
6957 static const Jim_ObjType returnCodeObjType = {
6958 "return-code",
6959 NULL,
6960 NULL,
6961 NULL,
6962 JIM_TYPE_NONE,
6965 /* Converts a (standard) return code to a string. Returns "?" for
6966 * non-standard return codes.
6968 const char *Jim_ReturnCode(int code)
6970 if (code < 0 || code >= (int)jimReturnCodesSize) {
6971 return "?";
6973 else {
6974 return jimReturnCodes[code];
6978 int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6980 int returnCode;
6981 jim_wide wideValue;
6983 /* Try to convert into an integer */
6984 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
6985 returnCode = (int)wideValue;
6986 else if (Jim_GetEnum(interp, objPtr, jimReturnCodes, &returnCode, NULL, JIM_NONE) != JIM_OK) {
6987 Jim_SetResultFormatted(interp, "expected return code but got \"%#s\"", objPtr);
6988 return JIM_ERR;
6990 /* Free the old internal repr and set the new one. */
6991 Jim_FreeIntRep(interp, objPtr);
6992 objPtr->typePtr = &returnCodeObjType;
6993 objPtr->internalRep.intValue = returnCode;
6994 return JIM_OK;
6997 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
6999 if (objPtr->typePtr != &returnCodeObjType && SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
7000 return JIM_ERR;
7001 *intPtr = objPtr->internalRep.intValue;
7002 return JIM_OK;
7005 /* -----------------------------------------------------------------------------
7006 * Expression Parsing
7007 * ---------------------------------------------------------------------------*/
7008 static int JimParseExprOperator(struct JimParserCtx *pc);
7009 static int JimParseExprNumber(struct JimParserCtx *pc);
7010 static int JimParseExprIrrational(struct JimParserCtx *pc);
7012 /* Exrp's Stack machine operators opcodes. */
7014 /* Binary operators (numbers) */
7015 enum
7017 /* Continues on from the JIM_TT_ space */
7018 /* Operations */
7019 JIM_EXPROP_MUL = JIM_TT_EXPR_OP, /* 20 */
7020 JIM_EXPROP_DIV,
7021 JIM_EXPROP_MOD,
7022 JIM_EXPROP_SUB,
7023 JIM_EXPROP_ADD,
7024 JIM_EXPROP_LSHIFT,
7025 JIM_EXPROP_RSHIFT,
7026 JIM_EXPROP_ROTL,
7027 JIM_EXPROP_ROTR,
7028 JIM_EXPROP_LT,
7029 JIM_EXPROP_GT,
7030 JIM_EXPROP_LTE,
7031 JIM_EXPROP_GTE,
7032 JIM_EXPROP_NUMEQ,
7033 JIM_EXPROP_NUMNE,
7034 JIM_EXPROP_BITAND, /* 35 */
7035 JIM_EXPROP_BITXOR,
7036 JIM_EXPROP_BITOR,
7038 /* Note must keep these together */
7039 JIM_EXPROP_LOGICAND, /* 38 */
7040 JIM_EXPROP_LOGICAND_LEFT,
7041 JIM_EXPROP_LOGICAND_RIGHT,
7043 /* and these */
7044 JIM_EXPROP_LOGICOR, /* 41 */
7045 JIM_EXPROP_LOGICOR_LEFT,
7046 JIM_EXPROP_LOGICOR_RIGHT,
7048 /* and these */
7049 /* Ternary operators */
7050 JIM_EXPROP_TERNARY, /* 44 */
7051 JIM_EXPROP_TERNARY_LEFT,
7052 JIM_EXPROP_TERNARY_RIGHT,
7054 /* and these */
7055 JIM_EXPROP_COLON, /* 47 */
7056 JIM_EXPROP_COLON_LEFT,
7057 JIM_EXPROP_COLON_RIGHT,
7059 JIM_EXPROP_POW, /* 50 */
7061 /* Binary operators (strings) */
7062 JIM_EXPROP_STREQ, /* 51 */
7063 JIM_EXPROP_STRNE,
7064 JIM_EXPROP_STRIN,
7065 JIM_EXPROP_STRNI,
7067 /* Unary operators (numbers) */
7068 JIM_EXPROP_NOT, /* 55 */
7069 JIM_EXPROP_BITNOT,
7070 JIM_EXPROP_UNARYMINUS,
7071 JIM_EXPROP_UNARYPLUS,
7073 /* Functions */
7074 JIM_EXPROP_FUNC_FIRST, /* 59 */
7075 JIM_EXPROP_FUNC_INT = JIM_EXPROP_FUNC_FIRST,
7076 JIM_EXPROP_FUNC_ABS,
7077 JIM_EXPROP_FUNC_DOUBLE,
7078 JIM_EXPROP_FUNC_ROUND,
7079 JIM_EXPROP_FUNC_RAND,
7080 JIM_EXPROP_FUNC_SRAND,
7082 /* math functions from libm */
7083 JIM_EXPROP_FUNC_SIN, /* 64 */
7084 JIM_EXPROP_FUNC_COS,
7085 JIM_EXPROP_FUNC_TAN,
7086 JIM_EXPROP_FUNC_ASIN,
7087 JIM_EXPROP_FUNC_ACOS,
7088 JIM_EXPROP_FUNC_ATAN,
7089 JIM_EXPROP_FUNC_SINH,
7090 JIM_EXPROP_FUNC_COSH,
7091 JIM_EXPROP_FUNC_TANH,
7092 JIM_EXPROP_FUNC_CEIL,
7093 JIM_EXPROP_FUNC_FLOOR,
7094 JIM_EXPROP_FUNC_EXP,
7095 JIM_EXPROP_FUNC_LOG,
7096 JIM_EXPROP_FUNC_LOG10,
7097 JIM_EXPROP_FUNC_SQRT,
7098 JIM_EXPROP_FUNC_POW,
7101 struct JimExprState
7103 Jim_Obj **stack;
7104 int stacklen;
7105 int opcode;
7106 int skip;
7109 /* Operators table */
7110 typedef struct Jim_ExprOperator
7112 const char *name;
7113 int precedence;
7114 int arity;
7115 int (*funcop) (Jim_Interp *interp, struct JimExprState * e);
7116 int lazy;
7117 } Jim_ExprOperator;
7119 static void ExprPush(struct JimExprState *e, Jim_Obj *obj)
7121 Jim_IncrRefCount(obj);
7122 e->stack[e->stacklen++] = obj;
7125 static Jim_Obj *ExprPop(struct JimExprState *e)
7127 return e->stack[--e->stacklen];
7130 static int JimExprOpNumUnary(Jim_Interp *interp, struct JimExprState *e)
7132 int intresult = 0;
7133 int rc = JIM_OK;
7134 Jim_Obj *A = ExprPop(e);
7135 double dA, dC = 0;
7136 jim_wide wA, wC = 0;
7138 if ((A->typePtr != &doubleObjType || A->bytes) && JimGetWideNoErr(interp, A, &wA) == JIM_OK) {
7139 intresult = 1;
7141 switch (e->opcode) {
7142 case JIM_EXPROP_FUNC_INT:
7143 wC = wA;
7144 break;
7145 case JIM_EXPROP_FUNC_ROUND:
7146 wC = wA;
7147 break;
7148 case JIM_EXPROP_FUNC_DOUBLE:
7149 dC = wA;
7150 intresult = 0;
7151 break;
7152 case JIM_EXPROP_FUNC_ABS:
7153 wC = wA >= 0 ? wA : -wA;
7154 break;
7155 case JIM_EXPROP_UNARYMINUS:
7156 wC = -wA;
7157 break;
7158 case JIM_EXPROP_UNARYPLUS:
7159 wC = wA;
7160 break;
7161 case JIM_EXPROP_NOT:
7162 wC = !wA;
7163 break;
7164 default:
7165 abort();
7168 else if ((rc = Jim_GetDouble(interp, A, &dA)) == JIM_OK) {
7169 switch (e->opcode) {
7170 case JIM_EXPROP_FUNC_INT:
7171 wC = dA;
7172 intresult = 1;
7173 break;
7174 case JIM_EXPROP_FUNC_ROUND:
7175 wC = dA < 0 ? (dA - 0.5) : (dA + 0.5);
7176 intresult = 1;
7177 break;
7178 case JIM_EXPROP_FUNC_DOUBLE:
7179 dC = dA;
7180 break;
7181 case JIM_EXPROP_FUNC_ABS:
7182 dC = dA >= 0 ? dA : -dA;
7183 break;
7184 case JIM_EXPROP_UNARYMINUS:
7185 dC = -dA;
7186 break;
7187 case JIM_EXPROP_UNARYPLUS:
7188 dC = dA;
7189 break;
7190 case JIM_EXPROP_NOT:
7191 wC = !dA;
7192 intresult = 1;
7193 break;
7194 default:
7195 abort();
7199 if (rc == JIM_OK) {
7200 if (intresult) {
7201 ExprPush(e, Jim_NewIntObj(interp, wC));
7203 else {
7204 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7208 Jim_DecrRefCount(interp, A);
7210 return rc;
7213 static double JimRandDouble(Jim_Interp *interp)
7215 unsigned long x;
7216 JimRandomBytes(interp, &x, sizeof(x));
7218 return (double)x / (unsigned long)~0;
7221 static int JimExprOpIntUnary(Jim_Interp *interp, struct JimExprState *e)
7223 Jim_Obj *A = ExprPop(e);
7224 jim_wide wA;
7226 int rc = Jim_GetWide(interp, A, &wA);
7227 if (rc == JIM_OK) {
7228 switch (e->opcode) {
7229 case JIM_EXPROP_BITNOT:
7230 ExprPush(e, Jim_NewIntObj(interp, ~wA));
7231 break;
7232 case JIM_EXPROP_FUNC_SRAND:
7233 JimPrngSeed(interp, (unsigned char *)&wA, sizeof(wA));
7234 ExprPush(e, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7235 break;
7236 default:
7237 abort();
7241 Jim_DecrRefCount(interp, A);
7243 return rc;
7246 static int JimExprOpNone(Jim_Interp *interp, struct JimExprState *e)
7248 JimPanic((e->opcode != JIM_EXPROP_FUNC_RAND, "JimExprOpNone only support rand()"));
7250 ExprPush(e, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7252 return JIM_OK;
7255 #ifdef JIM_MATH_FUNCTIONS
7256 static int JimExprOpDoubleUnary(Jim_Interp *interp, struct JimExprState *e)
7258 int rc;
7259 Jim_Obj *A = ExprPop(e);
7260 double dA, dC;
7262 rc = Jim_GetDouble(interp, A, &dA);
7263 if (rc == JIM_OK) {
7264 switch (e->opcode) {
7265 case JIM_EXPROP_FUNC_SIN:
7266 dC = sin(dA);
7267 break;
7268 case JIM_EXPROP_FUNC_COS:
7269 dC = cos(dA);
7270 break;
7271 case JIM_EXPROP_FUNC_TAN:
7272 dC = tan(dA);
7273 break;
7274 case JIM_EXPROP_FUNC_ASIN:
7275 dC = asin(dA);
7276 break;
7277 case JIM_EXPROP_FUNC_ACOS:
7278 dC = acos(dA);
7279 break;
7280 case JIM_EXPROP_FUNC_ATAN:
7281 dC = atan(dA);
7282 break;
7283 case JIM_EXPROP_FUNC_SINH:
7284 dC = sinh(dA);
7285 break;
7286 case JIM_EXPROP_FUNC_COSH:
7287 dC = cosh(dA);
7288 break;
7289 case JIM_EXPROP_FUNC_TANH:
7290 dC = tanh(dA);
7291 break;
7292 case JIM_EXPROP_FUNC_CEIL:
7293 dC = ceil(dA);
7294 break;
7295 case JIM_EXPROP_FUNC_FLOOR:
7296 dC = floor(dA);
7297 break;
7298 case JIM_EXPROP_FUNC_EXP:
7299 dC = exp(dA);
7300 break;
7301 case JIM_EXPROP_FUNC_LOG:
7302 dC = log(dA);
7303 break;
7304 case JIM_EXPROP_FUNC_LOG10:
7305 dC = log10(dA);
7306 break;
7307 case JIM_EXPROP_FUNC_SQRT:
7308 dC = sqrt(dA);
7309 break;
7310 default:
7311 abort();
7313 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7316 Jim_DecrRefCount(interp, A);
7318 return rc;
7320 #endif
7322 /* A binary operation on two ints */
7323 static int JimExprOpIntBin(Jim_Interp *interp, struct JimExprState *e)
7325 Jim_Obj *B = ExprPop(e);
7326 Jim_Obj *A = ExprPop(e);
7327 jim_wide wA, wB;
7328 int rc = JIM_ERR;
7330 if (Jim_GetWide(interp, A, &wA) == JIM_OK && Jim_GetWide(interp, B, &wB) == JIM_OK) {
7331 jim_wide wC;
7333 rc = JIM_OK;
7335 switch (e->opcode) {
7336 case JIM_EXPROP_LSHIFT:
7337 wC = wA << wB;
7338 break;
7339 case JIM_EXPROP_RSHIFT:
7340 wC = wA >> wB;
7341 break;
7342 case JIM_EXPROP_BITAND:
7343 wC = wA & wB;
7344 break;
7345 case JIM_EXPROP_BITXOR:
7346 wC = wA ^ wB;
7347 break;
7348 case JIM_EXPROP_BITOR:
7349 wC = wA | wB;
7350 break;
7351 case JIM_EXPROP_MOD:
7352 if (wB == 0) {
7353 wC = 0;
7354 Jim_SetResultString(interp, "Division by zero", -1);
7355 rc = JIM_ERR;
7357 else {
7359 * From Tcl 8.x
7361 * This code is tricky: C doesn't guarantee much
7362 * about the quotient or remainder, but Tcl does.
7363 * The remainder always has the same sign as the
7364 * divisor and a smaller absolute value.
7366 int negative = 0;
7368 if (wB < 0) {
7369 wB = -wB;
7370 wA = -wA;
7371 negative = 1;
7373 wC = wA % wB;
7374 if (wC < 0) {
7375 wC += wB;
7377 if (negative) {
7378 wC = -wC;
7381 break;
7382 case JIM_EXPROP_ROTL:
7383 case JIM_EXPROP_ROTR:{
7384 /* uint32_t would be better. But not everyone has inttypes.h? */
7385 unsigned long uA = (unsigned long)wA;
7386 unsigned long uB = (unsigned long)wB;
7387 const unsigned int S = sizeof(unsigned long) * 8;
7389 /* Shift left by the word size or more is undefined. */
7390 uB %= S;
7392 if (e->opcode == JIM_EXPROP_ROTR) {
7393 uB = S - uB;
7395 wC = (unsigned long)(uA << uB) | (uA >> (S - uB));
7396 break;
7398 default:
7399 abort();
7401 ExprPush(e, Jim_NewIntObj(interp, wC));
7405 Jim_DecrRefCount(interp, A);
7406 Jim_DecrRefCount(interp, B);
7408 return rc;
7412 /* A binary operation on two ints or two doubles (or two strings for some ops) */
7413 static int JimExprOpBin(Jim_Interp *interp, struct JimExprState *e)
7415 int intresult = 0;
7416 int rc = JIM_OK;
7417 double dA, dB, dC = 0;
7418 jim_wide wA, wB, wC = 0;
7420 Jim_Obj *B = ExprPop(e);
7421 Jim_Obj *A = ExprPop(e);
7423 if ((A->typePtr != &doubleObjType || A->bytes) &&
7424 (B->typePtr != &doubleObjType || B->bytes) &&
7425 JimGetWideNoErr(interp, A, &wA) == JIM_OK && JimGetWideNoErr(interp, B, &wB) == JIM_OK) {
7427 /* Both are ints */
7429 intresult = 1;
7431 switch (e->opcode) {
7432 case JIM_EXPROP_POW:
7433 case JIM_EXPROP_FUNC_POW:
7434 wC = JimPowWide(wA, wB);
7435 break;
7436 case JIM_EXPROP_ADD:
7437 wC = wA + wB;
7438 break;
7439 case JIM_EXPROP_SUB:
7440 wC = wA - wB;
7441 break;
7442 case JIM_EXPROP_MUL:
7443 wC = wA * wB;
7444 break;
7445 case JIM_EXPROP_DIV:
7446 if (wB == 0) {
7447 Jim_SetResultString(interp, "Division by zero", -1);
7448 rc = JIM_ERR;
7450 else {
7452 * From Tcl 8.x
7454 * This code is tricky: C doesn't guarantee much
7455 * about the quotient or remainder, but Tcl does.
7456 * The remainder always has the same sign as the
7457 * divisor and a smaller absolute value.
7459 if (wB < 0) {
7460 wB = -wB;
7461 wA = -wA;
7463 wC = wA / wB;
7464 if (wA % wB < 0) {
7465 wC--;
7468 break;
7469 case JIM_EXPROP_LT:
7470 wC = wA < wB;
7471 break;
7472 case JIM_EXPROP_GT:
7473 wC = wA > wB;
7474 break;
7475 case JIM_EXPROP_LTE:
7476 wC = wA <= wB;
7477 break;
7478 case JIM_EXPROP_GTE:
7479 wC = wA >= wB;
7480 break;
7481 case JIM_EXPROP_NUMEQ:
7482 wC = wA == wB;
7483 break;
7484 case JIM_EXPROP_NUMNE:
7485 wC = wA != wB;
7486 break;
7487 default:
7488 abort();
7491 else if (Jim_GetDouble(interp, A, &dA) == JIM_OK && Jim_GetDouble(interp, B, &dB) == JIM_OK) {
7492 switch (e->opcode) {
7493 case JIM_EXPROP_POW:
7494 case JIM_EXPROP_FUNC_POW:
7495 #ifdef JIM_MATH_FUNCTIONS
7496 dC = pow(dA, dB);
7497 #else
7498 Jim_SetResultString(interp, "unsupported", -1);
7499 rc = JIM_ERR;
7500 #endif
7501 break;
7502 case JIM_EXPROP_ADD:
7503 dC = dA + dB;
7504 break;
7505 case JIM_EXPROP_SUB:
7506 dC = dA - dB;
7507 break;
7508 case JIM_EXPROP_MUL:
7509 dC = dA * dB;
7510 break;
7511 case JIM_EXPROP_DIV:
7512 if (dB == 0) {
7513 #ifdef INFINITY
7514 dC = dA < 0 ? -INFINITY : INFINITY;
7515 #else
7516 dC = (dA < 0 ? -1.0 : 1.0) * strtod("Inf", NULL);
7517 #endif
7519 else {
7520 dC = dA / dB;
7522 break;
7523 case JIM_EXPROP_LT:
7524 wC = dA < dB;
7525 intresult = 1;
7526 break;
7527 case JIM_EXPROP_GT:
7528 wC = dA > dB;
7529 intresult = 1;
7530 break;
7531 case JIM_EXPROP_LTE:
7532 wC = dA <= dB;
7533 intresult = 1;
7534 break;
7535 case JIM_EXPROP_GTE:
7536 wC = dA >= dB;
7537 intresult = 1;
7538 break;
7539 case JIM_EXPROP_NUMEQ:
7540 wC = dA == dB;
7541 intresult = 1;
7542 break;
7543 case JIM_EXPROP_NUMNE:
7544 wC = dA != dB;
7545 intresult = 1;
7546 break;
7547 default:
7548 abort();
7551 else {
7552 /* Handle the string case */
7554 /* REVISIT: Could optimise the eq/ne case by checking lengths */
7555 int i = Jim_StringCompareObj(interp, A, B, 0);
7557 intresult = 1;
7559 switch (e->opcode) {
7560 case JIM_EXPROP_LT:
7561 wC = i < 0;
7562 break;
7563 case JIM_EXPROP_GT:
7564 wC = i > 0;
7565 break;
7566 case JIM_EXPROP_LTE:
7567 wC = i <= 0;
7568 break;
7569 case JIM_EXPROP_GTE:
7570 wC = i >= 0;
7571 break;
7572 case JIM_EXPROP_NUMEQ:
7573 wC = i == 0;
7574 break;
7575 case JIM_EXPROP_NUMNE:
7576 wC = i != 0;
7577 break;
7578 default:
7579 rc = JIM_ERR;
7580 break;
7584 if (rc == JIM_OK) {
7585 if (intresult) {
7586 ExprPush(e, Jim_NewIntObj(interp, wC));
7588 else {
7589 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7593 Jim_DecrRefCount(interp, A);
7594 Jim_DecrRefCount(interp, B);
7596 return rc;
7599 static int JimSearchList(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *valObj)
7601 int listlen;
7602 int i;
7604 listlen = Jim_ListLength(interp, listObjPtr);
7605 for (i = 0; i < listlen; i++) {
7606 Jim_Obj *objPtr;
7608 Jim_ListIndex(interp, listObjPtr, i, &objPtr, JIM_NONE);
7610 if (Jim_StringEqObj(objPtr, valObj)) {
7611 return 1;
7614 return 0;
7617 static int JimExprOpStrBin(Jim_Interp *interp, struct JimExprState *e)
7619 Jim_Obj *B = ExprPop(e);
7620 Jim_Obj *A = ExprPop(e);
7622 jim_wide wC;
7624 switch (e->opcode) {
7625 case JIM_EXPROP_STREQ:
7626 case JIM_EXPROP_STRNE: {
7627 int Alen, Blen;
7628 const char *sA = Jim_GetString(A, &Alen);
7629 const char *sB = Jim_GetString(B, &Blen);
7631 if (e->opcode == JIM_EXPROP_STREQ) {
7632 wC = (Alen == Blen && memcmp(sA, sB, Alen) == 0);
7634 else {
7635 wC = (Alen != Blen || memcmp(sA, sB, Alen) != 0);
7637 break;
7639 case JIM_EXPROP_STRIN:
7640 wC = JimSearchList(interp, B, A);
7641 break;
7642 case JIM_EXPROP_STRNI:
7643 wC = !JimSearchList(interp, B, A);
7644 break;
7645 default:
7646 abort();
7648 ExprPush(e, Jim_NewIntObj(interp, wC));
7650 Jim_DecrRefCount(interp, A);
7651 Jim_DecrRefCount(interp, B);
7653 return JIM_OK;
7656 static int ExprBool(Jim_Interp *interp, Jim_Obj *obj)
7658 long l;
7659 double d;
7661 if (Jim_GetLong(interp, obj, &l) == JIM_OK) {
7662 return l != 0;
7664 if (Jim_GetDouble(interp, obj, &d) == JIM_OK) {
7665 return d != 0;
7667 return -1;
7670 static int JimExprOpAndLeft(Jim_Interp *interp, struct JimExprState *e)
7672 Jim_Obj *skip = ExprPop(e);
7673 Jim_Obj *A = ExprPop(e);
7674 int rc = JIM_OK;
7676 switch (ExprBool(interp, A)) {
7677 case 0:
7678 /* false, so skip RHS opcodes with a 0 result */
7679 e->skip = JimWideValue(skip);
7680 ExprPush(e, Jim_NewIntObj(interp, 0));
7681 break;
7683 case 1:
7684 /* true so continue */
7685 break;
7687 case -1:
7688 /* Invalid */
7689 rc = JIM_ERR;
7691 Jim_DecrRefCount(interp, A);
7692 Jim_DecrRefCount(interp, skip);
7694 return rc;
7697 static int JimExprOpOrLeft(Jim_Interp *interp, struct JimExprState *e)
7699 Jim_Obj *skip = ExprPop(e);
7700 Jim_Obj *A = ExprPop(e);
7701 int rc = JIM_OK;
7703 switch (ExprBool(interp, A)) {
7704 case 0:
7705 /* false, so do nothing */
7706 break;
7708 case 1:
7709 /* true so skip RHS opcodes with a 1 result */
7710 e->skip = JimWideValue(skip);
7711 ExprPush(e, Jim_NewIntObj(interp, 1));
7712 break;
7714 case -1:
7715 /* Invalid */
7716 rc = JIM_ERR;
7717 break;
7719 Jim_DecrRefCount(interp, A);
7720 Jim_DecrRefCount(interp, skip);
7722 return rc;
7725 static int JimExprOpAndOrRight(Jim_Interp *interp, struct JimExprState *e)
7727 Jim_Obj *A = ExprPop(e);
7728 int rc = JIM_OK;
7730 switch (ExprBool(interp, A)) {
7731 case 0:
7732 ExprPush(e, Jim_NewIntObj(interp, 0));
7733 break;
7735 case 1:
7736 ExprPush(e, Jim_NewIntObj(interp, 1));
7737 break;
7739 case -1:
7740 /* Invalid */
7741 rc = JIM_ERR;
7742 break;
7744 Jim_DecrRefCount(interp, A);
7746 return rc;
7749 static int JimExprOpTernaryLeft(Jim_Interp *interp, struct JimExprState *e)
7751 Jim_Obj *skip = ExprPop(e);
7752 Jim_Obj *A = ExprPop(e);
7753 int rc = JIM_OK;
7755 /* Repush A */
7756 ExprPush(e, A);
7758 switch (ExprBool(interp, A)) {
7759 case 0:
7760 /* false, skip RHS opcodes */
7761 e->skip = JimWideValue(skip);
7762 /* Push a dummy value */
7763 ExprPush(e, Jim_NewIntObj(interp, 0));
7764 break;
7766 case 1:
7767 /* true so do nothing */
7768 break;
7770 case -1:
7771 /* Invalid */
7772 rc = JIM_ERR;
7773 break;
7775 Jim_DecrRefCount(interp, A);
7776 Jim_DecrRefCount(interp, skip);
7778 return rc;
7781 static int JimExprOpColonLeft(Jim_Interp *interp, struct JimExprState *e)
7783 Jim_Obj *skip = ExprPop(e);
7784 Jim_Obj *B = ExprPop(e);
7785 Jim_Obj *A = ExprPop(e);
7787 /* No need to check for A as non-boolean */
7788 if (ExprBool(interp, A)) {
7789 /* true, so skip RHS opcodes */
7790 e->skip = JimWideValue(skip);
7791 /* Repush B as the answer */
7792 ExprPush(e, B);
7795 Jim_DecrRefCount(interp, skip);
7796 Jim_DecrRefCount(interp, A);
7797 Jim_DecrRefCount(interp, B);
7798 return JIM_OK;
7801 static int JimExprOpNull(Jim_Interp *interp, struct JimExprState *e)
7803 return JIM_OK;
7806 enum
7808 LAZY_NONE,
7809 LAZY_OP,
7810 LAZY_LEFT,
7811 LAZY_RIGHT
7814 /* name - precedence - arity - opcode
7816 * This array *must* be kept in sync with the JIM_EXPROP enum
7818 static const struct Jim_ExprOperator Jim_ExprOperators[] = {
7819 {"*", 200, 2, JimExprOpBin, LAZY_NONE},
7820 {"/", 200, 2, JimExprOpBin, LAZY_NONE},
7821 {"%", 200, 2, JimExprOpIntBin, LAZY_NONE},
7823 {"-", 100, 2, JimExprOpBin, LAZY_NONE},
7824 {"+", 100, 2, JimExprOpBin, LAZY_NONE},
7826 {"<<", 90, 2, JimExprOpIntBin, LAZY_NONE},
7827 {">>", 90, 2, JimExprOpIntBin, LAZY_NONE},
7829 {"<<<", 90, 2, JimExprOpIntBin, LAZY_NONE},
7830 {">>>", 90, 2, JimExprOpIntBin, LAZY_NONE},
7832 {"<", 80, 2, JimExprOpBin, LAZY_NONE},
7833 {">", 80, 2, JimExprOpBin, LAZY_NONE},
7834 {"<=", 80, 2, JimExprOpBin, LAZY_NONE},
7835 {">=", 80, 2, JimExprOpBin, LAZY_NONE},
7837 {"==", 70, 2, JimExprOpBin, LAZY_NONE},
7838 {"!=", 70, 2, JimExprOpBin, LAZY_NONE},
7840 {"&", 50, 2, JimExprOpIntBin, LAZY_NONE},
7841 {"^", 49, 2, JimExprOpIntBin, LAZY_NONE},
7842 {"|", 48, 2, JimExprOpIntBin, LAZY_NONE},
7844 {"&&", 10, 2, NULL, LAZY_OP},
7845 {NULL, 10, 2, JimExprOpAndLeft, LAZY_LEFT},
7846 {NULL, 10, 2, JimExprOpAndOrRight, LAZY_RIGHT},
7848 {"||", 9, 2, NULL, LAZY_OP},
7849 {NULL, 9, 2, JimExprOpOrLeft, LAZY_LEFT},
7850 {NULL, 9, 2, JimExprOpAndOrRight, LAZY_RIGHT},
7852 {"?", 5, 2, JimExprOpNull, LAZY_OP},
7853 {NULL, 5, 2, JimExprOpTernaryLeft, LAZY_LEFT},
7854 {NULL, 5, 2, JimExprOpNull, LAZY_RIGHT},
7856 {":", 5, 2, JimExprOpNull, LAZY_OP},
7857 {NULL, 5, 2, JimExprOpColonLeft, LAZY_LEFT},
7858 {NULL, 5, 2, JimExprOpNull, LAZY_RIGHT},
7860 {"**", 250, 2, JimExprOpBin, LAZY_NONE},
7862 {"eq", 60, 2, JimExprOpStrBin, LAZY_NONE},
7863 {"ne", 60, 2, JimExprOpStrBin, LAZY_NONE},
7865 {"in", 55, 2, JimExprOpStrBin, LAZY_NONE},
7866 {"ni", 55, 2, JimExprOpStrBin, LAZY_NONE},
7868 {"!", 300, 1, JimExprOpNumUnary, LAZY_NONE},
7869 {"~", 300, 1, JimExprOpIntUnary, LAZY_NONE},
7870 {NULL, 300, 1, JimExprOpNumUnary, LAZY_NONE},
7871 {NULL, 300, 1, JimExprOpNumUnary, LAZY_NONE},
7875 {"int", 400, 1, JimExprOpNumUnary, LAZY_NONE},
7876 {"abs", 400, 1, JimExprOpNumUnary, LAZY_NONE},
7877 {"double", 400, 1, JimExprOpNumUnary, LAZY_NONE},
7878 {"round", 400, 1, JimExprOpNumUnary, LAZY_NONE},
7879 {"rand", 400, 0, JimExprOpNone, LAZY_NONE},
7880 {"srand", 400, 1, JimExprOpIntUnary, LAZY_NONE},
7882 #ifdef JIM_MATH_FUNCTIONS
7883 {"sin", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7884 {"cos", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7885 {"tan", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7886 {"asin", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7887 {"acos", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7888 {"atan", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7889 {"sinh", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7890 {"cosh", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7891 {"tanh", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7892 {"ceil", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7893 {"floor", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7894 {"exp", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7895 {"log", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7896 {"log10", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7897 {"sqrt", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7898 {"pow", 400, 2, JimExprOpBin, LAZY_NONE},
7899 #endif
7902 #define JIM_EXPR_OPERATORS_NUM \
7903 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
7905 static int JimParseExpression(struct JimParserCtx *pc)
7907 /* Discard spaces and quoted newline */
7908 while (isspace(UCHAR(*pc->p)) || (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) {
7909 if (*pc->p == '\n') {
7910 pc->linenr++;
7912 pc->p++;
7913 pc->len--;
7916 if (pc->len == 0) {
7917 pc->tstart = pc->tend = pc->p;
7918 pc->tline = pc->linenr;
7919 pc->tt = JIM_TT_EOL;
7920 pc->eof = 1;
7921 return JIM_OK;
7923 switch (*(pc->p)) {
7924 case '(':
7925 pc->tt = JIM_TT_SUBEXPR_START;
7926 goto singlechar;
7927 case ')':
7928 pc->tt = JIM_TT_SUBEXPR_END;
7929 goto singlechar;
7930 case ',':
7931 pc->tt = JIM_TT_SUBEXPR_COMMA;
7932 singlechar:
7933 pc->tstart = pc->tend = pc->p;
7934 pc->tline = pc->linenr;
7935 pc->p++;
7936 pc->len--;
7937 break;
7938 case '[':
7939 return JimParseCmd(pc);
7940 case '$':
7941 if (JimParseVar(pc) == JIM_ERR)
7942 return JimParseExprOperator(pc);
7943 else {
7944 /* Don't allow expr sugar in expressions */
7945 if (pc->tt == JIM_TT_EXPRSUGAR) {
7946 return JIM_ERR;
7948 return JIM_OK;
7950 break;
7951 case '0':
7952 case '1':
7953 case '2':
7954 case '3':
7955 case '4':
7956 case '5':
7957 case '6':
7958 case '7':
7959 case '8':
7960 case '9':
7961 case '.':
7962 return JimParseExprNumber(pc);
7963 case '"':
7964 return JimParseQuote(pc);
7965 case '{':
7966 return JimParseBrace(pc);
7968 case 'N':
7969 case 'I':
7970 case 'n':
7971 case 'i':
7972 if (JimParseExprIrrational(pc) == JIM_ERR)
7973 return JimParseExprOperator(pc);
7974 break;
7975 default:
7976 return JimParseExprOperator(pc);
7977 break;
7979 return JIM_OK;
7982 static int JimParseExprNumber(struct JimParserCtx *pc)
7984 int allowdot = 1;
7985 int allowhex = 0;
7987 /* Assume an integer for now */
7988 pc->tt = JIM_TT_EXPR_INT;
7989 pc->tstart = pc->p;
7990 pc->tline = pc->linenr;
7991 while (isdigit(UCHAR(*pc->p))
7992 || (allowhex && isxdigit(UCHAR(*pc->p)))
7993 || (allowdot && *pc->p == '.')
7994 || (pc->p - pc->tstart == 1 && *pc->tstart == '0' && (*pc->p == 'x' || *pc->p == 'X'))
7996 if ((*pc->p == 'x') || (*pc->p == 'X')) {
7997 allowhex = 1;
7998 allowdot = 0;
8000 if (*pc->p == '.') {
8001 allowdot = 0;
8002 pc->tt = JIM_TT_EXPR_DOUBLE;
8004 pc->p++;
8005 pc->len--;
8006 if (!allowhex && (*pc->p == 'e' || *pc->p == 'E') && (pc->p[1] == '-' || pc->p[1] == '+'
8007 || isdigit(UCHAR(pc->p[1])))) {
8008 pc->p += 2;
8009 pc->len -= 2;
8010 pc->tt = JIM_TT_EXPR_DOUBLE;
8013 pc->tend = pc->p - 1;
8014 return JIM_OK;
8017 static int JimParseExprIrrational(struct JimParserCtx *pc)
8019 const char *Tokens[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL };
8020 const char **token;
8022 for (token = Tokens; *token != NULL; token++) {
8023 int len = strlen(*token);
8025 if (strncmp(*token, pc->p, len) == 0) {
8026 pc->tstart = pc->p;
8027 pc->tend = pc->p + len - 1;
8028 pc->p += len;
8029 pc->len -= len;
8030 pc->tline = pc->linenr;
8031 pc->tt = JIM_TT_EXPR_DOUBLE;
8032 return JIM_OK;
8035 return JIM_ERR;
8038 static int JimParseExprOperator(struct JimParserCtx *pc)
8040 int i;
8041 int bestIdx = -1, bestLen = 0;
8043 /* Try to get the longest match. */
8044 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
8045 const char *opname;
8046 int oplen;
8048 opname = Jim_ExprOperators[i].name;
8049 if (opname == NULL) {
8050 continue;
8052 oplen = strlen(opname);
8054 if (strncmp(opname, pc->p, oplen) == 0 && oplen > bestLen) {
8055 bestIdx = i + JIM_TT_EXPR_OP;
8056 bestLen = oplen;
8059 if (bestIdx == -1) {
8060 return JIM_ERR;
8063 /* Validate paretheses around function arguments */
8064 if (bestIdx >= JIM_EXPROP_FUNC_FIRST) {
8065 const char *p = pc->p + bestLen;
8066 int len = pc->len - bestLen;
8068 while (len && isspace(UCHAR(*p))) {
8069 len--;
8070 p++;
8072 if (*p != '(') {
8073 return JIM_ERR;
8076 pc->tstart = pc->p;
8077 pc->tend = pc->p + bestLen - 1;
8078 pc->p += bestLen;
8079 pc->len -= bestLen;
8080 pc->tline = pc->linenr;
8082 pc->tt = bestIdx;
8083 return JIM_OK;
8086 static const struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
8088 static Jim_ExprOperator dummy_op;
8089 if (opcode < JIM_TT_EXPR_OP) {
8090 return &dummy_op;
8092 return &Jim_ExprOperators[opcode - JIM_TT_EXPR_OP];
8095 const char *jim_tt_name(int type)
8097 static const char * const tt_names[JIM_TT_EXPR_OP] =
8098 { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "LIN", "WRD", "(((", ")))", ",,,", "INT",
8099 "DBL", "$()" };
8100 if (type < JIM_TT_EXPR_OP) {
8101 return tt_names[type];
8103 else {
8104 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(type);
8105 static char buf[20];
8107 if (op->name) {
8108 return op->name;
8110 sprintf(buf, "(%d)", type);
8111 return buf;
8115 /* -----------------------------------------------------------------------------
8116 * Expression Object
8117 * ---------------------------------------------------------------------------*/
8118 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
8119 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
8120 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
8122 static const Jim_ObjType exprObjType = {
8123 "expression",
8124 FreeExprInternalRep,
8125 DupExprInternalRep,
8126 NULL,
8127 JIM_TYPE_REFERENCES,
8130 /* Expr bytecode structure */
8131 typedef struct ExprByteCode
8133 int len; /* Length as number of tokens. */
8134 ScriptToken *token; /* Tokens array. */
8135 int inUse; /* Used for sharing. */
8136 } ExprByteCode;
8138 static void ExprFreeByteCode(Jim_Interp *interp, ExprByteCode * expr)
8140 int i;
8142 for (i = 0; i < expr->len; i++) {
8143 Jim_DecrRefCount(interp, expr->token[i].objPtr);
8145 Jim_Free(expr->token);
8146 Jim_Free(expr);
8149 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
8151 ExprByteCode *expr = (void *)objPtr->internalRep.ptr;
8153 if (expr) {
8154 if (--expr->inUse != 0) {
8155 return;
8158 ExprFreeByteCode(interp, expr);
8162 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
8164 JIM_NOTUSED(interp);
8165 JIM_NOTUSED(srcPtr);
8167 /* Just returns an simple string. */
8168 dupPtr->typePtr = NULL;
8171 /* Check if an expr program looks correct. */
8172 static int ExprCheckCorrectness(ExprByteCode * expr)
8174 int i;
8175 int stacklen = 0;
8176 int ternary = 0;
8178 /* Try to check if there are stack underflows,
8179 * and make sure at the end of the program there is
8180 * a single result on the stack. */
8181 for (i = 0; i < expr->len; i++) {
8182 ScriptToken *t = &expr->token[i];
8183 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8185 stacklen -= op->arity;
8186 if (stacklen < 0) {
8187 break;
8189 if (t->type == JIM_EXPROP_TERNARY || t->type == JIM_EXPROP_TERNARY_LEFT) {
8190 ternary++;
8192 else if (t->type == JIM_EXPROP_COLON || t->type == JIM_EXPROP_COLON_LEFT) {
8193 ternary--;
8196 /* All operations and operands add one to the stack */
8197 stacklen++;
8199 if (stacklen != 1 || ternary != 0) {
8200 return JIM_ERR;
8202 return JIM_OK;
8205 /* This procedure converts every occurrence of || and && opereators
8206 * in lazy unary versions.
8208 * a b || is converted into:
8210 * a <offset> |L b |R
8212 * a b && is converted into:
8214 * a <offset> &L b &R
8216 * "|L" checks if 'a' is true:
8217 * 1) if it is true pushes 1 and skips <offset> instructions to reach
8218 * the opcode just after |R.
8219 * 2) if it is false does nothing.
8220 * "|R" checks if 'b' is true:
8221 * 1) if it is true pushes 1, otherwise pushes 0.
8223 * "&L" checks if 'a' is true:
8224 * 1) if it is true does nothing.
8225 * 2) If it is false pushes 0 and skips <offset> instructions to reach
8226 * the opcode just after &R
8227 * "&R" checks if 'a' is true:
8228 * if it is true pushes 1, otherwise pushes 0.
8230 static int ExprAddLazyOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
8232 int i;
8234 int leftindex, arity, offset;
8236 /* Search for the end of the first operator */
8237 leftindex = expr->len - 1;
8239 arity = 1;
8240 while (arity) {
8241 ScriptToken *tt = &expr->token[leftindex];
8243 if (tt->type >= JIM_TT_EXPR_OP) {
8244 arity += JimExprOperatorInfoByOpcode(tt->type)->arity;
8246 arity--;
8247 if (--leftindex < 0) {
8248 return JIM_ERR;
8251 leftindex++;
8253 /* Move them up */
8254 memmove(&expr->token[leftindex + 2], &expr->token[leftindex],
8255 sizeof(*expr->token) * (expr->len - leftindex));
8256 expr->len += 2;
8257 offset = (expr->len - leftindex) - 1;
8259 /* Now we rely on the fact the the left and right version have opcodes
8260 * 1 and 2 after the main opcode respectively
8262 expr->token[leftindex + 1].type = t->type + 1;
8263 expr->token[leftindex + 1].objPtr = interp->emptyObj;
8265 expr->token[leftindex].type = JIM_TT_EXPR_INT;
8266 expr->token[leftindex].objPtr = Jim_NewIntObj(interp, offset);
8268 /* Now add the 'R' operator */
8269 expr->token[expr->len].objPtr = interp->emptyObj;
8270 expr->token[expr->len].type = t->type + 2;
8271 expr->len++;
8273 /* Do we need to adjust the skip count for any &L, |L, ?L or :L in the left operand? */
8274 for (i = leftindex - 1; i > 0; i--) {
8275 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(expr->token[i].type);
8276 if (op->lazy == LAZY_LEFT) {
8277 if (JimWideValue(expr->token[i - 1].objPtr) + i - 1 >= leftindex) {
8278 JimWideValue(expr->token[i - 1].objPtr) += 2;
8282 return JIM_OK;
8285 static int ExprAddOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
8287 struct ScriptToken *token = &expr->token[expr->len];
8288 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8290 if (op->lazy == LAZY_OP) {
8291 if (ExprAddLazyOperator(interp, expr, t) != JIM_OK) {
8292 Jim_SetResultFormatted(interp, "Expression has bad operands to %s", op->name);
8293 return JIM_ERR;
8296 else {
8297 token->objPtr = interp->emptyObj;
8298 token->type = t->type;
8299 expr->len++;
8301 return JIM_OK;
8305 * Returns the index of the COLON_LEFT to the left of 'right_index'
8306 * taking into account nesting.
8308 * The expression *must* be well formed, thus a COLON_LEFT will always be found.
8310 static int ExprTernaryGetColonLeftIndex(ExprByteCode *expr, int right_index)
8312 int ternary_count = 1;
8314 right_index--;
8316 while (right_index > 1) {
8317 if (expr->token[right_index].type == JIM_EXPROP_TERNARY_LEFT) {
8318 ternary_count--;
8320 else if (expr->token[right_index].type == JIM_EXPROP_COLON_RIGHT) {
8321 ternary_count++;
8323 else if (expr->token[right_index].type == JIM_EXPROP_COLON_LEFT && ternary_count == 1) {
8324 return right_index;
8326 right_index--;
8329 /*notreached*/
8330 return -1;
8334 * Find the left/right indices for the ternary expression to the left of 'right_index'.
8336 * Returns 1 if found, and fills in *prev_right_index and *prev_left_index.
8337 * Otherwise returns 0.
8339 static int ExprTernaryGetMoveIndices(ExprByteCode *expr, int right_index, int *prev_right_index, int *prev_left_index)
8341 int i = right_index - 1;
8342 int ternary_count = 1;
8344 while (i > 1) {
8345 if (expr->token[i].type == JIM_EXPROP_TERNARY_LEFT) {
8346 if (--ternary_count == 0 && expr->token[i - 2].type == JIM_EXPROP_COLON_RIGHT) {
8347 *prev_right_index = i - 2;
8348 *prev_left_index = ExprTernaryGetColonLeftIndex(expr, *prev_right_index);
8349 return 1;
8352 else if (expr->token[i].type == JIM_EXPROP_COLON_RIGHT) {
8353 if (ternary_count == 0) {
8354 return 0;
8356 ternary_count++;
8358 i--;
8360 return 0;
8364 * ExprTernaryReorderExpression description
8365 * ========================================
8367 * ?: is right-to-left associative which doesn't work with the stack-based
8368 * expression engine. The fix is to reorder the bytecode.
8370 * The expression:
8372 * expr 1?2:0?3:4
8374 * Has initial bytecode:
8376 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '0' (44=COLON_RIGHT)
8377 * '2' (40=TERNARY_LEFT) '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT)
8379 * The fix involves simulating this expression instead:
8381 * expr 1?2:(0?3:4)
8383 * With the following bytecode:
8385 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '10' (43=COLON_LEFT) '0' '2' (40=TERNARY_LEFT)
8386 * '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT) (44=COLON_RIGHT)
8388 * i.e. The token COLON_RIGHT at index 8 is moved towards the end of the stack, all tokens above 8
8389 * are shifted down and the skip count of the token JIM_EXPROP_COLON_LEFT at index 5 is
8390 * incremented by the amount tokens shifted down. The token JIM_EXPROP_COLON_RIGHT that is moved
8391 * is identified as immediately preceeding a token JIM_EXPROP_TERNARY_LEFT
8393 * ExprTernaryReorderExpression works thus as follows :
8394 * - start from the end of the stack
8395 * - while walking towards the beginning of the stack
8396 * if token=JIM_EXPROP_COLON_RIGHT then
8397 * find the associated token JIM_EXPROP_TERNARY_LEFT, which allows to
8398 * find the associated token previous(JIM_EXPROP_COLON_RIGHT)
8399 * find the associated token previous(JIM_EXPROP_LEFT_RIGHT)
8400 * if all found then
8401 * perform the rotation
8402 * update the skip count of the token previous(JIM_EXPROP_LEFT_RIGHT)
8403 * end if
8404 * end if
8406 * Note: care has to be taken for nested ternary constructs!!!
8408 static void ExprTernaryReorderExpression(Jim_Interp *interp, ExprByteCode *expr)
8410 int i;
8412 for (i = expr->len - 1; i > 1; i--) {
8413 int prev_right_index;
8414 int prev_left_index;
8415 int j;
8416 ScriptToken tmp;
8418 if (expr->token[i].type != JIM_EXPROP_COLON_RIGHT) {
8419 continue;
8422 /* COLON_RIGHT found: get the indexes needed to move the tokens in the stack (if any) */
8423 if (ExprTernaryGetMoveIndices(expr, i, &prev_right_index, &prev_left_index) == 0) {
8424 continue;
8428 ** rotate tokens down
8430 ** +-> [i] : JIM_EXPROP_COLON_RIGHT
8431 ** | | |
8432 ** | V V
8433 ** | [...] : ...
8434 ** | | |
8435 ** | V V
8436 ** | [...] : ...
8437 ** | | |
8438 ** | V V
8439 ** +- [prev_right_index] : JIM_EXPROP_COLON_RIGHT
8441 tmp = expr->token[prev_right_index];
8442 for (j = prev_right_index; j < i; j++) {
8443 expr->token[j] = expr->token[j + 1];
8445 expr->token[i] = tmp;
8447 /* Increment the 'skip' count associated to the previous JIM_EXPROP_COLON_LEFT token
8449 * This is 'colon left increment' = i - prev_right_index
8451 * [prev_left_index] : JIM_EXPROP_LEFT_RIGHT
8452 * [prev_left_index-1] : skip_count
8455 JimWideValue(expr->token[prev_left_index-1].objPtr) += (i - prev_right_index);
8457 /* Adjust for i-- in the loop */
8458 i++;
8462 static ExprByteCode *ExprCreateByteCode(Jim_Interp *interp, const ParseTokenList *tokenlist, Jim_Obj *fileNameObj)
8464 Jim_Stack stack;
8465 ExprByteCode *expr;
8466 int ok = 1;
8467 int i;
8468 int prevtt = JIM_TT_NONE;
8469 int have_ternary = 0;
8471 /* -1 for EOL */
8472 int count = tokenlist->count - 1;
8474 expr = Jim_Alloc(sizeof(*expr));
8475 expr->inUse = 1;
8476 expr->len = 0;
8478 Jim_InitStack(&stack);
8480 /* Need extra bytecodes for lazy operators.
8481 * Also check for the ternary operator
8483 for (i = 0; i < tokenlist->count; i++) {
8484 ParseToken *t = &tokenlist->list[i];
8485 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8487 if (op->lazy == LAZY_OP) {
8488 count += 2;
8489 /* Ternary is a lazy op but also needs reordering */
8490 if (t->type == JIM_EXPROP_TERNARY) {
8491 have_ternary = 1;
8496 expr->token = Jim_Alloc(sizeof(ScriptToken) * count);
8498 for (i = 0; i < tokenlist->count && ok; i++) {
8499 ParseToken *t = &tokenlist->list[i];
8501 /* Next token will be stored here */
8502 struct ScriptToken *token = &expr->token[expr->len];
8504 if (t->type == JIM_TT_EOL) {
8505 break;
8508 switch (t->type) {
8509 case JIM_TT_STR:
8510 case JIM_TT_ESC:
8511 case JIM_TT_VAR:
8512 case JIM_TT_DICTSUGAR:
8513 case JIM_TT_EXPRSUGAR:
8514 case JIM_TT_CMD:
8515 token->objPtr = Jim_NewStringObj(interp, t->token, t->len);
8516 token->type = t->type;
8517 if (t->type == JIM_TT_CMD) {
8518 /* Only commands need source info */
8519 JimSetSourceInfo(interp, token->objPtr, fileNameObj, t->line);
8521 expr->len++;
8522 break;
8524 case JIM_TT_EXPR_INT:
8525 token->objPtr = Jim_NewIntObj(interp, strtoull(t->token, NULL, 0));
8526 token->type = t->type;
8527 expr->len++;
8528 break;
8530 case JIM_TT_EXPR_DOUBLE:
8531 token->objPtr = Jim_NewDoubleObj(interp, strtod(t->token, NULL));
8532 token->type = t->type;
8533 expr->len++;
8534 break;
8536 case JIM_TT_SUBEXPR_START:
8537 Jim_StackPush(&stack, t);
8538 prevtt = JIM_TT_NONE;
8539 continue;
8541 case JIM_TT_SUBEXPR_COMMA:
8542 /* Simple approach. Comma is simply ignored */
8543 continue;
8545 case JIM_TT_SUBEXPR_END:
8546 ok = 0;
8547 while (Jim_StackLen(&stack)) {
8548 ParseToken *tt = Jim_StackPop(&stack);
8550 if (tt->type == JIM_TT_SUBEXPR_START) {
8551 ok = 1;
8552 break;
8555 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
8556 goto err;
8559 if (!ok) {
8560 Jim_SetResultString(interp, "Unexpected close parenthesis", -1);
8561 goto err;
8563 break;
8566 default:{
8567 /* Must be an operator */
8568 const struct Jim_ExprOperator *op;
8569 ParseToken *tt;
8571 /* Convert -/+ to unary minus or unary plus if necessary */
8572 if (prevtt == JIM_TT_NONE || prevtt >= JIM_TT_EXPR_OP) {
8573 if (t->type == JIM_EXPROP_SUB) {
8574 t->type = JIM_EXPROP_UNARYMINUS;
8576 else if (t->type == JIM_EXPROP_ADD) {
8577 t->type = JIM_EXPROP_UNARYPLUS;
8581 op = JimExprOperatorInfoByOpcode(t->type);
8583 /* Now handle precedence */
8584 while ((tt = Jim_StackPeek(&stack)) != NULL) {
8585 const struct Jim_ExprOperator *tt_op =
8586 JimExprOperatorInfoByOpcode(tt->type);
8588 /* Note that right-to-left associativity of ?: operator is handled later */
8590 if (op->arity != 1 && tt_op->precedence >= op->precedence) {
8591 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
8592 ok = 0;
8593 goto err;
8595 Jim_StackPop(&stack);
8597 else {
8598 break;
8601 Jim_StackPush(&stack, t);
8602 break;
8605 prevtt = t->type;
8608 /* Reduce any remaining subexpr */
8609 while (Jim_StackLen(&stack)) {
8610 ParseToken *tt = Jim_StackPop(&stack);
8612 if (tt->type == JIM_TT_SUBEXPR_START) {
8613 ok = 0;
8614 Jim_SetResultString(interp, "Missing close parenthesis", -1);
8615 goto err;
8617 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
8618 ok = 0;
8619 goto err;
8623 if (have_ternary) {
8624 ExprTernaryReorderExpression(interp, expr);
8627 err:
8628 /* Free the stack used for the compilation. */
8629 Jim_FreeStack(&stack);
8631 for (i = 0; i < expr->len; i++) {
8632 Jim_IncrRefCount(expr->token[i].objPtr);
8635 if (!ok) {
8636 ExprFreeByteCode(interp, expr);
8637 return NULL;
8640 return expr;
8644 /* This method takes the string representation of an expression
8645 * and generates a program for the Expr's stack-based VM. */
8646 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
8648 int exprTextLen;
8649 const char *exprText;
8650 struct JimParserCtx parser;
8651 struct ExprByteCode *expr;
8652 ParseTokenList tokenlist;
8653 int line;
8654 Jim_Obj *fileNameObj;
8655 int rc = JIM_ERR;
8657 /* Try to get information about filename / line number */
8658 if (objPtr->typePtr == &sourceObjType) {
8659 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
8660 line = objPtr->internalRep.sourceValue.lineNumber;
8662 else {
8663 fileNameObj = interp->emptyObj;
8664 line = 1;
8666 Jim_IncrRefCount(fileNameObj);
8668 exprText = Jim_GetString(objPtr, &exprTextLen);
8670 /* Initially tokenise the expression into tokenlist */
8671 ScriptTokenListInit(&tokenlist);
8673 JimParserInit(&parser, exprText, exprTextLen, line);
8674 while (!parser.eof) {
8675 if (JimParseExpression(&parser) != JIM_OK) {
8676 ScriptTokenListFree(&tokenlist);
8677 invalidexpr:
8678 Jim_SetResultFormatted(interp, "syntax error in expression: \"%#s\"", objPtr);
8679 expr = NULL;
8680 goto err;
8683 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
8684 parser.tline);
8687 #ifdef DEBUG_SHOW_EXPR_TOKENS
8689 int i;
8690 printf("==== Expr Tokens ====\n");
8691 for (i = 0; i < tokenlist.count; i++) {
8692 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist.list[i].line, jim_tt_name(tokenlist.list[i].type),
8693 tokenlist.list[i].len, tokenlist.list[i].token);
8696 #endif
8698 /* Now create the expression bytecode from the tokenlist */
8699 expr = ExprCreateByteCode(interp, &tokenlist, fileNameObj);
8701 /* No longer need the token list */
8702 ScriptTokenListFree(&tokenlist);
8704 if (!expr) {
8705 goto err;
8708 #ifdef DEBUG_SHOW_EXPR
8710 int i;
8712 printf("==== Expr ====\n");
8713 for (i = 0; i < expr->len; i++) {
8714 ScriptToken *t = &expr->token[i];
8716 printf("[%2d] %s '%s'\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
8719 #endif
8721 /* Check program correctness. */
8722 if (ExprCheckCorrectness(expr) != JIM_OK) {
8723 ExprFreeByteCode(interp, expr);
8724 goto invalidexpr;
8727 rc = JIM_OK;
8729 err:
8730 /* Free the old internal rep and set the new one. */
8731 Jim_DecrRefCount(interp, fileNameObj);
8732 Jim_FreeIntRep(interp, objPtr);
8733 Jim_SetIntRepPtr(objPtr, expr);
8734 objPtr->typePtr = &exprObjType;
8735 return rc;
8738 static ExprByteCode *JimGetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
8740 if (objPtr->typePtr != &exprObjType) {
8741 if (SetExprFromAny(interp, objPtr) != JIM_OK) {
8742 return NULL;
8745 return (ExprByteCode *) Jim_GetIntRepPtr(objPtr);
8748 /* -----------------------------------------------------------------------------
8749 * Expressions evaluation.
8750 * Jim uses a specialized stack-based virtual machine for expressions,
8751 * that takes advantage of the fact that expr's operators
8752 * can't be redefined.
8754 * Jim_EvalExpression() uses the bytecode compiled by
8755 * SetExprFromAny() method of the "expression" object.
8757 * On success a Tcl Object containing the result of the evaluation
8758 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
8759 * returned.
8760 * On error the function returns a retcode != to JIM_OK and set a suitable
8761 * error on the interp.
8762 * ---------------------------------------------------------------------------*/
8763 #define JIM_EE_STATICSTACK_LEN 10
8765 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr, Jim_Obj **exprResultPtrPtr)
8767 ExprByteCode *expr;
8768 Jim_Obj *staticStack[JIM_EE_STATICSTACK_LEN];
8769 int i;
8770 int retcode = JIM_OK;
8771 struct JimExprState e;
8773 expr = JimGetExpression(interp, exprObjPtr);
8774 if (!expr) {
8775 return JIM_ERR; /* error in expression. */
8778 #ifdef JIM_OPTIMIZATION
8779 /* Check for one of the following common expressions used by while/for
8781 * CONST
8782 * $a
8783 * !$a
8784 * $a < CONST, $a < $b
8785 * $a <= CONST, $a <= $b
8786 * $a > CONST, $a > $b
8787 * $a >= CONST, $a >= $b
8788 * $a != CONST, $a != $b
8789 * $a == CONST, $a == $b
8792 Jim_Obj *objPtr;
8794 /* STEP 1 -- Check if there are the conditions to run the specialized
8795 * version of while */
8797 switch (expr->len) {
8798 case 1:
8799 if (expr->token[0].type == JIM_TT_EXPR_INT) {
8800 *exprResultPtrPtr = expr->token[0].objPtr;
8801 Jim_IncrRefCount(*exprResultPtrPtr);
8802 return JIM_OK;
8804 if (expr->token[0].type == JIM_TT_VAR) {
8805 objPtr = Jim_GetVariable(interp, expr->token[0].objPtr, JIM_ERRMSG);
8806 if (objPtr) {
8807 *exprResultPtrPtr = objPtr;
8808 Jim_IncrRefCount(*exprResultPtrPtr);
8809 return JIM_OK;
8812 break;
8814 case 2:
8815 if (expr->token[1].type == JIM_EXPROP_NOT && expr->token[0].type == JIM_TT_VAR) {
8816 jim_wide wideValue;
8818 objPtr = Jim_GetVariable(interp, expr->token[0].objPtr, JIM_NONE);
8819 if (objPtr && JimIsWide(objPtr)
8820 && Jim_GetWide(interp, objPtr, &wideValue) == JIM_OK) {
8821 *exprResultPtrPtr = wideValue ? interp->falseObj : interp->trueObj;
8822 Jim_IncrRefCount(*exprResultPtrPtr);
8823 return JIM_OK;
8826 break;
8828 case 3:
8829 if (expr->token[0].type == JIM_TT_VAR && (expr->token[1].type == JIM_TT_EXPR_INT
8830 || expr->token[1].type == JIM_TT_VAR)) {
8831 switch (expr->token[2].type) {
8832 case JIM_EXPROP_LT:
8833 case JIM_EXPROP_LTE:
8834 case JIM_EXPROP_GT:
8835 case JIM_EXPROP_GTE:
8836 case JIM_EXPROP_NUMEQ:
8837 case JIM_EXPROP_NUMNE:{
8838 /* optimise ok */
8839 jim_wide wideValueA;
8840 jim_wide wideValueB;
8842 objPtr = Jim_GetVariable(interp, expr->token[0].objPtr, JIM_NONE);
8843 if (objPtr && JimIsWide(objPtr)
8844 && Jim_GetWide(interp, objPtr, &wideValueA) == JIM_OK) {
8845 if (expr->token[1].type == JIM_TT_VAR) {
8846 objPtr =
8847 Jim_GetVariable(interp, expr->token[1].objPtr,
8848 JIM_NONE);
8850 else {
8851 objPtr = expr->token[1].objPtr;
8853 if (objPtr && JimIsWide(objPtr)
8854 && Jim_GetWide(interp, objPtr, &wideValueB) == JIM_OK) {
8855 int cmpRes;
8857 switch (expr->token[2].type) {
8858 case JIM_EXPROP_LT:
8859 cmpRes = wideValueA < wideValueB;
8860 break;
8861 case JIM_EXPROP_LTE:
8862 cmpRes = wideValueA <= wideValueB;
8863 break;
8864 case JIM_EXPROP_GT:
8865 cmpRes = wideValueA > wideValueB;
8866 break;
8867 case JIM_EXPROP_GTE:
8868 cmpRes = wideValueA >= wideValueB;
8869 break;
8870 case JIM_EXPROP_NUMEQ:
8871 cmpRes = wideValueA == wideValueB;
8872 break;
8873 case JIM_EXPROP_NUMNE:
8874 cmpRes = wideValueA != wideValueB;
8875 break;
8876 default: /*notreached */
8877 cmpRes = 0;
8879 *exprResultPtrPtr =
8880 cmpRes ? interp->trueObj : interp->falseObj;
8881 Jim_IncrRefCount(*exprResultPtrPtr);
8882 return JIM_OK;
8888 break;
8891 #endif
8893 /* In order to avoid that the internal repr gets freed due to
8894 * shimmering of the exprObjPtr's object, we make the internal rep
8895 * shared. */
8896 expr->inUse++;
8898 /* The stack-based expr VM itself */
8900 /* Stack allocation. Expr programs have the feature that
8901 * a program of length N can't require a stack longer than
8902 * N. */
8903 if (expr->len > JIM_EE_STATICSTACK_LEN)
8904 e.stack = Jim_Alloc(sizeof(Jim_Obj *) * expr->len);
8905 else
8906 e.stack = staticStack;
8908 e.stacklen = 0;
8910 /* Execute every instruction */
8911 for (i = 0; i < expr->len && retcode == JIM_OK; i++) {
8912 Jim_Obj *objPtr;
8914 switch (expr->token[i].type) {
8915 case JIM_TT_EXPR_INT:
8916 case JIM_TT_EXPR_DOUBLE:
8917 case JIM_TT_STR:
8918 ExprPush(&e, expr->token[i].objPtr);
8919 break;
8921 case JIM_TT_VAR:
8922 objPtr = Jim_GetVariable(interp, expr->token[i].objPtr, JIM_ERRMSG);
8923 if (objPtr) {
8924 ExprPush(&e, objPtr);
8926 else {
8927 retcode = JIM_ERR;
8929 break;
8931 case JIM_TT_DICTSUGAR:
8932 objPtr = JimExpandDictSugar(interp, expr->token[i].objPtr);
8933 if (objPtr) {
8934 ExprPush(&e, objPtr);
8936 else {
8937 retcode = JIM_ERR;
8939 break;
8941 case JIM_TT_ESC:
8942 retcode = Jim_SubstObj(interp, expr->token[i].objPtr, &objPtr, JIM_NONE);
8943 if (retcode == JIM_OK) {
8944 ExprPush(&e, objPtr);
8946 break;
8948 case JIM_TT_CMD:
8949 retcode = Jim_EvalObj(interp, expr->token[i].objPtr);
8950 if (retcode == JIM_OK) {
8951 ExprPush(&e, Jim_GetResult(interp));
8953 break;
8955 default:{
8956 /* Find and execute the operation */
8957 e.skip = 0;
8958 e.opcode = expr->token[i].type;
8960 retcode = JimExprOperatorInfoByOpcode(e.opcode)->funcop(interp, &e);
8961 /* Skip some opcodes if necessary */
8962 i += e.skip;
8963 continue;
8968 expr->inUse--;
8970 if (retcode == JIM_OK) {
8971 *exprResultPtrPtr = ExprPop(&e);
8973 else {
8974 for (i = 0; i < e.stacklen; i++) {
8975 Jim_DecrRefCount(interp, e.stack[i]);
8978 if (e.stack != staticStack) {
8979 Jim_Free(e.stack);
8981 return retcode;
8984 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
8986 int retcode;
8987 jim_wide wideValue;
8988 double doubleValue;
8989 Jim_Obj *exprResultPtr;
8991 retcode = Jim_EvalExpression(interp, exprObjPtr, &exprResultPtr);
8992 if (retcode != JIM_OK)
8993 return retcode;
8995 if (JimGetWideNoErr(interp, exprResultPtr, &wideValue) != JIM_OK) {
8996 if (Jim_GetDouble(interp, exprResultPtr, &doubleValue) != JIM_OK) {
8997 Jim_DecrRefCount(interp, exprResultPtr);
8998 return JIM_ERR;
9000 else {
9001 Jim_DecrRefCount(interp, exprResultPtr);
9002 *boolPtr = doubleValue != 0;
9003 return JIM_OK;
9006 *boolPtr = wideValue != 0;
9008 Jim_DecrRefCount(interp, exprResultPtr);
9009 return JIM_OK;
9012 /* -----------------------------------------------------------------------------
9013 * ScanFormat String Object
9014 * ---------------------------------------------------------------------------*/
9016 /* This Jim_Obj will held a parsed representation of a format string passed to
9017 * the Jim_ScanString command. For error diagnostics, the scanformat string has
9018 * to be parsed in its entirely first and then, if correct, can be used for
9019 * scanning. To avoid endless re-parsing, the parsed representation will be
9020 * stored in an internal representation and re-used for performance reason. */
9022 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
9023 * scanformat string. This part will later be used to extract information
9024 * out from the string to be parsed by Jim_ScanString */
9026 typedef struct ScanFmtPartDescr
9028 char type; /* Type of conversion (e.g. c, d, f) */
9029 char modifier; /* Modify type (e.g. l - long, h - short */
9030 size_t width; /* Maximal width of input to be converted */
9031 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
9032 char *arg; /* Specification of a CHARSET conversion */
9033 char *prefix; /* Prefix to be scanned literally before conversion */
9034 } ScanFmtPartDescr;
9036 /* The ScanFmtStringObj will hold the internal representation of a scanformat
9037 * string parsed and separated in part descriptions. Furthermore it contains
9038 * the original string representation of the scanformat string to allow for
9039 * fast update of the Jim_Obj's string representation part.
9041 * As an add-on the internal object representation adds some scratch pad area
9042 * for usage by Jim_ScanString to avoid endless allocating and freeing of
9043 * memory for purpose of string scanning.
9045 * The error member points to a static allocated string in case of a mal-
9046 * formed scanformat string or it contains '0' (NULL) in case of a valid
9047 * parse representation.
9049 * The whole memory of the internal representation is allocated as a single
9050 * area of memory that will be internally separated. So freeing and duplicating
9051 * of such an object is cheap */
9053 typedef struct ScanFmtStringObj
9055 jim_wide size; /* Size of internal repr in bytes */
9056 char *stringRep; /* Original string representation */
9057 size_t count; /* Number of ScanFmtPartDescr contained */
9058 size_t convCount; /* Number of conversions that will assign */
9059 size_t maxPos; /* Max position index if XPG3 is used */
9060 const char *error; /* Ptr to error text (NULL if no error */
9061 char *scratch; /* Some scratch pad used by Jim_ScanString */
9062 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
9063 } ScanFmtStringObj;
9066 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
9067 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
9068 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
9070 static const Jim_ObjType scanFmtStringObjType = {
9071 "scanformatstring",
9072 FreeScanFmtInternalRep,
9073 DupScanFmtInternalRep,
9074 UpdateStringOfScanFmt,
9075 JIM_TYPE_NONE,
9078 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
9080 JIM_NOTUSED(interp);
9081 Jim_Free((char *)objPtr->internalRep.ptr);
9082 objPtr->internalRep.ptr = 0;
9085 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
9087 size_t size = (size_t) ((ScanFmtStringObj *) srcPtr->internalRep.ptr)->size;
9088 ScanFmtStringObj *newVec = (ScanFmtStringObj *) Jim_Alloc(size);
9090 JIM_NOTUSED(interp);
9091 memcpy(newVec, srcPtr->internalRep.ptr, size);
9092 dupPtr->internalRep.ptr = newVec;
9093 dupPtr->typePtr = &scanFmtStringObjType;
9096 void UpdateStringOfScanFmt(Jim_Obj *objPtr)
9098 char *bytes = ((ScanFmtStringObj *) objPtr->internalRep.ptr)->stringRep;
9100 objPtr->bytes = Jim_StrDup(bytes);
9101 objPtr->length = strlen(bytes);
9104 /* SetScanFmtFromAny will parse a given string and create the internal
9105 * representation of the format specification. In case of an error
9106 * the error data member of the internal representation will be set
9107 * to an descriptive error text and the function will be left with
9108 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
9109 * specification */
9111 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
9113 ScanFmtStringObj *fmtObj;
9114 char *buffer;
9115 int maxCount, i, approxSize, lastPos = -1;
9116 const char *fmt = objPtr->bytes;
9117 int maxFmtLen = objPtr->length;
9118 const char *fmtEnd = fmt + maxFmtLen;
9119 int curr;
9121 Jim_FreeIntRep(interp, objPtr);
9122 /* Count how many conversions could take place maximally */
9123 for (i = 0, maxCount = 0; i < maxFmtLen; ++i)
9124 if (fmt[i] == '%')
9125 ++maxCount;
9126 /* Calculate an approximation of the memory necessary */
9127 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
9128 +(maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
9129 +maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
9130 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
9131 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
9132 +(maxCount + 1) * sizeof(char) /* '\0' for every partial */
9133 +1; /* safety byte */
9134 fmtObj = (ScanFmtStringObj *) Jim_Alloc(approxSize);
9135 memset(fmtObj, 0, approxSize);
9136 fmtObj->size = approxSize;
9137 fmtObj->maxPos = 0;
9138 fmtObj->scratch = (char *)&fmtObj->descr[maxCount + 1];
9139 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
9140 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
9141 buffer = fmtObj->stringRep + maxFmtLen + 1;
9142 objPtr->internalRep.ptr = fmtObj;
9143 objPtr->typePtr = &scanFmtStringObjType;
9144 for (i = 0, curr = 0; fmt < fmtEnd; ++fmt) {
9145 int width = 0, skip;
9146 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
9148 fmtObj->count++;
9149 descr->width = 0; /* Assume width unspecified */
9150 /* Overread and store any "literal" prefix */
9151 if (*fmt != '%' || fmt[1] == '%') {
9152 descr->type = 0;
9153 descr->prefix = &buffer[i];
9154 for (; fmt < fmtEnd; ++fmt) {
9155 if (*fmt == '%') {
9156 if (fmt[1] != '%')
9157 break;
9158 ++fmt;
9160 buffer[i++] = *fmt;
9162 buffer[i++] = 0;
9164 /* Skip the conversion introducing '%' sign */
9165 ++fmt;
9166 /* End reached due to non-conversion literal only? */
9167 if (fmt >= fmtEnd)
9168 goto done;
9169 descr->pos = 0; /* Assume "natural" positioning */
9170 if (*fmt == '*') {
9171 descr->pos = -1; /* Okay, conversion will not be assigned */
9172 ++fmt;
9174 else
9175 fmtObj->convCount++; /* Otherwise count as assign-conversion */
9176 /* Check if next token is a number (could be width or pos */
9177 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9178 fmt += skip;
9179 /* Was the number a XPG3 position specifier? */
9180 if (descr->pos != -1 && *fmt == '$') {
9181 int prev;
9183 ++fmt;
9184 descr->pos = width;
9185 width = 0;
9186 /* Look if "natural" postioning and XPG3 one was mixed */
9187 if ((lastPos == 0 && descr->pos > 0)
9188 || (lastPos > 0 && descr->pos == 0)) {
9189 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
9190 return JIM_ERR;
9192 /* Look if this position was already used */
9193 for (prev = 0; prev < curr; ++prev) {
9194 if (fmtObj->descr[prev].pos == -1)
9195 continue;
9196 if (fmtObj->descr[prev].pos == descr->pos) {
9197 fmtObj->error =
9198 "variable is assigned by multiple \"%n$\" conversion specifiers";
9199 return JIM_ERR;
9202 /* Try to find a width after the XPG3 specifier */
9203 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9204 descr->width = width;
9205 fmt += skip;
9207 if (descr->pos > 0 && (size_t) descr->pos > fmtObj->maxPos)
9208 fmtObj->maxPos = descr->pos;
9210 else {
9211 /* Number was not a XPG3, so it has to be a width */
9212 descr->width = width;
9215 /* If positioning mode was undetermined yet, fix this */
9216 if (lastPos == -1)
9217 lastPos = descr->pos;
9218 /* Handle CHARSET conversion type ... */
9219 if (*fmt == '[') {
9220 int swapped = 1, beg = i, end, j;
9222 descr->type = '[';
9223 descr->arg = &buffer[i];
9224 ++fmt;
9225 if (*fmt == '^')
9226 buffer[i++] = *fmt++;
9227 if (*fmt == ']')
9228 buffer[i++] = *fmt++;
9229 while (*fmt && *fmt != ']')
9230 buffer[i++] = *fmt++;
9231 if (*fmt != ']') {
9232 fmtObj->error = "unmatched [ in format string";
9233 return JIM_ERR;
9235 end = i;
9236 buffer[i++] = 0;
9237 /* In case a range fence was given "backwards", swap it */
9238 while (swapped) {
9239 swapped = 0;
9240 for (j = beg + 1; j < end - 1; ++j) {
9241 if (buffer[j] == '-' && buffer[j - 1] > buffer[j + 1]) {
9242 char tmp = buffer[j - 1];
9244 buffer[j - 1] = buffer[j + 1];
9245 buffer[j + 1] = tmp;
9246 swapped = 1;
9251 else {
9252 /* Remember any valid modifier if given */
9253 if (strchr("hlL", *fmt) != 0)
9254 descr->modifier = tolower((int)*fmt++);
9256 descr->type = *fmt;
9257 if (strchr("efgcsndoxui", *fmt) == 0) {
9258 fmtObj->error = "bad scan conversion character";
9259 return JIM_ERR;
9261 else if (*fmt == 'c' && descr->width != 0) {
9262 fmtObj->error = "field width may not be specified in %c " "conversion";
9263 return JIM_ERR;
9265 else if (*fmt == 'u' && descr->modifier == 'l') {
9266 fmtObj->error = "unsigned wide not supported";
9267 return JIM_ERR;
9270 curr++;
9272 done:
9273 return JIM_OK;
9276 /* Some accessor macros to allow lowlevel access to fields of internal repr */
9278 #define FormatGetCnvCount(_fo_) \
9279 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
9280 #define FormatGetMaxPos(_fo_) \
9281 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
9282 #define FormatGetError(_fo_) \
9283 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
9285 /* JimScanAString is used to scan an unspecified string that ends with
9286 * next WS, or a string that is specified via a charset.
9289 static Jim_Obj *JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
9291 char *buffer = Jim_StrDup(str);
9292 char *p = buffer;
9294 while (*str) {
9295 int c;
9296 int n;
9298 if (!sdescr && isspace(UCHAR(*str)))
9299 break; /* EOS via WS if unspecified */
9301 n = utf8_tounicode(str, &c);
9302 if (sdescr && !JimCharsetMatch(sdescr, c, JIM_CHARSET_SCAN))
9303 break;
9304 while (n--)
9305 *p++ = *str++;
9307 *p = 0;
9308 return Jim_NewStringObjNoAlloc(interp, buffer, p - buffer);
9311 /* ScanOneEntry will scan one entry out of the string passed as argument.
9312 * It use the sscanf() function for this task. After extracting and
9313 * converting of the value, the count of scanned characters will be
9314 * returned of -1 in case of no conversion tool place and string was
9315 * already scanned thru */
9317 static int ScanOneEntry(Jim_Interp *interp, const char *str, int pos, int strLen,
9318 ScanFmtStringObj * fmtObj, long idx, Jim_Obj **valObjPtr)
9320 const char *tok;
9321 const ScanFmtPartDescr *descr = &fmtObj->descr[idx];
9322 size_t scanned = 0;
9323 size_t anchor = pos;
9324 int i;
9325 Jim_Obj *tmpObj = NULL;
9327 /* First pessimistically assume, we will not scan anything :-) */
9328 *valObjPtr = 0;
9329 if (descr->prefix) {
9330 /* There was a prefix given before the conversion, skip it and adjust
9331 * the string-to-be-parsed accordingly */
9332 /* XXX: Should be checking strLen, not str[pos] */
9333 for (i = 0; pos < strLen && descr->prefix[i]; ++i) {
9334 /* If prefix require, skip WS */
9335 if (isspace(UCHAR(descr->prefix[i])))
9336 while (pos < strLen && isspace(UCHAR(str[pos])))
9337 ++pos;
9338 else if (descr->prefix[i] != str[pos])
9339 break; /* Prefix do not match here, leave the loop */
9340 else
9341 ++pos; /* Prefix matched so far, next round */
9343 if (pos >= strLen) {
9344 return -1; /* All of str consumed: EOF condition */
9346 else if (descr->prefix[i] != 0)
9347 return 0; /* Not whole prefix consumed, no conversion possible */
9349 /* For all but following conversion, skip leading WS */
9350 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
9351 while (isspace(UCHAR(str[pos])))
9352 ++pos;
9353 /* Determine how much skipped/scanned so far */
9354 scanned = pos - anchor;
9356 /* %c is a special, simple case. no width */
9357 if (descr->type == 'n') {
9358 /* Return pseudo conversion means: how much scanned so far? */
9359 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
9361 else if (pos >= strLen) {
9362 /* Cannot scan anything, as str is totally consumed */
9363 return -1;
9365 else if (descr->type == 'c') {
9366 int c;
9367 scanned += utf8_tounicode(&str[pos], &c);
9368 *valObjPtr = Jim_NewIntObj(interp, c);
9369 return scanned;
9371 else {
9372 /* Processing of conversions follows ... */
9373 if (descr->width > 0) {
9374 /* Do not try to scan as fas as possible but only the given width.
9375 * To ensure this, we copy the part that should be scanned. */
9376 size_t sLen = utf8_strlen(&str[pos], strLen - pos);
9377 size_t tLen = descr->width > sLen ? sLen : descr->width;
9379 tmpObj = Jim_NewStringObjUtf8(interp, str + pos, tLen);
9380 tok = tmpObj->bytes;
9382 else {
9383 /* As no width was given, simply refer to the original string */
9384 tok = &str[pos];
9386 switch (descr->type) {
9387 case 'd':
9388 case 'o':
9389 case 'x':
9390 case 'u':
9391 case 'i':{
9392 char *endp; /* Position where the number finished */
9393 jim_wide w;
9395 int base = descr->type == 'o' ? 8
9396 : descr->type == 'x' ? 16 : descr->type == 'i' ? 0 : 10;
9398 /* Try to scan a number with the given base */
9399 w = strtoull(tok, &endp, base);
9400 if (endp == tok && base == 0) {
9401 /* If scanning failed, and base was undetermined, simply
9402 * put it to 10 and try once more. This should catch the
9403 * case where %i begin to parse a number prefix (e.g.
9404 * '0x' but no further digits follows. This will be
9405 * handled as a ZERO followed by a char 'x' by Tcl) */
9406 w = strtoull(tok, &endp, 10);
9409 if (endp != tok) {
9410 /* There was some number sucessfully scanned! */
9411 *valObjPtr = Jim_NewIntObj(interp, w);
9413 /* Adjust the number-of-chars scanned so far */
9414 scanned += endp - tok;
9416 else {
9417 /* Nothing was scanned. We have to determine if this
9418 * happened due to e.g. prefix mismatch or input str
9419 * exhausted */
9420 scanned = *tok ? 0 : -1;
9422 break;
9424 case 's':
9425 case '[':{
9426 *valObjPtr = JimScanAString(interp, descr->arg, tok);
9427 scanned += Jim_Length(*valObjPtr);
9428 break;
9430 case 'e':
9431 case 'f':
9432 case 'g':{
9433 char *endp;
9434 double value = strtod(tok, &endp);
9436 if (endp != tok) {
9437 /* There was some number sucessfully scanned! */
9438 *valObjPtr = Jim_NewDoubleObj(interp, value);
9439 /* Adjust the number-of-chars scanned so far */
9440 scanned += endp - tok;
9442 else {
9443 /* Nothing was scanned. We have to determine if this
9444 * happened due to e.g. prefix mismatch or input str
9445 * exhausted */
9446 scanned = *tok ? 0 : -1;
9448 break;
9451 /* If a substring was allocated (due to pre-defined width) do not
9452 * forget to free it */
9453 if (tmpObj) {
9454 Jim_FreeNewObj(interp, tmpObj);
9457 return scanned;
9460 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
9461 * string and returns all converted (and not ignored) values in a list back
9462 * to the caller. If an error occured, a NULL pointer will be returned */
9464 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *fmtObjPtr, int flags)
9466 size_t i, pos;
9467 int scanned = 1;
9468 const char *str = Jim_String(strObjPtr);
9469 int strLen = Jim_Utf8Length(interp, strObjPtr);
9470 Jim_Obj *resultList = 0;
9471 Jim_Obj **resultVec = 0;
9472 int resultc;
9473 Jim_Obj *emptyStr = 0;
9474 ScanFmtStringObj *fmtObj;
9476 /* This should never happen. The format object should already be of the correct type */
9477 JimPanic((fmtObjPtr->typePtr != &scanFmtStringObjType, "Jim_ScanString() for non-scan format"));
9479 fmtObj = (ScanFmtStringObj *) fmtObjPtr->internalRep.ptr;
9480 /* Check if format specification was valid */
9481 if (fmtObj->error != 0) {
9482 if (flags & JIM_ERRMSG)
9483 Jim_SetResultString(interp, fmtObj->error, -1);
9484 return 0;
9486 /* Allocate a new "shared" empty string for all unassigned conversions */
9487 emptyStr = Jim_NewEmptyStringObj(interp);
9488 Jim_IncrRefCount(emptyStr);
9489 /* Create a list and fill it with empty strings up to max specified XPG3 */
9490 resultList = Jim_NewListObj(interp, NULL, 0);
9491 if (fmtObj->maxPos > 0) {
9492 for (i = 0; i < fmtObj->maxPos; ++i)
9493 Jim_ListAppendElement(interp, resultList, emptyStr);
9494 JimListGetElements(interp, resultList, &resultc, &resultVec);
9496 /* Now handle every partial format description */
9497 for (i = 0, pos = 0; i < fmtObj->count; ++i) {
9498 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
9499 Jim_Obj *value = 0;
9501 /* Only last type may be "literal" w/o conversion - skip it! */
9502 if (descr->type == 0)
9503 continue;
9504 /* As long as any conversion could be done, we will proceed */
9505 if (scanned > 0)
9506 scanned = ScanOneEntry(interp, str, pos, strLen, fmtObj, i, &value);
9507 /* In case our first try results in EOF, we will leave */
9508 if (scanned == -1 && i == 0)
9509 goto eof;
9510 /* Advance next pos-to-be-scanned for the amount scanned already */
9511 pos += scanned;
9513 /* value == 0 means no conversion took place so take empty string */
9514 if (value == 0)
9515 value = Jim_NewEmptyStringObj(interp);
9516 /* If value is a non-assignable one, skip it */
9517 if (descr->pos == -1) {
9518 Jim_FreeNewObj(interp, value);
9520 else if (descr->pos == 0)
9521 /* Otherwise append it to the result list if no XPG3 was given */
9522 Jim_ListAppendElement(interp, resultList, value);
9523 else if (resultVec[descr->pos - 1] == emptyStr) {
9524 /* But due to given XPG3, put the value into the corr. slot */
9525 Jim_DecrRefCount(interp, resultVec[descr->pos - 1]);
9526 Jim_IncrRefCount(value);
9527 resultVec[descr->pos - 1] = value;
9529 else {
9530 /* Otherwise, the slot was already used - free obj and ERROR */
9531 Jim_FreeNewObj(interp, value);
9532 goto err;
9535 Jim_DecrRefCount(interp, emptyStr);
9536 return resultList;
9537 eof:
9538 Jim_DecrRefCount(interp, emptyStr);
9539 Jim_FreeNewObj(interp, resultList);
9540 return (Jim_Obj *)EOF;
9541 err:
9542 Jim_DecrRefCount(interp, emptyStr);
9543 Jim_FreeNewObj(interp, resultList);
9544 return 0;
9547 /* -----------------------------------------------------------------------------
9548 * Pseudo Random Number Generation
9549 * ---------------------------------------------------------------------------*/
9550 /* Initialize the sbox with the numbers from 0 to 255 */
9551 static void JimPrngInit(Jim_Interp *interp)
9553 #define PRNG_SEED_SIZE 256
9554 int i;
9555 unsigned int *seed;
9556 time_t t = time(NULL);
9558 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
9560 seed = Jim_Alloc(PRNG_SEED_SIZE * sizeof(*seed));
9561 for (i = 0; i < PRNG_SEED_SIZE; i++) {
9562 seed[i] = (rand() ^ t ^ clock());
9564 JimPrngSeed(interp, (unsigned char *)seed, PRNG_SEED_SIZE * sizeof(*seed));
9565 Jim_Free(seed);
9568 /* Generates N bytes of random data */
9569 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
9571 Jim_PrngState *prng;
9572 unsigned char *destByte = (unsigned char *)dest;
9573 unsigned int si, sj, x;
9575 /* initialization, only needed the first time */
9576 if (interp->prngState == NULL)
9577 JimPrngInit(interp);
9578 prng = interp->prngState;
9579 /* generates 'len' bytes of pseudo-random numbers */
9580 for (x = 0; x < len; x++) {
9581 prng->i = (prng->i + 1) & 0xff;
9582 si = prng->sbox[prng->i];
9583 prng->j = (prng->j + si) & 0xff;
9584 sj = prng->sbox[prng->j];
9585 prng->sbox[prng->i] = sj;
9586 prng->sbox[prng->j] = si;
9587 *destByte++ = prng->sbox[(si + sj) & 0xff];
9591 /* Re-seed the generator with user-provided bytes */
9592 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen)
9594 int i;
9595 Jim_PrngState *prng;
9597 /* initialization, only needed the first time */
9598 if (interp->prngState == NULL)
9599 JimPrngInit(interp);
9600 prng = interp->prngState;
9602 /* Set the sbox[i] with i */
9603 for (i = 0; i < 256; i++)
9604 prng->sbox[i] = i;
9605 /* Now use the seed to perform a random permutation of the sbox */
9606 for (i = 0; i < seedLen; i++) {
9607 unsigned char t;
9609 t = prng->sbox[i & 0xFF];
9610 prng->sbox[i & 0xFF] = prng->sbox[seed[i]];
9611 prng->sbox[seed[i]] = t;
9613 prng->i = prng->j = 0;
9615 /* discard at least the first 256 bytes of stream.
9616 * borrow the seed buffer for this
9618 for (i = 0; i < 256; i += seedLen) {
9619 JimRandomBytes(interp, seed, seedLen);
9623 /* [incr] */
9624 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
9626 jim_wide wideValue, increment = 1;
9627 Jim_Obj *intObjPtr;
9629 if (argc != 2 && argc != 3) {
9630 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
9631 return JIM_ERR;
9633 if (argc == 3) {
9634 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
9635 return JIM_ERR;
9637 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
9638 if (!intObjPtr) {
9639 /* Set missing variable to 0 */
9640 wideValue = 0;
9642 else if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK) {
9643 return JIM_ERR;
9645 if (!intObjPtr || Jim_IsShared(intObjPtr)) {
9646 intObjPtr = Jim_NewIntObj(interp, wideValue + increment);
9647 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
9648 Jim_FreeNewObj(interp, intObjPtr);
9649 return JIM_ERR;
9652 else {
9653 /* Can do it the quick way */
9654 Jim_InvalidateStringRep(intObjPtr);
9655 JimWideValue(intObjPtr) = wideValue + increment;
9657 /* The following step is required in order to invalidate the
9658 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
9659 if (argv[1]->typePtr != &variableObjType) {
9660 /* Note that this can't fail since GetVariable already succeeded */
9661 Jim_SetVariable(interp, argv[1], intObjPtr);
9664 Jim_SetResult(interp, intObjPtr);
9665 return JIM_OK;
9669 /* -----------------------------------------------------------------------------
9670 * Eval
9671 * ---------------------------------------------------------------------------*/
9672 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
9673 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
9675 /* Handle calls to the [unknown] command */
9676 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
9678 int retcode;
9680 /* If JimUnknown() is recursively called too many times...
9681 * done here
9683 if (interp->unknown_called > 50) {
9684 return JIM_ERR;
9687 /* The object interp->unknown just contains
9688 * the "unknown" string, it is used in order to
9689 * avoid to lookup the unknown command every time
9690 * but instead to cache the result. */
9692 /* If the [unknown] command does not exist ... */
9693 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
9694 return JIM_ERR;
9696 interp->unknown_called++;
9697 /* XXX: Are we losing fileNameObj and linenr? */
9698 retcode = Jim_EvalObjPrefix(interp, interp->unknown, argc, argv);
9699 interp->unknown_called--;
9701 return retcode;
9704 static int JimInvokeCommand(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
9706 int retcode;
9707 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
9709 if (cmdPtr == NULL) {
9710 return JimUnknown(interp, objc, objv);
9712 if (interp->evalDepth == interp->maxEvalDepth) {
9713 Jim_SetResultString(interp, "Infinite eval recursion", -1);
9714 return JIM_ERR;
9716 interp->evalDepth++;
9718 /* Call it -- Make sure result is an empty object. */
9719 JimIncrCmdRefCount(cmdPtr);
9720 Jim_SetEmptyResult(interp);
9721 if (cmdPtr->isproc) {
9722 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
9724 else {
9725 interp->cmdPrivData = cmdPtr->u.native.privData;
9726 retcode = cmdPtr->u.native.cmdProc(interp, objc, objv);
9728 JimDecrCmdRefCount(interp, cmdPtr);
9729 interp->evalDepth--;
9731 return retcode;
9734 /* Eval the object vector 'objv' composed of 'objc' elements.
9735 * Every element is used as single argument.
9736 * Jim_EvalObj() will call this function every time its object
9737 * argument is of "list" type, with no string representation.
9739 * This is possible because the string representation of a
9740 * list object generated by the UpdateStringOfList is made
9741 * in a way that ensures that every list element is a different
9742 * command argument. */
9743 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
9745 int i, retcode;
9747 /* Incr refcount of arguments. */
9748 for (i = 0; i < objc; i++)
9749 Jim_IncrRefCount(objv[i]);
9751 retcode = JimInvokeCommand(interp, objc, objv);
9753 /* Decr refcount of arguments and return the retcode */
9754 for (i = 0; i < objc; i++)
9755 Jim_DecrRefCount(interp, objv[i]);
9757 return retcode;
9761 * Invokes 'prefix' as a command with the objv array as arguments.
9763 int Jim_EvalObjPrefix(Jim_Interp *interp, Jim_Obj *prefix, int objc, Jim_Obj *const *objv)
9765 int ret;
9766 Jim_Obj **nargv = Jim_Alloc((objc + 1) * sizeof(*nargv));
9768 nargv[0] = prefix;
9769 memcpy(&nargv[1], &objv[0], sizeof(nargv[0]) * objc);
9770 ret = Jim_EvalObjVector(interp, objc + 1, nargv);
9771 Jim_Free(nargv);
9772 return ret;
9775 static void JimAddErrorToStack(Jim_Interp *interp, int retcode, ScriptObj *script)
9777 int rc = retcode;
9779 if (rc == JIM_ERR && !interp->errorFlag) {
9780 /* This is the first error, so save the file/line information and reset the stack */
9781 interp->errorFlag = 1;
9782 Jim_IncrRefCount(script->fileNameObj);
9783 Jim_DecrRefCount(interp, interp->errorFileNameObj);
9784 interp->errorFileNameObj = script->fileNameObj;
9785 interp->errorLine = script->linenr;
9787 JimResetStackTrace(interp);
9788 /* Always add a level where the error first occurs */
9789 interp->addStackTrace++;
9792 /* Now if this is an "interesting" level, add it to the stack trace */
9793 if (rc == JIM_ERR && interp->addStackTrace > 0) {
9794 /* Add the stack info for the current level */
9796 JimAppendStackTrace(interp, Jim_String(interp->errorProc), script->fileNameObj, script->linenr);
9798 /* Note: if we didn't have a filename for this level,
9799 * don't clear the addStackTrace flag
9800 * so we can pick it up at the next level
9802 if (Jim_Length(script->fileNameObj)) {
9803 interp->addStackTrace = 0;
9806 Jim_DecrRefCount(interp, interp->errorProc);
9807 interp->errorProc = interp->emptyObj;
9808 Jim_IncrRefCount(interp->errorProc);
9810 else if (rc == JIM_RETURN && interp->returnCode == JIM_ERR) {
9811 /* Propagate the addStackTrace value through 'return -code error' */
9813 else {
9814 interp->addStackTrace = 0;
9818 static int JimSubstOneToken(Jim_Interp *interp, const ScriptToken *token, Jim_Obj **objPtrPtr)
9820 Jim_Obj *objPtr;
9822 switch (token->type) {
9823 case JIM_TT_STR:
9824 case JIM_TT_ESC:
9825 objPtr = token->objPtr;
9826 break;
9827 case JIM_TT_VAR:
9828 objPtr = Jim_GetVariable(interp, token->objPtr, JIM_ERRMSG);
9829 break;
9830 case JIM_TT_DICTSUGAR:
9831 objPtr = JimExpandDictSugar(interp, token->objPtr);
9832 break;
9833 case JIM_TT_EXPRSUGAR:
9834 objPtr = JimExpandExprSugar(interp, token->objPtr);
9835 break;
9836 case JIM_TT_CMD:
9837 switch (Jim_EvalObj(interp, token->objPtr)) {
9838 case JIM_OK:
9839 case JIM_RETURN:
9840 objPtr = interp->result;
9841 break;
9842 case JIM_BREAK:
9843 /* Stop substituting */
9844 return JIM_BREAK;
9845 case JIM_CONTINUE:
9846 /* just skip this one */
9847 return JIM_CONTINUE;
9848 default:
9849 return JIM_ERR;
9851 break;
9852 default:
9853 JimPanic((1,
9854 "default token type (%d) reached " "in Jim_SubstObj().", token->type));
9855 objPtr = NULL;
9856 break;
9858 if (objPtr) {
9859 *objPtrPtr = objPtr;
9860 return JIM_OK;
9862 return JIM_ERR;
9865 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
9866 * via *objPtrPtr. This function is only called by Jim_EvalObj() and Jim_SubstObj()
9867 * The returned object has refcount = 0.
9869 static Jim_Obj *JimInterpolateTokens(Jim_Interp *interp, const ScriptToken * token, int tokens, int flags)
9871 int totlen = 0, i;
9872 Jim_Obj **intv;
9873 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
9874 Jim_Obj *objPtr;
9875 char *s;
9877 if (tokens <= JIM_EVAL_SINTV_LEN)
9878 intv = sintv;
9879 else
9880 intv = Jim_Alloc(sizeof(Jim_Obj *) * tokens);
9882 /* Compute every token forming the argument
9883 * in the intv objects vector. */
9884 for (i = 0; i < tokens; i++) {
9885 switch (JimSubstOneToken(interp, &token[i], &intv[i])) {
9886 case JIM_OK:
9887 case JIM_RETURN:
9888 break;
9889 case JIM_BREAK:
9890 if (flags & JIM_SUBST_FLAG) {
9891 /* Stop here */
9892 tokens = i;
9893 continue;
9895 /* XXX: Should probably set an error about break outside loop */
9896 /* fall through to error */
9897 case JIM_CONTINUE:
9898 if (flags & JIM_SUBST_FLAG) {
9899 intv[i] = NULL;
9900 continue;
9902 /* XXX: Ditto continue outside loop */
9903 /* fall through to error */
9904 default:
9905 while (i--) {
9906 Jim_DecrRefCount(interp, intv[i]);
9908 if (intv != sintv) {
9909 Jim_Free(intv);
9911 return NULL;
9913 Jim_IncrRefCount(intv[i]);
9914 Jim_String(intv[i]);
9915 totlen += intv[i]->length;
9918 /* Fast path return for a single token */
9919 if (tokens == 1 && intv[0] && intv == sintv) {
9920 Jim_DecrRefCount(interp, intv[0]);
9921 return intv[0];
9924 /* Concatenate every token in an unique
9925 * object. */
9926 objPtr = Jim_NewStringObjNoAlloc(interp, NULL, 0);
9928 if (tokens == 4 && token[0].type == JIM_TT_ESC && token[1].type == JIM_TT_ESC
9929 && token[2].type == JIM_TT_VAR) {
9930 /* May be able to do fast interpolated object -> dictSubst */
9931 objPtr->typePtr = &interpolatedObjType;
9932 objPtr->internalRep.dictSubstValue.varNameObjPtr = token[0].objPtr;
9933 objPtr->internalRep.dictSubstValue.indexObjPtr = intv[2];
9934 Jim_IncrRefCount(intv[2]);
9937 s = objPtr->bytes = Jim_Alloc(totlen + 1);
9938 objPtr->length = totlen;
9939 for (i = 0; i < tokens; i++) {
9940 if (intv[i]) {
9941 memcpy(s, intv[i]->bytes, intv[i]->length);
9942 s += intv[i]->length;
9943 Jim_DecrRefCount(interp, intv[i]);
9946 objPtr->bytes[totlen] = '\0';
9947 /* Free the intv vector if not static. */
9948 if (intv != sintv) {
9949 Jim_Free(intv);
9952 return objPtr;
9956 /* listPtr *must* be a list.
9957 * The contents of the list is evaluated with the first element as the command and
9958 * the remaining elements as the arguments.
9960 static int JimEvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
9962 int retcode = JIM_OK;
9964 if (listPtr->internalRep.listValue.len) {
9965 Jim_IncrRefCount(listPtr);
9966 retcode = JimInvokeCommand(interp,
9967 listPtr->internalRep.listValue.len,
9968 listPtr->internalRep.listValue.ele);
9969 Jim_DecrRefCount(interp, listPtr);
9971 return retcode;
9974 int Jim_EvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
9976 SetListFromAny(interp, listPtr);
9977 return JimEvalObjList(interp, listPtr);
9980 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
9982 int i;
9983 ScriptObj *script;
9984 ScriptToken *token;
9985 int retcode = JIM_OK;
9986 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL;
9987 Jim_Obj *prevScriptObj;
9989 /* If the object is of type "list", with no string rep we can call
9990 * a specialized version of Jim_EvalObj() */
9991 if (Jim_IsList(scriptObjPtr) && scriptObjPtr->bytes == NULL) {
9992 return JimEvalObjList(interp, scriptObjPtr);
9995 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
9996 script = Jim_GetScript(interp, scriptObjPtr);
9998 /* Reset the interpreter result. This is useful to
9999 * return the empty result in the case of empty program. */
10000 Jim_SetEmptyResult(interp);
10002 token = script->token;
10004 #ifdef JIM_OPTIMIZATION
10005 /* Check for one of the following common scripts used by for, while
10007 * {}
10008 * incr a
10010 if (script->len == 0) {
10011 Jim_DecrRefCount(interp, scriptObjPtr);
10012 return JIM_OK;
10014 if (script->len == 3
10015 && token[1].objPtr->typePtr == &commandObjType
10016 && token[1].objPtr->internalRep.cmdValue.cmdPtr->isproc == 0
10017 && token[1].objPtr->internalRep.cmdValue.cmdPtr->u.native.cmdProc == Jim_IncrCoreCommand
10018 && token[2].objPtr->typePtr == &variableObjType) {
10020 Jim_Obj *objPtr = Jim_GetVariable(interp, token[2].objPtr, JIM_NONE);
10022 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
10023 JimWideValue(objPtr)++;
10024 Jim_InvalidateStringRep(objPtr);
10025 Jim_DecrRefCount(interp, scriptObjPtr);
10026 Jim_SetResult(interp, objPtr);
10027 return JIM_OK;
10030 #endif
10032 /* Now we have to make sure the internal repr will not be
10033 * freed on shimmering.
10035 * Think for example to this:
10037 * set x {llength $x; ... some more code ...}; eval $x
10039 * In order to preserve the internal rep, we increment the
10040 * inUse field of the script internal rep structure. */
10041 script->inUse++;
10043 /* Stash the current script */
10044 prevScriptObj = interp->currentScriptObj;
10045 interp->currentScriptObj = scriptObjPtr;
10047 interp->errorFlag = 0;
10048 argv = sargv;
10050 /* Execute every command sequentially until the end of the script
10051 * or an error occurs.
10053 for (i = 0; i < script->len && retcode == JIM_OK; ) {
10054 int argc;
10055 int j;
10057 /* First token of the line is always JIM_TT_LINE */
10058 argc = token[i].objPtr->internalRep.scriptLineValue.argc;
10059 script->linenr = token[i].objPtr->internalRep.scriptLineValue.line;
10061 /* Allocate the arguments vector if required */
10062 if (argc > JIM_EVAL_SARGV_LEN)
10063 argv = Jim_Alloc(sizeof(Jim_Obj *) * argc);
10065 /* Skip the JIM_TT_LINE token */
10066 i++;
10068 /* Populate the arguments objects.
10069 * If an error occurs, retcode will be set and
10070 * 'j' will be set to the number of args expanded
10072 for (j = 0; j < argc; j++) {
10073 long wordtokens = 1;
10074 int expand = 0;
10075 Jim_Obj *wordObjPtr = NULL;
10077 if (token[i].type == JIM_TT_WORD) {
10078 wordtokens = JimWideValue(token[i++].objPtr);
10079 if (wordtokens < 0) {
10080 expand = 1;
10081 wordtokens = -wordtokens;
10085 if (wordtokens == 1) {
10086 /* Fast path if the token does not
10087 * need interpolation */
10089 switch (token[i].type) {
10090 case JIM_TT_ESC:
10091 case JIM_TT_STR:
10092 wordObjPtr = token[i].objPtr;
10093 break;
10094 case JIM_TT_VAR:
10095 wordObjPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
10096 break;
10097 case JIM_TT_EXPRSUGAR:
10098 wordObjPtr = JimExpandExprSugar(interp, token[i].objPtr);
10099 break;
10100 case JIM_TT_DICTSUGAR:
10101 wordObjPtr = JimExpandDictSugar(interp, token[i].objPtr);
10102 break;
10103 case JIM_TT_CMD:
10104 retcode = Jim_EvalObj(interp, token[i].objPtr);
10105 if (retcode == JIM_OK) {
10106 wordObjPtr = Jim_GetResult(interp);
10108 break;
10109 default:
10110 JimPanic((1, "default token type reached " "in Jim_EvalObj()."));
10113 else {
10114 /* For interpolation we call a helper
10115 * function to do the work for us. */
10116 wordObjPtr = JimInterpolateTokens(interp, token + i, wordtokens, JIM_NONE);
10119 if (!wordObjPtr) {
10120 if (retcode == JIM_OK) {
10121 retcode = JIM_ERR;
10123 break;
10126 Jim_IncrRefCount(wordObjPtr);
10127 i += wordtokens;
10129 if (!expand) {
10130 argv[j] = wordObjPtr;
10132 else {
10133 /* Need to expand wordObjPtr into multiple args from argv[j] ... */
10134 int len = Jim_ListLength(interp, wordObjPtr);
10135 int newargc = argc + len - 1;
10136 int k;
10138 if (len > 1) {
10139 if (argv == sargv) {
10140 if (newargc > JIM_EVAL_SARGV_LEN) {
10141 argv = Jim_Alloc(sizeof(*argv) * newargc);
10142 memcpy(argv, sargv, sizeof(*argv) * j);
10145 else {
10146 /* Need to realloc to make room for (len - 1) more entries */
10147 argv = Jim_Realloc(argv, sizeof(*argv) * newargc);
10151 /* Now copy in the expanded version */
10152 for (k = 0; k < len; k++) {
10153 argv[j++] = wordObjPtr->internalRep.listValue.ele[k];
10154 Jim_IncrRefCount(wordObjPtr->internalRep.listValue.ele[k]);
10157 /* The original object reference is no longer needed,
10158 * after the expansion it is no longer present on
10159 * the argument vector, but the single elements are
10160 * in its place. */
10161 Jim_DecrRefCount(interp, wordObjPtr);
10163 /* And update the indexes */
10164 j--;
10165 argc += len - 1;
10169 if (retcode == JIM_OK && argc) {
10170 /* Invoke the command */
10171 retcode = JimInvokeCommand(interp, argc, argv);
10172 if (interp->signal_level && interp->sigmask) {
10173 /* Check for a signal after each command */
10174 retcode = JIM_SIGNAL;
10178 /* Finished with the command, so decrement ref counts of each argument */
10179 while (j-- > 0) {
10180 Jim_DecrRefCount(interp, argv[j]);
10183 if (argv != sargv) {
10184 Jim_Free(argv);
10185 argv = sargv;
10189 /* Possibly add to the error stack trace */
10190 JimAddErrorToStack(interp, retcode, script);
10192 /* Restore the current script */
10193 interp->currentScriptObj = prevScriptObj;
10195 /* Note that we don't have to decrement inUse, because the
10196 * following code transfers our use of the reference again to
10197 * the script object. */
10198 Jim_FreeIntRep(interp, scriptObjPtr);
10199 scriptObjPtr->typePtr = &scriptObjType;
10200 Jim_SetIntRepPtr(scriptObjPtr, script);
10201 Jim_DecrRefCount(interp, scriptObjPtr);
10203 return retcode;
10206 static int JimSetProcArg(Jim_Interp *interp, Jim_Obj *argNameObj, Jim_Obj *argValObj)
10208 int retcode;
10209 /* If argObjPtr begins with '&', do an automatic upvar */
10210 const char *varname = Jim_String(argNameObj);
10211 if (*varname == '&') {
10212 /* First check that the target variable exists */
10213 Jim_Obj *objPtr;
10214 Jim_CallFrame *savedCallFrame = interp->framePtr;
10216 interp->framePtr = interp->framePtr->parent;
10217 objPtr = Jim_GetVariable(interp, argValObj, JIM_ERRMSG);
10218 interp->framePtr = savedCallFrame;
10219 if (!objPtr) {
10220 return JIM_ERR;
10223 /* It exists, so perform the binding. */
10224 objPtr = Jim_NewStringObj(interp, varname + 1, -1);
10225 Jim_IncrRefCount(objPtr);
10226 retcode = Jim_SetVariableLink(interp, objPtr, argValObj, interp->framePtr->parent);
10227 Jim_DecrRefCount(interp, objPtr);
10229 else {
10230 retcode = Jim_SetVariable(interp, argNameObj, argValObj);
10232 return retcode;
10236 * Sets the interp result to be an error message indicating the required proc args.
10238 static void JimSetProcWrongArgs(Jim_Interp *interp, Jim_Obj *procNameObj, Jim_Cmd *cmd)
10240 /* Create a nice error message, consistent with Tcl 8.5 */
10241 Jim_Obj *argmsg = Jim_NewStringObj(interp, "", 0);
10242 int i;
10244 if (interp->rewriteNameObj) {
10245 procNameObj = interp->rewriteNameObj;
10248 for (i = 0; i < cmd->u.proc.argListLen; i++) {
10249 Jim_AppendString(interp, argmsg, " ", 1);
10251 if (i == cmd->u.proc.argsPos) {
10252 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10253 /* Renamed args */
10254 Jim_AppendString(interp, argmsg, "?", 1);
10255 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].defaultObjPtr);
10256 Jim_AppendString(interp, argmsg, " ...?", -1);
10258 else {
10259 /* We have plain args */
10260 Jim_AppendString(interp, argmsg, "?arg...?", -1);
10263 else {
10264 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10265 Jim_AppendString(interp, argmsg, "?", 1);
10266 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].nameObjPtr);
10267 Jim_AppendString(interp, argmsg, "?", 1);
10269 else {
10270 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].nameObjPtr);
10274 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s%#s\"", procNameObj, argmsg);
10275 Jim_FreeNewObj(interp, argmsg);
10278 /* Call a procedure implemented in Tcl.
10279 * It's possible to speed-up a lot this function, currently
10280 * the callframes are not cached, but allocated and
10281 * destroied every time. What is expecially costly is
10282 * to create/destroy the local vars hash table every time.
10284 * This can be fixed just implementing callframes caching
10285 * in JimCreateCallFrame() and JimFreeCallFrame(). */
10286 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv)
10288 Jim_CallFrame *callFramePtr;
10289 int i, d, retcode, optargs;
10290 Jim_Stack *localCommands;
10291 ScriptObj *script;
10293 /* Check arity */
10294 if (argc - 1 < cmd->u.proc.reqArity ||
10295 (cmd->u.proc.argsPos < 0 && argc - 1 > cmd->u.proc.reqArity + cmd->u.proc.optArity)) {
10296 JimSetProcWrongArgs(interp, argv[0], cmd);
10297 return JIM_ERR;
10300 /* Check if there are too nested calls */
10301 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10302 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10303 return JIM_ERR;
10306 /* Create a new callframe */
10307 callFramePtr = JimCreateCallFrame(interp, interp->framePtr);
10308 callFramePtr->argv = argv;
10309 callFramePtr->argc = argc;
10310 callFramePtr->procArgsObjPtr = cmd->u.proc.argListObjPtr;
10311 callFramePtr->procBodyObjPtr = cmd->u.proc.bodyObjPtr;
10312 callFramePtr->staticVars = cmd->u.proc.staticVars;
10314 /* Remember where we were called from. */
10315 script = Jim_GetScript(interp, interp->currentScriptObj);
10316 callFramePtr->fileNameObj = script->fileNameObj;
10317 callFramePtr->line = script->linenr;
10319 Jim_IncrRefCount(cmd->u.proc.argListObjPtr);
10320 Jim_IncrRefCount(cmd->u.proc.bodyObjPtr);
10321 interp->framePtr = callFramePtr;
10323 /* How many optional args are available */
10324 optargs = (argc - 1 - cmd->u.proc.reqArity);
10326 /* Step 'i' along the actual args, and step 'd' along the formal args */
10327 i = 1;
10328 for (d = 0; d < cmd->u.proc.argListLen; d++) {
10329 Jim_Obj *nameObjPtr = cmd->u.proc.arglist[d].nameObjPtr;
10330 if (d == cmd->u.proc.argsPos) {
10331 /* assign $args */
10332 Jim_Obj *listObjPtr;
10333 int argsLen = 0;
10334 if (cmd->u.proc.reqArity + cmd->u.proc.optArity < argc - 1) {
10335 argsLen = argc - 1 - (cmd->u.proc.reqArity + cmd->u.proc.optArity);
10337 listObjPtr = Jim_NewListObj(interp, &argv[i], argsLen);
10339 /* It is possible to rename args. */
10340 if (cmd->u.proc.arglist[d].defaultObjPtr) {
10341 nameObjPtr =cmd->u.proc.arglist[d].defaultObjPtr;
10343 retcode = Jim_SetVariable(interp, nameObjPtr, listObjPtr);
10344 if (retcode != JIM_OK) {
10345 goto badargset;
10348 i += argsLen;
10349 continue;
10352 /* Optional or required? */
10353 if (cmd->u.proc.arglist[d].defaultObjPtr == NULL || optargs-- > 0) {
10354 retcode = JimSetProcArg(interp, nameObjPtr, argv[i++]);
10356 else {
10357 /* Ran out, so use the default */
10358 retcode = Jim_SetVariable(interp, nameObjPtr, cmd->u.proc.arglist[d].defaultObjPtr);
10360 if (retcode != JIM_OK) {
10361 goto badargset;
10365 /* Eval the body */
10366 retcode = Jim_EvalObj(interp, cmd->u.proc.bodyObjPtr);
10368 badargset:
10369 /* Destroy the callframe */
10370 /* But first remove the local commands */
10371 localCommands = callFramePtr->localCommands;
10372 callFramePtr->localCommands = NULL;
10374 interp->framePtr = interp->framePtr->parent;
10375 if (callFramePtr->vars.size != JIM_HT_INITIAL_SIZE) {
10376 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NONE);
10378 else {
10379 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NOHT);
10382 /* Handle the JIM_EVAL return code */
10383 while (retcode == JIM_EVAL) {
10384 Jim_Obj *resultScriptObjPtr = Jim_GetResult(interp);
10386 Jim_IncrRefCount(resultScriptObjPtr);
10387 /* Result must be a list */
10388 JimPanic((!Jim_IsList(resultScriptObjPtr), "tailcall (JIM_EVAL) returned non-list"));
10390 retcode = JimEvalObjList(interp, resultScriptObjPtr);
10391 if (retcode == JIM_RETURN) {
10392 /* If the result of the tailcall invokes 'return', push
10393 * it up to the caller
10395 interp->returnLevel++;
10397 Jim_DecrRefCount(interp, resultScriptObjPtr);
10399 /* Handle the JIM_RETURN return code */
10400 if (retcode == JIM_RETURN) {
10401 if (--interp->returnLevel <= 0) {
10402 retcode = interp->returnCode;
10403 interp->returnCode = JIM_OK;
10404 interp->returnLevel = 0;
10407 else if (retcode == JIM_ERR) {
10408 interp->addStackTrace++;
10409 Jim_DecrRefCount(interp, interp->errorProc);
10410 interp->errorProc = argv[0];
10411 Jim_IncrRefCount(interp->errorProc);
10414 /* Finally delete local procs */
10415 JimDeleteLocalProcs(interp, localCommands);
10417 return retcode;
10420 int Jim_EvalSource(Jim_Interp *interp, const char *filename, int lineno, const char *script)
10422 int retval;
10423 Jim_Obj *scriptObjPtr;
10425 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
10426 Jim_IncrRefCount(scriptObjPtr);
10428 if (filename) {
10429 Jim_Obj *prevScriptObj;
10431 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), lineno);
10433 prevScriptObj = interp->currentScriptObj;
10434 interp->currentScriptObj = scriptObjPtr;
10436 retval = Jim_EvalObj(interp, scriptObjPtr);
10438 interp->currentScriptObj = prevScriptObj;
10440 else {
10441 retval = Jim_EvalObj(interp, scriptObjPtr);
10443 Jim_DecrRefCount(interp, scriptObjPtr);
10444 return retval;
10447 int Jim_Eval(Jim_Interp *interp, const char *script)
10449 return Jim_EvalObj(interp, Jim_NewStringObj(interp, script, -1));
10452 /* Execute script in the scope of the global level */
10453 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
10455 int retval;
10456 Jim_CallFrame *savedFramePtr = interp->framePtr;
10458 interp->framePtr = interp->topFramePtr;
10459 retval = Jim_Eval(interp, script);
10460 interp->framePtr = savedFramePtr;
10462 return retval;
10465 int Jim_EvalFileGlobal(Jim_Interp *interp, const char *filename)
10467 int retval;
10468 Jim_CallFrame *savedFramePtr = interp->framePtr;
10470 interp->framePtr = interp->topFramePtr;
10471 retval = Jim_EvalFile(interp, filename);
10472 interp->framePtr = savedFramePtr;
10474 return retval;
10477 #include <sys/stat.h>
10479 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
10481 FILE *fp;
10482 char *buf;
10483 Jim_Obj *scriptObjPtr;
10484 Jim_Obj *prevScriptObj;
10485 struct stat sb;
10486 int retcode;
10487 int readlen;
10488 struct JimParseResult result;
10490 if (stat(filename, &sb) != 0 || (fp = fopen(filename, "rt")) == NULL) {
10491 Jim_SetResultFormatted(interp, "couldn't read file \"%s\": %s", filename, strerror(errno));
10492 return JIM_ERR;
10494 if (sb.st_size == 0) {
10495 fclose(fp);
10496 return JIM_OK;
10499 buf = Jim_Alloc(sb.st_size + 1);
10500 readlen = fread(buf, 1, sb.st_size, fp);
10501 if (ferror(fp)) {
10502 fclose(fp);
10503 Jim_Free(buf);
10504 Jim_SetResultFormatted(interp, "failed to load file \"%s\": %s", filename, strerror(errno));
10505 return JIM_ERR;
10507 fclose(fp);
10508 buf[readlen] = 0;
10510 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, buf, readlen);
10511 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), 1);
10512 Jim_IncrRefCount(scriptObjPtr);
10514 /* Now check the script for unmatched braces, etc. */
10515 if (SetScriptFromAny(interp, scriptObjPtr, &result) == JIM_ERR) {
10516 const char *msg;
10517 char linebuf[20];
10519 switch (result.missing) {
10520 case '[':
10521 msg = "unmatched \"[\"";
10522 break;
10523 case '{':
10524 msg = "missing close-brace";
10525 break;
10526 case '"':
10527 default:
10528 msg = "missing quote";
10529 break;
10532 snprintf(linebuf, sizeof(linebuf), "%d", result.line);
10534 Jim_SetResultFormatted(interp, "%s in \"%s\" at line %s",
10535 msg, filename, linebuf);
10536 Jim_DecrRefCount(interp, scriptObjPtr);
10537 return JIM_ERR;
10540 prevScriptObj = interp->currentScriptObj;
10541 interp->currentScriptObj = scriptObjPtr;
10543 retcode = Jim_EvalObj(interp, scriptObjPtr);
10545 /* Handle the JIM_RETURN return code */
10546 if (retcode == JIM_RETURN) {
10547 if (--interp->returnLevel <= 0) {
10548 retcode = interp->returnCode;
10549 interp->returnCode = JIM_OK;
10550 interp->returnLevel = 0;
10553 if (retcode == JIM_ERR) {
10554 /* EvalFile changes context, so add a stack frame here */
10555 interp->addStackTrace++;
10558 interp->currentScriptObj = prevScriptObj;
10560 Jim_DecrRefCount(interp, scriptObjPtr);
10562 return retcode;
10565 /* -----------------------------------------------------------------------------
10566 * Subst
10567 * ---------------------------------------------------------------------------*/
10568 static int JimParseSubstStr(struct JimParserCtx *pc)
10570 pc->tstart = pc->p;
10571 pc->tline = pc->linenr;
10572 while (pc->len && *pc->p != '$' && *pc->p != '[') {
10573 if (*pc->p == '\\' && pc->len > 1) {
10574 pc->p++;
10575 pc->len--;
10577 pc->p++;
10578 pc->len--;
10580 pc->tend = pc->p - 1;
10581 pc->tt = JIM_TT_ESC;
10582 return JIM_OK;
10585 static int JimParseSubst(struct JimParserCtx *pc, int flags)
10587 int retval;
10589 if (pc->len == 0) {
10590 pc->tstart = pc->tend = pc->p;
10591 pc->tline = pc->linenr;
10592 pc->tt = JIM_TT_EOL;
10593 pc->eof = 1;
10594 return JIM_OK;
10596 switch (*pc->p) {
10597 case '[':
10598 retval = JimParseCmd(pc);
10599 if (flags & JIM_SUBST_NOCMD) {
10600 pc->tstart--;
10601 pc->tend++;
10602 pc->tt = (flags & JIM_SUBST_NOESC) ? JIM_TT_STR : JIM_TT_ESC;
10604 return retval;
10605 break;
10606 case '$':
10607 if (JimParseVar(pc) == JIM_ERR) {
10608 pc->tstart = pc->tend = pc->p++;
10609 pc->len--;
10610 pc->tline = pc->linenr;
10611 pc->tt = JIM_TT_STR;
10613 else {
10614 if (flags & JIM_SUBST_NOVAR) {
10615 pc->tstart--;
10616 if (flags & JIM_SUBST_NOESC)
10617 pc->tt = JIM_TT_STR;
10618 else
10619 pc->tt = JIM_TT_ESC;
10620 if (*pc->tstart == '{') {
10621 pc->tstart--;
10622 if (*(pc->tend + 1))
10623 pc->tend++;
10627 break;
10628 default:
10629 retval = JimParseSubstStr(pc);
10630 if (flags & JIM_SUBST_NOESC)
10631 pc->tt = JIM_TT_STR;
10632 return retval;
10633 break;
10635 return JIM_OK;
10638 /* The subst object type reuses most of the data structures and functions
10639 * of the script object. Script's data structures are a bit more complex
10640 * for what is needed for [subst]itution tasks, but the reuse helps to
10641 * deal with a single data structure at the cost of some more memory
10642 * usage for substitutions. */
10644 /* This method takes the string representation of an object
10645 * as a Tcl string where to perform [subst]itution, and generates
10646 * the pre-parsed internal representation. */
10647 static int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
10649 int scriptTextLen;
10650 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
10651 struct JimParserCtx parser;
10652 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
10653 ParseTokenList tokenlist;
10655 /* Initially parse the subst into tokens (in tokenlist) */
10656 ScriptTokenListInit(&tokenlist);
10658 JimParserInit(&parser, scriptText, scriptTextLen, 1);
10659 while (1) {
10660 JimParseSubst(&parser, flags);
10661 if (parser.eof) {
10662 /* Note that subst doesn't need the EOL token */
10663 break;
10665 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
10666 parser.tline);
10669 /* Create the "real" subst/script tokens from the initial token list */
10670 script->inUse = 1;
10671 script->substFlags = flags;
10672 script->fileNameObj = interp->emptyObj;
10673 Jim_IncrRefCount(script->fileNameObj);
10674 SubstObjAddTokens(interp, script, &tokenlist);
10676 /* No longer need the token list */
10677 ScriptTokenListFree(&tokenlist);
10679 #ifdef DEBUG_SHOW_SUBST
10681 int i;
10683 printf("==== Subst ====\n");
10684 for (i = 0; i < script->len; i++) {
10685 printf("[%2d] %s '%s'\n", i, jim_tt_name(script->token[i].type),
10686 Jim_String(script->token[i].objPtr));
10689 #endif
10691 /* Free the old internal rep and set the new one. */
10692 Jim_FreeIntRep(interp, objPtr);
10693 Jim_SetIntRepPtr(objPtr, script);
10694 objPtr->typePtr = &scriptObjType;
10695 return JIM_OK;
10698 static ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
10700 if (objPtr->typePtr != &scriptObjType || ((ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags != flags)
10701 SetSubstFromAny(interp, objPtr, flags);
10702 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
10705 /* Performs commands,variables,blackslashes substitution,
10706 * storing the result object (with refcount 0) into
10707 * resObjPtrPtr. */
10708 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr, Jim_Obj **resObjPtrPtr, int flags)
10710 ScriptObj *script = Jim_GetSubst(interp, substObjPtr, flags);
10712 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
10713 /* In order to preserve the internal rep, we increment the
10714 * inUse field of the script internal rep structure. */
10715 script->inUse++;
10717 *resObjPtrPtr = JimInterpolateTokens(interp, script->token, script->len, flags);
10719 script->inUse--;
10720 Jim_DecrRefCount(interp, substObjPtr);
10721 if (*resObjPtrPtr == NULL) {
10722 return JIM_ERR;
10724 return JIM_OK;
10727 /* -----------------------------------------------------------------------------
10728 * Core commands utility functions
10729 * ---------------------------------------------------------------------------*/
10730 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv, const char *msg)
10732 Jim_Obj *objPtr;
10733 Jim_Obj *listObjPtr;
10735 if (interp->rewriteNameObj) {
10736 argc -= interp->rewriteNameCount;
10737 argv += interp->rewriteNameCount;
10738 listObjPtr = Jim_NewListObj(interp, &interp->rewriteNameObj, 1);
10739 ListInsertElements(listObjPtr, -1, argc, argv);
10741 else {
10742 listObjPtr = Jim_NewListObj(interp, argv, argc);
10744 if (*msg) {
10745 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, msg, -1));
10747 Jim_IncrRefCount(listObjPtr);
10748 objPtr = Jim_ListJoin(interp, listObjPtr, " ", 1);
10749 Jim_DecrRefCount(interp, listObjPtr);
10751 Jim_IncrRefCount(objPtr);
10752 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s\"", objPtr);
10753 Jim_DecrRefCount(interp, objPtr);
10757 * May add the key and/or value to the list.
10759 typedef void JimHashtableIteratorCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr,
10760 Jim_HashEntry *he, int type);
10762 #define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL)
10765 * For each key of the hash table 'ht' (with string keys) which matches the glob pattern (all if NULL),
10766 * invoke the callback to add entries to a list.
10767 * Returns the list.
10769 static Jim_Obj *JimHashtablePatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
10770 JimHashtableIteratorCallbackType *callback, int type)
10772 Jim_HashEntry *he;
10773 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
10775 /* Check for the non-pattern case. We can do this much more efficiently. */
10776 if (patternObjPtr && JimTrivialMatch(Jim_String(patternObjPtr))) {
10777 he = Jim_FindHashEntry(ht, Jim_String(patternObjPtr));
10778 if (he) {
10779 callback(interp, listObjPtr, he, type);
10782 else {
10783 Jim_HashTableIterator *htiter = Jim_GetHashTableIterator(ht);
10784 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
10785 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), he->key, 0)) {
10786 callback(interp, listObjPtr, he, type);
10789 Jim_FreeHashTableIterator(htiter);
10791 return listObjPtr;
10794 /* Keep these in order */
10795 #define JIM_CMDLIST_COMMANDS 0
10796 #define JIM_CMDLIST_PROCS 1
10797 #define JIM_CMDLIST_CHANNELS 2
10800 * Adds matching command names (procs, channels) to the list.
10802 static void JimCommandMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
10803 Jim_HashEntry *he, int type)
10805 Jim_Cmd *cmdPtr = (Jim_Cmd *)he->u.val;
10806 Jim_Obj *objPtr;
10808 if (type == JIM_CMDLIST_PROCS && !cmdPtr->isproc) {
10809 /* not a proc */
10810 return;
10813 objPtr = Jim_NewStringObj(interp, he->key, -1);
10814 Jim_IncrRefCount(objPtr);
10816 if (type != JIM_CMDLIST_CHANNELS || Jim_AioFilehandle(interp, objPtr)) {
10817 Jim_ListAppendElement(interp, listObjPtr, objPtr);
10819 Jim_DecrRefCount(interp, objPtr);
10822 /* type is JIM_CMDLIST_xxx */
10823 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int type)
10825 return JimHashtablePatternMatch(interp, &interp->commands, patternObjPtr, JimCommandMatch, type);
10828 /* Keep these in order */
10829 #define JIM_VARLIST_GLOBALS 0
10830 #define JIM_VARLIST_LOCALS 1
10831 #define JIM_VARLIST_VARS 2
10833 #define JIM_VARLIST_VALUES 0x1000
10836 * Adds matching variable names to the list.
10838 static void JimVariablesMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
10839 Jim_HashEntry *he, int type)
10841 Jim_Var *varPtr = (Jim_Var *)he->u.val;
10843 if (type != JIM_VARLIST_LOCALS || varPtr->linkFramePtr == NULL) {
10844 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, he->key, -1));
10845 if (type & JIM_VARLIST_VALUES) {
10846 Jim_ListAppendElement(interp, listObjPtr, varPtr->objPtr);
10851 /* mode is JIM_VARLIST_xxx */
10852 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int mode)
10854 if (mode == JIM_VARLIST_LOCALS && interp->framePtr == interp->topFramePtr) {
10855 /* For [info locals], if we are at top level an emtpy list
10856 * is returned. I don't agree, but we aim at compatibility (SS) */
10857 return interp->emptyObj;
10859 else {
10860 Jim_CallFrame *framePtr = (mode == JIM_VARLIST_GLOBALS) ? interp->topFramePtr : interp->framePtr;
10861 return JimHashtablePatternMatch(interp, &framePtr->vars, patternObjPtr, JimVariablesMatch, mode);
10865 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
10866 Jim_Obj **objPtrPtr, int info_level_cmd)
10868 Jim_CallFrame *targetCallFrame;
10870 targetCallFrame = JimGetCallFrameByInteger(interp, levelObjPtr);
10871 if (targetCallFrame == NULL) {
10872 return JIM_ERR;
10874 /* No proc call at toplevel callframe */
10875 if (targetCallFrame == interp->topFramePtr) {
10876 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
10877 return JIM_ERR;
10879 if (info_level_cmd) {
10880 *objPtrPtr = Jim_NewListObj(interp, targetCallFrame->argv, targetCallFrame->argc);
10882 else {
10883 Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0);
10885 Jim_ListAppendElement(interp, listObj, targetCallFrame->argv[0]);
10886 Jim_ListAppendElement(interp, listObj, targetCallFrame->fileNameObj);
10887 Jim_ListAppendElement(interp, listObj, Jim_NewIntObj(interp, targetCallFrame->line));
10888 *objPtrPtr = listObj;
10890 return JIM_OK;
10893 /* -----------------------------------------------------------------------------
10894 * Core commands
10895 * ---------------------------------------------------------------------------*/
10897 /* fake [puts] -- not the real puts, just for debugging. */
10898 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10900 if (argc != 2 && argc != 3) {
10901 Jim_WrongNumArgs(interp, 1, argv, "?-nonewline? string");
10902 return JIM_ERR;
10904 if (argc == 3) {
10905 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline")) {
10906 Jim_SetResultString(interp, "The second argument must " "be -nonewline", -1);
10907 return JIM_ERR;
10909 else {
10910 fputs(Jim_String(argv[2]), stdout);
10913 else {
10914 puts(Jim_String(argv[1]));
10916 return JIM_OK;
10919 /* Helper for [+] and [*] */
10920 static int JimAddMulHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
10922 jim_wide wideValue, res;
10923 double doubleValue, doubleRes;
10924 int i;
10926 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
10928 for (i = 1; i < argc; i++) {
10929 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
10930 goto trydouble;
10931 if (op == JIM_EXPROP_ADD)
10932 res += wideValue;
10933 else
10934 res *= wideValue;
10936 Jim_SetResultInt(interp, res);
10937 return JIM_OK;
10938 trydouble:
10939 doubleRes = (double)res;
10940 for (; i < argc; i++) {
10941 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
10942 return JIM_ERR;
10943 if (op == JIM_EXPROP_ADD)
10944 doubleRes += doubleValue;
10945 else
10946 doubleRes *= doubleValue;
10948 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
10949 return JIM_OK;
10952 /* Helper for [-] and [/] */
10953 static int JimSubDivHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
10955 jim_wide wideValue, res = 0;
10956 double doubleValue, doubleRes = 0;
10957 int i = 2;
10959 if (argc < 2) {
10960 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
10961 return JIM_ERR;
10963 else if (argc == 2) {
10964 /* The arity = 2 case is different. For [- x] returns -x,
10965 * while [/ x] returns 1/x. */
10966 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
10967 if (Jim_GetDouble(interp, argv[1], &doubleValue) != JIM_OK) {
10968 return JIM_ERR;
10970 else {
10971 if (op == JIM_EXPROP_SUB)
10972 doubleRes = -doubleValue;
10973 else
10974 doubleRes = 1.0 / doubleValue;
10975 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
10976 return JIM_OK;
10979 if (op == JIM_EXPROP_SUB) {
10980 res = -wideValue;
10981 Jim_SetResultInt(interp, res);
10983 else {
10984 doubleRes = 1.0 / wideValue;
10985 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
10987 return JIM_OK;
10989 else {
10990 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
10991 if (Jim_GetDouble(interp, argv[1], &doubleRes)
10992 != JIM_OK) {
10993 return JIM_ERR;
10995 else {
10996 goto trydouble;
11000 for (i = 2; i < argc; i++) {
11001 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
11002 doubleRes = (double)res;
11003 goto trydouble;
11005 if (op == JIM_EXPROP_SUB)
11006 res -= wideValue;
11007 else
11008 res /= wideValue;
11010 Jim_SetResultInt(interp, res);
11011 return JIM_OK;
11012 trydouble:
11013 for (; i < argc; i++) {
11014 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11015 return JIM_ERR;
11016 if (op == JIM_EXPROP_SUB)
11017 doubleRes -= doubleValue;
11018 else
11019 doubleRes /= doubleValue;
11021 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11022 return JIM_OK;
11026 /* [+] */
11027 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11029 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
11032 /* [*] */
11033 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11035 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
11038 /* [-] */
11039 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11041 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
11044 /* [/] */
11045 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11047 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
11050 /* [set] */
11051 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11053 if (argc != 2 && argc != 3) {
11054 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
11055 return JIM_ERR;
11057 if (argc == 2) {
11058 Jim_Obj *objPtr;
11060 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11061 if (!objPtr)
11062 return JIM_ERR;
11063 Jim_SetResult(interp, objPtr);
11064 return JIM_OK;
11066 /* argc == 3 case. */
11067 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
11068 return JIM_ERR;
11069 Jim_SetResult(interp, argv[2]);
11070 return JIM_OK;
11073 /* [unset]
11075 * unset ?-nocomplain? ?--? ?varName ...?
11077 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11079 int i = 1;
11080 int complain = 1;
11082 while (i < argc) {
11083 if (Jim_CompareStringImmediate(interp, argv[i], "--")) {
11084 i++;
11085 break;
11087 if (Jim_CompareStringImmediate(interp, argv[i], "-nocomplain")) {
11088 complain = 0;
11089 i++;
11090 continue;
11092 break;
11095 while (i < argc) {
11096 if (Jim_UnsetVariable(interp, argv[i], complain ? JIM_ERRMSG : JIM_NONE) != JIM_OK
11097 && complain) {
11098 return JIM_ERR;
11100 i++;
11102 return JIM_OK;
11105 /* [while] */
11106 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11108 if (argc != 3) {
11109 Jim_WrongNumArgs(interp, 1, argv, "condition body");
11110 return JIM_ERR;
11113 /* The general purpose implementation of while starts here */
11114 while (1) {
11115 int boolean, retval;
11117 if ((retval = Jim_GetBoolFromExpr(interp, argv[1], &boolean)) != JIM_OK)
11118 return retval;
11119 if (!boolean)
11120 break;
11122 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
11123 switch (retval) {
11124 case JIM_BREAK:
11125 goto out;
11126 break;
11127 case JIM_CONTINUE:
11128 continue;
11129 break;
11130 default:
11131 return retval;
11135 out:
11136 Jim_SetEmptyResult(interp);
11137 return JIM_OK;
11140 /* [for] */
11141 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11143 int retval;
11144 int boolean = 1;
11145 Jim_Obj *varNamePtr = NULL;
11146 Jim_Obj *stopVarNamePtr = NULL;
11148 if (argc != 5) {
11149 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
11150 return JIM_ERR;
11153 /* Do the initialisation */
11154 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK) {
11155 return retval;
11158 /* And do the first test now. Better for optimisation
11159 * if we can do next/test at the bottom of the loop
11161 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11163 /* Ready to do the body as follows:
11164 * while (1) {
11165 * body // check retcode
11166 * next // check retcode
11167 * test // check retcode/test bool
11171 #ifdef JIM_OPTIMIZATION
11172 /* Check if the for is on the form:
11173 * for ... {$i < CONST} {incr i}
11174 * for ... {$i < $j} {incr i}
11176 if (retval == JIM_OK && boolean) {
11177 ScriptObj *incrScript;
11178 ExprByteCode *expr;
11179 jim_wide stop, currentVal;
11180 unsigned jim_wide procEpoch;
11181 Jim_Obj *objPtr;
11182 int cmpOffset;
11184 /* Do it only if there aren't shared arguments */
11185 expr = JimGetExpression(interp, argv[2]);
11186 incrScript = Jim_GetScript(interp, argv[3]);
11188 /* Ensure proper lengths to start */
11189 if (incrScript->len != 3 || !expr || expr->len != 3) {
11190 goto evalstart;
11192 /* Ensure proper token types. */
11193 if (incrScript->token[1].type != JIM_TT_ESC ||
11194 expr->token[0].type != JIM_TT_VAR ||
11195 (expr->token[1].type != JIM_TT_EXPR_INT && expr->token[1].type != JIM_TT_VAR)) {
11196 goto evalstart;
11199 if (expr->token[2].type == JIM_EXPROP_LT) {
11200 cmpOffset = 0;
11202 else if (expr->token[2].type == JIM_EXPROP_LTE) {
11203 cmpOffset = 1;
11205 else {
11206 goto evalstart;
11209 /* Update command must be incr */
11210 if (!Jim_CompareStringImmediate(interp, incrScript->token[1].objPtr, "incr")) {
11211 goto evalstart;
11214 /* incr, expression must be about the same variable */
11215 if (!Jim_StringEqObj(incrScript->token[2].objPtr, expr->token[0].objPtr)) {
11216 goto evalstart;
11219 /* Get the stop condition (must be a variable or integer) */
11220 if (expr->token[1].type == JIM_TT_EXPR_INT) {
11221 if (Jim_GetWide(interp, expr->token[1].objPtr, &stop) == JIM_ERR) {
11222 goto evalstart;
11225 else {
11226 stopVarNamePtr = expr->token[1].objPtr;
11227 Jim_IncrRefCount(stopVarNamePtr);
11228 /* Keep the compiler happy */
11229 stop = 0;
11232 /* Initialization */
11233 procEpoch = interp->procEpoch;
11234 varNamePtr = expr->token[0].objPtr;
11235 Jim_IncrRefCount(varNamePtr);
11237 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
11238 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK) {
11239 goto testcond;
11242 /* --- OPTIMIZED FOR --- */
11243 while (retval == JIM_OK) {
11244 /* === Check condition === */
11245 /* Note that currentVal is already set here */
11247 /* Immediate or Variable? get the 'stop' value if the latter. */
11248 if (stopVarNamePtr) {
11249 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
11250 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &stop) != JIM_OK) {
11251 goto testcond;
11255 if (currentVal >= stop + cmpOffset) {
11256 break;
11259 /* Eval body */
11260 retval = Jim_EvalObj(interp, argv[4]);
11261 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11262 retval = JIM_OK;
11263 /* If there was a change in procedures/command continue
11264 * with the usual [for] command implementation */
11265 if (procEpoch != interp->procEpoch) {
11266 goto evalnext;
11269 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
11271 /* Increment */
11272 if (objPtr == NULL) {
11273 retval = JIM_ERR;
11274 goto out;
11276 if (!Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11277 currentVal = ++JimWideValue(objPtr);
11278 Jim_InvalidateStringRep(objPtr);
11280 else {
11281 if (Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK ||
11282 Jim_SetVariable(interp, varNamePtr, Jim_NewIntObj(interp,
11283 ++currentVal)) != JIM_OK) {
11284 goto evalnext;
11289 goto out;
11291 evalstart:
11292 #endif
11294 while (boolean && (retval == JIM_OK || retval == JIM_CONTINUE)) {
11295 /* Body */
11296 retval = Jim_EvalObj(interp, argv[4]);
11298 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11299 /* increment */
11300 evalnext:
11301 retval = Jim_EvalObj(interp, argv[3]);
11302 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11303 /* test */
11304 testcond:
11305 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11309 out:
11310 if (stopVarNamePtr) {
11311 Jim_DecrRefCount(interp, stopVarNamePtr);
11313 if (varNamePtr) {
11314 Jim_DecrRefCount(interp, varNamePtr);
11317 if (retval == JIM_CONTINUE || retval == JIM_BREAK || retval == JIM_OK) {
11318 Jim_SetEmptyResult(interp);
11319 return JIM_OK;
11322 return retval;
11325 /* [loop] */
11326 static int Jim_LoopCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11328 int retval;
11329 jim_wide i;
11330 jim_wide limit;
11331 jim_wide incr = 1;
11332 Jim_Obj *bodyObjPtr;
11334 if (argc != 5 && argc != 6) {
11335 Jim_WrongNumArgs(interp, 1, argv, "var first limit ?incr? body");
11336 return JIM_ERR;
11339 if (Jim_GetWide(interp, argv[2], &i) != JIM_OK ||
11340 Jim_GetWide(interp, argv[3], &limit) != JIM_OK ||
11341 (argc == 6 && Jim_GetWide(interp, argv[4], &incr) != JIM_OK)) {
11342 return JIM_ERR;
11344 bodyObjPtr = (argc == 5) ? argv[4] : argv[5];
11346 retval = Jim_SetVariable(interp, argv[1], argv[2]);
11348 while (((i < limit && incr > 0) || (i > limit && incr < 0)) && retval == JIM_OK) {
11349 retval = Jim_EvalObj(interp, bodyObjPtr);
11350 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11351 Jim_Obj *objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11353 retval = JIM_OK;
11355 /* Increment */
11356 i += incr;
11358 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11359 if (argv[1]->typePtr != &variableObjType) {
11360 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11361 return JIM_ERR;
11364 JimWideValue(objPtr) = i;
11365 Jim_InvalidateStringRep(objPtr);
11367 /* The following step is required in order to invalidate the
11368 * string repr of "FOO" if the var name is of the form of "FOO(IDX)" */
11369 if (argv[1]->typePtr != &variableObjType) {
11370 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11371 retval = JIM_ERR;
11372 break;
11376 else {
11377 objPtr = Jim_NewIntObj(interp, i);
11378 retval = Jim_SetVariable(interp, argv[1], objPtr);
11379 if (retval != JIM_OK) {
11380 Jim_FreeNewObj(interp, objPtr);
11386 if (retval == JIM_OK || retval == JIM_CONTINUE || retval == JIM_BREAK) {
11387 Jim_SetEmptyResult(interp);
11388 return JIM_OK;
11390 return retval;
11393 /* List iterators make it easy to iterate over a list.
11394 * At some point iterators will be expanded to support generators.
11396 typedef struct {
11397 Jim_Obj *objPtr;
11398 int idx;
11399 } Jim_ListIter;
11402 * Initialise the iterator at the start of the list.
11404 static void JimListIterInit(Jim_ListIter *iter, Jim_Obj *objPtr)
11406 iter->objPtr = objPtr;
11407 iter->idx = 0;
11411 * Returns the next object from the list, or NULL on end-of-list.
11413 static Jim_Obj *JimListIterNext(Jim_Interp *interp, Jim_ListIter *iter)
11415 if (iter->idx >= Jim_ListLength(interp, iter->objPtr)) {
11416 return NULL;
11418 return iter->objPtr->internalRep.listValue.ele[iter->idx++];
11422 * Returns 1 if end-of-list has been reached.
11424 static int JimListIterDone(Jim_Interp *interp, Jim_ListIter *iter)
11426 return iter->idx >= Jim_ListLength(interp, iter->objPtr);
11429 /* foreach + lmap implementation. */
11430 static int JimForeachMapHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int doMap)
11432 int result = JIM_ERR;
11433 int i, numargs;
11434 Jim_ListIter twoiters[2]; /* Avoid allocation for a single list */
11435 Jim_ListIter *iters;
11436 Jim_Obj *script;
11437 Jim_Obj *resultObj;
11439 if (argc < 4 || argc % 2 != 0) {
11440 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
11441 return JIM_ERR;
11443 script = argv[argc - 1]; /* Last argument is a script */
11444 numargs = (argc - 1 - 1); /* argc - 'foreach' - script */
11446 if (numargs == 2) {
11447 iters = twoiters;
11449 else {
11450 iters = Jim_Alloc(numargs * sizeof(*iters));
11452 for (i = 0; i < numargs; i++) {
11453 JimListIterInit(&iters[i], argv[i + 1]);
11454 if (i % 2 == 0 && JimListIterDone(interp, &iters[i])) {
11455 Jim_SetResultString(interp, "foreach varlist is empty", -1);
11456 return JIM_ERR;
11460 if (doMap) {
11461 resultObj = Jim_NewListObj(interp, NULL, 0);
11463 else {
11464 resultObj = interp->emptyObj;
11466 Jim_IncrRefCount(resultObj);
11468 while (1) {
11469 /* Have we expired all lists? */
11470 for (i = 0; i < numargs; i += 2) {
11471 if (!JimListIterDone(interp, &iters[i + 1])) {
11472 break;
11475 if (i == numargs) {
11476 /* All done */
11477 break;
11480 /* For each list */
11481 for (i = 0; i < numargs; i += 2) {
11482 Jim_Obj *varName;
11484 /* foreach var */
11485 JimListIterInit(&iters[i], argv[i + 1]);
11486 while ((varName = JimListIterNext(interp, &iters[i])) != NULL) {
11487 Jim_Obj *valObj = JimListIterNext(interp, &iters[i + 1]);
11488 if (!valObj) {
11489 /* Ran out, so store the empty string */
11490 valObj = interp->emptyObj;
11492 /* Avoid shimmering */
11493 Jim_IncrRefCount(valObj);
11494 result = Jim_SetVariable(interp, varName, valObj);
11495 Jim_DecrRefCount(interp, valObj);
11496 if (result != JIM_OK) {
11497 goto err;
11501 switch (result = Jim_EvalObj(interp, script)) {
11502 case JIM_OK:
11503 if (doMap) {
11504 Jim_ListAppendElement(interp, resultObj, interp->result);
11506 break;
11507 case JIM_CONTINUE:
11508 break;
11509 case JIM_BREAK:
11510 goto out;
11511 default:
11512 goto err;
11515 out:
11516 result = JIM_OK;
11517 Jim_SetResult(interp, resultObj);
11518 err:
11519 Jim_DecrRefCount(interp, resultObj);
11520 if (numargs > 2) {
11521 Jim_Free(iters);
11523 return result;
11526 /* [foreach] */
11527 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11529 return JimForeachMapHelper(interp, argc, argv, 0);
11532 /* [lmap] */
11533 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11535 return JimForeachMapHelper(interp, argc, argv, 1);
11538 /* [lassign] */
11539 static int Jim_LassignCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11541 int result = JIM_ERR;
11542 int i;
11543 Jim_ListIter iter;
11544 Jim_Obj *resultObj;
11546 if (argc < 2) {
11547 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varName ...?");
11548 return JIM_ERR;
11551 JimListIterInit(&iter, argv[1]);
11553 for (i = 2; i < argc; i++) {
11554 Jim_Obj *valObj = JimListIterNext(interp, &iter);
11555 result = Jim_SetVariable(interp, argv[i], valObj ? valObj : interp->emptyObj);
11556 if (result != JIM_OK) {
11557 return result;
11561 resultObj = Jim_NewListObj(interp, NULL, 0);
11562 while (!JimListIterDone(interp, &iter)) {
11563 Jim_ListAppendElement(interp, resultObj, JimListIterNext(interp, &iter));
11566 Jim_SetResult(interp, resultObj);
11568 return JIM_OK;
11571 /* [if] */
11572 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11574 int boolean, retval, current = 1, falsebody = 0;
11576 if (argc >= 3) {
11577 while (1) {
11578 /* Far not enough arguments given! */
11579 if (current >= argc)
11580 goto err;
11581 if ((retval = Jim_GetBoolFromExpr(interp, argv[current++], &boolean))
11582 != JIM_OK)
11583 return retval;
11584 /* There lacks something, isn't it? */
11585 if (current >= argc)
11586 goto err;
11587 if (Jim_CompareStringImmediate(interp, argv[current], "then"))
11588 current++;
11589 /* Tsk tsk, no then-clause? */
11590 if (current >= argc)
11591 goto err;
11592 if (boolean)
11593 return Jim_EvalObj(interp, argv[current]);
11594 /* Ok: no else-clause follows */
11595 if (++current >= argc) {
11596 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11597 return JIM_OK;
11599 falsebody = current++;
11600 if (Jim_CompareStringImmediate(interp, argv[falsebody], "else")) {
11601 /* IIICKS - else-clause isn't last cmd? */
11602 if (current != argc - 1)
11603 goto err;
11604 return Jim_EvalObj(interp, argv[current]);
11606 else if (Jim_CompareStringImmediate(interp, argv[falsebody], "elseif"))
11607 /* Ok: elseif follows meaning all the stuff
11608 * again (how boring...) */
11609 continue;
11610 /* OOPS - else-clause is not last cmd? */
11611 else if (falsebody != argc - 1)
11612 goto err;
11613 return Jim_EvalObj(interp, argv[falsebody]);
11615 return JIM_OK;
11617 err:
11618 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
11619 return JIM_ERR;
11623 /* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)*/
11624 int Jim_CommandMatchObj(Jim_Interp *interp, Jim_Obj *commandObj, Jim_Obj *patternObj,
11625 Jim_Obj *stringObj, int nocase)
11627 Jim_Obj *parms[4];
11628 int argc = 0;
11629 long eq;
11630 int rc;
11632 parms[argc++] = commandObj;
11633 if (nocase) {
11634 parms[argc++] = Jim_NewStringObj(interp, "-nocase", -1);
11636 parms[argc++] = patternObj;
11637 parms[argc++] = stringObj;
11639 rc = Jim_EvalObjVector(interp, argc, parms);
11641 if (rc != JIM_OK || Jim_GetLong(interp, Jim_GetResult(interp), &eq) != JIM_OK) {
11642 eq = -rc;
11645 return eq;
11648 enum
11649 { SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD };
11651 /* [switch] */
11652 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11654 int matchOpt = SWITCH_EXACT, opt = 1, patCount, i;
11655 Jim_Obj *command = 0, *const *caseList = 0, *strObj;
11656 Jim_Obj *script = 0;
11658 if (argc < 3) {
11659 wrongnumargs:
11660 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
11661 "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}");
11662 return JIM_ERR;
11664 for (opt = 1; opt < argc; ++opt) {
11665 const char *option = Jim_String(argv[opt]);
11667 if (*option != '-')
11668 break;
11669 else if (strncmp(option, "--", 2) == 0) {
11670 ++opt;
11671 break;
11673 else if (strncmp(option, "-exact", 2) == 0)
11674 matchOpt = SWITCH_EXACT;
11675 else if (strncmp(option, "-glob", 2) == 0)
11676 matchOpt = SWITCH_GLOB;
11677 else if (strncmp(option, "-regexp", 2) == 0)
11678 matchOpt = SWITCH_RE;
11679 else if (strncmp(option, "-command", 2) == 0) {
11680 matchOpt = SWITCH_CMD;
11681 if ((argc - opt) < 2)
11682 goto wrongnumargs;
11683 command = argv[++opt];
11685 else {
11686 Jim_SetResultFormatted(interp,
11687 "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --",
11688 argv[opt]);
11689 return JIM_ERR;
11691 if ((argc - opt) < 2)
11692 goto wrongnumargs;
11694 strObj = argv[opt++];
11695 patCount = argc - opt;
11696 if (patCount == 1) {
11697 Jim_Obj **vector;
11699 JimListGetElements(interp, argv[opt], &patCount, &vector);
11700 caseList = vector;
11702 else
11703 caseList = &argv[opt];
11704 if (patCount == 0 || patCount % 2 != 0)
11705 goto wrongnumargs;
11706 for (i = 0; script == 0 && i < patCount; i += 2) {
11707 Jim_Obj *patObj = caseList[i];
11709 if (!Jim_CompareStringImmediate(interp, patObj, "default")
11710 || i < (patCount - 2)) {
11711 switch (matchOpt) {
11712 case SWITCH_EXACT:
11713 if (Jim_StringEqObj(strObj, patObj))
11714 script = caseList[i + 1];
11715 break;
11716 case SWITCH_GLOB:
11717 if (Jim_StringMatchObj(interp, patObj, strObj, 0))
11718 script = caseList[i + 1];
11719 break;
11720 case SWITCH_RE:
11721 command = Jim_NewStringObj(interp, "regexp", -1);
11722 /* Fall thru intentionally */
11723 case SWITCH_CMD:{
11724 int rc = Jim_CommandMatchObj(interp, command, patObj, strObj, 0);
11726 /* After the execution of a command we need to
11727 * make sure to reconvert the object into a list
11728 * again. Only for the single-list style [switch]. */
11729 if (argc - opt == 1) {
11730 Jim_Obj **vector;
11732 JimListGetElements(interp, argv[opt], &patCount, &vector);
11733 caseList = vector;
11735 /* command is here already decref'd */
11736 if (rc < 0) {
11737 return -rc;
11739 if (rc)
11740 script = caseList[i + 1];
11741 break;
11745 else {
11746 script = caseList[i + 1];
11749 for (; i < patCount && Jim_CompareStringImmediate(interp, script, "-"); i += 2)
11750 script = caseList[i + 1];
11751 if (script && Jim_CompareStringImmediate(interp, script, "-")) {
11752 Jim_SetResultFormatted(interp, "no body specified for pattern \"%#s\"", caseList[i - 2]);
11753 return JIM_ERR;
11755 Jim_SetEmptyResult(interp);
11756 if (script) {
11757 return Jim_EvalObj(interp, script);
11759 return JIM_OK;
11762 /* [list] */
11763 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11765 Jim_Obj *listObjPtr;
11767 listObjPtr = Jim_NewListObj(interp, argv + 1, argc - 1);
11768 Jim_SetResult(interp, listObjPtr);
11769 return JIM_OK;
11772 /* [lindex] */
11773 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11775 Jim_Obj *objPtr, *listObjPtr;
11776 int i;
11777 int idx;
11779 if (argc < 3) {
11780 Jim_WrongNumArgs(interp, 1, argv, "list index ?...?");
11781 return JIM_ERR;
11783 objPtr = argv[1];
11784 Jim_IncrRefCount(objPtr);
11785 for (i = 2; i < argc; i++) {
11786 listObjPtr = objPtr;
11787 if (Jim_GetIndex(interp, argv[i], &idx) != JIM_OK) {
11788 Jim_DecrRefCount(interp, listObjPtr);
11789 return JIM_ERR;
11791 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_NONE) != JIM_OK) {
11792 /* Returns an empty object if the index
11793 * is out of range. */
11794 Jim_DecrRefCount(interp, listObjPtr);
11795 Jim_SetEmptyResult(interp);
11796 return JIM_OK;
11798 Jim_IncrRefCount(objPtr);
11799 Jim_DecrRefCount(interp, listObjPtr);
11801 Jim_SetResult(interp, objPtr);
11802 Jim_DecrRefCount(interp, objPtr);
11803 return JIM_OK;
11806 /* [llength] */
11807 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11809 if (argc != 2) {
11810 Jim_WrongNumArgs(interp, 1, argv, "list");
11811 return JIM_ERR;
11813 Jim_SetResultInt(interp, Jim_ListLength(interp, argv[1]));
11814 return JIM_OK;
11817 /* [lsearch] */
11818 static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11820 static const char * const options[] = {
11821 "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
11822 NULL
11824 enum
11825 { OPT_BOOL, OPT_NOT, OPT_NOCASE, OPT_EXACT, OPT_GLOB, OPT_REGEXP, OPT_ALL, OPT_INLINE,
11826 OPT_COMMAND };
11827 int i;
11828 int opt_bool = 0;
11829 int opt_not = 0;
11830 int opt_nocase = 0;
11831 int opt_all = 0;
11832 int opt_inline = 0;
11833 int opt_match = OPT_EXACT;
11834 int listlen;
11835 int rc = JIM_OK;
11836 Jim_Obj *listObjPtr = NULL;
11837 Jim_Obj *commandObj = NULL;
11839 if (argc < 3) {
11840 wrongargs:
11841 Jim_WrongNumArgs(interp, 1, argv,
11842 "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
11843 return JIM_ERR;
11846 for (i = 1; i < argc - 2; i++) {
11847 int option;
11849 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG) != JIM_OK) {
11850 return JIM_ERR;
11852 switch (option) {
11853 case OPT_BOOL:
11854 opt_bool = 1;
11855 opt_inline = 0;
11856 break;
11857 case OPT_NOT:
11858 opt_not = 1;
11859 break;
11860 case OPT_NOCASE:
11861 opt_nocase = 1;
11862 break;
11863 case OPT_INLINE:
11864 opt_inline = 1;
11865 opt_bool = 0;
11866 break;
11867 case OPT_ALL:
11868 opt_all = 1;
11869 break;
11870 case OPT_COMMAND:
11871 if (i >= argc - 2) {
11872 goto wrongargs;
11874 commandObj = argv[++i];
11875 /* fallthru */
11876 case OPT_EXACT:
11877 case OPT_GLOB:
11878 case OPT_REGEXP:
11879 opt_match = option;
11880 break;
11884 argv += i;
11886 if (opt_all) {
11887 listObjPtr = Jim_NewListObj(interp, NULL, 0);
11889 if (opt_match == OPT_REGEXP) {
11890 commandObj = Jim_NewStringObj(interp, "regexp", -1);
11892 if (commandObj) {
11893 Jim_IncrRefCount(commandObj);
11896 listlen = Jim_ListLength(interp, argv[0]);
11897 for (i = 0; i < listlen; i++) {
11898 Jim_Obj *objPtr;
11899 int eq = 0;
11901 Jim_ListIndex(interp, argv[0], i, &objPtr, JIM_NONE);
11902 switch (opt_match) {
11903 case OPT_EXACT:
11904 eq = Jim_StringCompareObj(interp, argv[1], objPtr, opt_nocase) == 0;
11905 break;
11907 case OPT_GLOB:
11908 eq = Jim_StringMatchObj(interp, argv[1], objPtr, opt_nocase);
11909 break;
11911 case OPT_REGEXP:
11912 case OPT_COMMAND:
11913 eq = Jim_CommandMatchObj(interp, commandObj, argv[1], objPtr, opt_nocase);
11914 if (eq < 0) {
11915 if (listObjPtr) {
11916 Jim_FreeNewObj(interp, listObjPtr);
11918 rc = JIM_ERR;
11919 goto done;
11921 break;
11924 /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
11925 if (!eq && opt_bool && opt_not && !opt_all) {
11926 continue;
11929 if ((!opt_bool && eq == !opt_not) || (opt_bool && (eq || opt_all))) {
11930 /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
11931 Jim_Obj *resultObj;
11933 if (opt_bool) {
11934 resultObj = Jim_NewIntObj(interp, eq ^ opt_not);
11936 else if (!opt_inline) {
11937 resultObj = Jim_NewIntObj(interp, i);
11939 else {
11940 resultObj = objPtr;
11943 if (opt_all) {
11944 Jim_ListAppendElement(interp, listObjPtr, resultObj);
11946 else {
11947 Jim_SetResult(interp, resultObj);
11948 goto done;
11953 if (opt_all) {
11954 Jim_SetResult(interp, listObjPtr);
11956 else {
11957 /* No match */
11958 if (opt_bool) {
11959 Jim_SetResultBool(interp, opt_not);
11961 else if (!opt_inline) {
11962 Jim_SetResultInt(interp, -1);
11966 done:
11967 if (commandObj) {
11968 Jim_DecrRefCount(interp, commandObj);
11970 return rc;
11973 /* [lappend] */
11974 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11976 Jim_Obj *listObjPtr;
11977 int shared, i;
11979 if (argc < 2) {
11980 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
11981 return JIM_ERR;
11983 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
11984 if (!listObjPtr) {
11985 /* Create the list if it does not exists */
11986 listObjPtr = Jim_NewListObj(interp, NULL, 0);
11987 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
11988 Jim_FreeNewObj(interp, listObjPtr);
11989 return JIM_ERR;
11992 shared = Jim_IsShared(listObjPtr);
11993 if (shared)
11994 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
11995 for (i = 2; i < argc; i++)
11996 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
11997 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
11998 if (shared)
11999 Jim_FreeNewObj(interp, listObjPtr);
12000 return JIM_ERR;
12002 Jim_SetResult(interp, listObjPtr);
12003 return JIM_OK;
12006 /* [linsert] */
12007 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12009 int idx, len;
12010 Jim_Obj *listPtr;
12012 if (argc < 3) {
12013 Jim_WrongNumArgs(interp, 1, argv, "list index ?element ...?");
12014 return JIM_ERR;
12016 listPtr = argv[1];
12017 if (Jim_IsShared(listPtr))
12018 listPtr = Jim_DuplicateObj(interp, listPtr);
12019 if (Jim_GetIndex(interp, argv[2], &idx) != JIM_OK)
12020 goto err;
12021 len = Jim_ListLength(interp, listPtr);
12022 if (idx >= len)
12023 idx = len;
12024 else if (idx < 0)
12025 idx = len + idx + 1;
12026 Jim_ListInsertElements(interp, listPtr, idx, argc - 3, &argv[3]);
12027 Jim_SetResult(interp, listPtr);
12028 return JIM_OK;
12029 err:
12030 if (listPtr != argv[1]) {
12031 Jim_FreeNewObj(interp, listPtr);
12033 return JIM_ERR;
12036 /* [lreplace] */
12037 static int Jim_LreplaceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12039 int first, last, len, rangeLen;
12040 Jim_Obj *listObj;
12041 Jim_Obj *newListObj;
12043 if (argc < 4) {
12044 Jim_WrongNumArgs(interp, 1, argv, "list first last ?element ...?");
12045 return JIM_ERR;
12047 if (Jim_GetIndex(interp, argv[2], &first) != JIM_OK ||
12048 Jim_GetIndex(interp, argv[3], &last) != JIM_OK) {
12049 return JIM_ERR;
12052 listObj = argv[1];
12053 len = Jim_ListLength(interp, listObj);
12055 first = JimRelToAbsIndex(len, first);
12056 last = JimRelToAbsIndex(len, last);
12057 JimRelToAbsRange(len, &first, &last, &rangeLen);
12059 /* Now construct a new list which consists of:
12060 * <elements before first> <supplied elements> <elements after last>
12063 /* Check to see if trying to replace past the end of the list */
12064 if (first < len) {
12065 /* OK. Not past the end */
12067 else if (len == 0) {
12068 /* Special for empty list, adjust first to 0 */
12069 first = 0;
12071 else {
12072 Jim_SetResultString(interp, "list doesn't contain element ", -1);
12073 Jim_AppendObj(interp, Jim_GetResult(interp), argv[2]);
12074 return JIM_ERR;
12077 /* Add the first set of elements */
12078 newListObj = Jim_NewListObj(interp, listObj->internalRep.listValue.ele, first);
12080 /* Add supplied elements */
12081 ListInsertElements(newListObj, -1, argc - 4, argv + 4);
12083 /* Add the remaining elements */
12084 ListInsertElements(newListObj, -1, len - first - rangeLen, listObj->internalRep.listValue.ele + first + rangeLen);
12086 Jim_SetResult(interp, newListObj);
12087 return JIM_OK;
12090 /* [lset] */
12091 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12093 if (argc < 3) {
12094 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
12095 return JIM_ERR;
12097 else if (argc == 3) {
12098 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
12099 return JIM_ERR;
12100 Jim_SetResult(interp, argv[2]);
12101 return JIM_OK;
12103 if (Jim_SetListIndex(interp, argv[1], argv + 2, argc - 3, argv[argc - 1])
12104 == JIM_ERR)
12105 return JIM_ERR;
12106 return JIM_OK;
12109 /* [lsort] */
12110 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
12112 static const char * const options[] = {
12113 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-index", NULL
12115 enum
12116 { OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_INDEX };
12117 Jim_Obj *resObj;
12118 int i;
12119 int retCode;
12121 struct lsort_info info;
12123 if (argc < 2) {
12124 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
12125 return JIM_ERR;
12128 info.type = JIM_LSORT_ASCII;
12129 info.order = 1;
12130 info.indexed = 0;
12131 info.command = NULL;
12132 info.interp = interp;
12134 for (i = 1; i < (argc - 1); i++) {
12135 int option;
12137 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG)
12138 != JIM_OK)
12139 return JIM_ERR;
12140 switch (option) {
12141 case OPT_ASCII:
12142 info.type = JIM_LSORT_ASCII;
12143 break;
12144 case OPT_NOCASE:
12145 info.type = JIM_LSORT_NOCASE;
12146 break;
12147 case OPT_INTEGER:
12148 info.type = JIM_LSORT_INTEGER;
12149 break;
12150 case OPT_INCREASING:
12151 info.order = 1;
12152 break;
12153 case OPT_DECREASING:
12154 info.order = -1;
12155 break;
12156 case OPT_COMMAND:
12157 if (i >= (argc - 2)) {
12158 Jim_SetResultString(interp, "\"-command\" option must be followed by comparison command", -1);
12159 return JIM_ERR;
12161 info.type = JIM_LSORT_COMMAND;
12162 info.command = argv[i + 1];
12163 i++;
12164 break;
12165 case OPT_INDEX:
12166 if (i >= (argc - 2)) {
12167 Jim_SetResultString(interp, "\"-index\" option must be followed by list index", -1);
12168 return JIM_ERR;
12170 if (Jim_GetIndex(interp, argv[i + 1], &info.index) != JIM_OK) {
12171 return JIM_ERR;
12173 info.indexed = 1;
12174 i++;
12175 break;
12178 resObj = Jim_DuplicateObj(interp, argv[argc - 1]);
12179 retCode = ListSortElements(interp, resObj, &info);
12180 if (retCode == JIM_OK) {
12181 Jim_SetResult(interp, resObj);
12183 else {
12184 Jim_FreeNewObj(interp, resObj);
12186 return retCode;
12189 /* [append] */
12190 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12192 Jim_Obj *stringObjPtr;
12193 int i;
12195 if (argc < 2) {
12196 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
12197 return JIM_ERR;
12199 if (argc == 2) {
12200 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
12201 if (!stringObjPtr)
12202 return JIM_ERR;
12204 else {
12205 int freeobj = 0;
12206 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12207 if (!stringObjPtr) {
12208 /* Create the string if it doesn't exist */
12209 stringObjPtr = Jim_NewEmptyStringObj(interp);
12210 freeobj = 1;
12212 else if (Jim_IsShared(stringObjPtr)) {
12213 freeobj = 1;
12214 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
12216 for (i = 2; i < argc; i++) {
12217 Jim_AppendObj(interp, stringObjPtr, argv[i]);
12219 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
12220 if (freeobj) {
12221 Jim_FreeNewObj(interp, stringObjPtr);
12223 return JIM_ERR;
12226 Jim_SetResult(interp, stringObjPtr);
12227 return JIM_OK;
12230 /* [debug] */
12231 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12233 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12234 static const char * const options[] = {
12235 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
12236 "exprbc", "show",
12237 NULL
12239 enum
12241 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
12242 OPT_EXPRLEN, OPT_EXPRBC, OPT_SHOW,
12244 int option;
12246 if (argc < 2) {
12247 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?...?");
12248 return JIM_ERR;
12250 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK)
12251 return JIM_ERR;
12252 if (option == OPT_REFCOUNT) {
12253 if (argc != 3) {
12254 Jim_WrongNumArgs(interp, 2, argv, "object");
12255 return JIM_ERR;
12257 Jim_SetResultInt(interp, argv[2]->refCount);
12258 return JIM_OK;
12260 else if (option == OPT_OBJCOUNT) {
12261 int freeobj = 0, liveobj = 0;
12262 char buf[256];
12263 Jim_Obj *objPtr;
12265 if (argc != 2) {
12266 Jim_WrongNumArgs(interp, 2, argv, "");
12267 return JIM_ERR;
12269 /* Count the number of free objects. */
12270 objPtr = interp->freeList;
12271 while (objPtr) {
12272 freeobj++;
12273 objPtr = objPtr->nextObjPtr;
12275 /* Count the number of live objects. */
12276 objPtr = interp->liveList;
12277 while (objPtr) {
12278 liveobj++;
12279 objPtr = objPtr->nextObjPtr;
12281 /* Set the result string and return. */
12282 sprintf(buf, "free %d used %d", freeobj, liveobj);
12283 Jim_SetResultString(interp, buf, -1);
12284 return JIM_OK;
12286 else if (option == OPT_OBJECTS) {
12287 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
12289 /* Count the number of live objects. */
12290 objPtr = interp->liveList;
12291 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12292 while (objPtr) {
12293 char buf[128];
12294 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "";
12296 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
12297 sprintf(buf, "%p", objPtr);
12298 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, buf, -1));
12299 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, type, -1));
12300 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewIntObj(interp, objPtr->refCount));
12301 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
12302 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
12303 objPtr = objPtr->nextObjPtr;
12305 Jim_SetResult(interp, listObjPtr);
12306 return JIM_OK;
12308 else if (option == OPT_INVSTR) {
12309 Jim_Obj *objPtr;
12311 if (argc != 3) {
12312 Jim_WrongNumArgs(interp, 2, argv, "object");
12313 return JIM_ERR;
12315 objPtr = argv[2];
12316 if (objPtr->typePtr != NULL)
12317 Jim_InvalidateStringRep(objPtr);
12318 Jim_SetEmptyResult(interp);
12319 return JIM_OK;
12321 else if (option == OPT_SHOW) {
12322 const char *s;
12323 int len, charlen;
12325 if (argc != 3) {
12326 Jim_WrongNumArgs(interp, 2, argv, "object");
12327 return JIM_ERR;
12329 s = Jim_GetString(argv[2], &len);
12330 #ifdef JIM_UTF8
12331 charlen = utf8_strlen(s, len);
12332 #else
12333 charlen = len;
12334 #endif
12335 printf("refcount: %d, type: %s\n", argv[2]->refCount, JimObjTypeName(argv[2]));
12336 printf("chars (%d): <<%s>>\n", charlen, s);
12337 printf("bytes (%d):", len);
12338 while (len--) {
12339 printf(" %02x", (unsigned char)*s++);
12341 printf("\n");
12342 return JIM_OK;
12344 else if (option == OPT_SCRIPTLEN) {
12345 ScriptObj *script;
12347 if (argc != 3) {
12348 Jim_WrongNumArgs(interp, 2, argv, "script");
12349 return JIM_ERR;
12351 script = Jim_GetScript(interp, argv[2]);
12352 Jim_SetResultInt(interp, script->len);
12353 return JIM_OK;
12355 else if (option == OPT_EXPRLEN) {
12356 ExprByteCode *expr;
12358 if (argc != 3) {
12359 Jim_WrongNumArgs(interp, 2, argv, "expression");
12360 return JIM_ERR;
12362 expr = JimGetExpression(interp, argv[2]);
12363 if (expr == NULL)
12364 return JIM_ERR;
12365 Jim_SetResultInt(interp, expr->len);
12366 return JIM_OK;
12368 else if (option == OPT_EXPRBC) {
12369 Jim_Obj *objPtr;
12370 ExprByteCode *expr;
12371 int i;
12373 if (argc != 3) {
12374 Jim_WrongNumArgs(interp, 2, argv, "expression");
12375 return JIM_ERR;
12377 expr = JimGetExpression(interp, argv[2]);
12378 if (expr == NULL)
12379 return JIM_ERR;
12380 objPtr = Jim_NewListObj(interp, NULL, 0);
12381 for (i = 0; i < expr->len; i++) {
12382 const char *type;
12383 const Jim_ExprOperator *op;
12384 Jim_Obj *obj = expr->token[i].objPtr;
12386 switch (expr->token[i].type) {
12387 case JIM_TT_EXPR_INT:
12388 type = "int";
12389 break;
12390 case JIM_TT_EXPR_DOUBLE:
12391 type = "double";
12392 break;
12393 case JIM_TT_CMD:
12394 type = "command";
12395 break;
12396 case JIM_TT_VAR:
12397 type = "variable";
12398 break;
12399 case JIM_TT_DICTSUGAR:
12400 type = "dictsugar";
12401 break;
12402 case JIM_TT_EXPRSUGAR:
12403 type = "exprsugar";
12404 break;
12405 case JIM_TT_ESC:
12406 type = "subst";
12407 break;
12408 case JIM_TT_STR:
12409 type = "string";
12410 break;
12411 default:
12412 op = JimExprOperatorInfoByOpcode(expr->token[i].type);
12413 if (op == NULL) {
12414 type = "private";
12416 else {
12417 type = "operator";
12419 obj = Jim_NewStringObj(interp, op ? op->name : "", -1);
12420 break;
12422 Jim_ListAppendElement(interp, objPtr, Jim_NewStringObj(interp, type, -1));
12423 Jim_ListAppendElement(interp, objPtr, obj);
12425 Jim_SetResult(interp, objPtr);
12426 return JIM_OK;
12428 else {
12429 Jim_SetResultString(interp,
12430 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
12431 return JIM_ERR;
12433 /* unreached */
12434 #endif /* JIM_BOOTSTRAP */
12435 #if !defined(JIM_DEBUG_COMMAND)
12436 Jim_SetResultString(interp, "unsupported", -1);
12437 return JIM_ERR;
12438 #endif
12441 /* [eval] */
12442 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12444 int rc;
12446 if (argc < 2) {
12447 Jim_WrongNumArgs(interp, 1, argv, "script ?...?");
12448 return JIM_ERR;
12451 if (argc == 2) {
12452 rc = Jim_EvalObj(interp, argv[1]);
12454 else {
12455 rc = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12458 if (rc == JIM_ERR) {
12459 /* eval is "interesting", so add a stack frame here */
12460 interp->addStackTrace++;
12462 return rc;
12465 /* [uplevel] */
12466 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12468 if (argc >= 2) {
12469 int retcode;
12470 Jim_CallFrame *savedCallFrame, *targetCallFrame;
12471 Jim_Obj *objPtr;
12472 const char *str;
12474 /* Save the old callframe pointer */
12475 savedCallFrame = interp->framePtr;
12477 /* Lookup the target frame pointer */
12478 str = Jim_String(argv[1]);
12479 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#') {
12480 targetCallFrame =Jim_GetCallFrameByLevel(interp, argv[1]);
12481 argc--;
12482 argv++;
12484 else {
12485 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
12487 if (targetCallFrame == NULL) {
12488 return JIM_ERR;
12490 if (argc < 2) {
12491 argv--;
12492 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
12493 return JIM_ERR;
12495 /* Eval the code in the target callframe. */
12496 interp->framePtr = targetCallFrame;
12497 if (argc == 2) {
12498 retcode = Jim_EvalObj(interp, argv[1]);
12500 else {
12501 objPtr = Jim_ConcatObj(interp, argc - 1, argv + 1);
12502 Jim_IncrRefCount(objPtr);
12503 retcode = Jim_EvalObj(interp, objPtr);
12504 Jim_DecrRefCount(interp, objPtr);
12506 interp->framePtr = savedCallFrame;
12507 return retcode;
12509 else {
12510 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
12511 return JIM_ERR;
12515 /* [expr] */
12516 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12518 Jim_Obj *exprResultPtr;
12519 int retcode;
12521 if (argc == 2) {
12522 retcode = Jim_EvalExpression(interp, argv[1], &exprResultPtr);
12524 else if (argc > 2) {
12525 Jim_Obj *objPtr;
12527 objPtr = Jim_ConcatObj(interp, argc - 1, argv + 1);
12528 Jim_IncrRefCount(objPtr);
12529 retcode = Jim_EvalExpression(interp, objPtr, &exprResultPtr);
12530 Jim_DecrRefCount(interp, objPtr);
12532 else {
12533 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
12534 return JIM_ERR;
12536 if (retcode != JIM_OK)
12537 return retcode;
12538 Jim_SetResult(interp, exprResultPtr);
12539 Jim_DecrRefCount(interp, exprResultPtr);
12540 return JIM_OK;
12543 /* [break] */
12544 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12546 if (argc != 1) {
12547 Jim_WrongNumArgs(interp, 1, argv, "");
12548 return JIM_ERR;
12550 return JIM_BREAK;
12553 /* [continue] */
12554 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12556 if (argc != 1) {
12557 Jim_WrongNumArgs(interp, 1, argv, "");
12558 return JIM_ERR;
12560 return JIM_CONTINUE;
12563 /* [return] */
12564 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12566 int i;
12567 Jim_Obj *stackTraceObj = NULL;
12568 Jim_Obj *errorCodeObj = NULL;
12569 int returnCode = JIM_OK;
12570 long level = 1;
12572 for (i = 1; i < argc - 1; i += 2) {
12573 if (Jim_CompareStringImmediate(interp, argv[i], "-code")) {
12574 if (Jim_GetReturnCode(interp, argv[i + 1], &returnCode) == JIM_ERR) {
12575 return JIM_ERR;
12578 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorinfo")) {
12579 stackTraceObj = argv[i + 1];
12581 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorcode")) {
12582 errorCodeObj = argv[i + 1];
12584 else if (Jim_CompareStringImmediate(interp, argv[i], "-level")) {
12585 if (Jim_GetLong(interp, argv[i + 1], &level) != JIM_OK || level < 0) {
12586 Jim_SetResultFormatted(interp, "bad level \"%#s\"", argv[i + 1]);
12587 return JIM_ERR;
12590 else {
12591 break;
12595 if (i != argc - 1 && i != argc) {
12596 Jim_WrongNumArgs(interp, 1, argv,
12597 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
12600 /* If a stack trace is supplied and code is error, set the stack trace */
12601 if (stackTraceObj && returnCode == JIM_ERR) {
12602 JimSetStackTrace(interp, stackTraceObj);
12604 /* If an error code list is supplied, set the global $errorCode */
12605 if (errorCodeObj && returnCode == JIM_ERR) {
12606 Jim_SetGlobalVariableStr(interp, "errorCode", errorCodeObj);
12608 interp->returnCode = returnCode;
12609 interp->returnLevel = level;
12611 if (i == argc - 1) {
12612 Jim_SetResult(interp, argv[i]);
12614 return JIM_RETURN;
12617 /* [tailcall] */
12618 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12620 Jim_SetResult(interp, Jim_NewListObj(interp, argv + 1, argc - 1));
12621 return JIM_EVAL;
12624 static int JimAliasCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12626 int retcode;
12627 Jim_Obj *cmdList;
12628 Jim_Obj *prefixListObj = Jim_CmdPrivData(interp);
12629 Jim_Obj *saveRewriteNameObj = interp->rewriteNameObj;
12631 interp->rewriteNameObj = argv[0];
12632 interp->rewriteNameCount = Jim_ListLength(interp, prefixListObj);
12634 /* prefixListObj is a list to which the args need to be appended */
12635 cmdList = Jim_DuplicateObj(interp, prefixListObj);
12636 ListInsertElements(cmdList, -1, argc - 1, argv + 1);
12637 Jim_IncrRefCount(cmdList);
12639 retcode = JimEvalObjList(interp, cmdList);
12641 Jim_DecrRefCount(interp, cmdList);
12642 interp->rewriteNameObj = saveRewriteNameObj;
12644 return retcode;
12647 static void JimAliasCmdDelete(Jim_Interp *interp, void *privData)
12649 Jim_Obj *prefixListObj = privData;
12650 Jim_DecrRefCount(interp, prefixListObj);
12653 static int Jim_AliasCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12655 Jim_Obj *prefixListObj;
12656 const char *newname;
12658 if (argc < 3) {
12659 Jim_WrongNumArgs(interp, 1, argv, "newname command ?args ...?");
12660 return JIM_ERR;
12663 prefixListObj = Jim_NewListObj(interp, argv + 2, argc - 2);
12664 Jim_IncrRefCount(prefixListObj);
12665 newname = Jim_String(argv[1]);
12666 if (newname[0] == ':' && newname[1] == ':') {
12667 newname += 2;
12670 Jim_SetResult(interp, argv[1]);
12672 return Jim_CreateCommand(interp, newname, JimAliasCmd, prefixListObj, JimAliasCmdDelete);
12675 /* [proc] */
12676 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12678 if (argc != 4 && argc != 5) {
12679 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
12680 return JIM_ERR;
12683 if (argc == 4) {
12684 return JimCreateProcedure(interp, argv[1], argv[2], NULL, argv[3]);
12686 else {
12687 return JimCreateProcedure(interp, argv[1], argv[2], argv[3], argv[4]);
12691 /* [local] */
12692 static int Jim_LocalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12694 int retcode;
12696 /* Evaluate the arguments with 'local' in force */
12697 interp->local++;
12698 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
12699 interp->local--;
12702 /* If OK, and the result is a proc, add it to the list of local procs */
12703 if (retcode == 0) {
12704 Jim_Obj *cmdNameObj = Jim_GetResult(interp);
12706 if (Jim_FindHashEntry(&interp->commands, Jim_String(cmdNameObj)) == NULL) {
12707 Jim_SetResultFormatted(interp, "not a command: \"%#s\"", cmdNameObj);
12708 return JIM_ERR;
12710 if (interp->framePtr->localCommands == NULL) {
12711 interp->framePtr->localCommands = Jim_Alloc(sizeof(*interp->framePtr->localCommands));
12712 Jim_InitStack(interp->framePtr->localCommands);
12714 Jim_IncrRefCount(cmdNameObj);
12715 Jim_StackPush(interp->framePtr->localCommands, cmdNameObj);
12718 return retcode;
12721 /* [upcall] */
12722 static int Jim_UpcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12724 if (argc < 2) {
12725 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
12726 return JIM_ERR;
12728 else {
12729 int retcode;
12731 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
12732 if (cmdPtr == NULL || !cmdPtr->isproc || !cmdPtr->prevCmd) {
12733 Jim_SetResultFormatted(interp, "no previous command: \"%#s\"", argv[1]);
12734 return JIM_ERR;
12736 /* OK. Mark this command as being in an upcall */
12737 cmdPtr->u.proc.upcall++;
12738 JimIncrCmdRefCount(cmdPtr);
12740 /* Invoke the command as normal */
12741 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
12743 /* No longer in an upcall */
12744 cmdPtr->u.proc.upcall--;
12745 JimDecrCmdRefCount(interp, cmdPtr);
12747 return retcode;
12751 /* [concat] */
12752 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12754 Jim_SetResult(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12755 return JIM_OK;
12758 /* [upvar] */
12759 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12761 int i;
12762 Jim_CallFrame *targetCallFrame;
12764 /* Lookup the target frame pointer */
12765 if (argc > 3 && (argc % 2 == 0)) {
12766 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
12767 argc--;
12768 argv++;
12770 else {
12771 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
12773 if (targetCallFrame == NULL) {
12774 return JIM_ERR;
12777 /* Check for arity */
12778 if (argc < 3) {
12779 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
12780 return JIM_ERR;
12783 /* Now... for every other/local couple: */
12784 for (i = 1; i < argc; i += 2) {
12785 if (Jim_SetVariableLink(interp, argv[i + 1], argv[i], targetCallFrame) != JIM_OK)
12786 return JIM_ERR;
12788 return JIM_OK;
12791 /* [global] */
12792 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12794 int i;
12796 if (argc < 2) {
12797 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
12798 return JIM_ERR;
12800 /* Link every var to the toplevel having the same name */
12801 if (interp->framePtr->level == 0)
12802 return JIM_OK; /* global at toplevel... */
12803 for (i = 1; i < argc; i++) {
12804 /* global ::blah does nothing */
12805 const char *name = Jim_String(argv[i]);
12806 if (name[0] != ':' || name[1] != ':') {
12807 if (Jim_SetVariableLink(interp, argv[i], argv[i], interp->topFramePtr) != JIM_OK)
12808 return JIM_ERR;
12811 return JIM_OK;
12814 /* does the [string map] operation. On error NULL is returned,
12815 * otherwise a new string object with the result, having refcount = 0,
12816 * is returned. */
12817 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
12818 Jim_Obj *objPtr, int nocase)
12820 int numMaps;
12821 const char *str, *noMatchStart = NULL;
12822 int strLen, i;
12823 Jim_Obj *resultObjPtr;
12825 numMaps = Jim_ListLength(interp, mapListObjPtr);
12826 if (numMaps % 2) {
12827 Jim_SetResultString(interp, "list must contain an even number of elements", -1);
12828 return NULL;
12831 str = Jim_String(objPtr);
12832 strLen = Jim_Utf8Length(interp, objPtr);
12834 /* Map it */
12835 resultObjPtr = Jim_NewStringObj(interp, "", 0);
12836 while (strLen) {
12837 for (i = 0; i < numMaps; i += 2) {
12838 Jim_Obj *objPtr;
12839 const char *k;
12840 int kl;
12842 Jim_ListIndex(interp, mapListObjPtr, i, &objPtr, JIM_NONE);
12843 k = Jim_String(objPtr);
12844 kl = Jim_Utf8Length(interp, objPtr);
12846 if (strLen >= kl && kl) {
12847 int rc;
12848 rc = JimStringCompareLen(str, k, kl, nocase);
12849 if (rc == 0) {
12850 if (noMatchStart) {
12851 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
12852 noMatchStart = NULL;
12854 Jim_ListIndex(interp, mapListObjPtr, i + 1, &objPtr, JIM_NONE);
12855 Jim_AppendObj(interp, resultObjPtr, objPtr);
12856 str += utf8_index(str, kl);
12857 strLen -= kl;
12858 break;
12862 if (i == numMaps) { /* no match */
12863 int c;
12864 if (noMatchStart == NULL)
12865 noMatchStart = str;
12866 str += utf8_tounicode(str, &c);
12867 strLen--;
12870 if (noMatchStart) {
12871 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
12873 return resultObjPtr;
12876 /* [string] */
12877 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12879 int len;
12880 int opt_case = 1;
12881 int option;
12882 static const char * const options[] = {
12883 "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "replace",
12884 "map", "repeat", "reverse", "index", "first", "last",
12885 "trim", "trimleft", "trimright", "tolower", "toupper", "totitle", NULL
12887 enum
12889 OPT_BYTELENGTH, OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_IS, OPT_BYTERANGE, OPT_RANGE, OPT_REPLACE,
12890 OPT_MAP, OPT_REPEAT, OPT_REVERSE, OPT_INDEX, OPT_FIRST, OPT_LAST,
12891 OPT_TRIM, OPT_TRIMLEFT, OPT_TRIMRIGHT, OPT_TOLOWER, OPT_TOUPPER, OPT_TOTITLE
12893 static const char * const nocase_options[] = {
12894 "-nocase", NULL
12897 if (argc < 2) {
12898 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
12899 return JIM_ERR;
12901 if (Jim_GetEnum(interp, argv[1], options, &option, NULL,
12902 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK)
12903 return JIM_ERR;
12905 switch (option) {
12906 case OPT_LENGTH:
12907 case OPT_BYTELENGTH:
12908 if (argc != 3) {
12909 Jim_WrongNumArgs(interp, 2, argv, "string");
12910 return JIM_ERR;
12912 if (option == OPT_LENGTH) {
12913 len = Jim_Utf8Length(interp, argv[2]);
12915 else {
12916 len = Jim_Length(argv[2]);
12918 Jim_SetResultInt(interp, len);
12919 return JIM_OK;
12921 case OPT_COMPARE:
12922 case OPT_EQUAL:
12923 if (argc != 4 &&
12924 (argc != 5 ||
12925 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
12926 JIM_ENUM_ABBREV) != JIM_OK)) {
12927 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? string1 string2");
12928 return JIM_ERR;
12930 if (opt_case == 0) {
12931 argv++;
12933 if (option == OPT_COMPARE || !opt_case) {
12934 Jim_SetResultInt(interp, Jim_StringCompareObj(interp, argv[2], argv[3], !opt_case));
12936 else {
12937 Jim_SetResultBool(interp, Jim_StringEqObj(argv[2], argv[3]));
12939 return JIM_OK;
12941 case OPT_MATCH:
12942 if (argc != 4 &&
12943 (argc != 5 ||
12944 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
12945 JIM_ENUM_ABBREV) != JIM_OK)) {
12946 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern string");
12947 return JIM_ERR;
12949 if (opt_case == 0) {
12950 argv++;
12952 Jim_SetResultBool(interp, Jim_StringMatchObj(interp, argv[2], argv[3], !opt_case));
12953 return JIM_OK;
12955 case OPT_MAP:{
12956 Jim_Obj *objPtr;
12958 if (argc != 4 &&
12959 (argc != 5 ||
12960 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
12961 JIM_ENUM_ABBREV) != JIM_OK)) {
12962 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList string");
12963 return JIM_ERR;
12966 if (opt_case == 0) {
12967 argv++;
12969 objPtr = JimStringMap(interp, argv[2], argv[3], !opt_case);
12970 if (objPtr == NULL) {
12971 return JIM_ERR;
12973 Jim_SetResult(interp, objPtr);
12974 return JIM_OK;
12977 case OPT_RANGE:
12978 case OPT_BYTERANGE:{
12979 Jim_Obj *objPtr;
12981 if (argc != 5) {
12982 Jim_WrongNumArgs(interp, 2, argv, "string first last");
12983 return JIM_ERR;
12985 if (option == OPT_RANGE) {
12986 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
12988 else
12990 objPtr = Jim_StringByteRangeObj(interp, argv[2], argv[3], argv[4]);
12993 if (objPtr == NULL) {
12994 return JIM_ERR;
12996 Jim_SetResult(interp, objPtr);
12997 return JIM_OK;
13000 case OPT_REPLACE:{
13001 Jim_Obj *objPtr;
13003 if (argc != 5 && argc != 6) {
13004 Jim_WrongNumArgs(interp, 2, argv, "string first last ?newstring?");
13005 return JIM_ERR;
13007 objPtr = JimStringReplaceObj(interp, argv[2], argv[3], argv[4], argc == 6 ? argv[5] : NULL);
13008 if (objPtr == NULL) {
13009 return JIM_ERR;
13011 Jim_SetResult(interp, objPtr);
13012 return JIM_OK;
13016 case OPT_REPEAT:{
13017 Jim_Obj *objPtr;
13018 jim_wide count;
13020 if (argc != 4) {
13021 Jim_WrongNumArgs(interp, 2, argv, "string count");
13022 return JIM_ERR;
13024 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK) {
13025 return JIM_ERR;
13027 objPtr = Jim_NewStringObj(interp, "", 0);
13028 if (count > 0) {
13029 while (count--) {
13030 Jim_AppendObj(interp, objPtr, argv[2]);
13033 Jim_SetResult(interp, objPtr);
13034 return JIM_OK;
13037 case OPT_REVERSE:{
13038 char *buf, *p;
13039 const char *str;
13040 int len;
13041 int i;
13043 if (argc != 3) {
13044 Jim_WrongNumArgs(interp, 2, argv, "string");
13045 return JIM_ERR;
13048 str = Jim_GetString(argv[2], &len);
13049 buf = Jim_Alloc(len + 1);
13050 p = buf + len;
13051 *p = 0;
13052 for (i = 0; i < len; ) {
13053 int c;
13054 int l = utf8_tounicode(str, &c);
13055 memcpy(p - l, str, l);
13056 p -= l;
13057 i += l;
13058 str += l;
13060 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
13061 return JIM_OK;
13064 case OPT_INDEX:{
13065 int idx;
13066 const char *str;
13068 if (argc != 4) {
13069 Jim_WrongNumArgs(interp, 2, argv, "string index");
13070 return JIM_ERR;
13072 if (Jim_GetIndex(interp, argv[3], &idx) != JIM_OK) {
13073 return JIM_ERR;
13075 str = Jim_String(argv[2]);
13076 len = Jim_Utf8Length(interp, argv[2]);
13077 if (idx != INT_MIN && idx != INT_MAX) {
13078 idx = JimRelToAbsIndex(len, idx);
13080 if (idx < 0 || idx >= len || str == NULL) {
13081 Jim_SetResultString(interp, "", 0);
13083 else if (len == Jim_Length(argv[2])) {
13084 /* ASCII optimisation */
13085 Jim_SetResultString(interp, str + idx, 1);
13087 else {
13088 int c;
13089 int i = utf8_index(str, idx);
13090 Jim_SetResultString(interp, str + i, utf8_tounicode(str + i, &c));
13092 return JIM_OK;
13095 case OPT_FIRST:
13096 case OPT_LAST:{
13097 int idx = 0, l1, l2;
13098 const char *s1, *s2;
13100 if (argc != 4 && argc != 5) {
13101 Jim_WrongNumArgs(interp, 2, argv, "subString string ?index?");
13102 return JIM_ERR;
13104 s1 = Jim_String(argv[2]);
13105 s2 = Jim_String(argv[3]);
13106 l1 = Jim_Utf8Length(interp, argv[2]);
13107 l2 = Jim_Utf8Length(interp, argv[3]);
13108 if (argc == 5) {
13109 if (Jim_GetIndex(interp, argv[4], &idx) != JIM_OK) {
13110 return JIM_ERR;
13112 idx = JimRelToAbsIndex(l2, idx);
13114 else if (option == OPT_LAST) {
13115 idx = l2;
13117 if (option == OPT_FIRST) {
13118 Jim_SetResultInt(interp, JimStringFirst(s1, l1, s2, l2, idx));
13120 else {
13121 #ifdef JIM_UTF8
13122 Jim_SetResultInt(interp, JimStringLastUtf8(s1, l1, s2, idx));
13123 #else
13124 Jim_SetResultInt(interp, JimStringLast(s1, l1, s2, idx));
13125 #endif
13127 return JIM_OK;
13130 case OPT_TRIM:
13131 case OPT_TRIMLEFT:
13132 case OPT_TRIMRIGHT:{
13133 Jim_Obj *trimchars;
13135 if (argc != 3 && argc != 4) {
13136 Jim_WrongNumArgs(interp, 2, argv, "string ?trimchars?");
13137 return JIM_ERR;
13139 trimchars = (argc == 4 ? argv[3] : NULL);
13140 if (option == OPT_TRIM) {
13141 Jim_SetResult(interp, JimStringTrim(interp, argv[2], trimchars));
13143 else if (option == OPT_TRIMLEFT) {
13144 Jim_SetResult(interp, JimStringTrimLeft(interp, argv[2], trimchars));
13146 else if (option == OPT_TRIMRIGHT) {
13147 Jim_SetResult(interp, JimStringTrimRight(interp, argv[2], trimchars));
13149 return JIM_OK;
13152 case OPT_TOLOWER:
13153 case OPT_TOUPPER:
13154 case OPT_TOTITLE:
13155 if (argc != 3) {
13156 Jim_WrongNumArgs(interp, 2, argv, "string");
13157 return JIM_ERR;
13159 if (option == OPT_TOLOWER) {
13160 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
13162 else if (option == OPT_TOUPPER) {
13163 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
13165 else {
13166 Jim_SetResult(interp, JimStringToTitle(interp, argv[2]));
13168 return JIM_OK;
13170 case OPT_IS:
13171 if (argc == 4 || (argc == 5 && Jim_CompareStringImmediate(interp, argv[3], "-strict"))) {
13172 return JimStringIs(interp, argv[argc - 1], argv[2], argc == 5);
13174 Jim_WrongNumArgs(interp, 2, argv, "class ?-strict? str");
13175 return JIM_ERR;
13177 return JIM_OK;
13180 /* [time] */
13181 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13183 long i, count = 1;
13184 jim_wide start, elapsed;
13185 char buf[60];
13186 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
13188 if (argc < 2) {
13189 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
13190 return JIM_ERR;
13192 if (argc == 3) {
13193 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
13194 return JIM_ERR;
13196 if (count < 0)
13197 return JIM_OK;
13198 i = count;
13199 start = JimClock();
13200 while (i-- > 0) {
13201 int retval;
13203 retval = Jim_EvalObj(interp, argv[1]);
13204 if (retval != JIM_OK) {
13205 return retval;
13208 elapsed = JimClock() - start;
13209 sprintf(buf, fmt, count == 0 ? 0 : elapsed / count);
13210 Jim_SetResultString(interp, buf, -1);
13211 return JIM_OK;
13214 /* [exit] */
13215 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13217 long exitCode = 0;
13219 if (argc > 2) {
13220 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
13221 return JIM_ERR;
13223 if (argc == 2) {
13224 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
13225 return JIM_ERR;
13227 interp->exitCode = exitCode;
13228 return JIM_EXIT;
13231 /* [catch] */
13232 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13234 int exitCode = 0;
13235 int i;
13236 int sig = 0;
13238 /* Which return codes are ignored (passed through)? By default, only exit, eval and signal */
13239 jim_wide ignore_mask = (1 << JIM_EXIT) | (1 << JIM_EVAL) | (1 << JIM_SIGNAL);
13240 static const int max_ignore_code = sizeof(ignore_mask) * 8;
13242 /* Reset the error code before catch.
13243 * Note that this is not strictly correct.
13245 Jim_SetGlobalVariableStr(interp, "errorCode", Jim_NewStringObj(interp, "NONE", -1));
13247 for (i = 1; i < argc - 1; i++) {
13248 const char *arg = Jim_String(argv[i]);
13249 jim_wide option;
13250 int ignore;
13252 /* It's a pity we can't use Jim_GetEnum here :-( */
13253 if (strcmp(arg, "--") == 0) {
13254 i++;
13255 break;
13257 if (*arg != '-') {
13258 break;
13261 if (strncmp(arg, "-no", 3) == 0) {
13262 arg += 3;
13263 ignore = 1;
13265 else {
13266 arg++;
13267 ignore = 0;
13270 if (Jim_StringToWide(arg, &option, 10) != JIM_OK) {
13271 option = -1;
13273 if (option < 0) {
13274 option = Jim_FindByName(arg, jimReturnCodes, jimReturnCodesSize);
13276 if (option < 0) {
13277 goto wrongargs;
13280 if (ignore) {
13281 ignore_mask |= (1 << option);
13283 else {
13284 ignore_mask &= ~(1 << option);
13288 argc -= i;
13289 if (argc < 1 || argc > 3) {
13290 wrongargs:
13291 Jim_WrongNumArgs(interp, 1, argv,
13292 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
13293 return JIM_ERR;
13295 argv += i;
13297 if ((ignore_mask & (1 << JIM_SIGNAL)) == 0) {
13298 sig++;
13301 interp->signal_level += sig;
13302 if (interp->signal_level && interp->sigmask) {
13303 /* If a signal is set, don't even try to execute the body */
13304 exitCode = JIM_SIGNAL;
13306 else {
13307 exitCode = Jim_EvalObj(interp, argv[0]);
13309 interp->signal_level -= sig;
13311 /* Catch or pass through? Only the first 32/64 codes can be passed through */
13312 if (exitCode >= 0 && exitCode < max_ignore_code && ((1 << exitCode) & ignore_mask)) {
13313 /* Not caught, pass it up */
13314 return exitCode;
13317 if (sig && exitCode == JIM_SIGNAL) {
13318 /* Catch the signal at this level */
13319 if (interp->signal_set_result) {
13320 interp->signal_set_result(interp, interp->sigmask);
13322 else {
13323 Jim_SetResultInt(interp, interp->sigmask);
13325 interp->sigmask = 0;
13328 if (argc >= 2) {
13329 if (Jim_SetVariable(interp, argv[1], Jim_GetResult(interp)) != JIM_OK) {
13330 return JIM_ERR;
13332 if (argc == 3) {
13333 Jim_Obj *optListObj = Jim_NewListObj(interp, NULL, 0);
13335 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-code", -1));
13336 Jim_ListAppendElement(interp, optListObj,
13337 Jim_NewIntObj(interp, exitCode == JIM_RETURN ? interp->returnCode : exitCode));
13338 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-level", -1));
13339 Jim_ListAppendElement(interp, optListObj, Jim_NewIntObj(interp, interp->returnLevel));
13340 if (exitCode == JIM_ERR) {
13341 Jim_Obj *errorCode;
13342 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorinfo",
13343 -1));
13344 Jim_ListAppendElement(interp, optListObj, interp->stackTrace);
13346 errorCode = Jim_GetGlobalVariableStr(interp, "errorCode", JIM_NONE);
13347 if (errorCode) {
13348 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorcode", -1));
13349 Jim_ListAppendElement(interp, optListObj, errorCode);
13352 if (Jim_SetVariable(interp, argv[2], optListObj) != JIM_OK) {
13353 return JIM_ERR;
13357 Jim_SetResultInt(interp, exitCode);
13358 return JIM_OK;
13361 #ifdef JIM_REFERENCES
13363 /* [ref] */
13364 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13366 if (argc != 3 && argc != 4) {
13367 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
13368 return JIM_ERR;
13370 if (argc == 3) {
13371 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
13373 else {
13374 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], argv[3]));
13376 return JIM_OK;
13379 /* [getref] */
13380 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13382 Jim_Reference *refPtr;
13384 if (argc != 2) {
13385 Jim_WrongNumArgs(interp, 1, argv, "reference");
13386 return JIM_ERR;
13388 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
13389 return JIM_ERR;
13390 Jim_SetResult(interp, refPtr->objPtr);
13391 return JIM_OK;
13394 /* [setref] */
13395 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13397 Jim_Reference *refPtr;
13399 if (argc != 3) {
13400 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
13401 return JIM_ERR;
13403 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
13404 return JIM_ERR;
13405 Jim_IncrRefCount(argv[2]);
13406 Jim_DecrRefCount(interp, refPtr->objPtr);
13407 refPtr->objPtr = argv[2];
13408 Jim_SetResult(interp, argv[2]);
13409 return JIM_OK;
13412 /* [collect] */
13413 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13415 if (argc != 1) {
13416 Jim_WrongNumArgs(interp, 1, argv, "");
13417 return JIM_ERR;
13419 Jim_SetResultInt(interp, Jim_Collect(interp));
13421 /* Free all the freed objects. */
13422 while (interp->freeList) {
13423 Jim_Obj *nextObjPtr = interp->freeList->nextObjPtr;
13424 Jim_Free(interp->freeList);
13425 interp->freeList = nextObjPtr;
13428 return JIM_OK;
13431 /* [finalize] reference ?newValue? */
13432 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13434 if (argc != 2 && argc != 3) {
13435 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
13436 return JIM_ERR;
13438 if (argc == 2) {
13439 Jim_Obj *cmdNamePtr;
13441 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
13442 return JIM_ERR;
13443 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
13444 Jim_SetResult(interp, cmdNamePtr);
13446 else {
13447 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
13448 return JIM_ERR;
13449 Jim_SetResult(interp, argv[2]);
13451 return JIM_OK;
13454 /* [info references] */
13455 static int JimInfoReferences(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13457 Jim_Obj *listObjPtr;
13458 Jim_HashTableIterator *htiter;
13459 Jim_HashEntry *he;
13461 listObjPtr = Jim_NewListObj(interp, NULL, 0);
13463 htiter = Jim_GetHashTableIterator(&interp->references);
13464 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
13465 char buf[JIM_REFERENCE_SPACE];
13466 Jim_Reference *refPtr = he->u.val;
13467 const jim_wide *refId = he->key;
13469 JimFormatReference(buf, refPtr, *refId);
13470 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, buf, -1));
13472 Jim_FreeHashTableIterator(htiter);
13473 Jim_SetResult(interp, listObjPtr);
13474 return JIM_OK;
13476 #endif
13478 /* [rename] */
13479 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13481 const char *oldName, *newName;
13483 if (argc != 3) {
13484 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
13485 return JIM_ERR;
13488 if (JimValidName(interp, "new procedure", argv[2])) {
13489 return JIM_ERR;
13492 oldName = Jim_String(argv[1]);
13493 newName = Jim_String(argv[2]);
13494 return Jim_RenameCommand(interp, oldName, newName);
13497 #define JIM_DICTMATCH_VALUES 0x0001
13499 typedef void JimDictMatchCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_HashEntry *he, int type);
13501 static void JimDictMatchKeys(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_HashEntry *he, int type)
13503 Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->key);
13504 if (type & JIM_DICTMATCH_VALUES) {
13505 Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->u.val);
13510 * Like JimHashtablePatternMatch, but for dictionaries.
13512 static Jim_Obj *JimDictPatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
13513 JimDictMatchCallbackType *callback, int type)
13515 Jim_HashEntry *he;
13516 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
13518 /* Check for the non-pattern case. We can do this much more efficiently. */
13519 Jim_HashTableIterator *htiter = Jim_GetHashTableIterator(ht);
13520 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
13521 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), Jim_String((Jim_Obj *)he->key), 0)) {
13522 callback(interp, listObjPtr, he, type);
13525 Jim_FreeHashTableIterator(htiter);
13527 return listObjPtr;
13531 int Jim_DictKeys(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObjPtr)
13533 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
13534 return JIM_ERR;
13536 Jim_SetResult(interp, JimDictPatternMatch(interp, objPtr->internalRep.ptr, patternObjPtr, JimDictMatchKeys, 0));
13537 return JIM_OK;
13540 int Jim_DictValues(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObjPtr)
13542 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
13543 return JIM_ERR;
13545 Jim_SetResult(interp, JimDictPatternMatch(interp, objPtr->internalRep.ptr, patternObjPtr, JimDictMatchKeys, JIM_DICTMATCH_VALUES));
13546 return JIM_OK;
13549 int Jim_DictSize(Jim_Interp *interp, Jim_Obj *objPtr)
13551 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
13552 return -1;
13554 return ((Jim_HashTable *)objPtr->internalRep.ptr)->used;
13557 /* [dict] */
13558 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13560 Jim_Obj *objPtr;
13561 int option;
13562 static const char * const options[] = {
13563 "create", "get", "set", "unset", "exists", "keys", "merge", "size", "with", NULL
13565 enum
13567 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXIST, OPT_KEYS, OPT_MERGE, OPT_SIZE, OPT_WITH,
13570 if (argc < 2) {
13571 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?arguments ...?");
13572 return JIM_ERR;
13575 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK) {
13576 return JIM_ERR;
13579 switch (option) {
13580 case OPT_GET:
13581 if (argc < 3) {
13582 Jim_WrongNumArgs(interp, 2, argv, "varName ?key ...?");
13583 return JIM_ERR;
13585 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr,
13586 JIM_ERRMSG) != JIM_OK) {
13587 return JIM_ERR;
13589 Jim_SetResult(interp, objPtr);
13590 return JIM_OK;
13592 case OPT_SET:
13593 if (argc < 5) {
13594 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
13595 return JIM_ERR;
13597 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 4, argv[argc - 1], JIM_ERRMSG);
13599 case OPT_EXIST:
13600 if (argc < 3) {
13601 Jim_WrongNumArgs(interp, 2, argv, "varName ?key ...?");
13602 return JIM_ERR;
13604 Jim_SetResultBool(interp, Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3,
13605 &objPtr, JIM_ERRMSG) == JIM_OK);
13606 return JIM_OK;
13608 case OPT_UNSET:
13609 if (argc < 4) {
13610 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
13611 return JIM_ERR;
13613 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 3, NULL, JIM_NONE);
13615 case OPT_KEYS:
13616 if (argc != 3 && argc != 4) {
13617 Jim_WrongNumArgs(interp, 2, argv, "dictVar ?pattern?");
13618 return JIM_ERR;
13620 return Jim_DictKeys(interp, argv[2], argc == 4 ? argv[3] : NULL);
13622 case OPT_SIZE: {
13623 int size;
13625 if (argc != 3) {
13626 Jim_WrongNumArgs(interp, 2, argv, "dictVar");
13627 return JIM_ERR;
13630 size = Jim_DictSize(interp, argv[2]);
13631 if (size < 0) {
13632 return JIM_ERR;
13634 Jim_SetResultInt(interp, size);
13635 return JIM_OK;
13638 case OPT_MERGE:
13639 if (argc == 2) {
13640 return JIM_OK;
13642 else if (SetDictFromAny(interp, argv[2]) != JIM_OK) {
13643 return JIM_ERR;
13645 else {
13646 return Jim_EvalPrefix(interp, "dict merge", argc - 2, argv + 2);
13649 case OPT_WITH:
13650 if (argc < 4) {
13651 Jim_WrongNumArgs(interp, 2, argv, "dictVar ?key ...? script");
13652 return JIM_ERR;
13654 else if (Jim_GetVariable(interp, argv[2], JIM_ERRMSG) == NULL) {
13655 return JIM_ERR;
13657 else {
13658 return Jim_EvalPrefix(interp, "dict with", argc - 2, argv + 2);
13661 case OPT_CREATE:
13662 if (argc % 2) {
13663 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
13664 return JIM_ERR;
13666 objPtr = Jim_NewDictObj(interp, argv + 2, argc - 2);
13667 Jim_SetResult(interp, objPtr);
13668 return JIM_OK;
13670 return JIM_ERR;
13673 /* [subst] */
13674 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13676 static const char * const options[] = {
13677 "-nobackslashes", "-nocommands", "-novariables", NULL
13679 enum
13680 { OPT_NOBACKSLASHES, OPT_NOCOMMANDS, OPT_NOVARIABLES };
13681 int i;
13682 int flags = JIM_SUBST_FLAG;
13683 Jim_Obj *objPtr;
13685 if (argc < 2) {
13686 Jim_WrongNumArgs(interp, 1, argv, "?options? string");
13687 return JIM_ERR;
13689 for (i = 1; i < (argc - 1); i++) {
13690 int option;
13692 if (Jim_GetEnum(interp, argv[i], options, &option, NULL,
13693 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
13694 return JIM_ERR;
13696 switch (option) {
13697 case OPT_NOBACKSLASHES:
13698 flags |= JIM_SUBST_NOESC;
13699 break;
13700 case OPT_NOCOMMANDS:
13701 flags |= JIM_SUBST_NOCMD;
13702 break;
13703 case OPT_NOVARIABLES:
13704 flags |= JIM_SUBST_NOVAR;
13705 break;
13708 if (Jim_SubstObj(interp, argv[argc - 1], &objPtr, flags) != JIM_OK) {
13709 return JIM_ERR;
13711 Jim_SetResult(interp, objPtr);
13712 return JIM_OK;
13715 /* [info] */
13716 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13718 int cmd;
13719 Jim_Obj *objPtr;
13720 int mode = 0;
13722 static const char * const commands[] = {
13723 "body", "statics", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
13724 "vars", "version", "patchlevel", "complete", "args", "hostname",
13725 "script", "source", "stacktrace", "nameofexecutable", "returncodes",
13726 "references", "alias", NULL
13728 enum
13729 { INFO_BODY, INFO_STATICS, INFO_COMMANDS, INFO_PROCS, INFO_CHANNELS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
13730 INFO_FRAME, INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_PATCHLEVEL, INFO_COMPLETE, INFO_ARGS,
13731 INFO_HOSTNAME, INFO_SCRIPT, INFO_SOURCE, INFO_STACKTRACE, INFO_NAMEOFEXECUTABLE,
13732 INFO_RETURNCODES, INFO_REFERENCES, INFO_ALIAS
13735 if (argc < 2) {
13736 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?args ...?");
13737 return JIM_ERR;
13739 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "subcommand", JIM_ERRMSG | JIM_ENUM_ABBREV)
13740 != JIM_OK) {
13741 return JIM_ERR;
13744 /* Test for the the most common commands first, just in case it makes a difference */
13745 switch (cmd) {
13746 case INFO_EXISTS:
13747 if (argc != 3) {
13748 Jim_WrongNumArgs(interp, 2, argv, "varName");
13749 return JIM_ERR;
13751 Jim_SetResultBool(interp, Jim_GetVariable(interp, argv[2], 0) != NULL);
13752 break;
13754 case INFO_ALIAS:{
13755 Jim_Cmd *cmdPtr;
13757 if (argc != 3) {
13758 Jim_WrongNumArgs(interp, 2, argv, "command");
13759 return JIM_ERR;
13761 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
13762 return JIM_ERR;
13764 if (cmdPtr->isproc || cmdPtr->u.native.cmdProc != JimAliasCmd) {
13765 Jim_SetResultFormatted(interp, "command \"%#s\" is not an alias", argv[2]);
13766 return JIM_ERR;
13768 Jim_SetResult(interp, (Jim_Obj *)cmdPtr->u.native.privData);
13769 return JIM_OK;
13772 case INFO_CHANNELS:
13773 mode++; /* JIM_CMDLIST_CHANNELS */
13774 #ifndef jim_ext_aio
13775 Jim_SetResultString(interp, "aio not enabled", -1);
13776 return JIM_ERR;
13777 #endif
13778 case INFO_PROCS:
13779 mode++; /* JIM_CMDLIST_PROCS */
13780 case INFO_COMMANDS:
13781 /* mode 0 => JIM_CMDLIST_COMMANDS */
13782 if (argc != 2 && argc != 3) {
13783 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
13784 return JIM_ERR;
13786 Jim_SetResult(interp, JimCommandsList(interp, (argc == 3) ? argv[2] : NULL, mode));
13787 break;
13789 case INFO_VARS:
13790 mode++; /* JIM_VARLIST_VARS */
13791 case INFO_LOCALS:
13792 mode++; /* JIM_VARLIST_LOCALS */
13793 case INFO_GLOBALS:
13794 /* mode 0 => JIM_VARLIST_GLOBALS */
13795 if (argc != 2 && argc != 3) {
13796 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
13797 return JIM_ERR;
13799 Jim_SetResult(interp, JimVariablesList(interp, argc == 3 ? argv[2] : NULL, mode));
13800 break;
13802 case INFO_SCRIPT:
13803 if (argc != 2) {
13804 Jim_WrongNumArgs(interp, 2, argv, "");
13805 return JIM_ERR;
13807 Jim_SetResult(interp, Jim_GetScript(interp, interp->currentScriptObj)->fileNameObj);
13808 break;
13810 case INFO_SOURCE:{
13811 int line;
13812 Jim_Obj *resObjPtr;
13813 Jim_Obj *fileNameObj;
13815 if (argc != 3) {
13816 Jim_WrongNumArgs(interp, 2, argv, "source");
13817 return JIM_ERR;
13819 if (argv[2]->typePtr == &sourceObjType) {
13820 fileNameObj = argv[2]->internalRep.sourceValue.fileNameObj;
13821 line = argv[2]->internalRep.sourceValue.lineNumber;
13823 else if (argv[2]->typePtr == &scriptObjType) {
13824 ScriptObj *script = Jim_GetScript(interp, argv[2]);
13825 fileNameObj = script->fileNameObj;
13826 line = script->firstline;
13828 else {
13829 fileNameObj = interp->emptyObj;
13830 line = 1;
13832 resObjPtr = Jim_NewListObj(interp, NULL, 0);
13833 Jim_ListAppendElement(interp, resObjPtr, fileNameObj);
13834 Jim_ListAppendElement(interp, resObjPtr, Jim_NewIntObj(interp, line));
13835 Jim_SetResult(interp, resObjPtr);
13836 break;
13839 case INFO_STACKTRACE:
13840 Jim_SetResult(interp, interp->stackTrace);
13841 break;
13843 case INFO_LEVEL:
13844 case INFO_FRAME:
13845 switch (argc) {
13846 case 2:
13847 Jim_SetResultInt(interp, interp->framePtr->level);
13848 break;
13850 case 3:
13851 if (JimInfoLevel(interp, argv[2], &objPtr, cmd == INFO_LEVEL) != JIM_OK) {
13852 return JIM_ERR;
13854 Jim_SetResult(interp, objPtr);
13855 break;
13857 default:
13858 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
13859 return JIM_ERR;
13861 break;
13863 case INFO_BODY:
13864 case INFO_STATICS:
13865 case INFO_ARGS:{
13866 Jim_Cmd *cmdPtr;
13868 if (argc != 3) {
13869 Jim_WrongNumArgs(interp, 2, argv, "procname");
13870 return JIM_ERR;
13872 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
13873 return JIM_ERR;
13875 if (!cmdPtr->isproc) {
13876 Jim_SetResultFormatted(interp, "command \"%#s\" is not a procedure", argv[2]);
13877 return JIM_ERR;
13879 switch (cmd) {
13880 case INFO_BODY:
13881 Jim_SetResult(interp, cmdPtr->u.proc.bodyObjPtr);
13882 break;
13883 case INFO_ARGS:
13884 Jim_SetResult(interp, cmdPtr->u.proc.argListObjPtr);
13885 break;
13886 case INFO_STATICS:
13887 if (cmdPtr->u.proc.staticVars) {
13888 int mode = JIM_VARLIST_LOCALS | JIM_VARLIST_VALUES;
13889 Jim_SetResult(interp, JimHashtablePatternMatch(interp, cmdPtr->u.proc.staticVars,
13890 NULL, JimVariablesMatch, mode));
13892 break;
13894 break;
13897 case INFO_VERSION:
13898 case INFO_PATCHLEVEL:{
13899 char buf[(JIM_INTEGER_SPACE * 2) + 1];
13901 sprintf(buf, "%d.%d", JIM_VERSION / 100, JIM_VERSION % 100);
13902 Jim_SetResultString(interp, buf, -1);
13903 break;
13906 case INFO_COMPLETE:
13907 if (argc != 3 && argc != 4) {
13908 Jim_WrongNumArgs(interp, 2, argv, "script ?missing?");
13909 return JIM_ERR;
13911 else {
13912 int len;
13913 const char *s = Jim_GetString(argv[2], &len);
13914 char missing;
13916 Jim_SetResultBool(interp, Jim_ScriptIsComplete(s, len, &missing));
13917 if (missing != ' ' && argc == 4) {
13918 Jim_SetVariable(interp, argv[3], Jim_NewStringObj(interp, &missing, 1));
13921 break;
13923 case INFO_HOSTNAME:
13924 /* Redirect to os.gethostname if it exists */
13925 return Jim_Eval(interp, "os.gethostname");
13927 case INFO_NAMEOFEXECUTABLE:
13928 /* Redirect to Tcl proc */
13929 return Jim_Eval(interp, "{info nameofexecutable}");
13931 case INFO_RETURNCODES:
13932 if (argc == 2) {
13933 int i;
13934 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
13936 for (i = 0; jimReturnCodes[i]; i++) {
13937 Jim_ListAppendElement(interp, listObjPtr, Jim_NewIntObj(interp, i));
13938 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp,
13939 jimReturnCodes[i], -1));
13942 Jim_SetResult(interp, listObjPtr);
13944 else if (argc == 3) {
13945 long code;
13946 const char *name;
13948 if (Jim_GetLong(interp, argv[2], &code) != JIM_OK) {
13949 return JIM_ERR;
13951 name = Jim_ReturnCode(code);
13952 if (*name == '?') {
13953 Jim_SetResultInt(interp, code);
13955 else {
13956 Jim_SetResultString(interp, name, -1);
13959 else {
13960 Jim_WrongNumArgs(interp, 2, argv, "?code?");
13961 return JIM_ERR;
13963 break;
13964 case INFO_REFERENCES:
13965 #ifdef JIM_REFERENCES
13966 return JimInfoReferences(interp, argc, argv);
13967 #else
13968 Jim_SetResultString(interp, "not supported", -1);
13969 return JIM_ERR;
13970 #endif
13972 return JIM_OK;
13975 /* [exists] */
13976 static int Jim_ExistsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13978 Jim_Obj *objPtr;
13980 static const char * const options[] = {
13981 "-command", "-proc", "-var", NULL
13983 enum
13985 OPT_COMMAND, OPT_PROC, OPT_VAR
13987 int option;
13989 if (argc == 2) {
13990 option = OPT_VAR;
13991 objPtr = argv[1];
13993 else if (argc == 3) {
13994 if (Jim_GetEnum(interp, argv[1], options, &option, NULL, JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
13995 return JIM_ERR;
13997 objPtr = argv[2];
13999 else {
14000 Jim_WrongNumArgs(interp, 1, argv, "?option? name");
14001 return JIM_ERR;
14004 /* Test for the the most common commands first, just in case it makes a difference */
14005 switch (option) {
14006 case OPT_VAR:
14007 Jim_SetResultBool(interp, Jim_GetVariable(interp, objPtr, 0) != NULL);
14008 break;
14010 case OPT_COMMAND:
14011 case OPT_PROC: {
14012 Jim_Cmd *cmd = Jim_GetCommand(interp, objPtr, JIM_NONE);
14013 Jim_SetResultBool(interp, cmd != NULL && (option == OPT_COMMAND || cmd->isproc));
14014 break;
14017 return JIM_OK;
14020 /* [split] */
14021 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14023 const char *str, *splitChars, *noMatchStart;
14024 int splitLen, strLen;
14025 Jim_Obj *resObjPtr;
14026 int c;
14027 int len;
14029 if (argc != 2 && argc != 3) {
14030 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
14031 return JIM_ERR;
14034 str = Jim_GetString(argv[1], &len);
14035 if (len == 0) {
14036 return JIM_OK;
14038 strLen = Jim_Utf8Length(interp, argv[1]);
14040 /* Init */
14041 if (argc == 2) {
14042 splitChars = " \n\t\r";
14043 splitLen = 4;
14045 else {
14046 splitChars = Jim_String(argv[2]);
14047 splitLen = Jim_Utf8Length(interp, argv[2]);
14050 noMatchStart = str;
14051 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14053 /* Split */
14054 if (splitLen) {
14055 Jim_Obj *objPtr;
14056 while (strLen--) {
14057 const char *sc = splitChars;
14058 int scLen = splitLen;
14059 int sl = utf8_tounicode(str, &c);
14060 while (scLen--) {
14061 int pc;
14062 sc += utf8_tounicode(sc, &pc);
14063 if (c == pc) {
14064 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14065 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14066 noMatchStart = str + sl;
14067 break;
14070 str += sl;
14072 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14073 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14075 else {
14076 /* This handles the special case of splitchars eq {}
14077 * Optimise by sharing common (ASCII) characters
14079 Jim_Obj **commonObj = NULL;
14080 #define NUM_COMMON (128 - 9)
14081 while (strLen--) {
14082 int n = utf8_tounicode(str, &c);
14083 #ifdef JIM_OPTIMIZATION
14084 if (c >= 9 && c < 128) {
14085 /* Common ASCII char. Note that 9 is the tab character */
14086 c -= 9;
14087 if (!commonObj) {
14088 commonObj = Jim_Alloc(sizeof(*commonObj) * NUM_COMMON);
14089 memset(commonObj, 0, sizeof(*commonObj) * NUM_COMMON);
14091 if (!commonObj[c]) {
14092 commonObj[c] = Jim_NewStringObj(interp, str, 1);
14094 Jim_ListAppendElement(interp, resObjPtr, commonObj[c]);
14095 str++;
14096 continue;
14098 #endif
14099 Jim_ListAppendElement(interp, resObjPtr, Jim_NewStringObjUtf8(interp, str, 1));
14100 str += n;
14102 Jim_Free(commonObj);
14105 Jim_SetResult(interp, resObjPtr);
14106 return JIM_OK;
14109 /* [join] */
14110 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14112 const char *joinStr;
14113 int joinStrLen;
14115 if (argc != 2 && argc != 3) {
14116 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
14117 return JIM_ERR;
14119 /* Init */
14120 if (argc == 2) {
14121 joinStr = " ";
14122 joinStrLen = 1;
14124 else {
14125 joinStr = Jim_GetString(argv[2], &joinStrLen);
14127 Jim_SetResult(interp, Jim_ListJoin(interp, argv[1], joinStr, joinStrLen));
14128 return JIM_OK;
14131 /* [format] */
14132 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14134 Jim_Obj *objPtr;
14136 if (argc < 2) {
14137 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
14138 return JIM_ERR;
14140 objPtr = Jim_FormatString(interp, argv[1], argc - 2, argv + 2);
14141 if (objPtr == NULL)
14142 return JIM_ERR;
14143 Jim_SetResult(interp, objPtr);
14144 return JIM_OK;
14147 /* [scan] */
14148 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14150 Jim_Obj *listPtr, **outVec;
14151 int outc, i;
14153 if (argc < 3) {
14154 Jim_WrongNumArgs(interp, 1, argv, "string format ?varName varName ...?");
14155 return JIM_ERR;
14157 if (argv[2]->typePtr != &scanFmtStringObjType)
14158 SetScanFmtFromAny(interp, argv[2]);
14159 if (FormatGetError(argv[2]) != 0) {
14160 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
14161 return JIM_ERR;
14163 if (argc > 3) {
14164 int maxPos = FormatGetMaxPos(argv[2]);
14165 int count = FormatGetCnvCount(argv[2]);
14167 if (maxPos > argc - 3) {
14168 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
14169 return JIM_ERR;
14171 else if (count > argc - 3) {
14172 Jim_SetResultString(interp, "different numbers of variable names and "
14173 "field specifiers", -1);
14174 return JIM_ERR;
14176 else if (count < argc - 3) {
14177 Jim_SetResultString(interp, "variable is not assigned by any "
14178 "conversion specifiers", -1);
14179 return JIM_ERR;
14182 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
14183 if (listPtr == 0)
14184 return JIM_ERR;
14185 if (argc > 3) {
14186 int rc = JIM_OK;
14187 int count = 0;
14189 if (listPtr != 0 && listPtr != (Jim_Obj *)EOF) {
14190 int len = Jim_ListLength(interp, listPtr);
14192 if (len != 0) {
14193 JimListGetElements(interp, listPtr, &outc, &outVec);
14194 for (i = 0; i < outc; ++i) {
14195 if (Jim_Length(outVec[i]) > 0) {
14196 ++count;
14197 if (Jim_SetVariable(interp, argv[3 + i], outVec[i]) != JIM_OK) {
14198 rc = JIM_ERR;
14203 Jim_FreeNewObj(interp, listPtr);
14205 else {
14206 count = -1;
14208 if (rc == JIM_OK) {
14209 Jim_SetResultInt(interp, count);
14211 return rc;
14213 else {
14214 if (listPtr == (Jim_Obj *)EOF) {
14215 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
14216 return JIM_OK;
14218 Jim_SetResult(interp, listPtr);
14220 return JIM_OK;
14223 /* [error] */
14224 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14226 if (argc != 2 && argc != 3) {
14227 Jim_WrongNumArgs(interp, 1, argv, "message ?stacktrace?");
14228 return JIM_ERR;
14230 Jim_SetResult(interp, argv[1]);
14231 if (argc == 3) {
14232 JimSetStackTrace(interp, argv[2]);
14233 return JIM_ERR;
14235 interp->addStackTrace++;
14236 return JIM_ERR;
14239 /* [lrange] */
14240 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14242 Jim_Obj *objPtr;
14244 if (argc != 4) {
14245 Jim_WrongNumArgs(interp, 1, argv, "list first last");
14246 return JIM_ERR;
14248 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
14249 return JIM_ERR;
14250 Jim_SetResult(interp, objPtr);
14251 return JIM_OK;
14254 /* [lrepeat] */
14255 static int Jim_LrepeatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14257 Jim_Obj *objPtr;
14258 long count;
14260 if (argc < 2 || Jim_GetLong(interp, argv[1], &count) != JIM_OK || count < 0) {
14261 Jim_WrongNumArgs(interp, 1, argv, "count ?value ...?");
14262 return JIM_ERR;
14265 if (count == 0 || argc == 2) {
14266 return JIM_OK;
14269 argc -= 2;
14270 argv += 2;
14272 objPtr = Jim_NewListObj(interp, argv, argc);
14273 while (--count) {
14274 ListInsertElements(objPtr, -1, argc, argv);
14277 Jim_SetResult(interp, objPtr);
14278 return JIM_OK;
14281 char **Jim_GetEnviron(void)
14283 #if defined(HAVE__NSGETENVIRON)
14284 return *_NSGetEnviron();
14285 #else
14286 #if !defined(NO_ENVIRON_EXTERN)
14287 extern char **environ;
14288 #endif
14290 return environ;
14291 #endif
14294 void Jim_SetEnviron(char **env)
14296 #if defined(HAVE__NSGETENVIRON)
14297 *_NSGetEnviron() = env;
14298 #else
14299 #if !defined(NO_ENVIRON_EXTERN)
14300 extern char **environ;
14301 #endif
14303 environ = env;
14304 #endif
14307 /* [env] */
14308 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14310 const char *key;
14311 const char *val;
14313 if (argc == 1) {
14314 char **e = Jim_GetEnviron();
14316 int i;
14317 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14319 for (i = 0; e[i]; i++) {
14320 const char *equals = strchr(e[i], '=');
14322 if (equals) {
14323 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, e[i],
14324 equals - e[i]));
14325 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
14329 Jim_SetResult(interp, listObjPtr);
14330 return JIM_OK;
14333 if (argc < 2) {
14334 Jim_WrongNumArgs(interp, 1, argv, "varName ?default?");
14335 return JIM_ERR;
14337 key = Jim_String(argv[1]);
14338 val = getenv(key);
14339 if (val == NULL) {
14340 if (argc < 3) {
14341 Jim_SetResultFormatted(interp, "environment variable \"%#s\" does not exist", argv[1]);
14342 return JIM_ERR;
14344 val = Jim_String(argv[2]);
14346 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
14347 return JIM_OK;
14350 /* [source] */
14351 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14353 int retval;
14355 if (argc != 2) {
14356 Jim_WrongNumArgs(interp, 1, argv, "fileName");
14357 return JIM_ERR;
14359 retval = Jim_EvalFile(interp, Jim_String(argv[1]));
14360 if (retval == JIM_RETURN)
14361 return JIM_OK;
14362 return retval;
14365 /* [lreverse] */
14366 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14368 Jim_Obj *revObjPtr, **ele;
14369 int len;
14371 if (argc != 2) {
14372 Jim_WrongNumArgs(interp, 1, argv, "list");
14373 return JIM_ERR;
14375 JimListGetElements(interp, argv[1], &len, &ele);
14376 len--;
14377 revObjPtr = Jim_NewListObj(interp, NULL, 0);
14378 while (len >= 0)
14379 ListAppendElement(revObjPtr, ele[len--]);
14380 Jim_SetResult(interp, revObjPtr);
14381 return JIM_OK;
14384 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
14386 jim_wide len;
14388 if (step == 0)
14389 return -1;
14390 if (start == end)
14391 return 0;
14392 else if (step > 0 && start > end)
14393 return -1;
14394 else if (step < 0 && end > start)
14395 return -1;
14396 len = end - start;
14397 if (len < 0)
14398 len = -len; /* abs(len) */
14399 if (step < 0)
14400 step = -step; /* abs(step) */
14401 len = 1 + ((len - 1) / step);
14402 /* We can truncate safely to INT_MAX, the range command
14403 * will always return an error for a such long range
14404 * because Tcl lists can't be so long. */
14405 if (len > INT_MAX)
14406 len = INT_MAX;
14407 return (int)((len < 0) ? -1 : len);
14410 /* [range] */
14411 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14413 jim_wide start = 0, end, step = 1;
14414 int len, i;
14415 Jim_Obj *objPtr;
14417 if (argc < 2 || argc > 4) {
14418 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
14419 return JIM_ERR;
14421 if (argc == 2) {
14422 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
14423 return JIM_ERR;
14425 else {
14426 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
14427 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
14428 return JIM_ERR;
14429 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
14430 return JIM_ERR;
14432 if ((len = JimRangeLen(start, end, step)) == -1) {
14433 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
14434 return JIM_ERR;
14436 objPtr = Jim_NewListObj(interp, NULL, 0);
14437 for (i = 0; i < len; i++)
14438 ListAppendElement(objPtr, Jim_NewIntObj(interp, start + i * step));
14439 Jim_SetResult(interp, objPtr);
14440 return JIM_OK;
14443 /* [rand] */
14444 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14446 jim_wide min = 0, max = 0, len, maxMul;
14448 if (argc < 1 || argc > 3) {
14449 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
14450 return JIM_ERR;
14452 if (argc == 1) {
14453 max = JIM_WIDE_MAX;
14454 } else if (argc == 2) {
14455 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
14456 return JIM_ERR;
14457 } else if (argc == 3) {
14458 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
14459 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
14460 return JIM_ERR;
14462 len = max-min;
14463 if (len < 0) {
14464 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
14465 return JIM_ERR;
14467 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
14468 while (1) {
14469 jim_wide r;
14471 JimRandomBytes(interp, &r, sizeof(jim_wide));
14472 if (r < 0 || r >= maxMul) continue;
14473 r = (len == 0) ? 0 : r%len;
14474 Jim_SetResultInt(interp, min+r);
14475 return JIM_OK;
14479 static const struct {
14480 const char *name;
14481 Jim_CmdProc cmdProc;
14482 } Jim_CoreCommandsTable[] = {
14483 {"alias", Jim_AliasCoreCommand},
14484 {"set", Jim_SetCoreCommand},
14485 {"unset", Jim_UnsetCoreCommand},
14486 {"puts", Jim_PutsCoreCommand},
14487 {"+", Jim_AddCoreCommand},
14488 {"*", Jim_MulCoreCommand},
14489 {"-", Jim_SubCoreCommand},
14490 {"/", Jim_DivCoreCommand},
14491 {"incr", Jim_IncrCoreCommand},
14492 {"while", Jim_WhileCoreCommand},
14493 {"loop", Jim_LoopCoreCommand},
14494 {"for", Jim_ForCoreCommand},
14495 {"foreach", Jim_ForeachCoreCommand},
14496 {"lmap", Jim_LmapCoreCommand},
14497 {"lassign", Jim_LassignCoreCommand},
14498 {"if", Jim_IfCoreCommand},
14499 {"switch", Jim_SwitchCoreCommand},
14500 {"list", Jim_ListCoreCommand},
14501 {"lindex", Jim_LindexCoreCommand},
14502 {"lset", Jim_LsetCoreCommand},
14503 {"lsearch", Jim_LsearchCoreCommand},
14504 {"llength", Jim_LlengthCoreCommand},
14505 {"lappend", Jim_LappendCoreCommand},
14506 {"linsert", Jim_LinsertCoreCommand},
14507 {"lreplace", Jim_LreplaceCoreCommand},
14508 {"lsort", Jim_LsortCoreCommand},
14509 {"append", Jim_AppendCoreCommand},
14510 {"debug", Jim_DebugCoreCommand},
14511 {"eval", Jim_EvalCoreCommand},
14512 {"uplevel", Jim_UplevelCoreCommand},
14513 {"expr", Jim_ExprCoreCommand},
14514 {"break", Jim_BreakCoreCommand},
14515 {"continue", Jim_ContinueCoreCommand},
14516 {"proc", Jim_ProcCoreCommand},
14517 {"concat", Jim_ConcatCoreCommand},
14518 {"return", Jim_ReturnCoreCommand},
14519 {"upvar", Jim_UpvarCoreCommand},
14520 {"global", Jim_GlobalCoreCommand},
14521 {"string", Jim_StringCoreCommand},
14522 {"time", Jim_TimeCoreCommand},
14523 {"exit", Jim_ExitCoreCommand},
14524 {"catch", Jim_CatchCoreCommand},
14525 #ifdef JIM_REFERENCES
14526 {"ref", Jim_RefCoreCommand},
14527 {"getref", Jim_GetrefCoreCommand},
14528 {"setref", Jim_SetrefCoreCommand},
14529 {"finalize", Jim_FinalizeCoreCommand},
14530 {"collect", Jim_CollectCoreCommand},
14531 #endif
14532 {"rename", Jim_RenameCoreCommand},
14533 {"dict", Jim_DictCoreCommand},
14534 {"subst", Jim_SubstCoreCommand},
14535 {"info", Jim_InfoCoreCommand},
14536 {"exists", Jim_ExistsCoreCommand},
14537 {"split", Jim_SplitCoreCommand},
14538 {"join", Jim_JoinCoreCommand},
14539 {"format", Jim_FormatCoreCommand},
14540 {"scan", Jim_ScanCoreCommand},
14541 {"error", Jim_ErrorCoreCommand},
14542 {"lrange", Jim_LrangeCoreCommand},
14543 {"lrepeat", Jim_LrepeatCoreCommand},
14544 {"env", Jim_EnvCoreCommand},
14545 {"source", Jim_SourceCoreCommand},
14546 {"lreverse", Jim_LreverseCoreCommand},
14547 {"range", Jim_RangeCoreCommand},
14548 {"rand", Jim_RandCoreCommand},
14549 {"tailcall", Jim_TailcallCoreCommand},
14550 {"local", Jim_LocalCoreCommand},
14551 {"upcall", Jim_UpcallCoreCommand},
14552 {NULL, NULL},
14555 void Jim_RegisterCoreCommands(Jim_Interp *interp)
14557 int i = 0;
14559 while (Jim_CoreCommandsTable[i].name != NULL) {
14560 Jim_CreateCommand(interp,
14561 Jim_CoreCommandsTable[i].name, Jim_CoreCommandsTable[i].cmdProc, NULL, NULL);
14562 i++;
14566 /* -----------------------------------------------------------------------------
14567 * Interactive prompt
14568 * ---------------------------------------------------------------------------*/
14569 void Jim_MakeErrorMessage(Jim_Interp *interp)
14571 Jim_Obj *argv[2];
14573 argv[0] = Jim_NewStringObj(interp, "errorInfo", -1);
14574 argv[1] = interp->result;
14576 Jim_EvalObjVector(interp, 2, argv);
14579 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
14580 const char *prefix, const char *const *tablePtr, const char *name)
14582 int count;
14583 char **tablePtrSorted;
14584 int i;
14586 for (count = 0; tablePtr[count]; count++) {
14589 if (name == NULL) {
14590 name = "option";
14593 Jim_SetResultFormatted(interp, "%s%s \"%s\": must be ", badtype, name, arg);
14594 tablePtrSorted = Jim_Alloc(sizeof(char *) * count);
14595 memcpy(tablePtrSorted, tablePtr, sizeof(char *) * count);
14596 qsort(tablePtrSorted, count, sizeof(char *), qsortCompareStringPointers);
14597 for (i = 0; i < count; i++) {
14598 if (i + 1 == count && count > 1) {
14599 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
14601 Jim_AppendStrings(interp, Jim_GetResult(interp), prefix, tablePtrSorted[i], NULL);
14602 if (i + 1 != count) {
14603 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
14606 Jim_Free(tablePtrSorted);
14609 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
14610 const char *const *tablePtr, int *indexPtr, const char *name, int flags)
14612 const char *bad = "bad ";
14613 const char *const *entryPtr = NULL;
14614 int i;
14615 int match = -1;
14616 int arglen;
14617 const char *arg = Jim_GetString(objPtr, &arglen);
14619 *indexPtr = -1;
14621 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
14622 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
14623 /* Found an exact match */
14624 *indexPtr = i;
14625 return JIM_OK;
14627 if (flags & JIM_ENUM_ABBREV) {
14628 /* Accept an unambiguous abbreviation.
14629 * Note that '-' doesnt' consitute a valid abbreviation
14631 if (strncmp(arg, *entryPtr, arglen) == 0) {
14632 if (*arg == '-' && arglen == 1) {
14633 break;
14635 if (match >= 0) {
14636 bad = "ambiguous ";
14637 goto ambiguous;
14639 match = i;
14644 /* If we had an unambiguous partial match */
14645 if (match >= 0) {
14646 *indexPtr = match;
14647 return JIM_OK;
14650 ambiguous:
14651 if (flags & JIM_ERRMSG) {
14652 JimSetFailedEnumResult(interp, arg, bad, "", tablePtr, name);
14654 return JIM_ERR;
14657 int Jim_FindByName(const char *name, const char * const array[], size_t len)
14659 int i;
14661 for (i = 0; i < (int)len; i++) {
14662 if (array[i] && strcmp(array[i], name) == 0) {
14663 return i;
14666 return -1;
14669 int Jim_IsDict(Jim_Obj *objPtr)
14671 return objPtr->typePtr == &dictObjType;
14674 int Jim_IsList(Jim_Obj *objPtr)
14676 return objPtr->typePtr == &listObjType;
14680 * Very simple printf-like formatting, designed for error messages.
14682 * The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
14683 * The resulting string is created and set as the result.
14685 * Each '%s' should correspond to a regular string parameter.
14686 * Each '%#s' should correspond to a (Jim_Obj *) parameter.
14687 * Any other printf specifier is not allowed (but %% is allowed for the % character).
14689 * e.g. Jim_SetResultFormatted(interp, "Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
14691 * Note: We take advantage of the fact that printf has the same behaviour for both %s and %#s
14693 void Jim_SetResultFormatted(Jim_Interp *interp, const char *format, ...)
14695 /* Initial space needed */
14696 int len = strlen(format);
14697 int extra = 0;
14698 int n = 0;
14699 const char *params[5];
14700 char *buf;
14701 va_list args;
14702 int i;
14704 va_start(args, format);
14706 for (i = 0; i < len && n < 5; i++) {
14707 int l;
14709 if (strncmp(format + i, "%s", 2) == 0) {
14710 params[n] = va_arg(args, char *);
14712 l = strlen(params[n]);
14714 else if (strncmp(format + i, "%#s", 3) == 0) {
14715 Jim_Obj *objPtr = va_arg(args, Jim_Obj *);
14717 params[n] = Jim_GetString(objPtr, &l);
14719 else {
14720 if (format[i] == '%') {
14721 i++;
14723 continue;
14725 n++;
14726 extra += l;
14729 len += extra;
14730 buf = Jim_Alloc(len + 1);
14731 len = snprintf(buf, len + 1, format, params[0], params[1], params[2], params[3], params[4]);
14733 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
14736 /* stubs */
14737 #ifndef jim_ext_package
14738 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver, int flags)
14740 return JIM_OK;
14742 #endif
14743 #ifndef jim_ext_aio
14744 FILE *Jim_AioFilehandle(Jim_Interp *interp, Jim_Obj *fhObj)
14746 Jim_SetResultString(interp, "aio not enabled", -1);
14747 return NULL;
14749 #endif
14753 * Local Variables: ***
14754 * c-basic-offset: 4 ***
14755 * tab-width: 4 ***
14756 * End: ***