core: improve performance through negative command caching
[jimtcl.git] / jim.c
blob72b6c3ff9432360ca4300604c5a03d328cca99f4
1 /* Jim - A small embeddable Tcl interpreter
3 * Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
4 * Copyright 2005 Clemens Hintze <c.hintze@gmx.net>
5 * Copyright 2005 patthoyts - Pat Thoyts <patthoyts@users.sf.net>
6 * Copyright 2008,2009 oharboe - Øyvind Harboe - oyvind.harboe@zylin.com
7 * Copyright 2008 Andrew Lunn <andrew@lunn.ch>
8 * Copyright 2008 Duane Ellis <openocd@duaneellis.com>
9 * Copyright 2008 Uwe Klein <uklein@klein-messgeraete.de>
10 * Copyright 2008 Steve Bennett <steveb@workware.net.au>
11 * Copyright 2009 Nico Coesel <ncoesel@dealogic.nl>
12 * Copyright 2009 Zachary T Welch zw@superlucidity.net
13 * Copyright 2009 David Brownell
15 * Redistribution and use in source and binary forms, with or without
16 * modification, are permitted provided that the following conditions
17 * are met:
19 * 1. Redistributions of source code must retain the above copyright
20 * notice, this list of conditions and the following disclaimer.
21 * 2. Redistributions in binary form must reproduce the above
22 * copyright notice, this list of conditions and the following
23 * disclaimer in the documentation and/or other materials
24 * provided with the distribution.
26 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
27 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
28 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
29 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
30 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
31 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
32 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
33 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
34 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
35 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
36 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
37 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
39 * The views and conclusions contained in the software and documentation
40 * are those of the authors and should not be interpreted as representing
41 * official policies, either expressed or implied, of the Jim Tcl Project.
42 **/
43 #define JIM_OPTIMIZATION /* comment to avoid optimizations and reduce size */
44 #ifndef _GNU_SOURCE
45 #define _GNU_SOURCE /* Mostly just for environ */
46 #endif
48 #include <stdio.h>
49 #include <stdlib.h>
51 #include <string.h>
52 #include <stdarg.h>
53 #include <ctype.h>
54 #include <limits.h>
55 #include <assert.h>
56 #include <errno.h>
57 #include <time.h>
58 #include <setjmp.h>
60 #include "jim.h"
61 #include "jimautoconf.h"
62 #include "utf8.h"
64 #ifdef HAVE_SYS_TIME_H
65 #include <sys/time.h>
66 #endif
67 #ifdef HAVE_BACKTRACE
68 #include <execinfo.h>
69 #endif
70 #ifdef HAVE_CRT_EXTERNS_H
71 #include <crt_externs.h>
72 #endif
74 /* For INFINITY, even if math functions are not enabled */
75 #include <math.h>
77 /* We may decide to switch to using $[...] after all, so leave it as an option */
78 /*#define EXPRSUGAR_BRACKET*/
80 /* For the no-autoconf case */
81 #ifndef TCL_LIBRARY
82 #define TCL_LIBRARY "."
83 #endif
84 #ifndef TCL_PLATFORM_OS
85 #define TCL_PLATFORM_OS "unknown"
86 #endif
87 #ifndef TCL_PLATFORM_PLATFORM
88 #define TCL_PLATFORM_PLATFORM "unknown"
89 #endif
90 #ifndef TCL_PLATFORM_PATH_SEPARATOR
91 #define TCL_PLATFORM_PATH_SEPARATOR ":"
92 #endif
94 /*#define DEBUG_SHOW_SCRIPT*/
95 /*#define DEBUG_SHOW_SCRIPT_TOKENS*/
96 /*#define DEBUG_SHOW_SUBST*/
97 /*#define DEBUG_SHOW_EXPR*/
98 /*#define DEBUG_SHOW_EXPR_TOKENS*/
99 /*#define JIM_DEBUG_GC*/
100 #ifdef JIM_MAINTAINER
101 #define JIM_DEBUG_COMMAND
102 #define JIM_DEBUG_PANIC
103 #endif
104 /* Enable this (in conjunction with valgrind) to help debug
105 * reference counting issues
107 /*#define JIM_DISABLE_OBJECT_POOL*/
109 /* Maximum size of an integer */
110 #define JIM_INTEGER_SPACE 24
112 const char *jim_tt_name(int type);
114 #ifdef JIM_DEBUG_PANIC
115 static void JimPanicDump(int fail_condition, const char *fmt, ...);
116 #define JimPanic(X) JimPanicDump X
117 #else
118 #define JimPanic(X)
119 #endif
121 #ifdef JIM_OPTIMIZATION
122 #define JIM_IF_OPTIM(X) X
123 #else
124 #define JIM_IF_OPTIM(X)
125 #endif
127 /* -----------------------------------------------------------------------------
128 * Global variables
129 * ---------------------------------------------------------------------------*/
131 /* A shared empty string for the objects string representation.
132 * Jim_InvalidateStringRep knows about it and doesn't try to free it. */
133 static char JimEmptyStringRep[] = "";
135 /* -----------------------------------------------------------------------------
136 * Required prototypes of not exported functions
137 * ---------------------------------------------------------------------------*/
138 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action);
139 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int listindex, Jim_Obj *newObjPtr,
140 int flags);
141 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands);
142 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr);
143 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
144 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len);
145 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
146 const char *prefix, const char *const *tablePtr, const char *name);
147 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv);
148 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr);
149 static int JimSign(jim_wide w);
150 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen);
151 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len);
152 static int JimSetNewVariable(Jim_HashTable *ht, Jim_Obj *nameObjPtr, Jim_Var *var);
153 static Jim_Var *JimFindVariable(Jim_HashTable *ht, Jim_Obj *nameObjPtr);
156 /* Fast access to the int (wide) value of an object which is known to be of int type */
157 #define JimWideValue(objPtr) (objPtr)->internalRep.wideValue
159 #define JimObjTypeName(O) ((O)->typePtr ? (O)->typePtr->name : "none")
161 static int utf8_tounicode_case(const char *s, int *uc, int upper)
163 int l = utf8_tounicode(s, uc);
164 if (upper) {
165 *uc = utf8_upper(*uc);
167 return l;
170 /* These can be used in addition to JIM_CASESENS/JIM_NOCASE */
171 #define JIM_CHARSET_SCAN 2
172 #define JIM_CHARSET_GLOB 0
175 * pattern points to a string like "[^a-z\ub5]"
177 * The pattern may contain trailing chars, which are ignored.
179 * The pattern is matched against unicode char 'c'.
181 * If (flags & JIM_NOCASE), case is ignored when matching.
182 * If (flags & JIM_CHARSET_SCAN), the considers ^ and ] special at the start
183 * of the charset, per scan, rather than glob/string match.
185 * If the unicode char 'c' matches that set, returns a pointer to the ']' character,
186 * or the null character if the ']' is missing.
188 * Returns NULL on no match.
190 static const char *JimCharsetMatch(const char *pattern, int plen, int c, int flags)
192 int not = 0;
193 int pchar;
194 int match = 0;
195 int nocase = 0;
196 int n;
198 if (flags & JIM_NOCASE) {
199 nocase++;
200 c = utf8_upper(c);
203 if (flags & JIM_CHARSET_SCAN) {
204 if (*pattern == '^') {
205 not++;
206 pattern++;
207 plen--;
210 /* Special case. If the first char is ']', it is part of the set */
211 if (*pattern == ']') {
212 goto first;
216 while (plen && *pattern != ']') {
217 /* Exact match */
218 if (pattern[0] == '\\') {
219 first:
220 n = utf8_tounicode_case(pattern, &pchar, nocase);
221 pattern += n;
222 plen -= n;
224 else {
225 /* Is this a range? a-z */
226 int start;
227 int end;
229 n = utf8_tounicode_case(pattern, &start, nocase);
230 pattern += n;
231 plen -= n;
232 if (pattern[0] == '-' && plen > 1) {
233 /* skip '-' */
234 n = 1 + utf8_tounicode_case(pattern + 1, &end, nocase);
235 pattern += n;
236 plen -= n;
238 /* Handle reversed range too */
239 if ((c >= start && c <= end) || (c >= end && c <= start)) {
240 match = 1;
242 continue;
244 pchar = start;
247 if (pchar == c) {
248 match = 1;
251 if (not) {
252 match = !match;
255 return match ? pattern : NULL;
258 /* Glob-style pattern matching. */
260 /* Note: string *must* be valid UTF-8 sequences
262 static int JimGlobMatch(const char *pattern, int plen, const char *string, int slen, int nocase)
264 int c;
265 int pchar;
266 int n;
267 const char *p;
268 while (plen) {
269 switch (pattern[0]) {
270 case '*':
271 while (pattern[1] == '*' && plen) {
272 pattern++;
273 plen--;
275 pattern++;
276 plen--;
277 if (!plen) {
278 return 1; /* match */
280 while (slen) {
281 /* Recursive call - Does the remaining pattern match anywhere? */
282 if (JimGlobMatch(pattern, plen, string, slen, nocase))
283 return 1; /* match */
284 n = utf8_tounicode(string, &c);
285 string += n;
286 slen -= n;
288 return 0; /* no match */
290 case '?':
291 n = utf8_tounicode(string, &c);
292 string += n;
293 slen -= n;
294 break;
296 case '[': {
297 n = utf8_tounicode(string, &c);
298 string += n;
299 slen -= n;
300 p = JimCharsetMatch(pattern + 1, plen - 1, c, nocase ? JIM_NOCASE : 0);
301 if (!p) {
302 return 0;
304 plen -= p - pattern;
305 pattern = p;
307 if (!plen) {
308 /* Ran out of pattern (no ']') */
309 continue;
311 break;
313 case '\\':
314 if (pattern[1]) {
315 pattern++;
316 plen--;
318 /* fall through */
319 default:
320 n = utf8_tounicode_case(string, &c, nocase);
321 string += n;
322 slen -= n;
323 utf8_tounicode_case(pattern, &pchar, nocase);
324 if (pchar != c) {
325 return 0;
327 break;
329 n = utf8_tounicode_case(pattern, &pchar, nocase);
330 pattern += n;
331 plen -= n;
332 if (!slen) {
333 while (*pattern == '*' && plen) {
334 pattern++;
335 plen--;
337 break;
340 if (!plen && !slen) {
341 return 1;
343 return 0;
347 * utf-8 string comparison. case-insensitive if nocase is set.
349 * Returns -1, 0 or 1
351 * Note that the lengths are character lengths, not byte lengths.
353 static int JimStringCompareUtf8(const char *s1, int l1, const char *s2, int l2, int nocase)
355 int minlen = l1;
356 if (l2 < l1) {
357 minlen = l2;
359 while (minlen) {
360 int c1, c2;
361 s1 += utf8_tounicode_case(s1, &c1, nocase);
362 s2 += utf8_tounicode_case(s2, &c2, nocase);
363 if (c1 != c2) {
364 return JimSign(c1 - c2);
366 minlen--;
368 /* Equal to this point, so the shorter string is less */
369 if (l1 < l2) {
370 return -1;
372 if (l1 > l2) {
373 return 1;
375 return 0;
378 /* Search for 's1' inside 's2', starting to search from char 'index' of 's2'.
379 * The index of the first occurrence of s1 in s2 is returned.
380 * If s1 is not found inside s2, -1 is returned.
382 * Note: Lengths and return value are in bytes, not chars.
384 static int JimStringFirst(const char *s1, int l1, const char *s2, int l2, int idx)
386 int i;
387 int l1bytelen;
389 if (!l1 || !l2 || l1 > l2) {
390 return -1;
392 if (idx < 0)
393 idx = 0;
394 s2 += utf8_index(s2, idx);
396 l1bytelen = utf8_index(s1, l1);
398 for (i = idx; i <= l2 - l1; i++) {
399 int c;
400 if (memcmp(s2, s1, l1bytelen) == 0) {
401 return i;
403 s2 += utf8_tounicode(s2, &c);
405 return -1;
408 /* Search for the last occurrence 's1' inside 's2', starting to search from char 'index' of 's2'.
409 * The index of the last occurrence of s1 in s2 is returned.
410 * If s1 is not found inside s2, -1 is returned.
412 * Note: Lengths and return value are in bytes, not chars.
414 static int JimStringLast(const char *s1, int l1, const char *s2, int l2)
416 const char *p;
418 if (!l1 || !l2 || l1 > l2)
419 return -1;
421 /* Now search for the needle */
422 for (p = s2 + l2 - 1; p != s2 - 1; p--) {
423 if (*p == *s1 && memcmp(s1, p, l1) == 0) {
424 return p - s2;
427 return -1;
430 #ifdef JIM_UTF8
432 * Per JimStringLast but lengths and return value are in chars, not bytes.
434 static int JimStringLastUtf8(const char *s1, int l1, const char *s2, int l2)
436 int n = JimStringLast(s1, utf8_index(s1, l1), s2, utf8_index(s2, l2));
437 if (n > 0) {
438 n = utf8_strlen(s2, n);
440 return n;
442 #endif
445 * After an strtol()/strtod()-like conversion,
446 * check whether something was converted and that
447 * the only thing left is white space.
449 * Returns JIM_OK or JIM_ERR.
451 static int JimCheckConversion(const char *str, const char *endptr)
453 if (str[0] == '\0' || str == endptr) {
454 return JIM_ERR;
457 if (endptr[0] != '\0') {
458 while (*endptr) {
459 if (!isspace(UCHAR(*endptr))) {
460 return JIM_ERR;
462 endptr++;
465 return JIM_OK;
468 /* Parses the front of a number to determine its sign and base.
469 * Returns the index to start parsing according to the given base
471 static int JimNumberBase(const char *str, int *base, int *sign)
473 int i = 0;
475 *base = 10;
477 while (isspace(UCHAR(str[i]))) {
478 i++;
481 if (str[i] == '-') {
482 *sign = -1;
483 i++;
485 else {
486 if (str[i] == '+') {
487 i++;
489 *sign = 1;
492 if (str[i] != '0') {
493 /* base 10 */
494 return 0;
497 /* We have 0<x>, so see if we can convert it */
498 switch (str[i + 1]) {
499 case 'x': case 'X': *base = 16; break;
500 case 'o': case 'O': *base = 8; break;
501 case 'b': case 'B': *base = 2; break;
502 default: return 0;
504 i += 2;
505 /* Ensure that (e.g.) 0x-5 fails to parse */
506 if (str[i] != '-' && str[i] != '+' && !isspace(UCHAR(str[i]))) {
507 /* Parse according to this base */
508 return i;
510 /* Parse as base 10 */
511 *base = 10;
512 return 0;
515 /* Converts a number as per strtol(..., 0) except leading zeros do *not*
516 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
518 static long jim_strtol(const char *str, char **endptr)
520 int sign;
521 int base;
522 int i = JimNumberBase(str, &base, &sign);
524 if (base != 10) {
525 long value = strtol(str + i, endptr, base);
526 if (endptr == NULL || *endptr != str + i) {
527 return value * sign;
531 /* Can just do a regular base-10 conversion */
532 return strtol(str, endptr, 10);
536 /* Converts a number as per strtoull(..., 0) except leading zeros do *not*
537 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
539 static jim_wide jim_strtoull(const char *str, char **endptr)
541 #ifdef HAVE_LONG_LONG
542 int sign;
543 int base;
544 int i = JimNumberBase(str, &base, &sign);
546 if (base != 10) {
547 jim_wide value = strtoull(str + i, endptr, base);
548 if (endptr == NULL || *endptr != str + i) {
549 return value * sign;
553 /* Can just do a regular base-10 conversion */
554 return strtoull(str, endptr, 10);
555 #else
556 return (unsigned long)jim_strtol(str, endptr);
557 #endif
560 int Jim_StringToWide(const char *str, jim_wide * widePtr, int base)
562 char *endptr;
564 if (base) {
565 *widePtr = strtoull(str, &endptr, base);
567 else {
568 *widePtr = jim_strtoull(str, &endptr);
571 return JimCheckConversion(str, endptr);
574 int Jim_StringToDouble(const char *str, double *doublePtr)
576 char *endptr;
578 /* Callers can check for underflow via ERANGE */
579 errno = 0;
581 *doublePtr = strtod(str, &endptr);
583 return JimCheckConversion(str, endptr);
586 static jim_wide JimPowWide(jim_wide b, jim_wide e)
588 jim_wide res = 1;
590 /* Special cases */
591 if (b == 1) {
592 /* 1 ^ any = 1 */
593 return 1;
595 if (e < 0) {
596 if (b != -1) {
597 return 0;
599 /* Only special case is -1 ^ -n
600 * -1^-1 = -1
601 * -1^-2 = 1
602 * i.e. same as +ve n
604 e = -e;
606 while (e)
608 if (e & 1) {
609 res *= b;
611 e >>= 1;
612 b *= b;
614 return res;
617 /* -----------------------------------------------------------------------------
618 * Special functions
619 * ---------------------------------------------------------------------------*/
620 #ifdef JIM_DEBUG_PANIC
621 static void JimPanicDump(int condition, const char *fmt, ...)
623 va_list ap;
625 if (!condition) {
626 return;
629 va_start(ap, fmt);
631 fprintf(stderr, "\nJIM INTERPRETER PANIC: ");
632 vfprintf(stderr, fmt, ap);
633 fprintf(stderr, "\n\n");
634 va_end(ap);
636 #ifdef HAVE_BACKTRACE
638 void *array[40];
639 int size, i;
640 char **strings;
642 size = backtrace(array, 40);
643 strings = backtrace_symbols(array, size);
644 for (i = 0; i < size; i++)
645 fprintf(stderr, "[backtrace] %s\n", strings[i]);
646 fprintf(stderr, "[backtrace] Include the above lines and the output\n");
647 fprintf(stderr, "[backtrace] of 'nm <executable>' in the bug report.\n");
649 #endif
651 exit(1);
653 #endif
655 /* -----------------------------------------------------------------------------
656 * Memory allocation
657 * ---------------------------------------------------------------------------*/
659 void *Jim_Alloc(int size)
661 return size ? malloc(size) : NULL;
664 void Jim_Free(void *ptr)
666 free(ptr);
669 void *Jim_Realloc(void *ptr, int size)
671 return realloc(ptr, size);
674 char *Jim_StrDup(const char *s)
676 return strdup(s);
679 char *Jim_StrDupLen(const char *s, int l)
681 char *copy = Jim_Alloc(l + 1);
683 memcpy(copy, s, l + 1);
684 copy[l] = 0; /* Just to be sure, original could be substring */
685 return copy;
688 /* -----------------------------------------------------------------------------
689 * Time related functions
690 * ---------------------------------------------------------------------------*/
692 /* Returns current time in microseconds */
693 static jim_wide JimClock(void)
695 struct timeval tv;
697 gettimeofday(&tv, NULL);
698 return (jim_wide) tv.tv_sec * 1000000 + tv.tv_usec;
701 /* -----------------------------------------------------------------------------
702 * Hash Tables
703 * ---------------------------------------------------------------------------*/
705 /* -------------------------- private prototypes ---------------------------- */
706 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht);
707 static unsigned int JimHashTableNextPower(unsigned int size);
708 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace);
710 /* -------------------------- hash functions -------------------------------- */
712 /* Thomas Wang's 32 bit Mix Function */
713 unsigned int Jim_IntHashFunction(unsigned int key)
715 key += ~(key << 15);
716 key ^= (key >> 10);
717 key += (key << 3);
718 key ^= (key >> 6);
719 key += ~(key << 11);
720 key ^= (key >> 16);
721 return key;
724 /* Generic hash function (we are using to multiply by 9 and add the byte
725 * as Tcl) */
726 unsigned int Jim_GenHashFunction(const unsigned char *buf, int len)
728 unsigned int h = 0;
730 while (len--)
731 h += (h << 3) + *buf++;
732 return h;
735 /* ----------------------------- API implementation ------------------------- */
738 * Reset a hashtable already initialized.
739 * The table data should already have been freed.
741 * Note that type and privdata are not initialised
742 * to allow the now-empty hashtable to be reused
744 static void JimResetHashTable(Jim_HashTable *ht)
746 ht->table = NULL;
747 ht->size = 0;
748 ht->sizemask = 0;
749 ht->used = 0;
750 ht->collisions = 0;
751 #ifdef JIM_RANDOMISE_HASH
752 /* This is initialised to a random value to avoid a hash collision attack.
753 * See: n.runs-SA-2011.004
755 ht->uniq = (rand() ^ time(NULL) ^ clock());
756 #else
757 ht->uniq = 0;
758 #endif
761 static void JimInitHashTableIterator(Jim_HashTable *ht, Jim_HashTableIterator *iter)
763 iter->ht = ht;
764 iter->index = -1;
765 iter->entry = NULL;
766 iter->nextEntry = NULL;
769 /* Initialize the hash table */
770 int Jim_InitHashTable(Jim_HashTable *ht, const Jim_HashTableType *type, void *privDataPtr)
772 JimResetHashTable(ht);
773 ht->type = type;
774 ht->privdata = privDataPtr;
775 return JIM_OK;
778 /* Expand or create the hashtable */
779 void Jim_ExpandHashTable(Jim_HashTable *ht, unsigned int size)
781 Jim_HashTable n; /* the new hashtable */
782 unsigned int realsize = JimHashTableNextPower(size), i;
784 /* the size is invalid if it is smaller than the number of
785 * elements already inside the hashtable */
786 if (size <= ht->used)
787 return;
789 Jim_InitHashTable(&n, ht->type, ht->privdata);
790 n.size = realsize;
791 n.sizemask = realsize - 1;
792 n.table = Jim_Alloc(realsize * sizeof(Jim_HashEntry *));
793 /* Keep the same 'uniq' as the original */
794 n.uniq = ht->uniq;
796 /* Initialize all the pointers to NULL */
797 memset(n.table, 0, realsize * sizeof(Jim_HashEntry *));
799 /* Copy all the elements from the old to the new table:
800 * note that if the old hash table is empty ht->used is zero,
801 * so Jim_ExpandHashTable just creates an empty hash table. */
802 n.used = ht->used;
803 for (i = 0; ht->used > 0; i++) {
804 Jim_HashEntry *he, *nextHe;
806 if (ht->table[i] == NULL)
807 continue;
809 /* For each hash entry on this slot... */
810 he = ht->table[i];
811 while (he) {
812 unsigned int h;
814 nextHe = he->next;
815 /* Get the new element index */
816 h = Jim_HashKey(ht, he->key) & n.sizemask;
817 he->next = n.table[h];
818 n.table[h] = he;
819 ht->used--;
820 /* Pass to the next element */
821 he = nextHe;
824 assert(ht->used == 0);
825 Jim_Free(ht->table);
827 /* Remap the new hashtable in the old */
828 *ht = n;
831 /* Add an element to the target hash table */
832 int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val)
834 Jim_HashEntry *entry;
836 /* Get the index of the new element, or -1 if
837 * the element already exists. */
838 entry = JimInsertHashEntry(ht, key, 0);
839 if (entry == NULL)
840 return JIM_ERR;
842 /* Set the hash entry fields. */
843 Jim_SetHashKey(ht, entry, key);
844 Jim_SetHashVal(ht, entry, val);
845 return JIM_OK;
848 /* Add an element, discarding the old if the key already exists */
849 int Jim_ReplaceHashEntry(Jim_HashTable *ht, const void *key, void *val)
851 int existed;
852 Jim_HashEntry *entry;
854 /* Get the index of the new element, or -1 if
855 * the element already exists. */
856 entry = JimInsertHashEntry(ht, key, 1);
857 if (entry->key) {
858 /* It already exists, so only replace the value.
859 * Note if both a destructor and a duplicate function exist,
860 * need to dup before destroy. perhaps they are the same
861 * reference counted object
863 if (ht->type->valDestructor && ht->type->valDup) {
864 void *newval = ht->type->valDup(ht->privdata, val);
865 ht->type->valDestructor(ht->privdata, entry->u.val);
866 entry->u.val = newval;
868 else {
869 Jim_FreeEntryVal(ht, entry);
870 Jim_SetHashVal(ht, entry, val);
872 existed = 1;
874 else {
875 /* Doesn't exist, so set the key */
876 Jim_SetHashKey(ht, entry, key);
877 Jim_SetHashVal(ht, entry, val);
878 existed = 0;
881 return existed;
884 /* Search and remove an element */
885 int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key)
887 unsigned int h;
888 Jim_HashEntry *he, *prevHe;
890 if (ht->used == 0)
891 return JIM_ERR;
892 h = Jim_HashKey(ht, key) & ht->sizemask;
893 he = ht->table[h];
895 prevHe = NULL;
896 while (he) {
897 if (Jim_CompareHashKeys(ht, key, he->key)) {
898 /* Unlink the element from the list */
899 if (prevHe)
900 prevHe->next = he->next;
901 else
902 ht->table[h] = he->next;
903 Jim_FreeEntryKey(ht, he);
904 Jim_FreeEntryVal(ht, he);
905 Jim_Free(he);
906 ht->used--;
907 return JIM_OK;
909 prevHe = he;
910 he = he->next;
912 return JIM_ERR; /* not found */
916 * Clear all hash entries from the table, but don't free
917 * the table.
919 void Jim_ClearHashTable(Jim_HashTable *ht)
921 unsigned int i;
923 /* Free all the elements */
924 for (i = 0; ht->used > 0; i++) {
925 Jim_HashEntry *he, *nextHe;
927 he = ht->table[i];
928 while (he) {
929 nextHe = he->next;
930 Jim_FreeEntryKey(ht, he);
931 Jim_FreeEntryVal(ht, he);
932 Jim_Free(he);
933 ht->used--;
934 he = nextHe;
936 ht->table[i] = NULL;
940 /* Remove all entries from the hash table
941 * and leave it empty for reuse
943 int Jim_FreeHashTable(Jim_HashTable *ht)
945 Jim_ClearHashTable(ht);
946 /* Free the table and the allocated cache structure */
947 Jim_Free(ht->table);
948 /* Re-initialize the table */
949 JimResetHashTable(ht);
950 return JIM_OK; /* never fails */
953 Jim_HashEntry *Jim_FindHashEntry(Jim_HashTable *ht, const void *key)
955 Jim_HashEntry *he;
956 unsigned int h;
958 if (ht->used == 0)
959 return NULL;
960 h = Jim_HashKey(ht, key) & ht->sizemask;
961 he = ht->table[h];
962 while (he) {
963 if (Jim_CompareHashKeys(ht, key, he->key))
964 return he;
965 he = he->next;
967 return NULL;
970 Jim_HashTableIterator *Jim_GetHashTableIterator(Jim_HashTable *ht)
972 Jim_HashTableIterator *iter = Jim_Alloc(sizeof(*iter));
973 JimInitHashTableIterator(ht, iter);
974 return iter;
977 Jim_HashEntry *Jim_NextHashEntry(Jim_HashTableIterator *iter)
979 while (1) {
980 if (iter->entry == NULL) {
981 iter->index++;
982 if (iter->index >= (signed)iter->ht->size)
983 break;
984 iter->entry = iter->ht->table[iter->index];
986 else {
987 iter->entry = iter->nextEntry;
989 if (iter->entry) {
990 /* We need to save the 'next' here, the iterator user
991 * may delete the entry we are returning. */
992 iter->nextEntry = iter->entry->next;
993 return iter->entry;
996 return NULL;
999 /* ------------------------- private functions ------------------------------ */
1001 /* Expand the hash table if needed */
1002 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht)
1004 /* If the hash table is empty expand it to the intial size,
1005 * if the table is "full" double its size. */
1006 if (ht->size == 0)
1007 Jim_ExpandHashTable(ht, JIM_HT_INITIAL_SIZE);
1008 if (ht->size == ht->used)
1009 Jim_ExpandHashTable(ht, ht->size * 2);
1012 /* Our hash table capability is a power of two */
1013 static unsigned int JimHashTableNextPower(unsigned int size)
1015 unsigned int i = JIM_HT_INITIAL_SIZE;
1017 if (size >= 2147483648U)
1018 return 2147483648U;
1019 while (1) {
1020 if (i >= size)
1021 return i;
1022 i *= 2;
1026 /* Returns the index of a free slot that can be populated with
1027 * a hash entry for the given 'key'.
1028 * If the key already exists, -1 is returned. */
1029 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace)
1031 unsigned int h;
1032 Jim_HashEntry *he;
1034 /* Expand the hashtable if needed */
1035 JimExpandHashTableIfNeeded(ht);
1037 /* Compute the key hash value */
1038 h = Jim_HashKey(ht, key) & ht->sizemask;
1039 /* Search if this slot does not already contain the given key */
1040 he = ht->table[h];
1041 while (he) {
1042 if (Jim_CompareHashKeys(ht, key, he->key))
1043 return replace ? he : NULL;
1044 he = he->next;
1047 /* Allocates the memory and stores key */
1048 he = Jim_Alloc(sizeof(*he));
1049 he->next = ht->table[h];
1050 ht->table[h] = he;
1051 ht->used++;
1052 he->key = NULL;
1054 return he;
1057 /* ----------------------- StringCopy Hash Table Type ------------------------*/
1059 static unsigned int JimStringCopyHTHashFunction(const void *key)
1061 return Jim_GenHashFunction(key, strlen(key));
1064 static void *JimStringCopyHTDup(void *privdata, const void *key)
1066 return Jim_StrDup(key);
1069 static int JimStringCopyHTKeyCompare(void *privdata, const void *key1, const void *key2)
1071 return strcmp(key1, key2) == 0;
1074 static void JimStringCopyHTKeyDestructor(void *privdata, void *key)
1076 Jim_Free(key);
1079 static const Jim_HashTableType JimPackageHashTableType = {
1080 JimStringCopyHTHashFunction, /* hash function */
1081 JimStringCopyHTDup, /* key dup */
1082 NULL, /* val dup */
1083 JimStringCopyHTKeyCompare, /* key compare */
1084 JimStringCopyHTKeyDestructor, /* key destructor */
1085 NULL /* val destructor */
1088 typedef struct AssocDataValue
1090 Jim_InterpDeleteProc *delProc;
1091 void *data;
1092 } AssocDataValue;
1094 static void JimAssocDataHashTableValueDestructor(void *privdata, void *data)
1096 AssocDataValue *assocPtr = (AssocDataValue *) data;
1098 if (assocPtr->delProc != NULL)
1099 assocPtr->delProc((Jim_Interp *)privdata, assocPtr->data);
1100 Jim_Free(data);
1103 static const Jim_HashTableType JimAssocDataHashTableType = {
1104 JimStringCopyHTHashFunction, /* hash function */
1105 JimStringCopyHTDup, /* key dup */
1106 NULL, /* val dup */
1107 JimStringCopyHTKeyCompare, /* key compare */
1108 JimStringCopyHTKeyDestructor, /* key destructor */
1109 JimAssocDataHashTableValueDestructor /* val destructor */
1112 /* -----------------------------------------------------------------------------
1113 * Stack - This is a simple generic stack implementation. It is used for
1114 * example in the 'expr' expression compiler.
1115 * ---------------------------------------------------------------------------*/
1116 void Jim_InitStack(Jim_Stack *stack)
1118 stack->len = 0;
1119 stack->maxlen = 0;
1120 stack->vector = NULL;
1123 void Jim_FreeStack(Jim_Stack *stack)
1125 Jim_Free(stack->vector);
1128 int Jim_StackLen(Jim_Stack *stack)
1130 return stack->len;
1133 void Jim_StackPush(Jim_Stack *stack, void *element)
1135 int neededLen = stack->len + 1;
1137 if (neededLen > stack->maxlen) {
1138 stack->maxlen = neededLen < 20 ? 20 : neededLen * 2;
1139 stack->vector = Jim_Realloc(stack->vector, sizeof(void *) * stack->maxlen);
1141 stack->vector[stack->len] = element;
1142 stack->len++;
1145 void *Jim_StackPop(Jim_Stack *stack)
1147 if (stack->len == 0)
1148 return NULL;
1149 stack->len--;
1150 return stack->vector[stack->len];
1153 void *Jim_StackPeek(Jim_Stack *stack)
1155 if (stack->len == 0)
1156 return NULL;
1157 return stack->vector[stack->len - 1];
1160 void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc) (void *ptr))
1162 int i;
1164 for (i = 0; i < stack->len; i++)
1165 freeFunc(stack->vector[i]);
1168 /* -----------------------------------------------------------------------------
1169 * Tcl Parser
1170 * ---------------------------------------------------------------------------*/
1172 /* Token types */
1173 #define JIM_TT_NONE 0 /* No token returned */
1174 #define JIM_TT_STR 1 /* simple string */
1175 #define JIM_TT_ESC 2 /* string that needs escape chars conversion */
1176 #define JIM_TT_VAR 3 /* var substitution */
1177 #define JIM_TT_DICTSUGAR 4 /* Syntax sugar for [dict get], $foo(bar) */
1178 #define JIM_TT_CMD 5 /* command substitution */
1179 /* Note: Keep these three together for TOKEN_IS_SEP() */
1180 #define JIM_TT_SEP 6 /* word separator (white space) */
1181 #define JIM_TT_EOL 7 /* line separator */
1182 #define JIM_TT_EOF 8 /* end of script */
1184 #define JIM_TT_LINE 9 /* special 'start-of-line' token. arg is # of arguments to the command. -ve if {*} */
1185 #define JIM_TT_WORD 10 /* special 'start-of-word' token. arg is # of tokens to combine. -ve if {*} */
1187 /* Additional token types needed for expressions */
1188 #define JIM_TT_SUBEXPR_START 11
1189 #define JIM_TT_SUBEXPR_END 12
1190 #define JIM_TT_SUBEXPR_COMMA 13
1191 #define JIM_TT_EXPR_INT 14
1192 #define JIM_TT_EXPR_DOUBLE 15
1193 #define JIM_TT_EXPR_BOOLEAN 16
1195 #define JIM_TT_EXPRSUGAR 17 /* $(expression) */
1197 /* Operator token types start here */
1198 #define JIM_TT_EXPR_OP 20
1200 #define TOKEN_IS_SEP(type) (type >= JIM_TT_SEP && type <= JIM_TT_EOF)
1201 /* Can this token start an expression? */
1202 #define TOKEN_IS_EXPR_START(type) (type == JIM_TT_NONE || type == JIM_TT_SUBEXPR_START || type == JIM_TT_SUBEXPR_COMMA)
1203 /* Is this token an expression operator? */
1204 #define TOKEN_IS_EXPR_OP(type) (type >= JIM_TT_EXPR_OP)
1207 * Results of missing quotes, braces, etc. from parsing.
1209 struct JimParseMissing {
1210 int ch; /* At end of parse, ' ' if complete or '{', '[', '"', '\\', '}' if incomplete */
1211 int line; /* Line number starting the missing token */
1214 /* Parser context structure. The same context is used to parse
1215 * Tcl scripts, expressions and lists. */
1216 struct JimParserCtx
1218 const char *p; /* Pointer to the point of the program we are parsing */
1219 int len; /* Remaining length */
1220 int linenr; /* Current line number */
1221 const char *tstart;
1222 const char *tend; /* Returned token is at tstart-tend in 'prg'. */
1223 int tline; /* Line number of the returned token */
1224 int tt; /* Token type */
1225 int eof; /* Non zero if EOF condition is true. */
1226 int inquote; /* Parsing a quoted string */
1227 int comment; /* Non zero if the next chars may be a comment. */
1228 struct JimParseMissing missing; /* Details of any missing quotes, etc. */
1231 static int JimParseScript(struct JimParserCtx *pc);
1232 static int JimParseSep(struct JimParserCtx *pc);
1233 static int JimParseEol(struct JimParserCtx *pc);
1234 static int JimParseCmd(struct JimParserCtx *pc);
1235 static int JimParseQuote(struct JimParserCtx *pc);
1236 static int JimParseVar(struct JimParserCtx *pc);
1237 static int JimParseBrace(struct JimParserCtx *pc);
1238 static int JimParseStr(struct JimParserCtx *pc);
1239 static int JimParseComment(struct JimParserCtx *pc);
1240 static void JimParseSubCmd(struct JimParserCtx *pc);
1241 static int JimParseSubQuote(struct JimParserCtx *pc);
1242 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc);
1244 /* Initialize a parser context.
1245 * 'prg' is a pointer to the program text, linenr is the line
1246 * number of the first line contained in the program. */
1247 static void JimParserInit(struct JimParserCtx *pc, const char *prg, int len, int linenr)
1249 pc->p = prg;
1250 pc->len = len;
1251 pc->tstart = NULL;
1252 pc->tend = NULL;
1253 pc->tline = 0;
1254 pc->tt = JIM_TT_NONE;
1255 pc->eof = 0;
1256 pc->inquote = 0;
1257 pc->linenr = linenr;
1258 pc->comment = 1;
1259 pc->missing.ch = ' ';
1260 pc->missing.line = linenr;
1263 static int JimParseScript(struct JimParserCtx *pc)
1265 while (1) { /* the while is used to reiterate with continue if needed */
1266 if (!pc->len) {
1267 pc->tstart = pc->p;
1268 pc->tend = pc->p - 1;
1269 pc->tline = pc->linenr;
1270 pc->tt = JIM_TT_EOL;
1271 pc->eof = 1;
1272 return JIM_OK;
1274 switch (*(pc->p)) {
1275 case '\\':
1276 if (*(pc->p + 1) == '\n' && !pc->inquote) {
1277 return JimParseSep(pc);
1279 pc->comment = 0;
1280 return JimParseStr(pc);
1281 case ' ':
1282 case '\t':
1283 case '\r':
1284 case '\f':
1285 if (!pc->inquote)
1286 return JimParseSep(pc);
1287 pc->comment = 0;
1288 return JimParseStr(pc);
1289 case '\n':
1290 case ';':
1291 pc->comment = 1;
1292 if (!pc->inquote)
1293 return JimParseEol(pc);
1294 return JimParseStr(pc);
1295 case '[':
1296 pc->comment = 0;
1297 return JimParseCmd(pc);
1298 case '$':
1299 pc->comment = 0;
1300 if (JimParseVar(pc) == JIM_ERR) {
1301 /* An orphan $. Create as a separate token */
1302 pc->tstart = pc->tend = pc->p++;
1303 pc->len--;
1304 pc->tt = JIM_TT_ESC;
1306 return JIM_OK;
1307 case '#':
1308 if (pc->comment) {
1309 JimParseComment(pc);
1310 continue;
1312 return JimParseStr(pc);
1313 default:
1314 pc->comment = 0;
1315 return JimParseStr(pc);
1317 return JIM_OK;
1321 static int JimParseSep(struct JimParserCtx *pc)
1323 pc->tstart = pc->p;
1324 pc->tline = pc->linenr;
1325 while (isspace(UCHAR(*pc->p)) || (*pc->p == '\\' && *(pc->p + 1) == '\n')) {
1326 if (*pc->p == '\n') {
1327 break;
1329 if (*pc->p == '\\') {
1330 pc->p++;
1331 pc->len--;
1332 pc->linenr++;
1334 pc->p++;
1335 pc->len--;
1337 pc->tend = pc->p - 1;
1338 pc->tt = JIM_TT_SEP;
1339 return JIM_OK;
1342 static int JimParseEol(struct JimParserCtx *pc)
1344 pc->tstart = pc->p;
1345 pc->tline = pc->linenr;
1346 while (isspace(UCHAR(*pc->p)) || *pc->p == ';') {
1347 if (*pc->p == '\n')
1348 pc->linenr++;
1349 pc->p++;
1350 pc->len--;
1352 pc->tend = pc->p - 1;
1353 pc->tt = JIM_TT_EOL;
1354 return JIM_OK;
1358 ** Here are the rules for parsing:
1359 ** {braced expression}
1360 ** - Count open and closing braces
1361 ** - Backslash escapes meaning of braces but doesn't remove the backslash
1363 ** "quoted expression"
1364 ** - Unescaped double quote terminates the expression
1365 ** - Backslash escapes next char
1366 ** - [commands brackets] are counted/nested
1367 ** - command rules apply within [brackets], not quoting rules (i.e. brackets have their own rules)
1369 ** [command expression]
1370 ** - Count open and closing brackets
1371 ** - Backslash escapes next char
1372 ** - [commands brackets] are counted/nested
1373 ** - "quoted expressions" are parsed according to quoting rules
1374 ** - {braced expressions} are parsed according to brace rules
1376 ** For everything, backslash escapes the next char, newline increments current line
1380 * Parses a braced expression starting at pc->p.
1382 * Positions the parser at the end of the braced expression,
1383 * sets pc->tend and possibly pc->missing.
1385 static void JimParseSubBrace(struct JimParserCtx *pc)
1387 int level = 1;
1389 /* Skip the brace */
1390 pc->p++;
1391 pc->len--;
1392 while (pc->len) {
1393 switch (*pc->p) {
1394 case '\\':
1395 if (pc->len > 1) {
1396 if (*++pc->p == '\n') {
1397 pc->linenr++;
1399 pc->len--;
1401 break;
1403 case '{':
1404 level++;
1405 break;
1407 case '}':
1408 if (--level == 0) {
1409 pc->tend = pc->p - 1;
1410 pc->p++;
1411 pc->len--;
1412 return;
1414 break;
1416 case '\n':
1417 pc->linenr++;
1418 break;
1420 pc->p++;
1421 pc->len--;
1423 pc->missing.ch = '{';
1424 pc->missing.line = pc->tline;
1425 pc->tend = pc->p - 1;
1429 * Parses a quoted expression starting at pc->p.
1431 * Positions the parser at the end of the quoted expression,
1432 * sets pc->tend and possibly pc->missing.
1434 * Returns the type of the token of the string,
1435 * either JIM_TT_ESC (if it contains values which need to be [subst]ed)
1436 * or JIM_TT_STR.
1438 static int JimParseSubQuote(struct JimParserCtx *pc)
1440 int tt = JIM_TT_STR;
1441 int line = pc->tline;
1443 /* Skip the quote */
1444 pc->p++;
1445 pc->len--;
1446 while (pc->len) {
1447 switch (*pc->p) {
1448 case '\\':
1449 if (pc->len > 1) {
1450 if (*++pc->p == '\n') {
1451 pc->linenr++;
1453 pc->len--;
1454 tt = JIM_TT_ESC;
1456 break;
1458 case '"':
1459 pc->tend = pc->p - 1;
1460 pc->p++;
1461 pc->len--;
1462 return tt;
1464 case '[':
1465 JimParseSubCmd(pc);
1466 tt = JIM_TT_ESC;
1467 continue;
1469 case '\n':
1470 pc->linenr++;
1471 break;
1473 case '$':
1474 tt = JIM_TT_ESC;
1475 break;
1477 pc->p++;
1478 pc->len--;
1480 pc->missing.ch = '"';
1481 pc->missing.line = line;
1482 pc->tend = pc->p - 1;
1483 return tt;
1487 * Parses a [command] expression starting at pc->p.
1489 * Positions the parser at the end of the command expression,
1490 * sets pc->tend and possibly pc->missing.
1492 static void JimParseSubCmd(struct JimParserCtx *pc)
1494 int level = 1;
1495 int startofword = 1;
1496 int line = pc->tline;
1498 /* Skip the bracket */
1499 pc->p++;
1500 pc->len--;
1501 while (pc->len) {
1502 switch (*pc->p) {
1503 case '\\':
1504 if (pc->len > 1) {
1505 if (*++pc->p == '\n') {
1506 pc->linenr++;
1508 pc->len--;
1510 break;
1512 case '[':
1513 level++;
1514 break;
1516 case ']':
1517 if (--level == 0) {
1518 pc->tend = pc->p - 1;
1519 pc->p++;
1520 pc->len--;
1521 return;
1523 break;
1525 case '"':
1526 if (startofword) {
1527 JimParseSubQuote(pc);
1528 if (pc->missing.ch == '"') {
1529 return;
1531 continue;
1533 break;
1535 case '{':
1536 JimParseSubBrace(pc);
1537 startofword = 0;
1538 continue;
1540 case '\n':
1541 pc->linenr++;
1542 break;
1544 startofword = isspace(UCHAR(*pc->p));
1545 pc->p++;
1546 pc->len--;
1548 pc->missing.ch = '[';
1549 pc->missing.line = line;
1550 pc->tend = pc->p - 1;
1553 static int JimParseBrace(struct JimParserCtx *pc)
1555 pc->tstart = pc->p + 1;
1556 pc->tline = pc->linenr;
1557 pc->tt = JIM_TT_STR;
1558 JimParseSubBrace(pc);
1559 return JIM_OK;
1562 static int JimParseCmd(struct JimParserCtx *pc)
1564 pc->tstart = pc->p + 1;
1565 pc->tline = pc->linenr;
1566 pc->tt = JIM_TT_CMD;
1567 JimParseSubCmd(pc);
1568 return JIM_OK;
1571 static int JimParseQuote(struct JimParserCtx *pc)
1573 pc->tstart = pc->p + 1;
1574 pc->tline = pc->linenr;
1575 pc->tt = JimParseSubQuote(pc);
1576 return JIM_OK;
1579 static int JimParseVar(struct JimParserCtx *pc)
1581 /* skip the $ */
1582 pc->p++;
1583 pc->len--;
1585 #ifdef EXPRSUGAR_BRACKET
1586 if (*pc->p == '[') {
1587 /* Parse $[...] expr shorthand syntax */
1588 JimParseCmd(pc);
1589 pc->tt = JIM_TT_EXPRSUGAR;
1590 return JIM_OK;
1592 #endif
1594 pc->tstart = pc->p;
1595 pc->tt = JIM_TT_VAR;
1596 pc->tline = pc->linenr;
1598 if (*pc->p == '{') {
1599 pc->tstart = ++pc->p;
1600 pc->len--;
1602 while (pc->len && *pc->p != '}') {
1603 if (*pc->p == '\n') {
1604 pc->linenr++;
1606 pc->p++;
1607 pc->len--;
1609 pc->tend = pc->p - 1;
1610 if (pc->len) {
1611 pc->p++;
1612 pc->len--;
1615 else {
1616 while (1) {
1617 /* Skip double colon, but not single colon! */
1618 if (pc->p[0] == ':' && pc->p[1] == ':') {
1619 while (*pc->p == ':') {
1620 pc->p++;
1621 pc->len--;
1623 continue;
1625 /* Note that any char >= 0x80 must be part of a utf-8 char.
1626 * We consider all unicode points outside of ASCII as letters
1628 if (isalnum(UCHAR(*pc->p)) || *pc->p == '_' || UCHAR(*pc->p) >= 0x80) {
1629 pc->p++;
1630 pc->len--;
1631 continue;
1633 break;
1635 /* Parse [dict get] syntax sugar. */
1636 if (*pc->p == '(') {
1637 int count = 1;
1638 const char *paren = NULL;
1640 pc->tt = JIM_TT_DICTSUGAR;
1642 while (count && pc->len) {
1643 pc->p++;
1644 pc->len--;
1645 if (*pc->p == '\\' && pc->len >= 1) {
1646 pc->p++;
1647 pc->len--;
1649 else if (*pc->p == '(') {
1650 count++;
1652 else if (*pc->p == ')') {
1653 paren = pc->p;
1654 count--;
1657 if (count == 0) {
1658 pc->p++;
1659 pc->len--;
1661 else if (paren) {
1662 /* Did not find a matching paren. Back up */
1663 paren++;
1664 pc->len += (pc->p - paren);
1665 pc->p = paren;
1667 #ifndef EXPRSUGAR_BRACKET
1668 if (*pc->tstart == '(') {
1669 pc->tt = JIM_TT_EXPRSUGAR;
1671 #endif
1673 pc->tend = pc->p - 1;
1675 /* Check if we parsed just the '$' character.
1676 * That's not a variable so an error is returned
1677 * to tell the state machine to consider this '$' just
1678 * a string. */
1679 if (pc->tstart == pc->p) {
1680 pc->p--;
1681 pc->len++;
1682 return JIM_ERR;
1684 return JIM_OK;
1687 static int JimParseStr(struct JimParserCtx *pc)
1689 if (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1690 pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR) {
1691 /* Starting a new word */
1692 if (*pc->p == '{') {
1693 return JimParseBrace(pc);
1695 if (*pc->p == '"') {
1696 pc->inquote = 1;
1697 pc->p++;
1698 pc->len--;
1699 /* In case the end quote is missing */
1700 pc->missing.line = pc->tline;
1703 pc->tstart = pc->p;
1704 pc->tline = pc->linenr;
1705 while (1) {
1706 if (pc->len == 0) {
1707 if (pc->inquote) {
1708 pc->missing.ch = '"';
1710 pc->tend = pc->p - 1;
1711 pc->tt = JIM_TT_ESC;
1712 return JIM_OK;
1714 switch (*pc->p) {
1715 case '\\':
1716 if (!pc->inquote && *(pc->p + 1) == '\n') {
1717 pc->tend = pc->p - 1;
1718 pc->tt = JIM_TT_ESC;
1719 return JIM_OK;
1721 if (pc->len >= 2) {
1722 if (*(pc->p + 1) == '\n') {
1723 pc->linenr++;
1725 pc->p++;
1726 pc->len--;
1728 else if (pc->len == 1) {
1729 /* End of script with trailing backslash */
1730 pc->missing.ch = '\\';
1732 break;
1733 case '(':
1734 /* If the following token is not '$' just keep going */
1735 if (pc->len > 1 && pc->p[1] != '$') {
1736 break;
1738 /* fall through */
1739 case ')':
1740 /* Only need a separate ')' token if the previous was a var */
1741 if (*pc->p == '(' || pc->tt == JIM_TT_VAR) {
1742 if (pc->p == pc->tstart) {
1743 /* At the start of the token, so just return this char */
1744 pc->p++;
1745 pc->len--;
1747 pc->tend = pc->p - 1;
1748 pc->tt = JIM_TT_ESC;
1749 return JIM_OK;
1751 break;
1753 case '$':
1754 case '[':
1755 pc->tend = pc->p - 1;
1756 pc->tt = JIM_TT_ESC;
1757 return JIM_OK;
1758 case ' ':
1759 case '\t':
1760 case '\n':
1761 case '\r':
1762 case '\f':
1763 case ';':
1764 if (!pc->inquote) {
1765 pc->tend = pc->p - 1;
1766 pc->tt = JIM_TT_ESC;
1767 return JIM_OK;
1769 else if (*pc->p == '\n') {
1770 pc->linenr++;
1772 break;
1773 case '"':
1774 if (pc->inquote) {
1775 pc->tend = pc->p - 1;
1776 pc->tt = JIM_TT_ESC;
1777 pc->p++;
1778 pc->len--;
1779 pc->inquote = 0;
1780 return JIM_OK;
1782 break;
1784 pc->p++;
1785 pc->len--;
1787 return JIM_OK; /* unreached */
1790 static int JimParseComment(struct JimParserCtx *pc)
1792 while (*pc->p) {
1793 if (*pc->p == '\\') {
1794 pc->p++;
1795 pc->len--;
1796 if (pc->len == 0) {
1797 pc->missing.ch = '\\';
1798 return JIM_OK;
1800 if (*pc->p == '\n') {
1801 pc->linenr++;
1804 else if (*pc->p == '\n') {
1805 pc->p++;
1806 pc->len--;
1807 pc->linenr++;
1808 break;
1810 pc->p++;
1811 pc->len--;
1813 return JIM_OK;
1816 /* xdigitval and odigitval are helper functions for JimEscape() */
1817 static int xdigitval(int c)
1819 if (c >= '0' && c <= '9')
1820 return c - '0';
1821 if (c >= 'a' && c <= 'f')
1822 return c - 'a' + 10;
1823 if (c >= 'A' && c <= 'F')
1824 return c - 'A' + 10;
1825 return -1;
1828 static int odigitval(int c)
1830 if (c >= '0' && c <= '7')
1831 return c - '0';
1832 return -1;
1835 /* Perform Tcl escape substitution of 's', storing the result
1836 * string into 'dest'. The escaped string is guaranteed to
1837 * be the same length or shorter than the source string.
1838 * slen is the length of the string at 's'.
1840 * The function returns the length of the resulting string. */
1841 static int JimEscape(char *dest, const char *s, int slen)
1843 char *p = dest;
1844 int i, len;
1846 for (i = 0; i < slen; i++) {
1847 switch (s[i]) {
1848 case '\\':
1849 switch (s[i + 1]) {
1850 case 'a':
1851 *p++ = 0x7;
1852 i++;
1853 break;
1854 case 'b':
1855 *p++ = 0x8;
1856 i++;
1857 break;
1858 case 'f':
1859 *p++ = 0xc;
1860 i++;
1861 break;
1862 case 'n':
1863 *p++ = 0xa;
1864 i++;
1865 break;
1866 case 'r':
1867 *p++ = 0xd;
1868 i++;
1869 break;
1870 case 't':
1871 *p++ = 0x9;
1872 i++;
1873 break;
1874 case 'u':
1875 case 'U':
1876 case 'x':
1877 /* A unicode or hex sequence.
1878 * \x Expect 1-2 hex chars and convert to hex.
1879 * \u Expect 1-4 hex chars and convert to utf-8.
1880 * \U Expect 1-8 hex chars and convert to utf-8.
1881 * \u{NNN} supports 1-6 hex chars and convert to utf-8.
1882 * An invalid sequence means simply the escaped char.
1885 unsigned val = 0;
1886 int k;
1887 int maxchars = 2;
1889 i++;
1891 if (s[i] == 'U') {
1892 maxchars = 8;
1894 else if (s[i] == 'u') {
1895 if (s[i + 1] == '{') {
1896 maxchars = 6;
1897 i++;
1899 else {
1900 maxchars = 4;
1904 for (k = 0; k < maxchars; k++) {
1905 int c = xdigitval(s[i + k + 1]);
1906 if (c == -1) {
1907 break;
1909 val = (val << 4) | c;
1911 /* The \u{nnn} syntax supports up to 21 bit codepoints. */
1912 if (s[i] == '{') {
1913 if (k == 0 || val > 0x1fffff || s[i + k + 1] != '}') {
1914 /* Back up */
1915 i--;
1916 k = 0;
1918 else {
1919 /* Skip the closing brace */
1920 k++;
1923 if (k) {
1924 /* Got a valid sequence, so convert */
1925 if (s[i] == 'x') {
1926 *p++ = val;
1928 else {
1929 p += utf8_fromunicode(p, val);
1931 i += k;
1932 break;
1934 /* Not a valid codepoint, just an escaped char */
1935 *p++ = s[i];
1937 break;
1938 case 'v':
1939 *p++ = 0xb;
1940 i++;
1941 break;
1942 case '\0':
1943 *p++ = '\\';
1944 i++;
1945 break;
1946 case '\n':
1947 /* Replace all spaces and tabs after backslash newline with a single space*/
1948 *p++ = ' ';
1949 do {
1950 i++;
1951 } while (s[i + 1] == ' ' || s[i + 1] == '\t');
1952 break;
1953 case '0':
1954 case '1':
1955 case '2':
1956 case '3':
1957 case '4':
1958 case '5':
1959 case '6':
1960 case '7':
1961 /* octal escape */
1963 int val = 0;
1964 int c = odigitval(s[i + 1]);
1966 val = c;
1967 c = odigitval(s[i + 2]);
1968 if (c == -1) {
1969 *p++ = val;
1970 i++;
1971 break;
1973 val = (val * 8) + c;
1974 c = odigitval(s[i + 3]);
1975 if (c == -1) {
1976 *p++ = val;
1977 i += 2;
1978 break;
1980 val = (val * 8) + c;
1981 *p++ = val;
1982 i += 3;
1984 break;
1985 default:
1986 *p++ = s[i + 1];
1987 i++;
1988 break;
1990 break;
1991 default:
1992 *p++ = s[i];
1993 break;
1996 len = p - dest;
1997 *p = '\0';
1998 return len;
2001 /* Returns a dynamically allocated copy of the current token in the
2002 * parser context. The function performs conversion of escapes if
2003 * the token is of type JIM_TT_ESC.
2005 * Note that after the conversion, tokens that are grouped with
2006 * braces in the source code, are always recognizable from the
2007 * identical string obtained in a different way from the type.
2009 * For example the string:
2011 * {*}$a
2013 * will return as first token "*", of type JIM_TT_STR
2015 * While the string:
2017 * *$a
2019 * will return as first token "*", of type JIM_TT_ESC
2021 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc)
2023 const char *start, *end;
2024 char *token;
2025 int len;
2027 start = pc->tstart;
2028 end = pc->tend;
2029 len = (end - start) + 1;
2030 if (len < 0) {
2031 len = 0;
2033 token = Jim_Alloc(len + 1);
2034 if (pc->tt != JIM_TT_ESC) {
2035 /* No escape conversion needed? Just copy it. */
2036 memcpy(token, start, len);
2037 token[len] = '\0';
2039 else {
2040 /* Else convert the escape chars. */
2041 len = JimEscape(token, start, len);
2044 return Jim_NewStringObjNoAlloc(interp, token, len);
2047 /* -----------------------------------------------------------------------------
2048 * Tcl Lists parsing
2049 * ---------------------------------------------------------------------------*/
2050 static int JimParseListSep(struct JimParserCtx *pc);
2051 static int JimParseListStr(struct JimParserCtx *pc);
2052 static int JimParseListQuote(struct JimParserCtx *pc);
2054 static int JimParseList(struct JimParserCtx *pc)
2056 if (isspace(UCHAR(*pc->p))) {
2057 return JimParseListSep(pc);
2059 switch (*pc->p) {
2060 case '"':
2061 return JimParseListQuote(pc);
2063 case '{':
2064 return JimParseBrace(pc);
2066 default:
2067 if (pc->len) {
2068 return JimParseListStr(pc);
2070 break;
2073 pc->tstart = pc->tend = pc->p;
2074 pc->tline = pc->linenr;
2075 pc->tt = JIM_TT_EOL;
2076 pc->eof = 1;
2077 return JIM_OK;
2080 static int JimParseListSep(struct JimParserCtx *pc)
2082 pc->tstart = pc->p;
2083 pc->tline = pc->linenr;
2084 while (isspace(UCHAR(*pc->p))) {
2085 if (*pc->p == '\n') {
2086 pc->linenr++;
2088 pc->p++;
2089 pc->len--;
2091 pc->tend = pc->p - 1;
2092 pc->tt = JIM_TT_SEP;
2093 return JIM_OK;
2096 static int JimParseListQuote(struct JimParserCtx *pc)
2098 pc->p++;
2099 pc->len--;
2101 pc->tstart = pc->p;
2102 pc->tline = pc->linenr;
2103 pc->tt = JIM_TT_STR;
2105 while (pc->len) {
2106 switch (*pc->p) {
2107 case '\\':
2108 pc->tt = JIM_TT_ESC;
2109 if (--pc->len == 0) {
2110 /* Trailing backslash */
2111 pc->tend = pc->p;
2112 return JIM_OK;
2114 pc->p++;
2115 break;
2116 case '\n':
2117 pc->linenr++;
2118 break;
2119 case '"':
2120 pc->tend = pc->p - 1;
2121 pc->p++;
2122 pc->len--;
2123 return JIM_OK;
2125 pc->p++;
2126 pc->len--;
2129 pc->tend = pc->p - 1;
2130 return JIM_OK;
2133 static int JimParseListStr(struct JimParserCtx *pc)
2135 pc->tstart = pc->p;
2136 pc->tline = pc->linenr;
2137 pc->tt = JIM_TT_STR;
2139 while (pc->len) {
2140 if (isspace(UCHAR(*pc->p))) {
2141 pc->tend = pc->p - 1;
2142 return JIM_OK;
2144 if (*pc->p == '\\') {
2145 if (--pc->len == 0) {
2146 /* Trailing backslash */
2147 pc->tend = pc->p;
2148 return JIM_OK;
2150 pc->tt = JIM_TT_ESC;
2151 pc->p++;
2153 pc->p++;
2154 pc->len--;
2156 pc->tend = pc->p - 1;
2157 return JIM_OK;
2160 /* -----------------------------------------------------------------------------
2161 * Jim_Obj related functions
2162 * ---------------------------------------------------------------------------*/
2164 /* Return a new initialized object. */
2165 Jim_Obj *Jim_NewObj(Jim_Interp *interp)
2167 Jim_Obj *objPtr;
2169 /* -- Check if there are objects in the free list -- */
2170 if (interp->freeList != NULL) {
2171 /* -- Unlink the object from the free list -- */
2172 objPtr = interp->freeList;
2173 interp->freeList = objPtr->nextObjPtr;
2175 else {
2176 /* -- No ready to use objects: allocate a new one -- */
2177 objPtr = Jim_Alloc(sizeof(*objPtr));
2180 /* Object is returned with refCount of 0. Every
2181 * kind of GC implemented should take care to avoid
2182 * scanning objects with refCount == 0. */
2183 objPtr->refCount = 0;
2184 /* All the other fields are left uninitialized to save time.
2185 * The caller will probably want to set them to the right
2186 * value anyway. */
2188 /* -- Put the object into the live list -- */
2189 objPtr->prevObjPtr = NULL;
2190 objPtr->nextObjPtr = interp->liveList;
2191 if (interp->liveList)
2192 interp->liveList->prevObjPtr = objPtr;
2193 interp->liveList = objPtr;
2195 return objPtr;
2198 /* Free an object. Actually objects are never freed, but
2199 * just moved to the free objects list, where they will be
2200 * reused by Jim_NewObj(). */
2201 void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr)
2203 /* Check if the object was already freed, panic. */
2204 JimPanic((objPtr->refCount != 0, "!!!Object %p freed with bad refcount %d, type=%s", objPtr,
2205 objPtr->refCount, objPtr->typePtr ? objPtr->typePtr->name : "<none>"));
2207 /* Free the internal representation */
2208 Jim_FreeIntRep(interp, objPtr);
2209 /* Free the string representation */
2210 if (objPtr->bytes != NULL) {
2211 if (objPtr->bytes != JimEmptyStringRep)
2212 Jim_Free(objPtr->bytes);
2214 /* Unlink the object from the live objects list */
2215 if (objPtr->prevObjPtr)
2216 objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr;
2217 if (objPtr->nextObjPtr)
2218 objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr;
2219 if (interp->liveList == objPtr)
2220 interp->liveList = objPtr->nextObjPtr;
2221 #ifdef JIM_DISABLE_OBJECT_POOL
2222 Jim_Free(objPtr);
2223 #else
2224 /* Link the object into the free objects list */
2225 objPtr->prevObjPtr = NULL;
2226 objPtr->nextObjPtr = interp->freeList;
2227 if (interp->freeList)
2228 interp->freeList->prevObjPtr = objPtr;
2229 interp->freeList = objPtr;
2230 objPtr->refCount = -1;
2231 #endif
2234 /* Invalidate the string representation of an object. */
2235 void Jim_InvalidateStringRep(Jim_Obj *objPtr)
2237 if (objPtr->bytes != NULL) {
2238 if (objPtr->bytes != JimEmptyStringRep)
2239 Jim_Free(objPtr->bytes);
2241 objPtr->bytes = NULL;
2244 /* Duplicate an object. The returned object has refcount = 0. */
2245 Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
2247 Jim_Obj *dupPtr;
2249 dupPtr = Jim_NewObj(interp);
2250 if (objPtr->bytes == NULL) {
2251 /* Object does not have a valid string representation. */
2252 dupPtr->bytes = NULL;
2254 else if (objPtr->length == 0) {
2255 /* Zero length, so don't even bother with the type-specific dup,
2256 * since all zero length objects look the same
2258 dupPtr->bytes = JimEmptyStringRep;
2259 dupPtr->length = 0;
2260 dupPtr->typePtr = NULL;
2261 return dupPtr;
2263 else {
2264 dupPtr->bytes = Jim_Alloc(objPtr->length + 1);
2265 dupPtr->length = objPtr->length;
2266 /* Copy the null byte too */
2267 memcpy(dupPtr->bytes, objPtr->bytes, objPtr->length + 1);
2270 /* By default, the new object has the same type as the old object */
2271 dupPtr->typePtr = objPtr->typePtr;
2272 if (objPtr->typePtr != NULL) {
2273 if (objPtr->typePtr->dupIntRepProc == NULL) {
2274 dupPtr->internalRep = objPtr->internalRep;
2276 else {
2277 /* The dup proc may set a different type, e.g. NULL */
2278 objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr);
2281 return dupPtr;
2284 /* Return the string representation for objPtr. If the object's
2285 * string representation is invalid, calls the updateStringProc method to create
2286 * a new one from the internal representation of the object.
2288 const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr)
2290 if (objPtr->bytes == NULL) {
2291 /* Invalid string repr. Generate it. */
2292 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2293 objPtr->typePtr->updateStringProc(objPtr);
2295 if (lenPtr)
2296 *lenPtr = objPtr->length;
2297 return objPtr->bytes;
2300 /* Just returns the length (in bytes) of the object's string rep */
2301 int Jim_Length(Jim_Obj *objPtr)
2303 if (objPtr->bytes == NULL) {
2304 /* Invalid string repr. Generate it. */
2305 Jim_GetString(objPtr, NULL);
2307 return objPtr->length;
2310 /* Just returns object's string rep */
2311 const char *Jim_String(Jim_Obj *objPtr)
2313 if (objPtr->bytes == NULL) {
2314 /* Invalid string repr. Generate it. */
2315 Jim_GetString(objPtr, NULL);
2317 return objPtr->bytes;
2320 static void JimSetStringBytes(Jim_Obj *objPtr, const char *str)
2322 objPtr->bytes = Jim_StrDup(str);
2323 objPtr->length = strlen(str);
2326 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2327 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2329 static const Jim_ObjType dictSubstObjType = {
2330 "dict-substitution",
2331 FreeDictSubstInternalRep,
2332 DupDictSubstInternalRep,
2333 NULL,
2334 JIM_TYPE_NONE,
2337 static void FreeInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2338 static void DupInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2340 static const Jim_ObjType interpolatedObjType = {
2341 "interpolated",
2342 FreeInterpolatedInternalRep,
2343 DupInterpolatedInternalRep,
2344 NULL,
2345 JIM_TYPE_NONE,
2348 static void FreeInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2350 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
2353 static void DupInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2355 /* Copy the interal rep */
2356 dupPtr->internalRep = srcPtr->internalRep;
2357 /* Need to increment the key ref count */
2358 Jim_IncrRefCount(dupPtr->internalRep.dictSubstValue.indexObjPtr);
2361 /* -----------------------------------------------------------------------------
2362 * String Object
2363 * ---------------------------------------------------------------------------*/
2364 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2365 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2367 static const Jim_ObjType stringObjType = {
2368 "string",
2369 NULL,
2370 DupStringInternalRep,
2371 NULL,
2372 JIM_TYPE_REFERENCES,
2375 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2377 JIM_NOTUSED(interp);
2379 /* This is a bit subtle: the only caller of this function
2380 * should be Jim_DuplicateObj(), that will copy the
2381 * string representaion. After the copy, the duplicated
2382 * object will not have more room in the buffer than
2383 * srcPtr->length bytes. So we just set it to length. */
2384 dupPtr->internalRep.strValue.maxLength = srcPtr->length;
2385 dupPtr->internalRep.strValue.charLength = srcPtr->internalRep.strValue.charLength;
2388 static int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
2390 if (objPtr->typePtr != &stringObjType) {
2391 /* Get a fresh string representation. */
2392 if (objPtr->bytes == NULL) {
2393 /* Invalid string repr. Generate it. */
2394 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2395 objPtr->typePtr->updateStringProc(objPtr);
2397 /* Free any other internal representation. */
2398 Jim_FreeIntRep(interp, objPtr);
2399 /* Set it as string, i.e. just set the maxLength field. */
2400 objPtr->typePtr = &stringObjType;
2401 objPtr->internalRep.strValue.maxLength = objPtr->length;
2402 /* Don't know the utf-8 length yet */
2403 objPtr->internalRep.strValue.charLength = -1;
2405 return JIM_OK;
2409 * Returns the length of the object string in chars, not bytes.
2411 * These may be different for a utf-8 string.
2413 int Jim_Utf8Length(Jim_Interp *interp, Jim_Obj *objPtr)
2415 #ifdef JIM_UTF8
2416 SetStringFromAny(interp, objPtr);
2418 if (objPtr->internalRep.strValue.charLength < 0) {
2419 objPtr->internalRep.strValue.charLength = utf8_strlen(objPtr->bytes, objPtr->length);
2421 return objPtr->internalRep.strValue.charLength;
2422 #else
2423 return Jim_Length(objPtr);
2424 #endif
2427 /* len is in bytes -- see also Jim_NewStringObjUtf8() */
2428 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
2430 Jim_Obj *objPtr = Jim_NewObj(interp);
2432 /* Need to find out how many bytes the string requires */
2433 if (len == -1)
2434 len = strlen(s);
2435 /* Alloc/Set the string rep. */
2436 if (len == 0) {
2437 objPtr->bytes = JimEmptyStringRep;
2439 else {
2440 objPtr->bytes = Jim_StrDupLen(s, len);
2442 objPtr->length = len;
2444 /* No typePtr field for the vanilla string object. */
2445 objPtr->typePtr = NULL;
2446 return objPtr;
2449 /* charlen is in characters -- see also Jim_NewStringObj() */
2450 Jim_Obj *Jim_NewStringObjUtf8(Jim_Interp *interp, const char *s, int charlen)
2452 #ifdef JIM_UTF8
2453 /* Need to find out how many bytes the string requires */
2454 int bytelen = utf8_index(s, charlen);
2456 Jim_Obj *objPtr = Jim_NewStringObj(interp, s, bytelen);
2458 /* Remember the utf8 length, so set the type */
2459 objPtr->typePtr = &stringObjType;
2460 objPtr->internalRep.strValue.maxLength = bytelen;
2461 objPtr->internalRep.strValue.charLength = charlen;
2463 return objPtr;
2464 #else
2465 return Jim_NewStringObj(interp, s, charlen);
2466 #endif
2469 /* This version does not try to duplicate the 's' pointer, but
2470 * use it directly. */
2471 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
2473 Jim_Obj *objPtr = Jim_NewObj(interp);
2475 objPtr->bytes = s;
2476 objPtr->length = (len == -1) ? strlen(s) : len;
2477 objPtr->typePtr = NULL;
2478 return objPtr;
2481 /* Low-level string append. Use it only against unshared objects
2482 * of type "string". */
2483 static void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
2485 int needlen;
2487 if (len == -1)
2488 len = strlen(str);
2489 needlen = objPtr->length + len;
2490 if (objPtr->internalRep.strValue.maxLength < needlen ||
2491 objPtr->internalRep.strValue.maxLength == 0) {
2492 needlen *= 2;
2493 /* Inefficient to malloc() for less than 8 bytes */
2494 if (needlen < 7) {
2495 needlen = 7;
2497 if (objPtr->bytes == JimEmptyStringRep) {
2498 objPtr->bytes = Jim_Alloc(needlen + 1);
2500 else {
2501 objPtr->bytes = Jim_Realloc(objPtr->bytes, needlen + 1);
2503 objPtr->internalRep.strValue.maxLength = needlen;
2505 memcpy(objPtr->bytes + objPtr->length, str, len);
2506 objPtr->bytes[objPtr->length + len] = '\0';
2508 if (objPtr->internalRep.strValue.charLength >= 0) {
2509 /* Update the utf-8 char length */
2510 objPtr->internalRep.strValue.charLength += utf8_strlen(objPtr->bytes + objPtr->length, len);
2512 objPtr->length += len;
2515 /* Higher level API to append strings to objects.
2516 * Object must not be unshared for each of these.
2518 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str, int len)
2520 JimPanic((Jim_IsShared(objPtr), "Jim_AppendString called with shared object"));
2521 SetStringFromAny(interp, objPtr);
2522 StringAppendString(objPtr, str, len);
2525 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *appendObjPtr)
2527 int len;
2528 const char *str = Jim_GetString(appendObjPtr, &len);
2529 Jim_AppendString(interp, objPtr, str, len);
2532 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2534 va_list ap;
2536 SetStringFromAny(interp, objPtr);
2537 va_start(ap, objPtr);
2538 while (1) {
2539 const char *s = va_arg(ap, const char *);
2541 if (s == NULL)
2542 break;
2543 Jim_AppendString(interp, objPtr, s, -1);
2545 va_end(ap);
2548 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr)
2550 if (aObjPtr == bObjPtr) {
2551 return 1;
2553 else {
2554 int Alen, Blen;
2555 const char *sA = Jim_GetString(aObjPtr, &Alen);
2556 const char *sB = Jim_GetString(bObjPtr, &Blen);
2558 return Alen == Blen && memcmp(sA, sB, Alen) == 0;
2563 * Note. Does not support embedded nulls in either the pattern or the object.
2565 int Jim_StringMatchObj(Jim_Interp *interp, Jim_Obj *patternObjPtr, Jim_Obj *objPtr, int nocase)
2567 int plen, slen;
2568 const char *pattern = Jim_GetString(patternObjPtr, &plen);
2569 const char *string = Jim_GetString(objPtr, &slen);
2570 return JimGlobMatch(pattern, plen, string, slen, nocase);
2573 int Jim_StringCompareObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2575 const char *s1 = Jim_String(firstObjPtr);
2576 int l1 = Jim_Utf8Length(interp, firstObjPtr);
2577 const char *s2 = Jim_String(secondObjPtr);
2578 int l2 = Jim_Utf8Length(interp, secondObjPtr);
2579 return JimStringCompareUtf8(s1, l1, s2, l2, nocase);
2582 /* Convert a range, as returned by Jim_GetRange(), into
2583 * an absolute index into an object of the specified length.
2584 * This function may return negative values, or values
2585 * greater than or equal to the length of the list if the index
2586 * is out of range. */
2587 static int JimRelToAbsIndex(int len, int idx)
2589 if (idx < 0)
2590 return len + idx;
2591 return idx;
2594 /* Convert a pair of indexes (*firstPtr, *lastPtr) as normalized by JimRelToAbsIndex(),
2595 * into a form suitable for implementation of commands like [string range] and [lrange].
2597 * The resulting range is guaranteed to address valid elements of
2598 * the structure.
2600 static void JimRelToAbsRange(int len, int *firstPtr, int *lastPtr, int *rangeLenPtr)
2602 int rangeLen;
2604 if (*firstPtr > *lastPtr) {
2605 rangeLen = 0;
2607 else {
2608 rangeLen = *lastPtr - *firstPtr + 1;
2609 if (rangeLen) {
2610 if (*firstPtr < 0) {
2611 rangeLen += *firstPtr;
2612 *firstPtr = 0;
2614 if (*lastPtr >= len) {
2615 rangeLen -= (*lastPtr - (len - 1));
2616 *lastPtr = len - 1;
2620 if (rangeLen < 0)
2621 rangeLen = 0;
2623 *rangeLenPtr = rangeLen;
2626 static int JimStringGetRange(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr,
2627 int len, int *first, int *last, int *range)
2629 if (Jim_GetIndex(interp, firstObjPtr, first) != JIM_OK) {
2630 return JIM_ERR;
2632 if (Jim_GetIndex(interp, lastObjPtr, last) != JIM_OK) {
2633 return JIM_ERR;
2635 *first = JimRelToAbsIndex(len, *first);
2636 *last = JimRelToAbsIndex(len, *last);
2637 JimRelToAbsRange(len, first, last, range);
2638 return JIM_OK;
2641 Jim_Obj *Jim_StringByteRangeObj(Jim_Interp *interp,
2642 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2644 int first, last;
2645 const char *str;
2646 int rangeLen;
2647 int bytelen;
2649 str = Jim_GetString(strObjPtr, &bytelen);
2651 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, bytelen, &first, &last, &rangeLen) != JIM_OK) {
2652 return NULL;
2655 if (first == 0 && rangeLen == bytelen) {
2656 return strObjPtr;
2658 return Jim_NewStringObj(interp, str + first, rangeLen);
2661 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2662 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2664 #ifdef JIM_UTF8
2665 int first, last;
2666 const char *str;
2667 int len, rangeLen;
2668 int bytelen;
2670 str = Jim_GetString(strObjPtr, &bytelen);
2671 len = Jim_Utf8Length(interp, strObjPtr);
2673 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2674 return NULL;
2677 if (first == 0 && rangeLen == len) {
2678 return strObjPtr;
2680 if (len == bytelen) {
2681 /* ASCII optimisation */
2682 return Jim_NewStringObj(interp, str + first, rangeLen);
2684 return Jim_NewStringObjUtf8(interp, str + utf8_index(str, first), rangeLen);
2685 #else
2686 return Jim_StringByteRangeObj(interp, strObjPtr, firstObjPtr, lastObjPtr);
2687 #endif
2690 Jim_Obj *JimStringReplaceObj(Jim_Interp *interp,
2691 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr, Jim_Obj *newStrObj)
2693 int first, last;
2694 const char *str;
2695 int len, rangeLen;
2696 Jim_Obj *objPtr;
2698 len = Jim_Utf8Length(interp, strObjPtr);
2700 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2701 return NULL;
2704 if (last < first) {
2705 return strObjPtr;
2708 str = Jim_String(strObjPtr);
2710 /* Before part */
2711 objPtr = Jim_NewStringObjUtf8(interp, str, first);
2713 /* Replacement */
2714 if (newStrObj) {
2715 Jim_AppendObj(interp, objPtr, newStrObj);
2718 /* After part */
2719 Jim_AppendString(interp, objPtr, str + utf8_index(str, last + 1), len - last - 1);
2721 return objPtr;
2725 * Note: does not support embedded nulls.
2727 static void JimStrCopyUpperLower(char *dest, const char *str, int uc)
2729 while (*str) {
2730 int c;
2731 str += utf8_tounicode(str, &c);
2732 dest += utf8_getchars(dest, uc ? utf8_upper(c) : utf8_lower(c));
2734 *dest = 0;
2738 * Note: does not support embedded nulls.
2740 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2742 char *buf;
2743 int len;
2744 const char *str;
2746 str = Jim_GetString(strObjPtr, &len);
2748 #ifdef JIM_UTF8
2749 /* Case mapping can change the utf-8 length of the string.
2750 * But at worst it will be by one extra byte per char
2752 len *= 2;
2753 #endif
2754 buf = Jim_Alloc(len + 1);
2755 JimStrCopyUpperLower(buf, str, 0);
2756 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2760 * Note: does not support embedded nulls.
2762 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2764 char *buf;
2765 const char *str;
2766 int len;
2768 str = Jim_GetString(strObjPtr, &len);
2770 #ifdef JIM_UTF8
2771 /* Case mapping can change the utf-8 length of the string.
2772 * But at worst it will be by one extra byte per char
2774 len *= 2;
2775 #endif
2776 buf = Jim_Alloc(len + 1);
2777 JimStrCopyUpperLower(buf, str, 1);
2778 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2782 * Note: does not support embedded nulls.
2784 static Jim_Obj *JimStringToTitle(Jim_Interp *interp, Jim_Obj *strObjPtr)
2786 char *buf, *p;
2787 int len;
2788 int c;
2789 const char *str;
2791 str = Jim_GetString(strObjPtr, &len);
2793 #ifdef JIM_UTF8
2794 /* Case mapping can change the utf-8 length of the string.
2795 * But at worst it will be by one extra byte per char
2797 len *= 2;
2798 #endif
2799 buf = p = Jim_Alloc(len + 1);
2801 str += utf8_tounicode(str, &c);
2802 p += utf8_getchars(p, utf8_title(c));
2804 JimStrCopyUpperLower(p, str, 0);
2806 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2809 /* Similar to memchr() except searches a UTF-8 string 'str' of byte length 'len'
2810 * for unicode character 'c'.
2811 * Returns the position if found or NULL if not
2813 static const char *utf8_memchr(const char *str, int len, int c)
2815 #ifdef JIM_UTF8
2816 while (len) {
2817 int sc;
2818 int n = utf8_tounicode(str, &sc);
2819 if (sc == c) {
2820 return str;
2822 str += n;
2823 len -= n;
2825 return NULL;
2826 #else
2827 return memchr(str, c, len);
2828 #endif
2832 * Searches for the first non-trim char in string (str, len)
2834 * If none is found, returns just past the last char.
2836 * Lengths are in bytes.
2838 static const char *JimFindTrimLeft(const char *str, int len, const char *trimchars, int trimlen)
2840 while (len) {
2841 int c;
2842 int n = utf8_tounicode(str, &c);
2844 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2845 /* Not a trim char, so stop */
2846 break;
2848 str += n;
2849 len -= n;
2851 return str;
2855 * Searches backwards for a non-trim char in string (str, len).
2857 * Returns a pointer to just after the non-trim char, or NULL if not found.
2859 * Lengths are in bytes.
2861 static const char *JimFindTrimRight(const char *str, int len, const char *trimchars, int trimlen)
2863 str += len;
2865 while (len) {
2866 int c;
2867 int n = utf8_prev_len(str, len);
2869 len -= n;
2870 str -= n;
2872 n = utf8_tounicode(str, &c);
2874 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2875 return str + n;
2879 return NULL;
2882 static const char default_trim_chars[] = " \t\n\r";
2883 /* sizeof() here includes the null byte */
2884 static int default_trim_chars_len = sizeof(default_trim_chars);
2886 static Jim_Obj *JimStringTrimLeft(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2888 int len;
2889 const char *str = Jim_GetString(strObjPtr, &len);
2890 const char *trimchars = default_trim_chars;
2891 int trimcharslen = default_trim_chars_len;
2892 const char *newstr;
2894 if (trimcharsObjPtr) {
2895 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2898 newstr = JimFindTrimLeft(str, len, trimchars, trimcharslen);
2899 if (newstr == str) {
2900 return strObjPtr;
2903 return Jim_NewStringObj(interp, newstr, len - (newstr - str));
2906 static Jim_Obj *JimStringTrimRight(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2908 int len;
2909 const char *trimchars = default_trim_chars;
2910 int trimcharslen = default_trim_chars_len;
2911 const char *nontrim;
2913 if (trimcharsObjPtr) {
2914 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2917 SetStringFromAny(interp, strObjPtr);
2919 len = Jim_Length(strObjPtr);
2920 nontrim = JimFindTrimRight(strObjPtr->bytes, len, trimchars, trimcharslen);
2922 if (nontrim == NULL) {
2923 /* All trim, so return a zero-length string */
2924 return Jim_NewEmptyStringObj(interp);
2926 if (nontrim == strObjPtr->bytes + len) {
2927 /* All non-trim, so return the original object */
2928 return strObjPtr;
2931 if (Jim_IsShared(strObjPtr)) {
2932 strObjPtr = Jim_NewStringObj(interp, strObjPtr->bytes, (nontrim - strObjPtr->bytes));
2934 else {
2935 /* Can modify this string in place */
2936 strObjPtr->bytes[nontrim - strObjPtr->bytes] = 0;
2937 strObjPtr->length = (nontrim - strObjPtr->bytes);
2940 return strObjPtr;
2943 static Jim_Obj *JimStringTrim(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2945 /* First trim left. */
2946 Jim_Obj *objPtr = JimStringTrimLeft(interp, strObjPtr, trimcharsObjPtr);
2948 /* Now trim right */
2949 strObjPtr = JimStringTrimRight(interp, objPtr, trimcharsObjPtr);
2951 /* Note: refCount check is needed since objPtr may be emptyObj */
2952 if (objPtr != strObjPtr && objPtr->refCount == 0) {
2953 /* We don't want this object to be leaked */
2954 Jim_FreeNewObj(interp, objPtr);
2957 return strObjPtr;
2960 /* Some platforms don't have isascii - need a non-macro version */
2961 #ifdef HAVE_ISASCII
2962 #define jim_isascii isascii
2963 #else
2964 static int jim_isascii(int c)
2966 return !(c & ~0x7f);
2968 #endif
2970 static int JimStringIs(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *strClass, int strict)
2972 static const char * const strclassnames[] = {
2973 "integer", "alpha", "alnum", "ascii", "digit",
2974 "double", "lower", "upper", "space", "xdigit",
2975 "control", "print", "graph", "punct", "boolean",
2976 NULL
2978 enum {
2979 STR_IS_INTEGER, STR_IS_ALPHA, STR_IS_ALNUM, STR_IS_ASCII, STR_IS_DIGIT,
2980 STR_IS_DOUBLE, STR_IS_LOWER, STR_IS_UPPER, STR_IS_SPACE, STR_IS_XDIGIT,
2981 STR_IS_CONTROL, STR_IS_PRINT, STR_IS_GRAPH, STR_IS_PUNCT, STR_IS_BOOLEAN,
2983 int strclass;
2984 int len;
2985 int i;
2986 const char *str;
2987 int (*isclassfunc)(int c) = NULL;
2989 if (Jim_GetEnum(interp, strClass, strclassnames, &strclass, "class", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
2990 return JIM_ERR;
2993 str = Jim_GetString(strObjPtr, &len);
2994 if (len == 0) {
2995 Jim_SetResultBool(interp, !strict);
2996 return JIM_OK;
2999 switch (strclass) {
3000 case STR_IS_INTEGER:
3002 jim_wide w;
3003 Jim_SetResultBool(interp, JimGetWideNoErr(interp, strObjPtr, &w) == JIM_OK);
3004 return JIM_OK;
3007 case STR_IS_DOUBLE:
3009 double d;
3010 Jim_SetResultBool(interp, Jim_GetDouble(interp, strObjPtr, &d) == JIM_OK && errno != ERANGE);
3011 return JIM_OK;
3014 case STR_IS_BOOLEAN:
3016 int b;
3017 Jim_SetResultBool(interp, Jim_GetBoolean(interp, strObjPtr, &b) == JIM_OK);
3018 return JIM_OK;
3021 case STR_IS_ALPHA: isclassfunc = isalpha; break;
3022 case STR_IS_ALNUM: isclassfunc = isalnum; break;
3023 case STR_IS_ASCII: isclassfunc = jim_isascii; break;
3024 case STR_IS_DIGIT: isclassfunc = isdigit; break;
3025 case STR_IS_LOWER: isclassfunc = islower; break;
3026 case STR_IS_UPPER: isclassfunc = isupper; break;
3027 case STR_IS_SPACE: isclassfunc = isspace; break;
3028 case STR_IS_XDIGIT: isclassfunc = isxdigit; break;
3029 case STR_IS_CONTROL: isclassfunc = iscntrl; break;
3030 case STR_IS_PRINT: isclassfunc = isprint; break;
3031 case STR_IS_GRAPH: isclassfunc = isgraph; break;
3032 case STR_IS_PUNCT: isclassfunc = ispunct; break;
3033 default:
3034 return JIM_ERR;
3037 for (i = 0; i < len; i++) {
3038 if (!isclassfunc(UCHAR(str[i]))) {
3039 Jim_SetResultBool(interp, 0);
3040 return JIM_OK;
3043 Jim_SetResultBool(interp, 1);
3044 return JIM_OK;
3047 /* -----------------------------------------------------------------------------
3048 * Compared String Object
3049 * ---------------------------------------------------------------------------*/
3051 /* This is strange object that allows comparison of a C literal string
3052 * with a Jim object in a very short time if the same comparison is done
3053 * multiple times. For example every time the [if] command is executed,
3054 * Jim has to check if a given argument is "else".
3055 * If the code has no errors, this comparison is true most of the time,
3056 * so we can cache the pointer of the string of the last matching
3057 * comparison inside the object. Because most C compilers perform literal sharing,
3058 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
3059 * this works pretty well even if comparisons are at different places
3060 * inside the C code. */
3062 static const Jim_ObjType comparedStringObjType = {
3063 "compared-string",
3064 NULL,
3065 NULL,
3066 NULL,
3067 JIM_TYPE_REFERENCES,
3070 /* The only way this object is exposed to the API is via the following
3071 * function. Returns true if the string and the object string repr.
3072 * are the same, otherwise zero is returned.
3074 * Note: this isn't binary safe, but it hardly needs to be.*/
3075 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr, const char *str)
3077 if (objPtr->typePtr == &comparedStringObjType && objPtr->internalRep.ptr == str) {
3078 return 1;
3080 else {
3081 if (strcmp(str, Jim_String(objPtr)) != 0)
3082 return 0;
3084 if (objPtr->typePtr != &comparedStringObjType) {
3085 Jim_FreeIntRep(interp, objPtr);
3086 objPtr->typePtr = &comparedStringObjType;
3088 objPtr->internalRep.ptr = (char *)str; /*ATTENTION: const cast */
3089 return 1;
3093 static int qsortCompareStringPointers(const void *a, const void *b)
3095 char *const *sa = (char *const *)a;
3096 char *const *sb = (char *const *)b;
3098 return strcmp(*sa, *sb);
3102 /* -----------------------------------------------------------------------------
3103 * Source Object
3105 * This object is just a string from the language point of view, but
3106 * the internal representation contains the filename and line number
3107 * where this token was read. This information is used by
3108 * Jim_EvalObj() if the object passed happens to be of type "source".
3110 * This allows propagation of the information about line numbers and file
3111 * names and gives error messages with absolute line numbers.
3113 * Note that this object uses the internal representation of the Jim_Object,
3114 * so there is almost no memory overhead. (One Jim_Obj for each filename).
3116 * Also the object will be converted to something else if the given
3117 * token it represents in the source file is not something to be
3118 * evaluated (not a script), and will be specialized in some other way,
3119 * so the time overhead is also almost zero.
3120 * ---------------------------------------------------------------------------*/
3122 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3123 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3125 static const Jim_ObjType sourceObjType = {
3126 "source",
3127 FreeSourceInternalRep,
3128 DupSourceInternalRep,
3129 NULL,
3130 JIM_TYPE_REFERENCES,
3133 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3135 Jim_DecrRefCount(interp, objPtr->internalRep.sourceValue.fileNameObj);
3138 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3140 dupPtr->internalRep.sourceValue = srcPtr->internalRep.sourceValue;
3141 Jim_IncrRefCount(dupPtr->internalRep.sourceValue.fileNameObj);
3144 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
3145 Jim_Obj *fileNameObj, int lineNumber)
3147 JimPanic((Jim_IsShared(objPtr), "JimSetSourceInfo called with shared object"));
3148 JimPanic((objPtr->typePtr != NULL, "JimSetSourceInfo called with typed object"));
3149 Jim_IncrRefCount(fileNameObj);
3150 objPtr->internalRep.sourceValue.fileNameObj = fileNameObj;
3151 objPtr->internalRep.sourceValue.lineNumber = lineNumber;
3152 objPtr->typePtr = &sourceObjType;
3155 /* -----------------------------------------------------------------------------
3156 * ScriptLine Object
3158 * This object is used only in the Script internal represenation.
3159 * For each line of the script, it holds the number of tokens on the line
3160 * and the source line number.
3162 static const Jim_ObjType scriptLineObjType = {
3163 "scriptline",
3164 NULL,
3165 NULL,
3166 NULL,
3167 JIM_NONE,
3170 static Jim_Obj *JimNewScriptLineObj(Jim_Interp *interp, int argc, int line)
3172 Jim_Obj *objPtr;
3174 #ifdef DEBUG_SHOW_SCRIPT
3175 char buf[100];
3176 snprintf(buf, sizeof(buf), "line=%d, argc=%d", line, argc);
3177 objPtr = Jim_NewStringObj(interp, buf, -1);
3178 #else
3179 objPtr = Jim_NewEmptyStringObj(interp);
3180 #endif
3181 objPtr->typePtr = &scriptLineObjType;
3182 objPtr->internalRep.scriptLineValue.argc = argc;
3183 objPtr->internalRep.scriptLineValue.line = line;
3185 return objPtr;
3188 /* -----------------------------------------------------------------------------
3189 * Script Object
3191 * This object holds the parsed internal representation of a script.
3192 * This representation is help within an allocated ScriptObj (see below)
3194 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3195 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3197 static const Jim_ObjType scriptObjType = {
3198 "script",
3199 FreeScriptInternalRep,
3200 DupScriptInternalRep,
3201 NULL,
3202 JIM_TYPE_REFERENCES,
3205 /* Each token of a script is represented by a ScriptToken.
3206 * The ScriptToken contains a type and a Jim_Obj. The Jim_Obj
3207 * can be specialized by commands operating on it.
3209 typedef struct ScriptToken
3211 Jim_Obj *objPtr;
3212 int type;
3213 } ScriptToken;
3215 /* This is the script object internal representation. An array of
3216 * ScriptToken structures, including a pre-computed representation of the
3217 * command length and arguments.
3219 * For example the script:
3221 * puts hello
3222 * set $i $x$y [foo]BAR
3224 * will produce a ScriptObj with the following ScriptToken's:
3226 * LIN 2
3227 * ESC puts
3228 * ESC hello
3229 * LIN 4
3230 * ESC set
3231 * VAR i
3232 * WRD 2
3233 * VAR x
3234 * VAR y
3235 * WRD 2
3236 * CMD foo
3237 * ESC BAR
3239 * "puts hello" has two args (LIN 2), composed of single tokens.
3240 * (Note that the WRD token is omitted for the common case of a single token.)
3242 * "set $i $x$y [foo]BAR" has four (LIN 4) args, the first word
3243 * has 1 token (ESC SET), and the last has two tokens (WRD 2 CMD foo ESC BAR)
3245 * The precomputation of the command structure makes Jim_Eval() faster,
3246 * and simpler because there aren't dynamic lengths / allocations.
3248 * -- {expand}/{*} handling --
3250 * Expand is handled in a special way.
3252 * If a "word" begins with {*}, the word token count is -ve.
3254 * For example the command:
3256 * list {*}{a b}
3258 * Will produce the following cmdstruct array:
3260 * LIN 2
3261 * ESC list
3262 * WRD -1
3263 * STR a b
3265 * Note that the 'LIN' token also contains the source information for the
3266 * first word of the line for error reporting purposes
3268 * -- the substFlags field of the structure --
3270 * The scriptObj structure is used to represent both "script" objects
3271 * and "subst" objects. In the second case, there are no LIN and WRD
3272 * tokens. Instead SEP and EOL tokens are added as-is.
3273 * In addition, the field 'substFlags' is used to represent the flags used to turn
3274 * the string into the internal representation.
3275 * If these flags do not match what the application requires,
3276 * the scriptObj is created again. For example the script:
3278 * subst -nocommands $string
3279 * subst -novariables $string
3281 * Will (re)create the internal representation of the $string object
3282 * two times.
3284 typedef struct ScriptObj
3286 ScriptToken *token; /* Tokens array. */
3287 Jim_Obj *fileNameObj; /* Filename */
3288 int len; /* Length of token[] */
3289 int substFlags; /* flags used for the compilation of "subst" objects */
3290 int inUse; /* Used to share a ScriptObj. Currently
3291 only used by Jim_EvalObj() as protection against
3292 shimmering of the currently evaluated object. */
3293 int firstline; /* Line number of the first line */
3294 int linenr; /* Error line number, if any */
3295 int missing; /* Missing char if script failed to parse, (or space or backslash if OK) */
3296 } ScriptObj;
3298 static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3299 static int JimParseCheckMissing(Jim_Interp *interp, int ch);
3300 static ScriptObj *JimGetScript(Jim_Interp *interp, Jim_Obj *objPtr);
3302 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3304 int i;
3305 struct ScriptObj *script = (void *)objPtr->internalRep.ptr;
3307 if (--script->inUse != 0)
3308 return;
3309 for (i = 0; i < script->len; i++) {
3310 Jim_DecrRefCount(interp, script->token[i].objPtr);
3312 Jim_Free(script->token);
3313 Jim_DecrRefCount(interp, script->fileNameObj);
3314 Jim_Free(script);
3317 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3319 JIM_NOTUSED(interp);
3320 JIM_NOTUSED(srcPtr);
3322 /* Just return a simple string. We don't try to preserve the source info
3323 * since in practice scripts are never duplicated
3325 dupPtr->typePtr = NULL;
3328 /* A simple parse token.
3329 * As the script is parsed, the created tokens point into the script string rep.
3331 typedef struct
3333 const char *token; /* Pointer to the start of the token */
3334 int len; /* Length of this token */
3335 int type; /* Token type */
3336 int line; /* Line number */
3337 } ParseToken;
3339 /* A list of parsed tokens representing a script.
3340 * Tokens are added to this list as the script is parsed.
3341 * It grows as needed.
3343 typedef struct
3345 /* Start with a statically allocated list of tokens which will be expanded with realloc if needed */
3346 ParseToken *list; /* Array of tokens */
3347 int size; /* Current size of the list */
3348 int count; /* Number of entries used */
3349 ParseToken static_list[20]; /* Small initial token space to avoid allocation */
3350 } ParseTokenList;
3352 static void ScriptTokenListInit(ParseTokenList *tokenlist)
3354 tokenlist->list = tokenlist->static_list;
3355 tokenlist->size = sizeof(tokenlist->static_list) / sizeof(ParseToken);
3356 tokenlist->count = 0;
3359 static void ScriptTokenListFree(ParseTokenList *tokenlist)
3361 if (tokenlist->list != tokenlist->static_list) {
3362 Jim_Free(tokenlist->list);
3367 * Adds the new token to the tokenlist.
3368 * The token has the given length, type and line number.
3369 * The token list is resized as necessary.
3371 static void ScriptAddToken(ParseTokenList *tokenlist, const char *token, int len, int type,
3372 int line)
3374 ParseToken *t;
3376 if (tokenlist->count == tokenlist->size) {
3377 /* Resize the list */
3378 tokenlist->size *= 2;
3379 if (tokenlist->list != tokenlist->static_list) {
3380 tokenlist->list =
3381 Jim_Realloc(tokenlist->list, tokenlist->size * sizeof(*tokenlist->list));
3383 else {
3384 /* The list needs to become allocated */
3385 tokenlist->list = Jim_Alloc(tokenlist->size * sizeof(*tokenlist->list));
3386 memcpy(tokenlist->list, tokenlist->static_list,
3387 tokenlist->count * sizeof(*tokenlist->list));
3390 t = &tokenlist->list[tokenlist->count++];
3391 t->token = token;
3392 t->len = len;
3393 t->type = type;
3394 t->line = line;
3397 /* Counts the number of adjoining non-separator tokens.
3399 * Returns -ve if the first token is the expansion
3400 * operator (in which case the count doesn't include
3401 * that token).
3403 static int JimCountWordTokens(struct ScriptObj *script, ParseToken *t)
3405 int expand = 1;
3406 int count = 0;
3408 /* Is the first word {*} or {expand}? */
3409 if (t->type == JIM_TT_STR && !TOKEN_IS_SEP(t[1].type)) {
3410 if ((t->len == 1 && *t->token == '*') || (t->len == 6 && strncmp(t->token, "expand", 6) == 0)) {
3411 /* Create an expand token */
3412 expand = -1;
3413 t++;
3415 else {
3416 if (script->missing == ' ') {
3417 /* This is a "extra characters after close-brace" error. Report the first error */
3418 script->missing = '}';
3419 script->linenr = t[1].line;
3424 /* Now count non-separator words */
3425 while (!TOKEN_IS_SEP(t->type)) {
3426 t++;
3427 count++;
3430 return count * expand;
3434 * Create a script/subst object from the given token.
3436 static Jim_Obj *JimMakeScriptObj(Jim_Interp *interp, const ParseToken *t)
3438 Jim_Obj *objPtr;
3440 if (t->type == JIM_TT_ESC && memchr(t->token, '\\', t->len) != NULL) {
3441 /* Convert backlash escapes. The result will never be longer than the original */
3442 int len = t->len;
3443 char *str = Jim_Alloc(len + 1);
3444 len = JimEscape(str, t->token, len);
3445 objPtr = Jim_NewStringObjNoAlloc(interp, str, len);
3447 else {
3448 /* XXX: For strict Tcl compatibility, JIM_TT_STR should replace <backslash><newline><whitespace>
3449 * with a single space.
3451 objPtr = Jim_NewStringObj(interp, t->token, t->len);
3453 return objPtr;
3457 * Takes a tokenlist and creates the allocated list of script tokens
3458 * in script->token, of length script->len.
3460 * Unnecessary tokens are discarded, and LINE and WORD tokens are inserted
3461 * as required.
3463 * Also sets script->line to the line number of the first token
3465 static void ScriptObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3466 ParseTokenList *tokenlist)
3468 int i;
3469 struct ScriptToken *token;
3470 /* Number of tokens so far for the current command */
3471 int lineargs = 0;
3472 /* This is the first token for the current command */
3473 ScriptToken *linefirst;
3474 int count;
3475 int linenr;
3477 #ifdef DEBUG_SHOW_SCRIPT_TOKENS
3478 printf("==== Tokens ====\n");
3479 for (i = 0; i < tokenlist->count; i++) {
3480 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist->list[i].line, jim_tt_name(tokenlist->list[i].type),
3481 tokenlist->list[i].len, tokenlist->list[i].token);
3483 #endif
3485 /* May need up to one extra script token for each EOL in the worst case */
3486 count = tokenlist->count;
3487 for (i = 0; i < tokenlist->count; i++) {
3488 if (tokenlist->list[i].type == JIM_TT_EOL) {
3489 count++;
3492 linenr = script->firstline = tokenlist->list[0].line;
3494 token = script->token = Jim_Alloc(sizeof(ScriptToken) * count);
3496 /* This is the first token for the current command */
3497 linefirst = token++;
3499 for (i = 0; i < tokenlist->count; ) {
3500 /* Look ahead to find out how many tokens make up the next word */
3501 int wordtokens;
3503 /* Skip any leading separators */
3504 while (tokenlist->list[i].type == JIM_TT_SEP) {
3505 i++;
3508 wordtokens = JimCountWordTokens(script, tokenlist->list + i);
3510 if (wordtokens == 0) {
3511 /* None, so at end of line */
3512 if (lineargs) {
3513 linefirst->type = JIM_TT_LINE;
3514 linefirst->objPtr = JimNewScriptLineObj(interp, lineargs, linenr);
3515 Jim_IncrRefCount(linefirst->objPtr);
3517 /* Reset for new line */
3518 lineargs = 0;
3519 linefirst = token++;
3521 i++;
3522 continue;
3524 else if (wordtokens != 1) {
3525 /* More than 1, or {*}, so insert a WORD token */
3526 token->type = JIM_TT_WORD;
3527 token->objPtr = Jim_NewIntObj(interp, wordtokens);
3528 Jim_IncrRefCount(token->objPtr);
3529 token++;
3530 if (wordtokens < 0) {
3531 /* Skip the expand token */
3532 i++;
3533 wordtokens = -wordtokens - 1;
3534 lineargs--;
3538 if (lineargs == 0) {
3539 /* First real token on the line, so record the line number */
3540 linenr = tokenlist->list[i].line;
3542 lineargs++;
3544 /* Add each non-separator word token to the line */
3545 while (wordtokens--) {
3546 const ParseToken *t = &tokenlist->list[i++];
3548 token->type = t->type;
3549 token->objPtr = JimMakeScriptObj(interp, t);
3550 Jim_IncrRefCount(token->objPtr);
3552 /* Every object is initially a string of type 'source', but the
3553 * internal type may be specialized during execution of the
3554 * script. */
3555 JimSetSourceInfo(interp, token->objPtr, script->fileNameObj, t->line);
3556 token++;
3560 if (lineargs == 0) {
3561 token--;
3564 script->len = token - script->token;
3566 JimPanic((script->len >= count, "allocated script array is too short"));
3568 #ifdef DEBUG_SHOW_SCRIPT
3569 printf("==== Script (%s) ====\n", Jim_String(script->fileNameObj));
3570 for (i = 0; i < script->len; i++) {
3571 const ScriptToken *t = &script->token[i];
3572 printf("[%2d] %s %s\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
3574 #endif
3578 /* Parses the given string object to determine if it represents a complete script.
3580 * This is useful for interactive shells implementation, for [info complete].
3582 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
3583 * '{' on scripts incomplete missing one or more '}' to be balanced.
3584 * '[' on scripts incomplete missing one or more ']' to be balanced.
3585 * '"' on scripts incomplete missing a '"' char.
3586 * '\\' on scripts with a trailing backslash.
3588 * If the script is complete, 1 is returned, otherwise 0.
3590 * If the script has extra characters after a close brace, this still returns 1,
3591 * but sets *stateCharPtr to '}'
3592 * Evaluating the script will give the error "extra characters after close-brace".
3594 int Jim_ScriptIsComplete(Jim_Interp *interp, Jim_Obj *scriptObj, char *stateCharPtr)
3596 ScriptObj *script = JimGetScript(interp, scriptObj);
3597 if (stateCharPtr) {
3598 *stateCharPtr = script->missing;
3600 return script->missing == ' ' || script->missing == '}';
3604 * Sets an appropriate error message for a missing script/expression terminator.
3606 * Returns JIM_ERR if 'ch' represents an unmatched/missing character.
3608 * Note that a trailing backslash is not considered to be an error.
3610 static int JimParseCheckMissing(Jim_Interp *interp, int ch)
3612 const char *msg;
3614 switch (ch) {
3615 case '\\':
3616 case ' ':
3617 return JIM_OK;
3619 case '[':
3620 msg = "unmatched \"[\"";
3621 break;
3622 case '{':
3623 msg = "missing close-brace";
3624 break;
3625 case '}':
3626 msg = "extra characters after close-brace";
3627 break;
3628 case '"':
3629 default:
3630 msg = "missing quote";
3631 break;
3634 Jim_SetResultString(interp, msg, -1);
3635 return JIM_ERR;
3639 * Similar to ScriptObjAddTokens(), but for subst objects.
3641 static void SubstObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3642 ParseTokenList *tokenlist)
3644 int i;
3645 struct ScriptToken *token;
3647 token = script->token = Jim_Alloc(sizeof(ScriptToken) * tokenlist->count);
3649 for (i = 0; i < tokenlist->count; i++) {
3650 const ParseToken *t = &tokenlist->list[i];
3652 /* Create a token for 't' */
3653 token->type = t->type;
3654 token->objPtr = JimMakeScriptObj(interp, t);
3655 Jim_IncrRefCount(token->objPtr);
3656 token++;
3659 script->len = i;
3662 /* This method takes the string representation of an object
3663 * as a Tcl script, and generates the pre-parsed internal representation
3664 * of the script.
3666 * On parse error, sets an error message and returns JIM_ERR
3667 * (Note: the object is still converted to a script, even if an error occurs)
3669 static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3671 int scriptTextLen;
3672 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
3673 struct JimParserCtx parser;
3674 struct ScriptObj *script;
3675 ParseTokenList tokenlist;
3676 int line = 1;
3678 /* Try to get information about filename / line number */
3679 if (objPtr->typePtr == &sourceObjType) {
3680 line = objPtr->internalRep.sourceValue.lineNumber;
3683 /* Initially parse the script into tokens (in tokenlist) */
3684 ScriptTokenListInit(&tokenlist);
3686 JimParserInit(&parser, scriptText, scriptTextLen, line);
3687 while (!parser.eof) {
3688 JimParseScript(&parser);
3689 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
3690 parser.tline);
3693 /* Add a final EOF token */
3694 ScriptAddToken(&tokenlist, scriptText + scriptTextLen, 0, JIM_TT_EOF, 0);
3696 /* Create the "real" script tokens from the parsed tokens */
3697 script = Jim_Alloc(sizeof(*script));
3698 memset(script, 0, sizeof(*script));
3699 script->inUse = 1;
3700 if (objPtr->typePtr == &sourceObjType) {
3701 script->fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
3703 else {
3704 script->fileNameObj = interp->emptyObj;
3706 Jim_IncrRefCount(script->fileNameObj);
3707 script->missing = parser.missing.ch;
3708 script->linenr = parser.missing.line;
3710 ScriptObjAddTokens(interp, script, &tokenlist);
3712 /* No longer need the token list */
3713 ScriptTokenListFree(&tokenlist);
3715 /* Free the old internal rep and set the new one. */
3716 Jim_FreeIntRep(interp, objPtr);
3717 Jim_SetIntRepPtr(objPtr, script);
3718 objPtr->typePtr = &scriptObjType;
3721 static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script);
3724 * Returns the parsed script.
3725 * Note that if there is any possibility that the script is not valid,
3726 * call JimScriptValid() to check
3728 static ScriptObj *JimGetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3730 if (objPtr == interp->emptyObj) {
3731 /* Avoid converting emptyObj to a script. use nullScriptObj instead. */
3732 objPtr = interp->nullScriptObj;
3735 if (objPtr->typePtr != &scriptObjType || ((struct ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags) {
3736 JimSetScriptFromAny(interp, objPtr);
3739 return (ScriptObj *)Jim_GetIntRepPtr(objPtr);
3743 * Returns 1 if the script is valid (parsed ok), otherwise returns 0
3744 * and leaves an error message in the interp result.
3747 static int JimScriptValid(Jim_Interp *interp, ScriptObj *script)
3749 if (JimParseCheckMissing(interp, script->missing) == JIM_ERR) {
3750 JimAddErrorToStack(interp, script);
3751 return 0;
3753 return 1;
3757 /* -----------------------------------------------------------------------------
3758 * Commands
3759 * ---------------------------------------------------------------------------*/
3760 void Jim_InterpIncrProcEpoch(Jim_Interp *interp)
3762 interp->procEpoch++;
3764 /* Now discard all out-of-date Jim_Cmd entries */
3765 while (interp->oldCmdCache) {
3766 Jim_Cmd *next = interp->oldCmdCache->prevCmd;
3767 Jim_Free(interp->oldCmdCache);
3768 interp->oldCmdCache = next;
3770 interp->oldCmdCacheSize = 0;
3773 static void JimIncrCmdRefCount(Jim_Cmd *cmdPtr)
3775 cmdPtr->inUse++;
3778 static void JimDecrCmdRefCount(Jim_Interp *interp, Jim_Cmd *cmdPtr)
3780 if (--cmdPtr->inUse == 0) {
3781 if (cmdPtr->isproc) {
3782 Jim_DecrRefCount(interp, cmdPtr->u.proc.argListObjPtr);
3783 Jim_DecrRefCount(interp, cmdPtr->u.proc.bodyObjPtr);
3784 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
3785 if (cmdPtr->u.proc.staticVars) {
3786 Jim_FreeHashTable(cmdPtr->u.proc.staticVars);
3787 Jim_Free(cmdPtr->u.proc.staticVars);
3790 else {
3791 /* native (C) */
3792 if (cmdPtr->u.native.delProc) {
3793 cmdPtr->u.native.delProc(interp, cmdPtr->u.native.privData);
3796 if (cmdPtr->prevCmd) {
3797 /* Delete any pushed command too */
3798 JimDecrCmdRefCount(interp, cmdPtr->prevCmd);
3801 if (interp->quitting) {
3802 Jim_Free(cmdPtr);
3804 else {
3805 /* Preserve the structure with inUse = 0 so that
3806 * cached references will continue to work.
3807 * These will be discarding at the next procEpoch increment
3808 * or once 1000 have been accumulated.
3810 cmdPtr->prevCmd = interp->oldCmdCache;
3811 interp->oldCmdCache = cmdPtr;
3812 if (++interp->oldCmdCacheSize >= 1000) {
3813 Jim_InterpIncrProcEpoch(interp);
3819 /* Variables HashTable Type.
3821 * Keys are dynamically allocated strings, Values are Jim_Var structures.
3823 static void JimVariablesHTValDestructor(void *interp, void *val)
3825 Jim_DecrRefCount(interp, ((Jim_Var *)val)->objPtr);
3826 Jim_Free(val);
3829 static unsigned int JimObjectHTHashFunction(const void *key)
3831 int len;
3832 const char *str = Jim_GetString((Jim_Obj *)key, &len);
3833 return Jim_GenHashFunction((const unsigned char *)str, len);
3836 static int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
3838 return Jim_StringEqObj((Jim_Obj *)key1, (Jim_Obj *)key2);
3841 static void *JimObjectHTKeyValDup(void *privdata, const void *val)
3843 Jim_IncrRefCount((Jim_Obj *)val);
3844 return (void *)val;
3847 static void JimObjectHTKeyValDestructor(void *interp, void *val)
3849 Jim_DecrRefCount(interp, (Jim_Obj *)val);
3853 static const Jim_HashTableType JimVariablesHashTableType = {
3854 JimObjectHTHashFunction, /* hash function */
3855 JimObjectHTKeyValDup, /* key dup */
3856 NULL, /* val dup */
3857 JimObjectHTKeyCompare, /* key compare */
3858 JimObjectHTKeyValDestructor, /* key destructor */
3859 JimVariablesHTValDestructor /* val destructor */
3862 /* Commands HashTable Type.
3864 * Keys are Jim Objects where any leading namespace qualifier
3865 * is ignored. Values are Jim_Cmd structures.
3869 * Like Jim_GetString() but strips any leading namespace qualifier.
3871 static const char *Jim_GetStringNoQualifier(Jim_Obj *objPtr, int *length)
3873 int len;
3874 const char *str = Jim_GetString(objPtr, &len);
3875 if (len >= 2 && str[0] == ':' && str[1] == ':') {
3876 while (len && *str == ':') {
3877 len--;
3878 str++;
3881 *length = len;
3882 return str;
3885 static unsigned int JimCommandsHT_HashFunction(const void *key)
3887 int len;
3888 const char *str = Jim_GetStringNoQualifier((Jim_Obj *)key, &len);
3889 return Jim_GenHashFunction((const unsigned char *)str, len);
3892 static int JimCommandsHT_KeyCompare(void *privdata, const void *key1, const void *key2)
3894 int len1, len2;
3895 const char *str1 = Jim_GetStringNoQualifier((Jim_Obj *)key1, &len1);
3896 const char *str2 = Jim_GetStringNoQualifier((Jim_Obj *)key2, &len2);
3897 return len1 == len2 && memcmp(str1, str2, len1) == 0;
3900 static void JimCommandsHT_ValDestructor(void *interp, void *val)
3902 JimDecrCmdRefCount(interp, val);
3905 static const Jim_HashTableType JimCommandsHashTableType = {
3906 JimCommandsHT_HashFunction, /* hash function */
3907 JimObjectHTKeyValDup, /* key dup */
3908 NULL, /* val dup */
3909 JimCommandsHT_KeyCompare, /* key compare */
3910 JimObjectHTKeyValDestructor, /* key destructor */
3911 JimCommandsHT_ValDestructor /* val destructor */
3914 /* ------------------------- Commands related functions --------------------- */
3917 * If nameObjPtr starts with "::", returns it.
3918 * Otherwise returns a new object with nameObjPtr prefixed with "::".
3919 * In this case, decrements the ref count of nameObjPtr.
3921 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3923 #ifdef jim_ext_namespace
3924 Jim_Obj *resultObj;
3926 const char *name = Jim_String(nameObjPtr);
3927 if (name[0] == ':' && name[1] == ':') {
3928 return nameObjPtr;
3930 Jim_IncrRefCount(nameObjPtr);
3931 resultObj = Jim_NewStringObj(interp, "::", -1);
3932 Jim_AppendObj(interp, resultObj, nameObjPtr);
3933 Jim_DecrRefCount(interp, nameObjPtr);
3935 return resultObj;
3936 #else
3937 return nameObjPtr;
3938 #endif
3942 * If the name in objPtr is not fully qualified, and a non-global namespace
3943 * is in effect, qualifies the name with the current namespace and returns the new name.
3944 * Otherwise returns objPtr.
3946 * In either case the ref count is incremented and should be decremented by the caller.
3947 * with Jim_DecrRefCount()
3949 static Jim_Obj *JimQualifyName(Jim_Interp *interp, Jim_Obj *objPtr)
3951 #ifdef jim_ext_namespace
3952 if (Jim_Length(interp->framePtr->nsObj)) {
3953 int len;
3954 const char *name = Jim_GetString(objPtr, &len);
3955 if (len < 2 || name[0] != ':' || name[1] != ':') {
3956 /* OK. Need to qualify this name */
3957 objPtr = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3958 Jim_AppendStrings(interp, objPtr, "::", name, NULL);
3961 #endif
3962 Jim_IncrRefCount(objPtr);
3963 return objPtr;
3967 * Note that nameObjPtr must already be namespace qualified.
3969 static int JimCreateCommand(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Cmd *cmd)
3971 /* It may already exist, so we try to delete the old one.
3972 * Note that reference count means that it won't be deleted yet if
3973 * it exists in the call stack.
3975 * BUT, if 'local' is in force, instead of deleting the existing
3976 * proc, we stash a reference to the old proc here.
3978 Jim_HashEntry *he = Jim_FindHashEntry(&interp->commands, nameObjPtr);
3979 if (he) {
3980 /* There was an old cmd with the same name,
3981 * so this requires a 'proc epoch' update. */
3983 /* If a procedure with the same name didn't exist there is no need
3984 * to increment the 'proc epoch' because creation of a new procedure
3985 * can never affect existing cached commands. We don't do
3986 * negative caching. */
3987 //Jim_InterpIncrProcEpoch(interp);
3990 if (he && interp->local) {
3991 /* Push this command over the top of the previous one */
3992 cmd->prevCmd = Jim_GetHashEntryVal(he);
3993 Jim_SetHashVal(&interp->commands, he, cmd);
3994 /* Need to increment the proc epoch here so that the new command will be used */
3995 Jim_InterpIncrProcEpoch(interp);
3997 else {
3998 if (he) {
3999 /* Replace the existing command */
4000 Jim_DeleteHashEntry(&interp->commands, nameObjPtr);
4003 Jim_AddHashEntry(&interp->commands, nameObjPtr, cmd);
4005 return JIM_OK;
4008 int Jim_CreateCommandObj(Jim_Interp *interp, Jim_Obj *cmdNameObj,
4009 Jim_CmdProc *cmdProc, void *privData, Jim_DelCmdProc *delProc)
4011 Jim_Cmd *cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
4013 /* Store the new details for this command */
4014 memset(cmdPtr, 0, sizeof(*cmdPtr));
4015 cmdPtr->inUse = 1;
4016 cmdPtr->u.native.delProc = delProc;
4017 cmdPtr->u.native.cmdProc = cmdProc;
4018 cmdPtr->u.native.privData = privData;
4020 JimCreateCommand(interp, cmdNameObj, cmdPtr);
4022 return JIM_OK;
4026 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdNameStr,
4027 Jim_CmdProc *cmdProc, void *privData, Jim_DelCmdProc *delProc)
4029 return Jim_CreateCommandObj(interp, Jim_NewStringObj(interp, cmdNameStr, -1), cmdProc, privData, delProc);
4032 static int JimCreateProcedureStatics(Jim_Interp *interp, Jim_Cmd *cmdPtr, Jim_Obj *staticsListObjPtr)
4034 int len, i;
4036 len = Jim_ListLength(interp, staticsListObjPtr);
4037 if (len == 0) {
4038 return JIM_OK;
4041 cmdPtr->u.proc.staticVars = Jim_Alloc(sizeof(Jim_HashTable));
4042 Jim_InitHashTable(cmdPtr->u.proc.staticVars, &JimVariablesHashTableType, interp);
4043 for (i = 0; i < len; i++) {
4044 Jim_Obj *objPtr, *initObjPtr, *nameObjPtr;
4045 Jim_Var *varPtr;
4046 int subLen;
4048 objPtr = Jim_ListGetIndex(interp, staticsListObjPtr, i);
4049 /* Check if it's composed of two elements. */
4050 subLen = Jim_ListLength(interp, objPtr);
4051 if (subLen == 1 || subLen == 2) {
4052 /* Try to get the variable value from the current
4053 * environment. */
4054 nameObjPtr = Jim_ListGetIndex(interp, objPtr, 0);
4055 if (subLen == 1) {
4056 initObjPtr = Jim_GetVariable(interp, nameObjPtr, JIM_NONE);
4057 if (initObjPtr == NULL) {
4058 Jim_SetResultFormatted(interp,
4059 "variable for initialization of static \"%#s\" not found in the local context",
4060 nameObjPtr);
4061 return JIM_ERR;
4064 else {
4065 initObjPtr = Jim_ListGetIndex(interp, objPtr, 1);
4068 varPtr = Jim_Alloc(sizeof(*varPtr));
4069 varPtr->objPtr = initObjPtr;
4070 Jim_IncrRefCount(initObjPtr);
4071 varPtr->linkFramePtr = NULL;
4072 if (JimSetNewVariable(cmdPtr->u.proc.staticVars, nameObjPtr, varPtr) != JIM_OK) {
4073 Jim_SetResultFormatted(interp,
4074 "static variable name \"%#s\" duplicated in statics list", nameObjPtr);
4075 Jim_DecrRefCount(interp, initObjPtr);
4076 Jim_Free(varPtr);
4077 return JIM_ERR;
4080 else {
4081 Jim_SetResultFormatted(interp, "too many fields in static specifier \"%#s\"",
4082 objPtr);
4083 return JIM_ERR;
4086 return JIM_OK;
4089 /* memrchr() is not standard */
4090 static const char *Jim_memrchr(const char *p, int c, int len)
4092 int i;
4093 for (i = len; i > 0; i--) {
4094 if (p[i] == c) {
4095 return p + i;
4098 return NULL;
4102 * If the command is a proc, sets/updates the cached namespace (nsObj)
4103 * based on the command name.
4105 static void JimUpdateProcNamespace(Jim_Interp *interp, Jim_Cmd *cmdPtr, Jim_Obj *nameObjPtr)
4107 #ifdef jim_ext_namespace
4108 if (cmdPtr->isproc) {
4109 int len;
4110 const char *cmdname = Jim_GetStringNoQualifier(nameObjPtr, &len);
4111 /* XXX: Really need JimNamespaceSplit() */
4112 const char *pt = Jim_memrchr(cmdname, ':', len);
4113 if (pt && pt != cmdname && pt[-1] == ':') {
4114 pt++;
4115 /* Now pt points to the base name .e.g. ::abc::def::ghi points to ghi
4116 * while cmdname points to abc
4118 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
4119 cmdPtr->u.proc.nsObj = Jim_NewStringObj(interp, cmdname, pt - cmdname - 2);
4120 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
4122 Jim_Obj *tempObj = Jim_NewStringObj(interp, pt, len - (pt - cmdname));
4123 if (Jim_FindHashEntry(&interp->commands, tempObj)) {
4124 /* This command shadows a global command, so a proc epoch update is required */
4125 Jim_InterpIncrProcEpoch(interp);
4127 Jim_FreeNewObj(interp, tempObj);
4130 #endif
4133 static Jim_Cmd *JimCreateProcedureCmd(Jim_Interp *interp, Jim_Obj *argListObjPtr,
4134 Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr, Jim_Obj *nsObj)
4136 Jim_Cmd *cmdPtr;
4137 int argListLen;
4138 int i;
4140 argListLen = Jim_ListLength(interp, argListObjPtr);
4142 /* Allocate space for both the command pointer and the arg list */
4143 cmdPtr = Jim_Alloc(sizeof(*cmdPtr) + sizeof(struct Jim_ProcArg) * argListLen);
4144 memset(cmdPtr, 0, sizeof(*cmdPtr));
4145 cmdPtr->inUse = 1;
4146 cmdPtr->isproc = 1;
4147 cmdPtr->u.proc.argListObjPtr = argListObjPtr;
4148 cmdPtr->u.proc.argListLen = argListLen;
4149 cmdPtr->u.proc.bodyObjPtr = bodyObjPtr;
4150 cmdPtr->u.proc.argsPos = -1;
4151 cmdPtr->u.proc.arglist = (struct Jim_ProcArg *)(cmdPtr + 1);
4152 cmdPtr->u.proc.nsObj = nsObj ? nsObj : interp->emptyObj;
4153 Jim_IncrRefCount(argListObjPtr);
4154 Jim_IncrRefCount(bodyObjPtr);
4155 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
4157 /* Create the statics hash table. */
4158 if (staticsListObjPtr && JimCreateProcedureStatics(interp, cmdPtr, staticsListObjPtr) != JIM_OK) {
4159 goto err;
4162 /* Parse the args out into arglist, validating as we go */
4163 /* Examine the argument list for default parameters and 'args' */
4164 for (i = 0; i < argListLen; i++) {
4165 Jim_Obj *argPtr;
4166 Jim_Obj *nameObjPtr;
4167 Jim_Obj *defaultObjPtr;
4168 int len;
4170 /* Examine a parameter */
4171 argPtr = Jim_ListGetIndex(interp, argListObjPtr, i);
4172 len = Jim_ListLength(interp, argPtr);
4173 if (len == 0) {
4174 Jim_SetResultString(interp, "argument with no name", -1);
4175 err:
4176 JimDecrCmdRefCount(interp, cmdPtr);
4177 return NULL;
4179 if (len > 2) {
4180 Jim_SetResultFormatted(interp, "too many fields in argument specifier \"%#s\"", argPtr);
4181 goto err;
4184 if (len == 2) {
4185 /* Optional parameter */
4186 nameObjPtr = Jim_ListGetIndex(interp, argPtr, 0);
4187 defaultObjPtr = Jim_ListGetIndex(interp, argPtr, 1);
4189 else {
4190 /* Required parameter */
4191 nameObjPtr = argPtr;
4192 defaultObjPtr = NULL;
4196 if (Jim_CompareStringImmediate(interp, nameObjPtr, "args")) {
4197 if (cmdPtr->u.proc.argsPos >= 0) {
4198 Jim_SetResultString(interp, "'args' specified more than once", -1);
4199 goto err;
4201 cmdPtr->u.proc.argsPos = i;
4203 else {
4204 if (len == 2) {
4205 cmdPtr->u.proc.optArity++;
4207 else {
4208 cmdPtr->u.proc.reqArity++;
4212 cmdPtr->u.proc.arglist[i].nameObjPtr = nameObjPtr;
4213 cmdPtr->u.proc.arglist[i].defaultObjPtr = defaultObjPtr;
4216 return cmdPtr;
4219 int Jim_DeleteCommand(Jim_Interp *interp, Jim_Obj *nameObj)
4221 int ret = JIM_OK;
4223 nameObj = JimQualifyName(interp, nameObj);
4225 if (Jim_DeleteHashEntry(&interp->commands, nameObj) == JIM_ERR) {
4226 Jim_SetResultFormatted(interp, "can't delete \"%#s\": command doesn't exist", nameObj);
4227 ret = JIM_ERR;
4229 Jim_DecrRefCount(interp, nameObj);
4231 return ret;
4234 int Jim_RenameCommand(Jim_Interp *interp, Jim_Obj *oldNameObj, Jim_Obj *newNameObj)
4236 int ret = JIM_ERR;
4237 Jim_HashEntry *he;
4238 Jim_Cmd *cmdPtr;
4240 if (Jim_Length(newNameObj) == 0) {
4241 return Jim_DeleteCommand(interp, oldNameObj);
4244 /* each name may need to have the current namespace added to it */
4246 oldNameObj = JimQualifyName(interp, oldNameObj);
4247 newNameObj = JimQualifyName(interp, newNameObj);
4249 /* Does it exist? */
4250 he = Jim_FindHashEntry(&interp->commands, oldNameObj);
4251 if (he == NULL) {
4252 Jim_SetResultFormatted(interp, "can't rename \"%#s\": command doesn't exist", oldNameObj);
4254 else if (Jim_FindHashEntry(&interp->commands, newNameObj)) {
4255 Jim_SetResultFormatted(interp, "can't rename to \"%#s\": command already exists", newNameObj);
4257 else {
4258 cmdPtr = Jim_GetHashEntryVal(he);
4259 if (cmdPtr->prevCmd) {
4260 /* If the command replaced another command with 'local', renaming it
4261 * would break the usage of upcall, so don't allow it.
4263 Jim_SetResultFormatted(interp, "can't rename local command \"%#s\"", oldNameObj);
4265 else {
4266 /* Add the new name first */
4267 JimIncrCmdRefCount(cmdPtr);
4268 JimUpdateProcNamespace(interp, cmdPtr, newNameObj);
4269 Jim_AddHashEntry(&interp->commands, newNameObj, cmdPtr);
4271 /* Now remove the old name */
4272 Jim_DeleteHashEntry(&interp->commands, oldNameObj);
4274 /* Increment the epoch */
4275 Jim_InterpIncrProcEpoch(interp);
4277 ret = JIM_OK;
4281 Jim_DecrRefCount(interp, oldNameObj);
4282 Jim_DecrRefCount(interp, newNameObj);
4284 return ret;
4287 /* -----------------------------------------------------------------------------
4288 * Command object
4289 * ---------------------------------------------------------------------------*/
4291 static void FreeCommandInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4293 Jim_DecrRefCount(interp, objPtr->internalRep.cmdValue.nsObj);
4296 static void DupCommandInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4298 dupPtr->internalRep.cmdValue = srcPtr->internalRep.cmdValue;
4299 dupPtr->typePtr = srcPtr->typePtr;
4300 Jim_IncrRefCount(dupPtr->internalRep.cmdValue.nsObj);
4303 static const Jim_ObjType commandObjType = {
4304 "command",
4305 FreeCommandInternalRep,
4306 DupCommandInternalRep,
4307 NULL,
4308 JIM_TYPE_REFERENCES,
4311 /* This function returns the command structure for the command name
4312 * stored in objPtr. It specializes the objPtr to contain
4313 * cached info instead of performing the lookup into the hash table
4314 * every time. The information cached may not be up-to-date, in this
4315 * case the lookup is performed and the cache updated.
4317 * Respects the 'upcall' setting.
4319 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4321 Jim_Cmd *cmd = NULL;
4323 /* In order to be valid, the proc epoch must match and
4324 * the lookup must have occurred in the same namespace
4326 if (objPtr->typePtr == &commandObjType) {
4327 cmd = objPtr->internalRep.cmdValue.cmdPtr;
4328 if (cmd->inUse == 0 || objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch
4329 #ifdef jim_ext_namespace
4330 || !Jim_StringEqObj(objPtr->internalRep.cmdValue.nsObj, interp->framePtr->nsObj)
4331 #endif
4333 /* Cache is invalid */
4334 cmd = NULL;
4337 if (!cmd) {
4338 Jim_Obj *qualifiedNameObj = JimQualifyName(interp, objPtr);
4339 Jim_HashEntry *he = Jim_FindHashEntry(&interp->commands, qualifiedNameObj);
4340 #ifdef jim_ext_namespace
4341 if (he == NULL && Jim_Length(interp->framePtr->nsObj)) {
4342 he = Jim_FindHashEntry(&interp->commands, objPtr);
4344 #endif
4345 if (he == NULL) {
4346 if (flags & JIM_ERRMSG) {
4347 Jim_SetResultFormatted(interp, "invalid command name \"%#s\"", objPtr);
4349 Jim_DecrRefCount(interp, qualifiedNameObj);
4350 return NULL;
4352 cmd = Jim_GetHashEntryVal(he);
4354 /* Free the old internal rep and set the new one. */
4355 Jim_FreeIntRep(interp, objPtr);
4356 objPtr->typePtr = &commandObjType;
4357 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
4358 objPtr->internalRep.cmdValue.cmdPtr = cmd;
4359 objPtr->internalRep.cmdValue.nsObj = interp->framePtr->nsObj;
4360 Jim_IncrRefCount(interp->framePtr->nsObj);
4361 Jim_DecrRefCount(interp, qualifiedNameObj);
4363 while (cmd->u.proc.upcall) {
4364 cmd = cmd->prevCmd;
4366 return cmd;
4369 /* -----------------------------------------------------------------------------
4370 * Variables
4371 * ---------------------------------------------------------------------------*/
4373 /* -----------------------------------------------------------------------------
4374 * Variable object
4375 * ---------------------------------------------------------------------------*/
4377 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
4379 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4381 static const Jim_ObjType variableObjType = {
4382 "variable",
4383 NULL,
4384 NULL,
4385 NULL,
4386 JIM_TYPE_REFERENCES,
4389 /* This method should be called only by the variable API.
4390 * It returns JIM_OK on success (variable already exists),
4391 * JIM_ERR if it does not exist, JIM_DICT_SUGAR if it's not
4392 * a variable name, but syntax glue for [dict] i.e. the last
4393 * character is ')' */
4394 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
4396 const char *varName;
4397 Jim_CallFrame *framePtr;
4398 int global;
4399 int len;
4400 Jim_Var *var;
4402 /* Check if the object is already an uptodate variable */
4403 if (objPtr->typePtr == &variableObjType) {
4404 framePtr = objPtr->internalRep.varValue.global ? interp->topFramePtr : interp->framePtr;
4405 if (objPtr->internalRep.varValue.callFrameId == framePtr->id) {
4406 /* nothing to do */
4407 return JIM_OK;
4409 /* Need to re-resolve the variable in the updated callframe */
4411 else if (objPtr->typePtr == &dictSubstObjType) {
4412 return JIM_DICT_SUGAR;
4415 varName = Jim_GetString(objPtr, &len);
4417 /* Make sure it's not syntax glue to get/set dict. */
4418 if (len && varName[len - 1] == ')' && strchr(varName, '(') != NULL) {
4419 return JIM_DICT_SUGAR;
4422 if (varName[0] == ':' && varName[1] == ':') {
4423 while (*varName == ':') {
4424 varName++;
4425 len--;
4427 global = 1;
4428 framePtr = interp->topFramePtr;
4429 /* XXX should use length */
4430 Jim_Obj *tempObj = Jim_NewStringObj(interp, varName, len);
4431 var = JimFindVariable(&framePtr->vars, tempObj);
4432 Jim_FreeNewObj(interp, tempObj);
4434 else {
4435 global = 0;
4436 framePtr = interp->framePtr;
4437 /* Resolve this name in the variables hash table */
4438 var = JimFindVariable(&framePtr->vars, objPtr);
4439 if (var == NULL && framePtr->staticVars) {
4440 /* Try with static vars. */
4441 var = JimFindVariable(framePtr->staticVars, objPtr);
4445 if (var == NULL) {
4446 return JIM_ERR;
4449 /* Free the old internal repr and set the new one. */
4450 Jim_FreeIntRep(interp, objPtr);
4451 objPtr->typePtr = &variableObjType;
4452 objPtr->internalRep.varValue.callFrameId = framePtr->id;
4453 objPtr->internalRep.varValue.varPtr = var;
4454 objPtr->internalRep.varValue.global = global;
4455 return JIM_OK;
4458 /* -------------------- Variables related functions ------------------------- */
4459 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr, Jim_Obj *valObjPtr);
4460 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr, int flags);
4462 static int JimSetNewVariable(Jim_HashTable *ht, Jim_Obj *nameObjPtr, Jim_Var *var)
4464 return Jim_AddHashEntry(ht, nameObjPtr, var);
4467 static Jim_Var *JimFindVariable(Jim_HashTable *ht, Jim_Obj *nameObjPtr)
4469 Jim_HashEntry *he = Jim_FindHashEntry(ht, nameObjPtr);
4470 if (he) {
4471 return (Jim_Var *)Jim_GetHashEntryVal(he);
4473 return NULL;
4476 static int JimUnsetVariable(Jim_HashTable *ht, Jim_Obj *nameObjPtr)
4478 return Jim_DeleteHashEntry(ht, nameObjPtr);
4481 static Jim_Var *JimCreateVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4483 const char *name;
4484 Jim_CallFrame *framePtr;
4485 int global;
4486 int len;
4488 /* New variable to create */
4489 Jim_Var *var = Jim_Alloc(sizeof(*var));
4491 var->objPtr = valObjPtr;
4492 Jim_IncrRefCount(valObjPtr);
4493 var->linkFramePtr = NULL;
4495 name = Jim_GetString(nameObjPtr, &len);
4496 if (name[0] == ':' && name[1] == ':') {
4497 while (*name == ':') {
4498 name++;
4499 len--;
4501 framePtr = interp->topFramePtr;
4502 global = 1;
4503 JimSetNewVariable(&framePtr->vars, Jim_NewStringObj(interp, name, len), var);
4505 else {
4506 framePtr = interp->framePtr;
4507 global = 0;
4508 JimSetNewVariable(&framePtr->vars, nameObjPtr, var);
4511 /* Make the object int rep a variable */
4512 Jim_FreeIntRep(interp, nameObjPtr);
4513 nameObjPtr->typePtr = &variableObjType;
4514 nameObjPtr->internalRep.varValue.callFrameId = framePtr->id;
4515 nameObjPtr->internalRep.varValue.varPtr = var;
4516 nameObjPtr->internalRep.varValue.global = global;
4518 return var;
4521 /* For now that's dummy. Variables lookup should be optimized
4522 * in many ways, with caching of lookups, and possibly with
4523 * a table of pre-allocated vars in every CallFrame for local vars.
4524 * All the caching should also have an 'epoch' mechanism similar
4525 * to the one used by Tcl for procedures lookup caching. */
4528 * Set the variable nameObjPtr to value valObjptr.
4530 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4532 int err;
4533 Jim_Var *var;
4535 switch (SetVariableFromAny(interp, nameObjPtr)) {
4536 case JIM_DICT_SUGAR:
4537 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
4539 case JIM_ERR:
4540 JimCreateVariable(interp, nameObjPtr, valObjPtr);
4541 break;
4543 case JIM_OK:
4544 var = nameObjPtr->internalRep.varValue.varPtr;
4545 if (var->linkFramePtr == NULL) {
4546 Jim_IncrRefCount(valObjPtr);
4547 Jim_DecrRefCount(interp, var->objPtr);
4548 var->objPtr = valObjPtr;
4550 else { /* Else handle the link */
4551 Jim_CallFrame *savedCallFrame;
4553 savedCallFrame = interp->framePtr;
4554 interp->framePtr = var->linkFramePtr;
4555 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
4556 interp->framePtr = savedCallFrame;
4557 if (err != JIM_OK)
4558 return err;
4561 return JIM_OK;
4564 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4566 Jim_Obj *nameObjPtr;
4567 int result;
4569 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4570 Jim_IncrRefCount(nameObjPtr);
4571 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
4572 Jim_DecrRefCount(interp, nameObjPtr);
4573 return result;
4576 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4578 Jim_CallFrame *savedFramePtr;
4579 int result;
4581 savedFramePtr = interp->framePtr;
4582 interp->framePtr = interp->topFramePtr;
4583 result = Jim_SetVariableStr(interp, name, objPtr);
4584 interp->framePtr = savedFramePtr;
4585 return result;
4588 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
4590 Jim_Obj *valObjPtr;
4591 int result;
4593 valObjPtr = Jim_NewStringObj(interp, val, -1);
4594 Jim_IncrRefCount(valObjPtr);
4595 result = Jim_SetVariableStr(interp, name, valObjPtr);
4596 Jim_DecrRefCount(interp, valObjPtr);
4597 return result;
4600 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
4601 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
4603 const char *varName;
4604 const char *targetName;
4605 Jim_CallFrame *framePtr;
4606 Jim_Var *varPtr;
4607 int len;
4608 int varnamelen;
4610 /* Check for an existing variable or link */
4611 switch (SetVariableFromAny(interp, nameObjPtr)) {
4612 case JIM_DICT_SUGAR:
4613 /* XXX: This message seem unnecessarily verbose, but it matches Tcl */
4614 Jim_SetResultFormatted(interp, "bad variable name \"%#s\": upvar won't create a scalar variable that looks like an array element", nameObjPtr);
4615 return JIM_ERR;
4617 case JIM_OK:
4618 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4620 if (varPtr->linkFramePtr == NULL) {
4621 Jim_SetResultFormatted(interp, "variable \"%#s\" already exists", nameObjPtr);
4622 return JIM_ERR;
4625 /* It exists, but is a link, so first delete the link */
4626 varPtr->linkFramePtr = NULL;
4627 break;
4630 /* Resolve the call frames for both variables */
4631 /* XXX: SetVariableFromAny() already did this! */
4632 varName = Jim_GetString(nameObjPtr, &varnamelen);
4634 if (varName[0] == ':' && varName[1] == ':') {
4635 while (*varName == ':') {
4636 varName++;
4637 varnamelen--;
4639 /* Linking a global var does nothing */
4640 framePtr = interp->topFramePtr;
4642 else {
4643 framePtr = interp->framePtr;
4646 targetName = Jim_GetString(targetNameObjPtr, &len);
4647 if (targetName[0] == ':' && targetName[1] == ':') {
4648 while (*targetName == ':') {
4649 targetName++;
4650 len--;
4652 targetNameObjPtr = Jim_NewStringObj(interp, targetName, len);
4653 targetCallFrame = interp->topFramePtr;
4655 Jim_IncrRefCount(targetNameObjPtr);
4657 if (framePtr->level < targetCallFrame->level) {
4658 Jim_SetResultFormatted(interp,
4659 "bad variable name \"%#s\": upvar won't create namespace variable that refers to procedure variable",
4660 nameObjPtr);
4661 Jim_DecrRefCount(interp, targetNameObjPtr);
4662 return JIM_ERR;
4665 /* Check for cycles. */
4666 if (framePtr == targetCallFrame) {
4667 Jim_Obj *objPtr = targetNameObjPtr;
4669 /* Cycles are only possible with 'uplevel 0' */
4670 while (1) {
4671 if (Jim_Length(objPtr) == varnamelen && memcmp(Jim_String(objPtr), varName, varnamelen) == 0) {
4672 Jim_SetResultString(interp, "can't upvar from variable to itself", -1);
4673 Jim_DecrRefCount(interp, targetNameObjPtr);
4674 return JIM_ERR;
4676 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
4677 break;
4678 varPtr = objPtr->internalRep.varValue.varPtr;
4679 if (varPtr->linkFramePtr != targetCallFrame)
4680 break;
4681 objPtr = varPtr->objPtr;
4685 /* Perform the binding */
4686 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
4687 /* We are now sure 'nameObjPtr' type is variableObjType */
4688 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
4689 Jim_DecrRefCount(interp, targetNameObjPtr);
4690 return JIM_OK;
4693 /* Return the Jim_Obj pointer associated with a variable name,
4694 * or NULL if the variable was not found in the current context.
4695 * The same optimization discussed in the comment to the
4696 * 'SetVariable' function should apply here.
4698 * If JIM_UNSHARED is set and the variable is an array element (dict sugar)
4699 * in a dictionary which is shared, the array variable value is duplicated first.
4700 * This allows the array element to be updated (e.g. append, lappend) without
4701 * affecting other references to the dictionary.
4703 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4705 switch (SetVariableFromAny(interp, nameObjPtr)) {
4706 case JIM_OK:{
4707 Jim_Var *varPtr = nameObjPtr->internalRep.varValue.varPtr;
4709 if (varPtr->linkFramePtr == NULL) {
4710 return varPtr->objPtr;
4712 else {
4713 Jim_Obj *objPtr;
4715 /* The variable is a link? Resolve it. */
4716 Jim_CallFrame *savedCallFrame = interp->framePtr;
4718 interp->framePtr = varPtr->linkFramePtr;
4719 objPtr = Jim_GetVariable(interp, varPtr->objPtr, flags);
4720 interp->framePtr = savedCallFrame;
4721 if (objPtr) {
4722 return objPtr;
4724 /* Error, so fall through to the error message */
4727 break;
4729 case JIM_DICT_SUGAR:
4730 /* [dict] syntax sugar. */
4731 return JimDictSugarGet(interp, nameObjPtr, flags);
4733 if (flags & JIM_ERRMSG) {
4734 Jim_SetResultFormatted(interp, "can't read \"%#s\": no such variable", nameObjPtr);
4736 return NULL;
4739 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4741 Jim_CallFrame *savedFramePtr;
4742 Jim_Obj *objPtr;
4744 savedFramePtr = interp->framePtr;
4745 interp->framePtr = interp->topFramePtr;
4746 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4747 interp->framePtr = savedFramePtr;
4749 return objPtr;
4752 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
4754 Jim_Obj *nameObjPtr, *varObjPtr;
4756 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4757 Jim_IncrRefCount(nameObjPtr);
4758 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4759 Jim_DecrRefCount(interp, nameObjPtr);
4760 return varObjPtr;
4763 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name, int flags)
4765 Jim_CallFrame *savedFramePtr;
4766 Jim_Obj *objPtr;
4768 savedFramePtr = interp->framePtr;
4769 interp->framePtr = interp->topFramePtr;
4770 objPtr = Jim_GetVariableStr(interp, name, flags);
4771 interp->framePtr = savedFramePtr;
4773 return objPtr;
4776 /* Unset a variable.
4777 * Note: On success unset invalidates all the (cached) variable objects
4778 * by incrementing callFrameEpoch
4780 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4782 Jim_Var *varPtr;
4783 int retval;
4784 Jim_CallFrame *framePtr;
4786 retval = SetVariableFromAny(interp, nameObjPtr);
4787 if (retval == JIM_DICT_SUGAR) {
4788 /* [dict] syntax sugar. */
4789 return JimDictSugarSet(interp, nameObjPtr, NULL);
4791 else if (retval == JIM_OK) {
4792 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4794 /* If it's a link call UnsetVariable recursively */
4795 if (varPtr->linkFramePtr) {
4796 framePtr = interp->framePtr;
4797 interp->framePtr = varPtr->linkFramePtr;
4798 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
4799 interp->framePtr = framePtr;
4801 else {
4802 if (nameObjPtr->internalRep.varValue.global) {
4803 int len;
4804 const char *name = Jim_GetString(nameObjPtr, &len);
4805 while (*name == ':') {
4806 name++;
4807 len--;
4809 framePtr = interp->topFramePtr;
4810 Jim_Obj *tempObj = Jim_NewStringObj(interp, name, len);
4811 retval = JimUnsetVariable(&framePtr->vars, tempObj);
4812 Jim_FreeNewObj(interp, tempObj);
4814 else {
4815 framePtr = interp->framePtr;
4816 retval = JimUnsetVariable(&framePtr->vars, nameObjPtr);
4819 if (retval == JIM_OK) {
4820 /* Change the callframe id, invalidating var lookup caching */
4821 framePtr->id = interp->callFrameEpoch++;
4825 if (retval != JIM_OK && (flags & JIM_ERRMSG)) {
4826 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such variable", nameObjPtr);
4828 return retval;
4831 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
4833 /* Given a variable name for [dict] operation syntax sugar,
4834 * this function returns two objects, the first with the name
4835 * of the variable to set, and the second with the respective key.
4836 * For example "foo(bar)" will return objects with string repr. of
4837 * "foo" and "bar".
4839 * The returned objects have refcount = 1. The function can't fail. */
4840 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
4841 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
4843 const char *str, *p;
4844 int len, keyLen;
4845 Jim_Obj *varObjPtr, *keyObjPtr;
4847 str = Jim_GetString(objPtr, &len);
4849 p = strchr(str, '(');
4850 JimPanic((p == NULL, "JimDictSugarParseVarKey() called for non-dict-sugar (%s)", str));
4852 varObjPtr = Jim_NewStringObj(interp, str, p - str);
4854 p++;
4855 keyLen = (str + len) - p;
4856 if (str[len - 1] == ')') {
4857 keyLen--;
4860 /* Create the objects with the variable name and key. */
4861 keyObjPtr = Jim_NewStringObj(interp, p, keyLen);
4863 Jim_IncrRefCount(varObjPtr);
4864 Jim_IncrRefCount(keyObjPtr);
4865 *varPtrPtr = varObjPtr;
4866 *keyPtrPtr = keyObjPtr;
4869 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
4870 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
4871 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *valObjPtr)
4873 int err;
4875 SetDictSubstFromAny(interp, objPtr);
4877 err = Jim_SetDictKeysVector(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4878 &objPtr->internalRep.dictSubstValue.indexObjPtr, 1, valObjPtr, JIM_MUSTEXIST);
4880 if (err == JIM_OK) {
4881 /* Don't keep an extra ref to the result */
4882 Jim_SetEmptyResult(interp);
4884 else {
4885 if (!valObjPtr) {
4886 /* Better error message for unset a(2) where a exists but a(2) doesn't */
4887 if (Jim_GetVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_NONE)) {
4888 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such element in array",
4889 objPtr);
4890 return err;
4893 /* Make the error more informative and Tcl-compatible */
4894 Jim_SetResultFormatted(interp, "can't %s \"%#s\": variable isn't array",
4895 (valObjPtr ? "set" : "unset"), objPtr);
4897 return err;
4901 * Expands the array variable (dict sugar) and returns the result, or NULL on error.
4903 * If JIM_UNSHARED is set and the dictionary is shared, it will be duplicated
4904 * and stored back to the variable before expansion.
4906 static Jim_Obj *JimDictExpandArrayVariable(Jim_Interp *interp, Jim_Obj *varObjPtr,
4907 Jim_Obj *keyObjPtr, int flags)
4909 Jim_Obj *dictObjPtr;
4910 Jim_Obj *resObjPtr = NULL;
4911 int ret;
4913 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
4914 if (!dictObjPtr) {
4915 return NULL;
4918 ret = Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_NONE);
4919 if (ret != JIM_OK) {
4920 Jim_SetResultFormatted(interp,
4921 "can't read \"%#s(%#s)\": %s array", varObjPtr, keyObjPtr,
4922 ret < 0 ? "variable isn't" : "no such element in");
4924 else if ((flags & JIM_UNSHARED) && Jim_IsShared(dictObjPtr)) {
4925 /* Update the variable to have an unshared copy */
4926 Jim_SetVariable(interp, varObjPtr, Jim_DuplicateObj(interp, dictObjPtr));
4929 return resObjPtr;
4932 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
4933 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4935 SetDictSubstFromAny(interp, objPtr);
4937 return JimDictExpandArrayVariable(interp,
4938 objPtr->internalRep.dictSubstValue.varNameObjPtr,
4939 objPtr->internalRep.dictSubstValue.indexObjPtr, flags);
4942 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
4944 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4946 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
4947 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
4950 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4952 /* Copy the internal rep */
4953 dupPtr->internalRep = srcPtr->internalRep;
4954 /* Need to increment the ref counts */
4955 Jim_IncrRefCount(dupPtr->internalRep.dictSubstValue.varNameObjPtr);
4956 Jim_IncrRefCount(dupPtr->internalRep.dictSubstValue.indexObjPtr);
4959 /* Note: The object *must* be in dict-sugar format */
4960 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4962 if (objPtr->typePtr != &dictSubstObjType) {
4963 Jim_Obj *varObjPtr, *keyObjPtr;
4965 if (objPtr->typePtr == &interpolatedObjType) {
4966 /* An interpolated object in dict-sugar form */
4968 varObjPtr = objPtr->internalRep.dictSubstValue.varNameObjPtr;
4969 keyObjPtr = objPtr->internalRep.dictSubstValue.indexObjPtr;
4971 Jim_IncrRefCount(varObjPtr);
4972 Jim_IncrRefCount(keyObjPtr);
4974 else {
4975 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
4978 Jim_FreeIntRep(interp, objPtr);
4979 objPtr->typePtr = &dictSubstObjType;
4980 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
4981 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
4985 /* This function is used to expand [dict get] sugar in the form
4986 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
4987 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
4988 * object that is *guaranteed* to be in the form VARNAME(INDEX).
4989 * The 'index' part is [subst]ituted, and is used to lookup a key inside
4990 * the [dict]ionary contained in variable VARNAME. */
4991 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4993 Jim_Obj *resObjPtr = NULL;
4994 Jim_Obj *substKeyObjPtr = NULL;
4996 SetDictSubstFromAny(interp, objPtr);
4998 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
4999 &substKeyObjPtr, JIM_NONE)
5000 != JIM_OK) {
5001 return NULL;
5003 Jim_IncrRefCount(substKeyObjPtr);
5004 resObjPtr =
5005 JimDictExpandArrayVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
5006 substKeyObjPtr, 0);
5007 Jim_DecrRefCount(interp, substKeyObjPtr);
5009 return resObjPtr;
5012 /* -----------------------------------------------------------------------------
5013 * CallFrame
5014 * ---------------------------------------------------------------------------*/
5016 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp, Jim_CallFrame *parent, Jim_Obj *nsObj)
5018 Jim_CallFrame *cf;
5020 if (interp->freeFramesList) {
5021 cf = interp->freeFramesList;
5022 interp->freeFramesList = cf->next;
5024 cf->argv = NULL;
5025 cf->argc = 0;
5026 cf->procArgsObjPtr = NULL;
5027 cf->procBodyObjPtr = NULL;
5028 cf->next = NULL;
5029 cf->staticVars = NULL;
5030 cf->localCommands = NULL;
5031 cf->tailcallObj = NULL;
5032 cf->tailcallCmd = NULL;
5034 else {
5035 cf = Jim_Alloc(sizeof(*cf));
5036 memset(cf, 0, sizeof(*cf));
5038 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
5041 cf->id = interp->callFrameEpoch++;
5042 cf->parent = parent;
5043 cf->level = parent ? parent->level + 1 : 0;
5044 cf->nsObj = nsObj;
5045 Jim_IncrRefCount(nsObj);
5047 return cf;
5050 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands)
5052 /* Delete any local procs */
5053 if (localCommands) {
5054 Jim_Obj *cmdNameObj;
5056 while ((cmdNameObj = Jim_StackPop(localCommands)) != NULL) {
5057 Jim_HashTable *ht = &interp->commands;
5058 Jim_HashEntry *he = Jim_FindHashEntry(ht, cmdNameObj);
5059 if (he) {
5060 Jim_Cmd *cmd = Jim_GetHashEntryVal(he);
5061 if (cmd->prevCmd) {
5062 Jim_Cmd *prevCmd = cmd->prevCmd;
5063 cmd->prevCmd = NULL;
5065 /* Delete the old command */
5066 JimDecrCmdRefCount(interp, cmd);
5068 /* And restore the original */
5069 Jim_SetHashVal(ht, he, prevCmd);
5071 else {
5072 Jim_DeleteHashEntry(ht, cmdNameObj);
5075 Jim_DecrRefCount(interp, cmdNameObj);
5077 Jim_FreeStack(localCommands);
5078 Jim_Free(localCommands);
5080 return JIM_OK;
5084 * Run any $jim::defer scripts for the current call frame.
5086 * retcode is the return code from the current proc.
5088 * Returns the new return code.
5090 static int JimInvokeDefer(Jim_Interp *interp, int retcode)
5092 Jim_Obj *objPtr;
5094 /* Fast check for the likely case that the variable doesn't exist */
5095 if (JimFindVariable(&interp->framePtr->vars, interp->defer) == NULL) {
5096 return retcode;
5098 objPtr = Jim_GetVariable(interp, interp->defer, JIM_NONE);
5100 if (objPtr) {
5101 int ret = JIM_OK;
5102 int i;
5103 int listLen = Jim_ListLength(interp, objPtr);
5104 Jim_Obj *resultObjPtr;
5106 Jim_IncrRefCount(objPtr);
5108 /* Need to save away the current interp result and
5109 * restore it if appropriate
5111 resultObjPtr = Jim_GetResult(interp);
5112 Jim_IncrRefCount(resultObjPtr);
5113 Jim_SetEmptyResult(interp);
5115 /* Invoke in reverse order */
5116 for (i = listLen; i > 0; i--) {
5117 /* If a defer script returns an error, don't evaluate remaining scripts */
5118 Jim_Obj *scriptObjPtr = Jim_ListGetIndex(interp, objPtr, i - 1);
5119 ret = Jim_EvalObj(interp, scriptObjPtr);
5120 if (ret != JIM_OK) {
5121 break;
5125 if (ret == JIM_OK || retcode == JIM_ERR) {
5126 /* defer script had no error, or proc had an error so restore proc result */
5127 Jim_SetResult(interp, resultObjPtr);
5129 else {
5130 retcode = ret;
5133 Jim_DecrRefCount(interp, resultObjPtr);
5134 Jim_DecrRefCount(interp, objPtr);
5136 return retcode;
5139 #define JIM_FCF_FULL 0 /* Always free the vars hash table */
5140 #define JIM_FCF_REUSE 1 /* Reuse the vars hash table if possible */
5141 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action)
5143 JimDeleteLocalProcs(interp, cf->localCommands);
5145 if (cf->procArgsObjPtr)
5146 Jim_DecrRefCount(interp, cf->procArgsObjPtr);
5147 if (cf->procBodyObjPtr)
5148 Jim_DecrRefCount(interp, cf->procBodyObjPtr);
5149 Jim_DecrRefCount(interp, cf->nsObj);
5150 if (action == JIM_FCF_FULL || cf->vars.size != JIM_HT_INITIAL_SIZE)
5151 Jim_FreeHashTable(&cf->vars);
5152 else {
5153 Jim_ClearHashTable(&cf->vars);
5155 cf->next = interp->freeFramesList;
5156 interp->freeFramesList = cf;
5160 /* -----------------------------------------------------------------------------
5161 * References
5162 * ---------------------------------------------------------------------------*/
5163 #if defined(JIM_REFERENCES) && !defined(JIM_BOOTSTRAP)
5165 /* References HashTable Type.
5167 * Keys are unsigned long integers, dynamically allocated for now but in the
5168 * future it's worth to cache this 4 bytes objects. Values are pointers
5169 * to Jim_References. */
5170 static void JimReferencesHTValDestructor(void *interp, void *val)
5172 Jim_Reference *refPtr = (void *)val;
5174 Jim_DecrRefCount(interp, refPtr->objPtr);
5175 if (refPtr->finalizerCmdNamePtr != NULL) {
5176 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5178 Jim_Free(val);
5181 static unsigned int JimReferencesHTHashFunction(const void *key)
5183 /* Only the least significant bits are used. */
5184 const unsigned long *widePtr = key;
5185 unsigned int intValue = (unsigned int)*widePtr;
5187 return Jim_IntHashFunction(intValue);
5190 static void *JimReferencesHTKeyDup(void *privdata, const void *key)
5192 void *copy = Jim_Alloc(sizeof(unsigned long));
5194 JIM_NOTUSED(privdata);
5196 memcpy(copy, key, sizeof(unsigned long));
5197 return copy;
5200 static int JimReferencesHTKeyCompare(void *privdata, const void *key1, const void *key2)
5202 JIM_NOTUSED(privdata);
5204 return memcmp(key1, key2, sizeof(unsigned long)) == 0;
5207 static void JimReferencesHTKeyDestructor(void *privdata, void *key)
5209 JIM_NOTUSED(privdata);
5211 Jim_Free(key);
5214 static const Jim_HashTableType JimReferencesHashTableType = {
5215 JimReferencesHTHashFunction, /* hash function */
5216 JimReferencesHTKeyDup, /* key dup */
5217 NULL, /* val dup */
5218 JimReferencesHTKeyCompare, /* key compare */
5219 JimReferencesHTKeyDestructor, /* key destructor */
5220 JimReferencesHTValDestructor /* val destructor */
5223 /* -----------------------------------------------------------------------------
5224 * Reference object type and References API
5225 * ---------------------------------------------------------------------------*/
5227 /* The string representation of references has two features in order
5228 * to make the GC faster. The first is that every reference starts
5229 * with a non common character '<', in order to make the string matching
5230 * faster. The second is that the reference string rep is 42 characters
5231 * in length, this means that it is not necessary to check any object with a string
5232 * repr < 42, and usually there aren't many of these objects. */
5234 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
5236 static int JimFormatReference(char *buf, Jim_Reference *refPtr, unsigned long id)
5238 const char *fmt = "<reference.<%s>.%020lu>";
5240 sprintf(buf, fmt, refPtr->tag, id);
5241 return JIM_REFERENCE_SPACE;
5244 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
5246 static const Jim_ObjType referenceObjType = {
5247 "reference",
5248 NULL,
5249 NULL,
5250 UpdateStringOfReference,
5251 JIM_TYPE_REFERENCES,
5254 static void UpdateStringOfReference(struct Jim_Obj *objPtr)
5256 char buf[JIM_REFERENCE_SPACE + 1];
5258 JimFormatReference(buf, objPtr->internalRep.refValue.refPtr, objPtr->internalRep.refValue.id);
5259 JimSetStringBytes(objPtr, buf);
5262 /* returns true if 'c' is a valid reference tag character.
5263 * i.e. inside the range [_a-zA-Z0-9] */
5264 static int isrefchar(int c)
5266 return (c == '_' || isalnum(c));
5269 static int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5271 unsigned long value;
5272 int i, len;
5273 const char *str, *start, *end;
5274 char refId[21];
5275 Jim_Reference *refPtr;
5276 Jim_HashEntry *he;
5277 char *endptr;
5279 /* Get the string representation */
5280 str = Jim_GetString(objPtr, &len);
5281 /* Check if it looks like a reference */
5282 if (len < JIM_REFERENCE_SPACE)
5283 goto badformat;
5284 /* Trim spaces */
5285 start = str;
5286 end = str + len - 1;
5287 while (*start == ' ')
5288 start++;
5289 while (*end == ' ' && end > start)
5290 end--;
5291 if (end - start + 1 != JIM_REFERENCE_SPACE)
5292 goto badformat;
5293 /* <reference.<1234567>.%020> */
5294 if (memcmp(start, "<reference.<", 12) != 0)
5295 goto badformat;
5296 if (start[12 + JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>')
5297 goto badformat;
5298 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
5299 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5300 if (!isrefchar(start[12 + i]))
5301 goto badformat;
5303 /* Extract info from the reference. */
5304 memcpy(refId, start + 14 + JIM_REFERENCE_TAGLEN, 20);
5305 refId[20] = '\0';
5306 /* Try to convert the ID into an unsigned long */
5307 value = strtoul(refId, &endptr, 10);
5308 if (JimCheckConversion(refId, endptr) != JIM_OK)
5309 goto badformat;
5310 /* Check if the reference really exists! */
5311 he = Jim_FindHashEntry(&interp->references, &value);
5312 if (he == NULL) {
5313 Jim_SetResultFormatted(interp, "invalid reference id \"%#s\"", objPtr);
5314 return JIM_ERR;
5316 refPtr = Jim_GetHashEntryVal(he);
5317 /* Free the old internal repr and set the new one. */
5318 Jim_FreeIntRep(interp, objPtr);
5319 objPtr->typePtr = &referenceObjType;
5320 objPtr->internalRep.refValue.id = value;
5321 objPtr->internalRep.refValue.refPtr = refPtr;
5322 return JIM_OK;
5324 badformat:
5325 Jim_SetResultFormatted(interp, "expected reference but got \"%#s\"", objPtr);
5326 return JIM_ERR;
5329 /* Returns a new reference pointing to objPtr, having cmdNamePtr
5330 * as finalizer command (or NULL if there is no finalizer).
5331 * The returned reference object has refcount = 0. */
5332 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr, Jim_Obj *cmdNamePtr)
5334 struct Jim_Reference *refPtr;
5335 unsigned long id;
5336 Jim_Obj *refObjPtr;
5337 const char *tag;
5338 int tagLen, i;
5340 /* Perform the Garbage Collection if needed. */
5341 Jim_CollectIfNeeded(interp);
5343 refPtr = Jim_Alloc(sizeof(*refPtr));
5344 refPtr->objPtr = objPtr;
5345 Jim_IncrRefCount(objPtr);
5346 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5347 if (cmdNamePtr)
5348 Jim_IncrRefCount(cmdNamePtr);
5349 id = interp->referenceNextId++;
5350 Jim_AddHashEntry(&interp->references, &id, refPtr);
5351 refObjPtr = Jim_NewObj(interp);
5352 refObjPtr->typePtr = &referenceObjType;
5353 refObjPtr->bytes = NULL;
5354 refObjPtr->internalRep.refValue.id = id;
5355 refObjPtr->internalRep.refValue.refPtr = refPtr;
5356 interp->referenceNextId++;
5357 /* Set the tag. Trimmed at JIM_REFERENCE_TAGLEN. Everything
5358 * that does not pass the 'isrefchar' test is replaced with '_' */
5359 tag = Jim_GetString(tagPtr, &tagLen);
5360 if (tagLen > JIM_REFERENCE_TAGLEN)
5361 tagLen = JIM_REFERENCE_TAGLEN;
5362 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5363 if (i < tagLen && isrefchar(tag[i]))
5364 refPtr->tag[i] = tag[i];
5365 else
5366 refPtr->tag[i] = '_';
5368 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
5369 return refObjPtr;
5372 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
5374 if (objPtr->typePtr != &referenceObjType && SetReferenceFromAny(interp, objPtr) == JIM_ERR)
5375 return NULL;
5376 return objPtr->internalRep.refValue.refPtr;
5379 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
5381 Jim_Reference *refPtr;
5383 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5384 return JIM_ERR;
5385 Jim_IncrRefCount(cmdNamePtr);
5386 if (refPtr->finalizerCmdNamePtr)
5387 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5388 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5389 return JIM_OK;
5392 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
5394 Jim_Reference *refPtr;
5396 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5397 return JIM_ERR;
5398 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
5399 return JIM_OK;
5402 /* -----------------------------------------------------------------------------
5403 * References Garbage Collection
5404 * ---------------------------------------------------------------------------*/
5406 /* This the hash table type for the "MARK" phase of the GC */
5407 static const Jim_HashTableType JimRefMarkHashTableType = {
5408 JimReferencesHTHashFunction, /* hash function */
5409 JimReferencesHTKeyDup, /* key dup */
5410 NULL, /* val dup */
5411 JimReferencesHTKeyCompare, /* key compare */
5412 JimReferencesHTKeyDestructor, /* key destructor */
5413 NULL /* val destructor */
5416 /* Performs the garbage collection. */
5417 int Jim_Collect(Jim_Interp *interp)
5419 int collected = 0;
5420 Jim_HashTable marks;
5421 Jim_HashTableIterator htiter;
5422 Jim_HashEntry *he;
5423 Jim_Obj *objPtr;
5425 /* Avoid recursive calls */
5426 if (interp->lastCollectId == (unsigned long)~0) {
5427 /* Jim_Collect() already running. Return just now. */
5428 return 0;
5430 interp->lastCollectId = ~0;
5432 /* Mark all the references found into the 'mark' hash table.
5433 * The references are searched in every live object that
5434 * is of a type that can contain references. */
5435 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
5436 objPtr = interp->liveList;
5437 while (objPtr) {
5438 if (objPtr->typePtr == NULL || objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
5439 const char *str, *p;
5440 int len;
5442 /* If the object is of type reference, to get the
5443 * Id is simple... */
5444 if (objPtr->typePtr == &referenceObjType) {
5445 Jim_AddHashEntry(&marks, &objPtr->internalRep.refValue.id, NULL);
5446 #ifdef JIM_DEBUG_GC
5447 printf("MARK (reference): %d refcount: %d\n",
5448 (int)objPtr->internalRep.refValue.id, objPtr->refCount);
5449 #endif
5450 objPtr = objPtr->nextObjPtr;
5451 continue;
5453 /* Get the string repr of the object we want
5454 * to scan for references. */
5455 p = str = Jim_GetString(objPtr, &len);
5456 /* Skip objects too little to contain references. */
5457 if (len < JIM_REFERENCE_SPACE) {
5458 objPtr = objPtr->nextObjPtr;
5459 continue;
5462 /* Maybe the entire string is a reference that is also in the commands table with a refcount of 1.
5463 * If so, this can be collected */
5464 if (objPtr->refCount == 1) {
5465 if (Jim_FindHashEntry(&interp->commands, objPtr)) {
5466 #ifdef JIM_DEBUG_GC
5467 printf("Found %s which is a command with refcount=1, so not marking\n", Jim_String(objPtr));
5468 #endif
5469 /* Yes, a command with refcount of 1 */
5470 objPtr = objPtr->nextObjPtr;
5471 continue;
5475 /* Extract references from the object string repr. */
5476 while (1) {
5477 int i;
5478 unsigned long id;
5480 if ((p = strstr(p, "<reference.<")) == NULL)
5481 break;
5482 /* Check if it's a valid reference. */
5483 if (len - (p - str) < JIM_REFERENCE_SPACE)
5484 break;
5485 if (p[41] != '>' || p[19] != '>' || p[20] != '.')
5486 break;
5487 for (i = 21; i <= 40; i++)
5488 if (!isdigit(UCHAR(p[i])))
5489 break;
5490 /* Get the ID */
5491 id = strtoul(p + 21, NULL, 10);
5493 /* Ok, a reference for the given ID
5494 * was found. Mark it. */
5495 Jim_AddHashEntry(&marks, &id, NULL);
5496 #ifdef JIM_DEBUG_GC
5497 printf("MARK: %d\n", (int)id);
5498 #endif
5499 p += JIM_REFERENCE_SPACE;
5502 objPtr = objPtr->nextObjPtr;
5505 /* Run the references hash table to destroy every reference that
5506 * is not referenced outside (not present in the mark HT). */
5507 JimInitHashTableIterator(&interp->references, &htiter);
5508 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
5509 const unsigned long *refId;
5510 Jim_Reference *refPtr;
5512 refId = he->key;
5513 /* Check if in the mark phase we encountered
5514 * this reference. */
5515 if (Jim_FindHashEntry(&marks, refId) == NULL) {
5516 #ifdef JIM_DEBUG_GC
5517 printf("COLLECTING %d\n", (int)*refId);
5518 #endif
5519 collected++;
5520 /* Drop the reference, but call the
5521 * finalizer first if registered. */
5522 refPtr = Jim_GetHashEntryVal(he);
5523 if (refPtr->finalizerCmdNamePtr) {
5524 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE + 1);
5525 Jim_Obj *objv[3], *oldResult;
5527 JimFormatReference(refstr, refPtr, *refId);
5529 objv[0] = refPtr->finalizerCmdNamePtr;
5530 objv[1] = Jim_NewStringObjNoAlloc(interp, refstr, JIM_REFERENCE_SPACE);
5531 objv[2] = refPtr->objPtr;
5533 /* Drop the reference itself */
5534 /* Avoid the finaliser being freed here */
5535 Jim_IncrRefCount(objv[0]);
5536 /* Don't remove the reference from the hash table just yet
5537 * since that will free refPtr, and hence refPtr->objPtr
5540 /* Call the finalizer. Errors ignored. (should we use bgerror?) */
5541 oldResult = interp->result;
5542 Jim_IncrRefCount(oldResult);
5543 Jim_EvalObjVector(interp, 3, objv);
5544 Jim_SetResult(interp, oldResult);
5545 Jim_DecrRefCount(interp, oldResult);
5547 Jim_DecrRefCount(interp, objv[0]);
5549 Jim_DeleteHashEntry(&interp->references, refId);
5552 Jim_FreeHashTable(&marks);
5553 interp->lastCollectId = interp->referenceNextId;
5554 interp->lastCollectTime = JimClock();
5555 return collected;
5558 #define JIM_COLLECT_ID_PERIOD 5000000
5559 #define JIM_COLLECT_TIME_PERIOD 300000
5561 void Jim_CollectIfNeeded(Jim_Interp *interp)
5563 unsigned long elapsedId;
5564 jim_wide elapsedTime;
5566 elapsedId = interp->referenceNextId - interp->lastCollectId;
5567 elapsedTime = JimClock() - interp->lastCollectTime;
5570 if (elapsedId > JIM_COLLECT_ID_PERIOD || elapsedTime > JIM_COLLECT_TIME_PERIOD) {
5571 Jim_Collect(interp);
5574 #endif /* JIM_REFERENCES && !JIM_BOOTSTRAP */
5576 int Jim_IsBigEndian(void)
5578 union {
5579 unsigned short s;
5580 unsigned char c[2];
5581 } uval = {0x0102};
5583 return uval.c[0] == 1;
5586 /* -----------------------------------------------------------------------------
5587 * Interpreter related functions
5588 * ---------------------------------------------------------------------------*/
5590 Jim_Interp *Jim_CreateInterp(void)
5592 Jim_Interp *i = Jim_Alloc(sizeof(*i));
5594 memset(i, 0, sizeof(*i));
5596 i->maxCallFrameDepth = JIM_MAX_CALLFRAME_DEPTH;
5597 i->maxEvalDepth = JIM_MAX_EVAL_DEPTH;
5598 i->lastCollectTime = JimClock();
5600 /* Note that we can create objects only after the
5601 * interpreter liveList and freeList pointers are
5602 * initialized to NULL. */
5603 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
5604 #ifdef JIM_REFERENCES
5605 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
5606 #endif
5607 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
5608 Jim_InitHashTable(&i->packages, &JimPackageHashTableType, NULL);
5609 i->emptyObj = Jim_NewEmptyStringObj(i);
5610 i->trueObj = Jim_NewIntObj(i, 1);
5611 i->falseObj = Jim_NewIntObj(i, 0);
5612 i->framePtr = i->topFramePtr = JimCreateCallFrame(i, NULL, i->emptyObj);
5613 i->errorFileNameObj = i->emptyObj;
5614 i->result = i->emptyObj;
5615 i->stackTrace = Jim_NewListObj(i, NULL, 0);
5616 i->unknown = Jim_NewStringObj(i, "unknown", -1);
5617 i->defer = Jim_NewStringObj(i, "jim::defer", -1);
5618 i->errorProc = i->emptyObj;
5619 i->currentScriptObj = Jim_NewEmptyStringObj(i);
5620 i->nullScriptObj = Jim_NewEmptyStringObj(i);
5621 Jim_IncrRefCount(i->emptyObj);
5622 Jim_IncrRefCount(i->errorFileNameObj);
5623 Jim_IncrRefCount(i->result);
5624 Jim_IncrRefCount(i->stackTrace);
5625 Jim_IncrRefCount(i->unknown);
5626 Jim_IncrRefCount(i->defer);
5627 Jim_IncrRefCount(i->currentScriptObj);
5628 Jim_IncrRefCount(i->nullScriptObj);
5629 Jim_IncrRefCount(i->errorProc);
5630 Jim_IncrRefCount(i->trueObj);
5631 Jim_IncrRefCount(i->falseObj);
5633 /* Initialize key variables every interpreter should contain */
5634 Jim_SetVariableStrWithStr(i, JIM_LIBPATH, TCL_LIBRARY);
5635 Jim_SetVariableStrWithStr(i, JIM_INTERACTIVE, "0");
5637 Jim_SetVariableStrWithStr(i, "tcl_platform(engine)", "Jim");
5638 Jim_SetVariableStrWithStr(i, "tcl_platform(os)", TCL_PLATFORM_OS);
5639 Jim_SetVariableStrWithStr(i, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM);
5640 Jim_SetVariableStrWithStr(i, "tcl_platform(pathSeparator)", TCL_PLATFORM_PATH_SEPARATOR);
5641 Jim_SetVariableStrWithStr(i, "tcl_platform(byteOrder)", Jim_IsBigEndian() ? "bigEndian" : "littleEndian");
5642 Jim_SetVariableStrWithStr(i, "tcl_platform(threaded)", "0");
5643 Jim_SetVariableStr(i, "tcl_platform(pointerSize)", Jim_NewIntObj(i, sizeof(void *)));
5644 Jim_SetVariableStr(i, "tcl_platform(wordSize)", Jim_NewIntObj(i, sizeof(jim_wide)));
5646 return i;
5649 void Jim_FreeInterp(Jim_Interp *i)
5651 Jim_CallFrame *cf, *cfx;
5653 Jim_Obj *objPtr, *nextObjPtr;
5655 i->quitting = 1;
5657 /* Free the active call frames list - must be done before i->commands is destroyed */
5658 for (cf = i->framePtr; cf; cf = cfx) {
5659 /* Note that we ignore any errors */
5660 JimInvokeDefer(i, JIM_OK);
5661 cfx = cf->parent;
5662 JimFreeCallFrame(i, cf, JIM_FCF_FULL);
5665 Jim_DecrRefCount(i, i->emptyObj);
5666 Jim_DecrRefCount(i, i->trueObj);
5667 Jim_DecrRefCount(i, i->falseObj);
5668 Jim_DecrRefCount(i, i->result);
5669 Jim_DecrRefCount(i, i->stackTrace);
5670 Jim_DecrRefCount(i, i->errorProc);
5671 Jim_DecrRefCount(i, i->unknown);
5672 Jim_DecrRefCount(i, i->defer);
5673 Jim_DecrRefCount(i, i->errorFileNameObj);
5674 Jim_DecrRefCount(i, i->currentScriptObj);
5675 Jim_DecrRefCount(i, i->nullScriptObj);
5677 Jim_InterpIncrProcEpoch(i);
5679 Jim_FreeHashTable(&i->commands);
5680 #ifdef JIM_REFERENCES
5681 Jim_FreeHashTable(&i->references);
5682 #endif
5683 Jim_FreeHashTable(&i->packages);
5684 Jim_Free(i->prngState);
5685 Jim_FreeHashTable(&i->assocData);
5687 /* Check that the live object list is empty, otherwise
5688 * there is a memory leak. */
5689 #ifdef JIM_MAINTAINER
5690 if (i->liveList != NULL) {
5691 objPtr = i->liveList;
5693 printf("\n-------------------------------------\n");
5694 printf("Objects still in the free list:\n");
5695 while (objPtr) {
5696 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "string";
5697 Jim_String(objPtr);
5699 if (objPtr->bytes && strlen(objPtr->bytes) > 20) {
5700 printf("%p (%d) %-10s: '%.20s...'\n",
5701 (void *)objPtr, objPtr->refCount, type, objPtr->bytes);
5703 else {
5704 printf("%p (%d) %-10s: '%s'\n",
5705 (void *)objPtr, objPtr->refCount, type, objPtr->bytes ? objPtr->bytes : "(null)");
5707 if (objPtr->typePtr == &sourceObjType) {
5708 printf("FILE %s LINE %d\n",
5709 Jim_String(objPtr->internalRep.sourceValue.fileNameObj),
5710 objPtr->internalRep.sourceValue.lineNumber);
5712 objPtr = objPtr->nextObjPtr;
5714 printf("-------------------------------------\n\n");
5715 JimPanic((1, "Live list non empty freeing the interpreter! Leak?"));
5717 #endif
5719 /* Free all the freed objects. */
5720 objPtr = i->freeList;
5721 while (objPtr) {
5722 nextObjPtr = objPtr->nextObjPtr;
5723 Jim_Free(objPtr);
5724 objPtr = nextObjPtr;
5727 /* Free the free call frames list */
5728 for (cf = i->freeFramesList; cf; cf = cfx) {
5729 cfx = cf->next;
5730 if (cf->vars.table)
5731 Jim_FreeHashTable(&cf->vars);
5732 Jim_Free(cf);
5735 /* Free the interpreter structure. */
5736 Jim_Free(i);
5739 /* Returns the call frame relative to the level represented by
5740 * levelObjPtr. If levelObjPtr == NULL, the level is assumed to be '1'.
5742 * This function accepts the 'level' argument in the form
5743 * of the commands [uplevel] and [upvar].
5745 * Returns NULL on error.
5747 * Note: for a function accepting a relative integer as level suitable
5748 * for implementation of [info level ?level?], see JimGetCallFrameByInteger()
5750 Jim_CallFrame *Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5752 long level;
5753 const char *str;
5754 Jim_CallFrame *framePtr;
5756 if (levelObjPtr) {
5757 str = Jim_String(levelObjPtr);
5758 if (str[0] == '#') {
5759 char *endptr;
5761 level = jim_strtol(str + 1, &endptr);
5762 if (str[1] == '\0' || endptr[0] != '\0') {
5763 level = -1;
5766 else {
5767 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0) {
5768 level = -1;
5770 else {
5771 /* Convert from a relative to an absolute level */
5772 level = interp->framePtr->level - level;
5776 else {
5777 str = "1"; /* Needed to format the error message. */
5778 level = interp->framePtr->level - 1;
5781 if (level == 0) {
5782 return interp->topFramePtr;
5784 if (level > 0) {
5785 /* Lookup */
5786 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5787 if (framePtr->level == level) {
5788 return framePtr;
5793 Jim_SetResultFormatted(interp, "bad level \"%s\"", str);
5794 return NULL;
5797 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
5798 * as a relative integer like in the [info level ?level?] command.
5800 static Jim_CallFrame *JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5802 long level;
5803 Jim_CallFrame *framePtr;
5805 if (Jim_GetLong(interp, levelObjPtr, &level) == JIM_OK) {
5806 if (level <= 0) {
5807 /* Convert from a relative to an absolute level */
5808 level = interp->framePtr->level + level;
5811 if (level == 0) {
5812 return interp->topFramePtr;
5815 /* Lookup */
5816 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5817 if (framePtr->level == level) {
5818 return framePtr;
5823 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
5824 return NULL;
5827 static void JimResetStackTrace(Jim_Interp *interp)
5829 Jim_DecrRefCount(interp, interp->stackTrace);
5830 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
5831 Jim_IncrRefCount(interp->stackTrace);
5834 static void JimSetStackTrace(Jim_Interp *interp, Jim_Obj *stackTraceObj)
5836 int len;
5838 /* Increment reference first in case these are the same object */
5839 Jim_IncrRefCount(stackTraceObj);
5840 Jim_DecrRefCount(interp, interp->stackTrace);
5841 interp->stackTrace = stackTraceObj;
5842 interp->errorFlag = 1;
5844 /* This is a bit ugly.
5845 * If the filename of the last entry of the stack trace is empty,
5846 * the next stack level should be added.
5848 len = Jim_ListLength(interp, interp->stackTrace);
5849 if (len >= 3) {
5850 if (Jim_Length(Jim_ListGetIndex(interp, interp->stackTrace, len - 2)) == 0) {
5851 interp->addStackTrace = 1;
5856 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
5857 Jim_Obj *fileNameObj, int linenr)
5859 if (strcmp(procname, "unknown") == 0) {
5860 procname = "";
5862 if (!*procname && !Jim_Length(fileNameObj)) {
5863 /* No useful info here */
5864 return;
5867 if (Jim_IsShared(interp->stackTrace)) {
5868 Jim_DecrRefCount(interp, interp->stackTrace);
5869 interp->stackTrace = Jim_DuplicateObj(interp, interp->stackTrace);
5870 Jim_IncrRefCount(interp->stackTrace);
5873 /* If we have no procname but the previous element did, merge with that frame */
5874 if (!*procname && Jim_Length(fileNameObj)) {
5875 /* Just a filename. Check the previous entry */
5876 int len = Jim_ListLength(interp, interp->stackTrace);
5878 if (len >= 3) {
5879 Jim_Obj *objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 3);
5880 if (Jim_Length(objPtr)) {
5881 /* Yes, the previous level had procname */
5882 objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 2);
5883 if (Jim_Length(objPtr) == 0) {
5884 /* But no filename, so merge the new info with that frame */
5885 ListSetIndex(interp, interp->stackTrace, len - 2, fileNameObj, 0);
5886 ListSetIndex(interp, interp->stackTrace, len - 1, Jim_NewIntObj(interp, linenr), 0);
5887 return;
5893 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewStringObj(interp, procname, -1));
5894 Jim_ListAppendElement(interp, interp->stackTrace, fileNameObj);
5895 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewIntObj(interp, linenr));
5898 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc * delProc,
5899 void *data)
5901 AssocDataValue *assocEntryPtr = (AssocDataValue *) Jim_Alloc(sizeof(AssocDataValue));
5903 assocEntryPtr->delProc = delProc;
5904 assocEntryPtr->data = data;
5905 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
5908 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
5910 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
5912 if (entryPtr != NULL) {
5913 AssocDataValue *assocEntryPtr = Jim_GetHashEntryVal(entryPtr);
5914 return assocEntryPtr->data;
5916 return NULL;
5919 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
5921 return Jim_DeleteHashEntry(&interp->assocData, key);
5924 int Jim_GetExitCode(Jim_Interp *interp)
5926 return interp->exitCode;
5929 /* -----------------------------------------------------------------------------
5930 * Integer object
5931 * ---------------------------------------------------------------------------*/
5932 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
5933 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
5935 static const Jim_ObjType intObjType = {
5936 "int",
5937 NULL,
5938 NULL,
5939 UpdateStringOfInt,
5940 JIM_TYPE_NONE,
5943 /* A coerced double is closer to an int than a double.
5944 * It is an int value temporarily masquerading as a double value.
5945 * i.e. it has the same string value as an int and Jim_GetWide()
5946 * succeeds, but also Jim_GetDouble() returns the value directly.
5948 static const Jim_ObjType coercedDoubleObjType = {
5949 "coerced-double",
5950 NULL,
5951 NULL,
5952 UpdateStringOfInt,
5953 JIM_TYPE_NONE,
5957 static void UpdateStringOfInt(struct Jim_Obj *objPtr)
5959 char buf[JIM_INTEGER_SPACE + 1];
5960 jim_wide wideValue = JimWideValue(objPtr);
5961 int pos = 0;
5963 if (wideValue == 0) {
5964 buf[pos++] = '0';
5966 else {
5967 char tmp[JIM_INTEGER_SPACE];
5968 int num = 0;
5969 int i;
5971 if (wideValue < 0) {
5972 buf[pos++] = '-';
5973 i = wideValue % 10;
5974 /* C89 is implementation defined as to whether (-106 % 10) is -6 or 4,
5975 * whereas C99 is always -6
5976 * coverity[dead_error_line]
5978 tmp[num++] = (i > 0) ? (10 - i) : -i;
5979 wideValue /= -10;
5982 while (wideValue) {
5983 tmp[num++] = wideValue % 10;
5984 wideValue /= 10;
5987 for (i = 0; i < num; i++) {
5988 buf[pos++] = '0' + tmp[num - i - 1];
5991 buf[pos] = 0;
5993 JimSetStringBytes(objPtr, buf);
5996 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
5998 jim_wide wideValue;
5999 const char *str;
6001 if (objPtr->typePtr == &coercedDoubleObjType) {
6002 /* Simple switch */
6003 objPtr->typePtr = &intObjType;
6004 return JIM_OK;
6007 /* Get the string representation */
6008 str = Jim_String(objPtr);
6009 /* Try to convert into a jim_wide */
6010 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
6011 if (flags & JIM_ERRMSG) {
6012 Jim_SetResultFormatted(interp, "expected integer but got \"%#s\"", objPtr);
6014 return JIM_ERR;
6016 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) && errno == ERANGE) {
6017 Jim_SetResultString(interp, "Integer value too big to be represented", -1);
6018 return JIM_ERR;
6020 /* Free the old internal repr and set the new one. */
6021 Jim_FreeIntRep(interp, objPtr);
6022 objPtr->typePtr = &intObjType;
6023 objPtr->internalRep.wideValue = wideValue;
6024 return JIM_OK;
6027 #ifdef JIM_OPTIMIZATION
6028 static int JimIsWide(Jim_Obj *objPtr)
6030 return objPtr->typePtr == &intObjType;
6032 #endif
6034 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
6036 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
6037 return JIM_ERR;
6038 *widePtr = JimWideValue(objPtr);
6039 return JIM_OK;
6042 /* Get a wide but does not set an error if the format is bad. */
6043 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
6045 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
6046 return JIM_ERR;
6047 *widePtr = JimWideValue(objPtr);
6048 return JIM_OK;
6051 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
6053 jim_wide wideValue;
6054 int retval;
6056 retval = Jim_GetWide(interp, objPtr, &wideValue);
6057 if (retval == JIM_OK) {
6058 *longPtr = (long)wideValue;
6059 return JIM_OK;
6061 return JIM_ERR;
6064 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
6066 Jim_Obj *objPtr;
6068 objPtr = Jim_NewObj(interp);
6069 objPtr->typePtr = &intObjType;
6070 objPtr->bytes = NULL;
6071 objPtr->internalRep.wideValue = wideValue;
6072 return objPtr;
6075 /* -----------------------------------------------------------------------------
6076 * Double object
6077 * ---------------------------------------------------------------------------*/
6078 #define JIM_DOUBLE_SPACE 30
6080 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
6081 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
6083 static const Jim_ObjType doubleObjType = {
6084 "double",
6085 NULL,
6086 NULL,
6087 UpdateStringOfDouble,
6088 JIM_TYPE_NONE,
6091 #ifndef HAVE_ISNAN
6092 #undef isnan
6093 #define isnan(X) ((X) != (X))
6094 #endif
6095 #ifndef HAVE_ISINF
6096 #undef isinf
6097 #define isinf(X) (1.0 / (X) == 0.0)
6098 #endif
6100 static void UpdateStringOfDouble(struct Jim_Obj *objPtr)
6102 double value = objPtr->internalRep.doubleValue;
6104 if (isnan(value)) {
6105 JimSetStringBytes(objPtr, "NaN");
6106 return;
6108 if (isinf(value)) {
6109 if (value < 0) {
6110 JimSetStringBytes(objPtr, "-Inf");
6112 else {
6113 JimSetStringBytes(objPtr, "Inf");
6115 return;
6118 char buf[JIM_DOUBLE_SPACE + 1];
6119 int i;
6120 int len = sprintf(buf, "%.12g", value);
6122 /* Add a final ".0" if necessary */
6123 for (i = 0; i < len; i++) {
6124 if (buf[i] == '.' || buf[i] == 'e') {
6125 #if defined(JIM_SPRINTF_DOUBLE_NEEDS_FIX)
6126 /* If 'buf' ends in e-0nn or e+0nn, remove
6127 * the 0 after the + or - and reduce the length by 1
6129 char *e = strchr(buf, 'e');
6130 if (e && (e[1] == '-' || e[1] == '+') && e[2] == '0') {
6131 /* Move it up */
6132 e += 2;
6133 memmove(e, e + 1, len - (e - buf));
6135 #endif
6136 break;
6139 if (buf[i] == '\0') {
6140 buf[i++] = '.';
6141 buf[i++] = '0';
6142 buf[i] = '\0';
6144 JimSetStringBytes(objPtr, buf);
6148 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6150 double doubleValue;
6151 jim_wide wideValue;
6152 const char *str;
6154 #ifdef HAVE_LONG_LONG
6155 /* Assume a 53 bit mantissa */
6156 #define MIN_INT_IN_DOUBLE -(1LL << 53)
6157 #define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1)
6159 if (objPtr->typePtr == &intObjType
6160 && JimWideValue(objPtr) >= MIN_INT_IN_DOUBLE
6161 && JimWideValue(objPtr) <= MAX_INT_IN_DOUBLE) {
6163 /* Direct conversion to coerced double */
6164 objPtr->typePtr = &coercedDoubleObjType;
6165 return JIM_OK;
6167 #endif
6168 /* Preserve the string representation.
6169 * Needed so we can convert back to int without loss
6171 str = Jim_String(objPtr);
6173 if (Jim_StringToWide(str, &wideValue, 10) == JIM_OK) {
6174 /* Managed to convert to an int, so we can use this as a cooerced double */
6175 Jim_FreeIntRep(interp, objPtr);
6176 objPtr->typePtr = &coercedDoubleObjType;
6177 objPtr->internalRep.wideValue = wideValue;
6178 return JIM_OK;
6180 else {
6181 /* Try to convert into a double */
6182 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
6183 Jim_SetResultFormatted(interp, "expected floating-point number but got \"%#s\"", objPtr);
6184 return JIM_ERR;
6186 /* Free the old internal repr and set the new one. */
6187 Jim_FreeIntRep(interp, objPtr);
6189 objPtr->typePtr = &doubleObjType;
6190 objPtr->internalRep.doubleValue = doubleValue;
6191 return JIM_OK;
6194 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
6196 if (objPtr->typePtr == &coercedDoubleObjType) {
6197 *doublePtr = JimWideValue(objPtr);
6198 return JIM_OK;
6200 if (objPtr->typePtr != &doubleObjType && SetDoubleFromAny(interp, objPtr) == JIM_ERR)
6201 return JIM_ERR;
6203 if (objPtr->typePtr == &coercedDoubleObjType) {
6204 *doublePtr = JimWideValue(objPtr);
6206 else {
6207 *doublePtr = objPtr->internalRep.doubleValue;
6209 return JIM_OK;
6212 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
6214 Jim_Obj *objPtr;
6216 objPtr = Jim_NewObj(interp);
6217 objPtr->typePtr = &doubleObjType;
6218 objPtr->bytes = NULL;
6219 objPtr->internalRep.doubleValue = doubleValue;
6220 return objPtr;
6223 /* -----------------------------------------------------------------------------
6224 * Boolean conversion
6225 * ---------------------------------------------------------------------------*/
6226 static int SetBooleanFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
6228 int Jim_GetBoolean(Jim_Interp *interp, Jim_Obj *objPtr, int * booleanPtr)
6230 if (objPtr->typePtr != &intObjType && SetBooleanFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
6231 return JIM_ERR;
6232 *booleanPtr = (int) JimWideValue(objPtr);
6233 return JIM_OK;
6236 static int SetBooleanFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
6238 static const char * const falses[] = {
6239 "0", "false", "no", "off", NULL
6241 static const char * const trues[] = {
6242 "1", "true", "yes", "on", NULL
6245 int boolean;
6247 int index;
6248 if (Jim_GetEnum(interp, objPtr, falses, &index, NULL, 0) == JIM_OK) {
6249 boolean = 0;
6250 } else if (Jim_GetEnum(interp, objPtr, trues, &index, NULL, 0) == JIM_OK) {
6251 boolean = 1;
6252 } else {
6253 if (flags & JIM_ERRMSG) {
6254 Jim_SetResultFormatted(interp, "expected boolean but got \"%#s\"", objPtr);
6256 return JIM_ERR;
6259 /* Free the old internal repr and set the new one. */
6260 Jim_FreeIntRep(interp, objPtr);
6261 objPtr->typePtr = &intObjType;
6262 objPtr->internalRep.wideValue = boolean;
6263 return JIM_OK;
6266 /* -----------------------------------------------------------------------------
6267 * List object
6268 * ---------------------------------------------------------------------------*/
6269 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec);
6270 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
6271 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6272 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6273 static void UpdateStringOfList(struct Jim_Obj *objPtr);
6274 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6276 /* Note that while the elements of the list may contain references,
6277 * the list object itself can't. This basically means that the
6278 * list object string representation as a whole can't contain references
6279 * that are not presents in the single elements. */
6280 static const Jim_ObjType listObjType = {
6281 "list",
6282 FreeListInternalRep,
6283 DupListInternalRep,
6284 UpdateStringOfList,
6285 JIM_TYPE_NONE,
6288 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6290 int i;
6292 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
6293 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
6295 Jim_Free(objPtr->internalRep.listValue.ele);
6298 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6300 int i;
6302 JIM_NOTUSED(interp);
6304 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
6305 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
6306 dupPtr->internalRep.listValue.ele =
6307 Jim_Alloc(sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.maxLen);
6308 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
6309 sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.len);
6310 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
6311 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
6313 dupPtr->typePtr = &listObjType;
6316 /* The following function checks if a given string can be encoded
6317 * into a list element without any kind of quoting, surrounded by braces,
6318 * or using escapes to quote. */
6319 #define JIM_ELESTR_SIMPLE 0
6320 #define JIM_ELESTR_BRACE 1
6321 #define JIM_ELESTR_QUOTE 2
6322 static unsigned char ListElementQuotingType(const char *s, int len)
6324 int i, level, blevel, trySimple = 1;
6326 /* Try with the SIMPLE case */
6327 if (len == 0)
6328 return JIM_ELESTR_BRACE;
6329 if (s[0] == '"' || s[0] == '{') {
6330 trySimple = 0;
6331 goto testbrace;
6333 for (i = 0; i < len; i++) {
6334 switch (s[i]) {
6335 case ' ':
6336 case '$':
6337 case '"':
6338 case '[':
6339 case ']':
6340 case ';':
6341 case '\\':
6342 case '\r':
6343 case '\n':
6344 case '\t':
6345 case '\f':
6346 case '\v':
6347 trySimple = 0;
6348 /* fall through */
6349 case '{':
6350 case '}':
6351 goto testbrace;
6354 return JIM_ELESTR_SIMPLE;
6356 testbrace:
6357 /* Test if it's possible to do with braces */
6358 if (s[len - 1] == '\\')
6359 return JIM_ELESTR_QUOTE;
6360 level = 0;
6361 blevel = 0;
6362 for (i = 0; i < len; i++) {
6363 switch (s[i]) {
6364 case '{':
6365 level++;
6366 break;
6367 case '}':
6368 level--;
6369 if (level < 0)
6370 return JIM_ELESTR_QUOTE;
6371 break;
6372 case '[':
6373 blevel++;
6374 break;
6375 case ']':
6376 blevel--;
6377 break;
6378 case '\\':
6379 if (s[i + 1] == '\n')
6380 return JIM_ELESTR_QUOTE;
6381 else if (s[i + 1] != '\0')
6382 i++;
6383 break;
6386 if (blevel < 0) {
6387 return JIM_ELESTR_QUOTE;
6390 if (level == 0) {
6391 if (!trySimple)
6392 return JIM_ELESTR_BRACE;
6393 for (i = 0; i < len; i++) {
6394 switch (s[i]) {
6395 case ' ':
6396 case '$':
6397 case '"':
6398 case '[':
6399 case ']':
6400 case ';':
6401 case '\\':
6402 case '\r':
6403 case '\n':
6404 case '\t':
6405 case '\f':
6406 case '\v':
6407 return JIM_ELESTR_BRACE;
6408 break;
6411 return JIM_ELESTR_SIMPLE;
6413 return JIM_ELESTR_QUOTE;
6416 /* Backslashes-escapes the null-terminated string 's' into the buffer at 'q'
6417 * The buffer must be at least strlen(s) * 2 + 1 bytes long for the worst-case
6418 * scenario.
6419 * Returns the length of the result.
6421 static int BackslashQuoteString(const char *s, int len, char *q)
6423 char *p = q;
6425 while (len--) {
6426 switch (*s) {
6427 case ' ':
6428 case '$':
6429 case '"':
6430 case '[':
6431 case ']':
6432 case '{':
6433 case '}':
6434 case ';':
6435 case '\\':
6436 *p++ = '\\';
6437 *p++ = *s++;
6438 break;
6439 case '\n':
6440 *p++ = '\\';
6441 *p++ = 'n';
6442 s++;
6443 break;
6444 case '\r':
6445 *p++ = '\\';
6446 *p++ = 'r';
6447 s++;
6448 break;
6449 case '\t':
6450 *p++ = '\\';
6451 *p++ = 't';
6452 s++;
6453 break;
6454 case '\f':
6455 *p++ = '\\';
6456 *p++ = 'f';
6457 s++;
6458 break;
6459 case '\v':
6460 *p++ = '\\';
6461 *p++ = 'v';
6462 s++;
6463 break;
6464 default:
6465 *p++ = *s++;
6466 break;
6469 *p = '\0';
6471 return p - q;
6474 static void JimMakeListStringRep(Jim_Obj *objPtr, Jim_Obj **objv, int objc)
6476 #define STATIC_QUOTING_LEN 32
6477 int i, bufLen, realLength;
6478 const char *strRep;
6479 char *p;
6480 unsigned char *quotingType, staticQuoting[STATIC_QUOTING_LEN];
6482 /* Estimate the space needed. */
6483 if (objc > STATIC_QUOTING_LEN) {
6484 quotingType = Jim_Alloc(objc);
6486 else {
6487 quotingType = staticQuoting;
6489 bufLen = 0;
6490 for (i = 0; i < objc; i++) {
6491 int len;
6493 strRep = Jim_GetString(objv[i], &len);
6494 quotingType[i] = ListElementQuotingType(strRep, len);
6495 switch (quotingType[i]) {
6496 case JIM_ELESTR_SIMPLE:
6497 if (i != 0 || strRep[0] != '#') {
6498 bufLen += len;
6499 break;
6501 /* Special case '#' on first element needs braces */
6502 quotingType[i] = JIM_ELESTR_BRACE;
6503 /* fall through */
6504 case JIM_ELESTR_BRACE:
6505 bufLen += len + 2;
6506 break;
6507 case JIM_ELESTR_QUOTE:
6508 bufLen += len * 2;
6509 break;
6511 bufLen++; /* elements separator. */
6513 bufLen++;
6515 /* Generate the string rep. */
6516 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
6517 realLength = 0;
6518 for (i = 0; i < objc; i++) {
6519 int len, qlen;
6521 strRep = Jim_GetString(objv[i], &len);
6523 switch (quotingType[i]) {
6524 case JIM_ELESTR_SIMPLE:
6525 memcpy(p, strRep, len);
6526 p += len;
6527 realLength += len;
6528 break;
6529 case JIM_ELESTR_BRACE:
6530 *p++ = '{';
6531 memcpy(p, strRep, len);
6532 p += len;
6533 *p++ = '}';
6534 realLength += len + 2;
6535 break;
6536 case JIM_ELESTR_QUOTE:
6537 if (i == 0 && strRep[0] == '#') {
6538 *p++ = '\\';
6539 realLength++;
6541 qlen = BackslashQuoteString(strRep, len, p);
6542 p += qlen;
6543 realLength += qlen;
6544 break;
6546 /* Add a separating space */
6547 if (i + 1 != objc) {
6548 *p++ = ' ';
6549 realLength++;
6552 *p = '\0'; /* nul term. */
6553 objPtr->length = realLength;
6555 if (quotingType != staticQuoting) {
6556 Jim_Free(quotingType);
6560 static void UpdateStringOfList(struct Jim_Obj *objPtr)
6562 JimMakeListStringRep(objPtr, objPtr->internalRep.listValue.ele, objPtr->internalRep.listValue.len);
6565 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6567 struct JimParserCtx parser;
6568 const char *str;
6569 int strLen;
6570 Jim_Obj *fileNameObj;
6571 int linenr;
6573 if (objPtr->typePtr == &listObjType) {
6574 return JIM_OK;
6577 /* Optimise dict -> list for object with no string rep. Note that this may only save a little time, but
6578 * it also preserves any source location of the dict elements
6579 * which can be very useful
6581 if (Jim_IsDict(objPtr) && objPtr->bytes == NULL) {
6582 Jim_Obj **listObjPtrPtr;
6583 int len;
6584 int i;
6586 listObjPtrPtr = JimDictPairs(objPtr, &len);
6587 for (i = 0; i < len; i++) {
6588 Jim_IncrRefCount(listObjPtrPtr[i]);
6591 /* Now just switch the internal rep */
6592 Jim_FreeIntRep(interp, objPtr);
6593 objPtr->typePtr = &listObjType;
6594 objPtr->internalRep.listValue.len = len;
6595 objPtr->internalRep.listValue.maxLen = len;
6596 objPtr->internalRep.listValue.ele = listObjPtrPtr;
6598 return JIM_OK;
6601 /* Try to preserve information about filename / line number */
6602 if (objPtr->typePtr == &sourceObjType) {
6603 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
6604 linenr = objPtr->internalRep.sourceValue.lineNumber;
6606 else {
6607 fileNameObj = interp->emptyObj;
6608 linenr = 1;
6610 Jim_IncrRefCount(fileNameObj);
6612 /* Get the string representation */
6613 str = Jim_GetString(objPtr, &strLen);
6615 /* Free the old internal repr just now and initialize the
6616 * new one just now. The string->list conversion can't fail. */
6617 Jim_FreeIntRep(interp, objPtr);
6618 objPtr->typePtr = &listObjType;
6619 objPtr->internalRep.listValue.len = 0;
6620 objPtr->internalRep.listValue.maxLen = 0;
6621 objPtr->internalRep.listValue.ele = NULL;
6623 /* Convert into a list */
6624 if (strLen) {
6625 JimParserInit(&parser, str, strLen, linenr);
6626 while (!parser.eof) {
6627 Jim_Obj *elementPtr;
6629 JimParseList(&parser);
6630 if (parser.tt != JIM_TT_STR && parser.tt != JIM_TT_ESC)
6631 continue;
6632 elementPtr = JimParserGetTokenObj(interp, &parser);
6633 JimSetSourceInfo(interp, elementPtr, fileNameObj, parser.tline);
6634 ListAppendElement(objPtr, elementPtr);
6637 Jim_DecrRefCount(interp, fileNameObj);
6638 return JIM_OK;
6641 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
6643 Jim_Obj *objPtr;
6645 objPtr = Jim_NewObj(interp);
6646 objPtr->typePtr = &listObjType;
6647 objPtr->bytes = NULL;
6648 objPtr->internalRep.listValue.ele = NULL;
6649 objPtr->internalRep.listValue.len = 0;
6650 objPtr->internalRep.listValue.maxLen = 0;
6652 if (len) {
6653 ListInsertElements(objPtr, 0, len, elements);
6656 return objPtr;
6659 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
6660 * length of the vector. Note that the user of this function should make
6661 * sure that the list object can't shimmer while the vector returned
6662 * is in use, this vector is the one stored inside the internal representation
6663 * of the list object. This function is not exported, extensions should
6664 * always access to the List object elements using Jim_ListIndex(). */
6665 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *listLen,
6666 Jim_Obj ***listVec)
6668 *listLen = Jim_ListLength(interp, listObj);
6669 *listVec = listObj->internalRep.listValue.ele;
6672 /* Sorting uses ints, but commands may return wide */
6673 static int JimSign(jim_wide w)
6675 if (w == 0) {
6676 return 0;
6678 else if (w < 0) {
6679 return -1;
6681 return 1;
6684 /* ListSortElements type values */
6685 struct lsort_info {
6686 jmp_buf jmpbuf;
6687 Jim_Obj *command;
6688 Jim_Interp *interp;
6689 enum {
6690 JIM_LSORT_ASCII,
6691 JIM_LSORT_NOCASE,
6692 JIM_LSORT_INTEGER,
6693 JIM_LSORT_REAL,
6694 JIM_LSORT_COMMAND
6695 } type;
6696 int order;
6697 int index;
6698 int indexed;
6699 int unique;
6700 int (*subfn)(Jim_Obj **, Jim_Obj **);
6703 static struct lsort_info *sort_info;
6705 static int ListSortIndexHelper(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6707 Jim_Obj *lObj, *rObj;
6709 if (Jim_ListIndex(sort_info->interp, *lhsObj, sort_info->index, &lObj, JIM_ERRMSG) != JIM_OK ||
6710 Jim_ListIndex(sort_info->interp, *rhsObj, sort_info->index, &rObj, JIM_ERRMSG) != JIM_OK) {
6711 longjmp(sort_info->jmpbuf, JIM_ERR);
6713 return sort_info->subfn(&lObj, &rObj);
6716 /* Sort the internal rep of a list. */
6717 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6719 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 0) * sort_info->order;
6722 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6724 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 1) * sort_info->order;
6727 static int ListSortInteger(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6729 jim_wide lhs = 0, rhs = 0;
6731 if (Jim_GetWide(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6732 Jim_GetWide(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6733 longjmp(sort_info->jmpbuf, JIM_ERR);
6736 return JimSign(lhs - rhs) * sort_info->order;
6739 static int ListSortReal(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6741 double lhs = 0, rhs = 0;
6743 if (Jim_GetDouble(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6744 Jim_GetDouble(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6745 longjmp(sort_info->jmpbuf, JIM_ERR);
6747 if (lhs == rhs) {
6748 return 0;
6750 if (lhs > rhs) {
6751 return sort_info->order;
6753 return -sort_info->order;
6756 static int ListSortCommand(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6758 Jim_Obj *compare_script;
6759 int rc;
6761 jim_wide ret = 0;
6763 /* This must be a valid list */
6764 compare_script = Jim_DuplicateObj(sort_info->interp, sort_info->command);
6765 Jim_ListAppendElement(sort_info->interp, compare_script, *lhsObj);
6766 Jim_ListAppendElement(sort_info->interp, compare_script, *rhsObj);
6768 rc = Jim_EvalObj(sort_info->interp, compare_script);
6770 if (rc != JIM_OK || Jim_GetWide(sort_info->interp, Jim_GetResult(sort_info->interp), &ret) != JIM_OK) {
6771 longjmp(sort_info->jmpbuf, rc);
6774 return JimSign(ret) * sort_info->order;
6777 /* Remove duplicate elements from the (sorted) list in-place, according to the
6778 * comparison function, comp.
6780 * Note that the last unique value is kept, not the first
6782 static void ListRemoveDuplicates(Jim_Obj *listObjPtr, int (*comp)(Jim_Obj **lhs, Jim_Obj **rhs))
6784 int src;
6785 int dst = 0;
6786 Jim_Obj **ele = listObjPtr->internalRep.listValue.ele;
6788 for (src = 1; src < listObjPtr->internalRep.listValue.len; src++) {
6789 if (comp(&ele[dst], &ele[src]) == 0) {
6790 /* Match, so replace the dest with the current source */
6791 Jim_DecrRefCount(sort_info->interp, ele[dst]);
6793 else {
6794 /* No match, so keep the current source and move to the next destination */
6795 dst++;
6797 ele[dst] = ele[src];
6800 /* At end of list, keep the final element unless all elements were kept */
6801 dst++;
6802 if (dst < listObjPtr->internalRep.listValue.len) {
6803 ele[dst] = ele[src];
6806 /* Set the new length */
6807 listObjPtr->internalRep.listValue.len = dst;
6810 /* Sort a list *in place*. MUST be called with a non-shared list. */
6811 static int ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, struct lsort_info *info)
6813 struct lsort_info *prev_info;
6815 typedef int (qsort_comparator) (const void *, const void *);
6816 int (*fn) (Jim_Obj **, Jim_Obj **);
6817 Jim_Obj **vector;
6818 int len;
6819 int rc;
6821 JimPanic((Jim_IsShared(listObjPtr), "ListSortElements called with shared object"));
6822 SetListFromAny(interp, listObjPtr);
6824 /* Allow lsort to be called reentrantly */
6825 prev_info = sort_info;
6826 sort_info = info;
6828 vector = listObjPtr->internalRep.listValue.ele;
6829 len = listObjPtr->internalRep.listValue.len;
6830 switch (info->type) {
6831 case JIM_LSORT_ASCII:
6832 fn = ListSortString;
6833 break;
6834 case JIM_LSORT_NOCASE:
6835 fn = ListSortStringNoCase;
6836 break;
6837 case JIM_LSORT_INTEGER:
6838 fn = ListSortInteger;
6839 break;
6840 case JIM_LSORT_REAL:
6841 fn = ListSortReal;
6842 break;
6843 case JIM_LSORT_COMMAND:
6844 fn = ListSortCommand;
6845 break;
6846 default:
6847 fn = NULL; /* avoid warning */
6848 JimPanic((1, "ListSort called with invalid sort type"));
6849 return -1; /* Should not be run but keeps static analysers happy */
6852 if (info->indexed) {
6853 /* Need to interpose a "list index" function */
6854 info->subfn = fn;
6855 fn = ListSortIndexHelper;
6858 if ((rc = setjmp(info->jmpbuf)) == 0) {
6859 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *) fn);
6861 if (info->unique && len > 1) {
6862 ListRemoveDuplicates(listObjPtr, fn);
6865 Jim_InvalidateStringRep(listObjPtr);
6867 sort_info = prev_info;
6869 return rc;
6872 /* This is the low-level function to insert elements into a list.
6873 * The higher-level Jim_ListInsertElements() performs shared object
6874 * check and invalidates the string repr. This version is used
6875 * in the internals of the List Object and is not exported.
6877 * NOTE: this function can be called only against objects
6878 * with internal type of List.
6880 * An insertion point (idx) of -1 means end-of-list.
6882 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec)
6884 int currentLen = listPtr->internalRep.listValue.len;
6885 int requiredLen = currentLen + elemc;
6886 int i;
6887 Jim_Obj **point;
6889 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
6890 if (requiredLen < 2) {
6891 /* Don't do allocations of under 4 pointers. */
6892 requiredLen = 4;
6894 else {
6895 requiredLen *= 2;
6898 listPtr->internalRep.listValue.ele = Jim_Realloc(listPtr->internalRep.listValue.ele,
6899 sizeof(Jim_Obj *) * requiredLen);
6901 listPtr->internalRep.listValue.maxLen = requiredLen;
6903 if (idx < 0) {
6904 idx = currentLen;
6906 point = listPtr->internalRep.listValue.ele + idx;
6907 memmove(point + elemc, point, (currentLen - idx) * sizeof(Jim_Obj *));
6908 for (i = 0; i < elemc; ++i) {
6909 point[i] = elemVec[i];
6910 Jim_IncrRefCount(point[i]);
6912 listPtr->internalRep.listValue.len += elemc;
6915 /* Convenience call to ListInsertElements() to append a single element.
6917 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
6919 ListInsertElements(listPtr, -1, 1, &objPtr);
6922 /* Appends every element of appendListPtr into listPtr.
6923 * Both have to be of the list type.
6924 * Convenience call to ListInsertElements()
6926 static void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6928 ListInsertElements(listPtr, -1,
6929 appendListPtr->internalRep.listValue.len, appendListPtr->internalRep.listValue.ele);
6932 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
6934 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendElement called with shared object"));
6935 SetListFromAny(interp, listPtr);
6936 Jim_InvalidateStringRep(listPtr);
6937 ListAppendElement(listPtr, objPtr);
6940 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6942 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendList called with shared object"));
6943 SetListFromAny(interp, listPtr);
6944 SetListFromAny(interp, appendListPtr);
6945 Jim_InvalidateStringRep(listPtr);
6946 ListAppendList(listPtr, appendListPtr);
6949 int Jim_ListLength(Jim_Interp *interp, Jim_Obj *objPtr)
6951 SetListFromAny(interp, objPtr);
6952 return objPtr->internalRep.listValue.len;
6955 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6956 int objc, Jim_Obj *const *objVec)
6958 JimPanic((Jim_IsShared(listPtr), "Jim_ListInsertElement called with shared object"));
6959 SetListFromAny(interp, listPtr);
6960 if (idx >= 0 && idx > listPtr->internalRep.listValue.len)
6961 idx = listPtr->internalRep.listValue.len;
6962 else if (idx < 0)
6963 idx = 0;
6964 Jim_InvalidateStringRep(listPtr);
6965 ListInsertElements(listPtr, idx, objc, objVec);
6968 Jim_Obj *Jim_ListGetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx)
6970 SetListFromAny(interp, listPtr);
6971 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6972 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6973 return NULL;
6975 if (idx < 0)
6976 idx = listPtr->internalRep.listValue.len + idx;
6977 return listPtr->internalRep.listValue.ele[idx];
6980 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx, Jim_Obj **objPtrPtr, int flags)
6982 *objPtrPtr = Jim_ListGetIndex(interp, listPtr, idx);
6983 if (*objPtrPtr == NULL) {
6984 if (flags & JIM_ERRMSG) {
6985 Jim_SetResultString(interp, "list index out of range", -1);
6987 return JIM_ERR;
6989 return JIM_OK;
6992 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6993 Jim_Obj *newObjPtr, int flags)
6995 SetListFromAny(interp, listPtr);
6996 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6997 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6998 if (flags & JIM_ERRMSG) {
6999 Jim_SetResultString(interp, "list index out of range", -1);
7001 return JIM_ERR;
7003 if (idx < 0)
7004 idx = listPtr->internalRep.listValue.len + idx;
7005 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[idx]);
7006 listPtr->internalRep.listValue.ele[idx] = newObjPtr;
7007 Jim_IncrRefCount(newObjPtr);
7008 return JIM_OK;
7011 /* Modify the list stored in the variable named 'varNamePtr'
7012 * setting the element specified by the 'indexc' indexes objects in 'indexv',
7013 * with the new element 'newObjptr'. (implements the [lset] command) */
7014 int Jim_ListSetIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
7015 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
7017 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
7018 int shared, i, idx;
7020 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG | JIM_UNSHARED);
7021 if (objPtr == NULL)
7022 return JIM_ERR;
7023 if ((shared = Jim_IsShared(objPtr)))
7024 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
7025 for (i = 0; i < indexc - 1; i++) {
7026 listObjPtr = objPtr;
7027 if (Jim_GetIndex(interp, indexv[i], &idx) != JIM_OK)
7028 goto err;
7029 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_ERRMSG) != JIM_OK) {
7030 goto err;
7032 if (Jim_IsShared(objPtr)) {
7033 objPtr = Jim_DuplicateObj(interp, objPtr);
7034 ListSetIndex(interp, listObjPtr, idx, objPtr, JIM_NONE);
7036 Jim_InvalidateStringRep(listObjPtr);
7038 if (Jim_GetIndex(interp, indexv[indexc - 1], &idx) != JIM_OK)
7039 goto err;
7040 if (ListSetIndex(interp, objPtr, idx, newObjPtr, JIM_ERRMSG) == JIM_ERR)
7041 goto err;
7042 Jim_InvalidateStringRep(objPtr);
7043 Jim_InvalidateStringRep(varObjPtr);
7044 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
7045 goto err;
7046 Jim_SetResult(interp, varObjPtr);
7047 return JIM_OK;
7048 err:
7049 if (shared) {
7050 Jim_FreeNewObj(interp, varObjPtr);
7052 return JIM_ERR;
7055 Jim_Obj *Jim_ListJoin(Jim_Interp *interp, Jim_Obj *listObjPtr, const char *joinStr, int joinStrLen)
7057 int i;
7058 int listLen = Jim_ListLength(interp, listObjPtr);
7059 Jim_Obj *resObjPtr = Jim_NewEmptyStringObj(interp);
7061 for (i = 0; i < listLen; ) {
7062 Jim_AppendObj(interp, resObjPtr, Jim_ListGetIndex(interp, listObjPtr, i));
7063 if (++i != listLen) {
7064 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
7067 return resObjPtr;
7070 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
7072 int i;
7074 /* If all the objects in objv are lists,
7075 * it's possible to return a list as result, that's the
7076 * concatenation of all the lists. */
7077 for (i = 0; i < objc; i++) {
7078 if (!Jim_IsList(objv[i]))
7079 break;
7081 if (i == objc) {
7082 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
7084 for (i = 0; i < objc; i++)
7085 ListAppendList(objPtr, objv[i]);
7086 return objPtr;
7088 else {
7089 /* Else... we have to glue strings together */
7090 int len = 0, objLen;
7091 char *bytes, *p;
7093 /* Compute the length */
7094 for (i = 0; i < objc; i++) {
7095 len += Jim_Length(objv[i]);
7097 if (objc)
7098 len += objc - 1;
7099 /* Create the string rep, and a string object holding it. */
7100 p = bytes = Jim_Alloc(len + 1);
7101 for (i = 0; i < objc; i++) {
7102 const char *s = Jim_GetString(objv[i], &objLen);
7104 /* Remove leading space */
7105 while (objLen && isspace(UCHAR(*s))) {
7106 s++;
7107 objLen--;
7108 len--;
7110 /* And trailing space */
7111 while (objLen && isspace(UCHAR(s[objLen - 1]))) {
7112 /* Handle trailing backslash-space case */
7113 if (objLen > 1 && s[objLen - 2] == '\\') {
7114 break;
7116 objLen--;
7117 len--;
7119 memcpy(p, s, objLen);
7120 p += objLen;
7121 if (i + 1 != objc) {
7122 if (objLen)
7123 *p++ = ' ';
7124 else {
7125 /* Drop the space calculated for this
7126 * element that is instead null. */
7127 len--;
7131 *p = '\0';
7132 return Jim_NewStringObjNoAlloc(interp, bytes, len);
7136 /* Returns a list composed of the elements in the specified range.
7137 * first and start are directly accepted as Jim_Objects and
7138 * processed for the end?-index? case. */
7139 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr,
7140 Jim_Obj *lastObjPtr)
7142 int first, last;
7143 int len, rangeLen;
7145 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
7146 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
7147 return NULL;
7148 len = Jim_ListLength(interp, listObjPtr); /* will convert into list */
7149 first = JimRelToAbsIndex(len, first);
7150 last = JimRelToAbsIndex(len, last);
7151 JimRelToAbsRange(len, &first, &last, &rangeLen);
7152 if (first == 0 && last == len) {
7153 return listObjPtr;
7155 return Jim_NewListObj(interp, listObjPtr->internalRep.listValue.ele + first, rangeLen);
7158 /* -----------------------------------------------------------------------------
7159 * Dict object
7160 * ---------------------------------------------------------------------------*/
7161 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
7162 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
7163 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
7164 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7166 /* Dict HashTable Type.
7168 * Keys and Values are Jim objects. */
7170 static const Jim_HashTableType JimDictHashTableType = {
7171 JimObjectHTHashFunction, /* hash function */
7172 JimObjectHTKeyValDup, /* key dup */
7173 JimObjectHTKeyValDup, /* val dup */
7174 JimObjectHTKeyCompare, /* key compare */
7175 JimObjectHTKeyValDestructor, /* key destructor */
7176 JimObjectHTKeyValDestructor /* val destructor */
7179 /* Note that while the elements of the dict may contain references,
7180 * the list object itself can't. This basically means that the
7181 * dict object string representation as a whole can't contain references
7182 * that are not presents in the single elements. */
7183 static const Jim_ObjType dictObjType = {
7184 "dict",
7185 FreeDictInternalRep,
7186 DupDictInternalRep,
7187 UpdateStringOfDict,
7188 JIM_TYPE_NONE,
7191 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
7193 JIM_NOTUSED(interp);
7195 Jim_FreeHashTable(objPtr->internalRep.ptr);
7196 Jim_Free(objPtr->internalRep.ptr);
7199 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
7201 Jim_HashTable *ht, *dupHt;
7202 Jim_HashTableIterator htiter;
7203 Jim_HashEntry *he;
7205 /* Create a new hash table */
7206 ht = srcPtr->internalRep.ptr;
7207 dupHt = Jim_Alloc(sizeof(*dupHt));
7208 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
7209 if (ht->size != 0)
7210 Jim_ExpandHashTable(dupHt, ht->size);
7211 /* Copy every element from the source to the dup hash table */
7212 JimInitHashTableIterator(ht, &htiter);
7213 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7214 Jim_AddHashEntry(dupHt, he->key, he->u.val);
7217 dupPtr->internalRep.ptr = dupHt;
7218 dupPtr->typePtr = &dictObjType;
7221 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len)
7223 Jim_HashTable *ht;
7224 Jim_HashTableIterator htiter;
7225 Jim_HashEntry *he;
7226 Jim_Obj **objv;
7227 int i;
7229 ht = dictPtr->internalRep.ptr;
7231 /* Turn the hash table into a flat vector of Jim_Objects. */
7232 objv = Jim_Alloc((ht->used * 2) * sizeof(Jim_Obj *));
7233 JimInitHashTableIterator(ht, &htiter);
7234 i = 0;
7235 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7236 objv[i++] = Jim_GetHashEntryKey(he);
7237 objv[i++] = Jim_GetHashEntryVal(he);
7239 *len = i;
7240 return objv;
7243 static void UpdateStringOfDict(struct Jim_Obj *objPtr)
7245 /* Turn the hash table into a flat vector of Jim_Objects. */
7246 int len;
7247 Jim_Obj **objv = JimDictPairs(objPtr, &len);
7249 /* And now generate the string rep as a list */
7250 JimMakeListStringRep(objPtr, objv, len);
7252 Jim_Free(objv);
7255 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
7257 int listlen;
7259 if (objPtr->typePtr == &dictObjType) {
7260 return JIM_OK;
7263 if (Jim_IsList(objPtr) && Jim_IsShared(objPtr)) {
7264 /* A shared list, so get the string representation now to avoid
7265 * changing the order in case of fast conversion to dict.
7267 Jim_String(objPtr);
7270 /* For simplicity, convert a non-list object to a list and then to a dict */
7271 listlen = Jim_ListLength(interp, objPtr);
7272 if (listlen % 2) {
7273 Jim_SetResultString(interp, "missing value to go with key", -1);
7274 return JIM_ERR;
7276 else {
7277 /* Converting from a list to a dict can't fail */
7278 Jim_HashTable *ht;
7279 int i;
7281 ht = Jim_Alloc(sizeof(*ht));
7282 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
7284 for (i = 0; i < listlen; i += 2) {
7285 Jim_Obj *keyObjPtr = Jim_ListGetIndex(interp, objPtr, i);
7286 Jim_Obj *valObjPtr = Jim_ListGetIndex(interp, objPtr, i + 1);
7288 Jim_ReplaceHashEntry(ht, keyObjPtr, valObjPtr);
7291 Jim_FreeIntRep(interp, objPtr);
7292 objPtr->typePtr = &dictObjType;
7293 objPtr->internalRep.ptr = ht;
7295 return JIM_OK;
7299 /* Dict object API */
7301 /* Add an element to a dict. objPtr must be of the "dict" type.
7302 * The higher-level exported function is Jim_DictAddElement().
7303 * If an element with the specified key already exists, the value
7304 * associated is replaced with the new one.
7306 * if valueObjPtr == NULL, the key is instead removed if it exists. */
7307 static int DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7308 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7310 Jim_HashTable *ht = objPtr->internalRep.ptr;
7312 if (valueObjPtr == NULL) { /* unset */
7313 return Jim_DeleteHashEntry(ht, keyObjPtr);
7315 Jim_ReplaceHashEntry(ht, keyObjPtr, valueObjPtr);
7316 return JIM_OK;
7319 /* Add an element, higher-level interface for DictAddElement().
7320 * If valueObjPtr == NULL, the key is removed if it exists. */
7321 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7322 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7324 JimPanic((Jim_IsShared(objPtr), "Jim_DictAddElement called with shared object"));
7325 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
7326 return JIM_ERR;
7328 Jim_InvalidateStringRep(objPtr);
7329 return DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
7332 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
7334 Jim_Obj *objPtr;
7335 int i;
7337 JimPanic((len % 2, "Jim_NewDictObj() 'len' argument must be even"));
7339 objPtr = Jim_NewObj(interp);
7340 objPtr->typePtr = &dictObjType;
7341 objPtr->bytes = NULL;
7342 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
7343 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
7344 for (i = 0; i < len; i += 2)
7345 DictAddElement(interp, objPtr, elements[i], elements[i + 1]);
7346 return objPtr;
7349 /* Return the value associated to the specified dict key
7350 * Returns JIM_OK if OK, JIM_ERR if entry not found or -1 if can't create dict value
7352 * Sets *objPtrPtr to non-NULL only upon success.
7354 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
7355 Jim_Obj **objPtrPtr, int flags)
7357 Jim_HashEntry *he;
7358 Jim_HashTable *ht;
7360 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7361 return -1;
7363 ht = dictPtr->internalRep.ptr;
7364 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
7365 if (flags & JIM_ERRMSG) {
7366 Jim_SetResultFormatted(interp, "key \"%#s\" not known in dictionary", keyPtr);
7368 return JIM_ERR;
7370 else {
7371 *objPtrPtr = Jim_GetHashEntryVal(he);
7372 return JIM_OK;
7376 /* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */
7377 int Jim_DictPairs(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj ***objPtrPtr, int *len)
7379 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7380 return JIM_ERR;
7382 *objPtrPtr = JimDictPairs(dictPtr, len);
7384 return JIM_OK;
7388 /* Return the value associated to the specified dict keys */
7389 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
7390 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
7392 int i;
7394 if (keyc == 0) {
7395 *objPtrPtr = dictPtr;
7396 return JIM_OK;
7399 for (i = 0; i < keyc; i++) {
7400 Jim_Obj *objPtr;
7402 int rc = Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags);
7403 if (rc != JIM_OK) {
7404 return rc;
7406 dictPtr = objPtr;
7408 *objPtrPtr = dictPtr;
7409 return JIM_OK;
7412 /* Modify the dict stored into the variable named 'varNamePtr'
7413 * setting the element specified by the 'keyc' keys objects in 'keyv',
7414 * with the new value of the element 'newObjPtr'.
7416 * If newObjPtr == NULL the operation is to remove the given key
7417 * from the dictionary.
7419 * If flags & JIM_ERRMSG, then failure to remove the key is considered an error
7420 * and JIM_ERR is returned. Otherwise it is ignored and JIM_OK is returned.
7422 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
7423 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr, int flags)
7425 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
7426 int shared, i;
7428 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, flags);
7429 if (objPtr == NULL) {
7430 if (newObjPtr == NULL && (flags & JIM_MUSTEXIST)) {
7431 /* Cannot remove a key from non existing var */
7432 return JIM_ERR;
7434 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
7435 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
7436 Jim_FreeNewObj(interp, varObjPtr);
7437 return JIM_ERR;
7440 if ((shared = Jim_IsShared(objPtr)))
7441 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
7442 for (i = 0; i < keyc; i++) {
7443 dictObjPtr = objPtr;
7445 /* Check if it's a valid dictionary */
7446 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK) {
7447 goto err;
7450 if (i == keyc - 1) {
7451 /* Last key: Note that error on unset with missing last key is OK */
7452 if (Jim_DictAddElement(interp, objPtr, keyv[keyc - 1], newObjPtr) != JIM_OK) {
7453 if (newObjPtr || (flags & JIM_MUSTEXIST)) {
7454 goto err;
7457 break;
7460 /* Check if the given key exists. */
7461 Jim_InvalidateStringRep(dictObjPtr);
7462 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
7463 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK) {
7464 /* This key exists at the current level.
7465 * Make sure it's not shared!. */
7466 if (Jim_IsShared(objPtr)) {
7467 objPtr = Jim_DuplicateObj(interp, objPtr);
7468 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7471 else {
7472 /* Key not found. If it's an [unset] operation
7473 * this is an error. Only the last key may not
7474 * exist. */
7475 if (newObjPtr == NULL) {
7476 goto err;
7478 /* Otherwise set an empty dictionary
7479 * as key's value. */
7480 objPtr = Jim_NewDictObj(interp, NULL, 0);
7481 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7484 /* XXX: Is this necessary? */
7485 Jim_InvalidateStringRep(objPtr);
7486 Jim_InvalidateStringRep(varObjPtr);
7487 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK) {
7488 goto err;
7490 Jim_SetResult(interp, varObjPtr);
7491 return JIM_OK;
7492 err:
7493 if (shared) {
7494 Jim_FreeNewObj(interp, varObjPtr);
7496 return JIM_ERR;
7499 /* -----------------------------------------------------------------------------
7500 * Index object
7501 * ---------------------------------------------------------------------------*/
7502 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
7503 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7505 static const Jim_ObjType indexObjType = {
7506 "index",
7507 NULL,
7508 NULL,
7509 UpdateStringOfIndex,
7510 JIM_TYPE_NONE,
7513 static void UpdateStringOfIndex(struct Jim_Obj *objPtr)
7515 if (objPtr->internalRep.intValue == -1) {
7516 JimSetStringBytes(objPtr, "end");
7518 else {
7519 char buf[JIM_INTEGER_SPACE + 1];
7520 if (objPtr->internalRep.intValue >= 0 || objPtr->internalRep.intValue == -INT_MAX) {
7521 sprintf(buf, "%d", objPtr->internalRep.intValue);
7523 else {
7524 /* Must be <= -2 */
7525 sprintf(buf, "end%d", objPtr->internalRep.intValue + 1);
7527 JimSetStringBytes(objPtr, buf);
7531 static int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7533 int idx, end = 0;
7534 const char *str;
7535 char *endptr;
7537 /* Get the string representation */
7538 str = Jim_String(objPtr);
7540 /* Try to convert into an index */
7541 if (strncmp(str, "end", 3) == 0) {
7542 end = 1;
7543 str += 3;
7544 idx = 0;
7546 else {
7547 idx = jim_strtol(str, &endptr);
7549 if (endptr == str) {
7550 goto badindex;
7552 str = endptr;
7555 /* Now str may include or +<num> or -<num> */
7556 if (*str == '+' || *str == '-') {
7557 int sign = (*str == '+' ? 1 : -1);
7559 idx += sign * jim_strtol(++str, &endptr);
7560 if (str == endptr || *endptr) {
7561 goto badindex;
7563 str = endptr;
7565 /* The only thing left should be spaces */
7566 while (isspace(UCHAR(*str))) {
7567 str++;
7569 if (*str) {
7570 goto badindex;
7572 if (end) {
7573 if (idx > 0) {
7574 idx = INT_MAX;
7576 else {
7577 /* end-1 is repesented as -2 */
7578 idx--;
7581 else if (idx < 0) {
7582 idx = -INT_MAX;
7585 /* Free the old internal repr and set the new one. */
7586 Jim_FreeIntRep(interp, objPtr);
7587 objPtr->typePtr = &indexObjType;
7588 objPtr->internalRep.intValue = idx;
7589 return JIM_OK;
7591 badindex:
7592 Jim_SetResultFormatted(interp,
7593 "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr);
7594 return JIM_ERR;
7597 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
7599 /* Avoid shimmering if the object is an integer. */
7600 if (objPtr->typePtr == &intObjType) {
7601 jim_wide val = JimWideValue(objPtr);
7603 if (val < 0)
7604 *indexPtr = -INT_MAX;
7605 else if (val > INT_MAX)
7606 *indexPtr = INT_MAX;
7607 else
7608 *indexPtr = (int)val;
7609 return JIM_OK;
7611 if (objPtr->typePtr != &indexObjType && SetIndexFromAny(interp, objPtr) == JIM_ERR)
7612 return JIM_ERR;
7613 *indexPtr = objPtr->internalRep.intValue;
7614 return JIM_OK;
7617 /* -----------------------------------------------------------------------------
7618 * Return Code Object.
7619 * ---------------------------------------------------------------------------*/
7621 /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
7622 static const char * const jimReturnCodes[] = {
7623 "ok",
7624 "error",
7625 "return",
7626 "break",
7627 "continue",
7628 "signal",
7629 "exit",
7630 "eval",
7631 NULL
7634 #define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes) - 1)
7636 static const Jim_ObjType returnCodeObjType = {
7637 "return-code",
7638 NULL,
7639 NULL,
7640 NULL,
7641 JIM_TYPE_NONE,
7644 /* Converts a (standard) return code to a string. Returns "?" for
7645 * non-standard return codes.
7647 const char *Jim_ReturnCode(int code)
7649 if (code < 0 || code >= (int)jimReturnCodesSize) {
7650 return "?";
7652 else {
7653 return jimReturnCodes[code];
7657 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7659 int returnCode;
7660 jim_wide wideValue;
7662 /* Try to convert into an integer */
7663 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
7664 returnCode = (int)wideValue;
7665 else if (Jim_GetEnum(interp, objPtr, jimReturnCodes, &returnCode, NULL, JIM_NONE) != JIM_OK) {
7666 Jim_SetResultFormatted(interp, "expected return code but got \"%#s\"", objPtr);
7667 return JIM_ERR;
7669 /* Free the old internal repr and set the new one. */
7670 Jim_FreeIntRep(interp, objPtr);
7671 objPtr->typePtr = &returnCodeObjType;
7672 objPtr->internalRep.intValue = returnCode;
7673 return JIM_OK;
7676 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
7678 if (objPtr->typePtr != &returnCodeObjType && SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
7679 return JIM_ERR;
7680 *intPtr = objPtr->internalRep.intValue;
7681 return JIM_OK;
7684 /* -----------------------------------------------------------------------------
7685 * Expression Parsing
7686 * ---------------------------------------------------------------------------*/
7687 static int JimParseExprOperator(struct JimParserCtx *pc);
7688 static int JimParseExprNumber(struct JimParserCtx *pc);
7689 static int JimParseExprIrrational(struct JimParserCtx *pc);
7690 static int JimParseExprBoolean(struct JimParserCtx *pc);
7692 /* expr operator opcodes. */
7693 enum
7695 /* Continues on from the JIM_TT_ space */
7697 /* Binary operators (numbers) */
7698 JIM_EXPROP_MUL = JIM_TT_EXPR_OP, /* 20 */
7699 JIM_EXPROP_DIV,
7700 JIM_EXPROP_MOD,
7701 JIM_EXPROP_SUB,
7702 JIM_EXPROP_ADD,
7703 JIM_EXPROP_LSHIFT,
7704 JIM_EXPROP_RSHIFT,
7705 JIM_EXPROP_ROTL,
7706 JIM_EXPROP_ROTR,
7707 JIM_EXPROP_LT,
7708 JIM_EXPROP_GT,
7709 JIM_EXPROP_LTE,
7710 JIM_EXPROP_GTE,
7711 JIM_EXPROP_NUMEQ,
7712 JIM_EXPROP_NUMNE,
7713 JIM_EXPROP_BITAND, /* 35 */
7714 JIM_EXPROP_BITXOR,
7715 JIM_EXPROP_BITOR,
7716 JIM_EXPROP_LOGICAND, /* 38 */
7717 JIM_EXPROP_LOGICOR, /* 39 */
7718 JIM_EXPROP_TERNARY, /* 40 */
7719 JIM_EXPROP_COLON, /* 41 */
7720 JIM_EXPROP_POW, /* 42 */
7722 /* Binary operators (strings) */
7723 JIM_EXPROP_STREQ, /* 43 */
7724 JIM_EXPROP_STRNE,
7725 JIM_EXPROP_STRIN,
7726 JIM_EXPROP_STRNI,
7728 /* Unary operators (numbers) */
7729 JIM_EXPROP_NOT, /* 47 */
7730 JIM_EXPROP_BITNOT,
7731 JIM_EXPROP_UNARYMINUS,
7732 JIM_EXPROP_UNARYPLUS,
7734 /* Functions */
7735 JIM_EXPROP_FUNC_INT, /* 51 */
7736 JIM_EXPROP_FUNC_WIDE,
7737 JIM_EXPROP_FUNC_ABS,
7738 JIM_EXPROP_FUNC_DOUBLE,
7739 JIM_EXPROP_FUNC_ROUND,
7740 JIM_EXPROP_FUNC_RAND,
7741 JIM_EXPROP_FUNC_SRAND,
7743 /* math functions from libm */
7744 JIM_EXPROP_FUNC_SIN, /* 65 */
7745 JIM_EXPROP_FUNC_COS,
7746 JIM_EXPROP_FUNC_TAN,
7747 JIM_EXPROP_FUNC_ASIN,
7748 JIM_EXPROP_FUNC_ACOS,
7749 JIM_EXPROP_FUNC_ATAN,
7750 JIM_EXPROP_FUNC_ATAN2,
7751 JIM_EXPROP_FUNC_SINH,
7752 JIM_EXPROP_FUNC_COSH,
7753 JIM_EXPROP_FUNC_TANH,
7754 JIM_EXPROP_FUNC_CEIL,
7755 JIM_EXPROP_FUNC_FLOOR,
7756 JIM_EXPROP_FUNC_EXP,
7757 JIM_EXPROP_FUNC_LOG,
7758 JIM_EXPROP_FUNC_LOG10,
7759 JIM_EXPROP_FUNC_SQRT,
7760 JIM_EXPROP_FUNC_POW,
7761 JIM_EXPROP_FUNC_HYPOT,
7762 JIM_EXPROP_FUNC_FMOD,
7765 /* A expression node is either a term or an operator
7766 * If a node is an operator, 'op' points to the details of the operator and it's terms.
7768 struct JimExprNode {
7769 int type; /* JIM_TT_xxx */
7770 struct Jim_Obj *objPtr; /* The object for a term, or NULL for an operator */
7772 struct JimExprNode *left; /* For all operators */
7773 struct JimExprNode *right; /* For binary operators */
7774 struct JimExprNode *ternary; /* For ternary operator only */
7777 /* Operators table */
7778 typedef struct Jim_ExprOperator
7780 const char *name;
7781 int (*funcop) (Jim_Interp *interp, struct JimExprNode *opnode);
7782 unsigned char precedence;
7783 unsigned char arity;
7784 unsigned char attr;
7785 unsigned char namelen;
7786 } Jim_ExprOperator;
7788 static int JimExprGetTerm(Jim_Interp *interp, struct JimExprNode *node, Jim_Obj **objPtrPtr);
7789 static int JimExprGetTermBoolean(Jim_Interp *interp, struct JimExprNode *node);
7790 static int JimExprEvalTermNode(Jim_Interp *interp, struct JimExprNode *node);
7792 static int JimExprOpNumUnary(Jim_Interp *interp, struct JimExprNode *node)
7794 int intresult = 1;
7795 int rc;
7796 double dA, dC = 0;
7797 jim_wide wA, wC = 0;
7798 Jim_Obj *A;
7800 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7801 return rc;
7804 if ((A->typePtr != &doubleObjType || A->bytes) && JimGetWideNoErr(interp, A, &wA) == JIM_OK) {
7805 switch (node->type) {
7806 case JIM_EXPROP_FUNC_INT:
7807 case JIM_EXPROP_FUNC_WIDE:
7808 case JIM_EXPROP_FUNC_ROUND:
7809 case JIM_EXPROP_UNARYPLUS:
7810 wC = wA;
7811 break;
7812 case JIM_EXPROP_FUNC_DOUBLE:
7813 dC = wA;
7814 intresult = 0;
7815 break;
7816 case JIM_EXPROP_FUNC_ABS:
7817 wC = wA >= 0 ? wA : -wA;
7818 break;
7819 case JIM_EXPROP_UNARYMINUS:
7820 wC = -wA;
7821 break;
7822 case JIM_EXPROP_NOT:
7823 wC = !wA;
7824 break;
7825 default:
7826 abort();
7829 else if ((rc = Jim_GetDouble(interp, A, &dA)) == JIM_OK) {
7830 switch (node->type) {
7831 case JIM_EXPROP_FUNC_INT:
7832 case JIM_EXPROP_FUNC_WIDE:
7833 wC = dA;
7834 break;
7835 case JIM_EXPROP_FUNC_ROUND:
7836 wC = dA < 0 ? (dA - 0.5) : (dA + 0.5);
7837 break;
7838 case JIM_EXPROP_FUNC_DOUBLE:
7839 case JIM_EXPROP_UNARYPLUS:
7840 dC = dA;
7841 intresult = 0;
7842 break;
7843 case JIM_EXPROP_FUNC_ABS:
7844 #ifdef JIM_MATH_FUNCTIONS
7845 dC = fabs(dA);
7846 #else
7847 dC = dA >= 0 ? dA : -dA;
7848 #endif
7849 intresult = 0;
7850 break;
7851 case JIM_EXPROP_UNARYMINUS:
7852 dC = -dA;
7853 intresult = 0;
7854 break;
7855 case JIM_EXPROP_NOT:
7856 wC = !dA;
7857 break;
7858 default:
7859 abort();
7863 if (rc == JIM_OK) {
7864 if (intresult) {
7865 Jim_SetResultInt(interp, wC);
7867 else {
7868 Jim_SetResult(interp, Jim_NewDoubleObj(interp, dC));
7872 Jim_DecrRefCount(interp, A);
7874 return rc;
7877 static double JimRandDouble(Jim_Interp *interp)
7879 unsigned long x;
7880 JimRandomBytes(interp, &x, sizeof(x));
7882 return (double)x / (unsigned long)~0;
7885 static int JimExprOpIntUnary(Jim_Interp *interp, struct JimExprNode *node)
7887 jim_wide wA;
7888 Jim_Obj *A;
7889 int rc;
7891 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7892 return rc;
7895 rc = Jim_GetWide(interp, A, &wA);
7896 if (rc == JIM_OK) {
7897 switch (node->type) {
7898 case JIM_EXPROP_BITNOT:
7899 Jim_SetResultInt(interp, ~wA);
7900 break;
7901 case JIM_EXPROP_FUNC_SRAND:
7902 JimPrngSeed(interp, (unsigned char *)&wA, sizeof(wA));
7903 Jim_SetResult(interp, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7904 break;
7905 default:
7906 abort();
7910 Jim_DecrRefCount(interp, A);
7912 return rc;
7915 static int JimExprOpNone(Jim_Interp *interp, struct JimExprNode *node)
7917 JimPanic((node->type != JIM_EXPROP_FUNC_RAND, "JimExprOpNone only support rand()"));
7919 Jim_SetResult(interp, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7921 return JIM_OK;
7924 #ifdef JIM_MATH_FUNCTIONS
7925 static int JimExprOpDoubleUnary(Jim_Interp *interp, struct JimExprNode *node)
7927 int rc;
7928 double dA, dC;
7929 Jim_Obj *A;
7931 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7932 return rc;
7935 rc = Jim_GetDouble(interp, A, &dA);
7936 if (rc == JIM_OK) {
7937 switch (node->type) {
7938 case JIM_EXPROP_FUNC_SIN:
7939 dC = sin(dA);
7940 break;
7941 case JIM_EXPROP_FUNC_COS:
7942 dC = cos(dA);
7943 break;
7944 case JIM_EXPROP_FUNC_TAN:
7945 dC = tan(dA);
7946 break;
7947 case JIM_EXPROP_FUNC_ASIN:
7948 dC = asin(dA);
7949 break;
7950 case JIM_EXPROP_FUNC_ACOS:
7951 dC = acos(dA);
7952 break;
7953 case JIM_EXPROP_FUNC_ATAN:
7954 dC = atan(dA);
7955 break;
7956 case JIM_EXPROP_FUNC_SINH:
7957 dC = sinh(dA);
7958 break;
7959 case JIM_EXPROP_FUNC_COSH:
7960 dC = cosh(dA);
7961 break;
7962 case JIM_EXPROP_FUNC_TANH:
7963 dC = tanh(dA);
7964 break;
7965 case JIM_EXPROP_FUNC_CEIL:
7966 dC = ceil(dA);
7967 break;
7968 case JIM_EXPROP_FUNC_FLOOR:
7969 dC = floor(dA);
7970 break;
7971 case JIM_EXPROP_FUNC_EXP:
7972 dC = exp(dA);
7973 break;
7974 case JIM_EXPROP_FUNC_LOG:
7975 dC = log(dA);
7976 break;
7977 case JIM_EXPROP_FUNC_LOG10:
7978 dC = log10(dA);
7979 break;
7980 case JIM_EXPROP_FUNC_SQRT:
7981 dC = sqrt(dA);
7982 break;
7983 default:
7984 abort();
7986 Jim_SetResult(interp, Jim_NewDoubleObj(interp, dC));
7989 Jim_DecrRefCount(interp, A);
7991 return rc;
7993 #endif
7995 /* A binary operation on two ints */
7996 static int JimExprOpIntBin(Jim_Interp *interp, struct JimExprNode *node)
7998 jim_wide wA, wB;
7999 int rc;
8000 Jim_Obj *A, *B;
8002 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
8003 return rc;
8005 if ((rc = JimExprGetTerm(interp, node->right, &B)) != JIM_OK) {
8006 Jim_DecrRefCount(interp, A);
8007 return rc;
8010 rc = JIM_ERR;
8012 if (Jim_GetWide(interp, A, &wA) == JIM_OK && Jim_GetWide(interp, B, &wB) == JIM_OK) {
8013 jim_wide wC;
8015 rc = JIM_OK;
8017 switch (node->type) {
8018 case JIM_EXPROP_LSHIFT:
8019 wC = wA << wB;
8020 break;
8021 case JIM_EXPROP_RSHIFT:
8022 wC = wA >> wB;
8023 break;
8024 case JIM_EXPROP_BITAND:
8025 wC = wA & wB;
8026 break;
8027 case JIM_EXPROP_BITXOR:
8028 wC = wA ^ wB;
8029 break;
8030 case JIM_EXPROP_BITOR:
8031 wC = wA | wB;
8032 break;
8033 case JIM_EXPROP_MOD:
8034 if (wB == 0) {
8035 wC = 0;
8036 Jim_SetResultString(interp, "Division by zero", -1);
8037 rc = JIM_ERR;
8039 else {
8041 * From Tcl 8.x
8043 * This code is tricky: C doesn't guarantee much
8044 * about the quotient or remainder, but Tcl does.
8045 * The remainder always has the same sign as the
8046 * divisor and a smaller absolute value.
8048 int negative = 0;
8050 if (wB < 0) {
8051 wB = -wB;
8052 wA = -wA;
8053 negative = 1;
8055 wC = wA % wB;
8056 if (wC < 0) {
8057 wC += wB;
8059 if (negative) {
8060 wC = -wC;
8063 break;
8064 case JIM_EXPROP_ROTL:
8065 case JIM_EXPROP_ROTR:{
8066 /* uint32_t would be better. But not everyone has inttypes.h? */
8067 unsigned long uA = (unsigned long)wA;
8068 unsigned long uB = (unsigned long)wB;
8069 const unsigned int S = sizeof(unsigned long) * 8;
8071 /* Shift left by the word size or more is undefined. */
8072 uB %= S;
8074 if (node->type == JIM_EXPROP_ROTR) {
8075 uB = S - uB;
8077 wC = (unsigned long)(uA << uB) | (uA >> (S - uB));
8078 break;
8080 default:
8081 abort();
8083 Jim_SetResultInt(interp, wC);
8086 Jim_DecrRefCount(interp, A);
8087 Jim_DecrRefCount(interp, B);
8089 return rc;
8093 /* A binary operation on two ints or two doubles (or two strings for some ops) */
8094 static int JimExprOpBin(Jim_Interp *interp, struct JimExprNode *node)
8096 int rc = JIM_OK;
8097 double dA, dB, dC = 0;
8098 jim_wide wA, wB, wC = 0;
8099 Jim_Obj *A, *B;
8101 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
8102 return rc;
8104 if ((rc = JimExprGetTerm(interp, node->right, &B)) != JIM_OK) {
8105 Jim_DecrRefCount(interp, A);
8106 return rc;
8109 if ((A->typePtr != &doubleObjType || A->bytes) &&
8110 (B->typePtr != &doubleObjType || B->bytes) &&
8111 JimGetWideNoErr(interp, A, &wA) == JIM_OK && JimGetWideNoErr(interp, B, &wB) == JIM_OK) {
8113 /* Both are ints */
8115 switch (node->type) {
8116 case JIM_EXPROP_POW:
8117 case JIM_EXPROP_FUNC_POW:
8118 if (wA == 0 && wB < 0) {
8119 Jim_SetResultString(interp, "exponentiation of zero by negative power", -1);
8120 rc = JIM_ERR;
8121 goto done;
8123 wC = JimPowWide(wA, wB);
8124 goto intresult;
8125 case JIM_EXPROP_ADD:
8126 wC = wA + wB;
8127 goto intresult;
8128 case JIM_EXPROP_SUB:
8129 wC = wA - wB;
8130 goto intresult;
8131 case JIM_EXPROP_MUL:
8132 wC = wA * wB;
8133 goto intresult;
8134 case JIM_EXPROP_DIV:
8135 if (wB == 0) {
8136 Jim_SetResultString(interp, "Division by zero", -1);
8137 rc = JIM_ERR;
8138 goto done;
8140 else {
8142 * From Tcl 8.x
8144 * This code is tricky: C doesn't guarantee much
8145 * about the quotient or remainder, but Tcl does.
8146 * The remainder always has the same sign as the
8147 * divisor and a smaller absolute value.
8149 if (wB < 0) {
8150 wB = -wB;
8151 wA = -wA;
8153 wC = wA / wB;
8154 if (wA % wB < 0) {
8155 wC--;
8157 goto intresult;
8159 case JIM_EXPROP_LT:
8160 wC = wA < wB;
8161 goto intresult;
8162 case JIM_EXPROP_GT:
8163 wC = wA > wB;
8164 goto intresult;
8165 case JIM_EXPROP_LTE:
8166 wC = wA <= wB;
8167 goto intresult;
8168 case JIM_EXPROP_GTE:
8169 wC = wA >= wB;
8170 goto intresult;
8171 case JIM_EXPROP_NUMEQ:
8172 wC = wA == wB;
8173 goto intresult;
8174 case JIM_EXPROP_NUMNE:
8175 wC = wA != wB;
8176 goto intresult;
8179 if (Jim_GetDouble(interp, A, &dA) == JIM_OK && Jim_GetDouble(interp, B, &dB) == JIM_OK) {
8180 switch (node->type) {
8181 #ifndef JIM_MATH_FUNCTIONS
8182 case JIM_EXPROP_POW:
8183 case JIM_EXPROP_FUNC_POW:
8184 case JIM_EXPROP_FUNC_ATAN2:
8185 case JIM_EXPROP_FUNC_HYPOT:
8186 case JIM_EXPROP_FUNC_FMOD:
8187 Jim_SetResultString(interp, "unsupported", -1);
8188 rc = JIM_ERR;
8189 goto done;
8190 #else
8191 case JIM_EXPROP_POW:
8192 case JIM_EXPROP_FUNC_POW:
8193 dC = pow(dA, dB);
8194 goto doubleresult;
8195 case JIM_EXPROP_FUNC_ATAN2:
8196 dC = atan2(dA, dB);
8197 goto doubleresult;
8198 case JIM_EXPROP_FUNC_HYPOT:
8199 dC = hypot(dA, dB);
8200 goto doubleresult;
8201 case JIM_EXPROP_FUNC_FMOD:
8202 dC = fmod(dA, dB);
8203 goto doubleresult;
8204 #endif
8205 case JIM_EXPROP_ADD:
8206 dC = dA + dB;
8207 goto doubleresult;
8208 case JIM_EXPROP_SUB:
8209 dC = dA - dB;
8210 goto doubleresult;
8211 case JIM_EXPROP_MUL:
8212 dC = dA * dB;
8213 goto doubleresult;
8214 case JIM_EXPROP_DIV:
8215 if (dB == 0) {
8216 #ifdef INFINITY
8217 dC = dA < 0 ? -INFINITY : INFINITY;
8218 #else
8219 dC = (dA < 0 ? -1.0 : 1.0) * strtod("Inf", NULL);
8220 #endif
8222 else {
8223 dC = dA / dB;
8225 goto doubleresult;
8226 case JIM_EXPROP_LT:
8227 wC = dA < dB;
8228 goto intresult;
8229 case JIM_EXPROP_GT:
8230 wC = dA > dB;
8231 goto intresult;
8232 case JIM_EXPROP_LTE:
8233 wC = dA <= dB;
8234 goto intresult;
8235 case JIM_EXPROP_GTE:
8236 wC = dA >= dB;
8237 goto intresult;
8238 case JIM_EXPROP_NUMEQ:
8239 wC = dA == dB;
8240 goto intresult;
8241 case JIM_EXPROP_NUMNE:
8242 wC = dA != dB;
8243 goto intresult;
8246 else {
8247 /* Handle the string case */
8249 /* XXX: Could optimise the eq/ne case by checking lengths */
8250 int i = Jim_StringCompareObj(interp, A, B, 0);
8252 switch (node->type) {
8253 case JIM_EXPROP_LT:
8254 wC = i < 0;
8255 goto intresult;
8256 case JIM_EXPROP_GT:
8257 wC = i > 0;
8258 goto intresult;
8259 case JIM_EXPROP_LTE:
8260 wC = i <= 0;
8261 goto intresult;
8262 case JIM_EXPROP_GTE:
8263 wC = i >= 0;
8264 goto intresult;
8265 case JIM_EXPROP_NUMEQ:
8266 wC = i == 0;
8267 goto intresult;
8268 case JIM_EXPROP_NUMNE:
8269 wC = i != 0;
8270 goto intresult;
8273 /* If we get here, it is an error */
8274 rc = JIM_ERR;
8275 done:
8276 Jim_DecrRefCount(interp, A);
8277 Jim_DecrRefCount(interp, B);
8278 return rc;
8279 intresult:
8280 Jim_SetResultInt(interp, wC);
8281 goto done;
8282 doubleresult:
8283 Jim_SetResult(interp, Jim_NewDoubleObj(interp, dC));
8284 goto done;
8287 static int JimSearchList(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *valObj)
8289 int listlen;
8290 int i;
8292 listlen = Jim_ListLength(interp, listObjPtr);
8293 for (i = 0; i < listlen; i++) {
8294 if (Jim_StringEqObj(Jim_ListGetIndex(interp, listObjPtr, i), valObj)) {
8295 return 1;
8298 return 0;
8303 static int JimExprOpStrBin(Jim_Interp *interp, struct JimExprNode *node)
8305 Jim_Obj *A, *B;
8306 jim_wide wC;
8307 int rc;
8309 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
8310 return rc;
8312 if ((rc = JimExprGetTerm(interp, node->right, &B)) != JIM_OK) {
8313 Jim_DecrRefCount(interp, A);
8314 return rc;
8317 switch (node->type) {
8318 case JIM_EXPROP_STREQ:
8319 case JIM_EXPROP_STRNE:
8320 wC = Jim_StringEqObj(A, B);
8321 if (node->type == JIM_EXPROP_STRNE) {
8322 wC = !wC;
8324 break;
8325 case JIM_EXPROP_STRIN:
8326 wC = JimSearchList(interp, B, A);
8327 break;
8328 case JIM_EXPROP_STRNI:
8329 wC = !JimSearchList(interp, B, A);
8330 break;
8331 default:
8332 abort();
8334 Jim_SetResultInt(interp, wC);
8336 Jim_DecrRefCount(interp, A);
8337 Jim_DecrRefCount(interp, B);
8339 return rc;
8342 static int ExprBool(Jim_Interp *interp, Jim_Obj *obj)
8344 long l;
8345 double d;
8346 int b;
8347 int ret = -1;
8349 /* In case the object is interp->result with refcount 1*/
8350 Jim_IncrRefCount(obj);
8352 if (Jim_GetLong(interp, obj, &l) == JIM_OK) {
8353 ret = (l != 0);
8355 else if (Jim_GetDouble(interp, obj, &d) == JIM_OK) {
8356 ret = (d != 0);
8358 else if (Jim_GetBoolean(interp, obj, &b) == JIM_OK) {
8359 ret = (b != 0);
8362 Jim_DecrRefCount(interp, obj);
8363 return ret;
8366 static int JimExprOpAnd(Jim_Interp *interp, struct JimExprNode *node)
8368 /* evaluate left */
8369 int result = JimExprGetTermBoolean(interp, node->left);
8371 if (result == 1) {
8372 /* true so evaluate right */
8373 result = JimExprGetTermBoolean(interp, node->right);
8375 if (result == -1) {
8376 return JIM_ERR;
8378 Jim_SetResultInt(interp, result);
8379 return JIM_OK;
8382 static int JimExprOpOr(Jim_Interp *interp, struct JimExprNode *node)
8384 /* evaluate left */
8385 int result = JimExprGetTermBoolean(interp, node->left);
8387 if (result == 0) {
8388 /* false so evaluate right */
8389 result = JimExprGetTermBoolean(interp, node->right);
8391 if (result == -1) {
8392 return JIM_ERR;
8394 Jim_SetResultInt(interp, result);
8395 return JIM_OK;
8398 static int JimExprOpTernary(Jim_Interp *interp, struct JimExprNode *node)
8400 /* evaluate left */
8401 int result = JimExprGetTermBoolean(interp, node->left);
8403 if (result == 1) {
8404 /* true so select right */
8405 return JimExprEvalTermNode(interp, node->right);
8407 else if (result == 0) {
8408 /* false so select ternary */
8409 return JimExprEvalTermNode(interp, node->ternary);
8411 /* error */
8412 return JIM_ERR;
8415 enum
8417 OP_FUNC = 0x0001, /* function syntax */
8418 OP_RIGHT_ASSOC = 0x0002, /* right associative */
8421 /* name - precedence - arity - opcode
8423 * This array *must* be kept in sync with the JIM_EXPROP enum.
8425 * The following macros pre-compute the string length at compile time.
8427 #define OPRINIT_ATTR(N, P, ARITY, F, ATTR) {N, F, P, ARITY, ATTR, sizeof(N) - 1}
8428 #define OPRINIT(N, P, ARITY, F) OPRINIT_ATTR(N, P, ARITY, F, 0)
8430 static const struct Jim_ExprOperator Jim_ExprOperators[] = {
8431 OPRINIT("*", 110, 2, JimExprOpBin),
8432 OPRINIT("/", 110, 2, JimExprOpBin),
8433 OPRINIT("%", 110, 2, JimExprOpIntBin),
8435 OPRINIT("-", 100, 2, JimExprOpBin),
8436 OPRINIT("+", 100, 2, JimExprOpBin),
8438 OPRINIT("<<", 90, 2, JimExprOpIntBin),
8439 OPRINIT(">>", 90, 2, JimExprOpIntBin),
8441 OPRINIT("<<<", 90, 2, JimExprOpIntBin),
8442 OPRINIT(">>>", 90, 2, JimExprOpIntBin),
8444 OPRINIT("<", 80, 2, JimExprOpBin),
8445 OPRINIT(">", 80, 2, JimExprOpBin),
8446 OPRINIT("<=", 80, 2, JimExprOpBin),
8447 OPRINIT(">=", 80, 2, JimExprOpBin),
8449 OPRINIT("==", 70, 2, JimExprOpBin),
8450 OPRINIT("!=", 70, 2, JimExprOpBin),
8452 OPRINIT("&", 50, 2, JimExprOpIntBin),
8453 OPRINIT("^", 49, 2, JimExprOpIntBin),
8454 OPRINIT("|", 48, 2, JimExprOpIntBin),
8456 OPRINIT("&&", 10, 2, JimExprOpAnd),
8457 OPRINIT("||", 9, 2, JimExprOpOr),
8458 OPRINIT_ATTR("?", 5, 3, JimExprOpTernary, OP_RIGHT_ASSOC),
8459 OPRINIT_ATTR(":", 5, 3, NULL, OP_RIGHT_ASSOC),
8461 /* Precedence is higher than * and / but lower than ! and ~, and right-associative */
8462 OPRINIT_ATTR("**", 120, 2, JimExprOpBin, OP_RIGHT_ASSOC),
8464 OPRINIT("eq", 60, 2, JimExprOpStrBin),
8465 OPRINIT("ne", 60, 2, JimExprOpStrBin),
8467 OPRINIT("in", 55, 2, JimExprOpStrBin),
8468 OPRINIT("ni", 55, 2, JimExprOpStrBin),
8470 OPRINIT_ATTR("!", 150, 1, JimExprOpNumUnary, OP_RIGHT_ASSOC),
8471 OPRINIT_ATTR("~", 150, 1, JimExprOpIntUnary, OP_RIGHT_ASSOC),
8472 OPRINIT_ATTR(" -", 150, 1, JimExprOpNumUnary, OP_RIGHT_ASSOC),
8473 OPRINIT_ATTR(" +", 150, 1, JimExprOpNumUnary, OP_RIGHT_ASSOC),
8477 OPRINIT_ATTR("int", 200, 1, JimExprOpNumUnary, OP_FUNC),
8478 OPRINIT_ATTR("wide", 200, 1, JimExprOpNumUnary, OP_FUNC),
8479 OPRINIT_ATTR("abs", 200, 1, JimExprOpNumUnary, OP_FUNC),
8480 OPRINIT_ATTR("double", 200, 1, JimExprOpNumUnary, OP_FUNC),
8481 OPRINIT_ATTR("round", 200, 1, JimExprOpNumUnary, OP_FUNC),
8482 OPRINIT_ATTR("rand", 200, 0, JimExprOpNone, OP_FUNC),
8483 OPRINIT_ATTR("srand", 200, 1, JimExprOpIntUnary, OP_FUNC),
8485 #ifdef JIM_MATH_FUNCTIONS
8486 OPRINIT_ATTR("sin", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8487 OPRINIT_ATTR("cos", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8488 OPRINIT_ATTR("tan", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8489 OPRINIT_ATTR("asin", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8490 OPRINIT_ATTR("acos", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8491 OPRINIT_ATTR("atan", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8492 OPRINIT_ATTR("atan2", 200, 2, JimExprOpBin, OP_FUNC),
8493 OPRINIT_ATTR("sinh", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8494 OPRINIT_ATTR("cosh", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8495 OPRINIT_ATTR("tanh", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8496 OPRINIT_ATTR("ceil", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8497 OPRINIT_ATTR("floor", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8498 OPRINIT_ATTR("exp", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8499 OPRINIT_ATTR("log", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8500 OPRINIT_ATTR("log10", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8501 OPRINIT_ATTR("sqrt", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8502 OPRINIT_ATTR("pow", 200, 2, JimExprOpBin, OP_FUNC),
8503 OPRINIT_ATTR("hypot", 200, 2, JimExprOpBin, OP_FUNC),
8504 OPRINIT_ATTR("fmod", 200, 2, JimExprOpBin, OP_FUNC),
8505 #endif
8507 #undef OPRINIT
8508 #undef OPRINIT_ATTR
8510 #define JIM_EXPR_OPERATORS_NUM \
8511 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
8513 static int JimParseExpression(struct JimParserCtx *pc)
8515 /* Discard spaces and quoted newline */
8516 while (isspace(UCHAR(*pc->p)) || (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) {
8517 if (*pc->p == '\n') {
8518 pc->linenr++;
8520 pc->p++;
8521 pc->len--;
8524 /* Common case */
8525 pc->tline = pc->linenr;
8526 pc->tstart = pc->p;
8528 if (pc->len == 0) {
8529 pc->tend = pc->p;
8530 pc->tt = JIM_TT_EOL;
8531 pc->eof = 1;
8532 return JIM_OK;
8534 switch (*(pc->p)) {
8535 case '(':
8536 pc->tt = JIM_TT_SUBEXPR_START;
8537 goto singlechar;
8538 case ')':
8539 pc->tt = JIM_TT_SUBEXPR_END;
8540 goto singlechar;
8541 case ',':
8542 pc->tt = JIM_TT_SUBEXPR_COMMA;
8543 singlechar:
8544 pc->tend = pc->p;
8545 pc->p++;
8546 pc->len--;
8547 break;
8548 case '[':
8549 return JimParseCmd(pc);
8550 case '$':
8551 if (JimParseVar(pc) == JIM_ERR)
8552 return JimParseExprOperator(pc);
8553 else {
8554 /* Don't allow expr sugar in expressions */
8555 if (pc->tt == JIM_TT_EXPRSUGAR) {
8556 return JIM_ERR;
8558 return JIM_OK;
8560 break;
8561 case '0':
8562 case '1':
8563 case '2':
8564 case '3':
8565 case '4':
8566 case '5':
8567 case '6':
8568 case '7':
8569 case '8':
8570 case '9':
8571 case '.':
8572 return JimParseExprNumber(pc);
8573 case '"':
8574 return JimParseQuote(pc);
8575 case '{':
8576 return JimParseBrace(pc);
8578 case 'N':
8579 case 'I':
8580 case 'n':
8581 case 'i':
8582 if (JimParseExprIrrational(pc) == JIM_ERR)
8583 if (JimParseExprBoolean(pc) == JIM_ERR)
8584 return JimParseExprOperator(pc);
8585 break;
8586 case 't':
8587 case 'f':
8588 case 'o':
8589 case 'y':
8590 if (JimParseExprBoolean(pc) == JIM_ERR)
8591 return JimParseExprOperator(pc);
8592 break;
8593 default:
8594 return JimParseExprOperator(pc);
8595 break;
8597 return JIM_OK;
8600 static int JimParseExprNumber(struct JimParserCtx *pc)
8602 char *end;
8604 /* Assume an integer for now */
8605 pc->tt = JIM_TT_EXPR_INT;
8607 jim_strtoull(pc->p, (char **)&pc->p);
8608 /* Tried as an integer, but perhaps it parses as a double */
8609 if (strchr("eENnIi.", *pc->p) || pc->p == pc->tstart) {
8610 /* Some stupid compilers insist they are cleverer that
8611 * we are. Even a (void) cast doesn't prevent this warning!
8613 if (strtod(pc->tstart, &end)) { /* nothing */ }
8614 if (end == pc->tstart)
8615 return JIM_ERR;
8616 if (end > pc->p) {
8617 /* Yes, double captured more chars */
8618 pc->tt = JIM_TT_EXPR_DOUBLE;
8619 pc->p = end;
8622 pc->tend = pc->p - 1;
8623 pc->len -= (pc->p - pc->tstart);
8624 return JIM_OK;
8627 static int JimParseExprIrrational(struct JimParserCtx *pc)
8629 const char *irrationals[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL };
8630 int i;
8632 for (i = 0; irrationals[i]; i++) {
8633 const char *irr = irrationals[i];
8635 if (strncmp(irr, pc->p, 3) == 0) {
8636 pc->p += 3;
8637 pc->len -= 3;
8638 pc->tend = pc->p - 1;
8639 pc->tt = JIM_TT_EXPR_DOUBLE;
8640 return JIM_OK;
8643 return JIM_ERR;
8646 static int JimParseExprBoolean(struct JimParserCtx *pc)
8648 const char *booleans[] = { "false", "no", "off", "true", "yes", "on", NULL };
8649 const int lengths[] = { 5, 2, 3, 4, 3, 2, 0 };
8650 int i;
8652 for (i = 0; booleans[i]; i++) {
8653 const char *boolean = booleans[i];
8654 int length = lengths[i];
8656 if (strncmp(boolean, pc->p, length) == 0) {
8657 pc->p += length;
8658 pc->len -= length;
8659 pc->tend = pc->p - 1;
8660 pc->tt = JIM_TT_EXPR_BOOLEAN;
8661 return JIM_OK;
8664 return JIM_ERR;
8667 static const struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
8669 static Jim_ExprOperator dummy_op;
8670 if (opcode < JIM_TT_EXPR_OP) {
8671 return &dummy_op;
8673 return &Jim_ExprOperators[opcode - JIM_TT_EXPR_OP];
8676 static int JimParseExprOperator(struct JimParserCtx *pc)
8678 int i;
8679 const struct Jim_ExprOperator *bestOp = NULL;
8680 int bestLen = 0;
8682 /* Try to get the longest match. */
8683 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
8684 const struct Jim_ExprOperator *op = &Jim_ExprOperators[i];
8686 if (op->name[0] != pc->p[0]) {
8687 continue;
8690 if (op->namelen > bestLen && strncmp(op->name, pc->p, op->namelen) == 0) {
8691 bestOp = op;
8692 bestLen = op->namelen;
8695 if (bestOp == NULL) {
8696 return JIM_ERR;
8699 /* Validate paretheses around function arguments */
8700 if (bestOp->attr & OP_FUNC) {
8701 const char *p = pc->p + bestLen;
8702 int len = pc->len - bestLen;
8704 while (len && isspace(UCHAR(*p))) {
8705 len--;
8706 p++;
8708 if (*p != '(') {
8709 return JIM_ERR;
8712 pc->tend = pc->p + bestLen - 1;
8713 pc->p += bestLen;
8714 pc->len -= bestLen;
8716 pc->tt = (bestOp - Jim_ExprOperators) + JIM_TT_EXPR_OP;
8717 return JIM_OK;
8720 const char *jim_tt_name(int type)
8722 static const char * const tt_names[JIM_TT_EXPR_OP] =
8723 { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "LIN", "WRD", "(((", ")))", ",,,", "INT",
8724 "DBL", "BOO", "$()" };
8725 if (type < JIM_TT_EXPR_OP) {
8726 return tt_names[type];
8728 else if (type == JIM_EXPROP_UNARYMINUS) {
8729 return "-VE";
8731 else if (type == JIM_EXPROP_UNARYPLUS) {
8732 return "+VE";
8734 else {
8735 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(type);
8736 static char buf[20];
8738 if (op->name) {
8739 return op->name;
8741 sprintf(buf, "(%d)", type);
8742 return buf;
8746 /* -----------------------------------------------------------------------------
8747 * Expression Object
8748 * ---------------------------------------------------------------------------*/
8749 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
8750 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
8751 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
8753 static const Jim_ObjType exprObjType = {
8754 "expression",
8755 FreeExprInternalRep,
8756 DupExprInternalRep,
8757 NULL,
8758 JIM_TYPE_REFERENCES,
8761 /* expr tree structure */
8762 struct ExprTree
8764 struct JimExprNode *expr; /* The first operator or term */
8765 struct JimExprNode *nodes; /* Storage of all nodes in the tree */
8766 int len; /* Number of nodes in use */
8767 int inUse; /* Used for sharing. */
8770 static void ExprTreeFreeNodes(Jim_Interp *interp, struct JimExprNode *nodes, int num)
8772 int i;
8773 for (i = 0; i < num; i++) {
8774 if (nodes[i].objPtr) {
8775 Jim_DecrRefCount(interp, nodes[i].objPtr);
8778 Jim_Free(nodes);
8781 static void ExprTreeFree(Jim_Interp *interp, struct ExprTree *expr)
8783 ExprTreeFreeNodes(interp, expr->nodes, expr->len);
8784 Jim_Free(expr);
8787 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
8789 struct ExprTree *expr = (void *)objPtr->internalRep.ptr;
8791 if (expr) {
8792 if (--expr->inUse != 0) {
8793 return;
8796 ExprTreeFree(interp, expr);
8800 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
8802 JIM_NOTUSED(interp);
8803 JIM_NOTUSED(srcPtr);
8805 /* Just returns an simple string. */
8806 dupPtr->typePtr = NULL;
8809 struct ExprBuilder {
8810 int parencount; /* count of outstanding parentheses */
8811 int level; /* recursion depth */
8812 ParseToken *token; /* The current token */
8813 ParseToken *first_token; /* The first token */
8814 Jim_Stack stack; /* stack of pending terms */
8815 Jim_Obj *exprObjPtr; /* the original expression */
8816 Jim_Obj *fileNameObj; /* filename of the original expression */
8817 struct JimExprNode *nodes; /* storage for all nodes */
8818 struct JimExprNode *next; /* storage for the next node */
8821 #ifdef DEBUG_SHOW_EXPR
8822 static void JimShowExprNode(struct JimExprNode *node, int level)
8824 int i;
8825 for (i = 0; i < level; i++) {
8826 printf(" ");
8828 if (TOKEN_IS_EXPR_OP(node->type)) {
8829 printf("%s\n", jim_tt_name(node->type));
8830 if (node->left) {
8831 JimShowExprNode(node->left, level + 1);
8833 if (node->right) {
8834 JimShowExprNode(node->right, level + 1);
8836 if (node->ternary) {
8837 JimShowExprNode(node->ternary, level + 1);
8840 else {
8841 printf("[%s] %s\n", jim_tt_name(node->type), Jim_String(node->objPtr));
8844 #endif
8846 #define EXPR_UNTIL_CLOSE 0x0001
8847 #define EXPR_FUNC_ARGS 0x0002
8848 #define EXPR_TERNARY 0x0004
8851 * Parse the subexpression at builder->token and return with the node on the stack.
8852 * builder->token is advanced to the next unconsumed token.
8853 * Returns JIM_OK if OK or JIM_ERR on error and leaves a message in the interpreter result.
8855 * 'precedence' is the precedence of the current operator. Tokens are consumed until an operator
8856 * with an equal or lower precedence is reached (or strictly lower if right associative).
8858 * If EXPR_UNTIL_CLOSE is set, the subexpression extends up to and including the next close parenthesis.
8859 * If EXPR_FUNC_ARGS is set, multiple subexpressions (terms) are expected separated by comma
8860 * If EXPR_TERNARY is set, two subexpressions (terms) are expected separated by colon
8862 * 'exp_numterms' indicates how many terms are expected. Normally this is 1, but may be more for EXPR_FUNC_ARGS and EXPR_TERNARY.
8864 static int ExprTreeBuildTree(Jim_Interp *interp, struct ExprBuilder *builder, int precedence, int flags, int exp_numterms)
8866 int rc;
8867 struct JimExprNode *node;
8868 /* Calculate the stack length expected after pushing the number of expected terms */
8869 int exp_stacklen = builder->stack.len + exp_numterms;
8871 if (builder->level++ > 200) {
8872 Jim_SetResultString(interp, "Expression too complex", -1);
8873 return JIM_ERR;
8876 while (builder->token->type != JIM_TT_EOL) {
8877 ParseToken *t = builder->token++;
8878 int prevtt;
8880 if (t == builder->first_token) {
8881 prevtt = JIM_TT_NONE;
8883 else {
8884 prevtt = t[-1].type;
8887 if (t->type == JIM_TT_SUBEXPR_START) {
8888 if (builder->stack.len == exp_stacklen) {
8889 Jim_SetResultFormatted(interp, "unexpected open parenthesis in expression: \"%#s\"", builder->exprObjPtr);
8890 return JIM_ERR;
8892 builder->parencount++;
8893 rc = ExprTreeBuildTree(interp, builder, 0, EXPR_UNTIL_CLOSE, 1);
8894 if (rc != JIM_OK) {
8895 return rc;
8897 /* A complete subexpression is on the stack */
8899 else if (t->type == JIM_TT_SUBEXPR_END) {
8900 if (!(flags & EXPR_UNTIL_CLOSE)) {
8901 if (builder->stack.len == exp_stacklen && builder->level > 1) {
8902 builder->token--;
8903 builder->level--;
8904 return JIM_OK;
8906 Jim_SetResultFormatted(interp, "unexpected closing parenthesis in expression: \"%#s\"", builder->exprObjPtr);
8907 return JIM_ERR;
8909 builder->parencount--;
8910 if (builder->stack.len == exp_stacklen) {
8911 /* Return with the expected number of subexpressions on the stack */
8912 break;
8915 else if (t->type == JIM_TT_SUBEXPR_COMMA) {
8916 if (!(flags & EXPR_FUNC_ARGS)) {
8917 if (builder->stack.len == exp_stacklen) {
8918 /* handle the comma back at the parent level */
8919 builder->token--;
8920 builder->level--;
8921 return JIM_OK;
8923 Jim_SetResultFormatted(interp, "unexpected comma in expression: \"%#s\"", builder->exprObjPtr);
8924 return JIM_ERR;
8926 else {
8927 /* If we see more terms than expected, it is an error */
8928 if (builder->stack.len > exp_stacklen) {
8929 Jim_SetResultFormatted(interp, "too many arguments to math function");
8930 return JIM_ERR;
8933 /* just go onto the next arg */
8935 else if (t->type == JIM_EXPROP_COLON) {
8936 if (!(flags & EXPR_TERNARY)) {
8937 if (builder->level != 1) {
8938 /* handle the comma back at the parent level */
8939 builder->token--;
8940 builder->level--;
8941 return JIM_OK;
8943 Jim_SetResultFormatted(interp, ": without ? in expression: \"%#s\"", builder->exprObjPtr);
8944 return JIM_ERR;
8946 if (builder->stack.len == exp_stacklen) {
8947 /* handle the comma back at the parent level */
8948 builder->token--;
8949 builder->level--;
8950 return JIM_OK;
8952 /* just go onto the next term */
8954 else if (TOKEN_IS_EXPR_OP(t->type)) {
8955 const struct Jim_ExprOperator *op;
8957 /* Convert -/+ to unary minus or unary plus if necessary */
8958 if (TOKEN_IS_EXPR_OP(prevtt) || TOKEN_IS_EXPR_START(prevtt)) {
8959 if (t->type == JIM_EXPROP_SUB) {
8960 t->type = JIM_EXPROP_UNARYMINUS;
8962 else if (t->type == JIM_EXPROP_ADD) {
8963 t->type = JIM_EXPROP_UNARYPLUS;
8967 op = JimExprOperatorInfoByOpcode(t->type);
8969 if (op->precedence < precedence || (!(op->attr & OP_RIGHT_ASSOC) && op->precedence == precedence)) {
8970 /* next op is lower precedence, or equal and left associative, so done here */
8971 builder->token--;
8972 break;
8975 if (op->attr & OP_FUNC) {
8976 if (builder->token->type != JIM_TT_SUBEXPR_START) {
8977 Jim_SetResultString(interp, "missing arguments for math function", -1);
8978 return JIM_ERR;
8980 builder->token++;
8981 if (op->arity == 0) {
8982 if (builder->token->type != JIM_TT_SUBEXPR_END) {
8983 Jim_SetResultString(interp, "too many arguments for math function", -1);
8984 return JIM_ERR;
8986 builder->token++;
8987 goto noargs;
8989 builder->parencount++;
8991 /* This will push left and return right */
8992 rc = ExprTreeBuildTree(interp, builder, 0, EXPR_FUNC_ARGS | EXPR_UNTIL_CLOSE, op->arity);
8994 else if (t->type == JIM_EXPROP_TERNARY) {
8995 /* Collect the two arguments to the ternary operator */
8996 rc = ExprTreeBuildTree(interp, builder, op->precedence, EXPR_TERNARY, 2);
8998 else {
8999 /* Recursively handle everything on the right until we see a precendence <= op->precedence or == and right associative
9000 * and push that on the term stack
9002 rc = ExprTreeBuildTree(interp, builder, op->precedence, 0, 1);
9005 if (rc != JIM_OK) {
9006 return rc;
9009 noargs:
9010 node = builder->next++;
9011 node->type = t->type;
9013 if (op->arity >= 3) {
9014 node->ternary = Jim_StackPop(&builder->stack);
9015 if (node->ternary == NULL) {
9016 goto missingoperand;
9019 if (op->arity >= 2) {
9020 node->right = Jim_StackPop(&builder->stack);
9021 if (node->right == NULL) {
9022 goto missingoperand;
9025 if (op->arity >= 1) {
9026 node->left = Jim_StackPop(&builder->stack);
9027 if (node->left == NULL) {
9028 missingoperand:
9029 Jim_SetResultFormatted(interp, "missing operand to %s in expression: \"%#s\"", op->name, builder->exprObjPtr);
9030 builder->next--;
9031 return JIM_ERR;
9036 /* Now push the node */
9037 Jim_StackPush(&builder->stack, node);
9039 else {
9040 Jim_Obj *objPtr = NULL;
9042 /* This is a simple non-operator term, so create and push the appropriate object */
9044 /* Two consecutive terms without an operator is invalid */
9045 if (!TOKEN_IS_EXPR_START(prevtt) && !TOKEN_IS_EXPR_OP(prevtt)) {
9046 Jim_SetResultFormatted(interp, "missing operator in expression: \"%#s\"", builder->exprObjPtr);
9047 return JIM_ERR;
9050 /* Immediately create a double or int object? */
9051 if (t->type == JIM_TT_EXPR_INT || t->type == JIM_TT_EXPR_DOUBLE) {
9052 char *endptr;
9053 if (t->type == JIM_TT_EXPR_INT) {
9054 objPtr = Jim_NewIntObj(interp, jim_strtoull(t->token, &endptr));
9056 else {
9057 objPtr = Jim_NewDoubleObj(interp, strtod(t->token, &endptr));
9059 if (endptr != t->token + t->len) {
9060 /* Conversion failed, so just store it as a string */
9061 Jim_FreeNewObj(interp, objPtr);
9062 objPtr = NULL;
9066 if (!objPtr) {
9067 /* Everything else is stored a simple string term */
9068 objPtr = Jim_NewStringObj(interp, t->token, t->len);
9069 if (t->type == JIM_TT_CMD) {
9070 /* Only commands need source info */
9071 JimSetSourceInfo(interp, objPtr, builder->fileNameObj, t->line);
9075 /* Now push a term node */
9076 node = builder->next++;
9077 node->objPtr = objPtr;
9078 Jim_IncrRefCount(node->objPtr);
9079 node->type = t->type;
9080 Jim_StackPush(&builder->stack, node);
9084 if (builder->stack.len == exp_stacklen) {
9085 builder->level--;
9086 return JIM_OK;
9089 if ((flags & EXPR_FUNC_ARGS)) {
9090 Jim_SetResultFormatted(interp, "too %s arguments for math function", (builder->stack.len < exp_stacklen) ? "few" : "many");
9092 else {
9093 if (builder->stack.len < exp_stacklen) {
9094 if (builder->level == 0) {
9095 Jim_SetResultFormatted(interp, "empty expression");
9097 else {
9098 Jim_SetResultFormatted(interp, "syntax error in expression \"%#s\": premature end of expression", builder->exprObjPtr);
9101 else {
9102 Jim_SetResultFormatted(interp, "extra terms after expression");
9106 return JIM_ERR;
9109 static struct ExprTree *ExprTreeCreateTree(Jim_Interp *interp, const ParseTokenList *tokenlist, Jim_Obj *exprObjPtr, Jim_Obj *fileNameObj)
9111 struct ExprTree *expr;
9112 struct ExprBuilder builder;
9113 int rc;
9114 struct JimExprNode *top = NULL;
9116 builder.parencount = 0;
9117 builder.level = 0;
9118 builder.token = builder.first_token = tokenlist->list;
9119 builder.exprObjPtr = exprObjPtr;
9120 builder.fileNameObj = fileNameObj;
9121 /* The bytecode will never produce more nodes than there are tokens - 1 (for EOL)*/
9122 builder.nodes = Jim_Alloc(sizeof(struct JimExprNode) * (tokenlist->count - 1));
9123 memset(builder.nodes, 0, sizeof(struct JimExprNode) * (tokenlist->count - 1));
9124 builder.next = builder.nodes;
9125 Jim_InitStack(&builder.stack);
9127 rc = ExprTreeBuildTree(interp, &builder, 0, 0, 1);
9129 if (rc == JIM_OK) {
9130 top = Jim_StackPop(&builder.stack);
9132 if (builder.parencount) {
9133 Jim_SetResultString(interp, "missing close parenthesis", -1);
9134 rc = JIM_ERR;
9138 /* Free the stack used for the compilation. */
9139 Jim_FreeStack(&builder.stack);
9141 if (rc != JIM_OK) {
9142 ExprTreeFreeNodes(interp, builder.nodes, builder.next - builder.nodes);
9143 return NULL;
9146 expr = Jim_Alloc(sizeof(*expr));
9147 expr->inUse = 1;
9148 expr->expr = top;
9149 expr->nodes = builder.nodes;
9150 expr->len = builder.next - builder.nodes;
9152 assert(expr->len <= tokenlist->count - 1);
9154 return expr;
9157 /* This method takes the string representation of an expression
9158 * and generates a program for the expr engine */
9159 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
9161 int exprTextLen;
9162 const char *exprText;
9163 struct JimParserCtx parser;
9164 struct ExprTree *expr;
9165 ParseTokenList tokenlist;
9166 int line;
9167 Jim_Obj *fileNameObj;
9168 int rc = JIM_ERR;
9170 /* Try to get information about filename / line number */
9171 if (objPtr->typePtr == &sourceObjType) {
9172 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
9173 line = objPtr->internalRep.sourceValue.lineNumber;
9175 else {
9176 fileNameObj = interp->emptyObj;
9177 line = 1;
9179 Jim_IncrRefCount(fileNameObj);
9181 exprText = Jim_GetString(objPtr, &exprTextLen);
9183 /* Initially tokenise the expression into tokenlist */
9184 ScriptTokenListInit(&tokenlist);
9186 JimParserInit(&parser, exprText, exprTextLen, line);
9187 while (!parser.eof) {
9188 if (JimParseExpression(&parser) != JIM_OK) {
9189 ScriptTokenListFree(&tokenlist);
9190 Jim_SetResultFormatted(interp, "syntax error in expression: \"%#s\"", objPtr);
9191 expr = NULL;
9192 goto err;
9195 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
9196 parser.tline);
9199 #ifdef DEBUG_SHOW_EXPR_TOKENS
9201 int i;
9202 printf("==== Expr Tokens (%s) ====\n", Jim_String(fileNameObj));
9203 for (i = 0; i < tokenlist.count; i++) {
9204 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist.list[i].line, jim_tt_name(tokenlist.list[i].type),
9205 tokenlist.list[i].len, tokenlist.list[i].token);
9208 #endif
9210 if (JimParseCheckMissing(interp, parser.missing.ch) == JIM_ERR) {
9211 ScriptTokenListFree(&tokenlist);
9212 Jim_DecrRefCount(interp, fileNameObj);
9213 return JIM_ERR;
9216 /* Now create the expression bytecode from the tokenlist */
9217 expr = ExprTreeCreateTree(interp, &tokenlist, objPtr, fileNameObj);
9219 /* No longer need the token list */
9220 ScriptTokenListFree(&tokenlist);
9222 if (!expr) {
9223 goto err;
9226 #ifdef DEBUG_SHOW_EXPR
9227 printf("==== Expr ====\n");
9228 JimShowExprNode(expr->expr, 0);
9229 #endif
9231 rc = JIM_OK;
9233 err:
9234 /* Free the old internal rep and set the new one. */
9235 Jim_DecrRefCount(interp, fileNameObj);
9236 Jim_FreeIntRep(interp, objPtr);
9237 Jim_SetIntRepPtr(objPtr, expr);
9238 objPtr->typePtr = &exprObjType;
9239 return rc;
9242 static struct ExprTree *JimGetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
9244 if (objPtr->typePtr != &exprObjType) {
9245 if (SetExprFromAny(interp, objPtr) != JIM_OK) {
9246 return NULL;
9249 return (struct ExprTree *) Jim_GetIntRepPtr(objPtr);
9252 #ifdef JIM_OPTIMIZATION
9253 static Jim_Obj *JimExprIntValOrVar(Jim_Interp *interp, struct JimExprNode *node)
9255 if (node->type == JIM_TT_EXPR_INT)
9256 return node->objPtr;
9257 else if (node->type == JIM_TT_VAR)
9258 return Jim_GetVariable(interp, node->objPtr, JIM_NONE);
9259 else if (node->type == JIM_TT_DICTSUGAR)
9260 return JimExpandDictSugar(interp, node->objPtr);
9261 else
9262 return NULL;
9264 #endif
9266 /* -----------------------------------------------------------------------------
9267 * Expressions evaluation.
9268 * Jim uses a recursive evaluation engine for expressions,
9269 * that takes advantage of the fact that expr's operators
9270 * can't be redefined.
9272 * Jim_EvalExpression() uses the expression tree compiled by
9273 * SetExprFromAny() method of the "expression" object.
9275 * On success a Tcl Object containing the result of the evaluation
9276 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
9277 * returned.
9278 * On error the function returns a retcode != to JIM_OK and set a suitable
9279 * error on the interp.
9280 * ---------------------------------------------------------------------------*/
9282 static int JimExprEvalTermNode(Jim_Interp *interp, struct JimExprNode *node)
9284 if (TOKEN_IS_EXPR_OP(node->type)) {
9285 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(node->type);
9286 return op->funcop(interp, node);
9288 else {
9289 Jim_Obj *objPtr;
9291 /* A term */
9292 switch (node->type) {
9293 case JIM_TT_EXPR_INT:
9294 case JIM_TT_EXPR_DOUBLE:
9295 case JIM_TT_EXPR_BOOLEAN:
9296 case JIM_TT_STR:
9297 Jim_SetResult(interp, node->objPtr);
9298 return JIM_OK;
9300 case JIM_TT_VAR:
9301 objPtr = Jim_GetVariable(interp, node->objPtr, JIM_ERRMSG);
9302 if (objPtr) {
9303 Jim_SetResult(interp, objPtr);
9304 return JIM_OK;
9306 return JIM_ERR;
9308 case JIM_TT_DICTSUGAR:
9309 objPtr = JimExpandDictSugar(interp, node->objPtr);
9310 if (objPtr) {
9311 Jim_SetResult(interp, objPtr);
9312 return JIM_OK;
9314 return JIM_ERR;
9316 case JIM_TT_ESC:
9317 if (Jim_SubstObj(interp, node->objPtr, &objPtr, JIM_NONE) == JIM_OK) {
9318 Jim_SetResult(interp, objPtr);
9319 return JIM_OK;
9321 return JIM_ERR;
9323 case JIM_TT_CMD:
9324 return Jim_EvalObj(interp, node->objPtr);
9326 default:
9327 /* Should never get here */
9328 return JIM_ERR;
9333 static int JimExprGetTerm(Jim_Interp *interp, struct JimExprNode *node, Jim_Obj **objPtrPtr)
9335 int rc = JimExprEvalTermNode(interp, node);
9336 if (rc == JIM_OK) {
9337 *objPtrPtr = Jim_GetResult(interp);
9338 Jim_IncrRefCount(*objPtrPtr);
9340 return rc;
9343 static int JimExprGetTermBoolean(Jim_Interp *interp, struct JimExprNode *node)
9345 if (JimExprEvalTermNode(interp, node) == JIM_OK) {
9346 return ExprBool(interp, Jim_GetResult(interp));
9348 return -1;
9351 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr)
9353 struct ExprTree *expr;
9354 int retcode = JIM_OK;
9356 Jim_IncrRefCount(exprObjPtr); /* Make sure it's shared. */
9357 expr = JimGetExpression(interp, exprObjPtr);
9358 if (!expr) {
9359 retcode = JIM_ERR;
9360 goto done;
9363 #ifdef JIM_OPTIMIZATION
9364 /* Check for one of the following common expressions used by while/for
9366 * CONST
9367 * $a
9368 * !$a
9369 * $a < CONST, $a < $b
9370 * $a <= CONST, $a <= $b
9371 * $a > CONST, $a > $b
9372 * $a >= CONST, $a >= $b
9373 * $a != CONST, $a != $b
9374 * $a == CONST, $a == $b
9377 Jim_Obj *objPtr;
9379 /* STEP 1 -- Check if there are the conditions to run the specialized
9380 * version of while */
9382 switch (expr->len) {
9383 case 1:
9384 objPtr = JimExprIntValOrVar(interp, expr->expr);
9385 if (objPtr) {
9386 Jim_SetResult(interp, objPtr);
9387 goto done;
9389 break;
9391 case 2:
9392 if (expr->expr->type == JIM_EXPROP_NOT) {
9393 objPtr = JimExprIntValOrVar(interp, expr->expr->left);
9395 if (objPtr && JimIsWide(objPtr)) {
9396 Jim_SetResult(interp, JimWideValue(objPtr) ? interp->falseObj : interp->trueObj);
9397 goto done;
9400 break;
9402 case 3:
9403 objPtr = JimExprIntValOrVar(interp, expr->expr->left);
9404 if (objPtr && JimIsWide(objPtr)) {
9405 Jim_Obj *objPtr2 = JimExprIntValOrVar(interp, expr->expr->right);
9406 if (objPtr2 && JimIsWide(objPtr2)) {
9407 jim_wide wideValueA = JimWideValue(objPtr);
9408 jim_wide wideValueB = JimWideValue(objPtr2);
9409 int cmpRes;
9410 switch (expr->expr->type) {
9411 case JIM_EXPROP_LT:
9412 cmpRes = wideValueA < wideValueB;
9413 break;
9414 case JIM_EXPROP_LTE:
9415 cmpRes = wideValueA <= wideValueB;
9416 break;
9417 case JIM_EXPROP_GT:
9418 cmpRes = wideValueA > wideValueB;
9419 break;
9420 case JIM_EXPROP_GTE:
9421 cmpRes = wideValueA >= wideValueB;
9422 break;
9423 case JIM_EXPROP_NUMEQ:
9424 cmpRes = wideValueA == wideValueB;
9425 break;
9426 case JIM_EXPROP_NUMNE:
9427 cmpRes = wideValueA != wideValueB;
9428 break;
9429 default:
9430 goto noopt;
9432 Jim_SetResult(interp, cmpRes ? interp->trueObj : interp->falseObj);
9433 goto done;
9436 break;
9439 noopt:
9440 #endif
9442 /* In order to avoid the internal repr being freed due to
9443 * shimmering of the exprObjPtr's object, we increment the use count
9444 * and keep our own pointer outside the object.
9446 expr->inUse++;
9448 /* Evaluate with the recursive expr engine */
9449 retcode = JimExprEvalTermNode(interp, expr->expr);
9451 /* Now transfer ownership of expr back into the object in case it shimmered away */
9452 Jim_FreeIntRep(interp, exprObjPtr);
9453 exprObjPtr->typePtr = &exprObjType;
9454 Jim_SetIntRepPtr(exprObjPtr, expr);
9456 done:
9457 Jim_DecrRefCount(interp, exprObjPtr);
9459 return retcode;
9462 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
9464 int retcode = Jim_EvalExpression(interp, exprObjPtr);
9466 if (retcode == JIM_OK) {
9467 switch (ExprBool(interp, Jim_GetResult(interp))) {
9468 case 0:
9469 *boolPtr = 0;
9470 break;
9472 case 1:
9473 *boolPtr = 1;
9474 break;
9476 case -1:
9477 retcode = JIM_ERR;
9478 break;
9481 return retcode;
9484 /* -----------------------------------------------------------------------------
9485 * ScanFormat String Object
9486 * ---------------------------------------------------------------------------*/
9488 /* This Jim_Obj will held a parsed representation of a format string passed to
9489 * the Jim_ScanString command. For error diagnostics, the scanformat string has
9490 * to be parsed in its entirely first and then, if correct, can be used for
9491 * scanning. To avoid endless re-parsing, the parsed representation will be
9492 * stored in an internal representation and re-used for performance reason. */
9494 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
9495 * scanformat string. This part will later be used to extract information
9496 * out from the string to be parsed by Jim_ScanString */
9498 typedef struct ScanFmtPartDescr
9500 const char *arg; /* Specification of a CHARSET conversion */
9501 const char *prefix; /* Prefix to be scanned literally before conversion */
9502 size_t width; /* Maximal width of input to be converted */
9503 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
9504 char type; /* Type of conversion (e.g. c, d, f) */
9505 char modifier; /* Modify type (e.g. l - long, h - short */
9506 } ScanFmtPartDescr;
9508 /* The ScanFmtStringObj will hold the internal representation of a scanformat
9509 * string parsed and separated in part descriptions. Furthermore it contains
9510 * the original string representation of the scanformat string to allow for
9511 * fast update of the Jim_Obj's string representation part.
9513 * As an add-on the internal object representation adds some scratch pad area
9514 * for usage by Jim_ScanString to avoid endless allocating and freeing of
9515 * memory for purpose of string scanning.
9517 * The error member points to a static allocated string in case of a mal-
9518 * formed scanformat string or it contains '0' (NULL) in case of a valid
9519 * parse representation.
9521 * The whole memory of the internal representation is allocated as a single
9522 * area of memory that will be internally separated. So freeing and duplicating
9523 * of such an object is cheap */
9525 typedef struct ScanFmtStringObj
9527 jim_wide size; /* Size of internal repr in bytes */
9528 char *stringRep; /* Original string representation */
9529 size_t count; /* Number of ScanFmtPartDescr contained */
9530 size_t convCount; /* Number of conversions that will assign */
9531 size_t maxPos; /* Max position index if XPG3 is used */
9532 const char *error; /* Ptr to error text (NULL if no error */
9533 char *scratch; /* Some scratch pad used by Jim_ScanString */
9534 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
9535 } ScanFmtStringObj;
9538 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
9539 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
9540 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
9542 static const Jim_ObjType scanFmtStringObjType = {
9543 "scanformatstring",
9544 FreeScanFmtInternalRep,
9545 DupScanFmtInternalRep,
9546 UpdateStringOfScanFmt,
9547 JIM_TYPE_NONE,
9550 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
9552 JIM_NOTUSED(interp);
9553 Jim_Free((char *)objPtr->internalRep.ptr);
9554 objPtr->internalRep.ptr = 0;
9557 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
9559 size_t size = (size_t) ((ScanFmtStringObj *) srcPtr->internalRep.ptr)->size;
9560 ScanFmtStringObj *newVec = (ScanFmtStringObj *) Jim_Alloc(size);
9562 JIM_NOTUSED(interp);
9563 memcpy(newVec, srcPtr->internalRep.ptr, size);
9564 dupPtr->internalRep.ptr = newVec;
9565 dupPtr->typePtr = &scanFmtStringObjType;
9568 static void UpdateStringOfScanFmt(Jim_Obj *objPtr)
9570 JimSetStringBytes(objPtr, ((ScanFmtStringObj *) objPtr->internalRep.ptr)->stringRep);
9573 /* SetScanFmtFromAny will parse a given string and create the internal
9574 * representation of the format specification. In case of an error
9575 * the error data member of the internal representation will be set
9576 * to an descriptive error text and the function will be left with
9577 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
9578 * specification */
9580 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
9582 ScanFmtStringObj *fmtObj;
9583 char *buffer;
9584 int maxCount, i, approxSize, lastPos = -1;
9585 const char *fmt = Jim_String(objPtr);
9586 int maxFmtLen = Jim_Length(objPtr);
9587 const char *fmtEnd = fmt + maxFmtLen;
9588 int curr;
9590 Jim_FreeIntRep(interp, objPtr);
9591 /* Count how many conversions could take place maximally */
9592 for (i = 0, maxCount = 0; i < maxFmtLen; ++i)
9593 if (fmt[i] == '%')
9594 ++maxCount;
9595 /* Calculate an approximation of the memory necessary */
9596 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
9597 +(maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
9598 +maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
9599 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
9600 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
9601 +(maxCount + 1) * sizeof(char) /* '\0' for every partial */
9602 +1; /* safety byte */
9603 fmtObj = (ScanFmtStringObj *) Jim_Alloc(approxSize);
9604 memset(fmtObj, 0, approxSize);
9605 fmtObj->size = approxSize;
9606 fmtObj->maxPos = 0;
9607 fmtObj->scratch = (char *)&fmtObj->descr[maxCount + 1];
9608 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
9609 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
9610 buffer = fmtObj->stringRep + maxFmtLen + 1;
9611 objPtr->internalRep.ptr = fmtObj;
9612 objPtr->typePtr = &scanFmtStringObjType;
9613 for (i = 0, curr = 0; fmt < fmtEnd; ++fmt) {
9614 int width = 0, skip;
9615 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
9617 fmtObj->count++;
9618 descr->width = 0; /* Assume width unspecified */
9619 /* Overread and store any "literal" prefix */
9620 if (*fmt != '%' || fmt[1] == '%') {
9621 descr->type = 0;
9622 descr->prefix = &buffer[i];
9623 for (; fmt < fmtEnd; ++fmt) {
9624 if (*fmt == '%') {
9625 if (fmt[1] != '%')
9626 break;
9627 ++fmt;
9629 buffer[i++] = *fmt;
9631 buffer[i++] = 0;
9633 /* Skip the conversion introducing '%' sign */
9634 ++fmt;
9635 /* End reached due to non-conversion literal only? */
9636 if (fmt >= fmtEnd)
9637 goto done;
9638 descr->pos = 0; /* Assume "natural" positioning */
9639 if (*fmt == '*') {
9640 descr->pos = -1; /* Okay, conversion will not be assigned */
9641 ++fmt;
9643 else
9644 fmtObj->convCount++; /* Otherwise count as assign-conversion */
9645 /* Check if next token is a number (could be width or pos */
9646 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9647 fmt += skip;
9648 /* Was the number a XPG3 position specifier? */
9649 if (descr->pos != -1 && *fmt == '$') {
9650 int prev;
9652 ++fmt;
9653 descr->pos = width;
9654 width = 0;
9655 /* Look if "natural" postioning and XPG3 one was mixed */
9656 if ((lastPos == 0 && descr->pos > 0)
9657 || (lastPos > 0 && descr->pos == 0)) {
9658 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
9659 return JIM_ERR;
9661 /* Look if this position was already used */
9662 for (prev = 0; prev < curr; ++prev) {
9663 if (fmtObj->descr[prev].pos == -1)
9664 continue;
9665 if (fmtObj->descr[prev].pos == descr->pos) {
9666 fmtObj->error =
9667 "variable is assigned by multiple \"%n$\" conversion specifiers";
9668 return JIM_ERR;
9671 if (descr->pos < 0) {
9672 fmtObj->error =
9673 "\"%n$\" conversion specifier is negative";
9674 return JIM_ERR;
9676 /* Try to find a width after the XPG3 specifier */
9677 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9678 descr->width = width;
9679 fmt += skip;
9681 if (descr->pos > 0 && (size_t) descr->pos > fmtObj->maxPos)
9682 fmtObj->maxPos = descr->pos;
9684 else {
9685 /* Number was not a XPG3, so it has to be a width */
9686 descr->width = width;
9689 /* If positioning mode was undetermined yet, fix this */
9690 if (lastPos == -1)
9691 lastPos = descr->pos;
9692 /* Handle CHARSET conversion type ... */
9693 if (*fmt == '[') {
9694 int swapped = 1, beg = i, end, j;
9696 descr->type = '[';
9697 descr->arg = &buffer[i];
9698 ++fmt;
9699 if (*fmt == '^')
9700 buffer[i++] = *fmt++;
9701 if (*fmt == ']')
9702 buffer[i++] = *fmt++;
9703 while (*fmt && *fmt != ']')
9704 buffer[i++] = *fmt++;
9705 if (*fmt != ']') {
9706 fmtObj->error = "unmatched [ in format string";
9707 return JIM_ERR;
9709 end = i;
9710 buffer[i++] = 0;
9711 /* In case a range fence was given "backwards", swap it */
9712 while (swapped) {
9713 swapped = 0;
9714 for (j = beg + 1; j < end - 1; ++j) {
9715 if (buffer[j] == '-' && buffer[j - 1] > buffer[j + 1]) {
9716 char tmp = buffer[j - 1];
9718 buffer[j - 1] = buffer[j + 1];
9719 buffer[j + 1] = tmp;
9720 swapped = 1;
9725 else {
9726 /* Remember any valid modifier if given */
9727 if (fmt < fmtEnd && strchr("hlL", *fmt))
9728 descr->modifier = tolower((int)*fmt++);
9730 if (fmt >= fmtEnd) {
9731 fmtObj->error = "missing scan conversion character";
9732 return JIM_ERR;
9735 descr->type = *fmt;
9736 if (strchr("efgcsndoxui", *fmt) == 0) {
9737 fmtObj->error = "bad scan conversion character";
9738 return JIM_ERR;
9740 else if (*fmt == 'c' && descr->width != 0) {
9741 fmtObj->error = "field width may not be specified in %c " "conversion";
9742 return JIM_ERR;
9744 else if (*fmt == 'u' && descr->modifier == 'l') {
9745 fmtObj->error = "unsigned wide not supported";
9746 return JIM_ERR;
9749 curr++;
9751 done:
9752 return JIM_OK;
9755 /* Some accessor macros to allow lowlevel access to fields of internal repr */
9757 #define FormatGetCnvCount(_fo_) \
9758 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
9759 #define FormatGetMaxPos(_fo_) \
9760 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
9761 #define FormatGetError(_fo_) \
9762 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
9764 /* JimScanAString is used to scan an unspecified string that ends with
9765 * next WS, or a string that is specified via a charset.
9768 static Jim_Obj *JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
9770 char *buffer = Jim_StrDup(str);
9771 char *p = buffer;
9773 while (*str) {
9774 int c;
9775 int n;
9777 if (!sdescr && isspace(UCHAR(*str)))
9778 break; /* EOS via WS if unspecified */
9780 n = utf8_tounicode(str, &c);
9781 if (sdescr && !JimCharsetMatch(sdescr, strlen(sdescr), c, JIM_CHARSET_SCAN))
9782 break;
9783 while (n--)
9784 *p++ = *str++;
9786 *p = 0;
9787 return Jim_NewStringObjNoAlloc(interp, buffer, p - buffer);
9790 /* ScanOneEntry will scan one entry out of the string passed as argument.
9791 * It use the sscanf() function for this task. After extracting and
9792 * converting of the value, the count of scanned characters will be
9793 * returned of -1 in case of no conversion tool place and string was
9794 * already scanned thru */
9796 static int ScanOneEntry(Jim_Interp *interp, const char *str, int pos, int str_bytelen,
9797 ScanFmtStringObj * fmtObj, long idx, Jim_Obj **valObjPtr)
9799 const char *tok;
9800 const ScanFmtPartDescr *descr = &fmtObj->descr[idx];
9801 size_t scanned = 0;
9802 size_t anchor = pos;
9803 int i;
9804 Jim_Obj *tmpObj = NULL;
9806 /* First pessimistically assume, we will not scan anything :-) */
9807 *valObjPtr = 0;
9808 if (descr->prefix) {
9809 /* There was a prefix given before the conversion, skip it and adjust
9810 * the string-to-be-parsed accordingly */
9811 for (i = 0; pos < str_bytelen && descr->prefix[i]; ++i) {
9812 /* If prefix require, skip WS */
9813 if (isspace(UCHAR(descr->prefix[i])))
9814 while (pos < str_bytelen && isspace(UCHAR(str[pos])))
9815 ++pos;
9816 else if (descr->prefix[i] != str[pos])
9817 break; /* Prefix do not match here, leave the loop */
9818 else
9819 ++pos; /* Prefix matched so far, next round */
9821 if (pos >= str_bytelen) {
9822 return -1; /* All of str consumed: EOF condition */
9824 else if (descr->prefix[i] != 0)
9825 return 0; /* Not whole prefix consumed, no conversion possible */
9827 /* For all but following conversion, skip leading WS */
9828 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
9829 while (isspace(UCHAR(str[pos])))
9830 ++pos;
9832 /* Determine how much skipped/scanned so far */
9833 scanned = pos - anchor;
9835 /* %c is a special, simple case. no width */
9836 if (descr->type == 'n') {
9837 /* Return pseudo conversion means: how much scanned so far? */
9838 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
9840 else if (pos >= str_bytelen) {
9841 /* Cannot scan anything, as str is totally consumed */
9842 return -1;
9844 else if (descr->type == 'c') {
9845 int c;
9846 scanned += utf8_tounicode(&str[pos], &c);
9847 *valObjPtr = Jim_NewIntObj(interp, c);
9848 return scanned;
9850 else {
9851 /* Processing of conversions follows ... */
9852 if (descr->width > 0) {
9853 /* Do not try to scan as fas as possible but only the given width.
9854 * To ensure this, we copy the part that should be scanned. */
9855 size_t sLen = utf8_strlen(&str[pos], str_bytelen - pos);
9856 size_t tLen = descr->width > sLen ? sLen : descr->width;
9858 tmpObj = Jim_NewStringObjUtf8(interp, str + pos, tLen);
9859 tok = tmpObj->bytes;
9861 else {
9862 /* As no width was given, simply refer to the original string */
9863 tok = &str[pos];
9865 switch (descr->type) {
9866 case 'd':
9867 case 'o':
9868 case 'x':
9869 case 'u':
9870 case 'i':{
9871 char *endp; /* Position where the number finished */
9872 jim_wide w;
9874 int base = descr->type == 'o' ? 8
9875 : descr->type == 'x' ? 16 : descr->type == 'i' ? 0 : 10;
9877 /* Try to scan a number with the given base */
9878 if (base == 0) {
9879 w = jim_strtoull(tok, &endp);
9881 else {
9882 w = strtoull(tok, &endp, base);
9885 if (endp != tok) {
9886 /* There was some number sucessfully scanned! */
9887 *valObjPtr = Jim_NewIntObj(interp, w);
9889 /* Adjust the number-of-chars scanned so far */
9890 scanned += endp - tok;
9892 else {
9893 /* Nothing was scanned. We have to determine if this
9894 * happened due to e.g. prefix mismatch or input str
9895 * exhausted */
9896 scanned = *tok ? 0 : -1;
9898 break;
9900 case 's':
9901 case '[':{
9902 *valObjPtr = JimScanAString(interp, descr->arg, tok);
9903 scanned += Jim_Length(*valObjPtr);
9904 break;
9906 case 'e':
9907 case 'f':
9908 case 'g':{
9909 char *endp;
9910 double value = strtod(tok, &endp);
9912 if (endp != tok) {
9913 /* There was some number sucessfully scanned! */
9914 *valObjPtr = Jim_NewDoubleObj(interp, value);
9915 /* Adjust the number-of-chars scanned so far */
9916 scanned += endp - tok;
9918 else {
9919 /* Nothing was scanned. We have to determine if this
9920 * happened due to e.g. prefix mismatch or input str
9921 * exhausted */
9922 scanned = *tok ? 0 : -1;
9924 break;
9927 /* If a substring was allocated (due to pre-defined width) do not
9928 * forget to free it */
9929 if (tmpObj) {
9930 Jim_FreeNewObj(interp, tmpObj);
9933 return scanned;
9936 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
9937 * string and returns all converted (and not ignored) values in a list back
9938 * to the caller. If an error occured, a NULL pointer will be returned */
9940 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *fmtObjPtr, int flags)
9942 size_t i, pos;
9943 int scanned = 1;
9944 const char *str = Jim_String(strObjPtr);
9945 int str_bytelen = Jim_Length(strObjPtr);
9946 Jim_Obj *resultList = 0;
9947 Jim_Obj **resultVec = 0;
9948 int resultc;
9949 Jim_Obj *emptyStr = 0;
9950 ScanFmtStringObj *fmtObj;
9952 /* This should never happen. The format object should already be of the correct type */
9953 JimPanic((fmtObjPtr->typePtr != &scanFmtStringObjType, "Jim_ScanString() for non-scan format"));
9955 fmtObj = (ScanFmtStringObj *) fmtObjPtr->internalRep.ptr;
9956 /* Check if format specification was valid */
9957 if (fmtObj->error != 0) {
9958 if (flags & JIM_ERRMSG)
9959 Jim_SetResultString(interp, fmtObj->error, -1);
9960 return 0;
9962 /* Allocate a new "shared" empty string for all unassigned conversions */
9963 emptyStr = Jim_NewEmptyStringObj(interp);
9964 Jim_IncrRefCount(emptyStr);
9965 /* Create a list and fill it with empty strings up to max specified XPG3 */
9966 resultList = Jim_NewListObj(interp, NULL, 0);
9967 if (fmtObj->maxPos > 0) {
9968 for (i = 0; i < fmtObj->maxPos; ++i)
9969 Jim_ListAppendElement(interp, resultList, emptyStr);
9970 JimListGetElements(interp, resultList, &resultc, &resultVec);
9972 /* Now handle every partial format description */
9973 for (i = 0, pos = 0; i < fmtObj->count; ++i) {
9974 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
9975 Jim_Obj *value = 0;
9977 /* Only last type may be "literal" w/o conversion - skip it! */
9978 if (descr->type == 0)
9979 continue;
9980 /* As long as any conversion could be done, we will proceed */
9981 if (scanned > 0)
9982 scanned = ScanOneEntry(interp, str, pos, str_bytelen, fmtObj, i, &value);
9983 /* In case our first try results in EOF, we will leave */
9984 if (scanned == -1 && i == 0)
9985 goto eof;
9986 /* Advance next pos-to-be-scanned for the amount scanned already */
9987 pos += scanned;
9989 /* value == 0 means no conversion took place so take empty string */
9990 if (value == 0)
9991 value = Jim_NewEmptyStringObj(interp);
9992 /* If value is a non-assignable one, skip it */
9993 if (descr->pos == -1) {
9994 Jim_FreeNewObj(interp, value);
9996 else if (descr->pos == 0)
9997 /* Otherwise append it to the result list if no XPG3 was given */
9998 Jim_ListAppendElement(interp, resultList, value);
9999 else if (resultVec[descr->pos - 1] == emptyStr) {
10000 /* But due to given XPG3, put the value into the corr. slot */
10001 Jim_DecrRefCount(interp, resultVec[descr->pos - 1]);
10002 Jim_IncrRefCount(value);
10003 resultVec[descr->pos - 1] = value;
10005 else {
10006 /* Otherwise, the slot was already used - free obj and ERROR */
10007 Jim_FreeNewObj(interp, value);
10008 goto err;
10011 Jim_DecrRefCount(interp, emptyStr);
10012 return resultList;
10013 eof:
10014 Jim_DecrRefCount(interp, emptyStr);
10015 Jim_FreeNewObj(interp, resultList);
10016 return (Jim_Obj *)EOF;
10017 err:
10018 Jim_DecrRefCount(interp, emptyStr);
10019 Jim_FreeNewObj(interp, resultList);
10020 return 0;
10023 /* -----------------------------------------------------------------------------
10024 * Pseudo Random Number Generation
10025 * ---------------------------------------------------------------------------*/
10026 /* Initialize the sbox with the numbers from 0 to 255 */
10027 static void JimPrngInit(Jim_Interp *interp)
10029 #define PRNG_SEED_SIZE 256
10030 int i;
10031 unsigned int *seed;
10032 time_t t = time(NULL);
10034 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
10036 seed = Jim_Alloc(PRNG_SEED_SIZE * sizeof(*seed));
10037 for (i = 0; i < PRNG_SEED_SIZE; i++) {
10038 seed[i] = (rand() ^ t ^ clock());
10040 JimPrngSeed(interp, (unsigned char *)seed, PRNG_SEED_SIZE * sizeof(*seed));
10041 Jim_Free(seed);
10044 /* Generates N bytes of random data */
10045 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
10047 Jim_PrngState *prng;
10048 unsigned char *destByte = (unsigned char *)dest;
10049 unsigned int si, sj, x;
10051 /* initialization, only needed the first time */
10052 if (interp->prngState == NULL)
10053 JimPrngInit(interp);
10054 prng = interp->prngState;
10055 /* generates 'len' bytes of pseudo-random numbers */
10056 for (x = 0; x < len; x++) {
10057 prng->i = (prng->i + 1) & 0xff;
10058 si = prng->sbox[prng->i];
10059 prng->j = (prng->j + si) & 0xff;
10060 sj = prng->sbox[prng->j];
10061 prng->sbox[prng->i] = sj;
10062 prng->sbox[prng->j] = si;
10063 *destByte++ = prng->sbox[(si + sj) & 0xff];
10067 /* Re-seed the generator with user-provided bytes */
10068 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen)
10070 int i;
10071 Jim_PrngState *prng;
10073 /* initialization, only needed the first time */
10074 if (interp->prngState == NULL)
10075 JimPrngInit(interp);
10076 prng = interp->prngState;
10078 /* Set the sbox[i] with i */
10079 for (i = 0; i < 256; i++)
10080 prng->sbox[i] = i;
10081 /* Now use the seed to perform a random permutation of the sbox */
10082 for (i = 0; i < seedLen; i++) {
10083 unsigned char t;
10085 t = prng->sbox[i & 0xFF];
10086 prng->sbox[i & 0xFF] = prng->sbox[seed[i]];
10087 prng->sbox[seed[i]] = t;
10089 prng->i = prng->j = 0;
10091 /* discard at least the first 256 bytes of stream.
10092 * borrow the seed buffer for this
10094 for (i = 0; i < 256; i += seedLen) {
10095 JimRandomBytes(interp, seed, seedLen);
10099 /* [incr] */
10100 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10102 jim_wide wideValue, increment = 1;
10103 Jim_Obj *intObjPtr;
10105 if (argc != 2 && argc != 3) {
10106 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
10107 return JIM_ERR;
10109 if (argc == 3) {
10110 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
10111 return JIM_ERR;
10113 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
10114 if (!intObjPtr) {
10115 /* Set missing variable to 0 */
10116 wideValue = 0;
10118 else if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK) {
10119 return JIM_ERR;
10121 if (!intObjPtr || Jim_IsShared(intObjPtr)) {
10122 intObjPtr = Jim_NewIntObj(interp, wideValue + increment);
10123 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
10124 Jim_FreeNewObj(interp, intObjPtr);
10125 return JIM_ERR;
10128 else {
10129 /* Can do it the quick way */
10130 Jim_InvalidateStringRep(intObjPtr);
10131 JimWideValue(intObjPtr) = wideValue + increment;
10133 /* The following step is required in order to invalidate the
10134 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
10135 if (argv[1]->typePtr != &variableObjType) {
10136 /* Note that this can't fail since GetVariable already succeeded */
10137 Jim_SetVariable(interp, argv[1], intObjPtr);
10140 Jim_SetResult(interp, intObjPtr);
10141 return JIM_OK;
10145 /* -----------------------------------------------------------------------------
10146 * Eval
10147 * ---------------------------------------------------------------------------*/
10148 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
10149 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
10151 /* Handle calls to the [unknown] command */
10152 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10154 int retcode;
10156 /* If JimUnknown() is recursively called too many times...
10157 * done here
10159 if (interp->unknown_called > 50) {
10160 return JIM_ERR;
10163 /* The object interp->unknown just contains
10164 * the "unknown" string, it is used in order to
10165 * avoid to lookup the unknown command every time
10166 * but instead to cache the result. */
10168 /* If the [unknown] command does not exist ... */
10169 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
10170 return JIM_ERR;
10172 interp->unknown_called++;
10173 /* XXX: Are we losing fileNameObj and linenr? */
10174 retcode = Jim_EvalObjPrefix(interp, interp->unknown, argc, argv);
10175 interp->unknown_called--;
10177 return retcode;
10180 static int JimInvokeCommand(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10182 int retcode;
10183 Jim_Cmd *cmdPtr;
10184 void *prevPrivData;
10185 Jim_Obj *tailcallObj = NULL;
10187 #if 0
10188 printf("invoke");
10189 int j;
10190 for (j = 0; j < objc; j++) {
10191 printf(" '%s'", Jim_String(objv[j]));
10193 printf("\n");
10194 #endif
10196 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
10197 if (cmdPtr == NULL) {
10198 return JimUnknown(interp, objc, objv);
10200 JimIncrCmdRefCount(cmdPtr);
10202 if (interp->evalDepth == interp->maxEvalDepth) {
10203 Jim_SetResultString(interp, "Infinite eval recursion", -1);
10204 retcode = JIM_ERR;
10205 goto out;
10207 interp->evalDepth++;
10208 prevPrivData = interp->cmdPrivData;
10210 tailcall:
10212 /* Call it -- Make sure result is an empty object. */
10213 Jim_SetEmptyResult(interp);
10214 if (cmdPtr->isproc) {
10215 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
10217 else {
10218 interp->cmdPrivData = cmdPtr->u.native.privData;
10219 retcode = cmdPtr->u.native.cmdProc(interp, objc, objv);
10222 if (tailcallObj) {
10223 /* clean up previous tailcall if we were invoking one */
10224 Jim_DecrRefCount(interp, tailcallObj);
10225 tailcallObj = NULL;
10228 /* If a tailcall is returned for this frame, loop to invoke the new command */
10229 if (retcode == JIM_EVAL && interp->framePtr->tailcallObj) {
10230 JimDecrCmdRefCount(interp, cmdPtr);
10232 /* Replace the current command with the new tailcall command */
10233 cmdPtr = interp->framePtr->tailcallCmd;
10234 interp->framePtr->tailcallCmd = NULL;
10235 tailcallObj = interp->framePtr->tailcallObj;
10236 interp->framePtr->tailcallObj = NULL;
10237 /* We can access the internal rep here because the object can only
10238 * be constructed by the tailcall command
10240 objc = tailcallObj->internalRep.listValue.len;
10241 objv = tailcallObj->internalRep.listValue.ele;
10242 goto tailcall;
10245 interp->cmdPrivData = prevPrivData;
10246 interp->evalDepth--;
10248 out:
10249 JimDecrCmdRefCount(interp, cmdPtr);
10251 if (interp->framePtr->tailcallObj) {
10252 /* We might have skipped invoking a tailcall, perhaps because of an error
10253 * in defer handling so cleanup now
10255 JimDecrCmdRefCount(interp, interp->framePtr->tailcallCmd);
10256 Jim_DecrRefCount(interp, interp->framePtr->tailcallObj);
10257 interp->framePtr->tailcallCmd = NULL;
10258 interp->framePtr->tailcallObj = NULL;
10261 return retcode;
10264 /* Eval the object vector 'objv' composed of 'objc' elements.
10265 * Every element is used as single argument.
10266 * Jim_EvalObj() will call this function every time its object
10267 * argument is of "list" type, with no string representation.
10269 * This is possible because the string representation of a
10270 * list object generated by the UpdateStringOfList is made
10271 * in a way that ensures that every list element is a different
10272 * command argument. */
10273 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10275 int i, retcode;
10277 /* Incr refcount of arguments. */
10278 for (i = 0; i < objc; i++)
10279 Jim_IncrRefCount(objv[i]);
10281 retcode = JimInvokeCommand(interp, objc, objv);
10283 /* Decr refcount of arguments and return the retcode */
10284 for (i = 0; i < objc; i++)
10285 Jim_DecrRefCount(interp, objv[i]);
10287 return retcode;
10291 * Invokes 'prefix' as a command with the objv array as arguments.
10293 int Jim_EvalObjPrefix(Jim_Interp *interp, Jim_Obj *prefix, int objc, Jim_Obj *const *objv)
10295 int ret;
10296 Jim_Obj **nargv = Jim_Alloc((objc + 1) * sizeof(*nargv));
10298 nargv[0] = prefix;
10299 memcpy(&nargv[1], &objv[0], sizeof(nargv[0]) * objc);
10300 ret = Jim_EvalObjVector(interp, objc + 1, nargv);
10301 Jim_Free(nargv);
10302 return ret;
10305 static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script)
10307 if (!interp->errorFlag) {
10308 /* This is the first error, so save the file/line information and reset the stack */
10309 interp->errorFlag = 1;
10310 Jim_IncrRefCount(script->fileNameObj);
10311 Jim_DecrRefCount(interp, interp->errorFileNameObj);
10312 interp->errorFileNameObj = script->fileNameObj;
10313 interp->errorLine = script->linenr;
10315 JimResetStackTrace(interp);
10316 /* Always add a level where the error first occurs */
10317 interp->addStackTrace++;
10320 /* Now if this is an "interesting" level, add it to the stack trace */
10321 if (interp->addStackTrace > 0) {
10322 /* Add the stack info for the current level */
10324 JimAppendStackTrace(interp, Jim_String(interp->errorProc), script->fileNameObj, script->linenr);
10326 /* Note: if we didn't have a filename for this level,
10327 * don't clear the addStackTrace flag
10328 * so we can pick it up at the next level
10330 if (Jim_Length(script->fileNameObj)) {
10331 interp->addStackTrace = 0;
10334 Jim_DecrRefCount(interp, interp->errorProc);
10335 interp->errorProc = interp->emptyObj;
10336 Jim_IncrRefCount(interp->errorProc);
10340 static int JimSubstOneToken(Jim_Interp *interp, const ScriptToken *token, Jim_Obj **objPtrPtr)
10342 Jim_Obj *objPtr;
10343 int ret = JIM_ERR;
10345 switch (token->type) {
10346 case JIM_TT_STR:
10347 case JIM_TT_ESC:
10348 objPtr = token->objPtr;
10349 break;
10350 case JIM_TT_VAR:
10351 objPtr = Jim_GetVariable(interp, token->objPtr, JIM_ERRMSG);
10352 break;
10353 case JIM_TT_DICTSUGAR:
10354 objPtr = JimExpandDictSugar(interp, token->objPtr);
10355 break;
10356 case JIM_TT_EXPRSUGAR:
10357 ret = Jim_EvalExpression(interp, token->objPtr);
10358 if (ret == JIM_OK) {
10359 objPtr = Jim_GetResult(interp);
10361 else {
10362 objPtr = NULL;
10364 break;
10365 case JIM_TT_CMD:
10366 ret = Jim_EvalObj(interp, token->objPtr);
10367 if (ret == JIM_OK || ret == JIM_RETURN) {
10368 objPtr = interp->result;
10369 } else {
10370 /* includes JIM_BREAK, JIM_CONTINUE */
10371 objPtr = NULL;
10373 break;
10374 default:
10375 JimPanic((1,
10376 "default token type (%d) reached " "in Jim_SubstObj().", token->type));
10377 objPtr = NULL;
10378 break;
10380 if (objPtr) {
10381 *objPtrPtr = objPtr;
10382 return JIM_OK;
10384 return ret;
10387 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
10388 * via *objPtrPtr. This function is only called by Jim_EvalObj() and Jim_SubstObj()
10389 * The returned object has refcount = 0.
10391 static Jim_Obj *JimInterpolateTokens(Jim_Interp *interp, const ScriptToken * token, int tokens, int flags)
10393 int totlen = 0, i;
10394 Jim_Obj **intv;
10395 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
10396 Jim_Obj *objPtr;
10397 char *s;
10399 if (tokens <= JIM_EVAL_SINTV_LEN)
10400 intv = sintv;
10401 else
10402 intv = Jim_Alloc(sizeof(Jim_Obj *) * tokens);
10404 /* Compute every token forming the argument
10405 * in the intv objects vector. */
10406 for (i = 0; i < tokens; i++) {
10407 switch (JimSubstOneToken(interp, &token[i], &intv[i])) {
10408 case JIM_OK:
10409 case JIM_RETURN:
10410 break;
10411 case JIM_BREAK:
10412 if (flags & JIM_SUBST_FLAG) {
10413 /* Stop here */
10414 tokens = i;
10415 continue;
10417 /* XXX: Should probably set an error about break outside loop */
10418 /* fall through to error */
10419 case JIM_CONTINUE:
10420 if (flags & JIM_SUBST_FLAG) {
10421 intv[i] = NULL;
10422 continue;
10424 /* XXX: Ditto continue outside loop */
10425 /* fall through to error */
10426 default:
10427 while (i--) {
10428 Jim_DecrRefCount(interp, intv[i]);
10430 if (intv != sintv) {
10431 Jim_Free(intv);
10433 return NULL;
10435 Jim_IncrRefCount(intv[i]);
10436 Jim_String(intv[i]);
10437 totlen += intv[i]->length;
10440 /* Fast path return for a single token */
10441 if (tokens == 1 && intv[0] && intv == sintv) {
10442 /* Reverse the Jim_IncrRefCount() above, but don't free the object */
10443 intv[0]->refCount--;
10444 return intv[0];
10447 /* Concatenate every token in an unique
10448 * object. */
10449 objPtr = Jim_NewStringObjNoAlloc(interp, NULL, 0);
10451 if (tokens == 4 && token[0].type == JIM_TT_ESC && token[1].type == JIM_TT_ESC
10452 && token[2].type == JIM_TT_VAR) {
10453 /* May be able to do fast interpolated object -> dictSubst */
10454 objPtr->typePtr = &interpolatedObjType;
10455 objPtr->internalRep.dictSubstValue.varNameObjPtr = token[0].objPtr;
10456 objPtr->internalRep.dictSubstValue.indexObjPtr = intv[2];
10457 Jim_IncrRefCount(intv[2]);
10459 else if (tokens && intv[0] && intv[0]->typePtr == &sourceObjType) {
10460 /* The first interpolated token is source, so preserve the source info */
10461 JimSetSourceInfo(interp, objPtr, intv[0]->internalRep.sourceValue.fileNameObj, intv[0]->internalRep.sourceValue.lineNumber);
10465 s = objPtr->bytes = Jim_Alloc(totlen + 1);
10466 objPtr->length = totlen;
10467 for (i = 0; i < tokens; i++) {
10468 if (intv[i]) {
10469 memcpy(s, intv[i]->bytes, intv[i]->length);
10470 s += intv[i]->length;
10471 Jim_DecrRefCount(interp, intv[i]);
10474 objPtr->bytes[totlen] = '\0';
10475 /* Free the intv vector if not static. */
10476 if (intv != sintv) {
10477 Jim_Free(intv);
10480 return objPtr;
10484 /* listPtr *must* be a list.
10485 * The contents of the list is evaluated with the first element as the command and
10486 * the remaining elements as the arguments.
10488 static int JimEvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10490 int retcode = JIM_OK;
10492 JimPanic((Jim_IsList(listPtr) == 0, "JimEvalObjList() invoked on non-list."));
10494 if (listPtr->internalRep.listValue.len) {
10495 Jim_IncrRefCount(listPtr);
10496 retcode = JimInvokeCommand(interp,
10497 listPtr->internalRep.listValue.len,
10498 listPtr->internalRep.listValue.ele);
10499 Jim_DecrRefCount(interp, listPtr);
10501 return retcode;
10504 int Jim_EvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10506 SetListFromAny(interp, listPtr);
10507 return JimEvalObjList(interp, listPtr);
10510 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
10512 int i;
10513 ScriptObj *script;
10514 ScriptToken *token;
10515 int retcode = JIM_OK;
10516 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL;
10517 Jim_Obj *prevScriptObj;
10519 /* If the object is of type "list", with no string rep we can call
10520 * a specialized version of Jim_EvalObj() */
10521 if (Jim_IsList(scriptObjPtr) && scriptObjPtr->bytes == NULL) {
10522 return JimEvalObjList(interp, scriptObjPtr);
10525 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
10526 script = JimGetScript(interp, scriptObjPtr);
10527 if (!JimScriptValid(interp, script)) {
10528 Jim_DecrRefCount(interp, scriptObjPtr);
10529 return JIM_ERR;
10532 /* Reset the interpreter result. This is useful to
10533 * return the empty result in the case of empty program. */
10534 Jim_SetEmptyResult(interp);
10536 token = script->token;
10538 #ifdef JIM_OPTIMIZATION
10539 /* Check for one of the following common scripts used by for, while
10541 * {}
10542 * incr a
10544 if (script->len == 0) {
10545 Jim_DecrRefCount(interp, scriptObjPtr);
10546 return JIM_OK;
10548 if (script->len == 3
10549 && token[1].objPtr->typePtr == &commandObjType
10550 && token[1].objPtr->internalRep.cmdValue.cmdPtr->isproc == 0
10551 && token[1].objPtr->internalRep.cmdValue.cmdPtr->u.native.cmdProc == Jim_IncrCoreCommand
10552 && token[2].objPtr->typePtr == &variableObjType) {
10554 Jim_Obj *objPtr = Jim_GetVariable(interp, token[2].objPtr, JIM_NONE);
10556 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
10557 JimWideValue(objPtr)++;
10558 Jim_InvalidateStringRep(objPtr);
10559 Jim_DecrRefCount(interp, scriptObjPtr);
10560 Jim_SetResult(interp, objPtr);
10561 return JIM_OK;
10564 #endif
10566 /* Now we have to make sure the internal repr will not be
10567 * freed on shimmering.
10569 * Think for example to this:
10571 * set x {llength $x; ... some more code ...}; eval $x
10573 * In order to preserve the internal rep, we increment the
10574 * inUse field of the script internal rep structure. */
10575 script->inUse++;
10577 /* Stash the current script */
10578 prevScriptObj = interp->currentScriptObj;
10579 interp->currentScriptObj = scriptObjPtr;
10581 interp->errorFlag = 0;
10582 argv = sargv;
10584 /* Execute every command sequentially until the end of the script
10585 * or an error occurs.
10587 for (i = 0; i < script->len && retcode == JIM_OK; ) {
10588 int argc;
10589 int j;
10591 /* First token of the line is always JIM_TT_LINE */
10592 argc = token[i].objPtr->internalRep.scriptLineValue.argc;
10593 script->linenr = token[i].objPtr->internalRep.scriptLineValue.line;
10595 /* Allocate the arguments vector if required */
10596 if (argc > JIM_EVAL_SARGV_LEN)
10597 argv = Jim_Alloc(sizeof(Jim_Obj *) * argc);
10599 /* Skip the JIM_TT_LINE token */
10600 i++;
10602 /* Populate the arguments objects.
10603 * If an error occurs, retcode will be set and
10604 * 'j' will be set to the number of args expanded
10606 for (j = 0; j < argc; j++) {
10607 long wordtokens = 1;
10608 int expand = 0;
10609 Jim_Obj *wordObjPtr = NULL;
10611 if (token[i].type == JIM_TT_WORD) {
10612 wordtokens = JimWideValue(token[i++].objPtr);
10613 if (wordtokens < 0) {
10614 expand = 1;
10615 wordtokens = -wordtokens;
10619 if (wordtokens == 1) {
10620 /* Fast path if the token does not
10621 * need interpolation */
10623 switch (token[i].type) {
10624 case JIM_TT_ESC:
10625 case JIM_TT_STR:
10626 wordObjPtr = token[i].objPtr;
10627 break;
10628 case JIM_TT_VAR:
10629 wordObjPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
10630 break;
10631 case JIM_TT_EXPRSUGAR:
10632 retcode = Jim_EvalExpression(interp, token[i].objPtr);
10633 if (retcode == JIM_OK) {
10634 wordObjPtr = Jim_GetResult(interp);
10636 else {
10637 wordObjPtr = NULL;
10639 break;
10640 case JIM_TT_DICTSUGAR:
10641 wordObjPtr = JimExpandDictSugar(interp, token[i].objPtr);
10642 break;
10643 case JIM_TT_CMD:
10644 retcode = Jim_EvalObj(interp, token[i].objPtr);
10645 if (retcode == JIM_OK) {
10646 wordObjPtr = Jim_GetResult(interp);
10648 break;
10649 default:
10650 JimPanic((1, "default token type reached " "in Jim_EvalObj()."));
10653 else {
10654 /* For interpolation we call a helper
10655 * function to do the work for us. */
10656 wordObjPtr = JimInterpolateTokens(interp, token + i, wordtokens, JIM_NONE);
10659 if (!wordObjPtr) {
10660 if (retcode == JIM_OK) {
10661 retcode = JIM_ERR;
10663 break;
10666 Jim_IncrRefCount(wordObjPtr);
10667 i += wordtokens;
10669 if (!expand) {
10670 argv[j] = wordObjPtr;
10672 else {
10673 /* Need to expand wordObjPtr into multiple args from argv[j] ... */
10674 int len = Jim_ListLength(interp, wordObjPtr);
10675 int newargc = argc + len - 1;
10676 int k;
10678 if (len > 1) {
10679 if (argv == sargv) {
10680 if (newargc > JIM_EVAL_SARGV_LEN) {
10681 argv = Jim_Alloc(sizeof(*argv) * newargc);
10682 memcpy(argv, sargv, sizeof(*argv) * j);
10685 else {
10686 /* Need to realloc to make room for (len - 1) more entries */
10687 argv = Jim_Realloc(argv, sizeof(*argv) * newargc);
10691 /* Now copy in the expanded version */
10692 for (k = 0; k < len; k++) {
10693 argv[j++] = wordObjPtr->internalRep.listValue.ele[k];
10694 Jim_IncrRefCount(wordObjPtr->internalRep.listValue.ele[k]);
10697 /* The original object reference is no longer needed,
10698 * after the expansion it is no longer present on
10699 * the argument vector, but the single elements are
10700 * in its place. */
10701 Jim_DecrRefCount(interp, wordObjPtr);
10703 /* And update the indexes */
10704 j--;
10705 argc += len - 1;
10709 if (retcode == JIM_OK && argc) {
10710 /* Invoke the command */
10711 retcode = JimInvokeCommand(interp, argc, argv);
10712 /* Check for a signal after each command */
10713 if (Jim_CheckSignal(interp)) {
10714 retcode = JIM_SIGNAL;
10718 /* Finished with the command, so decrement ref counts of each argument */
10719 while (j-- > 0) {
10720 Jim_DecrRefCount(interp, argv[j]);
10723 if (argv != sargv) {
10724 Jim_Free(argv);
10725 argv = sargv;
10729 /* Possibly add to the error stack trace */
10730 if (retcode == JIM_ERR) {
10731 JimAddErrorToStack(interp, script);
10733 /* Propagate the addStackTrace value through 'return -code error' */
10734 else if (retcode != JIM_RETURN || interp->returnCode != JIM_ERR) {
10735 /* No need to add stack trace */
10736 interp->addStackTrace = 0;
10739 /* Restore the current script */
10740 interp->currentScriptObj = prevScriptObj;
10742 /* Note that we don't have to decrement inUse, because the
10743 * following code transfers our use of the reference again to
10744 * the script object. */
10745 Jim_FreeIntRep(interp, scriptObjPtr);
10746 scriptObjPtr->typePtr = &scriptObjType;
10747 Jim_SetIntRepPtr(scriptObjPtr, script);
10748 Jim_DecrRefCount(interp, scriptObjPtr);
10750 return retcode;
10753 static int JimSetProcArg(Jim_Interp *interp, Jim_Obj *argNameObj, Jim_Obj *argValObj)
10755 int retcode;
10756 /* If argObjPtr begins with '&', do an automatic upvar */
10757 const char *varname = Jim_String(argNameObj);
10758 if (*varname == '&') {
10759 /* First check that the target variable exists */
10760 Jim_Obj *objPtr;
10761 Jim_CallFrame *savedCallFrame = interp->framePtr;
10763 interp->framePtr = interp->framePtr->parent;
10764 objPtr = Jim_GetVariable(interp, argValObj, JIM_ERRMSG);
10765 interp->framePtr = savedCallFrame;
10766 if (!objPtr) {
10767 return JIM_ERR;
10770 /* It exists, so perform the binding. */
10771 objPtr = Jim_NewStringObj(interp, varname + 1, -1);
10772 Jim_IncrRefCount(objPtr);
10773 retcode = Jim_SetVariableLink(interp, objPtr, argValObj, interp->framePtr->parent);
10774 Jim_DecrRefCount(interp, objPtr);
10776 else {
10777 retcode = Jim_SetVariable(interp, argNameObj, argValObj);
10779 return retcode;
10783 * Sets the interp result to be an error message indicating the required proc args.
10785 static void JimSetProcWrongArgs(Jim_Interp *interp, Jim_Obj *procNameObj, Jim_Cmd *cmd)
10787 /* Create a nice error message, consistent with Tcl 8.5 */
10788 Jim_Obj *argmsg = Jim_NewStringObj(interp, "", 0);
10789 int i;
10791 for (i = 0; i < cmd->u.proc.argListLen; i++) {
10792 Jim_AppendString(interp, argmsg, " ", 1);
10794 if (i == cmd->u.proc.argsPos) {
10795 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10796 /* Renamed args */
10797 Jim_AppendString(interp, argmsg, "?", 1);
10798 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].defaultObjPtr);
10799 Jim_AppendString(interp, argmsg, " ...?", -1);
10801 else {
10802 /* We have plain args */
10803 Jim_AppendString(interp, argmsg, "?arg...?", -1);
10806 else {
10807 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10808 Jim_AppendString(interp, argmsg, "?", 1);
10809 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].nameObjPtr);
10810 Jim_AppendString(interp, argmsg, "?", 1);
10812 else {
10813 const char *arg = Jim_String(cmd->u.proc.arglist[i].nameObjPtr);
10814 if (*arg == '&') {
10815 arg++;
10817 Jim_AppendString(interp, argmsg, arg, -1);
10821 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s%#s\"", procNameObj, argmsg);
10824 #ifdef jim_ext_namespace
10826 * [namespace eval]
10828 int Jim_EvalNamespace(Jim_Interp *interp, Jim_Obj *scriptObj, Jim_Obj *nsObj)
10830 Jim_CallFrame *callFramePtr;
10831 int retcode;
10833 /* Create a new callframe */
10834 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, nsObj);
10835 callFramePtr->argv = &interp->emptyObj;
10836 callFramePtr->argc = 0;
10837 callFramePtr->procArgsObjPtr = NULL;
10838 callFramePtr->procBodyObjPtr = scriptObj;
10839 callFramePtr->staticVars = NULL;
10840 callFramePtr->fileNameObj = interp->emptyObj;
10841 callFramePtr->line = 0;
10842 Jim_IncrRefCount(scriptObj);
10843 interp->framePtr = callFramePtr;
10845 /* Check if there are too nested calls */
10846 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10847 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10848 retcode = JIM_ERR;
10850 else {
10851 /* Eval the body */
10852 retcode = Jim_EvalObj(interp, scriptObj);
10855 /* Destroy the callframe */
10856 interp->framePtr = interp->framePtr->parent;
10857 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10859 return retcode;
10861 #endif
10863 /* Call a procedure implemented in Tcl.
10864 * It's possible to speed-up a lot this function, currently
10865 * the callframes are not cached, but allocated and
10866 * destroied every time. What is expecially costly is
10867 * to create/destroy the local vars hash table every time.
10869 * This can be fixed just implementing callframes caching
10870 * in JimCreateCallFrame() and JimFreeCallFrame(). */
10871 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv)
10873 Jim_CallFrame *callFramePtr;
10874 int i, d, retcode, optargs;
10875 ScriptObj *script;
10877 /* Check arity */
10878 if (argc - 1 < cmd->u.proc.reqArity ||
10879 (cmd->u.proc.argsPos < 0 && argc - 1 > cmd->u.proc.reqArity + cmd->u.proc.optArity)) {
10880 JimSetProcWrongArgs(interp, argv[0], cmd);
10881 return JIM_ERR;
10884 if (Jim_Length(cmd->u.proc.bodyObjPtr) == 0) {
10885 /* Optimise for procedure with no body - useful for optional debugging */
10886 return JIM_OK;
10889 /* Check if there are too nested calls */
10890 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10891 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10892 return JIM_ERR;
10895 /* Create a new callframe */
10896 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, cmd->u.proc.nsObj);
10897 callFramePtr->argv = argv;
10898 callFramePtr->argc = argc;
10899 callFramePtr->procArgsObjPtr = cmd->u.proc.argListObjPtr;
10900 callFramePtr->procBodyObjPtr = cmd->u.proc.bodyObjPtr;
10901 callFramePtr->staticVars = cmd->u.proc.staticVars;
10903 /* Remember where we were called from. */
10904 script = JimGetScript(interp, interp->currentScriptObj);
10905 callFramePtr->fileNameObj = script->fileNameObj;
10906 callFramePtr->line = script->linenr;
10908 Jim_IncrRefCount(cmd->u.proc.argListObjPtr);
10909 Jim_IncrRefCount(cmd->u.proc.bodyObjPtr);
10910 interp->framePtr = callFramePtr;
10912 /* How many optional args are available */
10913 optargs = (argc - 1 - cmd->u.proc.reqArity);
10915 /* Step 'i' along the actual args, and step 'd' along the formal args */
10916 i = 1;
10917 for (d = 0; d < cmd->u.proc.argListLen; d++) {
10918 Jim_Obj *nameObjPtr = cmd->u.proc.arglist[d].nameObjPtr;
10919 if (d == cmd->u.proc.argsPos) {
10920 /* assign $args */
10921 Jim_Obj *listObjPtr;
10922 int argsLen = 0;
10923 if (cmd->u.proc.reqArity + cmd->u.proc.optArity < argc - 1) {
10924 argsLen = argc - 1 - (cmd->u.proc.reqArity + cmd->u.proc.optArity);
10926 listObjPtr = Jim_NewListObj(interp, &argv[i], argsLen);
10928 /* It is possible to rename args. */
10929 if (cmd->u.proc.arglist[d].defaultObjPtr) {
10930 nameObjPtr =cmd->u.proc.arglist[d].defaultObjPtr;
10932 retcode = Jim_SetVariable(interp, nameObjPtr, listObjPtr);
10933 if (retcode != JIM_OK) {
10934 goto badargset;
10937 i += argsLen;
10938 continue;
10941 /* Optional or required? */
10942 if (cmd->u.proc.arglist[d].defaultObjPtr == NULL || optargs-- > 0) {
10943 retcode = JimSetProcArg(interp, nameObjPtr, argv[i++]);
10945 else {
10946 /* Ran out, so use the default */
10947 retcode = Jim_SetVariable(interp, nameObjPtr, cmd->u.proc.arglist[d].defaultObjPtr);
10949 if (retcode != JIM_OK) {
10950 goto badargset;
10954 /* Eval the body */
10955 retcode = Jim_EvalObj(interp, cmd->u.proc.bodyObjPtr);
10957 badargset:
10959 /* Invoke $jim::defer then destroy the callframe */
10960 retcode = JimInvokeDefer(interp, retcode);
10961 interp->framePtr = interp->framePtr->parent;
10962 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10964 /* Handle the JIM_RETURN return code */
10965 if (retcode == JIM_RETURN) {
10966 if (--interp->returnLevel <= 0) {
10967 retcode = interp->returnCode;
10968 interp->returnCode = JIM_OK;
10969 interp->returnLevel = 0;
10972 else if (retcode == JIM_ERR) {
10973 interp->addStackTrace++;
10974 Jim_DecrRefCount(interp, interp->errorProc);
10975 interp->errorProc = argv[0];
10976 Jim_IncrRefCount(interp->errorProc);
10979 return retcode;
10982 int Jim_EvalSource(Jim_Interp *interp, const char *filename, int lineno, const char *script)
10984 int retval;
10985 Jim_Obj *scriptObjPtr;
10987 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
10988 Jim_IncrRefCount(scriptObjPtr);
10990 if (filename) {
10991 Jim_Obj *prevScriptObj;
10993 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), lineno);
10995 prevScriptObj = interp->currentScriptObj;
10996 interp->currentScriptObj = scriptObjPtr;
10998 retval = Jim_EvalObj(interp, scriptObjPtr);
11000 interp->currentScriptObj = prevScriptObj;
11002 else {
11003 retval = Jim_EvalObj(interp, scriptObjPtr);
11005 Jim_DecrRefCount(interp, scriptObjPtr);
11006 return retval;
11009 int Jim_Eval(Jim_Interp *interp, const char *script)
11011 return Jim_EvalObj(interp, Jim_NewStringObj(interp, script, -1));
11014 /* Execute script in the scope of the global level */
11015 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
11017 int retval;
11018 Jim_CallFrame *savedFramePtr = interp->framePtr;
11020 interp->framePtr = interp->topFramePtr;
11021 retval = Jim_Eval(interp, script);
11022 interp->framePtr = savedFramePtr;
11024 return retval;
11027 int Jim_EvalFileGlobal(Jim_Interp *interp, const char *filename)
11029 int retval;
11030 Jim_CallFrame *savedFramePtr = interp->framePtr;
11032 interp->framePtr = interp->topFramePtr;
11033 retval = Jim_EvalFile(interp, filename);
11034 interp->framePtr = savedFramePtr;
11036 return retval;
11039 #include <sys/stat.h>
11041 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
11043 FILE *fp;
11044 char *buf;
11045 Jim_Obj *scriptObjPtr;
11046 Jim_Obj *prevScriptObj;
11047 struct stat sb;
11048 int retcode;
11049 int readlen;
11051 if (stat(filename, &sb) != 0 || (fp = fopen(filename, "rt")) == NULL) {
11052 Jim_SetResultFormatted(interp, "couldn't read file \"%s\": %s", filename, strerror(errno));
11053 return JIM_ERR;
11055 if (sb.st_size == 0) {
11056 fclose(fp);
11057 return JIM_OK;
11060 buf = Jim_Alloc(sb.st_size + 1);
11061 readlen = fread(buf, 1, sb.st_size, fp);
11062 if (ferror(fp)) {
11063 fclose(fp);
11064 Jim_Free(buf);
11065 Jim_SetResultFormatted(interp, "failed to load file \"%s\": %s", filename, strerror(errno));
11066 return JIM_ERR;
11068 fclose(fp);
11069 buf[readlen] = 0;
11071 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, buf, readlen);
11072 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), 1);
11073 Jim_IncrRefCount(scriptObjPtr);
11075 prevScriptObj = interp->currentScriptObj;
11076 interp->currentScriptObj = scriptObjPtr;
11078 retcode = Jim_EvalObj(interp, scriptObjPtr);
11080 /* Handle the JIM_RETURN return code */
11081 if (retcode == JIM_RETURN) {
11082 if (--interp->returnLevel <= 0) {
11083 retcode = interp->returnCode;
11084 interp->returnCode = JIM_OK;
11085 interp->returnLevel = 0;
11088 if (retcode == JIM_ERR) {
11089 /* EvalFile changes context, so add a stack frame here */
11090 interp->addStackTrace++;
11093 interp->currentScriptObj = prevScriptObj;
11095 Jim_DecrRefCount(interp, scriptObjPtr);
11097 return retcode;
11100 /* -----------------------------------------------------------------------------
11101 * Subst
11102 * ---------------------------------------------------------------------------*/
11103 static void JimParseSubst(struct JimParserCtx *pc, int flags)
11105 pc->tstart = pc->p;
11106 pc->tline = pc->linenr;
11108 if (pc->len == 0) {
11109 pc->tend = pc->p;
11110 pc->tt = JIM_TT_EOL;
11111 pc->eof = 1;
11112 return;
11114 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11115 JimParseCmd(pc);
11116 return;
11118 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11119 if (JimParseVar(pc) == JIM_OK) {
11120 return;
11122 /* Not a var, so treat as a string */
11123 pc->tstart = pc->p;
11124 flags |= JIM_SUBST_NOVAR;
11126 while (pc->len) {
11127 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11128 break;
11130 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11131 break;
11133 if (*pc->p == '\\' && pc->len > 1) {
11134 pc->p++;
11135 pc->len--;
11137 pc->p++;
11138 pc->len--;
11140 pc->tend = pc->p - 1;
11141 pc->tt = (flags & JIM_SUBST_NOESC) ? JIM_TT_STR : JIM_TT_ESC;
11144 /* The subst object type reuses most of the data structures and functions
11145 * of the script object. Script's data structures are a bit more complex
11146 * for what is needed for [subst]itution tasks, but the reuse helps to
11147 * deal with a single data structure at the cost of some more memory
11148 * usage for substitutions. */
11150 /* This method takes the string representation of an object
11151 * as a Tcl string where to perform [subst]itution, and generates
11152 * the pre-parsed internal representation. */
11153 static int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
11155 int scriptTextLen;
11156 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
11157 struct JimParserCtx parser;
11158 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
11159 ParseTokenList tokenlist;
11161 /* Initially parse the subst into tokens (in tokenlist) */
11162 ScriptTokenListInit(&tokenlist);
11164 JimParserInit(&parser, scriptText, scriptTextLen, 1);
11165 while (1) {
11166 JimParseSubst(&parser, flags);
11167 if (parser.eof) {
11168 /* Note that subst doesn't need the EOL token */
11169 break;
11171 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
11172 parser.tline);
11175 /* Create the "real" subst/script tokens from the initial token list */
11176 script->inUse = 1;
11177 script->substFlags = flags;
11178 script->fileNameObj = interp->emptyObj;
11179 Jim_IncrRefCount(script->fileNameObj);
11180 SubstObjAddTokens(interp, script, &tokenlist);
11182 /* No longer need the token list */
11183 ScriptTokenListFree(&tokenlist);
11185 #ifdef DEBUG_SHOW_SUBST
11187 int i;
11189 printf("==== Subst ====\n");
11190 for (i = 0; i < script->len; i++) {
11191 printf("[%2d] %s '%s'\n", i, jim_tt_name(script->token[i].type),
11192 Jim_String(script->token[i].objPtr));
11195 #endif
11197 /* Free the old internal rep and set the new one. */
11198 Jim_FreeIntRep(interp, objPtr);
11199 Jim_SetIntRepPtr(objPtr, script);
11200 objPtr->typePtr = &scriptObjType;
11201 return JIM_OK;
11204 static ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
11206 if (objPtr->typePtr != &scriptObjType || ((ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags != flags)
11207 SetSubstFromAny(interp, objPtr, flags);
11208 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
11211 /* Performs commands,variables,blackslashes substitution,
11212 * storing the result object (with refcount 0) into
11213 * resObjPtrPtr. */
11214 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr, Jim_Obj **resObjPtrPtr, int flags)
11216 ScriptObj *script;
11218 JimPanic((substObjPtr->refCount == 0, "Jim_SubstObj() called with zero refcount object"));
11220 script = Jim_GetSubst(interp, substObjPtr, flags);
11222 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
11223 /* In order to preserve the internal rep, we increment the
11224 * inUse field of the script internal rep structure. */
11225 script->inUse++;
11227 *resObjPtrPtr = JimInterpolateTokens(interp, script->token, script->len, flags);
11229 script->inUse--;
11230 Jim_DecrRefCount(interp, substObjPtr);
11231 if (*resObjPtrPtr == NULL) {
11232 return JIM_ERR;
11234 return JIM_OK;
11237 /* -----------------------------------------------------------------------------
11238 * Core commands utility functions
11239 * ---------------------------------------------------------------------------*/
11240 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv, const char *msg)
11242 Jim_Obj *objPtr;
11243 Jim_Obj *listObjPtr;
11245 JimPanic((argc == 0, "Jim_WrongNumArgs() called with argc=0"));
11247 listObjPtr = Jim_NewListObj(interp, argv, argc);
11249 if (msg && *msg) {
11250 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, msg, -1));
11252 Jim_IncrRefCount(listObjPtr);
11253 objPtr = Jim_ListJoin(interp, listObjPtr, " ", 1);
11254 Jim_DecrRefCount(interp, listObjPtr);
11256 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s\"", objPtr);
11260 * May add the key and/or value to the list.
11262 typedef void JimHashtableIteratorCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr,
11263 Jim_HashEntry *he, int type);
11265 #define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL)
11268 * For each key of the hash table 'ht' with object keys that
11269 * matches the glob pattern (all if NULL), invoke the callback to add entries to a list.
11270 * Returns the list.
11272 static Jim_Obj *JimHashtablePatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
11273 JimHashtableIteratorCallbackType *callback, int type)
11275 Jim_HashEntry *he;
11276 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
11278 /* Check for the non-pattern case. We can do this much more efficiently. */
11279 if (patternObjPtr && JimTrivialMatch(Jim_String(patternObjPtr))) {
11280 he = Jim_FindHashEntry(ht, patternObjPtr);
11281 if (he) {
11282 callback(interp, listObjPtr, he, type);
11285 else {
11286 Jim_HashTableIterator htiter;
11287 JimInitHashTableIterator(ht, &htiter);
11288 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
11289 if (!patternObjPtr || Jim_StringMatchObj(interp, patternObjPtr, he->key, 0)) {
11290 callback(interp, listObjPtr, he, type);
11294 return listObjPtr;
11297 /* Keep these in order */
11298 #define JIM_CMDLIST_COMMANDS 0
11299 #define JIM_CMDLIST_PROCS 1
11300 #define JIM_CMDLIST_CHANNELS 2
11303 * Adds matching command names (procs, channels) to the list.
11305 static void JimCommandMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11306 Jim_HashEntry *he, int type)
11308 Jim_Cmd *cmdPtr = Jim_GetHashEntryVal(he);
11309 Jim_Obj *objPtr;
11311 if (type == JIM_CMDLIST_PROCS && !cmdPtr->isproc) {
11312 /* not a proc */
11313 return;
11316 objPtr = (Jim_Obj *)he->key;
11317 Jim_IncrRefCount(objPtr);
11319 if (type != JIM_CMDLIST_CHANNELS || Jim_AioFilehandle(interp, objPtr)) {
11320 Jim_ListAppendElement(interp, listObjPtr, objPtr);
11322 Jim_DecrRefCount(interp, objPtr);
11325 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int type)
11327 return JimHashtablePatternMatch(interp, &interp->commands, patternObjPtr, JimCommandMatch, type);
11330 /* Keep these in order */
11331 #define JIM_VARLIST_GLOBALS 0
11332 #define JIM_VARLIST_LOCALS 1
11333 #define JIM_VARLIST_VARS 2
11334 #define JIM_VARLIST_MASK 0x000f
11336 #define JIM_VARLIST_VALUES 0x1000
11339 * Adds matching variable names to the list.
11341 static void JimVariablesMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11342 Jim_HashEntry *he, int type)
11344 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
11346 if ((type & JIM_VARLIST_MASK) != JIM_VARLIST_LOCALS || varPtr->linkFramePtr == NULL) {
11347 Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->key);
11348 if (type & JIM_VARLIST_VALUES) {
11349 Jim_ListAppendElement(interp, listObjPtr, varPtr->objPtr);
11354 /* mode is JIM_VARLIST_xxx */
11355 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int mode)
11357 if (mode == JIM_VARLIST_LOCALS && interp->framePtr == interp->topFramePtr) {
11358 /* For [info locals], if we are at top level an empty list
11359 * is returned. I don't agree, but we aim at compatibility (SS) */
11360 return interp->emptyObj;
11362 else {
11363 Jim_CallFrame *framePtr = (mode == JIM_VARLIST_GLOBALS) ? interp->topFramePtr : interp->framePtr;
11364 return JimHashtablePatternMatch(interp, &framePtr->vars, patternObjPtr, JimVariablesMatch,
11365 mode);
11369 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
11370 Jim_Obj **objPtrPtr, int info_level_cmd)
11372 Jim_CallFrame *targetCallFrame;
11374 targetCallFrame = JimGetCallFrameByInteger(interp, levelObjPtr);
11375 if (targetCallFrame == NULL) {
11376 return JIM_ERR;
11378 /* No proc call at toplevel callframe */
11379 if (targetCallFrame == interp->topFramePtr) {
11380 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
11381 return JIM_ERR;
11383 if (info_level_cmd) {
11384 *objPtrPtr = Jim_NewListObj(interp, targetCallFrame->argv, targetCallFrame->argc);
11386 else {
11387 Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0);
11389 Jim_ListAppendElement(interp, listObj, targetCallFrame->argv[0]);
11390 Jim_ListAppendElement(interp, listObj, targetCallFrame->fileNameObj);
11391 Jim_ListAppendElement(interp, listObj, Jim_NewIntObj(interp, targetCallFrame->line));
11392 *objPtrPtr = listObj;
11394 return JIM_OK;
11397 /* -----------------------------------------------------------------------------
11398 * Core commands
11399 * ---------------------------------------------------------------------------*/
11401 /* fake [puts] -- not the real puts, just for debugging. */
11402 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11404 if (argc != 2 && argc != 3) {
11405 Jim_WrongNumArgs(interp, 1, argv, "?-nonewline? string");
11406 return JIM_ERR;
11408 if (argc == 3) {
11409 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline")) {
11410 Jim_SetResultString(interp, "The second argument must " "be -nonewline", -1);
11411 return JIM_ERR;
11413 else {
11414 fputs(Jim_String(argv[2]), stdout);
11417 else {
11418 puts(Jim_String(argv[1]));
11420 return JIM_OK;
11423 /* Helper for [+] and [*] */
11424 static int JimAddMulHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11426 jim_wide wideValue, res;
11427 double doubleValue, doubleRes;
11428 int i;
11430 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
11432 for (i = 1; i < argc; i++) {
11433 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
11434 goto trydouble;
11435 if (op == JIM_EXPROP_ADD)
11436 res += wideValue;
11437 else
11438 res *= wideValue;
11440 Jim_SetResultInt(interp, res);
11441 return JIM_OK;
11442 trydouble:
11443 doubleRes = (double)res;
11444 for (; i < argc; i++) {
11445 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11446 return JIM_ERR;
11447 if (op == JIM_EXPROP_ADD)
11448 doubleRes += doubleValue;
11449 else
11450 doubleRes *= doubleValue;
11452 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11453 return JIM_OK;
11456 /* Helper for [-] and [/] */
11457 static int JimSubDivHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11459 jim_wide wideValue, res = 0;
11460 double doubleValue, doubleRes = 0;
11461 int i = 2;
11463 if (argc < 2) {
11464 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
11465 return JIM_ERR;
11467 else if (argc == 2) {
11468 /* The arity = 2 case is different. For [- x] returns -x,
11469 * while [/ x] returns 1/x. */
11470 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
11471 if (Jim_GetDouble(interp, argv[1], &doubleValue) != JIM_OK) {
11472 return JIM_ERR;
11474 else {
11475 if (op == JIM_EXPROP_SUB)
11476 doubleRes = -doubleValue;
11477 else
11478 doubleRes = 1.0 / doubleValue;
11479 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11480 return JIM_OK;
11483 if (op == JIM_EXPROP_SUB) {
11484 res = -wideValue;
11485 Jim_SetResultInt(interp, res);
11487 else {
11488 doubleRes = 1.0 / wideValue;
11489 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11491 return JIM_OK;
11493 else {
11494 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
11495 if (Jim_GetDouble(interp, argv[1], &doubleRes)
11496 != JIM_OK) {
11497 return JIM_ERR;
11499 else {
11500 goto trydouble;
11504 for (i = 2; i < argc; i++) {
11505 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
11506 doubleRes = (double)res;
11507 goto trydouble;
11509 if (op == JIM_EXPROP_SUB)
11510 res -= wideValue;
11511 else {
11512 if (wideValue == 0) {
11513 Jim_SetResultString(interp, "Division by zero", -1);
11514 return JIM_ERR;
11516 res /= wideValue;
11519 Jim_SetResultInt(interp, res);
11520 return JIM_OK;
11521 trydouble:
11522 for (; i < argc; i++) {
11523 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11524 return JIM_ERR;
11525 if (op == JIM_EXPROP_SUB)
11526 doubleRes -= doubleValue;
11527 else
11528 doubleRes /= doubleValue;
11530 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11531 return JIM_OK;
11535 /* [+] */
11536 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11538 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
11541 /* [*] */
11542 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11544 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
11547 /* [-] */
11548 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11550 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
11553 /* [/] */
11554 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11556 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
11559 /* [set] */
11560 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11562 if (argc != 2 && argc != 3) {
11563 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
11564 return JIM_ERR;
11566 if (argc == 2) {
11567 Jim_Obj *objPtr;
11569 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11570 if (!objPtr)
11571 return JIM_ERR;
11572 Jim_SetResult(interp, objPtr);
11573 return JIM_OK;
11575 /* argc == 3 case. */
11576 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
11577 return JIM_ERR;
11578 Jim_SetResult(interp, argv[2]);
11579 return JIM_OK;
11582 /* [unset]
11584 * unset ?-nocomplain? ?--? ?varName ...?
11586 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11588 int i = 1;
11589 int complain = 1;
11591 while (i < argc) {
11592 if (Jim_CompareStringImmediate(interp, argv[i], "--")) {
11593 i++;
11594 break;
11596 if (Jim_CompareStringImmediate(interp, argv[i], "-nocomplain")) {
11597 complain = 0;
11598 i++;
11599 continue;
11601 break;
11604 while (i < argc) {
11605 if (Jim_UnsetVariable(interp, argv[i], complain ? JIM_ERRMSG : JIM_NONE) != JIM_OK
11606 && complain) {
11607 return JIM_ERR;
11609 i++;
11611 return JIM_OK;
11614 /* [while] */
11615 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11617 if (argc != 3) {
11618 Jim_WrongNumArgs(interp, 1, argv, "condition body");
11619 return JIM_ERR;
11622 /* The general purpose implementation of while starts here */
11623 while (1) {
11624 int boolean, retval;
11626 if ((retval = Jim_GetBoolFromExpr(interp, argv[1], &boolean)) != JIM_OK)
11627 return retval;
11628 if (!boolean)
11629 break;
11631 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
11632 switch (retval) {
11633 case JIM_BREAK:
11634 goto out;
11635 break;
11636 case JIM_CONTINUE:
11637 continue;
11638 break;
11639 default:
11640 return retval;
11644 out:
11645 Jim_SetEmptyResult(interp);
11646 return JIM_OK;
11649 /* [for] */
11650 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11652 int retval;
11653 int boolean = 1;
11654 Jim_Obj *varNamePtr = NULL;
11655 Jim_Obj *stopVarNamePtr = NULL;
11657 if (argc != 5) {
11658 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
11659 return JIM_ERR;
11662 /* Do the initialisation */
11663 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK) {
11664 return retval;
11667 /* And do the first test now. Better for optimisation
11668 * if we can do next/test at the bottom of the loop
11670 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11672 /* Ready to do the body as follows:
11673 * while (1) {
11674 * body // check retcode
11675 * next // check retcode
11676 * test // check retcode/test bool
11680 #ifdef JIM_OPTIMIZATION
11681 /* Check if the for is on the form:
11682 * for ... {$i < CONST} {incr i}
11683 * for ... {$i < $j} {incr i}
11685 if (retval == JIM_OK && boolean) {
11686 ScriptObj *incrScript;
11687 struct ExprTree *expr;
11688 jim_wide stop, currentVal;
11689 Jim_Obj *objPtr;
11690 int cmpOffset;
11692 /* Do it only if there aren't shared arguments */
11693 expr = JimGetExpression(interp, argv[2]);
11694 incrScript = JimGetScript(interp, argv[3]);
11696 /* Ensure proper lengths to start */
11697 if (incrScript == NULL || incrScript->len != 3 || !expr || expr->len != 3) {
11698 goto evalstart;
11700 /* Ensure proper token types. */
11701 if (incrScript->token[1].type != JIM_TT_ESC) {
11702 goto evalstart;
11705 if (expr->expr->type == JIM_EXPROP_LT) {
11706 cmpOffset = 0;
11708 else if (expr->expr->type == JIM_EXPROP_LTE) {
11709 cmpOffset = 1;
11711 else {
11712 goto evalstart;
11715 if (expr->expr->left->type != JIM_TT_VAR) {
11716 goto evalstart;
11719 if (expr->expr->right->type != JIM_TT_VAR && expr->expr->right->type != JIM_TT_EXPR_INT) {
11720 goto evalstart;
11723 /* Update command must be incr */
11724 if (!Jim_CompareStringImmediate(interp, incrScript->token[1].objPtr, "incr")) {
11725 goto evalstart;
11728 /* incr, expression must be about the same variable */
11729 if (!Jim_StringEqObj(incrScript->token[2].objPtr, expr->expr->left->objPtr)) {
11730 goto evalstart;
11733 /* Get the stop condition (must be a variable or integer) */
11734 if (expr->expr->right->type == JIM_TT_EXPR_INT) {
11735 if (Jim_GetWide(interp, expr->expr->right->objPtr, &stop) == JIM_ERR) {
11736 goto evalstart;
11739 else {
11740 stopVarNamePtr = expr->expr->right->objPtr;
11741 Jim_IncrRefCount(stopVarNamePtr);
11742 /* Keep the compiler happy */
11743 stop = 0;
11746 /* Initialization */
11747 varNamePtr = expr->expr->left->objPtr;
11748 Jim_IncrRefCount(varNamePtr);
11750 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
11751 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK) {
11752 goto testcond;
11755 /* --- OPTIMIZED FOR --- */
11756 while (retval == JIM_OK) {
11757 /* === Check condition === */
11758 /* Note that currentVal is already set here */
11760 /* Immediate or Variable? get the 'stop' value if the latter. */
11761 if (stopVarNamePtr) {
11762 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
11763 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &stop) != JIM_OK) {
11764 goto testcond;
11768 if (currentVal >= stop + cmpOffset) {
11769 break;
11772 /* Eval body */
11773 retval = Jim_EvalObj(interp, argv[4]);
11774 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11775 retval = JIM_OK;
11777 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
11779 /* Increment */
11780 if (objPtr == NULL) {
11781 retval = JIM_ERR;
11782 goto out;
11784 if (!Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11785 currentVal = ++JimWideValue(objPtr);
11786 Jim_InvalidateStringRep(objPtr);
11788 else {
11789 if (Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK ||
11790 Jim_SetVariable(interp, varNamePtr, Jim_NewIntObj(interp,
11791 ++currentVal)) != JIM_OK) {
11792 goto evalnext;
11797 goto out;
11799 evalstart:
11800 #endif
11802 while (boolean && (retval == JIM_OK || retval == JIM_CONTINUE)) {
11803 /* Body */
11804 retval = Jim_EvalObj(interp, argv[4]);
11806 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11807 /* increment */
11808 JIM_IF_OPTIM(evalnext:)
11809 retval = Jim_EvalObj(interp, argv[3]);
11810 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11811 /* test */
11812 JIM_IF_OPTIM(testcond:)
11813 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11817 JIM_IF_OPTIM(out:)
11818 if (stopVarNamePtr) {
11819 Jim_DecrRefCount(interp, stopVarNamePtr);
11821 if (varNamePtr) {
11822 Jim_DecrRefCount(interp, varNamePtr);
11825 if (retval == JIM_CONTINUE || retval == JIM_BREAK || retval == JIM_OK) {
11826 Jim_SetEmptyResult(interp);
11827 return JIM_OK;
11830 return retval;
11833 /* [loop] */
11834 static int Jim_LoopCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11836 int retval;
11837 jim_wide i;
11838 jim_wide limit;
11839 jim_wide incr = 1;
11840 Jim_Obj *bodyObjPtr;
11842 if (argc != 5 && argc != 6) {
11843 Jim_WrongNumArgs(interp, 1, argv, "var first limit ?incr? body");
11844 return JIM_ERR;
11847 if (Jim_GetWide(interp, argv[2], &i) != JIM_OK ||
11848 Jim_GetWide(interp, argv[3], &limit) != JIM_OK ||
11849 (argc == 6 && Jim_GetWide(interp, argv[4], &incr) != JIM_OK)) {
11850 return JIM_ERR;
11852 bodyObjPtr = (argc == 5) ? argv[4] : argv[5];
11854 retval = Jim_SetVariable(interp, argv[1], argv[2]);
11856 while (((i < limit && incr > 0) || (i > limit && incr < 0)) && retval == JIM_OK) {
11857 retval = Jim_EvalObj(interp, bodyObjPtr);
11858 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11859 Jim_Obj *objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11861 retval = JIM_OK;
11863 /* Increment */
11864 i += incr;
11866 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11867 if (argv[1]->typePtr != &variableObjType) {
11868 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11869 return JIM_ERR;
11872 JimWideValue(objPtr) = i;
11873 Jim_InvalidateStringRep(objPtr);
11875 /* The following step is required in order to invalidate the
11876 * string repr of "FOO" if the var name is of the form of "FOO(IDX)" */
11877 if (argv[1]->typePtr != &variableObjType) {
11878 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11879 retval = JIM_ERR;
11880 break;
11884 else {
11885 objPtr = Jim_NewIntObj(interp, i);
11886 retval = Jim_SetVariable(interp, argv[1], objPtr);
11887 if (retval != JIM_OK) {
11888 Jim_FreeNewObj(interp, objPtr);
11894 if (retval == JIM_OK || retval == JIM_CONTINUE || retval == JIM_BREAK) {
11895 Jim_SetEmptyResult(interp);
11896 return JIM_OK;
11898 return retval;
11901 /* List iterators make it easy to iterate over a list.
11902 * At some point iterators will be expanded to support generators.
11904 typedef struct {
11905 Jim_Obj *objPtr;
11906 int idx;
11907 } Jim_ListIter;
11910 * Initialise the iterator at the start of the list.
11912 static void JimListIterInit(Jim_ListIter *iter, Jim_Obj *objPtr)
11914 iter->objPtr = objPtr;
11915 iter->idx = 0;
11919 * Returns the next object from the list, or NULL on end-of-list.
11921 static Jim_Obj *JimListIterNext(Jim_Interp *interp, Jim_ListIter *iter)
11923 if (iter->idx >= Jim_ListLength(interp, iter->objPtr)) {
11924 return NULL;
11926 return iter->objPtr->internalRep.listValue.ele[iter->idx++];
11930 * Returns 1 if end-of-list has been reached.
11932 static int JimListIterDone(Jim_Interp *interp, Jim_ListIter *iter)
11934 return iter->idx >= Jim_ListLength(interp, iter->objPtr);
11937 /* foreach + lmap implementation. */
11938 static int JimForeachMapHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int doMap)
11940 int result = JIM_OK;
11941 int i, numargs;
11942 Jim_ListIter twoiters[2]; /* Avoid allocation for a single list */
11943 Jim_ListIter *iters;
11944 Jim_Obj *script;
11945 Jim_Obj *resultObj;
11947 if (argc < 4 || argc % 2 != 0) {
11948 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
11949 return JIM_ERR;
11951 script = argv[argc - 1]; /* Last argument is a script */
11952 numargs = (argc - 1 - 1); /* argc - 'foreach' - script */
11954 if (numargs == 2) {
11955 iters = twoiters;
11957 else {
11958 iters = Jim_Alloc(numargs * sizeof(*iters));
11960 for (i = 0; i < numargs; i++) {
11961 JimListIterInit(&iters[i], argv[i + 1]);
11962 if (i % 2 == 0 && JimListIterDone(interp, &iters[i])) {
11963 result = JIM_ERR;
11966 if (result != JIM_OK) {
11967 Jim_SetResultString(interp, "foreach varlist is empty", -1);
11968 goto empty_varlist;
11971 if (doMap) {
11972 resultObj = Jim_NewListObj(interp, NULL, 0);
11974 else {
11975 resultObj = interp->emptyObj;
11977 Jim_IncrRefCount(resultObj);
11979 while (1) {
11980 /* Have we expired all lists? */
11981 for (i = 0; i < numargs; i += 2) {
11982 if (!JimListIterDone(interp, &iters[i + 1])) {
11983 break;
11986 if (i == numargs) {
11987 /* All done */
11988 break;
11991 /* For each list */
11992 for (i = 0; i < numargs; i += 2) {
11993 Jim_Obj *varName;
11995 /* foreach var */
11996 JimListIterInit(&iters[i], argv[i + 1]);
11997 while ((varName = JimListIterNext(interp, &iters[i])) != NULL) {
11998 Jim_Obj *valObj = JimListIterNext(interp, &iters[i + 1]);
11999 if (!valObj) {
12000 /* Ran out, so store the empty string */
12001 valObj = interp->emptyObj;
12003 /* Avoid shimmering */
12004 Jim_IncrRefCount(valObj);
12005 result = Jim_SetVariable(interp, varName, valObj);
12006 Jim_DecrRefCount(interp, valObj);
12007 if (result != JIM_OK) {
12008 goto err;
12012 switch (result = Jim_EvalObj(interp, script)) {
12013 case JIM_OK:
12014 if (doMap) {
12015 Jim_ListAppendElement(interp, resultObj, interp->result);
12017 break;
12018 case JIM_CONTINUE:
12019 break;
12020 case JIM_BREAK:
12021 goto out;
12022 default:
12023 goto err;
12026 out:
12027 result = JIM_OK;
12028 Jim_SetResult(interp, resultObj);
12029 err:
12030 Jim_DecrRefCount(interp, resultObj);
12031 empty_varlist:
12032 if (numargs > 2) {
12033 Jim_Free(iters);
12035 return result;
12038 /* [foreach] */
12039 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12041 return JimForeachMapHelper(interp, argc, argv, 0);
12044 /* [lmap] */
12045 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12047 return JimForeachMapHelper(interp, argc, argv, 1);
12050 /* [lassign] */
12051 static int Jim_LassignCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12053 int result = JIM_ERR;
12054 int i;
12055 Jim_ListIter iter;
12056 Jim_Obj *resultObj;
12058 if (argc < 2) {
12059 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varName ...?");
12060 return JIM_ERR;
12063 JimListIterInit(&iter, argv[1]);
12065 for (i = 2; i < argc; i++) {
12066 Jim_Obj *valObj = JimListIterNext(interp, &iter);
12067 result = Jim_SetVariable(interp, argv[i], valObj ? valObj : interp->emptyObj);
12068 if (result != JIM_OK) {
12069 return result;
12073 resultObj = Jim_NewListObj(interp, NULL, 0);
12074 while (!JimListIterDone(interp, &iter)) {
12075 Jim_ListAppendElement(interp, resultObj, JimListIterNext(interp, &iter));
12078 Jim_SetResult(interp, resultObj);
12080 return JIM_OK;
12083 /* [if] */
12084 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12086 int boolean, retval, current = 1, falsebody = 0;
12088 if (argc >= 3) {
12089 while (1) {
12090 /* Far not enough arguments given! */
12091 if (current >= argc)
12092 goto err;
12093 if ((retval = Jim_GetBoolFromExpr(interp, argv[current++], &boolean))
12094 != JIM_OK)
12095 return retval;
12096 /* There lacks something, isn't it? */
12097 if (current >= argc)
12098 goto err;
12099 if (Jim_CompareStringImmediate(interp, argv[current], "then"))
12100 current++;
12101 /* Tsk tsk, no then-clause? */
12102 if (current >= argc)
12103 goto err;
12104 if (boolean)
12105 return Jim_EvalObj(interp, argv[current]);
12106 /* Ok: no else-clause follows */
12107 if (++current >= argc) {
12108 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
12109 return JIM_OK;
12111 falsebody = current++;
12112 if (Jim_CompareStringImmediate(interp, argv[falsebody], "else")) {
12113 /* IIICKS - else-clause isn't last cmd? */
12114 if (current != argc - 1)
12115 goto err;
12116 return Jim_EvalObj(interp, argv[current]);
12118 else if (Jim_CompareStringImmediate(interp, argv[falsebody], "elseif"))
12119 /* Ok: elseif follows meaning all the stuff
12120 * again (how boring...) */
12121 continue;
12122 /* OOPS - else-clause is not last cmd? */
12123 else if (falsebody != argc - 1)
12124 goto err;
12125 return Jim_EvalObj(interp, argv[falsebody]);
12127 return JIM_OK;
12129 err:
12130 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
12131 return JIM_ERR;
12135 /* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)
12136 * flags may contain JIM_NOCASE and/or JIM_OPT_END
12138 int Jim_CommandMatchObj(Jim_Interp *interp, Jim_Obj *commandObj, Jim_Obj *patternObj,
12139 Jim_Obj *stringObj, int flags)
12141 Jim_Obj *parms[5];
12142 int argc = 0;
12143 long eq;
12144 int rc;
12146 parms[argc++] = commandObj;
12147 if (flags & JIM_NOCASE) {
12148 parms[argc++] = Jim_NewStringObj(interp, "-nocase", -1);
12150 if (flags & JIM_OPT_END) {
12151 parms[argc++] = Jim_NewStringObj(interp, "--", -1);
12153 parms[argc++] = patternObj;
12154 parms[argc++] = stringObj;
12156 rc = Jim_EvalObjVector(interp, argc, parms);
12158 if (rc != JIM_OK || Jim_GetLong(interp, Jim_GetResult(interp), &eq) != JIM_OK) {
12159 eq = -rc;
12162 return eq;
12165 /* [switch] */
12166 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12168 enum { SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD };
12169 int matchOpt = SWITCH_EXACT, opt = 1, patCount, i;
12170 int match_flags = 0;
12171 Jim_Obj *command = NULL, *scriptObj = NULL, *strObj;
12172 Jim_Obj **caseList;
12174 if (argc < 3) {
12175 wrongnumargs:
12176 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
12177 "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}");
12178 return JIM_ERR;
12180 for (opt = 1; opt < argc; ++opt) {
12181 const char *option = Jim_String(argv[opt]);
12183 if (*option != '-')
12184 break;
12185 else if (strncmp(option, "--", 2) == 0) {
12186 ++opt;
12187 break;
12189 else if (strncmp(option, "-exact", 2) == 0)
12190 matchOpt = SWITCH_EXACT;
12191 else if (strncmp(option, "-glob", 2) == 0)
12192 matchOpt = SWITCH_GLOB;
12193 else if (strncmp(option, "-regexp", 2) == 0) {
12194 matchOpt = SWITCH_RE;
12195 match_flags |= JIM_OPT_END;
12197 else if (strncmp(option, "-command", 2) == 0) {
12198 matchOpt = SWITCH_CMD;
12199 if ((argc - opt) < 2)
12200 goto wrongnumargs;
12201 command = argv[++opt];
12203 else {
12204 Jim_SetResultFormatted(interp,
12205 "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --",
12206 argv[opt]);
12207 return JIM_ERR;
12209 if ((argc - opt) < 2)
12210 goto wrongnumargs;
12212 strObj = argv[opt++];
12213 patCount = argc - opt;
12214 if (patCount == 1) {
12215 JimListGetElements(interp, argv[opt], &patCount, &caseList);
12217 else
12218 caseList = (Jim_Obj **)&argv[opt];
12219 if (patCount == 0 || patCount % 2 != 0)
12220 goto wrongnumargs;
12221 for (i = 0; scriptObj == NULL && i < patCount; i += 2) {
12222 Jim_Obj *patObj = caseList[i];
12224 if (!Jim_CompareStringImmediate(interp, patObj, "default")
12225 || i < (patCount - 2)) {
12226 switch (matchOpt) {
12227 case SWITCH_EXACT:
12228 if (Jim_StringEqObj(strObj, patObj))
12229 scriptObj = caseList[i + 1];
12230 break;
12231 case SWITCH_GLOB:
12232 if (Jim_StringMatchObj(interp, patObj, strObj, 0))
12233 scriptObj = caseList[i + 1];
12234 break;
12235 case SWITCH_RE:
12236 command = Jim_NewStringObj(interp, "regexp", -1);
12237 /* Fall thru intentionally */
12238 case SWITCH_CMD:{
12239 int rc = Jim_CommandMatchObj(interp, command, patObj, strObj, match_flags);
12241 /* After the execution of a command we need to
12242 * make sure to reconvert the object into a list
12243 * again. Only for the single-list style [switch]. */
12244 if (argc - opt == 1) {
12245 JimListGetElements(interp, argv[opt], &patCount, &caseList);
12247 /* command is here already decref'd */
12248 if (rc < 0) {
12249 return -rc;
12251 if (rc)
12252 scriptObj = caseList[i + 1];
12253 break;
12257 else {
12258 scriptObj = caseList[i + 1];
12261 for (; i < patCount && Jim_CompareStringImmediate(interp, scriptObj, "-"); i += 2)
12262 scriptObj = caseList[i + 1];
12263 if (scriptObj && Jim_CompareStringImmediate(interp, scriptObj, "-")) {
12264 Jim_SetResultFormatted(interp, "no body specified for pattern \"%#s\"", caseList[i - 2]);
12265 return JIM_ERR;
12267 Jim_SetEmptyResult(interp);
12268 if (scriptObj) {
12269 return Jim_EvalObj(interp, scriptObj);
12271 return JIM_OK;
12274 /* [list] */
12275 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12277 Jim_Obj *listObjPtr;
12279 listObjPtr = Jim_NewListObj(interp, argv + 1, argc - 1);
12280 Jim_SetResult(interp, listObjPtr);
12281 return JIM_OK;
12284 /* [lindex] */
12285 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12287 Jim_Obj *objPtr, *listObjPtr;
12288 int i;
12289 int idx;
12291 if (argc < 2) {
12292 Jim_WrongNumArgs(interp, 1, argv, "list ?index ...?");
12293 return JIM_ERR;
12295 objPtr = argv[1];
12296 Jim_IncrRefCount(objPtr);
12297 for (i = 2; i < argc; i++) {
12298 listObjPtr = objPtr;
12299 if (Jim_GetIndex(interp, argv[i], &idx) != JIM_OK) {
12300 Jim_DecrRefCount(interp, listObjPtr);
12301 return JIM_ERR;
12303 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_NONE) != JIM_OK) {
12304 /* Returns an empty object if the index
12305 * is out of range. */
12306 Jim_DecrRefCount(interp, listObjPtr);
12307 Jim_SetEmptyResult(interp);
12308 return JIM_OK;
12310 Jim_IncrRefCount(objPtr);
12311 Jim_DecrRefCount(interp, listObjPtr);
12313 Jim_SetResult(interp, objPtr);
12314 Jim_DecrRefCount(interp, objPtr);
12315 return JIM_OK;
12318 /* [llength] */
12319 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12321 if (argc != 2) {
12322 Jim_WrongNumArgs(interp, 1, argv, "list");
12323 return JIM_ERR;
12325 Jim_SetResultInt(interp, Jim_ListLength(interp, argv[1]));
12326 return JIM_OK;
12329 /* [lsearch] */
12330 static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12332 static const char * const options[] = {
12333 "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
12334 NULL
12336 enum
12337 { OPT_BOOL, OPT_NOT, OPT_NOCASE, OPT_EXACT, OPT_GLOB, OPT_REGEXP, OPT_ALL, OPT_INLINE,
12338 OPT_COMMAND };
12339 int i;
12340 int opt_bool = 0;
12341 int opt_not = 0;
12342 int opt_all = 0;
12343 int opt_inline = 0;
12344 int opt_match = OPT_EXACT;
12345 int listlen;
12346 int rc = JIM_OK;
12347 Jim_Obj *listObjPtr = NULL;
12348 Jim_Obj *commandObj = NULL;
12349 int match_flags = 0;
12351 if (argc < 3) {
12352 wrongargs:
12353 Jim_WrongNumArgs(interp, 1, argv,
12354 "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
12355 return JIM_ERR;
12358 for (i = 1; i < argc - 2; i++) {
12359 int option;
12361 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG) != JIM_OK) {
12362 return JIM_ERR;
12364 switch (option) {
12365 case OPT_BOOL:
12366 opt_bool = 1;
12367 opt_inline = 0;
12368 break;
12369 case OPT_NOT:
12370 opt_not = 1;
12371 break;
12372 case OPT_NOCASE:
12373 match_flags |= JIM_NOCASE;
12374 break;
12375 case OPT_INLINE:
12376 opt_inline = 1;
12377 opt_bool = 0;
12378 break;
12379 case OPT_ALL:
12380 opt_all = 1;
12381 break;
12382 case OPT_REGEXP:
12383 opt_match = option;
12384 match_flags |= JIM_OPT_END;
12385 break;
12386 case OPT_COMMAND:
12387 if (i >= argc - 2) {
12388 goto wrongargs;
12390 commandObj = argv[++i];
12391 /* fallthru */
12392 case OPT_EXACT:
12393 case OPT_GLOB:
12394 opt_match = option;
12395 break;
12399 argc -= i;
12400 if (argc < 2) {
12401 goto wrongargs;
12403 argv += i;
12405 if (opt_all) {
12406 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12408 if (opt_match == OPT_REGEXP) {
12409 commandObj = Jim_NewStringObj(interp, "regexp", -1);
12411 if (commandObj) {
12412 Jim_IncrRefCount(commandObj);
12415 listlen = Jim_ListLength(interp, argv[0]);
12416 for (i = 0; i < listlen; i++) {
12417 int eq = 0;
12418 Jim_Obj *objPtr = Jim_ListGetIndex(interp, argv[0], i);
12420 switch (opt_match) {
12421 case OPT_EXACT:
12422 eq = Jim_StringCompareObj(interp, argv[1], objPtr, match_flags) == 0;
12423 break;
12425 case OPT_GLOB:
12426 eq = Jim_StringMatchObj(interp, argv[1], objPtr, match_flags);
12427 break;
12429 case OPT_REGEXP:
12430 case OPT_COMMAND:
12431 eq = Jim_CommandMatchObj(interp, commandObj, argv[1], objPtr, match_flags);
12432 if (eq < 0) {
12433 if (listObjPtr) {
12434 Jim_FreeNewObj(interp, listObjPtr);
12436 rc = JIM_ERR;
12437 goto done;
12439 break;
12442 /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
12443 if (!eq && opt_bool && opt_not && !opt_all) {
12444 continue;
12447 if ((!opt_bool && eq == !opt_not) || (opt_bool && (eq || opt_all))) {
12448 /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
12449 Jim_Obj *resultObj;
12451 if (opt_bool) {
12452 resultObj = Jim_NewIntObj(interp, eq ^ opt_not);
12454 else if (!opt_inline) {
12455 resultObj = Jim_NewIntObj(interp, i);
12457 else {
12458 resultObj = objPtr;
12461 if (opt_all) {
12462 Jim_ListAppendElement(interp, listObjPtr, resultObj);
12464 else {
12465 Jim_SetResult(interp, resultObj);
12466 goto done;
12471 if (opt_all) {
12472 Jim_SetResult(interp, listObjPtr);
12474 else {
12475 /* No match */
12476 if (opt_bool) {
12477 Jim_SetResultBool(interp, opt_not);
12479 else if (!opt_inline) {
12480 Jim_SetResultInt(interp, -1);
12484 done:
12485 if (commandObj) {
12486 Jim_DecrRefCount(interp, commandObj);
12488 return rc;
12491 /* [lappend] */
12492 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12494 Jim_Obj *listObjPtr;
12495 int new_obj = 0;
12496 int i;
12498 if (argc < 2) {
12499 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
12500 return JIM_ERR;
12502 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12503 if (!listObjPtr) {
12504 /* Create the list if it does not exist */
12505 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12506 new_obj = 1;
12508 else if (Jim_IsShared(listObjPtr)) {
12509 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
12510 new_obj = 1;
12512 for (i = 2; i < argc; i++)
12513 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
12514 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
12515 if (new_obj)
12516 Jim_FreeNewObj(interp, listObjPtr);
12517 return JIM_ERR;
12519 Jim_SetResult(interp, listObjPtr);
12520 return JIM_OK;
12523 /* [linsert] */
12524 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12526 int idx, len;
12527 Jim_Obj *listPtr;
12529 if (argc < 3) {
12530 Jim_WrongNumArgs(interp, 1, argv, "list index ?element ...?");
12531 return JIM_ERR;
12533 listPtr = argv[1];
12534 if (Jim_IsShared(listPtr))
12535 listPtr = Jim_DuplicateObj(interp, listPtr);
12536 if (Jim_GetIndex(interp, argv[2], &idx) != JIM_OK)
12537 goto err;
12538 len = Jim_ListLength(interp, listPtr);
12539 if (idx >= len)
12540 idx = len;
12541 else if (idx < 0)
12542 idx = len + idx + 1;
12543 Jim_ListInsertElements(interp, listPtr, idx, argc - 3, &argv[3]);
12544 Jim_SetResult(interp, listPtr);
12545 return JIM_OK;
12546 err:
12547 if (listPtr != argv[1]) {
12548 Jim_FreeNewObj(interp, listPtr);
12550 return JIM_ERR;
12553 /* [lreplace] */
12554 static int Jim_LreplaceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12556 int first, last, len, rangeLen;
12557 Jim_Obj *listObj;
12558 Jim_Obj *newListObj;
12560 if (argc < 4) {
12561 Jim_WrongNumArgs(interp, 1, argv, "list first last ?element ...?");
12562 return JIM_ERR;
12564 if (Jim_GetIndex(interp, argv[2], &first) != JIM_OK ||
12565 Jim_GetIndex(interp, argv[3], &last) != JIM_OK) {
12566 return JIM_ERR;
12569 listObj = argv[1];
12570 len = Jim_ListLength(interp, listObj);
12572 first = JimRelToAbsIndex(len, first);
12573 last = JimRelToAbsIndex(len, last);
12574 JimRelToAbsRange(len, &first, &last, &rangeLen);
12576 /* Now construct a new list which consists of:
12577 * <elements before first> <supplied elements> <elements after last>
12580 /* Trying to replace past the end of the list means end of list
12581 * See TIP #505
12583 if (first > len) {
12584 first = len;
12587 /* Add the first set of elements */
12588 newListObj = Jim_NewListObj(interp, listObj->internalRep.listValue.ele, first);
12590 /* Add supplied elements */
12591 ListInsertElements(newListObj, -1, argc - 4, argv + 4);
12593 /* Add the remaining elements */
12594 ListInsertElements(newListObj, -1, len - first - rangeLen, listObj->internalRep.listValue.ele + first + rangeLen);
12596 Jim_SetResult(interp, newListObj);
12597 return JIM_OK;
12600 /* [lset] */
12601 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12603 if (argc < 3) {
12604 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
12605 return JIM_ERR;
12607 else if (argc == 3) {
12608 /* With no indexes, simply implements [set] */
12609 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
12610 return JIM_ERR;
12611 Jim_SetResult(interp, argv[2]);
12612 return JIM_OK;
12614 return Jim_ListSetIndex(interp, argv[1], argv + 2, argc - 3, argv[argc - 1]);
12617 /* [lsort] */
12618 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
12620 static const char * const options[] = {
12621 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", NULL
12623 enum
12624 { OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_REAL, OPT_INDEX, OPT_UNIQUE };
12625 Jim_Obj *resObj;
12626 int i;
12627 int retCode;
12628 int shared;
12630 struct lsort_info info;
12632 if (argc < 2) {
12633 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
12634 return JIM_ERR;
12637 info.type = JIM_LSORT_ASCII;
12638 info.order = 1;
12639 info.indexed = 0;
12640 info.unique = 0;
12641 info.command = NULL;
12642 info.interp = interp;
12644 for (i = 1; i < (argc - 1); i++) {
12645 int option;
12647 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ENUM_ABBREV | JIM_ERRMSG)
12648 != JIM_OK)
12649 return JIM_ERR;
12650 switch (option) {
12651 case OPT_ASCII:
12652 info.type = JIM_LSORT_ASCII;
12653 break;
12654 case OPT_NOCASE:
12655 info.type = JIM_LSORT_NOCASE;
12656 break;
12657 case OPT_INTEGER:
12658 info.type = JIM_LSORT_INTEGER;
12659 break;
12660 case OPT_REAL:
12661 info.type = JIM_LSORT_REAL;
12662 break;
12663 case OPT_INCREASING:
12664 info.order = 1;
12665 break;
12666 case OPT_DECREASING:
12667 info.order = -1;
12668 break;
12669 case OPT_UNIQUE:
12670 info.unique = 1;
12671 break;
12672 case OPT_COMMAND:
12673 if (i >= (argc - 2)) {
12674 Jim_SetResultString(interp, "\"-command\" option must be followed by comparison command", -1);
12675 return JIM_ERR;
12677 info.type = JIM_LSORT_COMMAND;
12678 info.command = argv[i + 1];
12679 i++;
12680 break;
12681 case OPT_INDEX:
12682 if (i >= (argc - 2)) {
12683 Jim_SetResultString(interp, "\"-index\" option must be followed by list index", -1);
12684 return JIM_ERR;
12686 if (Jim_GetIndex(interp, argv[i + 1], &info.index) != JIM_OK) {
12687 return JIM_ERR;
12689 info.indexed = 1;
12690 i++;
12691 break;
12694 resObj = argv[argc - 1];
12695 if ((shared = Jim_IsShared(resObj)))
12696 resObj = Jim_DuplicateObj(interp, resObj);
12697 retCode = ListSortElements(interp, resObj, &info);
12698 if (retCode == JIM_OK) {
12699 Jim_SetResult(interp, resObj);
12701 else if (shared) {
12702 Jim_FreeNewObj(interp, resObj);
12704 return retCode;
12707 /* [append] */
12708 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12710 Jim_Obj *stringObjPtr;
12711 int i;
12713 if (argc < 2) {
12714 Jim_WrongNumArgs(interp, 1, argv, "varName ?value ...?");
12715 return JIM_ERR;
12717 if (argc == 2) {
12718 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
12719 if (!stringObjPtr)
12720 return JIM_ERR;
12722 else {
12723 int new_obj = 0;
12724 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12725 if (!stringObjPtr) {
12726 /* Create the string if it doesn't exist */
12727 stringObjPtr = Jim_NewEmptyStringObj(interp);
12728 new_obj = 1;
12730 else if (Jim_IsShared(stringObjPtr)) {
12731 new_obj = 1;
12732 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
12734 for (i = 2; i < argc; i++) {
12735 Jim_AppendObj(interp, stringObjPtr, argv[i]);
12737 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
12738 if (new_obj) {
12739 Jim_FreeNewObj(interp, stringObjPtr);
12741 return JIM_ERR;
12744 Jim_SetResult(interp, stringObjPtr);
12745 return JIM_OK;
12748 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12750 * Returns a zero-refcount list describing the expression at 'node'
12752 static Jim_Obj *JimGetExprAsList(Jim_Interp *interp, struct JimExprNode *node)
12754 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
12756 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, jim_tt_name(node->type), -1));
12757 if (TOKEN_IS_EXPR_OP(node->type)) {
12758 if (node->left) {
12759 Jim_ListAppendElement(interp, listObjPtr, JimGetExprAsList(interp, node->left));
12761 if (node->right) {
12762 Jim_ListAppendElement(interp, listObjPtr, JimGetExprAsList(interp, node->right));
12764 if (node->ternary) {
12765 Jim_ListAppendElement(interp, listObjPtr, JimGetExprAsList(interp, node->ternary));
12768 else {
12769 Jim_ListAppendElement(interp, listObjPtr, node->objPtr);
12771 return listObjPtr;
12773 #endif /* JIM_DEBUG_COMMAND && !JIM_BOOTSTRAP */
12775 /* [debug] */
12776 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12777 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12779 static const char * const options[] = {
12780 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
12781 "exprbc", "show",
12782 NULL
12784 enum
12786 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
12787 OPT_EXPRLEN, OPT_EXPRBC, OPT_SHOW,
12789 int option;
12791 if (argc < 2) {
12792 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?...?");
12793 return JIM_ERR;
12795 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK)
12796 return Jim_CheckShowCommands(interp, argv[1], options);
12797 if (option == OPT_REFCOUNT) {
12798 if (argc != 3) {
12799 Jim_WrongNumArgs(interp, 2, argv, "object");
12800 return JIM_ERR;
12802 Jim_SetResultInt(interp, argv[2]->refCount);
12803 return JIM_OK;
12805 else if (option == OPT_OBJCOUNT) {
12806 int freeobj = 0, liveobj = 0;
12807 char buf[256];
12808 Jim_Obj *objPtr;
12810 if (argc != 2) {
12811 Jim_WrongNumArgs(interp, 2, argv, "");
12812 return JIM_ERR;
12814 /* Count the number of free objects. */
12815 objPtr = interp->freeList;
12816 while (objPtr) {
12817 freeobj++;
12818 objPtr = objPtr->nextObjPtr;
12820 /* Count the number of live objects. */
12821 objPtr = interp->liveList;
12822 while (objPtr) {
12823 liveobj++;
12824 objPtr = objPtr->nextObjPtr;
12826 /* Set the result string and return. */
12827 sprintf(buf, "free %d used %d", freeobj, liveobj);
12828 Jim_SetResultString(interp, buf, -1);
12829 return JIM_OK;
12831 else if (option == OPT_OBJECTS) {
12832 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
12834 if (argc != 2) {
12835 Jim_WrongNumArgs(interp, 2, argv, "");
12836 return JIM_ERR;
12839 /* Count the number of live objects. */
12840 objPtr = interp->liveList;
12841 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12842 while (objPtr) {
12843 char buf[128];
12844 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "";
12846 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
12847 sprintf(buf, "%p", objPtr);
12848 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, buf, -1));
12849 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, type, -1));
12850 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewIntObj(interp, objPtr->refCount));
12851 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
12852 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
12853 objPtr = objPtr->nextObjPtr;
12855 Jim_SetResult(interp, listObjPtr);
12856 return JIM_OK;
12858 else if (option == OPT_INVSTR) {
12859 Jim_Obj *objPtr;
12861 if (argc != 3) {
12862 Jim_WrongNumArgs(interp, 2, argv, "object");
12863 return JIM_ERR;
12865 objPtr = argv[2];
12866 if (objPtr->typePtr != NULL)
12867 Jim_InvalidateStringRep(objPtr);
12868 Jim_SetEmptyResult(interp);
12869 return JIM_OK;
12871 else if (option == OPT_SHOW) {
12872 const char *s;
12873 int len, charlen;
12875 if (argc != 3) {
12876 Jim_WrongNumArgs(interp, 2, argv, "object");
12877 return JIM_ERR;
12879 s = Jim_GetString(argv[2], &len);
12880 #ifdef JIM_UTF8
12881 charlen = utf8_strlen(s, len);
12882 #else
12883 charlen = len;
12884 #endif
12885 char buf[256];
12886 snprintf(buf, sizeof(buf), "refcount: %d, type: %s\n"
12887 "chars (%d):",
12888 argv[2]->refCount, JimObjTypeName(argv[2]), charlen);
12889 Jim_SetResultFormatted(interp, "%s <<%s>>\n", buf, s);
12890 snprintf(buf, sizeof(buf), "bytes (%d):", len);
12891 Jim_AppendString(interp, Jim_GetResult(interp), buf, -1);
12892 while (len--) {
12893 snprintf(buf, sizeof(buf), " %02x", (unsigned char)*s++);
12894 Jim_AppendString(interp, Jim_GetResult(interp), buf, -1);
12896 return JIM_OK;
12898 else if (option == OPT_SCRIPTLEN) {
12899 ScriptObj *script;
12901 if (argc != 3) {
12902 Jim_WrongNumArgs(interp, 2, argv, "script");
12903 return JIM_ERR;
12905 script = JimGetScript(interp, argv[2]);
12906 if (script == NULL)
12907 return JIM_ERR;
12908 Jim_SetResultInt(interp, script->len);
12909 return JIM_OK;
12911 else if (option == OPT_EXPRLEN) {
12912 struct ExprTree *expr;
12914 if (argc != 3) {
12915 Jim_WrongNumArgs(interp, 2, argv, "expression");
12916 return JIM_ERR;
12918 expr = JimGetExpression(interp, argv[2]);
12919 if (expr == NULL)
12920 return JIM_ERR;
12921 Jim_SetResultInt(interp, expr->len);
12922 return JIM_OK;
12924 else if (option == OPT_EXPRBC) {
12925 struct ExprTree *expr;
12927 if (argc != 3) {
12928 Jim_WrongNumArgs(interp, 2, argv, "expression");
12929 return JIM_ERR;
12931 expr = JimGetExpression(interp, argv[2]);
12932 if (expr == NULL)
12933 return JIM_ERR;
12934 Jim_SetResult(interp, JimGetExprAsList(interp, expr->expr));
12935 return JIM_OK;
12937 else {
12938 Jim_SetResultString(interp,
12939 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
12940 return JIM_ERR;
12942 /* unreached */
12944 #endif /* JIM_DEBUG_COMMAND && !JIM_BOOTSTRAP */
12946 /* [eval] */
12947 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12949 int rc;
12951 if (argc < 2) {
12952 Jim_WrongNumArgs(interp, 1, argv, "arg ?arg ...?");
12953 return JIM_ERR;
12956 if (argc == 2) {
12957 rc = Jim_EvalObj(interp, argv[1]);
12959 else {
12960 rc = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12963 if (rc == JIM_ERR) {
12964 /* eval is "interesting", so add a stack frame here */
12965 interp->addStackTrace++;
12967 return rc;
12970 /* [uplevel] */
12971 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12973 if (argc >= 2) {
12974 int retcode;
12975 Jim_CallFrame *savedCallFrame, *targetCallFrame;
12976 const char *str;
12978 /* Save the old callframe pointer */
12979 savedCallFrame = interp->framePtr;
12981 /* Lookup the target frame pointer */
12982 str = Jim_String(argv[1]);
12983 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#') {
12984 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
12985 argc--;
12986 argv++;
12988 else {
12989 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
12991 if (targetCallFrame == NULL) {
12992 return JIM_ERR;
12994 if (argc < 2) {
12995 Jim_WrongNumArgs(interp, 1, argv - 1, "?level? command ?arg ...?");
12996 return JIM_ERR;
12998 /* Eval the code in the target callframe. */
12999 interp->framePtr = targetCallFrame;
13000 if (argc == 2) {
13001 retcode = Jim_EvalObj(interp, argv[1]);
13003 else {
13004 retcode = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13006 interp->framePtr = savedCallFrame;
13007 return retcode;
13009 else {
13010 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
13011 return JIM_ERR;
13015 /* [expr] */
13016 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13018 int retcode;
13020 if (argc == 2) {
13021 retcode = Jim_EvalExpression(interp, argv[1]);
13023 else if (argc > 2) {
13024 Jim_Obj *objPtr;
13026 objPtr = Jim_ConcatObj(interp, argc - 1, argv + 1);
13027 Jim_IncrRefCount(objPtr);
13028 retcode = Jim_EvalExpression(interp, objPtr);
13029 Jim_DecrRefCount(interp, objPtr);
13031 else {
13032 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
13033 return JIM_ERR;
13035 if (retcode != JIM_OK)
13036 return retcode;
13037 return JIM_OK;
13040 /* [break] */
13041 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13043 if (argc != 1) {
13044 Jim_WrongNumArgs(interp, 1, argv, "");
13045 return JIM_ERR;
13047 return JIM_BREAK;
13050 /* [continue] */
13051 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13053 if (argc != 1) {
13054 Jim_WrongNumArgs(interp, 1, argv, "");
13055 return JIM_ERR;
13057 return JIM_CONTINUE;
13060 /* [return] */
13061 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13063 int i;
13064 Jim_Obj *stackTraceObj = NULL;
13065 Jim_Obj *errorCodeObj = NULL;
13066 int returnCode = JIM_OK;
13067 long level = 1;
13069 for (i = 1; i < argc - 1; i += 2) {
13070 if (Jim_CompareStringImmediate(interp, argv[i], "-code")) {
13071 if (Jim_GetReturnCode(interp, argv[i + 1], &returnCode) == JIM_ERR) {
13072 return JIM_ERR;
13075 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorinfo")) {
13076 stackTraceObj = argv[i + 1];
13078 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorcode")) {
13079 errorCodeObj = argv[i + 1];
13081 else if (Jim_CompareStringImmediate(interp, argv[i], "-level")) {
13082 if (Jim_GetLong(interp, argv[i + 1], &level) != JIM_OK || level < 0) {
13083 Jim_SetResultFormatted(interp, "bad level \"%#s\"", argv[i + 1]);
13084 return JIM_ERR;
13087 else {
13088 break;
13092 if (i != argc - 1 && i != argc) {
13093 Jim_WrongNumArgs(interp, 1, argv,
13094 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
13097 /* If a stack trace is supplied and code is error, set the stack trace */
13098 if (stackTraceObj && returnCode == JIM_ERR) {
13099 JimSetStackTrace(interp, stackTraceObj);
13101 /* If an error code list is supplied, set the global $errorCode */
13102 if (errorCodeObj && returnCode == JIM_ERR) {
13103 Jim_SetGlobalVariableStr(interp, "errorCode", errorCodeObj);
13105 interp->returnCode = returnCode;
13106 interp->returnLevel = level;
13108 if (i == argc - 1) {
13109 Jim_SetResult(interp, argv[i]);
13111 return level == 0 ? returnCode : JIM_RETURN;
13114 /* [tailcall] */
13115 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13117 if (interp->framePtr->level == 0) {
13118 Jim_SetResultString(interp, "tailcall can only be called from a proc or lambda", -1);
13119 return JIM_ERR;
13121 else if (argc >= 2) {
13122 /* Need to resolve the tailcall command in the current context */
13123 Jim_CallFrame *cf = interp->framePtr->parent;
13125 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13126 if (cmdPtr == NULL) {
13127 return JIM_ERR;
13130 JimPanic((cf->tailcallCmd != NULL, "Already have a tailcallCmd"));
13132 /* And stash this pre-resolved command */
13133 JimIncrCmdRefCount(cmdPtr);
13134 cf->tailcallCmd = cmdPtr;
13136 /* And stash the command list */
13137 JimPanic((cf->tailcallObj != NULL, "Already have a tailcallobj"));
13139 cf->tailcallObj = Jim_NewListObj(interp, argv + 1, argc - 1);
13140 Jim_IncrRefCount(cf->tailcallObj);
13142 /* When the stack unwinds to the previous proc, the stashed command will be evaluated */
13143 return JIM_EVAL;
13145 return JIM_OK;
13148 static int JimAliasCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13150 Jim_Obj *cmdList;
13151 Jim_Obj *prefixListObj = Jim_CmdPrivData(interp);
13153 /* prefixListObj is a list to which the args need to be appended */
13154 cmdList = Jim_DuplicateObj(interp, prefixListObj);
13155 Jim_ListInsertElements(interp, cmdList, Jim_ListLength(interp, cmdList), argc - 1, argv + 1);
13157 return JimEvalObjList(interp, cmdList);
13160 static void JimAliasCmdDelete(Jim_Interp *interp, void *privData)
13162 Jim_Obj *prefixListObj = privData;
13163 Jim_DecrRefCount(interp, prefixListObj);
13166 static int Jim_AliasCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13168 Jim_Obj *prefixListObj;
13170 if (argc < 3) {
13171 Jim_WrongNumArgs(interp, 1, argv, "newname command ?args ...?");
13172 return JIM_ERR;
13175 prefixListObj = Jim_NewListObj(interp, argv + 2, argc - 2);
13176 Jim_IncrRefCount(prefixListObj);
13177 Jim_SetResult(interp, argv[1]);
13179 return Jim_CreateCommandObj(interp, argv[1], JimAliasCmd, prefixListObj, JimAliasCmdDelete);
13182 /* [proc] */
13183 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13185 Jim_Cmd *cmd;
13187 if (argc != 4 && argc != 5) {
13188 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
13189 return JIM_ERR;
13192 if (argc == 4) {
13193 cmd = JimCreateProcedureCmd(interp, argv[2], NULL, argv[3], NULL);
13195 else {
13196 cmd = JimCreateProcedureCmd(interp, argv[2], argv[3], argv[4], NULL);
13199 if (cmd) {
13200 /* Add the new command */
13201 Jim_Obj *nameObjPtr = JimQualifyName(interp, argv[1]);
13202 JimCreateCommand(interp, nameObjPtr, cmd);
13204 /* Calculate and set the namespace for this proc */
13205 JimUpdateProcNamespace(interp, cmd, nameObjPtr);
13206 Jim_DecrRefCount(interp, nameObjPtr);
13208 /* Unlike Tcl, set the name of the proc as the result */
13209 Jim_SetResult(interp, argv[1]);
13210 return JIM_OK;
13212 return JIM_ERR;
13215 /* [local] */
13216 static int Jim_LocalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13218 int retcode;
13220 if (argc < 2) {
13221 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13222 return JIM_ERR;
13225 /* Evaluate the arguments with 'local' in force */
13226 interp->local++;
13227 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13228 interp->local--;
13231 /* If OK, and the result is a proc, add it to the list of local procs */
13232 if (retcode == 0) {
13233 Jim_Obj *cmdNameObj = Jim_GetResult(interp);
13235 if (Jim_GetCommand(interp, cmdNameObj, JIM_ERRMSG) == NULL) {
13236 return JIM_ERR;
13238 if (interp->framePtr->localCommands == NULL) {
13239 interp->framePtr->localCommands = Jim_Alloc(sizeof(*interp->framePtr->localCommands));
13240 Jim_InitStack(interp->framePtr->localCommands);
13242 Jim_IncrRefCount(cmdNameObj);
13243 Jim_StackPush(interp->framePtr->localCommands, cmdNameObj);
13246 return retcode;
13249 /* [upcall] */
13250 static int Jim_UpcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13252 if (argc < 2) {
13253 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13254 return JIM_ERR;
13256 else {
13257 int retcode;
13259 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13260 if (cmdPtr == NULL || !cmdPtr->isproc || !cmdPtr->prevCmd) {
13261 Jim_SetResultFormatted(interp, "no previous command: \"%#s\"", argv[1]);
13262 return JIM_ERR;
13264 /* OK. Mark this command as being in an upcall */
13265 cmdPtr->u.proc.upcall++;
13266 JimIncrCmdRefCount(cmdPtr);
13268 /* Invoke the command as normal */
13269 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13271 /* No longer in an upcall */
13272 cmdPtr->u.proc.upcall--;
13273 JimDecrCmdRefCount(interp, cmdPtr);
13275 return retcode;
13279 /* [apply] */
13280 static int Jim_ApplyCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13282 if (argc < 2) {
13283 Jim_WrongNumArgs(interp, 1, argv, "lambdaExpr ?arg ...?");
13284 return JIM_ERR;
13286 else {
13287 int ret;
13288 Jim_Cmd *cmd;
13289 Jim_Obj *argListObjPtr;
13290 Jim_Obj *bodyObjPtr;
13291 Jim_Obj *nsObj = NULL;
13292 Jim_Obj **nargv;
13294 int len = Jim_ListLength(interp, argv[1]);
13295 if (len != 2 && len != 3) {
13296 Jim_SetResultFormatted(interp, "can't interpret \"%#s\" as a lambda expression", argv[1]);
13297 return JIM_ERR;
13300 if (len == 3) {
13301 #ifdef jim_ext_namespace
13302 /* Note that the namespace is always treated as global */
13303 nsObj = Jim_ListGetIndex(interp, argv[1], 2);
13304 #else
13305 Jim_SetResultString(interp, "namespaces not enabled", -1);
13306 return JIM_ERR;
13307 #endif
13309 argListObjPtr = Jim_ListGetIndex(interp, argv[1], 0);
13310 bodyObjPtr = Jim_ListGetIndex(interp, argv[1], 1);
13312 cmd = JimCreateProcedureCmd(interp, argListObjPtr, NULL, bodyObjPtr, nsObj);
13314 if (cmd) {
13315 /* Create a new argv array with a dummy argv[0], for error messages */
13316 nargv = Jim_Alloc((argc - 2 + 1) * sizeof(*nargv));
13317 nargv[0] = Jim_NewStringObj(interp, "apply lambdaExpr", -1);
13318 Jim_IncrRefCount(nargv[0]);
13319 memcpy(&nargv[1], argv + 2, (argc - 2) * sizeof(*nargv));
13320 ret = JimCallProcedure(interp, cmd, argc - 2 + 1, nargv);
13321 Jim_DecrRefCount(interp, nargv[0]);
13322 Jim_Free(nargv);
13324 JimDecrCmdRefCount(interp, cmd);
13325 return ret;
13327 return JIM_ERR;
13332 /* [concat] */
13333 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13335 Jim_SetResult(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13336 return JIM_OK;
13339 /* [upvar] */
13340 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13342 int i;
13343 Jim_CallFrame *targetCallFrame;
13345 /* Lookup the target frame pointer */
13346 if (argc > 3 && (argc % 2 == 0)) {
13347 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
13348 argc--;
13349 argv++;
13351 else {
13352 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
13354 if (targetCallFrame == NULL) {
13355 return JIM_ERR;
13358 /* Check for arity */
13359 if (argc < 3) {
13360 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
13361 return JIM_ERR;
13364 /* Now... for every other/local couple: */
13365 for (i = 1; i < argc; i += 2) {
13366 if (Jim_SetVariableLink(interp, argv[i + 1], argv[i], targetCallFrame) != JIM_OK)
13367 return JIM_ERR;
13369 return JIM_OK;
13372 /* [global] */
13373 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13375 int i;
13377 if (argc < 2) {
13378 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
13379 return JIM_ERR;
13381 /* Link every var to the toplevel having the same name */
13382 if (interp->framePtr->level == 0)
13383 return JIM_OK; /* global at toplevel... */
13384 for (i = 1; i < argc; i++) {
13385 /* global ::blah does nothing */
13386 const char *name = Jim_String(argv[i]);
13387 if (name[0] != ':' || name[1] != ':') {
13388 if (Jim_SetVariableLink(interp, argv[i], argv[i], interp->topFramePtr) != JIM_OK)
13389 return JIM_ERR;
13392 return JIM_OK;
13395 /* does the [string map] operation. On error NULL is returned,
13396 * otherwise a new string object with the result, having refcount = 0,
13397 * is returned. */
13398 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
13399 Jim_Obj *objPtr, int nocase)
13401 int numMaps;
13402 const char *str, *noMatchStart = NULL;
13403 int strLen, i;
13404 Jim_Obj *resultObjPtr;
13406 numMaps = Jim_ListLength(interp, mapListObjPtr);
13407 if (numMaps % 2) {
13408 Jim_SetResultString(interp, "list must contain an even number of elements", -1);
13409 return NULL;
13412 str = Jim_String(objPtr);
13413 strLen = Jim_Utf8Length(interp, objPtr);
13415 /* Map it */
13416 resultObjPtr = Jim_NewStringObj(interp, "", 0);
13417 while (strLen) {
13418 for (i = 0; i < numMaps; i += 2) {
13419 Jim_Obj *eachObjPtr;
13420 const char *k;
13421 int kl;
13423 eachObjPtr = Jim_ListGetIndex(interp, mapListObjPtr, i);
13424 k = Jim_String(eachObjPtr);
13425 kl = Jim_Utf8Length(interp, eachObjPtr);
13427 if (strLen >= kl && kl) {
13428 int rc;
13429 rc = JimStringCompareUtf8(str, kl, k, kl, nocase);
13430 if (rc == 0) {
13431 if (noMatchStart) {
13432 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13433 noMatchStart = NULL;
13435 Jim_AppendObj(interp, resultObjPtr, Jim_ListGetIndex(interp, mapListObjPtr, i + 1));
13436 str += utf8_index(str, kl);
13437 strLen -= kl;
13438 break;
13442 if (i == numMaps) { /* no match */
13443 int c;
13444 if (noMatchStart == NULL)
13445 noMatchStart = str;
13446 str += utf8_tounicode(str, &c);
13447 strLen--;
13450 if (noMatchStart) {
13451 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13453 return resultObjPtr;
13456 /* [string] */
13457 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13459 int len;
13460 int opt_case = 1;
13461 int option;
13462 static const char * const options[] = {
13463 "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "replace",
13464 "map", "repeat", "reverse", "index", "first", "last", "cat",
13465 "trim", "trimleft", "trimright", "tolower", "toupper", "totitle", NULL
13467 enum
13469 OPT_BYTELENGTH, OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_IS, OPT_BYTERANGE, OPT_RANGE, OPT_REPLACE,
13470 OPT_MAP, OPT_REPEAT, OPT_REVERSE, OPT_INDEX, OPT_FIRST, OPT_LAST, OPT_CAT,
13471 OPT_TRIM, OPT_TRIMLEFT, OPT_TRIMRIGHT, OPT_TOLOWER, OPT_TOUPPER, OPT_TOTITLE
13473 static const char * const nocase_options[] = {
13474 "-nocase", NULL
13476 static const char * const nocase_length_options[] = {
13477 "-nocase", "-length", NULL
13480 if (argc < 2) {
13481 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
13482 return JIM_ERR;
13484 if (Jim_GetEnum(interp, argv[1], options, &option, NULL,
13485 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK)
13486 return Jim_CheckShowCommands(interp, argv[1], options);
13488 switch (option) {
13489 case OPT_LENGTH:
13490 case OPT_BYTELENGTH:
13491 if (argc != 3) {
13492 Jim_WrongNumArgs(interp, 2, argv, "string");
13493 return JIM_ERR;
13495 if (option == OPT_LENGTH) {
13496 len = Jim_Utf8Length(interp, argv[2]);
13498 else {
13499 len = Jim_Length(argv[2]);
13501 Jim_SetResultInt(interp, len);
13502 return JIM_OK;
13504 case OPT_CAT:{
13505 Jim_Obj *objPtr;
13506 if (argc == 3) {
13507 /* optimise the one-arg case */
13508 objPtr = argv[2];
13510 else {
13511 int i;
13513 objPtr = Jim_NewStringObj(interp, "", 0);
13515 for (i = 2; i < argc; i++) {
13516 Jim_AppendObj(interp, objPtr, argv[i]);
13519 Jim_SetResult(interp, objPtr);
13520 return JIM_OK;
13523 case OPT_COMPARE:
13524 case OPT_EQUAL:
13526 /* n is the number of remaining option args */
13527 long opt_length = -1;
13528 int n = argc - 4;
13529 int i = 2;
13530 while (n > 0) {
13531 int subopt;
13532 if (Jim_GetEnum(interp, argv[i++], nocase_length_options, &subopt, NULL,
13533 JIM_ENUM_ABBREV) != JIM_OK) {
13534 badcompareargs:
13535 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? ?-length int? string1 string2");
13536 return JIM_ERR;
13538 if (subopt == 0) {
13539 /* -nocase */
13540 opt_case = 0;
13541 n--;
13543 else {
13544 /* -length */
13545 if (n < 2) {
13546 goto badcompareargs;
13548 if (Jim_GetLong(interp, argv[i++], &opt_length) != JIM_OK) {
13549 return JIM_ERR;
13551 n -= 2;
13554 if (n) {
13555 goto badcompareargs;
13557 argv += argc - 2;
13558 if (opt_length < 0 && option != OPT_COMPARE && opt_case) {
13559 /* Fast version - [string equal], case sensitive, no length */
13560 Jim_SetResultBool(interp, Jim_StringEqObj(argv[0], argv[1]));
13562 else {
13563 const char *s1 = Jim_String(argv[0]);
13564 int l1 = Jim_Utf8Length(interp, argv[0]);
13565 const char *s2 = Jim_String(argv[1]);
13566 int l2 = Jim_Utf8Length(interp, argv[1]);
13567 if (opt_length >= 0) {
13568 if (l1 > opt_length) {
13569 l1 = opt_length;
13571 if (l2 > opt_length) {
13572 l2 = opt_length;
13575 n = JimStringCompareUtf8(s1, l1, s2, l2, !opt_case);
13576 Jim_SetResultInt(interp, option == OPT_COMPARE ? n : n == 0);
13578 return JIM_OK;
13581 case OPT_MATCH:
13582 if (argc != 4 &&
13583 (argc != 5 ||
13584 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13585 JIM_ENUM_ABBREV) != JIM_OK)) {
13586 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern string");
13587 return JIM_ERR;
13589 if (opt_case == 0) {
13590 argv++;
13592 Jim_SetResultBool(interp, Jim_StringMatchObj(interp, argv[2], argv[3], !opt_case));
13593 return JIM_OK;
13595 case OPT_MAP:{
13596 Jim_Obj *objPtr;
13598 if (argc != 4 &&
13599 (argc != 5 ||
13600 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13601 JIM_ENUM_ABBREV) != JIM_OK)) {
13602 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList string");
13603 return JIM_ERR;
13606 if (opt_case == 0) {
13607 argv++;
13609 objPtr = JimStringMap(interp, argv[2], argv[3], !opt_case);
13610 if (objPtr == NULL) {
13611 return JIM_ERR;
13613 Jim_SetResult(interp, objPtr);
13614 return JIM_OK;
13617 case OPT_RANGE:
13618 case OPT_BYTERANGE:{
13619 Jim_Obj *objPtr;
13621 if (argc != 5) {
13622 Jim_WrongNumArgs(interp, 2, argv, "string first last");
13623 return JIM_ERR;
13625 if (option == OPT_RANGE) {
13626 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
13628 else
13630 objPtr = Jim_StringByteRangeObj(interp, argv[2], argv[3], argv[4]);
13633 if (objPtr == NULL) {
13634 return JIM_ERR;
13636 Jim_SetResult(interp, objPtr);
13637 return JIM_OK;
13640 case OPT_REPLACE:{
13641 Jim_Obj *objPtr;
13643 if (argc != 5 && argc != 6) {
13644 Jim_WrongNumArgs(interp, 2, argv, "string first last ?string?");
13645 return JIM_ERR;
13647 objPtr = JimStringReplaceObj(interp, argv[2], argv[3], argv[4], argc == 6 ? argv[5] : NULL);
13648 if (objPtr == NULL) {
13649 return JIM_ERR;
13651 Jim_SetResult(interp, objPtr);
13652 return JIM_OK;
13656 case OPT_REPEAT:{
13657 Jim_Obj *objPtr;
13658 jim_wide count;
13660 if (argc != 4) {
13661 Jim_WrongNumArgs(interp, 2, argv, "string count");
13662 return JIM_ERR;
13664 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK) {
13665 return JIM_ERR;
13667 objPtr = Jim_NewStringObj(interp, "", 0);
13668 if (count > 0) {
13669 while (count--) {
13670 Jim_AppendObj(interp, objPtr, argv[2]);
13673 Jim_SetResult(interp, objPtr);
13674 return JIM_OK;
13677 case OPT_REVERSE:{
13678 char *buf, *p;
13679 const char *str;
13680 int i;
13682 if (argc != 3) {
13683 Jim_WrongNumArgs(interp, 2, argv, "string");
13684 return JIM_ERR;
13687 str = Jim_GetString(argv[2], &len);
13688 buf = Jim_Alloc(len + 1);
13689 p = buf + len;
13690 *p = 0;
13691 for (i = 0; i < len; ) {
13692 int c;
13693 int l = utf8_tounicode(str, &c);
13694 memcpy(p - l, str, l);
13695 p -= l;
13696 i += l;
13697 str += l;
13699 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
13700 return JIM_OK;
13703 case OPT_INDEX:{
13704 int idx;
13705 const char *str;
13707 if (argc != 4) {
13708 Jim_WrongNumArgs(interp, 2, argv, "string index");
13709 return JIM_ERR;
13711 if (Jim_GetIndex(interp, argv[3], &idx) != JIM_OK) {
13712 return JIM_ERR;
13714 str = Jim_String(argv[2]);
13715 len = Jim_Utf8Length(interp, argv[2]);
13716 if (idx != INT_MIN && idx != INT_MAX) {
13717 idx = JimRelToAbsIndex(len, idx);
13719 if (idx < 0 || idx >= len || str == NULL) {
13720 Jim_SetResultString(interp, "", 0);
13722 else if (len == Jim_Length(argv[2])) {
13723 /* ASCII optimisation */
13724 Jim_SetResultString(interp, str + idx, 1);
13726 else {
13727 int c;
13728 int i = utf8_index(str, idx);
13729 Jim_SetResultString(interp, str + i, utf8_tounicode(str + i, &c));
13731 return JIM_OK;
13734 case OPT_FIRST:
13735 case OPT_LAST:{
13736 int idx = 0, l1, l2;
13737 const char *s1, *s2;
13739 if (argc != 4 && argc != 5) {
13740 Jim_WrongNumArgs(interp, 2, argv, "subString string ?index?");
13741 return JIM_ERR;
13743 s1 = Jim_String(argv[2]);
13744 s2 = Jim_String(argv[3]);
13745 l1 = Jim_Utf8Length(interp, argv[2]);
13746 l2 = Jim_Utf8Length(interp, argv[3]);
13747 if (argc == 5) {
13748 if (Jim_GetIndex(interp, argv[4], &idx) != JIM_OK) {
13749 return JIM_ERR;
13751 idx = JimRelToAbsIndex(l2, idx);
13753 else if (option == OPT_LAST) {
13754 idx = l2;
13756 if (option == OPT_FIRST) {
13757 Jim_SetResultInt(interp, JimStringFirst(s1, l1, s2, l2, idx));
13759 else {
13760 #ifdef JIM_UTF8
13761 Jim_SetResultInt(interp, JimStringLastUtf8(s1, l1, s2, idx));
13762 #else
13763 Jim_SetResultInt(interp, JimStringLast(s1, l1, s2, idx));
13764 #endif
13766 return JIM_OK;
13769 case OPT_TRIM:
13770 case OPT_TRIMLEFT:
13771 case OPT_TRIMRIGHT:{
13772 Jim_Obj *trimchars;
13774 if (argc != 3 && argc != 4) {
13775 Jim_WrongNumArgs(interp, 2, argv, "string ?trimchars?");
13776 return JIM_ERR;
13778 trimchars = (argc == 4 ? argv[3] : NULL);
13779 if (option == OPT_TRIM) {
13780 Jim_SetResult(interp, JimStringTrim(interp, argv[2], trimchars));
13782 else if (option == OPT_TRIMLEFT) {
13783 Jim_SetResult(interp, JimStringTrimLeft(interp, argv[2], trimchars));
13785 else if (option == OPT_TRIMRIGHT) {
13786 Jim_SetResult(interp, JimStringTrimRight(interp, argv[2], trimchars));
13788 return JIM_OK;
13791 case OPT_TOLOWER:
13792 case OPT_TOUPPER:
13793 case OPT_TOTITLE:
13794 if (argc != 3) {
13795 Jim_WrongNumArgs(interp, 2, argv, "string");
13796 return JIM_ERR;
13798 if (option == OPT_TOLOWER) {
13799 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
13801 else if (option == OPT_TOUPPER) {
13802 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
13804 else {
13805 Jim_SetResult(interp, JimStringToTitle(interp, argv[2]));
13807 return JIM_OK;
13809 case OPT_IS:
13810 if (argc == 4 || (argc == 5 && Jim_CompareStringImmediate(interp, argv[3], "-strict"))) {
13811 return JimStringIs(interp, argv[argc - 1], argv[2], argc == 5);
13813 Jim_WrongNumArgs(interp, 2, argv, "class ?-strict? str");
13814 return JIM_ERR;
13816 return JIM_OK;
13819 /* [time] */
13820 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13822 long i, count = 1;
13823 jim_wide start, elapsed;
13824 char buf[60];
13825 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
13827 if (argc < 2) {
13828 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
13829 return JIM_ERR;
13831 if (argc == 3) {
13832 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
13833 return JIM_ERR;
13835 if (count < 0)
13836 return JIM_OK;
13837 i = count;
13838 start = JimClock();
13839 while (i-- > 0) {
13840 int retval;
13842 retval = Jim_EvalObj(interp, argv[1]);
13843 if (retval != JIM_OK) {
13844 return retval;
13847 elapsed = JimClock() - start;
13848 sprintf(buf, fmt, count == 0 ? 0 : elapsed / count);
13849 Jim_SetResultString(interp, buf, -1);
13850 return JIM_OK;
13853 /* [exit] */
13854 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13856 long exitCode = 0;
13858 if (argc > 2) {
13859 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
13860 return JIM_ERR;
13862 if (argc == 2) {
13863 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
13864 return JIM_ERR;
13865 Jim_SetResult(interp, argv[1]);
13867 interp->exitCode = exitCode;
13868 return JIM_EXIT;
13871 /* [catch] */
13872 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13874 int exitCode = 0;
13875 int i;
13876 int sig = 0;
13878 /* Which return codes are ignored (passed through)? By default, only exit, eval and signal */
13879 jim_wide ignore_mask = (1 << JIM_EXIT) | (1 << JIM_EVAL) | (1 << JIM_SIGNAL);
13880 static const int max_ignore_code = sizeof(ignore_mask) * 8;
13882 /* Reset the error code before catch.
13883 * Note that this is not strictly correct.
13885 Jim_SetGlobalVariableStr(interp, "errorCode", Jim_NewStringObj(interp, "NONE", -1));
13887 for (i = 1; i < argc - 1; i++) {
13888 const char *arg = Jim_String(argv[i]);
13889 jim_wide option;
13890 int ignore;
13892 /* It's a pity we can't use Jim_GetEnum here :-( */
13893 if (strcmp(arg, "--") == 0) {
13894 i++;
13895 break;
13897 if (*arg != '-') {
13898 break;
13901 if (strncmp(arg, "-no", 3) == 0) {
13902 arg += 3;
13903 ignore = 1;
13905 else {
13906 arg++;
13907 ignore = 0;
13910 if (Jim_StringToWide(arg, &option, 10) != JIM_OK) {
13911 option = -1;
13913 if (option < 0) {
13914 option = Jim_FindByName(arg, jimReturnCodes, jimReturnCodesSize);
13916 if (option < 0) {
13917 goto wrongargs;
13920 if (ignore) {
13921 ignore_mask |= ((jim_wide)1 << option);
13923 else {
13924 ignore_mask &= (~((jim_wide)1 << option));
13928 argc -= i;
13929 if (argc < 1 || argc > 3) {
13930 wrongargs:
13931 Jim_WrongNumArgs(interp, 1, argv,
13932 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
13933 return JIM_ERR;
13935 argv += i;
13937 if ((ignore_mask & (1 << JIM_SIGNAL)) == 0) {
13938 sig++;
13941 interp->signal_level += sig;
13942 if (Jim_CheckSignal(interp)) {
13943 /* If a signal is set, don't even try to execute the body */
13944 exitCode = JIM_SIGNAL;
13946 else {
13947 exitCode = Jim_EvalObj(interp, argv[0]);
13948 /* Don't want any caught error included in a later stack trace */
13949 interp->errorFlag = 0;
13951 interp->signal_level -= sig;
13953 /* Catch or pass through? Only the first 32/64 codes can be passed through */
13954 if (exitCode >= 0 && exitCode < max_ignore_code && (((unsigned jim_wide)1 << exitCode) & ignore_mask)) {
13955 /* Not caught, pass it up */
13956 return exitCode;
13959 if (sig && exitCode == JIM_SIGNAL) {
13960 /* Catch the signal at this level */
13961 if (interp->signal_set_result) {
13962 interp->signal_set_result(interp, interp->sigmask);
13964 else {
13965 Jim_SetResultInt(interp, interp->sigmask);
13967 interp->sigmask = 0;
13970 if (argc >= 2) {
13971 if (Jim_SetVariable(interp, argv[1], Jim_GetResult(interp)) != JIM_OK) {
13972 return JIM_ERR;
13974 if (argc == 3) {
13975 Jim_Obj *optListObj = Jim_NewListObj(interp, NULL, 0);
13977 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-code", -1));
13978 Jim_ListAppendElement(interp, optListObj,
13979 Jim_NewIntObj(interp, exitCode == JIM_RETURN ? interp->returnCode : exitCode));
13980 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-level", -1));
13981 Jim_ListAppendElement(interp, optListObj, Jim_NewIntObj(interp, interp->returnLevel));
13982 if (exitCode == JIM_ERR) {
13983 Jim_Obj *errorCode;
13984 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorinfo",
13985 -1));
13986 Jim_ListAppendElement(interp, optListObj, interp->stackTrace);
13988 errorCode = Jim_GetGlobalVariableStr(interp, "errorCode", JIM_NONE);
13989 if (errorCode) {
13990 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorcode", -1));
13991 Jim_ListAppendElement(interp, optListObj, errorCode);
13994 if (Jim_SetVariable(interp, argv[2], optListObj) != JIM_OK) {
13995 return JIM_ERR;
13999 Jim_SetResultInt(interp, exitCode);
14000 return JIM_OK;
14003 #if defined(JIM_REFERENCES) && !defined(JIM_BOOTSTRAP)
14005 /* [ref] */
14006 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14008 if (argc != 3 && argc != 4) {
14009 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
14010 return JIM_ERR;
14012 if (argc == 3) {
14013 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
14015 else {
14016 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], argv[3]));
14018 return JIM_OK;
14021 /* [getref] */
14022 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14024 Jim_Reference *refPtr;
14026 if (argc != 2) {
14027 Jim_WrongNumArgs(interp, 1, argv, "reference");
14028 return JIM_ERR;
14030 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
14031 return JIM_ERR;
14032 Jim_SetResult(interp, refPtr->objPtr);
14033 return JIM_OK;
14036 /* [setref] */
14037 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14039 Jim_Reference *refPtr;
14041 if (argc != 3) {
14042 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
14043 return JIM_ERR;
14045 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
14046 return JIM_ERR;
14047 Jim_IncrRefCount(argv[2]);
14048 Jim_DecrRefCount(interp, refPtr->objPtr);
14049 refPtr->objPtr = argv[2];
14050 Jim_SetResult(interp, argv[2]);
14051 return JIM_OK;
14054 /* [collect] */
14055 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14057 if (argc != 1) {
14058 Jim_WrongNumArgs(interp, 1, argv, "");
14059 return JIM_ERR;
14061 Jim_SetResultInt(interp, Jim_Collect(interp));
14063 /* Free all the freed objects. */
14064 while (interp->freeList) {
14065 Jim_Obj *nextObjPtr = interp->freeList->nextObjPtr;
14066 Jim_Free(interp->freeList);
14067 interp->freeList = nextObjPtr;
14070 return JIM_OK;
14073 /* [finalize] reference ?newValue? */
14074 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14076 if (argc != 2 && argc != 3) {
14077 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
14078 return JIM_ERR;
14080 if (argc == 2) {
14081 Jim_Obj *cmdNamePtr;
14083 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
14084 return JIM_ERR;
14085 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
14086 Jim_SetResult(interp, cmdNamePtr);
14088 else {
14089 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
14090 return JIM_ERR;
14091 Jim_SetResult(interp, argv[2]);
14093 return JIM_OK;
14096 /* [info references] */
14097 static int JimInfoReferences(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14099 Jim_Obj *listObjPtr;
14100 Jim_HashTableIterator htiter;
14101 Jim_HashEntry *he;
14103 listObjPtr = Jim_NewListObj(interp, NULL, 0);
14105 JimInitHashTableIterator(&interp->references, &htiter);
14106 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14107 char buf[JIM_REFERENCE_SPACE + 1];
14108 Jim_Reference *refPtr = Jim_GetHashEntryVal(he);
14109 const unsigned long *refId = he->key;
14111 JimFormatReference(buf, refPtr, *refId);
14112 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, buf, -1));
14114 Jim_SetResult(interp, listObjPtr);
14115 return JIM_OK;
14117 #endif /* JIM_REFERENCES && !JIM_BOOTSTRAP */
14119 /* [rename] */
14120 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14122 if (argc != 3) {
14123 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
14124 return JIM_ERR;
14127 return Jim_RenameCommand(interp, argv[1], argv[2]);
14130 #define JIM_DICTMATCH_KEYS 0x0001
14131 #define JIM_DICTMATCH_VALUES 0x002
14134 * match_type must be one of JIM_DICTMATCH_KEYS or JIM_DICTMATCH_VALUES
14135 * return_types should be either or both
14137 int Jim_DictMatchTypes(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObj, int match_type, int return_types)
14139 Jim_HashEntry *he;
14140 Jim_Obj *listObjPtr;
14141 Jim_HashTableIterator htiter;
14143 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14144 return JIM_ERR;
14147 listObjPtr = Jim_NewListObj(interp, NULL, 0);
14149 JimInitHashTableIterator(objPtr->internalRep.ptr, &htiter);
14150 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14151 if (patternObj) {
14152 Jim_Obj *matchObj = (match_type == JIM_DICTMATCH_KEYS) ? (Jim_Obj *)he->key : Jim_GetHashEntryVal(he);
14153 if (!Jim_StringMatchObj(interp, patternObj, matchObj, 0)) {
14154 /* no match */
14155 continue;
14158 if (return_types & JIM_DICTMATCH_KEYS) {
14159 Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->key);
14161 if (return_types & JIM_DICTMATCH_VALUES) {
14162 Jim_ListAppendElement(interp, listObjPtr, Jim_GetHashEntryVal(he));
14166 Jim_SetResult(interp, listObjPtr);
14167 return JIM_OK;
14170 int Jim_DictSize(Jim_Interp *interp, Jim_Obj *objPtr)
14172 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14173 return -1;
14175 return ((Jim_HashTable *)objPtr->internalRep.ptr)->used;
14179 * Must be called with at least one object.
14180 * Returns the new dictionary, or NULL on error.
14182 Jim_Obj *Jim_DictMerge(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
14184 Jim_Obj *objPtr = Jim_NewDictObj(interp, NULL, 0);
14185 int i;
14187 JimPanic((objc == 0, "Jim_DictMerge called with objc=0"));
14189 /* Note that we don't optimise the trivial case of a single argument */
14191 for (i = 0; i < objc; i++) {
14192 Jim_HashTable *ht;
14193 Jim_HashTableIterator htiter;
14194 Jim_HashEntry *he;
14196 if (SetDictFromAny(interp, objv[i]) != JIM_OK) {
14197 Jim_FreeNewObj(interp, objPtr);
14198 return NULL;
14200 ht = objv[i]->internalRep.ptr;
14201 JimInitHashTableIterator(ht, &htiter);
14202 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14203 Jim_ReplaceHashEntry(objPtr->internalRep.ptr, Jim_GetHashEntryKey(he), Jim_GetHashEntryVal(he));
14206 return objPtr;
14209 int Jim_DictInfo(Jim_Interp *interp, Jim_Obj *objPtr)
14211 Jim_HashTable *ht;
14212 unsigned int i;
14213 char buffer[100];
14214 int sum = 0;
14215 int nonzero_count = 0;
14216 Jim_Obj *output;
14217 int bucket_counts[11] = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 };
14219 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14220 return JIM_ERR;
14223 ht = (Jim_HashTable *)objPtr->internalRep.ptr;
14225 /* Note that this uses internal knowledge of the hash table */
14226 snprintf(buffer, sizeof(buffer), "%d entries in table, %d buckets\n", ht->used, ht->size);
14227 output = Jim_NewStringObj(interp, buffer, -1);
14229 for (i = 0; i < ht->size; i++) {
14230 Jim_HashEntry *he = ht->table[i];
14231 int entries = 0;
14232 while (he) {
14233 entries++;
14234 he = he->next;
14236 if (entries > 9) {
14237 bucket_counts[10]++;
14239 else {
14240 bucket_counts[entries]++;
14242 if (entries) {
14243 sum += entries;
14244 nonzero_count++;
14247 for (i = 0; i < 10; i++) {
14248 snprintf(buffer, sizeof(buffer), "number of buckets with %d entries: %d\n", i, bucket_counts[i]);
14249 Jim_AppendString(interp, output, buffer, -1);
14251 snprintf(buffer, sizeof(buffer), "number of buckets with 10 or more entries: %d\n", bucket_counts[10]);
14252 Jim_AppendString(interp, output, buffer, -1);
14253 snprintf(buffer, sizeof(buffer), "average search distance for entry: %.1f", nonzero_count ? (double)sum / nonzero_count : 0.0);
14254 Jim_AppendString(interp, output, buffer, -1);
14255 Jim_SetResult(interp, output);
14256 return JIM_OK;
14259 static int Jim_EvalEnsemble(Jim_Interp *interp, const char *basecmd, const char *subcmd, int argc, Jim_Obj *const *argv)
14261 Jim_Obj *prefixObj = Jim_NewStringObj(interp, basecmd, -1);
14263 Jim_AppendString(interp, prefixObj, " ", 1);
14264 Jim_AppendString(interp, prefixObj, subcmd, -1);
14266 return Jim_EvalObjPrefix(interp, prefixObj, argc, argv);
14270 * Implements the [dict with] command
14272 static int JimDictWith(Jim_Interp *interp, Jim_Obj *dictVarName, Jim_Obj *const *keyv, int keyc, Jim_Obj *scriptObj)
14274 int i;
14275 Jim_Obj *objPtr;
14276 Jim_Obj *dictObj;
14277 Jim_Obj **dictValues;
14278 int len;
14279 int ret = JIM_OK;
14281 /* Open up the appropriate level of the dictionary */
14282 dictObj = Jim_GetVariable(interp, dictVarName, JIM_ERRMSG);
14283 if (dictObj == NULL || Jim_DictKeysVector(interp, dictObj, keyv, keyc, &objPtr, JIM_ERRMSG) != JIM_OK) {
14284 return JIM_ERR;
14286 /* Set the local variables */
14287 if (Jim_DictPairs(interp, objPtr, &dictValues, &len) == JIM_ERR) {
14288 return JIM_ERR;
14290 for (i = 0; i < len; i += 2) {
14291 if (Jim_SetVariable(interp, dictValues[i], dictValues[i + 1]) == JIM_ERR) {
14292 Jim_Free(dictValues);
14293 return JIM_ERR;
14297 /* As an optimisation, if the script is empty, no need to evaluate it or update the dict */
14298 if (Jim_Length(scriptObj)) {
14299 ret = Jim_EvalObj(interp, scriptObj);
14301 /* Now if the dictionary still exists, update it based on the local variables */
14302 if (ret == JIM_OK && Jim_GetVariable(interp, dictVarName, 0) != NULL) {
14303 /* We need a copy of keyv with one extra element at the end for Jim_SetDictKeysVector() */
14304 Jim_Obj **newkeyv = Jim_Alloc(sizeof(*newkeyv) * (keyc + 1));
14305 for (i = 0; i < keyc; i++) {
14306 newkeyv[i] = keyv[i];
14309 for (i = 0; i < len; i += 2) {
14310 /* This will be NULL if the variable no longer exists, thus deleting the variable */
14311 objPtr = Jim_GetVariable(interp, dictValues[i], 0);
14312 newkeyv[keyc] = dictValues[i];
14313 Jim_SetDictKeysVector(interp, dictVarName, newkeyv, keyc + 1, objPtr, 0);
14315 Jim_Free(newkeyv);
14319 Jim_Free(dictValues);
14321 return ret;
14324 /* [dict] */
14325 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14327 Jim_Obj *objPtr;
14328 int types = JIM_DICTMATCH_KEYS;
14329 int option;
14330 static const char * const options[] = {
14331 "create", "get", "set", "unset", "exists", "keys", "size", "info",
14332 "merge", "with", "append", "lappend", "incr", "remove", "values", "for",
14333 "replace", "update", NULL
14335 enum
14337 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXISTS, OPT_KEYS, OPT_SIZE, OPT_INFO,
14338 OPT_MERGE, OPT_WITH, OPT_APPEND, OPT_LAPPEND, OPT_INCR, OPT_REMOVE, OPT_VALUES, OPT_FOR,
14339 OPT_REPLACE, OPT_UPDATE,
14342 if (argc < 2) {
14343 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?arguments ...?");
14344 return JIM_ERR;
14347 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK) {
14348 return Jim_CheckShowCommands(interp, argv[1], options);
14351 switch (option) {
14352 case OPT_GET:
14353 if (argc < 3) {
14354 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?key ...?");
14355 return JIM_ERR;
14357 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr,
14358 JIM_ERRMSG) != JIM_OK) {
14359 return JIM_ERR;
14361 Jim_SetResult(interp, objPtr);
14362 return JIM_OK;
14364 case OPT_SET:
14365 if (argc < 5) {
14366 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
14367 return JIM_ERR;
14369 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 4, argv[argc - 1], JIM_ERRMSG);
14371 case OPT_EXISTS:
14372 if (argc < 4) {
14373 Jim_WrongNumArgs(interp, 2, argv, "dictionary key ?key ...?");
14374 return JIM_ERR;
14376 else {
14377 int rc = Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr, JIM_ERRMSG);
14378 if (rc < 0) {
14379 return JIM_ERR;
14381 Jim_SetResultBool(interp, rc == JIM_OK);
14382 return JIM_OK;
14385 case OPT_UNSET:
14386 if (argc < 4) {
14387 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
14388 return JIM_ERR;
14390 if (Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 3, NULL, 0) != JIM_OK) {
14391 return JIM_ERR;
14393 return JIM_OK;
14395 case OPT_VALUES:
14396 types = JIM_DICTMATCH_VALUES;
14397 /* fallthru */
14398 case OPT_KEYS:
14399 if (argc != 3 && argc != 4) {
14400 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?pattern?");
14401 return JIM_ERR;
14403 return Jim_DictMatchTypes(interp, argv[2], argc == 4 ? argv[3] : NULL, types, types);
14405 case OPT_SIZE:
14406 if (argc != 3) {
14407 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14408 return JIM_ERR;
14410 else if (Jim_DictSize(interp, argv[2]) < 0) {
14411 return JIM_ERR;
14413 Jim_SetResultInt(interp, Jim_DictSize(interp, argv[2]));
14414 return JIM_OK;
14416 case OPT_MERGE:
14417 if (argc == 2) {
14418 return JIM_OK;
14420 objPtr = Jim_DictMerge(interp, argc - 2, argv + 2);
14421 if (objPtr == NULL) {
14422 return JIM_ERR;
14424 Jim_SetResult(interp, objPtr);
14425 return JIM_OK;
14427 case OPT_UPDATE:
14428 if (argc < 6 || argc % 2) {
14429 /* Better error message */
14430 argc = 2;
14432 break;
14434 case OPT_CREATE:
14435 if (argc % 2) {
14436 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
14437 return JIM_ERR;
14439 objPtr = Jim_NewDictObj(interp, argv + 2, argc - 2);
14440 Jim_SetResult(interp, objPtr);
14441 return JIM_OK;
14443 case OPT_INFO:
14444 if (argc != 3) {
14445 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14446 return JIM_ERR;
14448 return Jim_DictInfo(interp, argv[2]);
14450 case OPT_WITH:
14451 if (argc < 4) {
14452 Jim_WrongNumArgs(interp, 2, argv, "dictVar ?key ...? script");
14453 return JIM_ERR;
14455 return JimDictWith(interp, argv[2], argv + 3, argc - 4, argv[argc - 1]);
14457 /* Handle command as an ensemble */
14458 return Jim_EvalEnsemble(interp, "dict", options[option], argc - 2, argv + 2);
14461 /* [subst] */
14462 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14464 static const char * const options[] = {
14465 "-nobackslashes", "-nocommands", "-novariables", NULL
14467 enum
14468 { OPT_NOBACKSLASHES, OPT_NOCOMMANDS, OPT_NOVARIABLES };
14469 int i;
14470 int flags = JIM_SUBST_FLAG;
14471 Jim_Obj *objPtr;
14473 if (argc < 2) {
14474 Jim_WrongNumArgs(interp, 1, argv, "?options? string");
14475 return JIM_ERR;
14477 for (i = 1; i < (argc - 1); i++) {
14478 int option;
14480 if (Jim_GetEnum(interp, argv[i], options, &option, NULL,
14481 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14482 return JIM_ERR;
14484 switch (option) {
14485 case OPT_NOBACKSLASHES:
14486 flags |= JIM_SUBST_NOESC;
14487 break;
14488 case OPT_NOCOMMANDS:
14489 flags |= JIM_SUBST_NOCMD;
14490 break;
14491 case OPT_NOVARIABLES:
14492 flags |= JIM_SUBST_NOVAR;
14493 break;
14496 if (Jim_SubstObj(interp, argv[argc - 1], &objPtr, flags) != JIM_OK) {
14497 return JIM_ERR;
14499 Jim_SetResult(interp, objPtr);
14500 return JIM_OK;
14503 #ifdef jim_ext_namespace
14504 static int JimIsGlobalNamespace(Jim_Obj *objPtr)
14506 int len;
14507 const char *str = Jim_GetString(objPtr, &len);
14508 return len >= 2 && str[0] == ':' && str[1] == ':';
14510 #endif
14512 /* [info] */
14513 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14515 int cmd;
14516 Jim_Obj *objPtr;
14517 int mode = 0;
14519 static const char * const commands[] = {
14520 "body", "statics", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
14521 "vars", "version", "patchlevel", "complete", "args", "hostname",
14522 "script", "source", "stacktrace", "nameofexecutable", "returncodes",
14523 "references", "alias", NULL
14525 enum
14526 { INFO_BODY, INFO_STATICS, INFO_COMMANDS, INFO_PROCS, INFO_CHANNELS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
14527 INFO_FRAME, INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_PATCHLEVEL, INFO_COMPLETE, INFO_ARGS,
14528 INFO_HOSTNAME, INFO_SCRIPT, INFO_SOURCE, INFO_STACKTRACE, INFO_NAMEOFEXECUTABLE,
14529 INFO_RETURNCODES, INFO_REFERENCES, INFO_ALIAS,
14532 #ifdef jim_ext_namespace
14533 int nons = 0;
14535 if (argc > 2 && Jim_CompareStringImmediate(interp, argv[1], "-nons")) {
14536 /* This is for internal use only */
14537 argc--;
14538 argv++;
14539 nons = 1;
14541 #endif
14543 if (argc < 2) {
14544 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?args ...?");
14545 return JIM_ERR;
14547 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "subcommand", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14548 return Jim_CheckShowCommands(interp, argv[1], commands);
14551 /* Test for the most common commands first, just in case it makes a difference */
14552 switch (cmd) {
14553 case INFO_EXISTS:
14554 if (argc != 3) {
14555 Jim_WrongNumArgs(interp, 2, argv, "varName");
14556 return JIM_ERR;
14558 Jim_SetResultBool(interp, Jim_GetVariable(interp, argv[2], 0) != NULL);
14559 break;
14561 case INFO_ALIAS:{
14562 Jim_Cmd *cmdPtr;
14564 if (argc != 3) {
14565 Jim_WrongNumArgs(interp, 2, argv, "command");
14566 return JIM_ERR;
14568 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14569 return JIM_ERR;
14571 if (cmdPtr->isproc || cmdPtr->u.native.cmdProc != JimAliasCmd) {
14572 Jim_SetResultFormatted(interp, "command \"%#s\" is not an alias", argv[2]);
14573 return JIM_ERR;
14575 Jim_SetResult(interp, (Jim_Obj *)cmdPtr->u.native.privData);
14576 return JIM_OK;
14579 case INFO_CHANNELS:
14580 mode++; /* JIM_CMDLIST_CHANNELS */
14581 #ifndef jim_ext_aio
14582 Jim_SetResultString(interp, "aio not enabled", -1);
14583 return JIM_ERR;
14584 #endif
14585 /* fall through */
14586 case INFO_PROCS:
14587 mode++; /* JIM_CMDLIST_PROCS */
14588 /* fall through */
14589 case INFO_COMMANDS:
14590 /* mode 0 => JIM_CMDLIST_COMMANDS */
14591 if (argc != 2 && argc != 3) {
14592 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14593 return JIM_ERR;
14595 #ifdef jim_ext_namespace
14596 if (!nons) {
14597 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimIsGlobalNamespace(argv[2]))) {
14598 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14601 #endif
14602 Jim_SetResult(interp, JimCommandsList(interp, (argc == 3) ? argv[2] : NULL, mode));
14603 break;
14605 case INFO_VARS:
14606 mode++; /* JIM_VARLIST_VARS */
14607 /* fall through */
14608 case INFO_LOCALS:
14609 mode++; /* JIM_VARLIST_LOCALS */
14610 /* fall through */
14611 case INFO_GLOBALS:
14612 /* mode 0 => JIM_VARLIST_GLOBALS */
14613 if (argc != 2 && argc != 3) {
14614 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14615 return JIM_ERR;
14617 #ifdef jim_ext_namespace
14618 if (!nons) {
14619 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimIsGlobalNamespace(argv[2]))) {
14620 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14623 #endif
14624 Jim_SetResult(interp, JimVariablesList(interp, argc == 3 ? argv[2] : NULL, mode));
14625 break;
14627 case INFO_SCRIPT:
14628 if (argc != 2) {
14629 Jim_WrongNumArgs(interp, 2, argv, "");
14630 return JIM_ERR;
14632 Jim_SetResult(interp, JimGetScript(interp, interp->currentScriptObj)->fileNameObj);
14633 break;
14635 case INFO_SOURCE:{
14636 jim_wide line;
14637 Jim_Obj *resObjPtr;
14638 Jim_Obj *fileNameObj;
14640 if (argc != 3 && argc != 5) {
14641 Jim_WrongNumArgs(interp, 2, argv, "source ?filename line?");
14642 return JIM_ERR;
14644 if (argc == 5) {
14645 if (Jim_GetWide(interp, argv[4], &line) != JIM_OK) {
14646 return JIM_ERR;
14648 resObjPtr = Jim_NewStringObj(interp, Jim_String(argv[2]), Jim_Length(argv[2]));
14649 JimSetSourceInfo(interp, resObjPtr, argv[3], line);
14651 else {
14652 if (argv[2]->typePtr == &sourceObjType) {
14653 fileNameObj = argv[2]->internalRep.sourceValue.fileNameObj;
14654 line = argv[2]->internalRep.sourceValue.lineNumber;
14656 else if (argv[2]->typePtr == &scriptObjType) {
14657 ScriptObj *script = JimGetScript(interp, argv[2]);
14658 fileNameObj = script->fileNameObj;
14659 line = script->firstline;
14661 else {
14662 fileNameObj = interp->emptyObj;
14663 line = 1;
14665 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14666 Jim_ListAppendElement(interp, resObjPtr, fileNameObj);
14667 Jim_ListAppendElement(interp, resObjPtr, Jim_NewIntObj(interp, line));
14669 Jim_SetResult(interp, resObjPtr);
14670 break;
14673 case INFO_STACKTRACE:
14674 Jim_SetResult(interp, interp->stackTrace);
14675 break;
14677 case INFO_LEVEL:
14678 case INFO_FRAME:
14679 switch (argc) {
14680 case 2:
14681 Jim_SetResultInt(interp, interp->framePtr->level);
14682 break;
14684 case 3:
14685 if (JimInfoLevel(interp, argv[2], &objPtr, cmd == INFO_LEVEL) != JIM_OK) {
14686 return JIM_ERR;
14688 Jim_SetResult(interp, objPtr);
14689 break;
14691 default:
14692 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
14693 return JIM_ERR;
14695 break;
14697 case INFO_BODY:
14698 case INFO_STATICS:
14699 case INFO_ARGS:{
14700 Jim_Cmd *cmdPtr;
14702 if (argc != 3) {
14703 Jim_WrongNumArgs(interp, 2, argv, "procname");
14704 return JIM_ERR;
14706 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14707 return JIM_ERR;
14709 if (!cmdPtr->isproc) {
14710 Jim_SetResultFormatted(interp, "command \"%#s\" is not a procedure", argv[2]);
14711 return JIM_ERR;
14713 switch (cmd) {
14714 case INFO_BODY:
14715 Jim_SetResult(interp, cmdPtr->u.proc.bodyObjPtr);
14716 break;
14717 case INFO_ARGS:
14718 Jim_SetResult(interp, cmdPtr->u.proc.argListObjPtr);
14719 break;
14720 case INFO_STATICS:
14721 if (cmdPtr->u.proc.staticVars) {
14722 Jim_SetResult(interp, JimHashtablePatternMatch(interp, cmdPtr->u.proc.staticVars,
14723 NULL, JimVariablesMatch, JIM_VARLIST_LOCALS | JIM_VARLIST_VALUES));
14725 break;
14727 break;
14730 case INFO_VERSION:
14731 case INFO_PATCHLEVEL:{
14732 char buf[(JIM_INTEGER_SPACE * 2) + 1];
14734 sprintf(buf, "%d.%d", JIM_VERSION / 100, JIM_VERSION % 100);
14735 Jim_SetResultString(interp, buf, -1);
14736 break;
14739 case INFO_COMPLETE:
14740 if (argc != 3 && argc != 4) {
14741 Jim_WrongNumArgs(interp, 2, argv, "script ?missing?");
14742 return JIM_ERR;
14744 else {
14745 char missing;
14747 Jim_SetResultBool(interp, Jim_ScriptIsComplete(interp, argv[2], &missing));
14748 if (missing != ' ' && argc == 4) {
14749 Jim_SetVariable(interp, argv[3], Jim_NewStringObj(interp, &missing, 1));
14752 break;
14754 case INFO_HOSTNAME:
14755 /* Redirect to os.gethostname if it exists */
14756 return Jim_Eval(interp, "os.gethostname");
14758 case INFO_NAMEOFEXECUTABLE:
14759 /* Redirect to Tcl proc */
14760 return Jim_Eval(interp, "{info nameofexecutable}");
14762 case INFO_RETURNCODES:
14763 if (argc == 2) {
14764 int i;
14765 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14767 for (i = 0; jimReturnCodes[i]; i++) {
14768 Jim_ListAppendElement(interp, listObjPtr, Jim_NewIntObj(interp, i));
14769 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp,
14770 jimReturnCodes[i], -1));
14773 Jim_SetResult(interp, listObjPtr);
14775 else if (argc == 3) {
14776 long code;
14777 const char *name;
14779 if (Jim_GetLong(interp, argv[2], &code) != JIM_OK) {
14780 return JIM_ERR;
14782 name = Jim_ReturnCode(code);
14783 if (*name == '?') {
14784 Jim_SetResultInt(interp, code);
14786 else {
14787 Jim_SetResultString(interp, name, -1);
14790 else {
14791 Jim_WrongNumArgs(interp, 2, argv, "?code?");
14792 return JIM_ERR;
14794 break;
14795 case INFO_REFERENCES:
14796 #ifdef JIM_REFERENCES
14797 return JimInfoReferences(interp, argc, argv);
14798 #else
14799 Jim_SetResultString(interp, "not supported", -1);
14800 return JIM_ERR;
14801 #endif
14803 return JIM_OK;
14806 /* [exists] */
14807 static int Jim_ExistsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14809 Jim_Obj *objPtr;
14810 int result = 0;
14812 static const char * const options[] = {
14813 "-command", "-proc", "-alias", "-var", NULL
14815 enum
14817 OPT_COMMAND, OPT_PROC, OPT_ALIAS, OPT_VAR
14819 int option;
14821 if (argc == 2) {
14822 option = OPT_VAR;
14823 objPtr = argv[1];
14825 else if (argc == 3) {
14826 if (Jim_GetEnum(interp, argv[1], options, &option, NULL, JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14827 return JIM_ERR;
14829 objPtr = argv[2];
14831 else {
14832 Jim_WrongNumArgs(interp, 1, argv, "?option? name");
14833 return JIM_ERR;
14836 if (option == OPT_VAR) {
14837 result = Jim_GetVariable(interp, objPtr, 0) != NULL;
14839 else {
14840 /* Now different kinds of commands */
14841 Jim_Cmd *cmd = Jim_GetCommand(interp, objPtr, JIM_NONE);
14843 if (cmd) {
14844 switch (option) {
14845 case OPT_COMMAND:
14846 result = 1;
14847 break;
14849 case OPT_ALIAS:
14850 result = cmd->isproc == 0 && cmd->u.native.cmdProc == JimAliasCmd;
14851 break;
14853 case OPT_PROC:
14854 result = cmd->isproc;
14855 break;
14859 Jim_SetResultBool(interp, result);
14860 return JIM_OK;
14863 /* [split] */
14864 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14866 const char *str, *splitChars, *noMatchStart;
14867 int splitLen, strLen;
14868 Jim_Obj *resObjPtr;
14869 int c;
14870 int len;
14872 if (argc != 2 && argc != 3) {
14873 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
14874 return JIM_ERR;
14877 str = Jim_GetString(argv[1], &len);
14878 if (len == 0) {
14879 return JIM_OK;
14881 strLen = Jim_Utf8Length(interp, argv[1]);
14883 /* Init */
14884 if (argc == 2) {
14885 splitChars = " \n\t\r";
14886 splitLen = 4;
14888 else {
14889 splitChars = Jim_String(argv[2]);
14890 splitLen = Jim_Utf8Length(interp, argv[2]);
14893 noMatchStart = str;
14894 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14896 /* Split */
14897 if (splitLen) {
14898 Jim_Obj *objPtr;
14899 while (strLen--) {
14900 const char *sc = splitChars;
14901 int scLen = splitLen;
14902 int sl = utf8_tounicode(str, &c);
14903 while (scLen--) {
14904 int pc;
14905 sc += utf8_tounicode(sc, &pc);
14906 if (c == pc) {
14907 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14908 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14909 noMatchStart = str + sl;
14910 break;
14913 str += sl;
14915 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14916 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14918 else {
14919 /* This handles the special case of splitchars eq {}
14920 * Optimise by sharing common (ASCII) characters
14922 Jim_Obj **commonObj = NULL;
14923 #define NUM_COMMON (128 - 9)
14924 while (strLen--) {
14925 int n = utf8_tounicode(str, &c);
14926 #ifdef JIM_OPTIMIZATION
14927 if (c >= 9 && c < 128) {
14928 /* Common ASCII char. Note that 9 is the tab character */
14929 c -= 9;
14930 if (!commonObj) {
14931 commonObj = Jim_Alloc(sizeof(*commonObj) * NUM_COMMON);
14932 memset(commonObj, 0, sizeof(*commonObj) * NUM_COMMON);
14934 if (!commonObj[c]) {
14935 commonObj[c] = Jim_NewStringObj(interp, str, 1);
14937 Jim_ListAppendElement(interp, resObjPtr, commonObj[c]);
14938 str++;
14939 continue;
14941 #endif
14942 Jim_ListAppendElement(interp, resObjPtr, Jim_NewStringObjUtf8(interp, str, 1));
14943 str += n;
14945 Jim_Free(commonObj);
14948 Jim_SetResult(interp, resObjPtr);
14949 return JIM_OK;
14952 /* [join] */
14953 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14955 const char *joinStr;
14956 int joinStrLen;
14958 if (argc != 2 && argc != 3) {
14959 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
14960 return JIM_ERR;
14962 /* Init */
14963 if (argc == 2) {
14964 joinStr = " ";
14965 joinStrLen = 1;
14967 else {
14968 joinStr = Jim_GetString(argv[2], &joinStrLen);
14970 Jim_SetResult(interp, Jim_ListJoin(interp, argv[1], joinStr, joinStrLen));
14971 return JIM_OK;
14974 /* [format] */
14975 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14977 Jim_Obj *objPtr;
14979 if (argc < 2) {
14980 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
14981 return JIM_ERR;
14983 objPtr = Jim_FormatString(interp, argv[1], argc - 2, argv + 2);
14984 if (objPtr == NULL)
14985 return JIM_ERR;
14986 Jim_SetResult(interp, objPtr);
14987 return JIM_OK;
14990 /* [scan] */
14991 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14993 Jim_Obj *listPtr, **outVec;
14994 int outc, i;
14996 if (argc < 3) {
14997 Jim_WrongNumArgs(interp, 1, argv, "string format ?varName varName ...?");
14998 return JIM_ERR;
15000 if (argv[2]->typePtr != &scanFmtStringObjType)
15001 SetScanFmtFromAny(interp, argv[2]);
15002 if (FormatGetError(argv[2]) != 0) {
15003 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
15004 return JIM_ERR;
15006 if (argc > 3) {
15007 int maxPos = FormatGetMaxPos(argv[2]);
15008 int count = FormatGetCnvCount(argv[2]);
15010 if (maxPos > argc - 3) {
15011 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
15012 return JIM_ERR;
15014 else if (count > argc - 3) {
15015 Jim_SetResultString(interp, "different numbers of variable names and "
15016 "field specifiers", -1);
15017 return JIM_ERR;
15019 else if (count < argc - 3) {
15020 Jim_SetResultString(interp, "variable is not assigned by any "
15021 "conversion specifiers", -1);
15022 return JIM_ERR;
15025 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
15026 if (listPtr == 0)
15027 return JIM_ERR;
15028 if (argc > 3) {
15029 int rc = JIM_OK;
15030 int count = 0;
15032 if (listPtr != 0 && listPtr != (Jim_Obj *)EOF) {
15033 int len = Jim_ListLength(interp, listPtr);
15035 if (len != 0) {
15036 JimListGetElements(interp, listPtr, &outc, &outVec);
15037 for (i = 0; i < outc; ++i) {
15038 if (Jim_Length(outVec[i]) > 0) {
15039 ++count;
15040 if (Jim_SetVariable(interp, argv[3 + i], outVec[i]) != JIM_OK) {
15041 rc = JIM_ERR;
15046 Jim_FreeNewObj(interp, listPtr);
15048 else {
15049 count = -1;
15051 if (rc == JIM_OK) {
15052 Jim_SetResultInt(interp, count);
15054 return rc;
15056 else {
15057 if (listPtr == (Jim_Obj *)EOF) {
15058 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
15059 return JIM_OK;
15061 Jim_SetResult(interp, listPtr);
15063 return JIM_OK;
15066 /* [error] */
15067 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15069 if (argc != 2 && argc != 3) {
15070 Jim_WrongNumArgs(interp, 1, argv, "message ?stacktrace?");
15071 return JIM_ERR;
15073 Jim_SetResult(interp, argv[1]);
15074 if (argc == 3) {
15075 JimSetStackTrace(interp, argv[2]);
15076 return JIM_ERR;
15078 interp->addStackTrace++;
15079 return JIM_ERR;
15082 /* [lrange] */
15083 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15085 Jim_Obj *objPtr;
15087 if (argc != 4) {
15088 Jim_WrongNumArgs(interp, 1, argv, "list first last");
15089 return JIM_ERR;
15091 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
15092 return JIM_ERR;
15093 Jim_SetResult(interp, objPtr);
15094 return JIM_OK;
15097 /* [lrepeat] */
15098 static int Jim_LrepeatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15100 Jim_Obj *objPtr;
15101 long count;
15103 if (argc < 2 || Jim_GetLong(interp, argv[1], &count) != JIM_OK || count < 0) {
15104 Jim_WrongNumArgs(interp, 1, argv, "count ?value ...?");
15105 return JIM_ERR;
15108 if (count == 0 || argc == 2) {
15109 return JIM_OK;
15112 argc -= 2;
15113 argv += 2;
15115 objPtr = Jim_NewListObj(interp, argv, argc);
15116 while (--count) {
15117 ListInsertElements(objPtr, -1, argc, argv);
15120 Jim_SetResult(interp, objPtr);
15121 return JIM_OK;
15124 char **Jim_GetEnviron(void)
15126 #if defined(HAVE__NSGETENVIRON)
15127 return *_NSGetEnviron();
15128 #else
15129 #if !defined(NO_ENVIRON_EXTERN)
15130 extern char **environ;
15131 #endif
15133 return environ;
15134 #endif
15137 void Jim_SetEnviron(char **env)
15139 #if defined(HAVE__NSGETENVIRON)
15140 *_NSGetEnviron() = env;
15141 #else
15142 #if !defined(NO_ENVIRON_EXTERN)
15143 extern char **environ;
15144 #endif
15146 environ = env;
15147 #endif
15150 /* [env] */
15151 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15153 const char *key;
15154 const char *val;
15156 if (argc == 1) {
15157 char **e = Jim_GetEnviron();
15159 int i;
15160 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
15162 for (i = 0; e[i]; i++) {
15163 const char *equals = strchr(e[i], '=');
15165 if (equals) {
15166 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, e[i],
15167 equals - e[i]));
15168 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
15172 Jim_SetResult(interp, listObjPtr);
15173 return JIM_OK;
15176 if (argc > 3) {
15177 Jim_WrongNumArgs(interp, 1, argv, "varName ?default?");
15178 return JIM_ERR;
15180 key = Jim_String(argv[1]);
15181 val = getenv(key);
15182 if (val == NULL) {
15183 if (argc < 3) {
15184 Jim_SetResultFormatted(interp, "environment variable \"%#s\" does not exist", argv[1]);
15185 return JIM_ERR;
15187 val = Jim_String(argv[2]);
15189 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
15190 return JIM_OK;
15193 /* [source] */
15194 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15196 int retval;
15198 if (argc != 2) {
15199 Jim_WrongNumArgs(interp, 1, argv, "fileName");
15200 return JIM_ERR;
15202 retval = Jim_EvalFile(interp, Jim_String(argv[1]));
15203 if (retval == JIM_RETURN)
15204 return JIM_OK;
15205 return retval;
15208 /* [lreverse] */
15209 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15211 Jim_Obj *revObjPtr, **ele;
15212 int len;
15214 if (argc != 2) {
15215 Jim_WrongNumArgs(interp, 1, argv, "list");
15216 return JIM_ERR;
15218 JimListGetElements(interp, argv[1], &len, &ele);
15219 len--;
15220 revObjPtr = Jim_NewListObj(interp, NULL, 0);
15221 while (len >= 0)
15222 ListAppendElement(revObjPtr, ele[len--]);
15223 Jim_SetResult(interp, revObjPtr);
15224 return JIM_OK;
15227 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
15229 jim_wide len;
15231 if (step == 0)
15232 return -1;
15233 if (start == end)
15234 return 0;
15235 else if (step > 0 && start > end)
15236 return -1;
15237 else if (step < 0 && end > start)
15238 return -1;
15239 len = end - start;
15240 if (len < 0)
15241 len = -len; /* abs(len) */
15242 if (step < 0)
15243 step = -step; /* abs(step) */
15244 len = 1 + ((len - 1) / step);
15245 /* We can truncate safely to INT_MAX, the range command
15246 * will always return an error for a such long range
15247 * because Tcl lists can't be so long. */
15248 if (len > INT_MAX)
15249 len = INT_MAX;
15250 return (int)((len < 0) ? -1 : len);
15253 /* [range] */
15254 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15256 jim_wide start = 0, end, step = 1;
15257 int len, i;
15258 Jim_Obj *objPtr;
15260 if (argc < 2 || argc > 4) {
15261 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
15262 return JIM_ERR;
15264 if (argc == 2) {
15265 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
15266 return JIM_ERR;
15268 else {
15269 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
15270 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
15271 return JIM_ERR;
15272 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
15273 return JIM_ERR;
15275 if ((len = JimRangeLen(start, end, step)) == -1) {
15276 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
15277 return JIM_ERR;
15279 objPtr = Jim_NewListObj(interp, NULL, 0);
15280 for (i = 0; i < len; i++)
15281 ListAppendElement(objPtr, Jim_NewIntObj(interp, start + i * step));
15282 Jim_SetResult(interp, objPtr);
15283 return JIM_OK;
15286 /* [rand] */
15287 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15289 jim_wide min = 0, max = 0, len, maxMul;
15291 if (argc < 1 || argc > 3) {
15292 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
15293 return JIM_ERR;
15295 if (argc == 1) {
15296 max = JIM_WIDE_MAX;
15297 } else if (argc == 2) {
15298 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
15299 return JIM_ERR;
15300 } else if (argc == 3) {
15301 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
15302 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
15303 return JIM_ERR;
15305 len = max-min;
15306 if (len < 0) {
15307 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
15308 return JIM_ERR;
15310 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
15311 while (1) {
15312 jim_wide r;
15314 JimRandomBytes(interp, &r, sizeof(jim_wide));
15315 if (r < 0 || r >= maxMul) continue;
15316 r = (len == 0) ? 0 : r%len;
15317 Jim_SetResultInt(interp, min+r);
15318 return JIM_OK;
15322 static const struct {
15323 const char *name;
15324 Jim_CmdProc *cmdProc;
15325 } Jim_CoreCommandsTable[] = {
15326 {"alias", Jim_AliasCoreCommand},
15327 {"set", Jim_SetCoreCommand},
15328 {"unset", Jim_UnsetCoreCommand},
15329 {"puts", Jim_PutsCoreCommand},
15330 {"+", Jim_AddCoreCommand},
15331 {"*", Jim_MulCoreCommand},
15332 {"-", Jim_SubCoreCommand},
15333 {"/", Jim_DivCoreCommand},
15334 {"incr", Jim_IncrCoreCommand},
15335 {"while", Jim_WhileCoreCommand},
15336 {"loop", Jim_LoopCoreCommand},
15337 {"for", Jim_ForCoreCommand},
15338 {"foreach", Jim_ForeachCoreCommand},
15339 {"lmap", Jim_LmapCoreCommand},
15340 {"lassign", Jim_LassignCoreCommand},
15341 {"if", Jim_IfCoreCommand},
15342 {"switch", Jim_SwitchCoreCommand},
15343 {"list", Jim_ListCoreCommand},
15344 {"lindex", Jim_LindexCoreCommand},
15345 {"lset", Jim_LsetCoreCommand},
15346 {"lsearch", Jim_LsearchCoreCommand},
15347 {"llength", Jim_LlengthCoreCommand},
15348 {"lappend", Jim_LappendCoreCommand},
15349 {"linsert", Jim_LinsertCoreCommand},
15350 {"lreplace", Jim_LreplaceCoreCommand},
15351 {"lsort", Jim_LsortCoreCommand},
15352 {"append", Jim_AppendCoreCommand},
15353 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
15354 {"debug", Jim_DebugCoreCommand},
15355 #endif
15356 {"eval", Jim_EvalCoreCommand},
15357 {"uplevel", Jim_UplevelCoreCommand},
15358 {"expr", Jim_ExprCoreCommand},
15359 {"break", Jim_BreakCoreCommand},
15360 {"continue", Jim_ContinueCoreCommand},
15361 {"proc", Jim_ProcCoreCommand},
15362 {"concat", Jim_ConcatCoreCommand},
15363 {"return", Jim_ReturnCoreCommand},
15364 {"upvar", Jim_UpvarCoreCommand},
15365 {"global", Jim_GlobalCoreCommand},
15366 {"string", Jim_StringCoreCommand},
15367 {"time", Jim_TimeCoreCommand},
15368 {"exit", Jim_ExitCoreCommand},
15369 {"catch", Jim_CatchCoreCommand},
15370 #ifdef JIM_REFERENCES
15371 {"ref", Jim_RefCoreCommand},
15372 {"getref", Jim_GetrefCoreCommand},
15373 {"setref", Jim_SetrefCoreCommand},
15374 {"finalize", Jim_FinalizeCoreCommand},
15375 {"collect", Jim_CollectCoreCommand},
15376 #endif
15377 {"rename", Jim_RenameCoreCommand},
15378 {"dict", Jim_DictCoreCommand},
15379 {"subst", Jim_SubstCoreCommand},
15380 {"info", Jim_InfoCoreCommand},
15381 {"exists", Jim_ExistsCoreCommand},
15382 {"split", Jim_SplitCoreCommand},
15383 {"join", Jim_JoinCoreCommand},
15384 {"format", Jim_FormatCoreCommand},
15385 {"scan", Jim_ScanCoreCommand},
15386 {"error", Jim_ErrorCoreCommand},
15387 {"lrange", Jim_LrangeCoreCommand},
15388 {"lrepeat", Jim_LrepeatCoreCommand},
15389 {"env", Jim_EnvCoreCommand},
15390 {"source", Jim_SourceCoreCommand},
15391 {"lreverse", Jim_LreverseCoreCommand},
15392 {"range", Jim_RangeCoreCommand},
15393 {"rand", Jim_RandCoreCommand},
15394 {"tailcall", Jim_TailcallCoreCommand},
15395 {"local", Jim_LocalCoreCommand},
15396 {"upcall", Jim_UpcallCoreCommand},
15397 {"apply", Jim_ApplyCoreCommand},
15398 {NULL, NULL},
15401 void Jim_RegisterCoreCommands(Jim_Interp *interp)
15403 int i = 0;
15405 while (Jim_CoreCommandsTable[i].name != NULL) {
15406 Jim_CreateCommand(interp,
15407 Jim_CoreCommandsTable[i].name, Jim_CoreCommandsTable[i].cmdProc, NULL, NULL);
15408 i++;
15412 /* -----------------------------------------------------------------------------
15413 * Interactive prompt
15414 * ---------------------------------------------------------------------------*/
15415 void Jim_MakeErrorMessage(Jim_Interp *interp)
15417 Jim_Obj *argv[2];
15419 argv[0] = Jim_NewStringObj(interp, "errorInfo", -1);
15420 argv[1] = interp->result;
15422 Jim_EvalObjVector(interp, 2, argv);
15426 * Given a null terminated array of strings, returns an allocated, sorted
15427 * copy of the array.
15429 static char **JimSortStringTable(const char *const *tablePtr)
15431 int count;
15432 char **tablePtrSorted;
15434 /* Find the size of the table */
15435 for (count = 0; tablePtr[count]; count++) {
15438 /* Allocate one extra for the terminating NULL pointer */
15439 tablePtrSorted = Jim_Alloc(sizeof(char *) * (count + 1));
15440 memcpy(tablePtrSorted, tablePtr, sizeof(char *) * count);
15441 qsort(tablePtrSorted, count, sizeof(char *), qsortCompareStringPointers);
15442 tablePtrSorted[count] = NULL;
15444 return tablePtrSorted;
15447 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
15448 const char *prefix, const char *const *tablePtr, const char *name)
15450 char **tablePtrSorted;
15451 int i;
15453 if (name == NULL) {
15454 name = "option";
15457 Jim_SetResultFormatted(interp, "%s%s \"%s\": must be ", badtype, name, arg);
15458 tablePtrSorted = JimSortStringTable(tablePtr);
15459 for (i = 0; tablePtrSorted[i]; i++) {
15460 if (tablePtrSorted[i + 1] == NULL && i > 0) {
15461 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
15463 Jim_AppendStrings(interp, Jim_GetResult(interp), prefix, tablePtrSorted[i], NULL);
15464 if (tablePtrSorted[i + 1]) {
15465 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
15468 Jim_Free(tablePtrSorted);
15473 * If objPtr is "-commands" sets the Jim result as a sorted list of options in the table
15474 * and returns JIM_OK.
15476 * Otherwise returns JIM_ERR.
15478 int Jim_CheckShowCommands(Jim_Interp *interp, Jim_Obj *objPtr, const char *const *tablePtr)
15480 if (Jim_CompareStringImmediate(interp, objPtr, "-commands")) {
15481 int i;
15482 char **tablePtrSorted = JimSortStringTable(tablePtr);
15483 Jim_SetResult(interp, Jim_NewListObj(interp, NULL, 0));
15484 for (i = 0; tablePtrSorted[i]; i++) {
15485 Jim_ListAppendElement(interp, Jim_GetResult(interp), Jim_NewStringObj(interp, tablePtrSorted[i], -1));
15487 Jim_Free(tablePtrSorted);
15488 return JIM_OK;
15490 return JIM_ERR;
15493 /* internal rep is stored in ptrIntvalue
15494 * ptr = tablePtr
15495 * int1 = flags
15496 * int2 = index
15498 static const Jim_ObjType getEnumObjType = {
15499 "get-enum",
15500 NULL,
15501 NULL,
15502 NULL,
15503 JIM_TYPE_REFERENCES
15506 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
15507 const char *const *tablePtr, int *indexPtr, const char *name, int flags)
15509 const char *bad = "bad ";
15510 const char *const *entryPtr = NULL;
15511 int i;
15512 int match = -1;
15513 int arglen;
15514 const char *arg;
15516 if (objPtr->typePtr == &getEnumObjType) {
15517 if (objPtr->internalRep.ptrIntValue.ptr == tablePtr && objPtr->internalRep.ptrIntValue.int1 == flags) {
15518 *indexPtr = objPtr->internalRep.ptrIntValue.int2;
15519 return JIM_OK;
15523 arg = Jim_GetString(objPtr, &arglen);
15525 *indexPtr = -1;
15527 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
15528 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
15529 /* Found an exact match */
15530 match = i;
15531 goto found;
15533 if (flags & JIM_ENUM_ABBREV) {
15534 /* Accept an unambiguous abbreviation.
15535 * Note that '-' doesnt' consitute a valid abbreviation
15537 if (strncmp(arg, *entryPtr, arglen) == 0) {
15538 if (*arg == '-' && arglen == 1) {
15539 break;
15541 if (match >= 0) {
15542 bad = "ambiguous ";
15543 goto ambiguous;
15545 match = i;
15550 /* If we had an unambiguous partial match */
15551 if (match >= 0) {
15552 found:
15553 /* Record the match in the object */
15554 Jim_FreeIntRep(interp, objPtr);
15555 objPtr->typePtr = &getEnumObjType;
15556 objPtr->internalRep.ptrIntValue.ptr = (void *)tablePtr;
15557 objPtr->internalRep.ptrIntValue.int1 = flags;
15558 objPtr->internalRep.ptrIntValue.int2 = match;
15559 /* Return the result */
15560 *indexPtr = match;
15561 return JIM_OK;
15564 ambiguous:
15565 if (flags & JIM_ERRMSG) {
15566 JimSetFailedEnumResult(interp, arg, bad, "", tablePtr, name);
15568 return JIM_ERR;
15571 int Jim_FindByName(const char *name, const char * const array[], size_t len)
15573 int i;
15575 for (i = 0; i < (int)len; i++) {
15576 if (array[i] && strcmp(array[i], name) == 0) {
15577 return i;
15580 return -1;
15583 int Jim_IsDict(Jim_Obj *objPtr)
15585 return objPtr->typePtr == &dictObjType;
15588 int Jim_IsList(Jim_Obj *objPtr)
15590 return objPtr->typePtr == &listObjType;
15594 * Very simple printf-like formatting, designed for error messages.
15596 * The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
15597 * The resulting string is created and set as the result.
15599 * Each '%s' should correspond to a regular string parameter.
15600 * Each '%#s' should correspond to a (Jim_Obj *) parameter.
15601 * Any other printf specifier is not allowed (but %% is allowed for the % character).
15603 * e.g. Jim_SetResultFormatted(interp, "Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
15605 * Note: We take advantage of the fact that printf has the same behaviour for both %s and %#s
15607 * Note that any Jim_Obj parameters with zero ref count will be freed as a result of this call.
15609 void Jim_SetResultFormatted(Jim_Interp *interp, const char *format, ...)
15611 /* Initial space needed */
15612 int len = strlen(format);
15613 int extra = 0;
15614 int n = 0;
15615 const char *params[5];
15616 int nobjparam = 0;
15617 Jim_Obj *objparam[5];
15618 char *buf;
15619 va_list args;
15620 int i;
15622 va_start(args, format);
15624 for (i = 0; i < len && n < 5; i++) {
15625 int l;
15627 if (strncmp(format + i, "%s", 2) == 0) {
15628 params[n] = va_arg(args, char *);
15630 l = strlen(params[n]);
15632 else if (strncmp(format + i, "%#s", 3) == 0) {
15633 Jim_Obj *objPtr = va_arg(args, Jim_Obj *);
15635 params[n] = Jim_GetString(objPtr, &l);
15636 objparam[nobjparam++] = objPtr;
15637 Jim_IncrRefCount(objPtr);
15639 else {
15640 if (format[i] == '%') {
15641 i++;
15643 continue;
15645 n++;
15646 extra += l;
15649 len += extra;
15650 buf = Jim_Alloc(len + 1);
15651 len = snprintf(buf, len + 1, format, params[0], params[1], params[2], params[3], params[4]);
15653 va_end(args);
15655 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
15657 for (i = 0; i < nobjparam; i++) {
15658 Jim_DecrRefCount(interp, objparam[i]);
15662 /* stubs */
15663 #ifndef jim_ext_package
15664 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver, int flags)
15666 return JIM_OK;
15668 #endif
15669 #ifndef jim_ext_aio
15670 FILE *Jim_AioFilehandle(Jim_Interp *interp, Jim_Obj *fhObj)
15672 Jim_SetResultString(interp, "aio not enabled", -1);
15673 return NULL;
15675 #endif
15679 * Local Variables: ***
15680 * c-basic-offset: 4 ***
15681 * tab-width: 4 ***
15682 * End: ***