core: command (proc) names may now contained embedded nulls
[jimtcl.git] / jim.c
blob233dba2a2273c27da5033538dc541827053b7dfe
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 static void JimIncrCmdRefCount(Jim_Cmd *cmdPtr)
3762 cmdPtr->inUse++;
3765 static void JimDecrCmdRefCount(Jim_Interp *interp, Jim_Cmd *cmdPtr)
3767 if (--cmdPtr->inUse == 0) {
3768 if (cmdPtr->isproc) {
3769 Jim_DecrRefCount(interp, cmdPtr->u.proc.argListObjPtr);
3770 Jim_DecrRefCount(interp, cmdPtr->u.proc.bodyObjPtr);
3771 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
3772 if (cmdPtr->u.proc.staticVars) {
3773 Jim_FreeHashTable(cmdPtr->u.proc.staticVars);
3774 Jim_Free(cmdPtr->u.proc.staticVars);
3777 else {
3778 /* native (C) */
3779 if (cmdPtr->u.native.delProc) {
3780 cmdPtr->u.native.delProc(interp, cmdPtr->u.native.privData);
3783 if (cmdPtr->prevCmd) {
3784 /* Delete any pushed command too */
3785 JimDecrCmdRefCount(interp, cmdPtr->prevCmd);
3787 Jim_Free(cmdPtr);
3791 /* Variables HashTable Type.
3793 * Keys are dynamically allocated strings, Values are Jim_Var structures.
3795 static void JimVariablesHTValDestructor(void *interp, void *val)
3797 Jim_DecrRefCount(interp, ((Jim_Var *)val)->objPtr);
3798 Jim_Free(val);
3801 static unsigned int JimObjectHTHashFunction(const void *key)
3803 int len;
3804 const char *str = Jim_GetString((Jim_Obj *)key, &len);
3805 return Jim_GenHashFunction((const unsigned char *)str, len);
3808 static int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
3810 return Jim_StringEqObj((Jim_Obj *)key1, (Jim_Obj *)key2);
3813 static void *JimObjectHTKeyValDup(void *privdata, const void *val)
3815 Jim_IncrRefCount((Jim_Obj *)val);
3816 return (void *)val;
3819 static void JimObjectHTKeyValDestructor(void *interp, void *val)
3821 Jim_DecrRefCount(interp, (Jim_Obj *)val);
3825 static const Jim_HashTableType JimVariablesHashTableType = {
3826 JimObjectHTHashFunction, /* hash function */
3827 JimObjectHTKeyValDup, /* key dup */
3828 NULL, /* val dup */
3829 JimObjectHTKeyCompare, /* key compare */
3830 JimObjectHTKeyValDestructor, /* key destructor */
3831 JimVariablesHTValDestructor /* val destructor */
3834 /* Commands HashTable Type.
3836 * Keys are Jim Objects where any leading namespace qualifier
3837 * is ignored. Values are Jim_Cmd structures.
3841 * Like Jim_GetString() but strips any leading namespace qualifier.
3843 static const char *Jim_GetStringNoQualifier(Jim_Obj *objPtr, int *length)
3845 int len;
3846 const char *str = Jim_GetString(objPtr, &len);
3847 if (len >= 2 && str[0] == ':' && str[1] == ':') {
3848 while (len && *str == ':') {
3849 len--;
3850 str++;
3853 *length = len;
3854 return str;
3857 static unsigned int JimCommandsHT_HashFunction(const void *key)
3859 int len;
3860 const char *str = Jim_GetStringNoQualifier((Jim_Obj *)key, &len);
3861 return Jim_GenHashFunction((const unsigned char *)str, len);
3864 static int JimCommandsHT_KeyCompare(void *privdata, const void *key1, const void *key2)
3866 int len1, len2;
3867 const char *str1 = Jim_GetStringNoQualifier((Jim_Obj *)key1, &len1);
3868 const char *str2 = Jim_GetStringNoQualifier((Jim_Obj *)key2, &len2);
3869 return len1 == len2 && memcmp(str1, str2, len1) == 0;
3872 static void JimCommandsHT_ValDestructor(void *interp, void *val)
3874 JimDecrCmdRefCount(interp, val);
3877 static const Jim_HashTableType JimCommandsHashTableType = {
3878 JimCommandsHT_HashFunction, /* hash function */
3879 JimObjectHTKeyValDup, /* key dup */
3880 NULL, /* val dup */
3881 JimCommandsHT_KeyCompare, /* key compare */
3882 JimObjectHTKeyValDestructor, /* key destructor */
3883 JimCommandsHT_ValDestructor /* val destructor */
3886 /* ------------------------- Commands related functions --------------------- */
3889 * If nameObjPtr starts with "::", returns it.
3890 * Otherwise returns a new object with nameObjPtr prefixed with "::".
3891 * In this case, decrements the ref count of nameObjPtr.
3893 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3895 #ifdef jim_ext_namespace
3896 Jim_Obj *resultObj;
3898 const char *name = Jim_String(nameObjPtr);
3899 if (name[0] == ':' && name[1] == ':') {
3900 return nameObjPtr;
3902 Jim_IncrRefCount(nameObjPtr);
3903 resultObj = Jim_NewStringObj(interp, "::", -1);
3904 Jim_AppendObj(interp, resultObj, nameObjPtr);
3905 Jim_DecrRefCount(interp, nameObjPtr);
3907 return resultObj;
3908 #else
3909 return nameObjPtr;
3910 #endif
3914 * If the name in objPtr is not fully qualified, and a non-global namespace
3915 * is in effect, qualifies the name with the current namespace and returns the new name.
3916 * Otherwise returns objPtr.
3918 * In either case the ref count is incremented and should be decremented by the caller.
3919 * with Jim_DecrRefCount()
3921 static Jim_Obj *JimQualifyName(Jim_Interp *interp, Jim_Obj *objPtr)
3923 #ifdef jim_ext_namespace
3924 if (Jim_Length(interp->framePtr->nsObj)) {
3925 int len;
3926 const char *name = Jim_GetString(objPtr, &len);
3927 if (len < 2 || name[0] != ':' || name[1] != ':') {
3928 /* OK. Need to qualify this name */
3929 objPtr = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3930 Jim_AppendStrings(interp, objPtr, "::", name, NULL);
3933 #endif
3934 Jim_IncrRefCount(objPtr);
3935 return objPtr;
3939 * Note that nameObjPtr must already be namespace qualified.
3941 static int JimCreateCommand(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Cmd *cmd)
3943 /* It may already exist, so we try to delete the old one.
3944 * Note that reference count means that it won't be deleted yet if
3945 * it exists in the call stack.
3947 * BUT, if 'local' is in force, instead of deleting the existing
3948 * proc, we stash a reference to the old proc here.
3950 Jim_HashEntry *he = Jim_FindHashEntry(&interp->commands, nameObjPtr);
3951 if (he) {
3952 /* There was an old cmd with the same name,
3953 * so this requires a 'proc epoch' update. */
3955 /* If a procedure with the same name didn't exist there is no need
3956 * to increment the 'proc epoch' because creation of a new procedure
3957 * can never affect existing cached commands. We don't do
3958 * negative caching. */
3959 Jim_InterpIncrProcEpoch(interp);
3962 if (he && interp->local) {
3963 /* Push this command over the top of the previous one */
3964 cmd->prevCmd = Jim_GetHashEntryVal(he);
3965 Jim_SetHashVal(&interp->commands, he, cmd);
3967 else {
3968 if (he) {
3969 /* Replace the existing command */
3970 Jim_DeleteHashEntry(&interp->commands, nameObjPtr);
3973 Jim_AddHashEntry(&interp->commands, nameObjPtr, cmd);
3975 return JIM_OK;
3978 int Jim_CreateCommandObj(Jim_Interp *interp, Jim_Obj *cmdNameObj,
3979 Jim_CmdProc *cmdProc, void *privData, Jim_DelCmdProc *delProc)
3981 Jim_Cmd *cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3983 /* Store the new details for this command */
3984 memset(cmdPtr, 0, sizeof(*cmdPtr));
3985 cmdPtr->inUse = 1;
3986 cmdPtr->u.native.delProc = delProc;
3987 cmdPtr->u.native.cmdProc = cmdProc;
3988 cmdPtr->u.native.privData = privData;
3990 JimCreateCommand(interp, cmdNameObj, cmdPtr);
3992 return JIM_OK;
3996 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdNameStr,
3997 Jim_CmdProc *cmdProc, void *privData, Jim_DelCmdProc *delProc)
3999 return Jim_CreateCommandObj(interp, Jim_NewStringObj(interp, cmdNameStr, -1), cmdProc, privData, delProc);
4002 static int JimCreateProcedureStatics(Jim_Interp *interp, Jim_Cmd *cmdPtr, Jim_Obj *staticsListObjPtr)
4004 int len, i;
4006 len = Jim_ListLength(interp, staticsListObjPtr);
4007 if (len == 0) {
4008 return JIM_OK;
4011 cmdPtr->u.proc.staticVars = Jim_Alloc(sizeof(Jim_HashTable));
4012 Jim_InitHashTable(cmdPtr->u.proc.staticVars, &JimVariablesHashTableType, interp);
4013 for (i = 0; i < len; i++) {
4014 Jim_Obj *objPtr, *initObjPtr, *nameObjPtr;
4015 Jim_Var *varPtr;
4016 int subLen;
4018 objPtr = Jim_ListGetIndex(interp, staticsListObjPtr, i);
4019 /* Check if it's composed of two elements. */
4020 subLen = Jim_ListLength(interp, objPtr);
4021 if (subLen == 1 || subLen == 2) {
4022 /* Try to get the variable value from the current
4023 * environment. */
4024 nameObjPtr = Jim_ListGetIndex(interp, objPtr, 0);
4025 if (subLen == 1) {
4026 initObjPtr = Jim_GetVariable(interp, nameObjPtr, JIM_NONE);
4027 if (initObjPtr == NULL) {
4028 Jim_SetResultFormatted(interp,
4029 "variable for initialization of static \"%#s\" not found in the local context",
4030 nameObjPtr);
4031 return JIM_ERR;
4034 else {
4035 initObjPtr = Jim_ListGetIndex(interp, objPtr, 1);
4038 varPtr = Jim_Alloc(sizeof(*varPtr));
4039 varPtr->objPtr = initObjPtr;
4040 Jim_IncrRefCount(initObjPtr);
4041 varPtr->linkFramePtr = NULL;
4042 if (JimSetNewVariable(cmdPtr->u.proc.staticVars, nameObjPtr, varPtr) != JIM_OK) {
4043 Jim_SetResultFormatted(interp,
4044 "static variable name \"%#s\" duplicated in statics list", nameObjPtr);
4045 Jim_DecrRefCount(interp, initObjPtr);
4046 Jim_Free(varPtr);
4047 return JIM_ERR;
4050 else {
4051 Jim_SetResultFormatted(interp, "too many fields in static specifier \"%#s\"",
4052 objPtr);
4053 return JIM_ERR;
4056 return JIM_OK;
4059 /* memrchr() is not standard */
4060 static const char *Jim_memrchr(const char *p, int c, int len)
4062 int i;
4063 for (i = len; i > 0; i--) {
4064 if (p[i] == c) {
4065 return p + i;
4068 return NULL;
4072 * If the command is a proc, sets/updates the cached namespace (nsObj)
4073 * based on the command name.
4075 static void JimUpdateProcNamespace(Jim_Interp *interp, Jim_Cmd *cmdPtr, Jim_Obj *nameObjPtr)
4077 #ifdef jim_ext_namespace
4078 if (cmdPtr->isproc) {
4079 int len;
4080 const char *cmdname = Jim_GetStringNoQualifier(nameObjPtr, &len);
4081 /* XXX: Really need JimNamespaceSplit() */
4082 const char *pt = Jim_memrchr(cmdname, ':', len);
4083 if (pt && pt != cmdname && pt[-1] == ':') {
4084 pt++;
4085 /* Now pt points to the base name .e.g. ::abc::def::ghi points to ghi
4086 * while cmdname points to abc
4088 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
4089 cmdPtr->u.proc.nsObj = Jim_NewStringObj(interp, cmdname, pt - cmdname - 2);
4090 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
4092 Jim_Obj *tempObj = Jim_NewStringObj(interp, pt, len - (pt - cmdname));
4093 if (Jim_FindHashEntry(&interp->commands, tempObj)) {
4094 /* This command shadows a global command, so a proc epoch update is required */
4095 Jim_InterpIncrProcEpoch(interp);
4097 Jim_FreeNewObj(interp, tempObj);
4100 #endif
4103 static Jim_Cmd *JimCreateProcedureCmd(Jim_Interp *interp, Jim_Obj *argListObjPtr,
4104 Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr, Jim_Obj *nsObj)
4106 Jim_Cmd *cmdPtr;
4107 int argListLen;
4108 int i;
4110 argListLen = Jim_ListLength(interp, argListObjPtr);
4112 /* Allocate space for both the command pointer and the arg list */
4113 cmdPtr = Jim_Alloc(sizeof(*cmdPtr) + sizeof(struct Jim_ProcArg) * argListLen);
4114 memset(cmdPtr, 0, sizeof(*cmdPtr));
4115 cmdPtr->inUse = 1;
4116 cmdPtr->isproc = 1;
4117 cmdPtr->u.proc.argListObjPtr = argListObjPtr;
4118 cmdPtr->u.proc.argListLen = argListLen;
4119 cmdPtr->u.proc.bodyObjPtr = bodyObjPtr;
4120 cmdPtr->u.proc.argsPos = -1;
4121 cmdPtr->u.proc.arglist = (struct Jim_ProcArg *)(cmdPtr + 1);
4122 cmdPtr->u.proc.nsObj = nsObj ? nsObj : interp->emptyObj;
4123 Jim_IncrRefCount(argListObjPtr);
4124 Jim_IncrRefCount(bodyObjPtr);
4125 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
4127 /* Create the statics hash table. */
4128 if (staticsListObjPtr && JimCreateProcedureStatics(interp, cmdPtr, staticsListObjPtr) != JIM_OK) {
4129 goto err;
4132 /* Parse the args out into arglist, validating as we go */
4133 /* Examine the argument list for default parameters and 'args' */
4134 for (i = 0; i < argListLen; i++) {
4135 Jim_Obj *argPtr;
4136 Jim_Obj *nameObjPtr;
4137 Jim_Obj *defaultObjPtr;
4138 int len;
4140 /* Examine a parameter */
4141 argPtr = Jim_ListGetIndex(interp, argListObjPtr, i);
4142 len = Jim_ListLength(interp, argPtr);
4143 if (len == 0) {
4144 Jim_SetResultString(interp, "argument with no name", -1);
4145 err:
4146 JimDecrCmdRefCount(interp, cmdPtr);
4147 return NULL;
4149 if (len > 2) {
4150 Jim_SetResultFormatted(interp, "too many fields in argument specifier \"%#s\"", argPtr);
4151 goto err;
4154 if (len == 2) {
4155 /* Optional parameter */
4156 nameObjPtr = Jim_ListGetIndex(interp, argPtr, 0);
4157 defaultObjPtr = Jim_ListGetIndex(interp, argPtr, 1);
4159 else {
4160 /* Required parameter */
4161 nameObjPtr = argPtr;
4162 defaultObjPtr = NULL;
4166 if (Jim_CompareStringImmediate(interp, nameObjPtr, "args")) {
4167 if (cmdPtr->u.proc.argsPos >= 0) {
4168 Jim_SetResultString(interp, "'args' specified more than once", -1);
4169 goto err;
4171 cmdPtr->u.proc.argsPos = i;
4173 else {
4174 if (len == 2) {
4175 cmdPtr->u.proc.optArity++;
4177 else {
4178 cmdPtr->u.proc.reqArity++;
4182 cmdPtr->u.proc.arglist[i].nameObjPtr = nameObjPtr;
4183 cmdPtr->u.proc.arglist[i].defaultObjPtr = defaultObjPtr;
4186 return cmdPtr;
4189 int Jim_DeleteCommand(Jim_Interp *interp, Jim_Obj *nameObj)
4191 int ret = JIM_OK;
4193 nameObj = JimQualifyName(interp, nameObj);
4195 if (Jim_DeleteHashEntry(&interp->commands, nameObj) == JIM_ERR) {
4196 Jim_SetResultFormatted(interp, "can't delete \"%#s\": command doesn't exist", nameObj);
4197 ret = JIM_ERR;
4199 else {
4200 Jim_InterpIncrProcEpoch(interp);
4202 Jim_DecrRefCount(interp, nameObj);
4204 return ret;
4207 int Jim_RenameCommand(Jim_Interp *interp, Jim_Obj *oldNameObj, Jim_Obj *newNameObj)
4209 int ret = JIM_ERR;
4210 Jim_HashEntry *he;
4211 Jim_Cmd *cmdPtr;
4213 if (Jim_Length(newNameObj) == 0) {
4214 return Jim_DeleteCommand(interp, oldNameObj);
4217 /* each name may need to have the current namespace added to it */
4219 oldNameObj = JimQualifyName(interp, oldNameObj);
4220 newNameObj = JimQualifyName(interp, newNameObj);
4222 /* Does it exist? */
4223 he = Jim_FindHashEntry(&interp->commands, oldNameObj);
4224 if (he == NULL) {
4225 Jim_SetResultFormatted(interp, "can't rename \"%#s\": command doesn't exist", oldNameObj);
4227 else if (Jim_FindHashEntry(&interp->commands, newNameObj)) {
4228 Jim_SetResultFormatted(interp, "can't rename to \"%#s\": command already exists", newNameObj);
4230 else {
4231 cmdPtr = Jim_GetHashEntryVal(he);
4232 if (cmdPtr->prevCmd) {
4233 /* If the command replaced another command with 'local', renaming it
4234 * would break the usage of upcall, so don't allow it.
4236 Jim_SetResultFormatted(interp, "can't rename local command \"%#s\"", oldNameObj);
4238 else {
4239 /* Add the new name first */
4240 JimIncrCmdRefCount(cmdPtr);
4241 JimUpdateProcNamespace(interp, cmdPtr, newNameObj);
4242 Jim_AddHashEntry(&interp->commands, newNameObj, cmdPtr);
4244 /* Now remove the old name */
4245 Jim_DeleteHashEntry(&interp->commands, oldNameObj);
4247 /* Increment the epoch */
4248 Jim_InterpIncrProcEpoch(interp);
4250 ret = JIM_OK;
4254 Jim_DecrRefCount(interp, oldNameObj);
4255 Jim_DecrRefCount(interp, newNameObj);
4257 return ret;
4260 /* -----------------------------------------------------------------------------
4261 * Command object
4262 * ---------------------------------------------------------------------------*/
4264 static void FreeCommandInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4266 Jim_DecrRefCount(interp, objPtr->internalRep.cmdValue.nsObj);
4269 static void DupCommandInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4271 dupPtr->internalRep.cmdValue = srcPtr->internalRep.cmdValue;
4272 dupPtr->typePtr = srcPtr->typePtr;
4273 Jim_IncrRefCount(dupPtr->internalRep.cmdValue.nsObj);
4276 static const Jim_ObjType commandObjType = {
4277 "command",
4278 FreeCommandInternalRep,
4279 DupCommandInternalRep,
4280 NULL,
4281 JIM_TYPE_REFERENCES,
4284 /* This function returns the command structure for the command name
4285 * stored in objPtr. It specializes the objPtr to contain
4286 * cached info instead of performing the lookup into the hash table
4287 * every time. The information cached may not be up-to-date, in this
4288 * case the lookup is performed and the cache updated.
4290 * Respects the 'upcall' setting.
4292 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4294 Jim_Cmd *cmd;
4296 /* In order to be valid, the proc epoch must match and
4297 * the lookup must have occurred in the same namespace
4299 if (objPtr->typePtr != &commandObjType ||
4300 objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch
4301 #ifdef jim_ext_namespace
4302 || !Jim_StringEqObj(objPtr->internalRep.cmdValue.nsObj, interp->framePtr->nsObj)
4303 #endif
4305 /* Not cached or out of date, so lookup */
4306 Jim_Obj *qualifiedNameObj = JimQualifyName(interp, objPtr);
4307 Jim_HashEntry *he = Jim_FindHashEntry(&interp->commands, qualifiedNameObj);
4308 #ifdef jim_ext_namespace
4309 if (he == NULL && Jim_Length(interp->framePtr->nsObj)) {
4310 he = Jim_FindHashEntry(&interp->commands, objPtr);
4312 #endif
4313 if (he == NULL) {
4314 if (flags & JIM_ERRMSG) {
4315 Jim_SetResultFormatted(interp, "invalid command name \"%#s\"", objPtr);
4317 Jim_DecrRefCount(interp, qualifiedNameObj);
4318 return NULL;
4320 cmd = Jim_GetHashEntryVal(he);
4322 /* Free the old internal rep and set the new one. */
4323 Jim_FreeIntRep(interp, objPtr);
4324 objPtr->typePtr = &commandObjType;
4325 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
4326 objPtr->internalRep.cmdValue.cmdPtr = cmd;
4327 objPtr->internalRep.cmdValue.nsObj = interp->framePtr->nsObj;
4328 Jim_IncrRefCount(interp->framePtr->nsObj);
4329 Jim_DecrRefCount(interp, qualifiedNameObj);
4331 else {
4332 cmd = objPtr->internalRep.cmdValue.cmdPtr;
4334 while (cmd->u.proc.upcall) {
4335 cmd = cmd->prevCmd;
4337 return cmd;
4340 /* -----------------------------------------------------------------------------
4341 * Variables
4342 * ---------------------------------------------------------------------------*/
4344 /* -----------------------------------------------------------------------------
4345 * Variable object
4346 * ---------------------------------------------------------------------------*/
4348 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
4350 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4352 static const Jim_ObjType variableObjType = {
4353 "variable",
4354 NULL,
4355 NULL,
4356 NULL,
4357 JIM_TYPE_REFERENCES,
4360 /* This method should be called only by the variable API.
4361 * It returns JIM_OK on success (variable already exists),
4362 * JIM_ERR if it does not exist, JIM_DICT_SUGAR if it's not
4363 * a variable name, but syntax glue for [dict] i.e. the last
4364 * character is ')' */
4365 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
4367 const char *varName;
4368 Jim_CallFrame *framePtr;
4369 int global;
4370 int len;
4371 Jim_Var *var;
4373 /* Check if the object is already an uptodate variable */
4374 if (objPtr->typePtr == &variableObjType) {
4375 framePtr = objPtr->internalRep.varValue.global ? interp->topFramePtr : interp->framePtr;
4376 if (objPtr->internalRep.varValue.callFrameId == framePtr->id) {
4377 /* nothing to do */
4378 return JIM_OK;
4380 /* Need to re-resolve the variable in the updated callframe */
4382 else if (objPtr->typePtr == &dictSubstObjType) {
4383 return JIM_DICT_SUGAR;
4386 varName = Jim_GetString(objPtr, &len);
4388 /* Make sure it's not syntax glue to get/set dict. */
4389 if (len && varName[len - 1] == ')' && strchr(varName, '(') != NULL) {
4390 return JIM_DICT_SUGAR;
4393 if (varName[0] == ':' && varName[1] == ':') {
4394 while (*varName == ':') {
4395 varName++;
4396 len--;
4398 global = 1;
4399 framePtr = interp->topFramePtr;
4400 /* XXX should use length */
4401 Jim_Obj *tempObj = Jim_NewStringObj(interp, varName, len);
4402 var = JimFindVariable(&framePtr->vars, tempObj);
4403 Jim_FreeNewObj(interp, tempObj);
4405 else {
4406 global = 0;
4407 framePtr = interp->framePtr;
4408 /* Resolve this name in the variables hash table */
4409 var = JimFindVariable(&framePtr->vars, objPtr);
4410 if (var == NULL && framePtr->staticVars) {
4411 /* Try with static vars. */
4412 var = JimFindVariable(framePtr->staticVars, objPtr);
4416 if (var == NULL) {
4417 return JIM_ERR;
4420 /* Free the old internal repr and set the new one. */
4421 Jim_FreeIntRep(interp, objPtr);
4422 objPtr->typePtr = &variableObjType;
4423 objPtr->internalRep.varValue.callFrameId = framePtr->id;
4424 objPtr->internalRep.varValue.varPtr = var;
4425 objPtr->internalRep.varValue.global = global;
4426 return JIM_OK;
4429 /* -------------------- Variables related functions ------------------------- */
4430 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr, Jim_Obj *valObjPtr);
4431 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr, int flags);
4433 static int JimSetNewVariable(Jim_HashTable *ht, Jim_Obj *nameObjPtr, Jim_Var *var)
4435 return Jim_AddHashEntry(ht, nameObjPtr, var);
4438 static Jim_Var *JimFindVariable(Jim_HashTable *ht, Jim_Obj *nameObjPtr)
4440 Jim_HashEntry *he = Jim_FindHashEntry(ht, nameObjPtr);
4441 if (he) {
4442 return (Jim_Var *)Jim_GetHashEntryVal(he);
4444 return NULL;
4447 static int JimUnsetVariable(Jim_HashTable *ht, Jim_Obj *nameObjPtr)
4449 return Jim_DeleteHashEntry(ht, nameObjPtr);
4452 static Jim_Var *JimCreateVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4454 const char *name;
4455 Jim_CallFrame *framePtr;
4456 int global;
4457 int len;
4459 /* New variable to create */
4460 Jim_Var *var = Jim_Alloc(sizeof(*var));
4462 var->objPtr = valObjPtr;
4463 Jim_IncrRefCount(valObjPtr);
4464 var->linkFramePtr = NULL;
4466 name = Jim_GetString(nameObjPtr, &len);
4467 if (name[0] == ':' && name[1] == ':') {
4468 while (*name == ':') {
4469 name++;
4470 len--;
4472 framePtr = interp->topFramePtr;
4473 global = 1;
4474 JimSetNewVariable(&framePtr->vars, Jim_NewStringObj(interp, name, len), var);
4476 else {
4477 framePtr = interp->framePtr;
4478 global = 0;
4479 JimSetNewVariable(&framePtr->vars, nameObjPtr, var);
4482 /* Make the object int rep a variable */
4483 Jim_FreeIntRep(interp, nameObjPtr);
4484 nameObjPtr->typePtr = &variableObjType;
4485 nameObjPtr->internalRep.varValue.callFrameId = framePtr->id;
4486 nameObjPtr->internalRep.varValue.varPtr = var;
4487 nameObjPtr->internalRep.varValue.global = global;
4489 return var;
4492 /* For now that's dummy. Variables lookup should be optimized
4493 * in many ways, with caching of lookups, and possibly with
4494 * a table of pre-allocated vars in every CallFrame for local vars.
4495 * All the caching should also have an 'epoch' mechanism similar
4496 * to the one used by Tcl for procedures lookup caching. */
4499 * Set the variable nameObjPtr to value valObjptr.
4501 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4503 int err;
4504 Jim_Var *var;
4506 switch (SetVariableFromAny(interp, nameObjPtr)) {
4507 case JIM_DICT_SUGAR:
4508 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
4510 case JIM_ERR:
4511 JimCreateVariable(interp, nameObjPtr, valObjPtr);
4512 break;
4514 case JIM_OK:
4515 var = nameObjPtr->internalRep.varValue.varPtr;
4516 if (var->linkFramePtr == NULL) {
4517 Jim_IncrRefCount(valObjPtr);
4518 Jim_DecrRefCount(interp, var->objPtr);
4519 var->objPtr = valObjPtr;
4521 else { /* Else handle the link */
4522 Jim_CallFrame *savedCallFrame;
4524 savedCallFrame = interp->framePtr;
4525 interp->framePtr = var->linkFramePtr;
4526 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
4527 interp->framePtr = savedCallFrame;
4528 if (err != JIM_OK)
4529 return err;
4532 return JIM_OK;
4535 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4537 Jim_Obj *nameObjPtr;
4538 int result;
4540 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4541 Jim_IncrRefCount(nameObjPtr);
4542 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
4543 Jim_DecrRefCount(interp, nameObjPtr);
4544 return result;
4547 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4549 Jim_CallFrame *savedFramePtr;
4550 int result;
4552 savedFramePtr = interp->framePtr;
4553 interp->framePtr = interp->topFramePtr;
4554 result = Jim_SetVariableStr(interp, name, objPtr);
4555 interp->framePtr = savedFramePtr;
4556 return result;
4559 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
4561 Jim_Obj *valObjPtr;
4562 int result;
4564 valObjPtr = Jim_NewStringObj(interp, val, -1);
4565 Jim_IncrRefCount(valObjPtr);
4566 result = Jim_SetVariableStr(interp, name, valObjPtr);
4567 Jim_DecrRefCount(interp, valObjPtr);
4568 return result;
4571 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
4572 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
4574 const char *varName;
4575 const char *targetName;
4576 Jim_CallFrame *framePtr;
4577 Jim_Var *varPtr;
4578 int len;
4579 int varnamelen;
4581 /* Check for an existing variable or link */
4582 switch (SetVariableFromAny(interp, nameObjPtr)) {
4583 case JIM_DICT_SUGAR:
4584 /* XXX: This message seem unnecessarily verbose, but it matches Tcl */
4585 Jim_SetResultFormatted(interp, "bad variable name \"%#s\": upvar won't create a scalar variable that looks like an array element", nameObjPtr);
4586 return JIM_ERR;
4588 case JIM_OK:
4589 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4591 if (varPtr->linkFramePtr == NULL) {
4592 Jim_SetResultFormatted(interp, "variable \"%#s\" already exists", nameObjPtr);
4593 return JIM_ERR;
4596 /* It exists, but is a link, so first delete the link */
4597 varPtr->linkFramePtr = NULL;
4598 break;
4601 /* Resolve the call frames for both variables */
4602 /* XXX: SetVariableFromAny() already did this! */
4603 varName = Jim_GetString(nameObjPtr, &varnamelen);
4605 if (varName[0] == ':' && varName[1] == ':') {
4606 while (*varName == ':') {
4607 varName++;
4608 varnamelen--;
4610 /* Linking a global var does nothing */
4611 framePtr = interp->topFramePtr;
4613 else {
4614 framePtr = interp->framePtr;
4617 targetName = Jim_GetString(targetNameObjPtr, &len);
4618 if (targetName[0] == ':' && targetName[1] == ':') {
4619 while (*targetName == ':') {
4620 targetName++;
4621 len--;
4623 targetNameObjPtr = Jim_NewStringObj(interp, targetName, len);
4624 targetCallFrame = interp->topFramePtr;
4626 Jim_IncrRefCount(targetNameObjPtr);
4628 if (framePtr->level < targetCallFrame->level) {
4629 Jim_SetResultFormatted(interp,
4630 "bad variable name \"%#s\": upvar won't create namespace variable that refers to procedure variable",
4631 nameObjPtr);
4632 Jim_DecrRefCount(interp, targetNameObjPtr);
4633 return JIM_ERR;
4636 /* Check for cycles. */
4637 if (framePtr == targetCallFrame) {
4638 Jim_Obj *objPtr = targetNameObjPtr;
4640 /* Cycles are only possible with 'uplevel 0' */
4641 while (1) {
4642 if (Jim_Length(objPtr) == varnamelen && memcmp(Jim_String(objPtr), varName, varnamelen) == 0) {
4643 Jim_SetResultString(interp, "can't upvar from variable to itself", -1);
4644 Jim_DecrRefCount(interp, targetNameObjPtr);
4645 return JIM_ERR;
4647 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
4648 break;
4649 varPtr = objPtr->internalRep.varValue.varPtr;
4650 if (varPtr->linkFramePtr != targetCallFrame)
4651 break;
4652 objPtr = varPtr->objPtr;
4656 /* Perform the binding */
4657 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
4658 /* We are now sure 'nameObjPtr' type is variableObjType */
4659 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
4660 Jim_DecrRefCount(interp, targetNameObjPtr);
4661 return JIM_OK;
4664 /* Return the Jim_Obj pointer associated with a variable name,
4665 * or NULL if the variable was not found in the current context.
4666 * The same optimization discussed in the comment to the
4667 * 'SetVariable' function should apply here.
4669 * If JIM_UNSHARED is set and the variable is an array element (dict sugar)
4670 * in a dictionary which is shared, the array variable value is duplicated first.
4671 * This allows the array element to be updated (e.g. append, lappend) without
4672 * affecting other references to the dictionary.
4674 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4676 switch (SetVariableFromAny(interp, nameObjPtr)) {
4677 case JIM_OK:{
4678 Jim_Var *varPtr = nameObjPtr->internalRep.varValue.varPtr;
4680 if (varPtr->linkFramePtr == NULL) {
4681 return varPtr->objPtr;
4683 else {
4684 Jim_Obj *objPtr;
4686 /* The variable is a link? Resolve it. */
4687 Jim_CallFrame *savedCallFrame = interp->framePtr;
4689 interp->framePtr = varPtr->linkFramePtr;
4690 objPtr = Jim_GetVariable(interp, varPtr->objPtr, flags);
4691 interp->framePtr = savedCallFrame;
4692 if (objPtr) {
4693 return objPtr;
4695 /* Error, so fall through to the error message */
4698 break;
4700 case JIM_DICT_SUGAR:
4701 /* [dict] syntax sugar. */
4702 return JimDictSugarGet(interp, nameObjPtr, flags);
4704 if (flags & JIM_ERRMSG) {
4705 Jim_SetResultFormatted(interp, "can't read \"%#s\": no such variable", nameObjPtr);
4707 return NULL;
4710 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4712 Jim_CallFrame *savedFramePtr;
4713 Jim_Obj *objPtr;
4715 savedFramePtr = interp->framePtr;
4716 interp->framePtr = interp->topFramePtr;
4717 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4718 interp->framePtr = savedFramePtr;
4720 return objPtr;
4723 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
4725 Jim_Obj *nameObjPtr, *varObjPtr;
4727 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4728 Jim_IncrRefCount(nameObjPtr);
4729 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4730 Jim_DecrRefCount(interp, nameObjPtr);
4731 return varObjPtr;
4734 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name, int flags)
4736 Jim_CallFrame *savedFramePtr;
4737 Jim_Obj *objPtr;
4739 savedFramePtr = interp->framePtr;
4740 interp->framePtr = interp->topFramePtr;
4741 objPtr = Jim_GetVariableStr(interp, name, flags);
4742 interp->framePtr = savedFramePtr;
4744 return objPtr;
4747 /* Unset a variable.
4748 * Note: On success unset invalidates all the (cached) variable objects
4749 * by incrementing callFrameEpoch
4751 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4753 Jim_Var *varPtr;
4754 int retval;
4755 Jim_CallFrame *framePtr;
4757 retval = SetVariableFromAny(interp, nameObjPtr);
4758 if (retval == JIM_DICT_SUGAR) {
4759 /* [dict] syntax sugar. */
4760 return JimDictSugarSet(interp, nameObjPtr, NULL);
4762 else if (retval == JIM_OK) {
4763 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4765 /* If it's a link call UnsetVariable recursively */
4766 if (varPtr->linkFramePtr) {
4767 framePtr = interp->framePtr;
4768 interp->framePtr = varPtr->linkFramePtr;
4769 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
4770 interp->framePtr = framePtr;
4772 else {
4773 if (nameObjPtr->internalRep.varValue.global) {
4774 int len;
4775 const char *name = Jim_GetString(nameObjPtr, &len);
4776 while (*name == ':') {
4777 name++;
4778 len--;
4780 framePtr = interp->topFramePtr;
4781 Jim_Obj *tempObj = Jim_NewStringObj(interp, name, len);
4782 retval = JimUnsetVariable(&framePtr->vars, tempObj);
4783 Jim_FreeNewObj(interp, tempObj);
4785 else {
4786 framePtr = interp->framePtr;
4787 retval = JimUnsetVariable(&framePtr->vars, nameObjPtr);
4790 if (retval == JIM_OK) {
4791 /* Change the callframe id, invalidating var lookup caching */
4792 framePtr->id = interp->callFrameEpoch++;
4796 if (retval != JIM_OK && (flags & JIM_ERRMSG)) {
4797 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such variable", nameObjPtr);
4799 return retval;
4802 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
4804 /* Given a variable name for [dict] operation syntax sugar,
4805 * this function returns two objects, the first with the name
4806 * of the variable to set, and the second with the respective key.
4807 * For example "foo(bar)" will return objects with string repr. of
4808 * "foo" and "bar".
4810 * The returned objects have refcount = 1. The function can't fail. */
4811 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
4812 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
4814 const char *str, *p;
4815 int len, keyLen;
4816 Jim_Obj *varObjPtr, *keyObjPtr;
4818 str = Jim_GetString(objPtr, &len);
4820 p = strchr(str, '(');
4821 JimPanic((p == NULL, "JimDictSugarParseVarKey() called for non-dict-sugar (%s)", str));
4823 varObjPtr = Jim_NewStringObj(interp, str, p - str);
4825 p++;
4826 keyLen = (str + len) - p;
4827 if (str[len - 1] == ')') {
4828 keyLen--;
4831 /* Create the objects with the variable name and key. */
4832 keyObjPtr = Jim_NewStringObj(interp, p, keyLen);
4834 Jim_IncrRefCount(varObjPtr);
4835 Jim_IncrRefCount(keyObjPtr);
4836 *varPtrPtr = varObjPtr;
4837 *keyPtrPtr = keyObjPtr;
4840 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
4841 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
4842 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *valObjPtr)
4844 int err;
4846 SetDictSubstFromAny(interp, objPtr);
4848 err = Jim_SetDictKeysVector(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4849 &objPtr->internalRep.dictSubstValue.indexObjPtr, 1, valObjPtr, JIM_MUSTEXIST);
4851 if (err == JIM_OK) {
4852 /* Don't keep an extra ref to the result */
4853 Jim_SetEmptyResult(interp);
4855 else {
4856 if (!valObjPtr) {
4857 /* Better error message for unset a(2) where a exists but a(2) doesn't */
4858 if (Jim_GetVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_NONE)) {
4859 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such element in array",
4860 objPtr);
4861 return err;
4864 /* Make the error more informative and Tcl-compatible */
4865 Jim_SetResultFormatted(interp, "can't %s \"%#s\": variable isn't array",
4866 (valObjPtr ? "set" : "unset"), objPtr);
4868 return err;
4872 * Expands the array variable (dict sugar) and returns the result, or NULL on error.
4874 * If JIM_UNSHARED is set and the dictionary is shared, it will be duplicated
4875 * and stored back to the variable before expansion.
4877 static Jim_Obj *JimDictExpandArrayVariable(Jim_Interp *interp, Jim_Obj *varObjPtr,
4878 Jim_Obj *keyObjPtr, int flags)
4880 Jim_Obj *dictObjPtr;
4881 Jim_Obj *resObjPtr = NULL;
4882 int ret;
4884 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
4885 if (!dictObjPtr) {
4886 return NULL;
4889 ret = Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_NONE);
4890 if (ret != JIM_OK) {
4891 Jim_SetResultFormatted(interp,
4892 "can't read \"%#s(%#s)\": %s array", varObjPtr, keyObjPtr,
4893 ret < 0 ? "variable isn't" : "no such element in");
4895 else if ((flags & JIM_UNSHARED) && Jim_IsShared(dictObjPtr)) {
4896 /* Update the variable to have an unshared copy */
4897 Jim_SetVariable(interp, varObjPtr, Jim_DuplicateObj(interp, dictObjPtr));
4900 return resObjPtr;
4903 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
4904 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4906 SetDictSubstFromAny(interp, objPtr);
4908 return JimDictExpandArrayVariable(interp,
4909 objPtr->internalRep.dictSubstValue.varNameObjPtr,
4910 objPtr->internalRep.dictSubstValue.indexObjPtr, flags);
4913 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
4915 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4917 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
4918 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
4921 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4923 /* Copy the internal rep */
4924 dupPtr->internalRep = srcPtr->internalRep;
4925 /* Need to increment the ref counts */
4926 Jim_IncrRefCount(dupPtr->internalRep.dictSubstValue.varNameObjPtr);
4927 Jim_IncrRefCount(dupPtr->internalRep.dictSubstValue.indexObjPtr);
4930 /* Note: The object *must* be in dict-sugar format */
4931 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4933 if (objPtr->typePtr != &dictSubstObjType) {
4934 Jim_Obj *varObjPtr, *keyObjPtr;
4936 if (objPtr->typePtr == &interpolatedObjType) {
4937 /* An interpolated object in dict-sugar form */
4939 varObjPtr = objPtr->internalRep.dictSubstValue.varNameObjPtr;
4940 keyObjPtr = objPtr->internalRep.dictSubstValue.indexObjPtr;
4942 Jim_IncrRefCount(varObjPtr);
4943 Jim_IncrRefCount(keyObjPtr);
4945 else {
4946 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
4949 Jim_FreeIntRep(interp, objPtr);
4950 objPtr->typePtr = &dictSubstObjType;
4951 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
4952 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
4956 /* This function is used to expand [dict get] sugar in the form
4957 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
4958 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
4959 * object that is *guaranteed* to be in the form VARNAME(INDEX).
4960 * The 'index' part is [subst]ituted, and is used to lookup a key inside
4961 * the [dict]ionary contained in variable VARNAME. */
4962 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4964 Jim_Obj *resObjPtr = NULL;
4965 Jim_Obj *substKeyObjPtr = NULL;
4967 SetDictSubstFromAny(interp, objPtr);
4969 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
4970 &substKeyObjPtr, JIM_NONE)
4971 != JIM_OK) {
4972 return NULL;
4974 Jim_IncrRefCount(substKeyObjPtr);
4975 resObjPtr =
4976 JimDictExpandArrayVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4977 substKeyObjPtr, 0);
4978 Jim_DecrRefCount(interp, substKeyObjPtr);
4980 return resObjPtr;
4983 /* -----------------------------------------------------------------------------
4984 * CallFrame
4985 * ---------------------------------------------------------------------------*/
4987 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp, Jim_CallFrame *parent, Jim_Obj *nsObj)
4989 Jim_CallFrame *cf;
4991 if (interp->freeFramesList) {
4992 cf = interp->freeFramesList;
4993 interp->freeFramesList = cf->next;
4995 cf->argv = NULL;
4996 cf->argc = 0;
4997 cf->procArgsObjPtr = NULL;
4998 cf->procBodyObjPtr = NULL;
4999 cf->next = NULL;
5000 cf->staticVars = NULL;
5001 cf->localCommands = NULL;
5002 cf->tailcallObj = NULL;
5003 cf->tailcallCmd = NULL;
5005 else {
5006 cf = Jim_Alloc(sizeof(*cf));
5007 memset(cf, 0, sizeof(*cf));
5009 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
5012 cf->id = interp->callFrameEpoch++;
5013 cf->parent = parent;
5014 cf->level = parent ? parent->level + 1 : 0;
5015 cf->nsObj = nsObj;
5016 Jim_IncrRefCount(nsObj);
5018 return cf;
5021 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands)
5023 /* Delete any local procs */
5024 if (localCommands) {
5025 Jim_Obj *cmdNameObj;
5027 while ((cmdNameObj = Jim_StackPop(localCommands)) != NULL) {
5028 Jim_HashTable *ht = &interp->commands;
5029 Jim_HashEntry *he = Jim_FindHashEntry(ht, cmdNameObj);
5030 if (he) {
5031 Jim_Cmd *cmd = Jim_GetHashEntryVal(he);
5032 if (cmd->prevCmd) {
5033 Jim_Cmd *prevCmd = cmd->prevCmd;
5034 cmd->prevCmd = NULL;
5036 /* Delete the old command */
5037 JimDecrCmdRefCount(interp, cmd);
5039 /* And restore the original */
5040 Jim_SetHashVal(ht, he, prevCmd);
5042 else {
5043 Jim_DeleteHashEntry(ht, cmdNameObj);
5045 Jim_InterpIncrProcEpoch(interp);
5047 Jim_DecrRefCount(interp, cmdNameObj);
5049 Jim_FreeStack(localCommands);
5050 Jim_Free(localCommands);
5052 return JIM_OK;
5056 * Run any $jim::defer scripts for the current call frame.
5058 * retcode is the return code from the current proc.
5060 * Returns the new return code.
5062 static int JimInvokeDefer(Jim_Interp *interp, int retcode)
5064 Jim_Obj *objPtr;
5066 /* Fast check for the likely case that the variable doesn't exist */
5067 if (JimFindVariable(&interp->framePtr->vars, interp->defer) == NULL) {
5068 return retcode;
5070 objPtr = Jim_GetVariable(interp, interp->defer, JIM_NONE);
5072 if (objPtr) {
5073 int ret = JIM_OK;
5074 int i;
5075 int listLen = Jim_ListLength(interp, objPtr);
5076 Jim_Obj *resultObjPtr;
5078 Jim_IncrRefCount(objPtr);
5080 /* Need to save away the current interp result and
5081 * restore it if appropriate
5083 resultObjPtr = Jim_GetResult(interp);
5084 Jim_IncrRefCount(resultObjPtr);
5085 Jim_SetEmptyResult(interp);
5087 /* Invoke in reverse order */
5088 for (i = listLen; i > 0; i--) {
5089 /* If a defer script returns an error, don't evaluate remaining scripts */
5090 Jim_Obj *scriptObjPtr = Jim_ListGetIndex(interp, objPtr, i - 1);
5091 ret = Jim_EvalObj(interp, scriptObjPtr);
5092 if (ret != JIM_OK) {
5093 break;
5097 if (ret == JIM_OK || retcode == JIM_ERR) {
5098 /* defer script had no error, or proc had an error so restore proc result */
5099 Jim_SetResult(interp, resultObjPtr);
5101 else {
5102 retcode = ret;
5105 Jim_DecrRefCount(interp, resultObjPtr);
5106 Jim_DecrRefCount(interp, objPtr);
5108 return retcode;
5111 #define JIM_FCF_FULL 0 /* Always free the vars hash table */
5112 #define JIM_FCF_REUSE 1 /* Reuse the vars hash table if possible */
5113 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action)
5115 JimDeleteLocalProcs(interp, cf->localCommands);
5117 if (cf->procArgsObjPtr)
5118 Jim_DecrRefCount(interp, cf->procArgsObjPtr);
5119 if (cf->procBodyObjPtr)
5120 Jim_DecrRefCount(interp, cf->procBodyObjPtr);
5121 Jim_DecrRefCount(interp, cf->nsObj);
5122 if (action == JIM_FCF_FULL || cf->vars.size != JIM_HT_INITIAL_SIZE)
5123 Jim_FreeHashTable(&cf->vars);
5124 else {
5125 Jim_ClearHashTable(&cf->vars);
5127 cf->next = interp->freeFramesList;
5128 interp->freeFramesList = cf;
5132 /* -----------------------------------------------------------------------------
5133 * References
5134 * ---------------------------------------------------------------------------*/
5135 #if defined(JIM_REFERENCES) && !defined(JIM_BOOTSTRAP)
5137 /* References HashTable Type.
5139 * Keys are unsigned long integers, dynamically allocated for now but in the
5140 * future it's worth to cache this 4 bytes objects. Values are pointers
5141 * to Jim_References. */
5142 static void JimReferencesHTValDestructor(void *interp, void *val)
5144 Jim_Reference *refPtr = (void *)val;
5146 Jim_DecrRefCount(interp, refPtr->objPtr);
5147 if (refPtr->finalizerCmdNamePtr != NULL) {
5148 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5150 Jim_Free(val);
5153 static unsigned int JimReferencesHTHashFunction(const void *key)
5155 /* Only the least significant bits are used. */
5156 const unsigned long *widePtr = key;
5157 unsigned int intValue = (unsigned int)*widePtr;
5159 return Jim_IntHashFunction(intValue);
5162 static void *JimReferencesHTKeyDup(void *privdata, const void *key)
5164 void *copy = Jim_Alloc(sizeof(unsigned long));
5166 JIM_NOTUSED(privdata);
5168 memcpy(copy, key, sizeof(unsigned long));
5169 return copy;
5172 static int JimReferencesHTKeyCompare(void *privdata, const void *key1, const void *key2)
5174 JIM_NOTUSED(privdata);
5176 return memcmp(key1, key2, sizeof(unsigned long)) == 0;
5179 static void JimReferencesHTKeyDestructor(void *privdata, void *key)
5181 JIM_NOTUSED(privdata);
5183 Jim_Free(key);
5186 static const Jim_HashTableType JimReferencesHashTableType = {
5187 JimReferencesHTHashFunction, /* hash function */
5188 JimReferencesHTKeyDup, /* key dup */
5189 NULL, /* val dup */
5190 JimReferencesHTKeyCompare, /* key compare */
5191 JimReferencesHTKeyDestructor, /* key destructor */
5192 JimReferencesHTValDestructor /* val destructor */
5195 /* -----------------------------------------------------------------------------
5196 * Reference object type and References API
5197 * ---------------------------------------------------------------------------*/
5199 /* The string representation of references has two features in order
5200 * to make the GC faster. The first is that every reference starts
5201 * with a non common character '<', in order to make the string matching
5202 * faster. The second is that the reference string rep is 42 characters
5203 * in length, this means that it is not necessary to check any object with a string
5204 * repr < 42, and usually there aren't many of these objects. */
5206 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
5208 static int JimFormatReference(char *buf, Jim_Reference *refPtr, unsigned long id)
5210 const char *fmt = "<reference.<%s>.%020lu>";
5212 sprintf(buf, fmt, refPtr->tag, id);
5213 return JIM_REFERENCE_SPACE;
5216 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
5218 static const Jim_ObjType referenceObjType = {
5219 "reference",
5220 NULL,
5221 NULL,
5222 UpdateStringOfReference,
5223 JIM_TYPE_REFERENCES,
5226 static void UpdateStringOfReference(struct Jim_Obj *objPtr)
5228 char buf[JIM_REFERENCE_SPACE + 1];
5230 JimFormatReference(buf, objPtr->internalRep.refValue.refPtr, objPtr->internalRep.refValue.id);
5231 JimSetStringBytes(objPtr, buf);
5234 /* returns true if 'c' is a valid reference tag character.
5235 * i.e. inside the range [_a-zA-Z0-9] */
5236 static int isrefchar(int c)
5238 return (c == '_' || isalnum(c));
5241 static int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5243 unsigned long value;
5244 int i, len;
5245 const char *str, *start, *end;
5246 char refId[21];
5247 Jim_Reference *refPtr;
5248 Jim_HashEntry *he;
5249 char *endptr;
5251 /* Get the string representation */
5252 str = Jim_GetString(objPtr, &len);
5253 /* Check if it looks like a reference */
5254 if (len < JIM_REFERENCE_SPACE)
5255 goto badformat;
5256 /* Trim spaces */
5257 start = str;
5258 end = str + len - 1;
5259 while (*start == ' ')
5260 start++;
5261 while (*end == ' ' && end > start)
5262 end--;
5263 if (end - start + 1 != JIM_REFERENCE_SPACE)
5264 goto badformat;
5265 /* <reference.<1234567>.%020> */
5266 if (memcmp(start, "<reference.<", 12) != 0)
5267 goto badformat;
5268 if (start[12 + JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>')
5269 goto badformat;
5270 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
5271 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5272 if (!isrefchar(start[12 + i]))
5273 goto badformat;
5275 /* Extract info from the reference. */
5276 memcpy(refId, start + 14 + JIM_REFERENCE_TAGLEN, 20);
5277 refId[20] = '\0';
5278 /* Try to convert the ID into an unsigned long */
5279 value = strtoul(refId, &endptr, 10);
5280 if (JimCheckConversion(refId, endptr) != JIM_OK)
5281 goto badformat;
5282 /* Check if the reference really exists! */
5283 he = Jim_FindHashEntry(&interp->references, &value);
5284 if (he == NULL) {
5285 Jim_SetResultFormatted(interp, "invalid reference id \"%#s\"", objPtr);
5286 return JIM_ERR;
5288 refPtr = Jim_GetHashEntryVal(he);
5289 /* Free the old internal repr and set the new one. */
5290 Jim_FreeIntRep(interp, objPtr);
5291 objPtr->typePtr = &referenceObjType;
5292 objPtr->internalRep.refValue.id = value;
5293 objPtr->internalRep.refValue.refPtr = refPtr;
5294 return JIM_OK;
5296 badformat:
5297 Jim_SetResultFormatted(interp, "expected reference but got \"%#s\"", objPtr);
5298 return JIM_ERR;
5301 /* Returns a new reference pointing to objPtr, having cmdNamePtr
5302 * as finalizer command (or NULL if there is no finalizer).
5303 * The returned reference object has refcount = 0. */
5304 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr, Jim_Obj *cmdNamePtr)
5306 struct Jim_Reference *refPtr;
5307 unsigned long id;
5308 Jim_Obj *refObjPtr;
5309 const char *tag;
5310 int tagLen, i;
5312 /* Perform the Garbage Collection if needed. */
5313 Jim_CollectIfNeeded(interp);
5315 refPtr = Jim_Alloc(sizeof(*refPtr));
5316 refPtr->objPtr = objPtr;
5317 Jim_IncrRefCount(objPtr);
5318 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5319 if (cmdNamePtr)
5320 Jim_IncrRefCount(cmdNamePtr);
5321 id = interp->referenceNextId++;
5322 Jim_AddHashEntry(&interp->references, &id, refPtr);
5323 refObjPtr = Jim_NewObj(interp);
5324 refObjPtr->typePtr = &referenceObjType;
5325 refObjPtr->bytes = NULL;
5326 refObjPtr->internalRep.refValue.id = id;
5327 refObjPtr->internalRep.refValue.refPtr = refPtr;
5328 interp->referenceNextId++;
5329 /* Set the tag. Trimmed at JIM_REFERENCE_TAGLEN. Everything
5330 * that does not pass the 'isrefchar' test is replaced with '_' */
5331 tag = Jim_GetString(tagPtr, &tagLen);
5332 if (tagLen > JIM_REFERENCE_TAGLEN)
5333 tagLen = JIM_REFERENCE_TAGLEN;
5334 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5335 if (i < tagLen && isrefchar(tag[i]))
5336 refPtr->tag[i] = tag[i];
5337 else
5338 refPtr->tag[i] = '_';
5340 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
5341 return refObjPtr;
5344 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
5346 if (objPtr->typePtr != &referenceObjType && SetReferenceFromAny(interp, objPtr) == JIM_ERR)
5347 return NULL;
5348 return objPtr->internalRep.refValue.refPtr;
5351 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
5353 Jim_Reference *refPtr;
5355 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5356 return JIM_ERR;
5357 Jim_IncrRefCount(cmdNamePtr);
5358 if (refPtr->finalizerCmdNamePtr)
5359 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5360 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5361 return JIM_OK;
5364 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
5366 Jim_Reference *refPtr;
5368 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5369 return JIM_ERR;
5370 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
5371 return JIM_OK;
5374 /* -----------------------------------------------------------------------------
5375 * References Garbage Collection
5376 * ---------------------------------------------------------------------------*/
5378 /* This the hash table type for the "MARK" phase of the GC */
5379 static const Jim_HashTableType JimRefMarkHashTableType = {
5380 JimReferencesHTHashFunction, /* hash function */
5381 JimReferencesHTKeyDup, /* key dup */
5382 NULL, /* val dup */
5383 JimReferencesHTKeyCompare, /* key compare */
5384 JimReferencesHTKeyDestructor, /* key destructor */
5385 NULL /* val destructor */
5388 /* Performs the garbage collection. */
5389 int Jim_Collect(Jim_Interp *interp)
5391 int collected = 0;
5392 Jim_HashTable marks;
5393 Jim_HashTableIterator htiter;
5394 Jim_HashEntry *he;
5395 Jim_Obj *objPtr;
5397 /* Avoid recursive calls */
5398 if (interp->lastCollectId == (unsigned long)~0) {
5399 /* Jim_Collect() already running. Return just now. */
5400 return 0;
5402 interp->lastCollectId = ~0;
5404 /* Mark all the references found into the 'mark' hash table.
5405 * The references are searched in every live object that
5406 * is of a type that can contain references. */
5407 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
5408 objPtr = interp->liveList;
5409 while (objPtr) {
5410 if (objPtr->typePtr == NULL || objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
5411 const char *str, *p;
5412 int len;
5414 /* If the object is of type reference, to get the
5415 * Id is simple... */
5416 if (objPtr->typePtr == &referenceObjType) {
5417 Jim_AddHashEntry(&marks, &objPtr->internalRep.refValue.id, NULL);
5418 #ifdef JIM_DEBUG_GC
5419 printf("MARK (reference): %d refcount: %d\n",
5420 (int)objPtr->internalRep.refValue.id, objPtr->refCount);
5421 #endif
5422 objPtr = objPtr->nextObjPtr;
5423 continue;
5425 /* Get the string repr of the object we want
5426 * to scan for references. */
5427 p = str = Jim_GetString(objPtr, &len);
5428 /* Skip objects too little to contain references. */
5429 if (len < JIM_REFERENCE_SPACE) {
5430 objPtr = objPtr->nextObjPtr;
5431 continue;
5434 /* Maybe the entire string is a reference that is also in the commands table with a refcount of 1.
5435 * If so, this can be collected */
5436 if (objPtr->refCount == 1) {
5437 if (Jim_FindHashEntry(&interp->commands, objPtr)) {
5438 #ifdef JIM_DEBUG_GC
5439 printf("Found %s which is a command with refcount=1, so not marking\n", Jim_String(objPtr));
5440 #endif
5441 /* Yes, a command with refcount of 1 */
5442 objPtr = objPtr->nextObjPtr;
5443 continue;
5447 /* Extract references from the object string repr. */
5448 while (1) {
5449 int i;
5450 unsigned long id;
5452 if ((p = strstr(p, "<reference.<")) == NULL)
5453 break;
5454 /* Check if it's a valid reference. */
5455 if (len - (p - str) < JIM_REFERENCE_SPACE)
5456 break;
5457 if (p[41] != '>' || p[19] != '>' || p[20] != '.')
5458 break;
5459 for (i = 21; i <= 40; i++)
5460 if (!isdigit(UCHAR(p[i])))
5461 break;
5462 /* Get the ID */
5463 id = strtoul(p + 21, NULL, 10);
5465 /* Ok, a reference for the given ID
5466 * was found. Mark it. */
5467 Jim_AddHashEntry(&marks, &id, NULL);
5468 #ifdef JIM_DEBUG_GC
5469 printf("MARK: %d\n", (int)id);
5470 #endif
5471 p += JIM_REFERENCE_SPACE;
5474 objPtr = objPtr->nextObjPtr;
5477 /* Run the references hash table to destroy every reference that
5478 * is not referenced outside (not present in the mark HT). */
5479 JimInitHashTableIterator(&interp->references, &htiter);
5480 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
5481 const unsigned long *refId;
5482 Jim_Reference *refPtr;
5484 refId = he->key;
5485 /* Check if in the mark phase we encountered
5486 * this reference. */
5487 if (Jim_FindHashEntry(&marks, refId) == NULL) {
5488 #ifdef JIM_DEBUG_GC
5489 printf("COLLECTING %d\n", (int)*refId);
5490 #endif
5491 collected++;
5492 /* Drop the reference, but call the
5493 * finalizer first if registered. */
5494 refPtr = Jim_GetHashEntryVal(he);
5495 if (refPtr->finalizerCmdNamePtr) {
5496 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE + 1);
5497 Jim_Obj *objv[3], *oldResult;
5499 JimFormatReference(refstr, refPtr, *refId);
5501 objv[0] = refPtr->finalizerCmdNamePtr;
5502 objv[1] = Jim_NewStringObjNoAlloc(interp, refstr, JIM_REFERENCE_SPACE);
5503 objv[2] = refPtr->objPtr;
5505 /* Drop the reference itself */
5506 /* Avoid the finaliser being freed here */
5507 Jim_IncrRefCount(objv[0]);
5508 /* Don't remove the reference from the hash table just yet
5509 * since that will free refPtr, and hence refPtr->objPtr
5512 /* Call the finalizer. Errors ignored. (should we use bgerror?) */
5513 oldResult = interp->result;
5514 Jim_IncrRefCount(oldResult);
5515 Jim_EvalObjVector(interp, 3, objv);
5516 Jim_SetResult(interp, oldResult);
5517 Jim_DecrRefCount(interp, oldResult);
5519 Jim_DecrRefCount(interp, objv[0]);
5521 Jim_DeleteHashEntry(&interp->references, refId);
5524 Jim_FreeHashTable(&marks);
5525 interp->lastCollectId = interp->referenceNextId;
5526 interp->lastCollectTime = JimClock();
5527 return collected;
5530 #define JIM_COLLECT_ID_PERIOD 5000000
5531 #define JIM_COLLECT_TIME_PERIOD 300000
5533 void Jim_CollectIfNeeded(Jim_Interp *interp)
5535 unsigned long elapsedId;
5536 jim_wide elapsedTime;
5538 elapsedId = interp->referenceNextId - interp->lastCollectId;
5539 elapsedTime = JimClock() - interp->lastCollectTime;
5542 if (elapsedId > JIM_COLLECT_ID_PERIOD || elapsedTime > JIM_COLLECT_TIME_PERIOD) {
5543 Jim_Collect(interp);
5546 #endif /* JIM_REFERENCES && !JIM_BOOTSTRAP */
5548 int Jim_IsBigEndian(void)
5550 union {
5551 unsigned short s;
5552 unsigned char c[2];
5553 } uval = {0x0102};
5555 return uval.c[0] == 1;
5558 /* -----------------------------------------------------------------------------
5559 * Interpreter related functions
5560 * ---------------------------------------------------------------------------*/
5562 Jim_Interp *Jim_CreateInterp(void)
5564 Jim_Interp *i = Jim_Alloc(sizeof(*i));
5566 memset(i, 0, sizeof(*i));
5568 i->maxCallFrameDepth = JIM_MAX_CALLFRAME_DEPTH;
5569 i->maxEvalDepth = JIM_MAX_EVAL_DEPTH;
5570 i->lastCollectTime = JimClock();
5572 /* Note that we can create objects only after the
5573 * interpreter liveList and freeList pointers are
5574 * initialized to NULL. */
5575 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
5576 #ifdef JIM_REFERENCES
5577 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
5578 #endif
5579 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
5580 Jim_InitHashTable(&i->packages, &JimPackageHashTableType, NULL);
5581 i->emptyObj = Jim_NewEmptyStringObj(i);
5582 i->trueObj = Jim_NewIntObj(i, 1);
5583 i->falseObj = Jim_NewIntObj(i, 0);
5584 i->framePtr = i->topFramePtr = JimCreateCallFrame(i, NULL, i->emptyObj);
5585 i->errorFileNameObj = i->emptyObj;
5586 i->result = i->emptyObj;
5587 i->stackTrace = Jim_NewListObj(i, NULL, 0);
5588 i->unknown = Jim_NewStringObj(i, "unknown", -1);
5589 i->defer = Jim_NewStringObj(i, "jim::defer", -1);
5590 i->errorProc = i->emptyObj;
5591 i->currentScriptObj = Jim_NewEmptyStringObj(i);
5592 i->nullScriptObj = Jim_NewEmptyStringObj(i);
5593 Jim_IncrRefCount(i->emptyObj);
5594 Jim_IncrRefCount(i->errorFileNameObj);
5595 Jim_IncrRefCount(i->result);
5596 Jim_IncrRefCount(i->stackTrace);
5597 Jim_IncrRefCount(i->unknown);
5598 Jim_IncrRefCount(i->defer);
5599 Jim_IncrRefCount(i->currentScriptObj);
5600 Jim_IncrRefCount(i->nullScriptObj);
5601 Jim_IncrRefCount(i->errorProc);
5602 Jim_IncrRefCount(i->trueObj);
5603 Jim_IncrRefCount(i->falseObj);
5605 /* Initialize key variables every interpreter should contain */
5606 Jim_SetVariableStrWithStr(i, JIM_LIBPATH, TCL_LIBRARY);
5607 Jim_SetVariableStrWithStr(i, JIM_INTERACTIVE, "0");
5609 Jim_SetVariableStrWithStr(i, "tcl_platform(engine)", "Jim");
5610 Jim_SetVariableStrWithStr(i, "tcl_platform(os)", TCL_PLATFORM_OS);
5611 Jim_SetVariableStrWithStr(i, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM);
5612 Jim_SetVariableStrWithStr(i, "tcl_platform(pathSeparator)", TCL_PLATFORM_PATH_SEPARATOR);
5613 Jim_SetVariableStrWithStr(i, "tcl_platform(byteOrder)", Jim_IsBigEndian() ? "bigEndian" : "littleEndian");
5614 Jim_SetVariableStrWithStr(i, "tcl_platform(threaded)", "0");
5615 Jim_SetVariableStr(i, "tcl_platform(pointerSize)", Jim_NewIntObj(i, sizeof(void *)));
5616 Jim_SetVariableStr(i, "tcl_platform(wordSize)", Jim_NewIntObj(i, sizeof(jim_wide)));
5618 return i;
5621 void Jim_FreeInterp(Jim_Interp *i)
5623 Jim_CallFrame *cf, *cfx;
5625 Jim_Obj *objPtr, *nextObjPtr;
5627 /* Free the active call frames list - must be done before i->commands is destroyed */
5628 for (cf = i->framePtr; cf; cf = cfx) {
5629 /* Note that we ignore any errors */
5630 JimInvokeDefer(i, JIM_OK);
5631 cfx = cf->parent;
5632 JimFreeCallFrame(i, cf, JIM_FCF_FULL);
5635 Jim_DecrRefCount(i, i->emptyObj);
5636 Jim_DecrRefCount(i, i->trueObj);
5637 Jim_DecrRefCount(i, i->falseObj);
5638 Jim_DecrRefCount(i, i->result);
5639 Jim_DecrRefCount(i, i->stackTrace);
5640 Jim_DecrRefCount(i, i->errorProc);
5641 Jim_DecrRefCount(i, i->unknown);
5642 Jim_DecrRefCount(i, i->defer);
5643 Jim_DecrRefCount(i, i->errorFileNameObj);
5644 Jim_DecrRefCount(i, i->currentScriptObj);
5645 Jim_DecrRefCount(i, i->nullScriptObj);
5646 Jim_FreeHashTable(&i->commands);
5647 #ifdef JIM_REFERENCES
5648 Jim_FreeHashTable(&i->references);
5649 #endif
5650 Jim_FreeHashTable(&i->packages);
5651 Jim_Free(i->prngState);
5652 Jim_FreeHashTable(&i->assocData);
5654 /* Check that the live object list is empty, otherwise
5655 * there is a memory leak. */
5656 #ifdef JIM_MAINTAINER
5657 if (i->liveList != NULL) {
5658 objPtr = i->liveList;
5660 printf("\n-------------------------------------\n");
5661 printf("Objects still in the free list:\n");
5662 while (objPtr) {
5663 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "string";
5664 Jim_String(objPtr);
5666 if (objPtr->bytes && strlen(objPtr->bytes) > 20) {
5667 printf("%p (%d) %-10s: '%.20s...'\n",
5668 (void *)objPtr, objPtr->refCount, type, objPtr->bytes);
5670 else {
5671 printf("%p (%d) %-10s: '%s'\n",
5672 (void *)objPtr, objPtr->refCount, type, objPtr->bytes ? objPtr->bytes : "(null)");
5674 if (objPtr->typePtr == &sourceObjType) {
5675 printf("FILE %s LINE %d\n",
5676 Jim_String(objPtr->internalRep.sourceValue.fileNameObj),
5677 objPtr->internalRep.sourceValue.lineNumber);
5679 objPtr = objPtr->nextObjPtr;
5681 printf("-------------------------------------\n\n");
5682 JimPanic((1, "Live list non empty freeing the interpreter! Leak?"));
5684 #endif
5686 /* Free all the freed objects. */
5687 objPtr = i->freeList;
5688 while (objPtr) {
5689 nextObjPtr = objPtr->nextObjPtr;
5690 Jim_Free(objPtr);
5691 objPtr = nextObjPtr;
5694 /* Free the free call frames list */
5695 for (cf = i->freeFramesList; cf; cf = cfx) {
5696 cfx = cf->next;
5697 if (cf->vars.table)
5698 Jim_FreeHashTable(&cf->vars);
5699 Jim_Free(cf);
5702 /* Free the interpreter structure. */
5703 Jim_Free(i);
5706 /* Returns the call frame relative to the level represented by
5707 * levelObjPtr. If levelObjPtr == NULL, the level is assumed to be '1'.
5709 * This function accepts the 'level' argument in the form
5710 * of the commands [uplevel] and [upvar].
5712 * Returns NULL on error.
5714 * Note: for a function accepting a relative integer as level suitable
5715 * for implementation of [info level ?level?], see JimGetCallFrameByInteger()
5717 Jim_CallFrame *Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5719 long level;
5720 const char *str;
5721 Jim_CallFrame *framePtr;
5723 if (levelObjPtr) {
5724 str = Jim_String(levelObjPtr);
5725 if (str[0] == '#') {
5726 char *endptr;
5728 level = jim_strtol(str + 1, &endptr);
5729 if (str[1] == '\0' || endptr[0] != '\0') {
5730 level = -1;
5733 else {
5734 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0) {
5735 level = -1;
5737 else {
5738 /* Convert from a relative to an absolute level */
5739 level = interp->framePtr->level - level;
5743 else {
5744 str = "1"; /* Needed to format the error message. */
5745 level = interp->framePtr->level - 1;
5748 if (level == 0) {
5749 return interp->topFramePtr;
5751 if (level > 0) {
5752 /* Lookup */
5753 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5754 if (framePtr->level == level) {
5755 return framePtr;
5760 Jim_SetResultFormatted(interp, "bad level \"%s\"", str);
5761 return NULL;
5764 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
5765 * as a relative integer like in the [info level ?level?] command.
5767 static Jim_CallFrame *JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5769 long level;
5770 Jim_CallFrame *framePtr;
5772 if (Jim_GetLong(interp, levelObjPtr, &level) == JIM_OK) {
5773 if (level <= 0) {
5774 /* Convert from a relative to an absolute level */
5775 level = interp->framePtr->level + level;
5778 if (level == 0) {
5779 return interp->topFramePtr;
5782 /* Lookup */
5783 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5784 if (framePtr->level == level) {
5785 return framePtr;
5790 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
5791 return NULL;
5794 static void JimResetStackTrace(Jim_Interp *interp)
5796 Jim_DecrRefCount(interp, interp->stackTrace);
5797 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
5798 Jim_IncrRefCount(interp->stackTrace);
5801 static void JimSetStackTrace(Jim_Interp *interp, Jim_Obj *stackTraceObj)
5803 int len;
5805 /* Increment reference first in case these are the same object */
5806 Jim_IncrRefCount(stackTraceObj);
5807 Jim_DecrRefCount(interp, interp->stackTrace);
5808 interp->stackTrace = stackTraceObj;
5809 interp->errorFlag = 1;
5811 /* This is a bit ugly.
5812 * If the filename of the last entry of the stack trace is empty,
5813 * the next stack level should be added.
5815 len = Jim_ListLength(interp, interp->stackTrace);
5816 if (len >= 3) {
5817 if (Jim_Length(Jim_ListGetIndex(interp, interp->stackTrace, len - 2)) == 0) {
5818 interp->addStackTrace = 1;
5823 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
5824 Jim_Obj *fileNameObj, int linenr)
5826 if (strcmp(procname, "unknown") == 0) {
5827 procname = "";
5829 if (!*procname && !Jim_Length(fileNameObj)) {
5830 /* No useful info here */
5831 return;
5834 if (Jim_IsShared(interp->stackTrace)) {
5835 Jim_DecrRefCount(interp, interp->stackTrace);
5836 interp->stackTrace = Jim_DuplicateObj(interp, interp->stackTrace);
5837 Jim_IncrRefCount(interp->stackTrace);
5840 /* If we have no procname but the previous element did, merge with that frame */
5841 if (!*procname && Jim_Length(fileNameObj)) {
5842 /* Just a filename. Check the previous entry */
5843 int len = Jim_ListLength(interp, interp->stackTrace);
5845 if (len >= 3) {
5846 Jim_Obj *objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 3);
5847 if (Jim_Length(objPtr)) {
5848 /* Yes, the previous level had procname */
5849 objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 2);
5850 if (Jim_Length(objPtr) == 0) {
5851 /* But no filename, so merge the new info with that frame */
5852 ListSetIndex(interp, interp->stackTrace, len - 2, fileNameObj, 0);
5853 ListSetIndex(interp, interp->stackTrace, len - 1, Jim_NewIntObj(interp, linenr), 0);
5854 return;
5860 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewStringObj(interp, procname, -1));
5861 Jim_ListAppendElement(interp, interp->stackTrace, fileNameObj);
5862 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewIntObj(interp, linenr));
5865 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc * delProc,
5866 void *data)
5868 AssocDataValue *assocEntryPtr = (AssocDataValue *) Jim_Alloc(sizeof(AssocDataValue));
5870 assocEntryPtr->delProc = delProc;
5871 assocEntryPtr->data = data;
5872 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
5875 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
5877 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
5879 if (entryPtr != NULL) {
5880 AssocDataValue *assocEntryPtr = Jim_GetHashEntryVal(entryPtr);
5881 return assocEntryPtr->data;
5883 return NULL;
5886 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
5888 return Jim_DeleteHashEntry(&interp->assocData, key);
5891 int Jim_GetExitCode(Jim_Interp *interp)
5893 return interp->exitCode;
5896 /* -----------------------------------------------------------------------------
5897 * Integer object
5898 * ---------------------------------------------------------------------------*/
5899 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
5900 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
5902 static const Jim_ObjType intObjType = {
5903 "int",
5904 NULL,
5905 NULL,
5906 UpdateStringOfInt,
5907 JIM_TYPE_NONE,
5910 /* A coerced double is closer to an int than a double.
5911 * It is an int value temporarily masquerading as a double value.
5912 * i.e. it has the same string value as an int and Jim_GetWide()
5913 * succeeds, but also Jim_GetDouble() returns the value directly.
5915 static const Jim_ObjType coercedDoubleObjType = {
5916 "coerced-double",
5917 NULL,
5918 NULL,
5919 UpdateStringOfInt,
5920 JIM_TYPE_NONE,
5924 static void UpdateStringOfInt(struct Jim_Obj *objPtr)
5926 char buf[JIM_INTEGER_SPACE + 1];
5927 jim_wide wideValue = JimWideValue(objPtr);
5928 int pos = 0;
5930 if (wideValue == 0) {
5931 buf[pos++] = '0';
5933 else {
5934 char tmp[JIM_INTEGER_SPACE];
5935 int num = 0;
5936 int i;
5938 if (wideValue < 0) {
5939 buf[pos++] = '-';
5940 i = wideValue % 10;
5941 /* C89 is implementation defined as to whether (-106 % 10) is -6 or 4,
5942 * whereas C99 is always -6
5943 * coverity[dead_error_line]
5945 tmp[num++] = (i > 0) ? (10 - i) : -i;
5946 wideValue /= -10;
5949 while (wideValue) {
5950 tmp[num++] = wideValue % 10;
5951 wideValue /= 10;
5954 for (i = 0; i < num; i++) {
5955 buf[pos++] = '0' + tmp[num - i - 1];
5958 buf[pos] = 0;
5960 JimSetStringBytes(objPtr, buf);
5963 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
5965 jim_wide wideValue;
5966 const char *str;
5968 if (objPtr->typePtr == &coercedDoubleObjType) {
5969 /* Simple switch */
5970 objPtr->typePtr = &intObjType;
5971 return JIM_OK;
5974 /* Get the string representation */
5975 str = Jim_String(objPtr);
5976 /* Try to convert into a jim_wide */
5977 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
5978 if (flags & JIM_ERRMSG) {
5979 Jim_SetResultFormatted(interp, "expected integer but got \"%#s\"", objPtr);
5981 return JIM_ERR;
5983 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) && errno == ERANGE) {
5984 Jim_SetResultString(interp, "Integer value too big to be represented", -1);
5985 return JIM_ERR;
5987 /* Free the old internal repr and set the new one. */
5988 Jim_FreeIntRep(interp, objPtr);
5989 objPtr->typePtr = &intObjType;
5990 objPtr->internalRep.wideValue = wideValue;
5991 return JIM_OK;
5994 #ifdef JIM_OPTIMIZATION
5995 static int JimIsWide(Jim_Obj *objPtr)
5997 return objPtr->typePtr == &intObjType;
5999 #endif
6001 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
6003 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
6004 return JIM_ERR;
6005 *widePtr = JimWideValue(objPtr);
6006 return JIM_OK;
6009 /* Get a wide but does not set an error if the format is bad. */
6010 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
6012 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
6013 return JIM_ERR;
6014 *widePtr = JimWideValue(objPtr);
6015 return JIM_OK;
6018 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
6020 jim_wide wideValue;
6021 int retval;
6023 retval = Jim_GetWide(interp, objPtr, &wideValue);
6024 if (retval == JIM_OK) {
6025 *longPtr = (long)wideValue;
6026 return JIM_OK;
6028 return JIM_ERR;
6031 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
6033 Jim_Obj *objPtr;
6035 objPtr = Jim_NewObj(interp);
6036 objPtr->typePtr = &intObjType;
6037 objPtr->bytes = NULL;
6038 objPtr->internalRep.wideValue = wideValue;
6039 return objPtr;
6042 /* -----------------------------------------------------------------------------
6043 * Double object
6044 * ---------------------------------------------------------------------------*/
6045 #define JIM_DOUBLE_SPACE 30
6047 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
6048 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
6050 static const Jim_ObjType doubleObjType = {
6051 "double",
6052 NULL,
6053 NULL,
6054 UpdateStringOfDouble,
6055 JIM_TYPE_NONE,
6058 #ifndef HAVE_ISNAN
6059 #undef isnan
6060 #define isnan(X) ((X) != (X))
6061 #endif
6062 #ifndef HAVE_ISINF
6063 #undef isinf
6064 #define isinf(X) (1.0 / (X) == 0.0)
6065 #endif
6067 static void UpdateStringOfDouble(struct Jim_Obj *objPtr)
6069 double value = objPtr->internalRep.doubleValue;
6071 if (isnan(value)) {
6072 JimSetStringBytes(objPtr, "NaN");
6073 return;
6075 if (isinf(value)) {
6076 if (value < 0) {
6077 JimSetStringBytes(objPtr, "-Inf");
6079 else {
6080 JimSetStringBytes(objPtr, "Inf");
6082 return;
6085 char buf[JIM_DOUBLE_SPACE + 1];
6086 int i;
6087 int len = sprintf(buf, "%.12g", value);
6089 /* Add a final ".0" if necessary */
6090 for (i = 0; i < len; i++) {
6091 if (buf[i] == '.' || buf[i] == 'e') {
6092 #if defined(JIM_SPRINTF_DOUBLE_NEEDS_FIX)
6093 /* If 'buf' ends in e-0nn or e+0nn, remove
6094 * the 0 after the + or - and reduce the length by 1
6096 char *e = strchr(buf, 'e');
6097 if (e && (e[1] == '-' || e[1] == '+') && e[2] == '0') {
6098 /* Move it up */
6099 e += 2;
6100 memmove(e, e + 1, len - (e - buf));
6102 #endif
6103 break;
6106 if (buf[i] == '\0') {
6107 buf[i++] = '.';
6108 buf[i++] = '0';
6109 buf[i] = '\0';
6111 JimSetStringBytes(objPtr, buf);
6115 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6117 double doubleValue;
6118 jim_wide wideValue;
6119 const char *str;
6121 #ifdef HAVE_LONG_LONG
6122 /* Assume a 53 bit mantissa */
6123 #define MIN_INT_IN_DOUBLE -(1LL << 53)
6124 #define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1)
6126 if (objPtr->typePtr == &intObjType
6127 && JimWideValue(objPtr) >= MIN_INT_IN_DOUBLE
6128 && JimWideValue(objPtr) <= MAX_INT_IN_DOUBLE) {
6130 /* Direct conversion to coerced double */
6131 objPtr->typePtr = &coercedDoubleObjType;
6132 return JIM_OK;
6134 #endif
6135 /* Preserve the string representation.
6136 * Needed so we can convert back to int without loss
6138 str = Jim_String(objPtr);
6140 if (Jim_StringToWide(str, &wideValue, 10) == JIM_OK) {
6141 /* Managed to convert to an int, so we can use this as a cooerced double */
6142 Jim_FreeIntRep(interp, objPtr);
6143 objPtr->typePtr = &coercedDoubleObjType;
6144 objPtr->internalRep.wideValue = wideValue;
6145 return JIM_OK;
6147 else {
6148 /* Try to convert into a double */
6149 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
6150 Jim_SetResultFormatted(interp, "expected floating-point number but got \"%#s\"", objPtr);
6151 return JIM_ERR;
6153 /* Free the old internal repr and set the new one. */
6154 Jim_FreeIntRep(interp, objPtr);
6156 objPtr->typePtr = &doubleObjType;
6157 objPtr->internalRep.doubleValue = doubleValue;
6158 return JIM_OK;
6161 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
6163 if (objPtr->typePtr == &coercedDoubleObjType) {
6164 *doublePtr = JimWideValue(objPtr);
6165 return JIM_OK;
6167 if (objPtr->typePtr != &doubleObjType && SetDoubleFromAny(interp, objPtr) == JIM_ERR)
6168 return JIM_ERR;
6170 if (objPtr->typePtr == &coercedDoubleObjType) {
6171 *doublePtr = JimWideValue(objPtr);
6173 else {
6174 *doublePtr = objPtr->internalRep.doubleValue;
6176 return JIM_OK;
6179 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
6181 Jim_Obj *objPtr;
6183 objPtr = Jim_NewObj(interp);
6184 objPtr->typePtr = &doubleObjType;
6185 objPtr->bytes = NULL;
6186 objPtr->internalRep.doubleValue = doubleValue;
6187 return objPtr;
6190 /* -----------------------------------------------------------------------------
6191 * Boolean conversion
6192 * ---------------------------------------------------------------------------*/
6193 static int SetBooleanFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
6195 int Jim_GetBoolean(Jim_Interp *interp, Jim_Obj *objPtr, int * booleanPtr)
6197 if (objPtr->typePtr != &intObjType && SetBooleanFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
6198 return JIM_ERR;
6199 *booleanPtr = (int) JimWideValue(objPtr);
6200 return JIM_OK;
6203 static int SetBooleanFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
6205 static const char * const falses[] = {
6206 "0", "false", "no", "off", NULL
6208 static const char * const trues[] = {
6209 "1", "true", "yes", "on", NULL
6212 int boolean;
6214 int index;
6215 if (Jim_GetEnum(interp, objPtr, falses, &index, NULL, 0) == JIM_OK) {
6216 boolean = 0;
6217 } else if (Jim_GetEnum(interp, objPtr, trues, &index, NULL, 0) == JIM_OK) {
6218 boolean = 1;
6219 } else {
6220 if (flags & JIM_ERRMSG) {
6221 Jim_SetResultFormatted(interp, "expected boolean but got \"%#s\"", objPtr);
6223 return JIM_ERR;
6226 /* Free the old internal repr and set the new one. */
6227 Jim_FreeIntRep(interp, objPtr);
6228 objPtr->typePtr = &intObjType;
6229 objPtr->internalRep.wideValue = boolean;
6230 return JIM_OK;
6233 /* -----------------------------------------------------------------------------
6234 * List object
6235 * ---------------------------------------------------------------------------*/
6236 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec);
6237 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
6238 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6239 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6240 static void UpdateStringOfList(struct Jim_Obj *objPtr);
6241 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6243 /* Note that while the elements of the list may contain references,
6244 * the list object itself can't. This basically means that the
6245 * list object string representation as a whole can't contain references
6246 * that are not presents in the single elements. */
6247 static const Jim_ObjType listObjType = {
6248 "list",
6249 FreeListInternalRep,
6250 DupListInternalRep,
6251 UpdateStringOfList,
6252 JIM_TYPE_NONE,
6255 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6257 int i;
6259 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
6260 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
6262 Jim_Free(objPtr->internalRep.listValue.ele);
6265 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6267 int i;
6269 JIM_NOTUSED(interp);
6271 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
6272 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
6273 dupPtr->internalRep.listValue.ele =
6274 Jim_Alloc(sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.maxLen);
6275 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
6276 sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.len);
6277 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
6278 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
6280 dupPtr->typePtr = &listObjType;
6283 /* The following function checks if a given string can be encoded
6284 * into a list element without any kind of quoting, surrounded by braces,
6285 * or using escapes to quote. */
6286 #define JIM_ELESTR_SIMPLE 0
6287 #define JIM_ELESTR_BRACE 1
6288 #define JIM_ELESTR_QUOTE 2
6289 static unsigned char ListElementQuotingType(const char *s, int len)
6291 int i, level, blevel, trySimple = 1;
6293 /* Try with the SIMPLE case */
6294 if (len == 0)
6295 return JIM_ELESTR_BRACE;
6296 if (s[0] == '"' || s[0] == '{') {
6297 trySimple = 0;
6298 goto testbrace;
6300 for (i = 0; i < len; i++) {
6301 switch (s[i]) {
6302 case ' ':
6303 case '$':
6304 case '"':
6305 case '[':
6306 case ']':
6307 case ';':
6308 case '\\':
6309 case '\r':
6310 case '\n':
6311 case '\t':
6312 case '\f':
6313 case '\v':
6314 trySimple = 0;
6315 /* fall through */
6316 case '{':
6317 case '}':
6318 goto testbrace;
6321 return JIM_ELESTR_SIMPLE;
6323 testbrace:
6324 /* Test if it's possible to do with braces */
6325 if (s[len - 1] == '\\')
6326 return JIM_ELESTR_QUOTE;
6327 level = 0;
6328 blevel = 0;
6329 for (i = 0; i < len; i++) {
6330 switch (s[i]) {
6331 case '{':
6332 level++;
6333 break;
6334 case '}':
6335 level--;
6336 if (level < 0)
6337 return JIM_ELESTR_QUOTE;
6338 break;
6339 case '[':
6340 blevel++;
6341 break;
6342 case ']':
6343 blevel--;
6344 break;
6345 case '\\':
6346 if (s[i + 1] == '\n')
6347 return JIM_ELESTR_QUOTE;
6348 else if (s[i + 1] != '\0')
6349 i++;
6350 break;
6353 if (blevel < 0) {
6354 return JIM_ELESTR_QUOTE;
6357 if (level == 0) {
6358 if (!trySimple)
6359 return JIM_ELESTR_BRACE;
6360 for (i = 0; i < len; i++) {
6361 switch (s[i]) {
6362 case ' ':
6363 case '$':
6364 case '"':
6365 case '[':
6366 case ']':
6367 case ';':
6368 case '\\':
6369 case '\r':
6370 case '\n':
6371 case '\t':
6372 case '\f':
6373 case '\v':
6374 return JIM_ELESTR_BRACE;
6375 break;
6378 return JIM_ELESTR_SIMPLE;
6380 return JIM_ELESTR_QUOTE;
6383 /* Backslashes-escapes the null-terminated string 's' into the buffer at 'q'
6384 * The buffer must be at least strlen(s) * 2 + 1 bytes long for the worst-case
6385 * scenario.
6386 * Returns the length of the result.
6388 static int BackslashQuoteString(const char *s, int len, char *q)
6390 char *p = q;
6392 while (len--) {
6393 switch (*s) {
6394 case ' ':
6395 case '$':
6396 case '"':
6397 case '[':
6398 case ']':
6399 case '{':
6400 case '}':
6401 case ';':
6402 case '\\':
6403 *p++ = '\\';
6404 *p++ = *s++;
6405 break;
6406 case '\n':
6407 *p++ = '\\';
6408 *p++ = 'n';
6409 s++;
6410 break;
6411 case '\r':
6412 *p++ = '\\';
6413 *p++ = 'r';
6414 s++;
6415 break;
6416 case '\t':
6417 *p++ = '\\';
6418 *p++ = 't';
6419 s++;
6420 break;
6421 case '\f':
6422 *p++ = '\\';
6423 *p++ = 'f';
6424 s++;
6425 break;
6426 case '\v':
6427 *p++ = '\\';
6428 *p++ = 'v';
6429 s++;
6430 break;
6431 default:
6432 *p++ = *s++;
6433 break;
6436 *p = '\0';
6438 return p - q;
6441 static void JimMakeListStringRep(Jim_Obj *objPtr, Jim_Obj **objv, int objc)
6443 #define STATIC_QUOTING_LEN 32
6444 int i, bufLen, realLength;
6445 const char *strRep;
6446 char *p;
6447 unsigned char *quotingType, staticQuoting[STATIC_QUOTING_LEN];
6449 /* Estimate the space needed. */
6450 if (objc > STATIC_QUOTING_LEN) {
6451 quotingType = Jim_Alloc(objc);
6453 else {
6454 quotingType = staticQuoting;
6456 bufLen = 0;
6457 for (i = 0; i < objc; i++) {
6458 int len;
6460 strRep = Jim_GetString(objv[i], &len);
6461 quotingType[i] = ListElementQuotingType(strRep, len);
6462 switch (quotingType[i]) {
6463 case JIM_ELESTR_SIMPLE:
6464 if (i != 0 || strRep[0] != '#') {
6465 bufLen += len;
6466 break;
6468 /* Special case '#' on first element needs braces */
6469 quotingType[i] = JIM_ELESTR_BRACE;
6470 /* fall through */
6471 case JIM_ELESTR_BRACE:
6472 bufLen += len + 2;
6473 break;
6474 case JIM_ELESTR_QUOTE:
6475 bufLen += len * 2;
6476 break;
6478 bufLen++; /* elements separator. */
6480 bufLen++;
6482 /* Generate the string rep. */
6483 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
6484 realLength = 0;
6485 for (i = 0; i < objc; i++) {
6486 int len, qlen;
6488 strRep = Jim_GetString(objv[i], &len);
6490 switch (quotingType[i]) {
6491 case JIM_ELESTR_SIMPLE:
6492 memcpy(p, strRep, len);
6493 p += len;
6494 realLength += len;
6495 break;
6496 case JIM_ELESTR_BRACE:
6497 *p++ = '{';
6498 memcpy(p, strRep, len);
6499 p += len;
6500 *p++ = '}';
6501 realLength += len + 2;
6502 break;
6503 case JIM_ELESTR_QUOTE:
6504 if (i == 0 && strRep[0] == '#') {
6505 *p++ = '\\';
6506 realLength++;
6508 qlen = BackslashQuoteString(strRep, len, p);
6509 p += qlen;
6510 realLength += qlen;
6511 break;
6513 /* Add a separating space */
6514 if (i + 1 != objc) {
6515 *p++ = ' ';
6516 realLength++;
6519 *p = '\0'; /* nul term. */
6520 objPtr->length = realLength;
6522 if (quotingType != staticQuoting) {
6523 Jim_Free(quotingType);
6527 static void UpdateStringOfList(struct Jim_Obj *objPtr)
6529 JimMakeListStringRep(objPtr, objPtr->internalRep.listValue.ele, objPtr->internalRep.listValue.len);
6532 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6534 struct JimParserCtx parser;
6535 const char *str;
6536 int strLen;
6537 Jim_Obj *fileNameObj;
6538 int linenr;
6540 if (objPtr->typePtr == &listObjType) {
6541 return JIM_OK;
6544 /* Optimise dict -> list for object with no string rep. Note that this may only save a little time, but
6545 * it also preserves any source location of the dict elements
6546 * which can be very useful
6548 if (Jim_IsDict(objPtr) && objPtr->bytes == NULL) {
6549 Jim_Obj **listObjPtrPtr;
6550 int len;
6551 int i;
6553 listObjPtrPtr = JimDictPairs(objPtr, &len);
6554 for (i = 0; i < len; i++) {
6555 Jim_IncrRefCount(listObjPtrPtr[i]);
6558 /* Now just switch the internal rep */
6559 Jim_FreeIntRep(interp, objPtr);
6560 objPtr->typePtr = &listObjType;
6561 objPtr->internalRep.listValue.len = len;
6562 objPtr->internalRep.listValue.maxLen = len;
6563 objPtr->internalRep.listValue.ele = listObjPtrPtr;
6565 return JIM_OK;
6568 /* Try to preserve information about filename / line number */
6569 if (objPtr->typePtr == &sourceObjType) {
6570 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
6571 linenr = objPtr->internalRep.sourceValue.lineNumber;
6573 else {
6574 fileNameObj = interp->emptyObj;
6575 linenr = 1;
6577 Jim_IncrRefCount(fileNameObj);
6579 /* Get the string representation */
6580 str = Jim_GetString(objPtr, &strLen);
6582 /* Free the old internal repr just now and initialize the
6583 * new one just now. The string->list conversion can't fail. */
6584 Jim_FreeIntRep(interp, objPtr);
6585 objPtr->typePtr = &listObjType;
6586 objPtr->internalRep.listValue.len = 0;
6587 objPtr->internalRep.listValue.maxLen = 0;
6588 objPtr->internalRep.listValue.ele = NULL;
6590 /* Convert into a list */
6591 if (strLen) {
6592 JimParserInit(&parser, str, strLen, linenr);
6593 while (!parser.eof) {
6594 Jim_Obj *elementPtr;
6596 JimParseList(&parser);
6597 if (parser.tt != JIM_TT_STR && parser.tt != JIM_TT_ESC)
6598 continue;
6599 elementPtr = JimParserGetTokenObj(interp, &parser);
6600 JimSetSourceInfo(interp, elementPtr, fileNameObj, parser.tline);
6601 ListAppendElement(objPtr, elementPtr);
6604 Jim_DecrRefCount(interp, fileNameObj);
6605 return JIM_OK;
6608 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
6610 Jim_Obj *objPtr;
6612 objPtr = Jim_NewObj(interp);
6613 objPtr->typePtr = &listObjType;
6614 objPtr->bytes = NULL;
6615 objPtr->internalRep.listValue.ele = NULL;
6616 objPtr->internalRep.listValue.len = 0;
6617 objPtr->internalRep.listValue.maxLen = 0;
6619 if (len) {
6620 ListInsertElements(objPtr, 0, len, elements);
6623 return objPtr;
6626 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
6627 * length of the vector. Note that the user of this function should make
6628 * sure that the list object can't shimmer while the vector returned
6629 * is in use, this vector is the one stored inside the internal representation
6630 * of the list object. This function is not exported, extensions should
6631 * always access to the List object elements using Jim_ListIndex(). */
6632 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *listLen,
6633 Jim_Obj ***listVec)
6635 *listLen = Jim_ListLength(interp, listObj);
6636 *listVec = listObj->internalRep.listValue.ele;
6639 /* Sorting uses ints, but commands may return wide */
6640 static int JimSign(jim_wide w)
6642 if (w == 0) {
6643 return 0;
6645 else if (w < 0) {
6646 return -1;
6648 return 1;
6651 /* ListSortElements type values */
6652 struct lsort_info {
6653 jmp_buf jmpbuf;
6654 Jim_Obj *command;
6655 Jim_Interp *interp;
6656 enum {
6657 JIM_LSORT_ASCII,
6658 JIM_LSORT_NOCASE,
6659 JIM_LSORT_INTEGER,
6660 JIM_LSORT_REAL,
6661 JIM_LSORT_COMMAND
6662 } type;
6663 int order;
6664 int index;
6665 int indexed;
6666 int unique;
6667 int (*subfn)(Jim_Obj **, Jim_Obj **);
6670 static struct lsort_info *sort_info;
6672 static int ListSortIndexHelper(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6674 Jim_Obj *lObj, *rObj;
6676 if (Jim_ListIndex(sort_info->interp, *lhsObj, sort_info->index, &lObj, JIM_ERRMSG) != JIM_OK ||
6677 Jim_ListIndex(sort_info->interp, *rhsObj, sort_info->index, &rObj, JIM_ERRMSG) != JIM_OK) {
6678 longjmp(sort_info->jmpbuf, JIM_ERR);
6680 return sort_info->subfn(&lObj, &rObj);
6683 /* Sort the internal rep of a list. */
6684 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6686 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 0) * sort_info->order;
6689 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6691 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 1) * sort_info->order;
6694 static int ListSortInteger(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6696 jim_wide lhs = 0, rhs = 0;
6698 if (Jim_GetWide(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6699 Jim_GetWide(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6700 longjmp(sort_info->jmpbuf, JIM_ERR);
6703 return JimSign(lhs - rhs) * sort_info->order;
6706 static int ListSortReal(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6708 double lhs = 0, rhs = 0;
6710 if (Jim_GetDouble(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6711 Jim_GetDouble(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6712 longjmp(sort_info->jmpbuf, JIM_ERR);
6714 if (lhs == rhs) {
6715 return 0;
6717 if (lhs > rhs) {
6718 return sort_info->order;
6720 return -sort_info->order;
6723 static int ListSortCommand(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6725 Jim_Obj *compare_script;
6726 int rc;
6728 jim_wide ret = 0;
6730 /* This must be a valid list */
6731 compare_script = Jim_DuplicateObj(sort_info->interp, sort_info->command);
6732 Jim_ListAppendElement(sort_info->interp, compare_script, *lhsObj);
6733 Jim_ListAppendElement(sort_info->interp, compare_script, *rhsObj);
6735 rc = Jim_EvalObj(sort_info->interp, compare_script);
6737 if (rc != JIM_OK || Jim_GetWide(sort_info->interp, Jim_GetResult(sort_info->interp), &ret) != JIM_OK) {
6738 longjmp(sort_info->jmpbuf, rc);
6741 return JimSign(ret) * sort_info->order;
6744 /* Remove duplicate elements from the (sorted) list in-place, according to the
6745 * comparison function, comp.
6747 * Note that the last unique value is kept, not the first
6749 static void ListRemoveDuplicates(Jim_Obj *listObjPtr, int (*comp)(Jim_Obj **lhs, Jim_Obj **rhs))
6751 int src;
6752 int dst = 0;
6753 Jim_Obj **ele = listObjPtr->internalRep.listValue.ele;
6755 for (src = 1; src < listObjPtr->internalRep.listValue.len; src++) {
6756 if (comp(&ele[dst], &ele[src]) == 0) {
6757 /* Match, so replace the dest with the current source */
6758 Jim_DecrRefCount(sort_info->interp, ele[dst]);
6760 else {
6761 /* No match, so keep the current source and move to the next destination */
6762 dst++;
6764 ele[dst] = ele[src];
6767 /* At end of list, keep the final element unless all elements were kept */
6768 dst++;
6769 if (dst < listObjPtr->internalRep.listValue.len) {
6770 ele[dst] = ele[src];
6773 /* Set the new length */
6774 listObjPtr->internalRep.listValue.len = dst;
6777 /* Sort a list *in place*. MUST be called with a non-shared list. */
6778 static int ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, struct lsort_info *info)
6780 struct lsort_info *prev_info;
6782 typedef int (qsort_comparator) (const void *, const void *);
6783 int (*fn) (Jim_Obj **, Jim_Obj **);
6784 Jim_Obj **vector;
6785 int len;
6786 int rc;
6788 JimPanic((Jim_IsShared(listObjPtr), "ListSortElements called with shared object"));
6789 SetListFromAny(interp, listObjPtr);
6791 /* Allow lsort to be called reentrantly */
6792 prev_info = sort_info;
6793 sort_info = info;
6795 vector = listObjPtr->internalRep.listValue.ele;
6796 len = listObjPtr->internalRep.listValue.len;
6797 switch (info->type) {
6798 case JIM_LSORT_ASCII:
6799 fn = ListSortString;
6800 break;
6801 case JIM_LSORT_NOCASE:
6802 fn = ListSortStringNoCase;
6803 break;
6804 case JIM_LSORT_INTEGER:
6805 fn = ListSortInteger;
6806 break;
6807 case JIM_LSORT_REAL:
6808 fn = ListSortReal;
6809 break;
6810 case JIM_LSORT_COMMAND:
6811 fn = ListSortCommand;
6812 break;
6813 default:
6814 fn = NULL; /* avoid warning */
6815 JimPanic((1, "ListSort called with invalid sort type"));
6816 return -1; /* Should not be run but keeps static analysers happy */
6819 if (info->indexed) {
6820 /* Need to interpose a "list index" function */
6821 info->subfn = fn;
6822 fn = ListSortIndexHelper;
6825 if ((rc = setjmp(info->jmpbuf)) == 0) {
6826 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *) fn);
6828 if (info->unique && len > 1) {
6829 ListRemoveDuplicates(listObjPtr, fn);
6832 Jim_InvalidateStringRep(listObjPtr);
6834 sort_info = prev_info;
6836 return rc;
6839 /* This is the low-level function to insert elements into a list.
6840 * The higher-level Jim_ListInsertElements() performs shared object
6841 * check and invalidates the string repr. This version is used
6842 * in the internals of the List Object and is not exported.
6844 * NOTE: this function can be called only against objects
6845 * with internal type of List.
6847 * An insertion point (idx) of -1 means end-of-list.
6849 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec)
6851 int currentLen = listPtr->internalRep.listValue.len;
6852 int requiredLen = currentLen + elemc;
6853 int i;
6854 Jim_Obj **point;
6856 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
6857 if (requiredLen < 2) {
6858 /* Don't do allocations of under 4 pointers. */
6859 requiredLen = 4;
6861 else {
6862 requiredLen *= 2;
6865 listPtr->internalRep.listValue.ele = Jim_Realloc(listPtr->internalRep.listValue.ele,
6866 sizeof(Jim_Obj *) * requiredLen);
6868 listPtr->internalRep.listValue.maxLen = requiredLen;
6870 if (idx < 0) {
6871 idx = currentLen;
6873 point = listPtr->internalRep.listValue.ele + idx;
6874 memmove(point + elemc, point, (currentLen - idx) * sizeof(Jim_Obj *));
6875 for (i = 0; i < elemc; ++i) {
6876 point[i] = elemVec[i];
6877 Jim_IncrRefCount(point[i]);
6879 listPtr->internalRep.listValue.len += elemc;
6882 /* Convenience call to ListInsertElements() to append a single element.
6884 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
6886 ListInsertElements(listPtr, -1, 1, &objPtr);
6889 /* Appends every element of appendListPtr into listPtr.
6890 * Both have to be of the list type.
6891 * Convenience call to ListInsertElements()
6893 static void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6895 ListInsertElements(listPtr, -1,
6896 appendListPtr->internalRep.listValue.len, appendListPtr->internalRep.listValue.ele);
6899 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
6901 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendElement called with shared object"));
6902 SetListFromAny(interp, listPtr);
6903 Jim_InvalidateStringRep(listPtr);
6904 ListAppendElement(listPtr, objPtr);
6907 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6909 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendList called with shared object"));
6910 SetListFromAny(interp, listPtr);
6911 SetListFromAny(interp, appendListPtr);
6912 Jim_InvalidateStringRep(listPtr);
6913 ListAppendList(listPtr, appendListPtr);
6916 int Jim_ListLength(Jim_Interp *interp, Jim_Obj *objPtr)
6918 SetListFromAny(interp, objPtr);
6919 return objPtr->internalRep.listValue.len;
6922 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6923 int objc, Jim_Obj *const *objVec)
6925 JimPanic((Jim_IsShared(listPtr), "Jim_ListInsertElement called with shared object"));
6926 SetListFromAny(interp, listPtr);
6927 if (idx >= 0 && idx > listPtr->internalRep.listValue.len)
6928 idx = listPtr->internalRep.listValue.len;
6929 else if (idx < 0)
6930 idx = 0;
6931 Jim_InvalidateStringRep(listPtr);
6932 ListInsertElements(listPtr, idx, objc, objVec);
6935 Jim_Obj *Jim_ListGetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx)
6937 SetListFromAny(interp, listPtr);
6938 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6939 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6940 return NULL;
6942 if (idx < 0)
6943 idx = listPtr->internalRep.listValue.len + idx;
6944 return listPtr->internalRep.listValue.ele[idx];
6947 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx, Jim_Obj **objPtrPtr, int flags)
6949 *objPtrPtr = Jim_ListGetIndex(interp, listPtr, idx);
6950 if (*objPtrPtr == NULL) {
6951 if (flags & JIM_ERRMSG) {
6952 Jim_SetResultString(interp, "list index out of range", -1);
6954 return JIM_ERR;
6956 return JIM_OK;
6959 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6960 Jim_Obj *newObjPtr, int flags)
6962 SetListFromAny(interp, listPtr);
6963 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6964 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6965 if (flags & JIM_ERRMSG) {
6966 Jim_SetResultString(interp, "list index out of range", -1);
6968 return JIM_ERR;
6970 if (idx < 0)
6971 idx = listPtr->internalRep.listValue.len + idx;
6972 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[idx]);
6973 listPtr->internalRep.listValue.ele[idx] = newObjPtr;
6974 Jim_IncrRefCount(newObjPtr);
6975 return JIM_OK;
6978 /* Modify the list stored in the variable named 'varNamePtr'
6979 * setting the element specified by the 'indexc' indexes objects in 'indexv',
6980 * with the new element 'newObjptr'. (implements the [lset] command) */
6981 int Jim_ListSetIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
6982 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
6984 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
6985 int shared, i, idx;
6987 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG | JIM_UNSHARED);
6988 if (objPtr == NULL)
6989 return JIM_ERR;
6990 if ((shared = Jim_IsShared(objPtr)))
6991 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
6992 for (i = 0; i < indexc - 1; i++) {
6993 listObjPtr = objPtr;
6994 if (Jim_GetIndex(interp, indexv[i], &idx) != JIM_OK)
6995 goto err;
6996 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_ERRMSG) != JIM_OK) {
6997 goto err;
6999 if (Jim_IsShared(objPtr)) {
7000 objPtr = Jim_DuplicateObj(interp, objPtr);
7001 ListSetIndex(interp, listObjPtr, idx, objPtr, JIM_NONE);
7003 Jim_InvalidateStringRep(listObjPtr);
7005 if (Jim_GetIndex(interp, indexv[indexc - 1], &idx) != JIM_OK)
7006 goto err;
7007 if (ListSetIndex(interp, objPtr, idx, newObjPtr, JIM_ERRMSG) == JIM_ERR)
7008 goto err;
7009 Jim_InvalidateStringRep(objPtr);
7010 Jim_InvalidateStringRep(varObjPtr);
7011 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
7012 goto err;
7013 Jim_SetResult(interp, varObjPtr);
7014 return JIM_OK;
7015 err:
7016 if (shared) {
7017 Jim_FreeNewObj(interp, varObjPtr);
7019 return JIM_ERR;
7022 Jim_Obj *Jim_ListJoin(Jim_Interp *interp, Jim_Obj *listObjPtr, const char *joinStr, int joinStrLen)
7024 int i;
7025 int listLen = Jim_ListLength(interp, listObjPtr);
7026 Jim_Obj *resObjPtr = Jim_NewEmptyStringObj(interp);
7028 for (i = 0; i < listLen; ) {
7029 Jim_AppendObj(interp, resObjPtr, Jim_ListGetIndex(interp, listObjPtr, i));
7030 if (++i != listLen) {
7031 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
7034 return resObjPtr;
7037 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
7039 int i;
7041 /* If all the objects in objv are lists,
7042 * it's possible to return a list as result, that's the
7043 * concatenation of all the lists. */
7044 for (i = 0; i < objc; i++) {
7045 if (!Jim_IsList(objv[i]))
7046 break;
7048 if (i == objc) {
7049 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
7051 for (i = 0; i < objc; i++)
7052 ListAppendList(objPtr, objv[i]);
7053 return objPtr;
7055 else {
7056 /* Else... we have to glue strings together */
7057 int len = 0, objLen;
7058 char *bytes, *p;
7060 /* Compute the length */
7061 for (i = 0; i < objc; i++) {
7062 len += Jim_Length(objv[i]);
7064 if (objc)
7065 len += objc - 1;
7066 /* Create the string rep, and a string object holding it. */
7067 p = bytes = Jim_Alloc(len + 1);
7068 for (i = 0; i < objc; i++) {
7069 const char *s = Jim_GetString(objv[i], &objLen);
7071 /* Remove leading space */
7072 while (objLen && isspace(UCHAR(*s))) {
7073 s++;
7074 objLen--;
7075 len--;
7077 /* And trailing space */
7078 while (objLen && isspace(UCHAR(s[objLen - 1]))) {
7079 /* Handle trailing backslash-space case */
7080 if (objLen > 1 && s[objLen - 2] == '\\') {
7081 break;
7083 objLen--;
7084 len--;
7086 memcpy(p, s, objLen);
7087 p += objLen;
7088 if (i + 1 != objc) {
7089 if (objLen)
7090 *p++ = ' ';
7091 else {
7092 /* Drop the space calculated for this
7093 * element that is instead null. */
7094 len--;
7098 *p = '\0';
7099 return Jim_NewStringObjNoAlloc(interp, bytes, len);
7103 /* Returns a list composed of the elements in the specified range.
7104 * first and start are directly accepted as Jim_Objects and
7105 * processed for the end?-index? case. */
7106 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr,
7107 Jim_Obj *lastObjPtr)
7109 int first, last;
7110 int len, rangeLen;
7112 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
7113 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
7114 return NULL;
7115 len = Jim_ListLength(interp, listObjPtr); /* will convert into list */
7116 first = JimRelToAbsIndex(len, first);
7117 last = JimRelToAbsIndex(len, last);
7118 JimRelToAbsRange(len, &first, &last, &rangeLen);
7119 if (first == 0 && last == len) {
7120 return listObjPtr;
7122 return Jim_NewListObj(interp, listObjPtr->internalRep.listValue.ele + first, rangeLen);
7125 /* -----------------------------------------------------------------------------
7126 * Dict object
7127 * ---------------------------------------------------------------------------*/
7128 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
7129 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
7130 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
7131 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7133 /* Dict HashTable Type.
7135 * Keys and Values are Jim objects. */
7137 static const Jim_HashTableType JimDictHashTableType = {
7138 JimObjectHTHashFunction, /* hash function */
7139 JimObjectHTKeyValDup, /* key dup */
7140 JimObjectHTKeyValDup, /* val dup */
7141 JimObjectHTKeyCompare, /* key compare */
7142 JimObjectHTKeyValDestructor, /* key destructor */
7143 JimObjectHTKeyValDestructor /* val destructor */
7146 /* Note that while the elements of the dict may contain references,
7147 * the list object itself can't. This basically means that the
7148 * dict object string representation as a whole can't contain references
7149 * that are not presents in the single elements. */
7150 static const Jim_ObjType dictObjType = {
7151 "dict",
7152 FreeDictInternalRep,
7153 DupDictInternalRep,
7154 UpdateStringOfDict,
7155 JIM_TYPE_NONE,
7158 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
7160 JIM_NOTUSED(interp);
7162 Jim_FreeHashTable(objPtr->internalRep.ptr);
7163 Jim_Free(objPtr->internalRep.ptr);
7166 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
7168 Jim_HashTable *ht, *dupHt;
7169 Jim_HashTableIterator htiter;
7170 Jim_HashEntry *he;
7172 /* Create a new hash table */
7173 ht = srcPtr->internalRep.ptr;
7174 dupHt = Jim_Alloc(sizeof(*dupHt));
7175 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
7176 if (ht->size != 0)
7177 Jim_ExpandHashTable(dupHt, ht->size);
7178 /* Copy every element from the source to the dup hash table */
7179 JimInitHashTableIterator(ht, &htiter);
7180 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7181 Jim_AddHashEntry(dupHt, he->key, he->u.val);
7184 dupPtr->internalRep.ptr = dupHt;
7185 dupPtr->typePtr = &dictObjType;
7188 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len)
7190 Jim_HashTable *ht;
7191 Jim_HashTableIterator htiter;
7192 Jim_HashEntry *he;
7193 Jim_Obj **objv;
7194 int i;
7196 ht = dictPtr->internalRep.ptr;
7198 /* Turn the hash table into a flat vector of Jim_Objects. */
7199 objv = Jim_Alloc((ht->used * 2) * sizeof(Jim_Obj *));
7200 JimInitHashTableIterator(ht, &htiter);
7201 i = 0;
7202 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7203 objv[i++] = Jim_GetHashEntryKey(he);
7204 objv[i++] = Jim_GetHashEntryVal(he);
7206 *len = i;
7207 return objv;
7210 static void UpdateStringOfDict(struct Jim_Obj *objPtr)
7212 /* Turn the hash table into a flat vector of Jim_Objects. */
7213 int len;
7214 Jim_Obj **objv = JimDictPairs(objPtr, &len);
7216 /* And now generate the string rep as a list */
7217 JimMakeListStringRep(objPtr, objv, len);
7219 Jim_Free(objv);
7222 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
7224 int listlen;
7226 if (objPtr->typePtr == &dictObjType) {
7227 return JIM_OK;
7230 if (Jim_IsList(objPtr) && Jim_IsShared(objPtr)) {
7231 /* A shared list, so get the string representation now to avoid
7232 * changing the order in case of fast conversion to dict.
7234 Jim_String(objPtr);
7237 /* For simplicity, convert a non-list object to a list and then to a dict */
7238 listlen = Jim_ListLength(interp, objPtr);
7239 if (listlen % 2) {
7240 Jim_SetResultString(interp, "missing value to go with key", -1);
7241 return JIM_ERR;
7243 else {
7244 /* Converting from a list to a dict can't fail */
7245 Jim_HashTable *ht;
7246 int i;
7248 ht = Jim_Alloc(sizeof(*ht));
7249 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
7251 for (i = 0; i < listlen; i += 2) {
7252 Jim_Obj *keyObjPtr = Jim_ListGetIndex(interp, objPtr, i);
7253 Jim_Obj *valObjPtr = Jim_ListGetIndex(interp, objPtr, i + 1);
7255 Jim_ReplaceHashEntry(ht, keyObjPtr, valObjPtr);
7258 Jim_FreeIntRep(interp, objPtr);
7259 objPtr->typePtr = &dictObjType;
7260 objPtr->internalRep.ptr = ht;
7262 return JIM_OK;
7266 /* Dict object API */
7268 /* Add an element to a dict. objPtr must be of the "dict" type.
7269 * The higher-level exported function is Jim_DictAddElement().
7270 * If an element with the specified key already exists, the value
7271 * associated is replaced with the new one.
7273 * if valueObjPtr == NULL, the key is instead removed if it exists. */
7274 static int DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7275 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7277 Jim_HashTable *ht = objPtr->internalRep.ptr;
7279 if (valueObjPtr == NULL) { /* unset */
7280 return Jim_DeleteHashEntry(ht, keyObjPtr);
7282 Jim_ReplaceHashEntry(ht, keyObjPtr, valueObjPtr);
7283 return JIM_OK;
7286 /* Add an element, higher-level interface for DictAddElement().
7287 * If valueObjPtr == NULL, the key is removed if it exists. */
7288 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7289 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7291 JimPanic((Jim_IsShared(objPtr), "Jim_DictAddElement called with shared object"));
7292 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
7293 return JIM_ERR;
7295 Jim_InvalidateStringRep(objPtr);
7296 return DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
7299 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
7301 Jim_Obj *objPtr;
7302 int i;
7304 JimPanic((len % 2, "Jim_NewDictObj() 'len' argument must be even"));
7306 objPtr = Jim_NewObj(interp);
7307 objPtr->typePtr = &dictObjType;
7308 objPtr->bytes = NULL;
7309 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
7310 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
7311 for (i = 0; i < len; i += 2)
7312 DictAddElement(interp, objPtr, elements[i], elements[i + 1]);
7313 return objPtr;
7316 /* Return the value associated to the specified dict key
7317 * Returns JIM_OK if OK, JIM_ERR if entry not found or -1 if can't create dict value
7319 * Sets *objPtrPtr to non-NULL only upon success.
7321 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
7322 Jim_Obj **objPtrPtr, int flags)
7324 Jim_HashEntry *he;
7325 Jim_HashTable *ht;
7327 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7328 return -1;
7330 ht = dictPtr->internalRep.ptr;
7331 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
7332 if (flags & JIM_ERRMSG) {
7333 Jim_SetResultFormatted(interp, "key \"%#s\" not known in dictionary", keyPtr);
7335 return JIM_ERR;
7337 else {
7338 *objPtrPtr = Jim_GetHashEntryVal(he);
7339 return JIM_OK;
7343 /* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */
7344 int Jim_DictPairs(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj ***objPtrPtr, int *len)
7346 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7347 return JIM_ERR;
7349 *objPtrPtr = JimDictPairs(dictPtr, len);
7351 return JIM_OK;
7355 /* Return the value associated to the specified dict keys */
7356 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
7357 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
7359 int i;
7361 if (keyc == 0) {
7362 *objPtrPtr = dictPtr;
7363 return JIM_OK;
7366 for (i = 0; i < keyc; i++) {
7367 Jim_Obj *objPtr;
7369 int rc = Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags);
7370 if (rc != JIM_OK) {
7371 return rc;
7373 dictPtr = objPtr;
7375 *objPtrPtr = dictPtr;
7376 return JIM_OK;
7379 /* Modify the dict stored into the variable named 'varNamePtr'
7380 * setting the element specified by the 'keyc' keys objects in 'keyv',
7381 * with the new value of the element 'newObjPtr'.
7383 * If newObjPtr == NULL the operation is to remove the given key
7384 * from the dictionary.
7386 * If flags & JIM_ERRMSG, then failure to remove the key is considered an error
7387 * and JIM_ERR is returned. Otherwise it is ignored and JIM_OK is returned.
7389 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
7390 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr, int flags)
7392 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
7393 int shared, i;
7395 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, flags);
7396 if (objPtr == NULL) {
7397 if (newObjPtr == NULL && (flags & JIM_MUSTEXIST)) {
7398 /* Cannot remove a key from non existing var */
7399 return JIM_ERR;
7401 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
7402 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
7403 Jim_FreeNewObj(interp, varObjPtr);
7404 return JIM_ERR;
7407 if ((shared = Jim_IsShared(objPtr)))
7408 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
7409 for (i = 0; i < keyc; i++) {
7410 dictObjPtr = objPtr;
7412 /* Check if it's a valid dictionary */
7413 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK) {
7414 goto err;
7417 if (i == keyc - 1) {
7418 /* Last key: Note that error on unset with missing last key is OK */
7419 if (Jim_DictAddElement(interp, objPtr, keyv[keyc - 1], newObjPtr) != JIM_OK) {
7420 if (newObjPtr || (flags & JIM_MUSTEXIST)) {
7421 goto err;
7424 break;
7427 /* Check if the given key exists. */
7428 Jim_InvalidateStringRep(dictObjPtr);
7429 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
7430 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK) {
7431 /* This key exists at the current level.
7432 * Make sure it's not shared!. */
7433 if (Jim_IsShared(objPtr)) {
7434 objPtr = Jim_DuplicateObj(interp, objPtr);
7435 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7438 else {
7439 /* Key not found. If it's an [unset] operation
7440 * this is an error. Only the last key may not
7441 * exist. */
7442 if (newObjPtr == NULL) {
7443 goto err;
7445 /* Otherwise set an empty dictionary
7446 * as key's value. */
7447 objPtr = Jim_NewDictObj(interp, NULL, 0);
7448 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7451 /* XXX: Is this necessary? */
7452 Jim_InvalidateStringRep(objPtr);
7453 Jim_InvalidateStringRep(varObjPtr);
7454 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK) {
7455 goto err;
7457 Jim_SetResult(interp, varObjPtr);
7458 return JIM_OK;
7459 err:
7460 if (shared) {
7461 Jim_FreeNewObj(interp, varObjPtr);
7463 return JIM_ERR;
7466 /* -----------------------------------------------------------------------------
7467 * Index object
7468 * ---------------------------------------------------------------------------*/
7469 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
7470 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7472 static const Jim_ObjType indexObjType = {
7473 "index",
7474 NULL,
7475 NULL,
7476 UpdateStringOfIndex,
7477 JIM_TYPE_NONE,
7480 static void UpdateStringOfIndex(struct Jim_Obj *objPtr)
7482 if (objPtr->internalRep.intValue == -1) {
7483 JimSetStringBytes(objPtr, "end");
7485 else {
7486 char buf[JIM_INTEGER_SPACE + 1];
7487 if (objPtr->internalRep.intValue >= 0 || objPtr->internalRep.intValue == -INT_MAX) {
7488 sprintf(buf, "%d", objPtr->internalRep.intValue);
7490 else {
7491 /* Must be <= -2 */
7492 sprintf(buf, "end%d", objPtr->internalRep.intValue + 1);
7494 JimSetStringBytes(objPtr, buf);
7498 static int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7500 int idx, end = 0;
7501 const char *str;
7502 char *endptr;
7504 /* Get the string representation */
7505 str = Jim_String(objPtr);
7507 /* Try to convert into an index */
7508 if (strncmp(str, "end", 3) == 0) {
7509 end = 1;
7510 str += 3;
7511 idx = 0;
7513 else {
7514 idx = jim_strtol(str, &endptr);
7516 if (endptr == str) {
7517 goto badindex;
7519 str = endptr;
7522 /* Now str may include or +<num> or -<num> */
7523 if (*str == '+' || *str == '-') {
7524 int sign = (*str == '+' ? 1 : -1);
7526 idx += sign * jim_strtol(++str, &endptr);
7527 if (str == endptr || *endptr) {
7528 goto badindex;
7530 str = endptr;
7532 /* The only thing left should be spaces */
7533 while (isspace(UCHAR(*str))) {
7534 str++;
7536 if (*str) {
7537 goto badindex;
7539 if (end) {
7540 if (idx > 0) {
7541 idx = INT_MAX;
7543 else {
7544 /* end-1 is repesented as -2 */
7545 idx--;
7548 else if (idx < 0) {
7549 idx = -INT_MAX;
7552 /* Free the old internal repr and set the new one. */
7553 Jim_FreeIntRep(interp, objPtr);
7554 objPtr->typePtr = &indexObjType;
7555 objPtr->internalRep.intValue = idx;
7556 return JIM_OK;
7558 badindex:
7559 Jim_SetResultFormatted(interp,
7560 "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr);
7561 return JIM_ERR;
7564 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
7566 /* Avoid shimmering if the object is an integer. */
7567 if (objPtr->typePtr == &intObjType) {
7568 jim_wide val = JimWideValue(objPtr);
7570 if (val < 0)
7571 *indexPtr = -INT_MAX;
7572 else if (val > INT_MAX)
7573 *indexPtr = INT_MAX;
7574 else
7575 *indexPtr = (int)val;
7576 return JIM_OK;
7578 if (objPtr->typePtr != &indexObjType && SetIndexFromAny(interp, objPtr) == JIM_ERR)
7579 return JIM_ERR;
7580 *indexPtr = objPtr->internalRep.intValue;
7581 return JIM_OK;
7584 /* -----------------------------------------------------------------------------
7585 * Return Code Object.
7586 * ---------------------------------------------------------------------------*/
7588 /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
7589 static const char * const jimReturnCodes[] = {
7590 "ok",
7591 "error",
7592 "return",
7593 "break",
7594 "continue",
7595 "signal",
7596 "exit",
7597 "eval",
7598 NULL
7601 #define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes) - 1)
7603 static const Jim_ObjType returnCodeObjType = {
7604 "return-code",
7605 NULL,
7606 NULL,
7607 NULL,
7608 JIM_TYPE_NONE,
7611 /* Converts a (standard) return code to a string. Returns "?" for
7612 * non-standard return codes.
7614 const char *Jim_ReturnCode(int code)
7616 if (code < 0 || code >= (int)jimReturnCodesSize) {
7617 return "?";
7619 else {
7620 return jimReturnCodes[code];
7624 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7626 int returnCode;
7627 jim_wide wideValue;
7629 /* Try to convert into an integer */
7630 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
7631 returnCode = (int)wideValue;
7632 else if (Jim_GetEnum(interp, objPtr, jimReturnCodes, &returnCode, NULL, JIM_NONE) != JIM_OK) {
7633 Jim_SetResultFormatted(interp, "expected return code but got \"%#s\"", objPtr);
7634 return JIM_ERR;
7636 /* Free the old internal repr and set the new one. */
7637 Jim_FreeIntRep(interp, objPtr);
7638 objPtr->typePtr = &returnCodeObjType;
7639 objPtr->internalRep.intValue = returnCode;
7640 return JIM_OK;
7643 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
7645 if (objPtr->typePtr != &returnCodeObjType && SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
7646 return JIM_ERR;
7647 *intPtr = objPtr->internalRep.intValue;
7648 return JIM_OK;
7651 /* -----------------------------------------------------------------------------
7652 * Expression Parsing
7653 * ---------------------------------------------------------------------------*/
7654 static int JimParseExprOperator(struct JimParserCtx *pc);
7655 static int JimParseExprNumber(struct JimParserCtx *pc);
7656 static int JimParseExprIrrational(struct JimParserCtx *pc);
7657 static int JimParseExprBoolean(struct JimParserCtx *pc);
7659 /* expr operator opcodes. */
7660 enum
7662 /* Continues on from the JIM_TT_ space */
7664 /* Binary operators (numbers) */
7665 JIM_EXPROP_MUL = JIM_TT_EXPR_OP, /* 20 */
7666 JIM_EXPROP_DIV,
7667 JIM_EXPROP_MOD,
7668 JIM_EXPROP_SUB,
7669 JIM_EXPROP_ADD,
7670 JIM_EXPROP_LSHIFT,
7671 JIM_EXPROP_RSHIFT,
7672 JIM_EXPROP_ROTL,
7673 JIM_EXPROP_ROTR,
7674 JIM_EXPROP_LT,
7675 JIM_EXPROP_GT,
7676 JIM_EXPROP_LTE,
7677 JIM_EXPROP_GTE,
7678 JIM_EXPROP_NUMEQ,
7679 JIM_EXPROP_NUMNE,
7680 JIM_EXPROP_BITAND, /* 35 */
7681 JIM_EXPROP_BITXOR,
7682 JIM_EXPROP_BITOR,
7683 JIM_EXPROP_LOGICAND, /* 38 */
7684 JIM_EXPROP_LOGICOR, /* 39 */
7685 JIM_EXPROP_TERNARY, /* 40 */
7686 JIM_EXPROP_COLON, /* 41 */
7687 JIM_EXPROP_POW, /* 42 */
7689 /* Binary operators (strings) */
7690 JIM_EXPROP_STREQ, /* 43 */
7691 JIM_EXPROP_STRNE,
7692 JIM_EXPROP_STRIN,
7693 JIM_EXPROP_STRNI,
7695 /* Unary operators (numbers) */
7696 JIM_EXPROP_NOT, /* 47 */
7697 JIM_EXPROP_BITNOT,
7698 JIM_EXPROP_UNARYMINUS,
7699 JIM_EXPROP_UNARYPLUS,
7701 /* Functions */
7702 JIM_EXPROP_FUNC_INT, /* 51 */
7703 JIM_EXPROP_FUNC_WIDE,
7704 JIM_EXPROP_FUNC_ABS,
7705 JIM_EXPROP_FUNC_DOUBLE,
7706 JIM_EXPROP_FUNC_ROUND,
7707 JIM_EXPROP_FUNC_RAND,
7708 JIM_EXPROP_FUNC_SRAND,
7710 /* math functions from libm */
7711 JIM_EXPROP_FUNC_SIN, /* 65 */
7712 JIM_EXPROP_FUNC_COS,
7713 JIM_EXPROP_FUNC_TAN,
7714 JIM_EXPROP_FUNC_ASIN,
7715 JIM_EXPROP_FUNC_ACOS,
7716 JIM_EXPROP_FUNC_ATAN,
7717 JIM_EXPROP_FUNC_ATAN2,
7718 JIM_EXPROP_FUNC_SINH,
7719 JIM_EXPROP_FUNC_COSH,
7720 JIM_EXPROP_FUNC_TANH,
7721 JIM_EXPROP_FUNC_CEIL,
7722 JIM_EXPROP_FUNC_FLOOR,
7723 JIM_EXPROP_FUNC_EXP,
7724 JIM_EXPROP_FUNC_LOG,
7725 JIM_EXPROP_FUNC_LOG10,
7726 JIM_EXPROP_FUNC_SQRT,
7727 JIM_EXPROP_FUNC_POW,
7728 JIM_EXPROP_FUNC_HYPOT,
7729 JIM_EXPROP_FUNC_FMOD,
7732 /* A expression node is either a term or an operator
7733 * If a node is an operator, 'op' points to the details of the operator and it's terms.
7735 struct JimExprNode {
7736 int type; /* JIM_TT_xxx */
7737 struct Jim_Obj *objPtr; /* The object for a term, or NULL for an operator */
7739 struct JimExprNode *left; /* For all operators */
7740 struct JimExprNode *right; /* For binary operators */
7741 struct JimExprNode *ternary; /* For ternary operator only */
7744 /* Operators table */
7745 typedef struct Jim_ExprOperator
7747 const char *name;
7748 int (*funcop) (Jim_Interp *interp, struct JimExprNode *opnode);
7749 unsigned char precedence;
7750 unsigned char arity;
7751 unsigned char attr;
7752 unsigned char namelen;
7753 } Jim_ExprOperator;
7755 static int JimExprGetTerm(Jim_Interp *interp, struct JimExprNode *node, Jim_Obj **objPtrPtr);
7756 static int JimExprGetTermBoolean(Jim_Interp *interp, struct JimExprNode *node);
7757 static int JimExprEvalTermNode(Jim_Interp *interp, struct JimExprNode *node);
7759 static int JimExprOpNumUnary(Jim_Interp *interp, struct JimExprNode *node)
7761 int intresult = 1;
7762 int rc;
7763 double dA, dC = 0;
7764 jim_wide wA, wC = 0;
7765 Jim_Obj *A;
7767 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7768 return rc;
7771 if ((A->typePtr != &doubleObjType || A->bytes) && JimGetWideNoErr(interp, A, &wA) == JIM_OK) {
7772 switch (node->type) {
7773 case JIM_EXPROP_FUNC_INT:
7774 case JIM_EXPROP_FUNC_WIDE:
7775 case JIM_EXPROP_FUNC_ROUND:
7776 case JIM_EXPROP_UNARYPLUS:
7777 wC = wA;
7778 break;
7779 case JIM_EXPROP_FUNC_DOUBLE:
7780 dC = wA;
7781 intresult = 0;
7782 break;
7783 case JIM_EXPROP_FUNC_ABS:
7784 wC = wA >= 0 ? wA : -wA;
7785 break;
7786 case JIM_EXPROP_UNARYMINUS:
7787 wC = -wA;
7788 break;
7789 case JIM_EXPROP_NOT:
7790 wC = !wA;
7791 break;
7792 default:
7793 abort();
7796 else if ((rc = Jim_GetDouble(interp, A, &dA)) == JIM_OK) {
7797 switch (node->type) {
7798 case JIM_EXPROP_FUNC_INT:
7799 case JIM_EXPROP_FUNC_WIDE:
7800 wC = dA;
7801 break;
7802 case JIM_EXPROP_FUNC_ROUND:
7803 wC = dA < 0 ? (dA - 0.5) : (dA + 0.5);
7804 break;
7805 case JIM_EXPROP_FUNC_DOUBLE:
7806 case JIM_EXPROP_UNARYPLUS:
7807 dC = dA;
7808 intresult = 0;
7809 break;
7810 case JIM_EXPROP_FUNC_ABS:
7811 #ifdef JIM_MATH_FUNCTIONS
7812 dC = fabs(dA);
7813 #else
7814 dC = dA >= 0 ? dA : -dA;
7815 #endif
7816 intresult = 0;
7817 break;
7818 case JIM_EXPROP_UNARYMINUS:
7819 dC = -dA;
7820 intresult = 0;
7821 break;
7822 case JIM_EXPROP_NOT:
7823 wC = !dA;
7824 break;
7825 default:
7826 abort();
7830 if (rc == JIM_OK) {
7831 if (intresult) {
7832 Jim_SetResultInt(interp, wC);
7834 else {
7835 Jim_SetResult(interp, Jim_NewDoubleObj(interp, dC));
7839 Jim_DecrRefCount(interp, A);
7841 return rc;
7844 static double JimRandDouble(Jim_Interp *interp)
7846 unsigned long x;
7847 JimRandomBytes(interp, &x, sizeof(x));
7849 return (double)x / (unsigned long)~0;
7852 static int JimExprOpIntUnary(Jim_Interp *interp, struct JimExprNode *node)
7854 jim_wide wA;
7855 Jim_Obj *A;
7856 int rc;
7858 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7859 return rc;
7862 rc = Jim_GetWide(interp, A, &wA);
7863 if (rc == JIM_OK) {
7864 switch (node->type) {
7865 case JIM_EXPROP_BITNOT:
7866 Jim_SetResultInt(interp, ~wA);
7867 break;
7868 case JIM_EXPROP_FUNC_SRAND:
7869 JimPrngSeed(interp, (unsigned char *)&wA, sizeof(wA));
7870 Jim_SetResult(interp, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7871 break;
7872 default:
7873 abort();
7877 Jim_DecrRefCount(interp, A);
7879 return rc;
7882 static int JimExprOpNone(Jim_Interp *interp, struct JimExprNode *node)
7884 JimPanic((node->type != JIM_EXPROP_FUNC_RAND, "JimExprOpNone only support rand()"));
7886 Jim_SetResult(interp, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7888 return JIM_OK;
7891 #ifdef JIM_MATH_FUNCTIONS
7892 static int JimExprOpDoubleUnary(Jim_Interp *interp, struct JimExprNode *node)
7894 int rc;
7895 double dA, dC;
7896 Jim_Obj *A;
7898 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7899 return rc;
7902 rc = Jim_GetDouble(interp, A, &dA);
7903 if (rc == JIM_OK) {
7904 switch (node->type) {
7905 case JIM_EXPROP_FUNC_SIN:
7906 dC = sin(dA);
7907 break;
7908 case JIM_EXPROP_FUNC_COS:
7909 dC = cos(dA);
7910 break;
7911 case JIM_EXPROP_FUNC_TAN:
7912 dC = tan(dA);
7913 break;
7914 case JIM_EXPROP_FUNC_ASIN:
7915 dC = asin(dA);
7916 break;
7917 case JIM_EXPROP_FUNC_ACOS:
7918 dC = acos(dA);
7919 break;
7920 case JIM_EXPROP_FUNC_ATAN:
7921 dC = atan(dA);
7922 break;
7923 case JIM_EXPROP_FUNC_SINH:
7924 dC = sinh(dA);
7925 break;
7926 case JIM_EXPROP_FUNC_COSH:
7927 dC = cosh(dA);
7928 break;
7929 case JIM_EXPROP_FUNC_TANH:
7930 dC = tanh(dA);
7931 break;
7932 case JIM_EXPROP_FUNC_CEIL:
7933 dC = ceil(dA);
7934 break;
7935 case JIM_EXPROP_FUNC_FLOOR:
7936 dC = floor(dA);
7937 break;
7938 case JIM_EXPROP_FUNC_EXP:
7939 dC = exp(dA);
7940 break;
7941 case JIM_EXPROP_FUNC_LOG:
7942 dC = log(dA);
7943 break;
7944 case JIM_EXPROP_FUNC_LOG10:
7945 dC = log10(dA);
7946 break;
7947 case JIM_EXPROP_FUNC_SQRT:
7948 dC = sqrt(dA);
7949 break;
7950 default:
7951 abort();
7953 Jim_SetResult(interp, Jim_NewDoubleObj(interp, dC));
7956 Jim_DecrRefCount(interp, A);
7958 return rc;
7960 #endif
7962 /* A binary operation on two ints */
7963 static int JimExprOpIntBin(Jim_Interp *interp, struct JimExprNode *node)
7965 jim_wide wA, wB;
7966 int rc;
7967 Jim_Obj *A, *B;
7969 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7970 return rc;
7972 if ((rc = JimExprGetTerm(interp, node->right, &B)) != JIM_OK) {
7973 Jim_DecrRefCount(interp, A);
7974 return rc;
7977 rc = JIM_ERR;
7979 if (Jim_GetWide(interp, A, &wA) == JIM_OK && Jim_GetWide(interp, B, &wB) == JIM_OK) {
7980 jim_wide wC;
7982 rc = JIM_OK;
7984 switch (node->type) {
7985 case JIM_EXPROP_LSHIFT:
7986 wC = wA << wB;
7987 break;
7988 case JIM_EXPROP_RSHIFT:
7989 wC = wA >> wB;
7990 break;
7991 case JIM_EXPROP_BITAND:
7992 wC = wA & wB;
7993 break;
7994 case JIM_EXPROP_BITXOR:
7995 wC = wA ^ wB;
7996 break;
7997 case JIM_EXPROP_BITOR:
7998 wC = wA | wB;
7999 break;
8000 case JIM_EXPROP_MOD:
8001 if (wB == 0) {
8002 wC = 0;
8003 Jim_SetResultString(interp, "Division by zero", -1);
8004 rc = JIM_ERR;
8006 else {
8008 * From Tcl 8.x
8010 * This code is tricky: C doesn't guarantee much
8011 * about the quotient or remainder, but Tcl does.
8012 * The remainder always has the same sign as the
8013 * divisor and a smaller absolute value.
8015 int negative = 0;
8017 if (wB < 0) {
8018 wB = -wB;
8019 wA = -wA;
8020 negative = 1;
8022 wC = wA % wB;
8023 if (wC < 0) {
8024 wC += wB;
8026 if (negative) {
8027 wC = -wC;
8030 break;
8031 case JIM_EXPROP_ROTL:
8032 case JIM_EXPROP_ROTR:{
8033 /* uint32_t would be better. But not everyone has inttypes.h? */
8034 unsigned long uA = (unsigned long)wA;
8035 unsigned long uB = (unsigned long)wB;
8036 const unsigned int S = sizeof(unsigned long) * 8;
8038 /* Shift left by the word size or more is undefined. */
8039 uB %= S;
8041 if (node->type == JIM_EXPROP_ROTR) {
8042 uB = S - uB;
8044 wC = (unsigned long)(uA << uB) | (uA >> (S - uB));
8045 break;
8047 default:
8048 abort();
8050 Jim_SetResultInt(interp, wC);
8053 Jim_DecrRefCount(interp, A);
8054 Jim_DecrRefCount(interp, B);
8056 return rc;
8060 /* A binary operation on two ints or two doubles (or two strings for some ops) */
8061 static int JimExprOpBin(Jim_Interp *interp, struct JimExprNode *node)
8063 int rc = JIM_OK;
8064 double dA, dB, dC = 0;
8065 jim_wide wA, wB, wC = 0;
8066 Jim_Obj *A, *B;
8068 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
8069 return rc;
8071 if ((rc = JimExprGetTerm(interp, node->right, &B)) != JIM_OK) {
8072 Jim_DecrRefCount(interp, A);
8073 return rc;
8076 if ((A->typePtr != &doubleObjType || A->bytes) &&
8077 (B->typePtr != &doubleObjType || B->bytes) &&
8078 JimGetWideNoErr(interp, A, &wA) == JIM_OK && JimGetWideNoErr(interp, B, &wB) == JIM_OK) {
8080 /* Both are ints */
8082 switch (node->type) {
8083 case JIM_EXPROP_POW:
8084 case JIM_EXPROP_FUNC_POW:
8085 if (wA == 0 && wB < 0) {
8086 Jim_SetResultString(interp, "exponentiation of zero by negative power", -1);
8087 rc = JIM_ERR;
8088 goto done;
8090 wC = JimPowWide(wA, wB);
8091 goto intresult;
8092 case JIM_EXPROP_ADD:
8093 wC = wA + wB;
8094 goto intresult;
8095 case JIM_EXPROP_SUB:
8096 wC = wA - wB;
8097 goto intresult;
8098 case JIM_EXPROP_MUL:
8099 wC = wA * wB;
8100 goto intresult;
8101 case JIM_EXPROP_DIV:
8102 if (wB == 0) {
8103 Jim_SetResultString(interp, "Division by zero", -1);
8104 rc = JIM_ERR;
8105 goto done;
8107 else {
8109 * From Tcl 8.x
8111 * This code is tricky: C doesn't guarantee much
8112 * about the quotient or remainder, but Tcl does.
8113 * The remainder always has the same sign as the
8114 * divisor and a smaller absolute value.
8116 if (wB < 0) {
8117 wB = -wB;
8118 wA = -wA;
8120 wC = wA / wB;
8121 if (wA % wB < 0) {
8122 wC--;
8124 goto intresult;
8126 case JIM_EXPROP_LT:
8127 wC = wA < wB;
8128 goto intresult;
8129 case JIM_EXPROP_GT:
8130 wC = wA > wB;
8131 goto intresult;
8132 case JIM_EXPROP_LTE:
8133 wC = wA <= wB;
8134 goto intresult;
8135 case JIM_EXPROP_GTE:
8136 wC = wA >= wB;
8137 goto intresult;
8138 case JIM_EXPROP_NUMEQ:
8139 wC = wA == wB;
8140 goto intresult;
8141 case JIM_EXPROP_NUMNE:
8142 wC = wA != wB;
8143 goto intresult;
8146 if (Jim_GetDouble(interp, A, &dA) == JIM_OK && Jim_GetDouble(interp, B, &dB) == JIM_OK) {
8147 switch (node->type) {
8148 #ifndef JIM_MATH_FUNCTIONS
8149 case JIM_EXPROP_POW:
8150 case JIM_EXPROP_FUNC_POW:
8151 case JIM_EXPROP_FUNC_ATAN2:
8152 case JIM_EXPROP_FUNC_HYPOT:
8153 case JIM_EXPROP_FUNC_FMOD:
8154 Jim_SetResultString(interp, "unsupported", -1);
8155 rc = JIM_ERR;
8156 goto done;
8157 #else
8158 case JIM_EXPROP_POW:
8159 case JIM_EXPROP_FUNC_POW:
8160 dC = pow(dA, dB);
8161 goto doubleresult;
8162 case JIM_EXPROP_FUNC_ATAN2:
8163 dC = atan2(dA, dB);
8164 goto doubleresult;
8165 case JIM_EXPROP_FUNC_HYPOT:
8166 dC = hypot(dA, dB);
8167 goto doubleresult;
8168 case JIM_EXPROP_FUNC_FMOD:
8169 dC = fmod(dA, dB);
8170 goto doubleresult;
8171 #endif
8172 case JIM_EXPROP_ADD:
8173 dC = dA + dB;
8174 goto doubleresult;
8175 case JIM_EXPROP_SUB:
8176 dC = dA - dB;
8177 goto doubleresult;
8178 case JIM_EXPROP_MUL:
8179 dC = dA * dB;
8180 goto doubleresult;
8181 case JIM_EXPROP_DIV:
8182 if (dB == 0) {
8183 #ifdef INFINITY
8184 dC = dA < 0 ? -INFINITY : INFINITY;
8185 #else
8186 dC = (dA < 0 ? -1.0 : 1.0) * strtod("Inf", NULL);
8187 #endif
8189 else {
8190 dC = dA / dB;
8192 goto doubleresult;
8193 case JIM_EXPROP_LT:
8194 wC = dA < dB;
8195 goto intresult;
8196 case JIM_EXPROP_GT:
8197 wC = dA > dB;
8198 goto intresult;
8199 case JIM_EXPROP_LTE:
8200 wC = dA <= dB;
8201 goto intresult;
8202 case JIM_EXPROP_GTE:
8203 wC = dA >= dB;
8204 goto intresult;
8205 case JIM_EXPROP_NUMEQ:
8206 wC = dA == dB;
8207 goto intresult;
8208 case JIM_EXPROP_NUMNE:
8209 wC = dA != dB;
8210 goto intresult;
8213 else {
8214 /* Handle the string case */
8216 /* XXX: Could optimise the eq/ne case by checking lengths */
8217 int i = Jim_StringCompareObj(interp, A, B, 0);
8219 switch (node->type) {
8220 case JIM_EXPROP_LT:
8221 wC = i < 0;
8222 goto intresult;
8223 case JIM_EXPROP_GT:
8224 wC = i > 0;
8225 goto intresult;
8226 case JIM_EXPROP_LTE:
8227 wC = i <= 0;
8228 goto intresult;
8229 case JIM_EXPROP_GTE:
8230 wC = i >= 0;
8231 goto intresult;
8232 case JIM_EXPROP_NUMEQ:
8233 wC = i == 0;
8234 goto intresult;
8235 case JIM_EXPROP_NUMNE:
8236 wC = i != 0;
8237 goto intresult;
8240 /* If we get here, it is an error */
8241 rc = JIM_ERR;
8242 done:
8243 Jim_DecrRefCount(interp, A);
8244 Jim_DecrRefCount(interp, B);
8245 return rc;
8246 intresult:
8247 Jim_SetResultInt(interp, wC);
8248 goto done;
8249 doubleresult:
8250 Jim_SetResult(interp, Jim_NewDoubleObj(interp, dC));
8251 goto done;
8254 static int JimSearchList(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *valObj)
8256 int listlen;
8257 int i;
8259 listlen = Jim_ListLength(interp, listObjPtr);
8260 for (i = 0; i < listlen; i++) {
8261 if (Jim_StringEqObj(Jim_ListGetIndex(interp, listObjPtr, i), valObj)) {
8262 return 1;
8265 return 0;
8270 static int JimExprOpStrBin(Jim_Interp *interp, struct JimExprNode *node)
8272 Jim_Obj *A, *B;
8273 jim_wide wC;
8274 int rc;
8276 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
8277 return rc;
8279 if ((rc = JimExprGetTerm(interp, node->right, &B)) != JIM_OK) {
8280 Jim_DecrRefCount(interp, A);
8281 return rc;
8284 switch (node->type) {
8285 case JIM_EXPROP_STREQ:
8286 case JIM_EXPROP_STRNE:
8287 wC = Jim_StringEqObj(A, B);
8288 if (node->type == JIM_EXPROP_STRNE) {
8289 wC = !wC;
8291 break;
8292 case JIM_EXPROP_STRIN:
8293 wC = JimSearchList(interp, B, A);
8294 break;
8295 case JIM_EXPROP_STRNI:
8296 wC = !JimSearchList(interp, B, A);
8297 break;
8298 default:
8299 abort();
8301 Jim_SetResultInt(interp, wC);
8303 Jim_DecrRefCount(interp, A);
8304 Jim_DecrRefCount(interp, B);
8306 return rc;
8309 static int ExprBool(Jim_Interp *interp, Jim_Obj *obj)
8311 long l;
8312 double d;
8313 int b;
8314 int ret = -1;
8316 /* In case the object is interp->result with refcount 1*/
8317 Jim_IncrRefCount(obj);
8319 if (Jim_GetLong(interp, obj, &l) == JIM_OK) {
8320 ret = (l != 0);
8322 else if (Jim_GetDouble(interp, obj, &d) == JIM_OK) {
8323 ret = (d != 0);
8325 else if (Jim_GetBoolean(interp, obj, &b) == JIM_OK) {
8326 ret = (b != 0);
8329 Jim_DecrRefCount(interp, obj);
8330 return ret;
8333 static int JimExprOpAnd(Jim_Interp *interp, struct JimExprNode *node)
8335 /* evaluate left */
8336 int result = JimExprGetTermBoolean(interp, node->left);
8338 if (result == 1) {
8339 /* true so evaluate right */
8340 result = JimExprGetTermBoolean(interp, node->right);
8342 if (result == -1) {
8343 return JIM_ERR;
8345 Jim_SetResultInt(interp, result);
8346 return JIM_OK;
8349 static int JimExprOpOr(Jim_Interp *interp, struct JimExprNode *node)
8351 /* evaluate left */
8352 int result = JimExprGetTermBoolean(interp, node->left);
8354 if (result == 0) {
8355 /* false so evaluate right */
8356 result = JimExprGetTermBoolean(interp, node->right);
8358 if (result == -1) {
8359 return JIM_ERR;
8361 Jim_SetResultInt(interp, result);
8362 return JIM_OK;
8365 static int JimExprOpTernary(Jim_Interp *interp, struct JimExprNode *node)
8367 /* evaluate left */
8368 int result = JimExprGetTermBoolean(interp, node->left);
8370 if (result == 1) {
8371 /* true so select right */
8372 return JimExprEvalTermNode(interp, node->right);
8374 else if (result == 0) {
8375 /* false so select ternary */
8376 return JimExprEvalTermNode(interp, node->ternary);
8378 /* error */
8379 return JIM_ERR;
8382 enum
8384 OP_FUNC = 0x0001, /* function syntax */
8385 OP_RIGHT_ASSOC = 0x0002, /* right associative */
8388 /* name - precedence - arity - opcode
8390 * This array *must* be kept in sync with the JIM_EXPROP enum.
8392 * The following macros pre-compute the string length at compile time.
8394 #define OPRINIT_ATTR(N, P, ARITY, F, ATTR) {N, F, P, ARITY, ATTR, sizeof(N) - 1}
8395 #define OPRINIT(N, P, ARITY, F) OPRINIT_ATTR(N, P, ARITY, F, 0)
8397 static const struct Jim_ExprOperator Jim_ExprOperators[] = {
8398 OPRINIT("*", 110, 2, JimExprOpBin),
8399 OPRINIT("/", 110, 2, JimExprOpBin),
8400 OPRINIT("%", 110, 2, JimExprOpIntBin),
8402 OPRINIT("-", 100, 2, JimExprOpBin),
8403 OPRINIT("+", 100, 2, JimExprOpBin),
8405 OPRINIT("<<", 90, 2, JimExprOpIntBin),
8406 OPRINIT(">>", 90, 2, JimExprOpIntBin),
8408 OPRINIT("<<<", 90, 2, JimExprOpIntBin),
8409 OPRINIT(">>>", 90, 2, JimExprOpIntBin),
8411 OPRINIT("<", 80, 2, JimExprOpBin),
8412 OPRINIT(">", 80, 2, JimExprOpBin),
8413 OPRINIT("<=", 80, 2, JimExprOpBin),
8414 OPRINIT(">=", 80, 2, JimExprOpBin),
8416 OPRINIT("==", 70, 2, JimExprOpBin),
8417 OPRINIT("!=", 70, 2, JimExprOpBin),
8419 OPRINIT("&", 50, 2, JimExprOpIntBin),
8420 OPRINIT("^", 49, 2, JimExprOpIntBin),
8421 OPRINIT("|", 48, 2, JimExprOpIntBin),
8423 OPRINIT("&&", 10, 2, JimExprOpAnd),
8424 OPRINIT("||", 9, 2, JimExprOpOr),
8425 OPRINIT_ATTR("?", 5, 3, JimExprOpTernary, OP_RIGHT_ASSOC),
8426 OPRINIT_ATTR(":", 5, 3, NULL, OP_RIGHT_ASSOC),
8428 /* Precedence is higher than * and / but lower than ! and ~, and right-associative */
8429 OPRINIT_ATTR("**", 120, 2, JimExprOpBin, OP_RIGHT_ASSOC),
8431 OPRINIT("eq", 60, 2, JimExprOpStrBin),
8432 OPRINIT("ne", 60, 2, JimExprOpStrBin),
8434 OPRINIT("in", 55, 2, JimExprOpStrBin),
8435 OPRINIT("ni", 55, 2, JimExprOpStrBin),
8437 OPRINIT_ATTR("!", 150, 1, JimExprOpNumUnary, OP_RIGHT_ASSOC),
8438 OPRINIT_ATTR("~", 150, 1, JimExprOpIntUnary, OP_RIGHT_ASSOC),
8439 OPRINIT_ATTR(" -", 150, 1, JimExprOpNumUnary, OP_RIGHT_ASSOC),
8440 OPRINIT_ATTR(" +", 150, 1, JimExprOpNumUnary, OP_RIGHT_ASSOC),
8444 OPRINIT_ATTR("int", 200, 1, JimExprOpNumUnary, OP_FUNC),
8445 OPRINIT_ATTR("wide", 200, 1, JimExprOpNumUnary, OP_FUNC),
8446 OPRINIT_ATTR("abs", 200, 1, JimExprOpNumUnary, OP_FUNC),
8447 OPRINIT_ATTR("double", 200, 1, JimExprOpNumUnary, OP_FUNC),
8448 OPRINIT_ATTR("round", 200, 1, JimExprOpNumUnary, OP_FUNC),
8449 OPRINIT_ATTR("rand", 200, 0, JimExprOpNone, OP_FUNC),
8450 OPRINIT_ATTR("srand", 200, 1, JimExprOpIntUnary, OP_FUNC),
8452 #ifdef JIM_MATH_FUNCTIONS
8453 OPRINIT_ATTR("sin", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8454 OPRINIT_ATTR("cos", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8455 OPRINIT_ATTR("tan", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8456 OPRINIT_ATTR("asin", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8457 OPRINIT_ATTR("acos", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8458 OPRINIT_ATTR("atan", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8459 OPRINIT_ATTR("atan2", 200, 2, JimExprOpBin, OP_FUNC),
8460 OPRINIT_ATTR("sinh", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8461 OPRINIT_ATTR("cosh", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8462 OPRINIT_ATTR("tanh", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8463 OPRINIT_ATTR("ceil", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8464 OPRINIT_ATTR("floor", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8465 OPRINIT_ATTR("exp", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8466 OPRINIT_ATTR("log", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8467 OPRINIT_ATTR("log10", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8468 OPRINIT_ATTR("sqrt", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8469 OPRINIT_ATTR("pow", 200, 2, JimExprOpBin, OP_FUNC),
8470 OPRINIT_ATTR("hypot", 200, 2, JimExprOpBin, OP_FUNC),
8471 OPRINIT_ATTR("fmod", 200, 2, JimExprOpBin, OP_FUNC),
8472 #endif
8474 #undef OPRINIT
8475 #undef OPRINIT_ATTR
8477 #define JIM_EXPR_OPERATORS_NUM \
8478 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
8480 static int JimParseExpression(struct JimParserCtx *pc)
8482 /* Discard spaces and quoted newline */
8483 while (isspace(UCHAR(*pc->p)) || (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) {
8484 if (*pc->p == '\n') {
8485 pc->linenr++;
8487 pc->p++;
8488 pc->len--;
8491 /* Common case */
8492 pc->tline = pc->linenr;
8493 pc->tstart = pc->p;
8495 if (pc->len == 0) {
8496 pc->tend = pc->p;
8497 pc->tt = JIM_TT_EOL;
8498 pc->eof = 1;
8499 return JIM_OK;
8501 switch (*(pc->p)) {
8502 case '(':
8503 pc->tt = JIM_TT_SUBEXPR_START;
8504 goto singlechar;
8505 case ')':
8506 pc->tt = JIM_TT_SUBEXPR_END;
8507 goto singlechar;
8508 case ',':
8509 pc->tt = JIM_TT_SUBEXPR_COMMA;
8510 singlechar:
8511 pc->tend = pc->p;
8512 pc->p++;
8513 pc->len--;
8514 break;
8515 case '[':
8516 return JimParseCmd(pc);
8517 case '$':
8518 if (JimParseVar(pc) == JIM_ERR)
8519 return JimParseExprOperator(pc);
8520 else {
8521 /* Don't allow expr sugar in expressions */
8522 if (pc->tt == JIM_TT_EXPRSUGAR) {
8523 return JIM_ERR;
8525 return JIM_OK;
8527 break;
8528 case '0':
8529 case '1':
8530 case '2':
8531 case '3':
8532 case '4':
8533 case '5':
8534 case '6':
8535 case '7':
8536 case '8':
8537 case '9':
8538 case '.':
8539 return JimParseExprNumber(pc);
8540 case '"':
8541 return JimParseQuote(pc);
8542 case '{':
8543 return JimParseBrace(pc);
8545 case 'N':
8546 case 'I':
8547 case 'n':
8548 case 'i':
8549 if (JimParseExprIrrational(pc) == JIM_ERR)
8550 if (JimParseExprBoolean(pc) == JIM_ERR)
8551 return JimParseExprOperator(pc);
8552 break;
8553 case 't':
8554 case 'f':
8555 case 'o':
8556 case 'y':
8557 if (JimParseExprBoolean(pc) == JIM_ERR)
8558 return JimParseExprOperator(pc);
8559 break;
8560 default:
8561 return JimParseExprOperator(pc);
8562 break;
8564 return JIM_OK;
8567 static int JimParseExprNumber(struct JimParserCtx *pc)
8569 char *end;
8571 /* Assume an integer for now */
8572 pc->tt = JIM_TT_EXPR_INT;
8574 jim_strtoull(pc->p, (char **)&pc->p);
8575 /* Tried as an integer, but perhaps it parses as a double */
8576 if (strchr("eENnIi.", *pc->p) || pc->p == pc->tstart) {
8577 /* Some stupid compilers insist they are cleverer that
8578 * we are. Even a (void) cast doesn't prevent this warning!
8580 if (strtod(pc->tstart, &end)) { /* nothing */ }
8581 if (end == pc->tstart)
8582 return JIM_ERR;
8583 if (end > pc->p) {
8584 /* Yes, double captured more chars */
8585 pc->tt = JIM_TT_EXPR_DOUBLE;
8586 pc->p = end;
8589 pc->tend = pc->p - 1;
8590 pc->len -= (pc->p - pc->tstart);
8591 return JIM_OK;
8594 static int JimParseExprIrrational(struct JimParserCtx *pc)
8596 const char *irrationals[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL };
8597 int i;
8599 for (i = 0; irrationals[i]; i++) {
8600 const char *irr = irrationals[i];
8602 if (strncmp(irr, pc->p, 3) == 0) {
8603 pc->p += 3;
8604 pc->len -= 3;
8605 pc->tend = pc->p - 1;
8606 pc->tt = JIM_TT_EXPR_DOUBLE;
8607 return JIM_OK;
8610 return JIM_ERR;
8613 static int JimParseExprBoolean(struct JimParserCtx *pc)
8615 const char *booleans[] = { "false", "no", "off", "true", "yes", "on", NULL };
8616 const int lengths[] = { 5, 2, 3, 4, 3, 2, 0 };
8617 int i;
8619 for (i = 0; booleans[i]; i++) {
8620 const char *boolean = booleans[i];
8621 int length = lengths[i];
8623 if (strncmp(boolean, pc->p, length) == 0) {
8624 pc->p += length;
8625 pc->len -= length;
8626 pc->tend = pc->p - 1;
8627 pc->tt = JIM_TT_EXPR_BOOLEAN;
8628 return JIM_OK;
8631 return JIM_ERR;
8634 static const struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
8636 static Jim_ExprOperator dummy_op;
8637 if (opcode < JIM_TT_EXPR_OP) {
8638 return &dummy_op;
8640 return &Jim_ExprOperators[opcode - JIM_TT_EXPR_OP];
8643 static int JimParseExprOperator(struct JimParserCtx *pc)
8645 int i;
8646 const struct Jim_ExprOperator *bestOp = NULL;
8647 int bestLen = 0;
8649 /* Try to get the longest match. */
8650 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
8651 const struct Jim_ExprOperator *op = &Jim_ExprOperators[i];
8653 if (op->name[0] != pc->p[0]) {
8654 continue;
8657 if (op->namelen > bestLen && strncmp(op->name, pc->p, op->namelen) == 0) {
8658 bestOp = op;
8659 bestLen = op->namelen;
8662 if (bestOp == NULL) {
8663 return JIM_ERR;
8666 /* Validate paretheses around function arguments */
8667 if (bestOp->attr & OP_FUNC) {
8668 const char *p = pc->p + bestLen;
8669 int len = pc->len - bestLen;
8671 while (len && isspace(UCHAR(*p))) {
8672 len--;
8673 p++;
8675 if (*p != '(') {
8676 return JIM_ERR;
8679 pc->tend = pc->p + bestLen - 1;
8680 pc->p += bestLen;
8681 pc->len -= bestLen;
8683 pc->tt = (bestOp - Jim_ExprOperators) + JIM_TT_EXPR_OP;
8684 return JIM_OK;
8687 const char *jim_tt_name(int type)
8689 static const char * const tt_names[JIM_TT_EXPR_OP] =
8690 { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "LIN", "WRD", "(((", ")))", ",,,", "INT",
8691 "DBL", "BOO", "$()" };
8692 if (type < JIM_TT_EXPR_OP) {
8693 return tt_names[type];
8695 else if (type == JIM_EXPROP_UNARYMINUS) {
8696 return "-VE";
8698 else if (type == JIM_EXPROP_UNARYPLUS) {
8699 return "+VE";
8701 else {
8702 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(type);
8703 static char buf[20];
8705 if (op->name) {
8706 return op->name;
8708 sprintf(buf, "(%d)", type);
8709 return buf;
8713 /* -----------------------------------------------------------------------------
8714 * Expression Object
8715 * ---------------------------------------------------------------------------*/
8716 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
8717 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
8718 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
8720 static const Jim_ObjType exprObjType = {
8721 "expression",
8722 FreeExprInternalRep,
8723 DupExprInternalRep,
8724 NULL,
8725 JIM_TYPE_REFERENCES,
8728 /* expr tree structure */
8729 struct ExprTree
8731 struct JimExprNode *expr; /* The first operator or term */
8732 struct JimExprNode *nodes; /* Storage of all nodes in the tree */
8733 int len; /* Number of nodes in use */
8734 int inUse; /* Used for sharing. */
8737 static void ExprTreeFreeNodes(Jim_Interp *interp, struct JimExprNode *nodes, int num)
8739 int i;
8740 for (i = 0; i < num; i++) {
8741 if (nodes[i].objPtr) {
8742 Jim_DecrRefCount(interp, nodes[i].objPtr);
8745 Jim_Free(nodes);
8748 static void ExprTreeFree(Jim_Interp *interp, struct ExprTree *expr)
8750 ExprTreeFreeNodes(interp, expr->nodes, expr->len);
8751 Jim_Free(expr);
8754 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
8756 struct ExprTree *expr = (void *)objPtr->internalRep.ptr;
8758 if (expr) {
8759 if (--expr->inUse != 0) {
8760 return;
8763 ExprTreeFree(interp, expr);
8767 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
8769 JIM_NOTUSED(interp);
8770 JIM_NOTUSED(srcPtr);
8772 /* Just returns an simple string. */
8773 dupPtr->typePtr = NULL;
8776 struct ExprBuilder {
8777 int parencount; /* count of outstanding parentheses */
8778 int level; /* recursion depth */
8779 ParseToken *token; /* The current token */
8780 ParseToken *first_token; /* The first token */
8781 Jim_Stack stack; /* stack of pending terms */
8782 Jim_Obj *exprObjPtr; /* the original expression */
8783 Jim_Obj *fileNameObj; /* filename of the original expression */
8784 struct JimExprNode *nodes; /* storage for all nodes */
8785 struct JimExprNode *next; /* storage for the next node */
8788 #ifdef DEBUG_SHOW_EXPR
8789 static void JimShowExprNode(struct JimExprNode *node, int level)
8791 int i;
8792 for (i = 0; i < level; i++) {
8793 printf(" ");
8795 if (TOKEN_IS_EXPR_OP(node->type)) {
8796 printf("%s\n", jim_tt_name(node->type));
8797 if (node->left) {
8798 JimShowExprNode(node->left, level + 1);
8800 if (node->right) {
8801 JimShowExprNode(node->right, level + 1);
8803 if (node->ternary) {
8804 JimShowExprNode(node->ternary, level + 1);
8807 else {
8808 printf("[%s] %s\n", jim_tt_name(node->type), Jim_String(node->objPtr));
8811 #endif
8813 #define EXPR_UNTIL_CLOSE 0x0001
8814 #define EXPR_FUNC_ARGS 0x0002
8815 #define EXPR_TERNARY 0x0004
8818 * Parse the subexpression at builder->token and return with the node on the stack.
8819 * builder->token is advanced to the next unconsumed token.
8820 * Returns JIM_OK if OK or JIM_ERR on error and leaves a message in the interpreter result.
8822 * 'precedence' is the precedence of the current operator. Tokens are consumed until an operator
8823 * with an equal or lower precedence is reached (or strictly lower if right associative).
8825 * If EXPR_UNTIL_CLOSE is set, the subexpression extends up to and including the next close parenthesis.
8826 * If EXPR_FUNC_ARGS is set, multiple subexpressions (terms) are expected separated by comma
8827 * If EXPR_TERNARY is set, two subexpressions (terms) are expected separated by colon
8829 * 'exp_numterms' indicates how many terms are expected. Normally this is 1, but may be more for EXPR_FUNC_ARGS and EXPR_TERNARY.
8831 static int ExprTreeBuildTree(Jim_Interp *interp, struct ExprBuilder *builder, int precedence, int flags, int exp_numterms)
8833 int rc;
8834 struct JimExprNode *node;
8835 /* Calculate the stack length expected after pushing the number of expected terms */
8836 int exp_stacklen = builder->stack.len + exp_numterms;
8838 if (builder->level++ > 200) {
8839 Jim_SetResultString(interp, "Expression too complex", -1);
8840 return JIM_ERR;
8843 while (builder->token->type != JIM_TT_EOL) {
8844 ParseToken *t = builder->token++;
8845 int prevtt;
8847 if (t == builder->first_token) {
8848 prevtt = JIM_TT_NONE;
8850 else {
8851 prevtt = t[-1].type;
8854 if (t->type == JIM_TT_SUBEXPR_START) {
8855 if (builder->stack.len == exp_stacklen) {
8856 Jim_SetResultFormatted(interp, "unexpected open parenthesis in expression: \"%#s\"", builder->exprObjPtr);
8857 return JIM_ERR;
8859 builder->parencount++;
8860 rc = ExprTreeBuildTree(interp, builder, 0, EXPR_UNTIL_CLOSE, 1);
8861 if (rc != JIM_OK) {
8862 return rc;
8864 /* A complete subexpression is on the stack */
8866 else if (t->type == JIM_TT_SUBEXPR_END) {
8867 if (!(flags & EXPR_UNTIL_CLOSE)) {
8868 if (builder->stack.len == exp_stacklen && builder->level > 1) {
8869 builder->token--;
8870 builder->level--;
8871 return JIM_OK;
8873 Jim_SetResultFormatted(interp, "unexpected closing parenthesis in expression: \"%#s\"", builder->exprObjPtr);
8874 return JIM_ERR;
8876 builder->parencount--;
8877 if (builder->stack.len == exp_stacklen) {
8878 /* Return with the expected number of subexpressions on the stack */
8879 break;
8882 else if (t->type == JIM_TT_SUBEXPR_COMMA) {
8883 if (!(flags & EXPR_FUNC_ARGS)) {
8884 if (builder->stack.len == exp_stacklen) {
8885 /* handle the comma back at the parent level */
8886 builder->token--;
8887 builder->level--;
8888 return JIM_OK;
8890 Jim_SetResultFormatted(interp, "unexpected comma in expression: \"%#s\"", builder->exprObjPtr);
8891 return JIM_ERR;
8893 else {
8894 /* If we see more terms than expected, it is an error */
8895 if (builder->stack.len > exp_stacklen) {
8896 Jim_SetResultFormatted(interp, "too many arguments to math function");
8897 return JIM_ERR;
8900 /* just go onto the next arg */
8902 else if (t->type == JIM_EXPROP_COLON) {
8903 if (!(flags & EXPR_TERNARY)) {
8904 if (builder->level != 1) {
8905 /* handle the comma back at the parent level */
8906 builder->token--;
8907 builder->level--;
8908 return JIM_OK;
8910 Jim_SetResultFormatted(interp, ": without ? in expression: \"%#s\"", builder->exprObjPtr);
8911 return JIM_ERR;
8913 if (builder->stack.len == exp_stacklen) {
8914 /* handle the comma back at the parent level */
8915 builder->token--;
8916 builder->level--;
8917 return JIM_OK;
8919 /* just go onto the next term */
8921 else if (TOKEN_IS_EXPR_OP(t->type)) {
8922 const struct Jim_ExprOperator *op;
8924 /* Convert -/+ to unary minus or unary plus if necessary */
8925 if (TOKEN_IS_EXPR_OP(prevtt) || TOKEN_IS_EXPR_START(prevtt)) {
8926 if (t->type == JIM_EXPROP_SUB) {
8927 t->type = JIM_EXPROP_UNARYMINUS;
8929 else if (t->type == JIM_EXPROP_ADD) {
8930 t->type = JIM_EXPROP_UNARYPLUS;
8934 op = JimExprOperatorInfoByOpcode(t->type);
8936 if (op->precedence < precedence || (!(op->attr & OP_RIGHT_ASSOC) && op->precedence == precedence)) {
8937 /* next op is lower precedence, or equal and left associative, so done here */
8938 builder->token--;
8939 break;
8942 if (op->attr & OP_FUNC) {
8943 if (builder->token->type != JIM_TT_SUBEXPR_START) {
8944 Jim_SetResultString(interp, "missing arguments for math function", -1);
8945 return JIM_ERR;
8947 builder->token++;
8948 if (op->arity == 0) {
8949 if (builder->token->type != JIM_TT_SUBEXPR_END) {
8950 Jim_SetResultString(interp, "too many arguments for math function", -1);
8951 return JIM_ERR;
8953 builder->token++;
8954 goto noargs;
8956 builder->parencount++;
8958 /* This will push left and return right */
8959 rc = ExprTreeBuildTree(interp, builder, 0, EXPR_FUNC_ARGS | EXPR_UNTIL_CLOSE, op->arity);
8961 else if (t->type == JIM_EXPROP_TERNARY) {
8962 /* Collect the two arguments to the ternary operator */
8963 rc = ExprTreeBuildTree(interp, builder, op->precedence, EXPR_TERNARY, 2);
8965 else {
8966 /* Recursively handle everything on the right until we see a precendence <= op->precedence or == and right associative
8967 * and push that on the term stack
8969 rc = ExprTreeBuildTree(interp, builder, op->precedence, 0, 1);
8972 if (rc != JIM_OK) {
8973 return rc;
8976 noargs:
8977 node = builder->next++;
8978 node->type = t->type;
8980 if (op->arity >= 3) {
8981 node->ternary = Jim_StackPop(&builder->stack);
8982 if (node->ternary == NULL) {
8983 goto missingoperand;
8986 if (op->arity >= 2) {
8987 node->right = Jim_StackPop(&builder->stack);
8988 if (node->right == NULL) {
8989 goto missingoperand;
8992 if (op->arity >= 1) {
8993 node->left = Jim_StackPop(&builder->stack);
8994 if (node->left == NULL) {
8995 missingoperand:
8996 Jim_SetResultFormatted(interp, "missing operand to %s in expression: \"%#s\"", op->name, builder->exprObjPtr);
8997 builder->next--;
8998 return JIM_ERR;
9003 /* Now push the node */
9004 Jim_StackPush(&builder->stack, node);
9006 else {
9007 Jim_Obj *objPtr = NULL;
9009 /* This is a simple non-operator term, so create and push the appropriate object */
9011 /* Two consecutive terms without an operator is invalid */
9012 if (!TOKEN_IS_EXPR_START(prevtt) && !TOKEN_IS_EXPR_OP(prevtt)) {
9013 Jim_SetResultFormatted(interp, "missing operator in expression: \"%#s\"", builder->exprObjPtr);
9014 return JIM_ERR;
9017 /* Immediately create a double or int object? */
9018 if (t->type == JIM_TT_EXPR_INT || t->type == JIM_TT_EXPR_DOUBLE) {
9019 char *endptr;
9020 if (t->type == JIM_TT_EXPR_INT) {
9021 objPtr = Jim_NewIntObj(interp, jim_strtoull(t->token, &endptr));
9023 else {
9024 objPtr = Jim_NewDoubleObj(interp, strtod(t->token, &endptr));
9026 if (endptr != t->token + t->len) {
9027 /* Conversion failed, so just store it as a string */
9028 Jim_FreeNewObj(interp, objPtr);
9029 objPtr = NULL;
9033 if (!objPtr) {
9034 /* Everything else is stored a simple string term */
9035 objPtr = Jim_NewStringObj(interp, t->token, t->len);
9036 if (t->type == JIM_TT_CMD) {
9037 /* Only commands need source info */
9038 JimSetSourceInfo(interp, objPtr, builder->fileNameObj, t->line);
9042 /* Now push a term node */
9043 node = builder->next++;
9044 node->objPtr = objPtr;
9045 Jim_IncrRefCount(node->objPtr);
9046 node->type = t->type;
9047 Jim_StackPush(&builder->stack, node);
9051 if (builder->stack.len == exp_stacklen) {
9052 builder->level--;
9053 return JIM_OK;
9056 if ((flags & EXPR_FUNC_ARGS)) {
9057 Jim_SetResultFormatted(interp, "too %s arguments for math function", (builder->stack.len < exp_stacklen) ? "few" : "many");
9059 else {
9060 if (builder->stack.len < exp_stacklen) {
9061 if (builder->level == 0) {
9062 Jim_SetResultFormatted(interp, "empty expression");
9064 else {
9065 Jim_SetResultFormatted(interp, "syntax error in expression \"%#s\": premature end of expression", builder->exprObjPtr);
9068 else {
9069 Jim_SetResultFormatted(interp, "extra terms after expression");
9073 return JIM_ERR;
9076 static struct ExprTree *ExprTreeCreateTree(Jim_Interp *interp, const ParseTokenList *tokenlist, Jim_Obj *exprObjPtr, Jim_Obj *fileNameObj)
9078 struct ExprTree *expr;
9079 struct ExprBuilder builder;
9080 int rc;
9081 struct JimExprNode *top = NULL;
9083 builder.parencount = 0;
9084 builder.level = 0;
9085 builder.token = builder.first_token = tokenlist->list;
9086 builder.exprObjPtr = exprObjPtr;
9087 builder.fileNameObj = fileNameObj;
9088 /* The bytecode will never produce more nodes than there are tokens - 1 (for EOL)*/
9089 builder.nodes = Jim_Alloc(sizeof(struct JimExprNode) * (tokenlist->count - 1));
9090 memset(builder.nodes, 0, sizeof(struct JimExprNode) * (tokenlist->count - 1));
9091 builder.next = builder.nodes;
9092 Jim_InitStack(&builder.stack);
9094 rc = ExprTreeBuildTree(interp, &builder, 0, 0, 1);
9096 if (rc == JIM_OK) {
9097 top = Jim_StackPop(&builder.stack);
9099 if (builder.parencount) {
9100 Jim_SetResultString(interp, "missing close parenthesis", -1);
9101 rc = JIM_ERR;
9105 /* Free the stack used for the compilation. */
9106 Jim_FreeStack(&builder.stack);
9108 if (rc != JIM_OK) {
9109 ExprTreeFreeNodes(interp, builder.nodes, builder.next - builder.nodes);
9110 return NULL;
9113 expr = Jim_Alloc(sizeof(*expr));
9114 expr->inUse = 1;
9115 expr->expr = top;
9116 expr->nodes = builder.nodes;
9117 expr->len = builder.next - builder.nodes;
9119 assert(expr->len <= tokenlist->count - 1);
9121 return expr;
9124 /* This method takes the string representation of an expression
9125 * and generates a program for the expr engine */
9126 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
9128 int exprTextLen;
9129 const char *exprText;
9130 struct JimParserCtx parser;
9131 struct ExprTree *expr;
9132 ParseTokenList tokenlist;
9133 int line;
9134 Jim_Obj *fileNameObj;
9135 int rc = JIM_ERR;
9137 /* Try to get information about filename / line number */
9138 if (objPtr->typePtr == &sourceObjType) {
9139 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
9140 line = objPtr->internalRep.sourceValue.lineNumber;
9142 else {
9143 fileNameObj = interp->emptyObj;
9144 line = 1;
9146 Jim_IncrRefCount(fileNameObj);
9148 exprText = Jim_GetString(objPtr, &exprTextLen);
9150 /* Initially tokenise the expression into tokenlist */
9151 ScriptTokenListInit(&tokenlist);
9153 JimParserInit(&parser, exprText, exprTextLen, line);
9154 while (!parser.eof) {
9155 if (JimParseExpression(&parser) != JIM_OK) {
9156 ScriptTokenListFree(&tokenlist);
9157 Jim_SetResultFormatted(interp, "syntax error in expression: \"%#s\"", objPtr);
9158 expr = NULL;
9159 goto err;
9162 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
9163 parser.tline);
9166 #ifdef DEBUG_SHOW_EXPR_TOKENS
9168 int i;
9169 printf("==== Expr Tokens (%s) ====\n", Jim_String(fileNameObj));
9170 for (i = 0; i < tokenlist.count; i++) {
9171 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist.list[i].line, jim_tt_name(tokenlist.list[i].type),
9172 tokenlist.list[i].len, tokenlist.list[i].token);
9175 #endif
9177 if (JimParseCheckMissing(interp, parser.missing.ch) == JIM_ERR) {
9178 ScriptTokenListFree(&tokenlist);
9179 Jim_DecrRefCount(interp, fileNameObj);
9180 return JIM_ERR;
9183 /* Now create the expression bytecode from the tokenlist */
9184 expr = ExprTreeCreateTree(interp, &tokenlist, objPtr, fileNameObj);
9186 /* No longer need the token list */
9187 ScriptTokenListFree(&tokenlist);
9189 if (!expr) {
9190 goto err;
9193 #ifdef DEBUG_SHOW_EXPR
9194 printf("==== Expr ====\n");
9195 JimShowExprNode(expr->expr, 0);
9196 #endif
9198 rc = JIM_OK;
9200 err:
9201 /* Free the old internal rep and set the new one. */
9202 Jim_DecrRefCount(interp, fileNameObj);
9203 Jim_FreeIntRep(interp, objPtr);
9204 Jim_SetIntRepPtr(objPtr, expr);
9205 objPtr->typePtr = &exprObjType;
9206 return rc;
9209 static struct ExprTree *JimGetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
9211 if (objPtr->typePtr != &exprObjType) {
9212 if (SetExprFromAny(interp, objPtr) != JIM_OK) {
9213 return NULL;
9216 return (struct ExprTree *) Jim_GetIntRepPtr(objPtr);
9219 #ifdef JIM_OPTIMIZATION
9220 static Jim_Obj *JimExprIntValOrVar(Jim_Interp *interp, struct JimExprNode *node)
9222 if (node->type == JIM_TT_EXPR_INT)
9223 return node->objPtr;
9224 else if (node->type == JIM_TT_VAR)
9225 return Jim_GetVariable(interp, node->objPtr, JIM_NONE);
9226 else if (node->type == JIM_TT_DICTSUGAR)
9227 return JimExpandDictSugar(interp, node->objPtr);
9228 else
9229 return NULL;
9231 #endif
9233 /* -----------------------------------------------------------------------------
9234 * Expressions evaluation.
9235 * Jim uses a recursive evaluation engine for expressions,
9236 * that takes advantage of the fact that expr's operators
9237 * can't be redefined.
9239 * Jim_EvalExpression() uses the expression tree compiled by
9240 * SetExprFromAny() method of the "expression" object.
9242 * On success a Tcl Object containing the result of the evaluation
9243 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
9244 * returned.
9245 * On error the function returns a retcode != to JIM_OK and set a suitable
9246 * error on the interp.
9247 * ---------------------------------------------------------------------------*/
9249 static int JimExprEvalTermNode(Jim_Interp *interp, struct JimExprNode *node)
9251 if (TOKEN_IS_EXPR_OP(node->type)) {
9252 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(node->type);
9253 return op->funcop(interp, node);
9255 else {
9256 Jim_Obj *objPtr;
9258 /* A term */
9259 switch (node->type) {
9260 case JIM_TT_EXPR_INT:
9261 case JIM_TT_EXPR_DOUBLE:
9262 case JIM_TT_EXPR_BOOLEAN:
9263 case JIM_TT_STR:
9264 Jim_SetResult(interp, node->objPtr);
9265 return JIM_OK;
9267 case JIM_TT_VAR:
9268 objPtr = Jim_GetVariable(interp, node->objPtr, JIM_ERRMSG);
9269 if (objPtr) {
9270 Jim_SetResult(interp, objPtr);
9271 return JIM_OK;
9273 return JIM_ERR;
9275 case JIM_TT_DICTSUGAR:
9276 objPtr = JimExpandDictSugar(interp, node->objPtr);
9277 if (objPtr) {
9278 Jim_SetResult(interp, objPtr);
9279 return JIM_OK;
9281 return JIM_ERR;
9283 case JIM_TT_ESC:
9284 if (Jim_SubstObj(interp, node->objPtr, &objPtr, JIM_NONE) == JIM_OK) {
9285 Jim_SetResult(interp, objPtr);
9286 return JIM_OK;
9288 return JIM_ERR;
9290 case JIM_TT_CMD:
9291 return Jim_EvalObj(interp, node->objPtr);
9293 default:
9294 /* Should never get here */
9295 return JIM_ERR;
9300 static int JimExprGetTerm(Jim_Interp *interp, struct JimExprNode *node, Jim_Obj **objPtrPtr)
9302 int rc = JimExprEvalTermNode(interp, node);
9303 if (rc == JIM_OK) {
9304 *objPtrPtr = Jim_GetResult(interp);
9305 Jim_IncrRefCount(*objPtrPtr);
9307 return rc;
9310 static int JimExprGetTermBoolean(Jim_Interp *interp, struct JimExprNode *node)
9312 if (JimExprEvalTermNode(interp, node) == JIM_OK) {
9313 return ExprBool(interp, Jim_GetResult(interp));
9315 return -1;
9318 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr)
9320 struct ExprTree *expr;
9321 int retcode = JIM_OK;
9323 Jim_IncrRefCount(exprObjPtr); /* Make sure it's shared. */
9324 expr = JimGetExpression(interp, exprObjPtr);
9325 if (!expr) {
9326 retcode = JIM_ERR;
9327 goto done;
9330 #ifdef JIM_OPTIMIZATION
9331 /* Check for one of the following common expressions used by while/for
9333 * CONST
9334 * $a
9335 * !$a
9336 * $a < CONST, $a < $b
9337 * $a <= CONST, $a <= $b
9338 * $a > CONST, $a > $b
9339 * $a >= CONST, $a >= $b
9340 * $a != CONST, $a != $b
9341 * $a == CONST, $a == $b
9344 Jim_Obj *objPtr;
9346 /* STEP 1 -- Check if there are the conditions to run the specialized
9347 * version of while */
9349 switch (expr->len) {
9350 case 1:
9351 objPtr = JimExprIntValOrVar(interp, expr->expr);
9352 if (objPtr) {
9353 Jim_SetResult(interp, objPtr);
9354 goto done;
9356 break;
9358 case 2:
9359 if (expr->expr->type == JIM_EXPROP_NOT) {
9360 objPtr = JimExprIntValOrVar(interp, expr->expr->left);
9362 if (objPtr && JimIsWide(objPtr)) {
9363 Jim_SetResult(interp, JimWideValue(objPtr) ? interp->falseObj : interp->trueObj);
9364 goto done;
9367 break;
9369 case 3:
9370 objPtr = JimExprIntValOrVar(interp, expr->expr->left);
9371 if (objPtr && JimIsWide(objPtr)) {
9372 Jim_Obj *objPtr2 = JimExprIntValOrVar(interp, expr->expr->right);
9373 if (objPtr2 && JimIsWide(objPtr2)) {
9374 jim_wide wideValueA = JimWideValue(objPtr);
9375 jim_wide wideValueB = JimWideValue(objPtr2);
9376 int cmpRes;
9377 switch (expr->expr->type) {
9378 case JIM_EXPROP_LT:
9379 cmpRes = wideValueA < wideValueB;
9380 break;
9381 case JIM_EXPROP_LTE:
9382 cmpRes = wideValueA <= wideValueB;
9383 break;
9384 case JIM_EXPROP_GT:
9385 cmpRes = wideValueA > wideValueB;
9386 break;
9387 case JIM_EXPROP_GTE:
9388 cmpRes = wideValueA >= wideValueB;
9389 break;
9390 case JIM_EXPROP_NUMEQ:
9391 cmpRes = wideValueA == wideValueB;
9392 break;
9393 case JIM_EXPROP_NUMNE:
9394 cmpRes = wideValueA != wideValueB;
9395 break;
9396 default:
9397 goto noopt;
9399 Jim_SetResult(interp, cmpRes ? interp->trueObj : interp->falseObj);
9400 goto done;
9403 break;
9406 noopt:
9407 #endif
9409 /* In order to avoid the internal repr being freed due to
9410 * shimmering of the exprObjPtr's object, we increment the use count
9411 * and keep our own pointer outside the object.
9413 expr->inUse++;
9415 /* Evaluate with the recursive expr engine */
9416 retcode = JimExprEvalTermNode(interp, expr->expr);
9418 /* Now transfer ownership of expr back into the object in case it shimmered away */
9419 Jim_FreeIntRep(interp, exprObjPtr);
9420 exprObjPtr->typePtr = &exprObjType;
9421 Jim_SetIntRepPtr(exprObjPtr, expr);
9423 done:
9424 Jim_DecrRefCount(interp, exprObjPtr);
9426 return retcode;
9429 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
9431 int retcode = Jim_EvalExpression(interp, exprObjPtr);
9433 if (retcode == JIM_OK) {
9434 switch (ExprBool(interp, Jim_GetResult(interp))) {
9435 case 0:
9436 *boolPtr = 0;
9437 break;
9439 case 1:
9440 *boolPtr = 1;
9441 break;
9443 case -1:
9444 retcode = JIM_ERR;
9445 break;
9448 return retcode;
9451 /* -----------------------------------------------------------------------------
9452 * ScanFormat String Object
9453 * ---------------------------------------------------------------------------*/
9455 /* This Jim_Obj will held a parsed representation of a format string passed to
9456 * the Jim_ScanString command. For error diagnostics, the scanformat string has
9457 * to be parsed in its entirely first and then, if correct, can be used for
9458 * scanning. To avoid endless re-parsing, the parsed representation will be
9459 * stored in an internal representation and re-used for performance reason. */
9461 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
9462 * scanformat string. This part will later be used to extract information
9463 * out from the string to be parsed by Jim_ScanString */
9465 typedef struct ScanFmtPartDescr
9467 const char *arg; /* Specification of a CHARSET conversion */
9468 const char *prefix; /* Prefix to be scanned literally before conversion */
9469 size_t width; /* Maximal width of input to be converted */
9470 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
9471 char type; /* Type of conversion (e.g. c, d, f) */
9472 char modifier; /* Modify type (e.g. l - long, h - short */
9473 } ScanFmtPartDescr;
9475 /* The ScanFmtStringObj will hold the internal representation of a scanformat
9476 * string parsed and separated in part descriptions. Furthermore it contains
9477 * the original string representation of the scanformat string to allow for
9478 * fast update of the Jim_Obj's string representation part.
9480 * As an add-on the internal object representation adds some scratch pad area
9481 * for usage by Jim_ScanString to avoid endless allocating and freeing of
9482 * memory for purpose of string scanning.
9484 * The error member points to a static allocated string in case of a mal-
9485 * formed scanformat string or it contains '0' (NULL) in case of a valid
9486 * parse representation.
9488 * The whole memory of the internal representation is allocated as a single
9489 * area of memory that will be internally separated. So freeing and duplicating
9490 * of such an object is cheap */
9492 typedef struct ScanFmtStringObj
9494 jim_wide size; /* Size of internal repr in bytes */
9495 char *stringRep; /* Original string representation */
9496 size_t count; /* Number of ScanFmtPartDescr contained */
9497 size_t convCount; /* Number of conversions that will assign */
9498 size_t maxPos; /* Max position index if XPG3 is used */
9499 const char *error; /* Ptr to error text (NULL if no error */
9500 char *scratch; /* Some scratch pad used by Jim_ScanString */
9501 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
9502 } ScanFmtStringObj;
9505 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
9506 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
9507 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
9509 static const Jim_ObjType scanFmtStringObjType = {
9510 "scanformatstring",
9511 FreeScanFmtInternalRep,
9512 DupScanFmtInternalRep,
9513 UpdateStringOfScanFmt,
9514 JIM_TYPE_NONE,
9517 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
9519 JIM_NOTUSED(interp);
9520 Jim_Free((char *)objPtr->internalRep.ptr);
9521 objPtr->internalRep.ptr = 0;
9524 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
9526 size_t size = (size_t) ((ScanFmtStringObj *) srcPtr->internalRep.ptr)->size;
9527 ScanFmtStringObj *newVec = (ScanFmtStringObj *) Jim_Alloc(size);
9529 JIM_NOTUSED(interp);
9530 memcpy(newVec, srcPtr->internalRep.ptr, size);
9531 dupPtr->internalRep.ptr = newVec;
9532 dupPtr->typePtr = &scanFmtStringObjType;
9535 static void UpdateStringOfScanFmt(Jim_Obj *objPtr)
9537 JimSetStringBytes(objPtr, ((ScanFmtStringObj *) objPtr->internalRep.ptr)->stringRep);
9540 /* SetScanFmtFromAny will parse a given string and create the internal
9541 * representation of the format specification. In case of an error
9542 * the error data member of the internal representation will be set
9543 * to an descriptive error text and the function will be left with
9544 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
9545 * specification */
9547 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
9549 ScanFmtStringObj *fmtObj;
9550 char *buffer;
9551 int maxCount, i, approxSize, lastPos = -1;
9552 const char *fmt = Jim_String(objPtr);
9553 int maxFmtLen = Jim_Length(objPtr);
9554 const char *fmtEnd = fmt + maxFmtLen;
9555 int curr;
9557 Jim_FreeIntRep(interp, objPtr);
9558 /* Count how many conversions could take place maximally */
9559 for (i = 0, maxCount = 0; i < maxFmtLen; ++i)
9560 if (fmt[i] == '%')
9561 ++maxCount;
9562 /* Calculate an approximation of the memory necessary */
9563 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
9564 +(maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
9565 +maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
9566 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
9567 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
9568 +(maxCount + 1) * sizeof(char) /* '\0' for every partial */
9569 +1; /* safety byte */
9570 fmtObj = (ScanFmtStringObj *) Jim_Alloc(approxSize);
9571 memset(fmtObj, 0, approxSize);
9572 fmtObj->size = approxSize;
9573 fmtObj->maxPos = 0;
9574 fmtObj->scratch = (char *)&fmtObj->descr[maxCount + 1];
9575 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
9576 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
9577 buffer = fmtObj->stringRep + maxFmtLen + 1;
9578 objPtr->internalRep.ptr = fmtObj;
9579 objPtr->typePtr = &scanFmtStringObjType;
9580 for (i = 0, curr = 0; fmt < fmtEnd; ++fmt) {
9581 int width = 0, skip;
9582 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
9584 fmtObj->count++;
9585 descr->width = 0; /* Assume width unspecified */
9586 /* Overread and store any "literal" prefix */
9587 if (*fmt != '%' || fmt[1] == '%') {
9588 descr->type = 0;
9589 descr->prefix = &buffer[i];
9590 for (; fmt < fmtEnd; ++fmt) {
9591 if (*fmt == '%') {
9592 if (fmt[1] != '%')
9593 break;
9594 ++fmt;
9596 buffer[i++] = *fmt;
9598 buffer[i++] = 0;
9600 /* Skip the conversion introducing '%' sign */
9601 ++fmt;
9602 /* End reached due to non-conversion literal only? */
9603 if (fmt >= fmtEnd)
9604 goto done;
9605 descr->pos = 0; /* Assume "natural" positioning */
9606 if (*fmt == '*') {
9607 descr->pos = -1; /* Okay, conversion will not be assigned */
9608 ++fmt;
9610 else
9611 fmtObj->convCount++; /* Otherwise count as assign-conversion */
9612 /* Check if next token is a number (could be width or pos */
9613 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9614 fmt += skip;
9615 /* Was the number a XPG3 position specifier? */
9616 if (descr->pos != -1 && *fmt == '$') {
9617 int prev;
9619 ++fmt;
9620 descr->pos = width;
9621 width = 0;
9622 /* Look if "natural" postioning and XPG3 one was mixed */
9623 if ((lastPos == 0 && descr->pos > 0)
9624 || (lastPos > 0 && descr->pos == 0)) {
9625 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
9626 return JIM_ERR;
9628 /* Look if this position was already used */
9629 for (prev = 0; prev < curr; ++prev) {
9630 if (fmtObj->descr[prev].pos == -1)
9631 continue;
9632 if (fmtObj->descr[prev].pos == descr->pos) {
9633 fmtObj->error =
9634 "variable is assigned by multiple \"%n$\" conversion specifiers";
9635 return JIM_ERR;
9638 if (descr->pos < 0) {
9639 fmtObj->error =
9640 "\"%n$\" conversion specifier is negative";
9641 return JIM_ERR;
9643 /* Try to find a width after the XPG3 specifier */
9644 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9645 descr->width = width;
9646 fmt += skip;
9648 if (descr->pos > 0 && (size_t) descr->pos > fmtObj->maxPos)
9649 fmtObj->maxPos = descr->pos;
9651 else {
9652 /* Number was not a XPG3, so it has to be a width */
9653 descr->width = width;
9656 /* If positioning mode was undetermined yet, fix this */
9657 if (lastPos == -1)
9658 lastPos = descr->pos;
9659 /* Handle CHARSET conversion type ... */
9660 if (*fmt == '[') {
9661 int swapped = 1, beg = i, end, j;
9663 descr->type = '[';
9664 descr->arg = &buffer[i];
9665 ++fmt;
9666 if (*fmt == '^')
9667 buffer[i++] = *fmt++;
9668 if (*fmt == ']')
9669 buffer[i++] = *fmt++;
9670 while (*fmt && *fmt != ']')
9671 buffer[i++] = *fmt++;
9672 if (*fmt != ']') {
9673 fmtObj->error = "unmatched [ in format string";
9674 return JIM_ERR;
9676 end = i;
9677 buffer[i++] = 0;
9678 /* In case a range fence was given "backwards", swap it */
9679 while (swapped) {
9680 swapped = 0;
9681 for (j = beg + 1; j < end - 1; ++j) {
9682 if (buffer[j] == '-' && buffer[j - 1] > buffer[j + 1]) {
9683 char tmp = buffer[j - 1];
9685 buffer[j - 1] = buffer[j + 1];
9686 buffer[j + 1] = tmp;
9687 swapped = 1;
9692 else {
9693 /* Remember any valid modifier if given */
9694 if (fmt < fmtEnd && strchr("hlL", *fmt))
9695 descr->modifier = tolower((int)*fmt++);
9697 if (fmt >= fmtEnd) {
9698 fmtObj->error = "missing scan conversion character";
9699 return JIM_ERR;
9702 descr->type = *fmt;
9703 if (strchr("efgcsndoxui", *fmt) == 0) {
9704 fmtObj->error = "bad scan conversion character";
9705 return JIM_ERR;
9707 else if (*fmt == 'c' && descr->width != 0) {
9708 fmtObj->error = "field width may not be specified in %c " "conversion";
9709 return JIM_ERR;
9711 else if (*fmt == 'u' && descr->modifier == 'l') {
9712 fmtObj->error = "unsigned wide not supported";
9713 return JIM_ERR;
9716 curr++;
9718 done:
9719 return JIM_OK;
9722 /* Some accessor macros to allow lowlevel access to fields of internal repr */
9724 #define FormatGetCnvCount(_fo_) \
9725 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
9726 #define FormatGetMaxPos(_fo_) \
9727 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
9728 #define FormatGetError(_fo_) \
9729 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
9731 /* JimScanAString is used to scan an unspecified string that ends with
9732 * next WS, or a string that is specified via a charset.
9735 static Jim_Obj *JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
9737 char *buffer = Jim_StrDup(str);
9738 char *p = buffer;
9740 while (*str) {
9741 int c;
9742 int n;
9744 if (!sdescr && isspace(UCHAR(*str)))
9745 break; /* EOS via WS if unspecified */
9747 n = utf8_tounicode(str, &c);
9748 if (sdescr && !JimCharsetMatch(sdescr, strlen(sdescr), c, JIM_CHARSET_SCAN))
9749 break;
9750 while (n--)
9751 *p++ = *str++;
9753 *p = 0;
9754 return Jim_NewStringObjNoAlloc(interp, buffer, p - buffer);
9757 /* ScanOneEntry will scan one entry out of the string passed as argument.
9758 * It use the sscanf() function for this task. After extracting and
9759 * converting of the value, the count of scanned characters will be
9760 * returned of -1 in case of no conversion tool place and string was
9761 * already scanned thru */
9763 static int ScanOneEntry(Jim_Interp *interp, const char *str, int pos, int str_bytelen,
9764 ScanFmtStringObj * fmtObj, long idx, Jim_Obj **valObjPtr)
9766 const char *tok;
9767 const ScanFmtPartDescr *descr = &fmtObj->descr[idx];
9768 size_t scanned = 0;
9769 size_t anchor = pos;
9770 int i;
9771 Jim_Obj *tmpObj = NULL;
9773 /* First pessimistically assume, we will not scan anything :-) */
9774 *valObjPtr = 0;
9775 if (descr->prefix) {
9776 /* There was a prefix given before the conversion, skip it and adjust
9777 * the string-to-be-parsed accordingly */
9778 for (i = 0; pos < str_bytelen && descr->prefix[i]; ++i) {
9779 /* If prefix require, skip WS */
9780 if (isspace(UCHAR(descr->prefix[i])))
9781 while (pos < str_bytelen && isspace(UCHAR(str[pos])))
9782 ++pos;
9783 else if (descr->prefix[i] != str[pos])
9784 break; /* Prefix do not match here, leave the loop */
9785 else
9786 ++pos; /* Prefix matched so far, next round */
9788 if (pos >= str_bytelen) {
9789 return -1; /* All of str consumed: EOF condition */
9791 else if (descr->prefix[i] != 0)
9792 return 0; /* Not whole prefix consumed, no conversion possible */
9794 /* For all but following conversion, skip leading WS */
9795 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
9796 while (isspace(UCHAR(str[pos])))
9797 ++pos;
9799 /* Determine how much skipped/scanned so far */
9800 scanned = pos - anchor;
9802 /* %c is a special, simple case. no width */
9803 if (descr->type == 'n') {
9804 /* Return pseudo conversion means: how much scanned so far? */
9805 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
9807 else if (pos >= str_bytelen) {
9808 /* Cannot scan anything, as str is totally consumed */
9809 return -1;
9811 else if (descr->type == 'c') {
9812 int c;
9813 scanned += utf8_tounicode(&str[pos], &c);
9814 *valObjPtr = Jim_NewIntObj(interp, c);
9815 return scanned;
9817 else {
9818 /* Processing of conversions follows ... */
9819 if (descr->width > 0) {
9820 /* Do not try to scan as fas as possible but only the given width.
9821 * To ensure this, we copy the part that should be scanned. */
9822 size_t sLen = utf8_strlen(&str[pos], str_bytelen - pos);
9823 size_t tLen = descr->width > sLen ? sLen : descr->width;
9825 tmpObj = Jim_NewStringObjUtf8(interp, str + pos, tLen);
9826 tok = tmpObj->bytes;
9828 else {
9829 /* As no width was given, simply refer to the original string */
9830 tok = &str[pos];
9832 switch (descr->type) {
9833 case 'd':
9834 case 'o':
9835 case 'x':
9836 case 'u':
9837 case 'i':{
9838 char *endp; /* Position where the number finished */
9839 jim_wide w;
9841 int base = descr->type == 'o' ? 8
9842 : descr->type == 'x' ? 16 : descr->type == 'i' ? 0 : 10;
9844 /* Try to scan a number with the given base */
9845 if (base == 0) {
9846 w = jim_strtoull(tok, &endp);
9848 else {
9849 w = strtoull(tok, &endp, base);
9852 if (endp != tok) {
9853 /* There was some number sucessfully scanned! */
9854 *valObjPtr = Jim_NewIntObj(interp, w);
9856 /* Adjust the number-of-chars scanned so far */
9857 scanned += endp - tok;
9859 else {
9860 /* Nothing was scanned. We have to determine if this
9861 * happened due to e.g. prefix mismatch or input str
9862 * exhausted */
9863 scanned = *tok ? 0 : -1;
9865 break;
9867 case 's':
9868 case '[':{
9869 *valObjPtr = JimScanAString(interp, descr->arg, tok);
9870 scanned += Jim_Length(*valObjPtr);
9871 break;
9873 case 'e':
9874 case 'f':
9875 case 'g':{
9876 char *endp;
9877 double value = strtod(tok, &endp);
9879 if (endp != tok) {
9880 /* There was some number sucessfully scanned! */
9881 *valObjPtr = Jim_NewDoubleObj(interp, value);
9882 /* Adjust the number-of-chars scanned so far */
9883 scanned += endp - tok;
9885 else {
9886 /* Nothing was scanned. We have to determine if this
9887 * happened due to e.g. prefix mismatch or input str
9888 * exhausted */
9889 scanned = *tok ? 0 : -1;
9891 break;
9894 /* If a substring was allocated (due to pre-defined width) do not
9895 * forget to free it */
9896 if (tmpObj) {
9897 Jim_FreeNewObj(interp, tmpObj);
9900 return scanned;
9903 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
9904 * string and returns all converted (and not ignored) values in a list back
9905 * to the caller. If an error occured, a NULL pointer will be returned */
9907 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *fmtObjPtr, int flags)
9909 size_t i, pos;
9910 int scanned = 1;
9911 const char *str = Jim_String(strObjPtr);
9912 int str_bytelen = Jim_Length(strObjPtr);
9913 Jim_Obj *resultList = 0;
9914 Jim_Obj **resultVec = 0;
9915 int resultc;
9916 Jim_Obj *emptyStr = 0;
9917 ScanFmtStringObj *fmtObj;
9919 /* This should never happen. The format object should already be of the correct type */
9920 JimPanic((fmtObjPtr->typePtr != &scanFmtStringObjType, "Jim_ScanString() for non-scan format"));
9922 fmtObj = (ScanFmtStringObj *) fmtObjPtr->internalRep.ptr;
9923 /* Check if format specification was valid */
9924 if (fmtObj->error != 0) {
9925 if (flags & JIM_ERRMSG)
9926 Jim_SetResultString(interp, fmtObj->error, -1);
9927 return 0;
9929 /* Allocate a new "shared" empty string for all unassigned conversions */
9930 emptyStr = Jim_NewEmptyStringObj(interp);
9931 Jim_IncrRefCount(emptyStr);
9932 /* Create a list and fill it with empty strings up to max specified XPG3 */
9933 resultList = Jim_NewListObj(interp, NULL, 0);
9934 if (fmtObj->maxPos > 0) {
9935 for (i = 0; i < fmtObj->maxPos; ++i)
9936 Jim_ListAppendElement(interp, resultList, emptyStr);
9937 JimListGetElements(interp, resultList, &resultc, &resultVec);
9939 /* Now handle every partial format description */
9940 for (i = 0, pos = 0; i < fmtObj->count; ++i) {
9941 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
9942 Jim_Obj *value = 0;
9944 /* Only last type may be "literal" w/o conversion - skip it! */
9945 if (descr->type == 0)
9946 continue;
9947 /* As long as any conversion could be done, we will proceed */
9948 if (scanned > 0)
9949 scanned = ScanOneEntry(interp, str, pos, str_bytelen, fmtObj, i, &value);
9950 /* In case our first try results in EOF, we will leave */
9951 if (scanned == -1 && i == 0)
9952 goto eof;
9953 /* Advance next pos-to-be-scanned for the amount scanned already */
9954 pos += scanned;
9956 /* value == 0 means no conversion took place so take empty string */
9957 if (value == 0)
9958 value = Jim_NewEmptyStringObj(interp);
9959 /* If value is a non-assignable one, skip it */
9960 if (descr->pos == -1) {
9961 Jim_FreeNewObj(interp, value);
9963 else if (descr->pos == 0)
9964 /* Otherwise append it to the result list if no XPG3 was given */
9965 Jim_ListAppendElement(interp, resultList, value);
9966 else if (resultVec[descr->pos - 1] == emptyStr) {
9967 /* But due to given XPG3, put the value into the corr. slot */
9968 Jim_DecrRefCount(interp, resultVec[descr->pos - 1]);
9969 Jim_IncrRefCount(value);
9970 resultVec[descr->pos - 1] = value;
9972 else {
9973 /* Otherwise, the slot was already used - free obj and ERROR */
9974 Jim_FreeNewObj(interp, value);
9975 goto err;
9978 Jim_DecrRefCount(interp, emptyStr);
9979 return resultList;
9980 eof:
9981 Jim_DecrRefCount(interp, emptyStr);
9982 Jim_FreeNewObj(interp, resultList);
9983 return (Jim_Obj *)EOF;
9984 err:
9985 Jim_DecrRefCount(interp, emptyStr);
9986 Jim_FreeNewObj(interp, resultList);
9987 return 0;
9990 /* -----------------------------------------------------------------------------
9991 * Pseudo Random Number Generation
9992 * ---------------------------------------------------------------------------*/
9993 /* Initialize the sbox with the numbers from 0 to 255 */
9994 static void JimPrngInit(Jim_Interp *interp)
9996 #define PRNG_SEED_SIZE 256
9997 int i;
9998 unsigned int *seed;
9999 time_t t = time(NULL);
10001 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
10003 seed = Jim_Alloc(PRNG_SEED_SIZE * sizeof(*seed));
10004 for (i = 0; i < PRNG_SEED_SIZE; i++) {
10005 seed[i] = (rand() ^ t ^ clock());
10007 JimPrngSeed(interp, (unsigned char *)seed, PRNG_SEED_SIZE * sizeof(*seed));
10008 Jim_Free(seed);
10011 /* Generates N bytes of random data */
10012 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
10014 Jim_PrngState *prng;
10015 unsigned char *destByte = (unsigned char *)dest;
10016 unsigned int si, sj, x;
10018 /* initialization, only needed the first time */
10019 if (interp->prngState == NULL)
10020 JimPrngInit(interp);
10021 prng = interp->prngState;
10022 /* generates 'len' bytes of pseudo-random numbers */
10023 for (x = 0; x < len; x++) {
10024 prng->i = (prng->i + 1) & 0xff;
10025 si = prng->sbox[prng->i];
10026 prng->j = (prng->j + si) & 0xff;
10027 sj = prng->sbox[prng->j];
10028 prng->sbox[prng->i] = sj;
10029 prng->sbox[prng->j] = si;
10030 *destByte++ = prng->sbox[(si + sj) & 0xff];
10034 /* Re-seed the generator with user-provided bytes */
10035 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen)
10037 int i;
10038 Jim_PrngState *prng;
10040 /* initialization, only needed the first time */
10041 if (interp->prngState == NULL)
10042 JimPrngInit(interp);
10043 prng = interp->prngState;
10045 /* Set the sbox[i] with i */
10046 for (i = 0; i < 256; i++)
10047 prng->sbox[i] = i;
10048 /* Now use the seed to perform a random permutation of the sbox */
10049 for (i = 0; i < seedLen; i++) {
10050 unsigned char t;
10052 t = prng->sbox[i & 0xFF];
10053 prng->sbox[i & 0xFF] = prng->sbox[seed[i]];
10054 prng->sbox[seed[i]] = t;
10056 prng->i = prng->j = 0;
10058 /* discard at least the first 256 bytes of stream.
10059 * borrow the seed buffer for this
10061 for (i = 0; i < 256; i += seedLen) {
10062 JimRandomBytes(interp, seed, seedLen);
10066 /* [incr] */
10067 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10069 jim_wide wideValue, increment = 1;
10070 Jim_Obj *intObjPtr;
10072 if (argc != 2 && argc != 3) {
10073 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
10074 return JIM_ERR;
10076 if (argc == 3) {
10077 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
10078 return JIM_ERR;
10080 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
10081 if (!intObjPtr) {
10082 /* Set missing variable to 0 */
10083 wideValue = 0;
10085 else if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK) {
10086 return JIM_ERR;
10088 if (!intObjPtr || Jim_IsShared(intObjPtr)) {
10089 intObjPtr = Jim_NewIntObj(interp, wideValue + increment);
10090 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
10091 Jim_FreeNewObj(interp, intObjPtr);
10092 return JIM_ERR;
10095 else {
10096 /* Can do it the quick way */
10097 Jim_InvalidateStringRep(intObjPtr);
10098 JimWideValue(intObjPtr) = wideValue + increment;
10100 /* The following step is required in order to invalidate the
10101 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
10102 if (argv[1]->typePtr != &variableObjType) {
10103 /* Note that this can't fail since GetVariable already succeeded */
10104 Jim_SetVariable(interp, argv[1], intObjPtr);
10107 Jim_SetResult(interp, intObjPtr);
10108 return JIM_OK;
10112 /* -----------------------------------------------------------------------------
10113 * Eval
10114 * ---------------------------------------------------------------------------*/
10115 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
10116 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
10118 /* Handle calls to the [unknown] command */
10119 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10121 int retcode;
10123 /* If JimUnknown() is recursively called too many times...
10124 * done here
10126 if (interp->unknown_called > 50) {
10127 return JIM_ERR;
10130 /* The object interp->unknown just contains
10131 * the "unknown" string, it is used in order to
10132 * avoid to lookup the unknown command every time
10133 * but instead to cache the result. */
10135 /* If the [unknown] command does not exist ... */
10136 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
10137 return JIM_ERR;
10139 interp->unknown_called++;
10140 /* XXX: Are we losing fileNameObj and linenr? */
10141 retcode = Jim_EvalObjPrefix(interp, interp->unknown, argc, argv);
10142 interp->unknown_called--;
10144 return retcode;
10147 static int JimInvokeCommand(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10149 int retcode;
10150 Jim_Cmd *cmdPtr;
10151 void *prevPrivData;
10152 Jim_Obj *tailcallObj = NULL;
10154 #if 0
10155 printf("invoke");
10156 int j;
10157 for (j = 0; j < objc; j++) {
10158 printf(" '%s'", Jim_String(objv[j]));
10160 printf("\n");
10161 #endif
10163 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
10164 if (cmdPtr == NULL) {
10165 return JimUnknown(interp, objc, objv);
10167 JimIncrCmdRefCount(cmdPtr);
10169 if (interp->evalDepth == interp->maxEvalDepth) {
10170 Jim_SetResultString(interp, "Infinite eval recursion", -1);
10171 retcode = JIM_ERR;
10172 goto out;
10174 interp->evalDepth++;
10175 prevPrivData = interp->cmdPrivData;
10177 tailcall:
10179 /* Call it -- Make sure result is an empty object. */
10180 Jim_SetEmptyResult(interp);
10181 if (cmdPtr->isproc) {
10182 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
10184 else {
10185 interp->cmdPrivData = cmdPtr->u.native.privData;
10186 retcode = cmdPtr->u.native.cmdProc(interp, objc, objv);
10189 if (tailcallObj) {
10190 /* clean up previous tailcall if we were invoking one */
10191 Jim_DecrRefCount(interp, tailcallObj);
10192 tailcallObj = NULL;
10195 /* If a tailcall is returned for this frame, loop to invoke the new command */
10196 if (retcode == JIM_EVAL && interp->framePtr->tailcallObj) {
10197 JimDecrCmdRefCount(interp, cmdPtr);
10199 /* Replace the current command with the new tailcall command */
10200 cmdPtr = interp->framePtr->tailcallCmd;
10201 interp->framePtr->tailcallCmd = NULL;
10202 tailcallObj = interp->framePtr->tailcallObj;
10203 interp->framePtr->tailcallObj = NULL;
10204 /* We can access the internal rep here because the object can only
10205 * be constructed by the tailcall command
10207 objc = tailcallObj->internalRep.listValue.len;
10208 objv = tailcallObj->internalRep.listValue.ele;
10209 goto tailcall;
10212 interp->cmdPrivData = prevPrivData;
10213 interp->evalDepth--;
10215 out:
10216 JimDecrCmdRefCount(interp, cmdPtr);
10218 if (interp->framePtr->tailcallObj) {
10219 /* We might have skipped invoking a tailcall, perhaps because of an error
10220 * in defer handling so cleanup now
10222 JimDecrCmdRefCount(interp, interp->framePtr->tailcallCmd);
10223 Jim_DecrRefCount(interp, interp->framePtr->tailcallObj);
10224 interp->framePtr->tailcallCmd = NULL;
10225 interp->framePtr->tailcallObj = NULL;
10228 return retcode;
10231 /* Eval the object vector 'objv' composed of 'objc' elements.
10232 * Every element is used as single argument.
10233 * Jim_EvalObj() will call this function every time its object
10234 * argument is of "list" type, with no string representation.
10236 * This is possible because the string representation of a
10237 * list object generated by the UpdateStringOfList is made
10238 * in a way that ensures that every list element is a different
10239 * command argument. */
10240 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10242 int i, retcode;
10244 /* Incr refcount of arguments. */
10245 for (i = 0; i < objc; i++)
10246 Jim_IncrRefCount(objv[i]);
10248 retcode = JimInvokeCommand(interp, objc, objv);
10250 /* Decr refcount of arguments and return the retcode */
10251 for (i = 0; i < objc; i++)
10252 Jim_DecrRefCount(interp, objv[i]);
10254 return retcode;
10258 * Invokes 'prefix' as a command with the objv array as arguments.
10260 int Jim_EvalObjPrefix(Jim_Interp *interp, Jim_Obj *prefix, int objc, Jim_Obj *const *objv)
10262 int ret;
10263 Jim_Obj **nargv = Jim_Alloc((objc + 1) * sizeof(*nargv));
10265 nargv[0] = prefix;
10266 memcpy(&nargv[1], &objv[0], sizeof(nargv[0]) * objc);
10267 ret = Jim_EvalObjVector(interp, objc + 1, nargv);
10268 Jim_Free(nargv);
10269 return ret;
10272 static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script)
10274 if (!interp->errorFlag) {
10275 /* This is the first error, so save the file/line information and reset the stack */
10276 interp->errorFlag = 1;
10277 Jim_IncrRefCount(script->fileNameObj);
10278 Jim_DecrRefCount(interp, interp->errorFileNameObj);
10279 interp->errorFileNameObj = script->fileNameObj;
10280 interp->errorLine = script->linenr;
10282 JimResetStackTrace(interp);
10283 /* Always add a level where the error first occurs */
10284 interp->addStackTrace++;
10287 /* Now if this is an "interesting" level, add it to the stack trace */
10288 if (interp->addStackTrace > 0) {
10289 /* Add the stack info for the current level */
10291 JimAppendStackTrace(interp, Jim_String(interp->errorProc), script->fileNameObj, script->linenr);
10293 /* Note: if we didn't have a filename for this level,
10294 * don't clear the addStackTrace flag
10295 * so we can pick it up at the next level
10297 if (Jim_Length(script->fileNameObj)) {
10298 interp->addStackTrace = 0;
10301 Jim_DecrRefCount(interp, interp->errorProc);
10302 interp->errorProc = interp->emptyObj;
10303 Jim_IncrRefCount(interp->errorProc);
10307 static int JimSubstOneToken(Jim_Interp *interp, const ScriptToken *token, Jim_Obj **objPtrPtr)
10309 Jim_Obj *objPtr;
10310 int ret = JIM_ERR;
10312 switch (token->type) {
10313 case JIM_TT_STR:
10314 case JIM_TT_ESC:
10315 objPtr = token->objPtr;
10316 break;
10317 case JIM_TT_VAR:
10318 objPtr = Jim_GetVariable(interp, token->objPtr, JIM_ERRMSG);
10319 break;
10320 case JIM_TT_DICTSUGAR:
10321 objPtr = JimExpandDictSugar(interp, token->objPtr);
10322 break;
10323 case JIM_TT_EXPRSUGAR:
10324 ret = Jim_EvalExpression(interp, token->objPtr);
10325 if (ret == JIM_OK) {
10326 objPtr = Jim_GetResult(interp);
10328 else {
10329 objPtr = NULL;
10331 break;
10332 case JIM_TT_CMD:
10333 ret = Jim_EvalObj(interp, token->objPtr);
10334 if (ret == JIM_OK || ret == JIM_RETURN) {
10335 objPtr = interp->result;
10336 } else {
10337 /* includes JIM_BREAK, JIM_CONTINUE */
10338 objPtr = NULL;
10340 break;
10341 default:
10342 JimPanic((1,
10343 "default token type (%d) reached " "in Jim_SubstObj().", token->type));
10344 objPtr = NULL;
10345 break;
10347 if (objPtr) {
10348 *objPtrPtr = objPtr;
10349 return JIM_OK;
10351 return ret;
10354 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
10355 * via *objPtrPtr. This function is only called by Jim_EvalObj() and Jim_SubstObj()
10356 * The returned object has refcount = 0.
10358 static Jim_Obj *JimInterpolateTokens(Jim_Interp *interp, const ScriptToken * token, int tokens, int flags)
10360 int totlen = 0, i;
10361 Jim_Obj **intv;
10362 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
10363 Jim_Obj *objPtr;
10364 char *s;
10366 if (tokens <= JIM_EVAL_SINTV_LEN)
10367 intv = sintv;
10368 else
10369 intv = Jim_Alloc(sizeof(Jim_Obj *) * tokens);
10371 /* Compute every token forming the argument
10372 * in the intv objects vector. */
10373 for (i = 0; i < tokens; i++) {
10374 switch (JimSubstOneToken(interp, &token[i], &intv[i])) {
10375 case JIM_OK:
10376 case JIM_RETURN:
10377 break;
10378 case JIM_BREAK:
10379 if (flags & JIM_SUBST_FLAG) {
10380 /* Stop here */
10381 tokens = i;
10382 continue;
10384 /* XXX: Should probably set an error about break outside loop */
10385 /* fall through to error */
10386 case JIM_CONTINUE:
10387 if (flags & JIM_SUBST_FLAG) {
10388 intv[i] = NULL;
10389 continue;
10391 /* XXX: Ditto continue outside loop */
10392 /* fall through to error */
10393 default:
10394 while (i--) {
10395 Jim_DecrRefCount(interp, intv[i]);
10397 if (intv != sintv) {
10398 Jim_Free(intv);
10400 return NULL;
10402 Jim_IncrRefCount(intv[i]);
10403 Jim_String(intv[i]);
10404 totlen += intv[i]->length;
10407 /* Fast path return for a single token */
10408 if (tokens == 1 && intv[0] && intv == sintv) {
10409 /* Reverse the Jim_IncrRefCount() above, but don't free the object */
10410 intv[0]->refCount--;
10411 return intv[0];
10414 /* Concatenate every token in an unique
10415 * object. */
10416 objPtr = Jim_NewStringObjNoAlloc(interp, NULL, 0);
10418 if (tokens == 4 && token[0].type == JIM_TT_ESC && token[1].type == JIM_TT_ESC
10419 && token[2].type == JIM_TT_VAR) {
10420 /* May be able to do fast interpolated object -> dictSubst */
10421 objPtr->typePtr = &interpolatedObjType;
10422 objPtr->internalRep.dictSubstValue.varNameObjPtr = token[0].objPtr;
10423 objPtr->internalRep.dictSubstValue.indexObjPtr = intv[2];
10424 Jim_IncrRefCount(intv[2]);
10426 else if (tokens && intv[0] && intv[0]->typePtr == &sourceObjType) {
10427 /* The first interpolated token is source, so preserve the source info */
10428 JimSetSourceInfo(interp, objPtr, intv[0]->internalRep.sourceValue.fileNameObj, intv[0]->internalRep.sourceValue.lineNumber);
10432 s = objPtr->bytes = Jim_Alloc(totlen + 1);
10433 objPtr->length = totlen;
10434 for (i = 0; i < tokens; i++) {
10435 if (intv[i]) {
10436 memcpy(s, intv[i]->bytes, intv[i]->length);
10437 s += intv[i]->length;
10438 Jim_DecrRefCount(interp, intv[i]);
10441 objPtr->bytes[totlen] = '\0';
10442 /* Free the intv vector if not static. */
10443 if (intv != sintv) {
10444 Jim_Free(intv);
10447 return objPtr;
10451 /* listPtr *must* be a list.
10452 * The contents of the list is evaluated with the first element as the command and
10453 * the remaining elements as the arguments.
10455 static int JimEvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10457 int retcode = JIM_OK;
10459 JimPanic((Jim_IsList(listPtr) == 0, "JimEvalObjList() invoked on non-list."));
10461 if (listPtr->internalRep.listValue.len) {
10462 Jim_IncrRefCount(listPtr);
10463 retcode = JimInvokeCommand(interp,
10464 listPtr->internalRep.listValue.len,
10465 listPtr->internalRep.listValue.ele);
10466 Jim_DecrRefCount(interp, listPtr);
10468 return retcode;
10471 int Jim_EvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10473 SetListFromAny(interp, listPtr);
10474 return JimEvalObjList(interp, listPtr);
10477 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
10479 int i;
10480 ScriptObj *script;
10481 ScriptToken *token;
10482 int retcode = JIM_OK;
10483 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL;
10484 Jim_Obj *prevScriptObj;
10486 /* If the object is of type "list", with no string rep we can call
10487 * a specialized version of Jim_EvalObj() */
10488 if (Jim_IsList(scriptObjPtr) && scriptObjPtr->bytes == NULL) {
10489 return JimEvalObjList(interp, scriptObjPtr);
10492 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
10493 script = JimGetScript(interp, scriptObjPtr);
10494 if (!JimScriptValid(interp, script)) {
10495 Jim_DecrRefCount(interp, scriptObjPtr);
10496 return JIM_ERR;
10499 /* Reset the interpreter result. This is useful to
10500 * return the empty result in the case of empty program. */
10501 Jim_SetEmptyResult(interp);
10503 token = script->token;
10505 #ifdef JIM_OPTIMIZATION
10506 /* Check for one of the following common scripts used by for, while
10508 * {}
10509 * incr a
10511 if (script->len == 0) {
10512 Jim_DecrRefCount(interp, scriptObjPtr);
10513 return JIM_OK;
10515 if (script->len == 3
10516 && token[1].objPtr->typePtr == &commandObjType
10517 && token[1].objPtr->internalRep.cmdValue.cmdPtr->isproc == 0
10518 && token[1].objPtr->internalRep.cmdValue.cmdPtr->u.native.cmdProc == Jim_IncrCoreCommand
10519 && token[2].objPtr->typePtr == &variableObjType) {
10521 Jim_Obj *objPtr = Jim_GetVariable(interp, token[2].objPtr, JIM_NONE);
10523 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
10524 JimWideValue(objPtr)++;
10525 Jim_InvalidateStringRep(objPtr);
10526 Jim_DecrRefCount(interp, scriptObjPtr);
10527 Jim_SetResult(interp, objPtr);
10528 return JIM_OK;
10531 #endif
10533 /* Now we have to make sure the internal repr will not be
10534 * freed on shimmering.
10536 * Think for example to this:
10538 * set x {llength $x; ... some more code ...}; eval $x
10540 * In order to preserve the internal rep, we increment the
10541 * inUse field of the script internal rep structure. */
10542 script->inUse++;
10544 /* Stash the current script */
10545 prevScriptObj = interp->currentScriptObj;
10546 interp->currentScriptObj = scriptObjPtr;
10548 interp->errorFlag = 0;
10549 argv = sargv;
10551 /* Execute every command sequentially until the end of the script
10552 * or an error occurs.
10554 for (i = 0; i < script->len && retcode == JIM_OK; ) {
10555 int argc;
10556 int j;
10558 /* First token of the line is always JIM_TT_LINE */
10559 argc = token[i].objPtr->internalRep.scriptLineValue.argc;
10560 script->linenr = token[i].objPtr->internalRep.scriptLineValue.line;
10562 /* Allocate the arguments vector if required */
10563 if (argc > JIM_EVAL_SARGV_LEN)
10564 argv = Jim_Alloc(sizeof(Jim_Obj *) * argc);
10566 /* Skip the JIM_TT_LINE token */
10567 i++;
10569 /* Populate the arguments objects.
10570 * If an error occurs, retcode will be set and
10571 * 'j' will be set to the number of args expanded
10573 for (j = 0; j < argc; j++) {
10574 long wordtokens = 1;
10575 int expand = 0;
10576 Jim_Obj *wordObjPtr = NULL;
10578 if (token[i].type == JIM_TT_WORD) {
10579 wordtokens = JimWideValue(token[i++].objPtr);
10580 if (wordtokens < 0) {
10581 expand = 1;
10582 wordtokens = -wordtokens;
10586 if (wordtokens == 1) {
10587 /* Fast path if the token does not
10588 * need interpolation */
10590 switch (token[i].type) {
10591 case JIM_TT_ESC:
10592 case JIM_TT_STR:
10593 wordObjPtr = token[i].objPtr;
10594 break;
10595 case JIM_TT_VAR:
10596 wordObjPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
10597 break;
10598 case JIM_TT_EXPRSUGAR:
10599 retcode = Jim_EvalExpression(interp, token[i].objPtr);
10600 if (retcode == JIM_OK) {
10601 wordObjPtr = Jim_GetResult(interp);
10603 else {
10604 wordObjPtr = NULL;
10606 break;
10607 case JIM_TT_DICTSUGAR:
10608 wordObjPtr = JimExpandDictSugar(interp, token[i].objPtr);
10609 break;
10610 case JIM_TT_CMD:
10611 retcode = Jim_EvalObj(interp, token[i].objPtr);
10612 if (retcode == JIM_OK) {
10613 wordObjPtr = Jim_GetResult(interp);
10615 break;
10616 default:
10617 JimPanic((1, "default token type reached " "in Jim_EvalObj()."));
10620 else {
10621 /* For interpolation we call a helper
10622 * function to do the work for us. */
10623 wordObjPtr = JimInterpolateTokens(interp, token + i, wordtokens, JIM_NONE);
10626 if (!wordObjPtr) {
10627 if (retcode == JIM_OK) {
10628 retcode = JIM_ERR;
10630 break;
10633 Jim_IncrRefCount(wordObjPtr);
10634 i += wordtokens;
10636 if (!expand) {
10637 argv[j] = wordObjPtr;
10639 else {
10640 /* Need to expand wordObjPtr into multiple args from argv[j] ... */
10641 int len = Jim_ListLength(interp, wordObjPtr);
10642 int newargc = argc + len - 1;
10643 int k;
10645 if (len > 1) {
10646 if (argv == sargv) {
10647 if (newargc > JIM_EVAL_SARGV_LEN) {
10648 argv = Jim_Alloc(sizeof(*argv) * newargc);
10649 memcpy(argv, sargv, sizeof(*argv) * j);
10652 else {
10653 /* Need to realloc to make room for (len - 1) more entries */
10654 argv = Jim_Realloc(argv, sizeof(*argv) * newargc);
10658 /* Now copy in the expanded version */
10659 for (k = 0; k < len; k++) {
10660 argv[j++] = wordObjPtr->internalRep.listValue.ele[k];
10661 Jim_IncrRefCount(wordObjPtr->internalRep.listValue.ele[k]);
10664 /* The original object reference is no longer needed,
10665 * after the expansion it is no longer present on
10666 * the argument vector, but the single elements are
10667 * in its place. */
10668 Jim_DecrRefCount(interp, wordObjPtr);
10670 /* And update the indexes */
10671 j--;
10672 argc += len - 1;
10676 if (retcode == JIM_OK && argc) {
10677 /* Invoke the command */
10678 retcode = JimInvokeCommand(interp, argc, argv);
10679 /* Check for a signal after each command */
10680 if (Jim_CheckSignal(interp)) {
10681 retcode = JIM_SIGNAL;
10685 /* Finished with the command, so decrement ref counts of each argument */
10686 while (j-- > 0) {
10687 Jim_DecrRefCount(interp, argv[j]);
10690 if (argv != sargv) {
10691 Jim_Free(argv);
10692 argv = sargv;
10696 /* Possibly add to the error stack trace */
10697 if (retcode == JIM_ERR) {
10698 JimAddErrorToStack(interp, script);
10700 /* Propagate the addStackTrace value through 'return -code error' */
10701 else if (retcode != JIM_RETURN || interp->returnCode != JIM_ERR) {
10702 /* No need to add stack trace */
10703 interp->addStackTrace = 0;
10706 /* Restore the current script */
10707 interp->currentScriptObj = prevScriptObj;
10709 /* Note that we don't have to decrement inUse, because the
10710 * following code transfers our use of the reference again to
10711 * the script object. */
10712 Jim_FreeIntRep(interp, scriptObjPtr);
10713 scriptObjPtr->typePtr = &scriptObjType;
10714 Jim_SetIntRepPtr(scriptObjPtr, script);
10715 Jim_DecrRefCount(interp, scriptObjPtr);
10717 return retcode;
10720 static int JimSetProcArg(Jim_Interp *interp, Jim_Obj *argNameObj, Jim_Obj *argValObj)
10722 int retcode;
10723 /* If argObjPtr begins with '&', do an automatic upvar */
10724 const char *varname = Jim_String(argNameObj);
10725 if (*varname == '&') {
10726 /* First check that the target variable exists */
10727 Jim_Obj *objPtr;
10728 Jim_CallFrame *savedCallFrame = interp->framePtr;
10730 interp->framePtr = interp->framePtr->parent;
10731 objPtr = Jim_GetVariable(interp, argValObj, JIM_ERRMSG);
10732 interp->framePtr = savedCallFrame;
10733 if (!objPtr) {
10734 return JIM_ERR;
10737 /* It exists, so perform the binding. */
10738 objPtr = Jim_NewStringObj(interp, varname + 1, -1);
10739 Jim_IncrRefCount(objPtr);
10740 retcode = Jim_SetVariableLink(interp, objPtr, argValObj, interp->framePtr->parent);
10741 Jim_DecrRefCount(interp, objPtr);
10743 else {
10744 retcode = Jim_SetVariable(interp, argNameObj, argValObj);
10746 return retcode;
10750 * Sets the interp result to be an error message indicating the required proc args.
10752 static void JimSetProcWrongArgs(Jim_Interp *interp, Jim_Obj *procNameObj, Jim_Cmd *cmd)
10754 /* Create a nice error message, consistent with Tcl 8.5 */
10755 Jim_Obj *argmsg = Jim_NewStringObj(interp, "", 0);
10756 int i;
10758 for (i = 0; i < cmd->u.proc.argListLen; i++) {
10759 Jim_AppendString(interp, argmsg, " ", 1);
10761 if (i == cmd->u.proc.argsPos) {
10762 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10763 /* Renamed args */
10764 Jim_AppendString(interp, argmsg, "?", 1);
10765 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].defaultObjPtr);
10766 Jim_AppendString(interp, argmsg, " ...?", -1);
10768 else {
10769 /* We have plain args */
10770 Jim_AppendString(interp, argmsg, "?arg...?", -1);
10773 else {
10774 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10775 Jim_AppendString(interp, argmsg, "?", 1);
10776 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].nameObjPtr);
10777 Jim_AppendString(interp, argmsg, "?", 1);
10779 else {
10780 const char *arg = Jim_String(cmd->u.proc.arglist[i].nameObjPtr);
10781 if (*arg == '&') {
10782 arg++;
10784 Jim_AppendString(interp, argmsg, arg, -1);
10788 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s%#s\"", procNameObj, argmsg);
10791 #ifdef jim_ext_namespace
10793 * [namespace eval]
10795 int Jim_EvalNamespace(Jim_Interp *interp, Jim_Obj *scriptObj, Jim_Obj *nsObj)
10797 Jim_CallFrame *callFramePtr;
10798 int retcode;
10800 /* Create a new callframe */
10801 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, nsObj);
10802 callFramePtr->argv = &interp->emptyObj;
10803 callFramePtr->argc = 0;
10804 callFramePtr->procArgsObjPtr = NULL;
10805 callFramePtr->procBodyObjPtr = scriptObj;
10806 callFramePtr->staticVars = NULL;
10807 callFramePtr->fileNameObj = interp->emptyObj;
10808 callFramePtr->line = 0;
10809 Jim_IncrRefCount(scriptObj);
10810 interp->framePtr = callFramePtr;
10812 /* Check if there are too nested calls */
10813 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10814 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10815 retcode = JIM_ERR;
10817 else {
10818 /* Eval the body */
10819 retcode = Jim_EvalObj(interp, scriptObj);
10822 /* Destroy the callframe */
10823 interp->framePtr = interp->framePtr->parent;
10824 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10826 return retcode;
10828 #endif
10830 /* Call a procedure implemented in Tcl.
10831 * It's possible to speed-up a lot this function, currently
10832 * the callframes are not cached, but allocated and
10833 * destroied every time. What is expecially costly is
10834 * to create/destroy the local vars hash table every time.
10836 * This can be fixed just implementing callframes caching
10837 * in JimCreateCallFrame() and JimFreeCallFrame(). */
10838 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv)
10840 Jim_CallFrame *callFramePtr;
10841 int i, d, retcode, optargs;
10842 ScriptObj *script;
10844 /* Check arity */
10845 if (argc - 1 < cmd->u.proc.reqArity ||
10846 (cmd->u.proc.argsPos < 0 && argc - 1 > cmd->u.proc.reqArity + cmd->u.proc.optArity)) {
10847 JimSetProcWrongArgs(interp, argv[0], cmd);
10848 return JIM_ERR;
10851 if (Jim_Length(cmd->u.proc.bodyObjPtr) == 0) {
10852 /* Optimise for procedure with no body - useful for optional debugging */
10853 return JIM_OK;
10856 /* Check if there are too nested calls */
10857 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10858 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10859 return JIM_ERR;
10862 /* Create a new callframe */
10863 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, cmd->u.proc.nsObj);
10864 callFramePtr->argv = argv;
10865 callFramePtr->argc = argc;
10866 callFramePtr->procArgsObjPtr = cmd->u.proc.argListObjPtr;
10867 callFramePtr->procBodyObjPtr = cmd->u.proc.bodyObjPtr;
10868 callFramePtr->staticVars = cmd->u.proc.staticVars;
10870 /* Remember where we were called from. */
10871 script = JimGetScript(interp, interp->currentScriptObj);
10872 callFramePtr->fileNameObj = script->fileNameObj;
10873 callFramePtr->line = script->linenr;
10875 Jim_IncrRefCount(cmd->u.proc.argListObjPtr);
10876 Jim_IncrRefCount(cmd->u.proc.bodyObjPtr);
10877 interp->framePtr = callFramePtr;
10879 /* How many optional args are available */
10880 optargs = (argc - 1 - cmd->u.proc.reqArity);
10882 /* Step 'i' along the actual args, and step 'd' along the formal args */
10883 i = 1;
10884 for (d = 0; d < cmd->u.proc.argListLen; d++) {
10885 Jim_Obj *nameObjPtr = cmd->u.proc.arglist[d].nameObjPtr;
10886 if (d == cmd->u.proc.argsPos) {
10887 /* assign $args */
10888 Jim_Obj *listObjPtr;
10889 int argsLen = 0;
10890 if (cmd->u.proc.reqArity + cmd->u.proc.optArity < argc - 1) {
10891 argsLen = argc - 1 - (cmd->u.proc.reqArity + cmd->u.proc.optArity);
10893 listObjPtr = Jim_NewListObj(interp, &argv[i], argsLen);
10895 /* It is possible to rename args. */
10896 if (cmd->u.proc.arglist[d].defaultObjPtr) {
10897 nameObjPtr =cmd->u.proc.arglist[d].defaultObjPtr;
10899 retcode = Jim_SetVariable(interp, nameObjPtr, listObjPtr);
10900 if (retcode != JIM_OK) {
10901 goto badargset;
10904 i += argsLen;
10905 continue;
10908 /* Optional or required? */
10909 if (cmd->u.proc.arglist[d].defaultObjPtr == NULL || optargs-- > 0) {
10910 retcode = JimSetProcArg(interp, nameObjPtr, argv[i++]);
10912 else {
10913 /* Ran out, so use the default */
10914 retcode = Jim_SetVariable(interp, nameObjPtr, cmd->u.proc.arglist[d].defaultObjPtr);
10916 if (retcode != JIM_OK) {
10917 goto badargset;
10921 /* Eval the body */
10922 retcode = Jim_EvalObj(interp, cmd->u.proc.bodyObjPtr);
10924 badargset:
10926 /* Invoke $jim::defer then destroy the callframe */
10927 retcode = JimInvokeDefer(interp, retcode);
10928 interp->framePtr = interp->framePtr->parent;
10929 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10931 /* Handle the JIM_RETURN return code */
10932 if (retcode == JIM_RETURN) {
10933 if (--interp->returnLevel <= 0) {
10934 retcode = interp->returnCode;
10935 interp->returnCode = JIM_OK;
10936 interp->returnLevel = 0;
10939 else if (retcode == JIM_ERR) {
10940 interp->addStackTrace++;
10941 Jim_DecrRefCount(interp, interp->errorProc);
10942 interp->errorProc = argv[0];
10943 Jim_IncrRefCount(interp->errorProc);
10946 return retcode;
10949 int Jim_EvalSource(Jim_Interp *interp, const char *filename, int lineno, const char *script)
10951 int retval;
10952 Jim_Obj *scriptObjPtr;
10954 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
10955 Jim_IncrRefCount(scriptObjPtr);
10957 if (filename) {
10958 Jim_Obj *prevScriptObj;
10960 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), lineno);
10962 prevScriptObj = interp->currentScriptObj;
10963 interp->currentScriptObj = scriptObjPtr;
10965 retval = Jim_EvalObj(interp, scriptObjPtr);
10967 interp->currentScriptObj = prevScriptObj;
10969 else {
10970 retval = Jim_EvalObj(interp, scriptObjPtr);
10972 Jim_DecrRefCount(interp, scriptObjPtr);
10973 return retval;
10976 int Jim_Eval(Jim_Interp *interp, const char *script)
10978 return Jim_EvalObj(interp, Jim_NewStringObj(interp, script, -1));
10981 /* Execute script in the scope of the global level */
10982 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
10984 int retval;
10985 Jim_CallFrame *savedFramePtr = interp->framePtr;
10987 interp->framePtr = interp->topFramePtr;
10988 retval = Jim_Eval(interp, script);
10989 interp->framePtr = savedFramePtr;
10991 return retval;
10994 int Jim_EvalFileGlobal(Jim_Interp *interp, const char *filename)
10996 int retval;
10997 Jim_CallFrame *savedFramePtr = interp->framePtr;
10999 interp->framePtr = interp->topFramePtr;
11000 retval = Jim_EvalFile(interp, filename);
11001 interp->framePtr = savedFramePtr;
11003 return retval;
11006 #include <sys/stat.h>
11008 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
11010 FILE *fp;
11011 char *buf;
11012 Jim_Obj *scriptObjPtr;
11013 Jim_Obj *prevScriptObj;
11014 struct stat sb;
11015 int retcode;
11016 int readlen;
11018 if (stat(filename, &sb) != 0 || (fp = fopen(filename, "rt")) == NULL) {
11019 Jim_SetResultFormatted(interp, "couldn't read file \"%s\": %s", filename, strerror(errno));
11020 return JIM_ERR;
11022 if (sb.st_size == 0) {
11023 fclose(fp);
11024 return JIM_OK;
11027 buf = Jim_Alloc(sb.st_size + 1);
11028 readlen = fread(buf, 1, sb.st_size, fp);
11029 if (ferror(fp)) {
11030 fclose(fp);
11031 Jim_Free(buf);
11032 Jim_SetResultFormatted(interp, "failed to load file \"%s\": %s", filename, strerror(errno));
11033 return JIM_ERR;
11035 fclose(fp);
11036 buf[readlen] = 0;
11038 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, buf, readlen);
11039 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), 1);
11040 Jim_IncrRefCount(scriptObjPtr);
11042 prevScriptObj = interp->currentScriptObj;
11043 interp->currentScriptObj = scriptObjPtr;
11045 retcode = Jim_EvalObj(interp, scriptObjPtr);
11047 /* Handle the JIM_RETURN return code */
11048 if (retcode == JIM_RETURN) {
11049 if (--interp->returnLevel <= 0) {
11050 retcode = interp->returnCode;
11051 interp->returnCode = JIM_OK;
11052 interp->returnLevel = 0;
11055 if (retcode == JIM_ERR) {
11056 /* EvalFile changes context, so add a stack frame here */
11057 interp->addStackTrace++;
11060 interp->currentScriptObj = prevScriptObj;
11062 Jim_DecrRefCount(interp, scriptObjPtr);
11064 return retcode;
11067 /* -----------------------------------------------------------------------------
11068 * Subst
11069 * ---------------------------------------------------------------------------*/
11070 static void JimParseSubst(struct JimParserCtx *pc, int flags)
11072 pc->tstart = pc->p;
11073 pc->tline = pc->linenr;
11075 if (pc->len == 0) {
11076 pc->tend = pc->p;
11077 pc->tt = JIM_TT_EOL;
11078 pc->eof = 1;
11079 return;
11081 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11082 JimParseCmd(pc);
11083 return;
11085 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11086 if (JimParseVar(pc) == JIM_OK) {
11087 return;
11089 /* Not a var, so treat as a string */
11090 pc->tstart = pc->p;
11091 flags |= JIM_SUBST_NOVAR;
11093 while (pc->len) {
11094 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11095 break;
11097 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11098 break;
11100 if (*pc->p == '\\' && pc->len > 1) {
11101 pc->p++;
11102 pc->len--;
11104 pc->p++;
11105 pc->len--;
11107 pc->tend = pc->p - 1;
11108 pc->tt = (flags & JIM_SUBST_NOESC) ? JIM_TT_STR : JIM_TT_ESC;
11111 /* The subst object type reuses most of the data structures and functions
11112 * of the script object. Script's data structures are a bit more complex
11113 * for what is needed for [subst]itution tasks, but the reuse helps to
11114 * deal with a single data structure at the cost of some more memory
11115 * usage for substitutions. */
11117 /* This method takes the string representation of an object
11118 * as a Tcl string where to perform [subst]itution, and generates
11119 * the pre-parsed internal representation. */
11120 static int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
11122 int scriptTextLen;
11123 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
11124 struct JimParserCtx parser;
11125 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
11126 ParseTokenList tokenlist;
11128 /* Initially parse the subst into tokens (in tokenlist) */
11129 ScriptTokenListInit(&tokenlist);
11131 JimParserInit(&parser, scriptText, scriptTextLen, 1);
11132 while (1) {
11133 JimParseSubst(&parser, flags);
11134 if (parser.eof) {
11135 /* Note that subst doesn't need the EOL token */
11136 break;
11138 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
11139 parser.tline);
11142 /* Create the "real" subst/script tokens from the initial token list */
11143 script->inUse = 1;
11144 script->substFlags = flags;
11145 script->fileNameObj = interp->emptyObj;
11146 Jim_IncrRefCount(script->fileNameObj);
11147 SubstObjAddTokens(interp, script, &tokenlist);
11149 /* No longer need the token list */
11150 ScriptTokenListFree(&tokenlist);
11152 #ifdef DEBUG_SHOW_SUBST
11154 int i;
11156 printf("==== Subst ====\n");
11157 for (i = 0; i < script->len; i++) {
11158 printf("[%2d] %s '%s'\n", i, jim_tt_name(script->token[i].type),
11159 Jim_String(script->token[i].objPtr));
11162 #endif
11164 /* Free the old internal rep and set the new one. */
11165 Jim_FreeIntRep(interp, objPtr);
11166 Jim_SetIntRepPtr(objPtr, script);
11167 objPtr->typePtr = &scriptObjType;
11168 return JIM_OK;
11171 static ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
11173 if (objPtr->typePtr != &scriptObjType || ((ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags != flags)
11174 SetSubstFromAny(interp, objPtr, flags);
11175 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
11178 /* Performs commands,variables,blackslashes substitution,
11179 * storing the result object (with refcount 0) into
11180 * resObjPtrPtr. */
11181 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr, Jim_Obj **resObjPtrPtr, int flags)
11183 ScriptObj *script;
11185 JimPanic((substObjPtr->refCount == 0, "Jim_SubstObj() called with zero refcount object"));
11187 script = Jim_GetSubst(interp, substObjPtr, flags);
11189 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
11190 /* In order to preserve the internal rep, we increment the
11191 * inUse field of the script internal rep structure. */
11192 script->inUse++;
11194 *resObjPtrPtr = JimInterpolateTokens(interp, script->token, script->len, flags);
11196 script->inUse--;
11197 Jim_DecrRefCount(interp, substObjPtr);
11198 if (*resObjPtrPtr == NULL) {
11199 return JIM_ERR;
11201 return JIM_OK;
11204 /* -----------------------------------------------------------------------------
11205 * Core commands utility functions
11206 * ---------------------------------------------------------------------------*/
11207 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv, const char *msg)
11209 Jim_Obj *objPtr;
11210 Jim_Obj *listObjPtr;
11212 JimPanic((argc == 0, "Jim_WrongNumArgs() called with argc=0"));
11214 listObjPtr = Jim_NewListObj(interp, argv, argc);
11216 if (msg && *msg) {
11217 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, msg, -1));
11219 Jim_IncrRefCount(listObjPtr);
11220 objPtr = Jim_ListJoin(interp, listObjPtr, " ", 1);
11221 Jim_DecrRefCount(interp, listObjPtr);
11223 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s\"", objPtr);
11227 * May add the key and/or value to the list.
11229 typedef void JimHashtableIteratorCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr,
11230 Jim_HashEntry *he, int type);
11232 #define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL)
11235 * For each key of the hash table 'ht' with object keys that
11236 * matches the glob pattern (all if NULL), invoke the callback to add entries to a list.
11237 * Returns the list.
11239 static Jim_Obj *JimHashtablePatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
11240 JimHashtableIteratorCallbackType *callback, int type)
11242 Jim_HashEntry *he;
11243 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
11245 /* Check for the non-pattern case. We can do this much more efficiently. */
11246 if (patternObjPtr && JimTrivialMatch(Jim_String(patternObjPtr))) {
11247 he = Jim_FindHashEntry(ht, patternObjPtr);
11248 if (he) {
11249 callback(interp, listObjPtr, he, type);
11252 else {
11253 Jim_HashTableIterator htiter;
11254 JimInitHashTableIterator(ht, &htiter);
11255 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
11256 if (!patternObjPtr || Jim_StringMatchObj(interp, patternObjPtr, he->key, 0)) {
11257 callback(interp, listObjPtr, he, type);
11261 return listObjPtr;
11264 /* Keep these in order */
11265 #define JIM_CMDLIST_COMMANDS 0
11266 #define JIM_CMDLIST_PROCS 1
11267 #define JIM_CMDLIST_CHANNELS 2
11270 * Adds matching command names (procs, channels) to the list.
11272 static void JimCommandMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11273 Jim_HashEntry *he, int type)
11275 Jim_Cmd *cmdPtr = Jim_GetHashEntryVal(he);
11276 Jim_Obj *objPtr;
11278 if (type == JIM_CMDLIST_PROCS && !cmdPtr->isproc) {
11279 /* not a proc */
11280 return;
11283 objPtr = (Jim_Obj *)he->key;
11284 Jim_IncrRefCount(objPtr);
11286 if (type != JIM_CMDLIST_CHANNELS || Jim_AioFilehandle(interp, objPtr)) {
11287 Jim_ListAppendElement(interp, listObjPtr, objPtr);
11289 Jim_DecrRefCount(interp, objPtr);
11292 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int type)
11294 return JimHashtablePatternMatch(interp, &interp->commands, patternObjPtr, JimCommandMatch, type);
11297 /* Keep these in order */
11298 #define JIM_VARLIST_GLOBALS 0
11299 #define JIM_VARLIST_LOCALS 1
11300 #define JIM_VARLIST_VARS 2
11301 #define JIM_VARLIST_MASK 0x000f
11303 #define JIM_VARLIST_VALUES 0x1000
11306 * Adds matching variable names to the list.
11308 static void JimVariablesMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11309 Jim_HashEntry *he, int type)
11311 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
11313 if ((type & JIM_VARLIST_MASK) != JIM_VARLIST_LOCALS || varPtr->linkFramePtr == NULL) {
11314 Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->key);
11315 if (type & JIM_VARLIST_VALUES) {
11316 Jim_ListAppendElement(interp, listObjPtr, varPtr->objPtr);
11321 /* mode is JIM_VARLIST_xxx */
11322 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int mode)
11324 if (mode == JIM_VARLIST_LOCALS && interp->framePtr == interp->topFramePtr) {
11325 /* For [info locals], if we are at top level an empty list
11326 * is returned. I don't agree, but we aim at compatibility (SS) */
11327 return interp->emptyObj;
11329 else {
11330 Jim_CallFrame *framePtr = (mode == JIM_VARLIST_GLOBALS) ? interp->topFramePtr : interp->framePtr;
11331 return JimHashtablePatternMatch(interp, &framePtr->vars, patternObjPtr, JimVariablesMatch,
11332 mode);
11336 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
11337 Jim_Obj **objPtrPtr, int info_level_cmd)
11339 Jim_CallFrame *targetCallFrame;
11341 targetCallFrame = JimGetCallFrameByInteger(interp, levelObjPtr);
11342 if (targetCallFrame == NULL) {
11343 return JIM_ERR;
11345 /* No proc call at toplevel callframe */
11346 if (targetCallFrame == interp->topFramePtr) {
11347 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
11348 return JIM_ERR;
11350 if (info_level_cmd) {
11351 *objPtrPtr = Jim_NewListObj(interp, targetCallFrame->argv, targetCallFrame->argc);
11353 else {
11354 Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0);
11356 Jim_ListAppendElement(interp, listObj, targetCallFrame->argv[0]);
11357 Jim_ListAppendElement(interp, listObj, targetCallFrame->fileNameObj);
11358 Jim_ListAppendElement(interp, listObj, Jim_NewIntObj(interp, targetCallFrame->line));
11359 *objPtrPtr = listObj;
11361 return JIM_OK;
11364 /* -----------------------------------------------------------------------------
11365 * Core commands
11366 * ---------------------------------------------------------------------------*/
11368 /* fake [puts] -- not the real puts, just for debugging. */
11369 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11371 if (argc != 2 && argc != 3) {
11372 Jim_WrongNumArgs(interp, 1, argv, "?-nonewline? string");
11373 return JIM_ERR;
11375 if (argc == 3) {
11376 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline")) {
11377 Jim_SetResultString(interp, "The second argument must " "be -nonewline", -1);
11378 return JIM_ERR;
11380 else {
11381 fputs(Jim_String(argv[2]), stdout);
11384 else {
11385 puts(Jim_String(argv[1]));
11387 return JIM_OK;
11390 /* Helper for [+] and [*] */
11391 static int JimAddMulHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11393 jim_wide wideValue, res;
11394 double doubleValue, doubleRes;
11395 int i;
11397 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
11399 for (i = 1; i < argc; i++) {
11400 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
11401 goto trydouble;
11402 if (op == JIM_EXPROP_ADD)
11403 res += wideValue;
11404 else
11405 res *= wideValue;
11407 Jim_SetResultInt(interp, res);
11408 return JIM_OK;
11409 trydouble:
11410 doubleRes = (double)res;
11411 for (; i < argc; i++) {
11412 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11413 return JIM_ERR;
11414 if (op == JIM_EXPROP_ADD)
11415 doubleRes += doubleValue;
11416 else
11417 doubleRes *= doubleValue;
11419 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11420 return JIM_OK;
11423 /* Helper for [-] and [/] */
11424 static int JimSubDivHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11426 jim_wide wideValue, res = 0;
11427 double doubleValue, doubleRes = 0;
11428 int i = 2;
11430 if (argc < 2) {
11431 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
11432 return JIM_ERR;
11434 else if (argc == 2) {
11435 /* The arity = 2 case is different. For [- x] returns -x,
11436 * while [/ x] returns 1/x. */
11437 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
11438 if (Jim_GetDouble(interp, argv[1], &doubleValue) != JIM_OK) {
11439 return JIM_ERR;
11441 else {
11442 if (op == JIM_EXPROP_SUB)
11443 doubleRes = -doubleValue;
11444 else
11445 doubleRes = 1.0 / doubleValue;
11446 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11447 return JIM_OK;
11450 if (op == JIM_EXPROP_SUB) {
11451 res = -wideValue;
11452 Jim_SetResultInt(interp, res);
11454 else {
11455 doubleRes = 1.0 / wideValue;
11456 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11458 return JIM_OK;
11460 else {
11461 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
11462 if (Jim_GetDouble(interp, argv[1], &doubleRes)
11463 != JIM_OK) {
11464 return JIM_ERR;
11466 else {
11467 goto trydouble;
11471 for (i = 2; i < argc; i++) {
11472 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
11473 doubleRes = (double)res;
11474 goto trydouble;
11476 if (op == JIM_EXPROP_SUB)
11477 res -= wideValue;
11478 else {
11479 if (wideValue == 0) {
11480 Jim_SetResultString(interp, "Division by zero", -1);
11481 return JIM_ERR;
11483 res /= wideValue;
11486 Jim_SetResultInt(interp, res);
11487 return JIM_OK;
11488 trydouble:
11489 for (; i < argc; i++) {
11490 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11491 return JIM_ERR;
11492 if (op == JIM_EXPROP_SUB)
11493 doubleRes -= doubleValue;
11494 else
11495 doubleRes /= doubleValue;
11497 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11498 return JIM_OK;
11502 /* [+] */
11503 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11505 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
11508 /* [*] */
11509 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11511 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
11514 /* [-] */
11515 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11517 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
11520 /* [/] */
11521 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11523 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
11526 /* [set] */
11527 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11529 if (argc != 2 && argc != 3) {
11530 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
11531 return JIM_ERR;
11533 if (argc == 2) {
11534 Jim_Obj *objPtr;
11536 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11537 if (!objPtr)
11538 return JIM_ERR;
11539 Jim_SetResult(interp, objPtr);
11540 return JIM_OK;
11542 /* argc == 3 case. */
11543 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
11544 return JIM_ERR;
11545 Jim_SetResult(interp, argv[2]);
11546 return JIM_OK;
11549 /* [unset]
11551 * unset ?-nocomplain? ?--? ?varName ...?
11553 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11555 int i = 1;
11556 int complain = 1;
11558 while (i < argc) {
11559 if (Jim_CompareStringImmediate(interp, argv[i], "--")) {
11560 i++;
11561 break;
11563 if (Jim_CompareStringImmediate(interp, argv[i], "-nocomplain")) {
11564 complain = 0;
11565 i++;
11566 continue;
11568 break;
11571 while (i < argc) {
11572 if (Jim_UnsetVariable(interp, argv[i], complain ? JIM_ERRMSG : JIM_NONE) != JIM_OK
11573 && complain) {
11574 return JIM_ERR;
11576 i++;
11578 return JIM_OK;
11581 /* [while] */
11582 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11584 if (argc != 3) {
11585 Jim_WrongNumArgs(interp, 1, argv, "condition body");
11586 return JIM_ERR;
11589 /* The general purpose implementation of while starts here */
11590 while (1) {
11591 int boolean, retval;
11593 if ((retval = Jim_GetBoolFromExpr(interp, argv[1], &boolean)) != JIM_OK)
11594 return retval;
11595 if (!boolean)
11596 break;
11598 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
11599 switch (retval) {
11600 case JIM_BREAK:
11601 goto out;
11602 break;
11603 case JIM_CONTINUE:
11604 continue;
11605 break;
11606 default:
11607 return retval;
11611 out:
11612 Jim_SetEmptyResult(interp);
11613 return JIM_OK;
11616 /* [for] */
11617 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11619 int retval;
11620 int boolean = 1;
11621 Jim_Obj *varNamePtr = NULL;
11622 Jim_Obj *stopVarNamePtr = NULL;
11624 if (argc != 5) {
11625 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
11626 return JIM_ERR;
11629 /* Do the initialisation */
11630 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK) {
11631 return retval;
11634 /* And do the first test now. Better for optimisation
11635 * if we can do next/test at the bottom of the loop
11637 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11639 /* Ready to do the body as follows:
11640 * while (1) {
11641 * body // check retcode
11642 * next // check retcode
11643 * test // check retcode/test bool
11647 #ifdef JIM_OPTIMIZATION
11648 /* Check if the for is on the form:
11649 * for ... {$i < CONST} {incr i}
11650 * for ... {$i < $j} {incr i}
11652 if (retval == JIM_OK && boolean) {
11653 ScriptObj *incrScript;
11654 struct ExprTree *expr;
11655 jim_wide stop, currentVal;
11656 Jim_Obj *objPtr;
11657 int cmpOffset;
11659 /* Do it only if there aren't shared arguments */
11660 expr = JimGetExpression(interp, argv[2]);
11661 incrScript = JimGetScript(interp, argv[3]);
11663 /* Ensure proper lengths to start */
11664 if (incrScript == NULL || incrScript->len != 3 || !expr || expr->len != 3) {
11665 goto evalstart;
11667 /* Ensure proper token types. */
11668 if (incrScript->token[1].type != JIM_TT_ESC) {
11669 goto evalstart;
11672 if (expr->expr->type == JIM_EXPROP_LT) {
11673 cmpOffset = 0;
11675 else if (expr->expr->type == JIM_EXPROP_LTE) {
11676 cmpOffset = 1;
11678 else {
11679 goto evalstart;
11682 if (expr->expr->left->type != JIM_TT_VAR) {
11683 goto evalstart;
11686 if (expr->expr->right->type != JIM_TT_VAR && expr->expr->right->type != JIM_TT_EXPR_INT) {
11687 goto evalstart;
11690 /* Update command must be incr */
11691 if (!Jim_CompareStringImmediate(interp, incrScript->token[1].objPtr, "incr")) {
11692 goto evalstart;
11695 /* incr, expression must be about the same variable */
11696 if (!Jim_StringEqObj(incrScript->token[2].objPtr, expr->expr->left->objPtr)) {
11697 goto evalstart;
11700 /* Get the stop condition (must be a variable or integer) */
11701 if (expr->expr->right->type == JIM_TT_EXPR_INT) {
11702 if (Jim_GetWide(interp, expr->expr->right->objPtr, &stop) == JIM_ERR) {
11703 goto evalstart;
11706 else {
11707 stopVarNamePtr = expr->expr->right->objPtr;
11708 Jim_IncrRefCount(stopVarNamePtr);
11709 /* Keep the compiler happy */
11710 stop = 0;
11713 /* Initialization */
11714 varNamePtr = expr->expr->left->objPtr;
11715 Jim_IncrRefCount(varNamePtr);
11717 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
11718 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK) {
11719 goto testcond;
11722 /* --- OPTIMIZED FOR --- */
11723 while (retval == JIM_OK) {
11724 /* === Check condition === */
11725 /* Note that currentVal is already set here */
11727 /* Immediate or Variable? get the 'stop' value if the latter. */
11728 if (stopVarNamePtr) {
11729 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
11730 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &stop) != JIM_OK) {
11731 goto testcond;
11735 if (currentVal >= stop + cmpOffset) {
11736 break;
11739 /* Eval body */
11740 retval = Jim_EvalObj(interp, argv[4]);
11741 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11742 retval = JIM_OK;
11744 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
11746 /* Increment */
11747 if (objPtr == NULL) {
11748 retval = JIM_ERR;
11749 goto out;
11751 if (!Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11752 currentVal = ++JimWideValue(objPtr);
11753 Jim_InvalidateStringRep(objPtr);
11755 else {
11756 if (Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK ||
11757 Jim_SetVariable(interp, varNamePtr, Jim_NewIntObj(interp,
11758 ++currentVal)) != JIM_OK) {
11759 goto evalnext;
11764 goto out;
11766 evalstart:
11767 #endif
11769 while (boolean && (retval == JIM_OK || retval == JIM_CONTINUE)) {
11770 /* Body */
11771 retval = Jim_EvalObj(interp, argv[4]);
11773 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11774 /* increment */
11775 JIM_IF_OPTIM(evalnext:)
11776 retval = Jim_EvalObj(interp, argv[3]);
11777 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11778 /* test */
11779 JIM_IF_OPTIM(testcond:)
11780 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11784 JIM_IF_OPTIM(out:)
11785 if (stopVarNamePtr) {
11786 Jim_DecrRefCount(interp, stopVarNamePtr);
11788 if (varNamePtr) {
11789 Jim_DecrRefCount(interp, varNamePtr);
11792 if (retval == JIM_CONTINUE || retval == JIM_BREAK || retval == JIM_OK) {
11793 Jim_SetEmptyResult(interp);
11794 return JIM_OK;
11797 return retval;
11800 /* [loop] */
11801 static int Jim_LoopCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11803 int retval;
11804 jim_wide i;
11805 jim_wide limit;
11806 jim_wide incr = 1;
11807 Jim_Obj *bodyObjPtr;
11809 if (argc != 5 && argc != 6) {
11810 Jim_WrongNumArgs(interp, 1, argv, "var first limit ?incr? body");
11811 return JIM_ERR;
11814 if (Jim_GetWide(interp, argv[2], &i) != JIM_OK ||
11815 Jim_GetWide(interp, argv[3], &limit) != JIM_OK ||
11816 (argc == 6 && Jim_GetWide(interp, argv[4], &incr) != JIM_OK)) {
11817 return JIM_ERR;
11819 bodyObjPtr = (argc == 5) ? argv[4] : argv[5];
11821 retval = Jim_SetVariable(interp, argv[1], argv[2]);
11823 while (((i < limit && incr > 0) || (i > limit && incr < 0)) && retval == JIM_OK) {
11824 retval = Jim_EvalObj(interp, bodyObjPtr);
11825 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11826 Jim_Obj *objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11828 retval = JIM_OK;
11830 /* Increment */
11831 i += incr;
11833 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11834 if (argv[1]->typePtr != &variableObjType) {
11835 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11836 return JIM_ERR;
11839 JimWideValue(objPtr) = i;
11840 Jim_InvalidateStringRep(objPtr);
11842 /* The following step is required in order to invalidate the
11843 * string repr of "FOO" if the var name is of the form of "FOO(IDX)" */
11844 if (argv[1]->typePtr != &variableObjType) {
11845 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11846 retval = JIM_ERR;
11847 break;
11851 else {
11852 objPtr = Jim_NewIntObj(interp, i);
11853 retval = Jim_SetVariable(interp, argv[1], objPtr);
11854 if (retval != JIM_OK) {
11855 Jim_FreeNewObj(interp, objPtr);
11861 if (retval == JIM_OK || retval == JIM_CONTINUE || retval == JIM_BREAK) {
11862 Jim_SetEmptyResult(interp);
11863 return JIM_OK;
11865 return retval;
11868 /* List iterators make it easy to iterate over a list.
11869 * At some point iterators will be expanded to support generators.
11871 typedef struct {
11872 Jim_Obj *objPtr;
11873 int idx;
11874 } Jim_ListIter;
11877 * Initialise the iterator at the start of the list.
11879 static void JimListIterInit(Jim_ListIter *iter, Jim_Obj *objPtr)
11881 iter->objPtr = objPtr;
11882 iter->idx = 0;
11886 * Returns the next object from the list, or NULL on end-of-list.
11888 static Jim_Obj *JimListIterNext(Jim_Interp *interp, Jim_ListIter *iter)
11890 if (iter->idx >= Jim_ListLength(interp, iter->objPtr)) {
11891 return NULL;
11893 return iter->objPtr->internalRep.listValue.ele[iter->idx++];
11897 * Returns 1 if end-of-list has been reached.
11899 static int JimListIterDone(Jim_Interp *interp, Jim_ListIter *iter)
11901 return iter->idx >= Jim_ListLength(interp, iter->objPtr);
11904 /* foreach + lmap implementation. */
11905 static int JimForeachMapHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int doMap)
11907 int result = JIM_OK;
11908 int i, numargs;
11909 Jim_ListIter twoiters[2]; /* Avoid allocation for a single list */
11910 Jim_ListIter *iters;
11911 Jim_Obj *script;
11912 Jim_Obj *resultObj;
11914 if (argc < 4 || argc % 2 != 0) {
11915 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
11916 return JIM_ERR;
11918 script = argv[argc - 1]; /* Last argument is a script */
11919 numargs = (argc - 1 - 1); /* argc - 'foreach' - script */
11921 if (numargs == 2) {
11922 iters = twoiters;
11924 else {
11925 iters = Jim_Alloc(numargs * sizeof(*iters));
11927 for (i = 0; i < numargs; i++) {
11928 JimListIterInit(&iters[i], argv[i + 1]);
11929 if (i % 2 == 0 && JimListIterDone(interp, &iters[i])) {
11930 result = JIM_ERR;
11933 if (result != JIM_OK) {
11934 Jim_SetResultString(interp, "foreach varlist is empty", -1);
11935 goto empty_varlist;
11938 if (doMap) {
11939 resultObj = Jim_NewListObj(interp, NULL, 0);
11941 else {
11942 resultObj = interp->emptyObj;
11944 Jim_IncrRefCount(resultObj);
11946 while (1) {
11947 /* Have we expired all lists? */
11948 for (i = 0; i < numargs; i += 2) {
11949 if (!JimListIterDone(interp, &iters[i + 1])) {
11950 break;
11953 if (i == numargs) {
11954 /* All done */
11955 break;
11958 /* For each list */
11959 for (i = 0; i < numargs; i += 2) {
11960 Jim_Obj *varName;
11962 /* foreach var */
11963 JimListIterInit(&iters[i], argv[i + 1]);
11964 while ((varName = JimListIterNext(interp, &iters[i])) != NULL) {
11965 Jim_Obj *valObj = JimListIterNext(interp, &iters[i + 1]);
11966 if (!valObj) {
11967 /* Ran out, so store the empty string */
11968 valObj = interp->emptyObj;
11970 /* Avoid shimmering */
11971 Jim_IncrRefCount(valObj);
11972 result = Jim_SetVariable(interp, varName, valObj);
11973 Jim_DecrRefCount(interp, valObj);
11974 if (result != JIM_OK) {
11975 goto err;
11979 switch (result = Jim_EvalObj(interp, script)) {
11980 case JIM_OK:
11981 if (doMap) {
11982 Jim_ListAppendElement(interp, resultObj, interp->result);
11984 break;
11985 case JIM_CONTINUE:
11986 break;
11987 case JIM_BREAK:
11988 goto out;
11989 default:
11990 goto err;
11993 out:
11994 result = JIM_OK;
11995 Jim_SetResult(interp, resultObj);
11996 err:
11997 Jim_DecrRefCount(interp, resultObj);
11998 empty_varlist:
11999 if (numargs > 2) {
12000 Jim_Free(iters);
12002 return result;
12005 /* [foreach] */
12006 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12008 return JimForeachMapHelper(interp, argc, argv, 0);
12011 /* [lmap] */
12012 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12014 return JimForeachMapHelper(interp, argc, argv, 1);
12017 /* [lassign] */
12018 static int Jim_LassignCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12020 int result = JIM_ERR;
12021 int i;
12022 Jim_ListIter iter;
12023 Jim_Obj *resultObj;
12025 if (argc < 2) {
12026 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varName ...?");
12027 return JIM_ERR;
12030 JimListIterInit(&iter, argv[1]);
12032 for (i = 2; i < argc; i++) {
12033 Jim_Obj *valObj = JimListIterNext(interp, &iter);
12034 result = Jim_SetVariable(interp, argv[i], valObj ? valObj : interp->emptyObj);
12035 if (result != JIM_OK) {
12036 return result;
12040 resultObj = Jim_NewListObj(interp, NULL, 0);
12041 while (!JimListIterDone(interp, &iter)) {
12042 Jim_ListAppendElement(interp, resultObj, JimListIterNext(interp, &iter));
12045 Jim_SetResult(interp, resultObj);
12047 return JIM_OK;
12050 /* [if] */
12051 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12053 int boolean, retval, current = 1, falsebody = 0;
12055 if (argc >= 3) {
12056 while (1) {
12057 /* Far not enough arguments given! */
12058 if (current >= argc)
12059 goto err;
12060 if ((retval = Jim_GetBoolFromExpr(interp, argv[current++], &boolean))
12061 != JIM_OK)
12062 return retval;
12063 /* There lacks something, isn't it? */
12064 if (current >= argc)
12065 goto err;
12066 if (Jim_CompareStringImmediate(interp, argv[current], "then"))
12067 current++;
12068 /* Tsk tsk, no then-clause? */
12069 if (current >= argc)
12070 goto err;
12071 if (boolean)
12072 return Jim_EvalObj(interp, argv[current]);
12073 /* Ok: no else-clause follows */
12074 if (++current >= argc) {
12075 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
12076 return JIM_OK;
12078 falsebody = current++;
12079 if (Jim_CompareStringImmediate(interp, argv[falsebody], "else")) {
12080 /* IIICKS - else-clause isn't last cmd? */
12081 if (current != argc - 1)
12082 goto err;
12083 return Jim_EvalObj(interp, argv[current]);
12085 else if (Jim_CompareStringImmediate(interp, argv[falsebody], "elseif"))
12086 /* Ok: elseif follows meaning all the stuff
12087 * again (how boring...) */
12088 continue;
12089 /* OOPS - else-clause is not last cmd? */
12090 else if (falsebody != argc - 1)
12091 goto err;
12092 return Jim_EvalObj(interp, argv[falsebody]);
12094 return JIM_OK;
12096 err:
12097 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
12098 return JIM_ERR;
12102 /* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)
12103 * flags may contain JIM_NOCASE and/or JIM_OPT_END
12105 int Jim_CommandMatchObj(Jim_Interp *interp, Jim_Obj *commandObj, Jim_Obj *patternObj,
12106 Jim_Obj *stringObj, int flags)
12108 Jim_Obj *parms[5];
12109 int argc = 0;
12110 long eq;
12111 int rc;
12113 parms[argc++] = commandObj;
12114 if (flags & JIM_NOCASE) {
12115 parms[argc++] = Jim_NewStringObj(interp, "-nocase", -1);
12117 if (flags & JIM_OPT_END) {
12118 parms[argc++] = Jim_NewStringObj(interp, "--", -1);
12120 parms[argc++] = patternObj;
12121 parms[argc++] = stringObj;
12123 rc = Jim_EvalObjVector(interp, argc, parms);
12125 if (rc != JIM_OK || Jim_GetLong(interp, Jim_GetResult(interp), &eq) != JIM_OK) {
12126 eq = -rc;
12129 return eq;
12132 /* [switch] */
12133 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12135 enum { SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD };
12136 int matchOpt = SWITCH_EXACT, opt = 1, patCount, i;
12137 int match_flags = 0;
12138 Jim_Obj *command = NULL, *scriptObj = NULL, *strObj;
12139 Jim_Obj **caseList;
12141 if (argc < 3) {
12142 wrongnumargs:
12143 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
12144 "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}");
12145 return JIM_ERR;
12147 for (opt = 1; opt < argc; ++opt) {
12148 const char *option = Jim_String(argv[opt]);
12150 if (*option != '-')
12151 break;
12152 else if (strncmp(option, "--", 2) == 0) {
12153 ++opt;
12154 break;
12156 else if (strncmp(option, "-exact", 2) == 0)
12157 matchOpt = SWITCH_EXACT;
12158 else if (strncmp(option, "-glob", 2) == 0)
12159 matchOpt = SWITCH_GLOB;
12160 else if (strncmp(option, "-regexp", 2) == 0) {
12161 matchOpt = SWITCH_RE;
12162 match_flags |= JIM_OPT_END;
12164 else if (strncmp(option, "-command", 2) == 0) {
12165 matchOpt = SWITCH_CMD;
12166 if ((argc - opt) < 2)
12167 goto wrongnumargs;
12168 command = argv[++opt];
12170 else {
12171 Jim_SetResultFormatted(interp,
12172 "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --",
12173 argv[opt]);
12174 return JIM_ERR;
12176 if ((argc - opt) < 2)
12177 goto wrongnumargs;
12179 strObj = argv[opt++];
12180 patCount = argc - opt;
12181 if (patCount == 1) {
12182 JimListGetElements(interp, argv[opt], &patCount, &caseList);
12184 else
12185 caseList = (Jim_Obj **)&argv[opt];
12186 if (patCount == 0 || patCount % 2 != 0)
12187 goto wrongnumargs;
12188 for (i = 0; scriptObj == NULL && i < patCount; i += 2) {
12189 Jim_Obj *patObj = caseList[i];
12191 if (!Jim_CompareStringImmediate(interp, patObj, "default")
12192 || i < (patCount - 2)) {
12193 switch (matchOpt) {
12194 case SWITCH_EXACT:
12195 if (Jim_StringEqObj(strObj, patObj))
12196 scriptObj = caseList[i + 1];
12197 break;
12198 case SWITCH_GLOB:
12199 if (Jim_StringMatchObj(interp, patObj, strObj, 0))
12200 scriptObj = caseList[i + 1];
12201 break;
12202 case SWITCH_RE:
12203 command = Jim_NewStringObj(interp, "regexp", -1);
12204 /* Fall thru intentionally */
12205 case SWITCH_CMD:{
12206 int rc = Jim_CommandMatchObj(interp, command, patObj, strObj, match_flags);
12208 /* After the execution of a command we need to
12209 * make sure to reconvert the object into a list
12210 * again. Only for the single-list style [switch]. */
12211 if (argc - opt == 1) {
12212 JimListGetElements(interp, argv[opt], &patCount, &caseList);
12214 /* command is here already decref'd */
12215 if (rc < 0) {
12216 return -rc;
12218 if (rc)
12219 scriptObj = caseList[i + 1];
12220 break;
12224 else {
12225 scriptObj = caseList[i + 1];
12228 for (; i < patCount && Jim_CompareStringImmediate(interp, scriptObj, "-"); i += 2)
12229 scriptObj = caseList[i + 1];
12230 if (scriptObj && Jim_CompareStringImmediate(interp, scriptObj, "-")) {
12231 Jim_SetResultFormatted(interp, "no body specified for pattern \"%#s\"", caseList[i - 2]);
12232 return JIM_ERR;
12234 Jim_SetEmptyResult(interp);
12235 if (scriptObj) {
12236 return Jim_EvalObj(interp, scriptObj);
12238 return JIM_OK;
12241 /* [list] */
12242 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12244 Jim_Obj *listObjPtr;
12246 listObjPtr = Jim_NewListObj(interp, argv + 1, argc - 1);
12247 Jim_SetResult(interp, listObjPtr);
12248 return JIM_OK;
12251 /* [lindex] */
12252 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12254 Jim_Obj *objPtr, *listObjPtr;
12255 int i;
12256 int idx;
12258 if (argc < 2) {
12259 Jim_WrongNumArgs(interp, 1, argv, "list ?index ...?");
12260 return JIM_ERR;
12262 objPtr = argv[1];
12263 Jim_IncrRefCount(objPtr);
12264 for (i = 2; i < argc; i++) {
12265 listObjPtr = objPtr;
12266 if (Jim_GetIndex(interp, argv[i], &idx) != JIM_OK) {
12267 Jim_DecrRefCount(interp, listObjPtr);
12268 return JIM_ERR;
12270 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_NONE) != JIM_OK) {
12271 /* Returns an empty object if the index
12272 * is out of range. */
12273 Jim_DecrRefCount(interp, listObjPtr);
12274 Jim_SetEmptyResult(interp);
12275 return JIM_OK;
12277 Jim_IncrRefCount(objPtr);
12278 Jim_DecrRefCount(interp, listObjPtr);
12280 Jim_SetResult(interp, objPtr);
12281 Jim_DecrRefCount(interp, objPtr);
12282 return JIM_OK;
12285 /* [llength] */
12286 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12288 if (argc != 2) {
12289 Jim_WrongNumArgs(interp, 1, argv, "list");
12290 return JIM_ERR;
12292 Jim_SetResultInt(interp, Jim_ListLength(interp, argv[1]));
12293 return JIM_OK;
12296 /* [lsearch] */
12297 static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12299 static const char * const options[] = {
12300 "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
12301 NULL
12303 enum
12304 { OPT_BOOL, OPT_NOT, OPT_NOCASE, OPT_EXACT, OPT_GLOB, OPT_REGEXP, OPT_ALL, OPT_INLINE,
12305 OPT_COMMAND };
12306 int i;
12307 int opt_bool = 0;
12308 int opt_not = 0;
12309 int opt_all = 0;
12310 int opt_inline = 0;
12311 int opt_match = OPT_EXACT;
12312 int listlen;
12313 int rc = JIM_OK;
12314 Jim_Obj *listObjPtr = NULL;
12315 Jim_Obj *commandObj = NULL;
12316 int match_flags = 0;
12318 if (argc < 3) {
12319 wrongargs:
12320 Jim_WrongNumArgs(interp, 1, argv,
12321 "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
12322 return JIM_ERR;
12325 for (i = 1; i < argc - 2; i++) {
12326 int option;
12328 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG) != JIM_OK) {
12329 return JIM_ERR;
12331 switch (option) {
12332 case OPT_BOOL:
12333 opt_bool = 1;
12334 opt_inline = 0;
12335 break;
12336 case OPT_NOT:
12337 opt_not = 1;
12338 break;
12339 case OPT_NOCASE:
12340 match_flags |= JIM_NOCASE;
12341 break;
12342 case OPT_INLINE:
12343 opt_inline = 1;
12344 opt_bool = 0;
12345 break;
12346 case OPT_ALL:
12347 opt_all = 1;
12348 break;
12349 case OPT_REGEXP:
12350 opt_match = option;
12351 match_flags |= JIM_OPT_END;
12352 break;
12353 case OPT_COMMAND:
12354 if (i >= argc - 2) {
12355 goto wrongargs;
12357 commandObj = argv[++i];
12358 /* fallthru */
12359 case OPT_EXACT:
12360 case OPT_GLOB:
12361 opt_match = option;
12362 break;
12366 argc -= i;
12367 if (argc < 2) {
12368 goto wrongargs;
12370 argv += i;
12372 if (opt_all) {
12373 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12375 if (opt_match == OPT_REGEXP) {
12376 commandObj = Jim_NewStringObj(interp, "regexp", -1);
12378 if (commandObj) {
12379 Jim_IncrRefCount(commandObj);
12382 listlen = Jim_ListLength(interp, argv[0]);
12383 for (i = 0; i < listlen; i++) {
12384 int eq = 0;
12385 Jim_Obj *objPtr = Jim_ListGetIndex(interp, argv[0], i);
12387 switch (opt_match) {
12388 case OPT_EXACT:
12389 eq = Jim_StringCompareObj(interp, argv[1], objPtr, match_flags) == 0;
12390 break;
12392 case OPT_GLOB:
12393 eq = Jim_StringMatchObj(interp, argv[1], objPtr, match_flags);
12394 break;
12396 case OPT_REGEXP:
12397 case OPT_COMMAND:
12398 eq = Jim_CommandMatchObj(interp, commandObj, argv[1], objPtr, match_flags);
12399 if (eq < 0) {
12400 if (listObjPtr) {
12401 Jim_FreeNewObj(interp, listObjPtr);
12403 rc = JIM_ERR;
12404 goto done;
12406 break;
12409 /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
12410 if (!eq && opt_bool && opt_not && !opt_all) {
12411 continue;
12414 if ((!opt_bool && eq == !opt_not) || (opt_bool && (eq || opt_all))) {
12415 /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
12416 Jim_Obj *resultObj;
12418 if (opt_bool) {
12419 resultObj = Jim_NewIntObj(interp, eq ^ opt_not);
12421 else if (!opt_inline) {
12422 resultObj = Jim_NewIntObj(interp, i);
12424 else {
12425 resultObj = objPtr;
12428 if (opt_all) {
12429 Jim_ListAppendElement(interp, listObjPtr, resultObj);
12431 else {
12432 Jim_SetResult(interp, resultObj);
12433 goto done;
12438 if (opt_all) {
12439 Jim_SetResult(interp, listObjPtr);
12441 else {
12442 /* No match */
12443 if (opt_bool) {
12444 Jim_SetResultBool(interp, opt_not);
12446 else if (!opt_inline) {
12447 Jim_SetResultInt(interp, -1);
12451 done:
12452 if (commandObj) {
12453 Jim_DecrRefCount(interp, commandObj);
12455 return rc;
12458 /* [lappend] */
12459 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12461 Jim_Obj *listObjPtr;
12462 int new_obj = 0;
12463 int i;
12465 if (argc < 2) {
12466 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
12467 return JIM_ERR;
12469 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12470 if (!listObjPtr) {
12471 /* Create the list if it does not exist */
12472 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12473 new_obj = 1;
12475 else if (Jim_IsShared(listObjPtr)) {
12476 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
12477 new_obj = 1;
12479 for (i = 2; i < argc; i++)
12480 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
12481 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
12482 if (new_obj)
12483 Jim_FreeNewObj(interp, listObjPtr);
12484 return JIM_ERR;
12486 Jim_SetResult(interp, listObjPtr);
12487 return JIM_OK;
12490 /* [linsert] */
12491 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12493 int idx, len;
12494 Jim_Obj *listPtr;
12496 if (argc < 3) {
12497 Jim_WrongNumArgs(interp, 1, argv, "list index ?element ...?");
12498 return JIM_ERR;
12500 listPtr = argv[1];
12501 if (Jim_IsShared(listPtr))
12502 listPtr = Jim_DuplicateObj(interp, listPtr);
12503 if (Jim_GetIndex(interp, argv[2], &idx) != JIM_OK)
12504 goto err;
12505 len = Jim_ListLength(interp, listPtr);
12506 if (idx >= len)
12507 idx = len;
12508 else if (idx < 0)
12509 idx = len + idx + 1;
12510 Jim_ListInsertElements(interp, listPtr, idx, argc - 3, &argv[3]);
12511 Jim_SetResult(interp, listPtr);
12512 return JIM_OK;
12513 err:
12514 if (listPtr != argv[1]) {
12515 Jim_FreeNewObj(interp, listPtr);
12517 return JIM_ERR;
12520 /* [lreplace] */
12521 static int Jim_LreplaceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12523 int first, last, len, rangeLen;
12524 Jim_Obj *listObj;
12525 Jim_Obj *newListObj;
12527 if (argc < 4) {
12528 Jim_WrongNumArgs(interp, 1, argv, "list first last ?element ...?");
12529 return JIM_ERR;
12531 if (Jim_GetIndex(interp, argv[2], &first) != JIM_OK ||
12532 Jim_GetIndex(interp, argv[3], &last) != JIM_OK) {
12533 return JIM_ERR;
12536 listObj = argv[1];
12537 len = Jim_ListLength(interp, listObj);
12539 first = JimRelToAbsIndex(len, first);
12540 last = JimRelToAbsIndex(len, last);
12541 JimRelToAbsRange(len, &first, &last, &rangeLen);
12543 /* Now construct a new list which consists of:
12544 * <elements before first> <supplied elements> <elements after last>
12547 /* Trying to replace past the end of the list means end of list
12548 * See TIP #505
12550 if (first > len) {
12551 first = len;
12554 /* Add the first set of elements */
12555 newListObj = Jim_NewListObj(interp, listObj->internalRep.listValue.ele, first);
12557 /* Add supplied elements */
12558 ListInsertElements(newListObj, -1, argc - 4, argv + 4);
12560 /* Add the remaining elements */
12561 ListInsertElements(newListObj, -1, len - first - rangeLen, listObj->internalRep.listValue.ele + first + rangeLen);
12563 Jim_SetResult(interp, newListObj);
12564 return JIM_OK;
12567 /* [lset] */
12568 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12570 if (argc < 3) {
12571 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
12572 return JIM_ERR;
12574 else if (argc == 3) {
12575 /* With no indexes, simply implements [set] */
12576 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
12577 return JIM_ERR;
12578 Jim_SetResult(interp, argv[2]);
12579 return JIM_OK;
12581 return Jim_ListSetIndex(interp, argv[1], argv + 2, argc - 3, argv[argc - 1]);
12584 /* [lsort] */
12585 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
12587 static const char * const options[] = {
12588 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", NULL
12590 enum
12591 { OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_REAL, OPT_INDEX, OPT_UNIQUE };
12592 Jim_Obj *resObj;
12593 int i;
12594 int retCode;
12595 int shared;
12597 struct lsort_info info;
12599 if (argc < 2) {
12600 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
12601 return JIM_ERR;
12604 info.type = JIM_LSORT_ASCII;
12605 info.order = 1;
12606 info.indexed = 0;
12607 info.unique = 0;
12608 info.command = NULL;
12609 info.interp = interp;
12611 for (i = 1; i < (argc - 1); i++) {
12612 int option;
12614 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ENUM_ABBREV | JIM_ERRMSG)
12615 != JIM_OK)
12616 return JIM_ERR;
12617 switch (option) {
12618 case OPT_ASCII:
12619 info.type = JIM_LSORT_ASCII;
12620 break;
12621 case OPT_NOCASE:
12622 info.type = JIM_LSORT_NOCASE;
12623 break;
12624 case OPT_INTEGER:
12625 info.type = JIM_LSORT_INTEGER;
12626 break;
12627 case OPT_REAL:
12628 info.type = JIM_LSORT_REAL;
12629 break;
12630 case OPT_INCREASING:
12631 info.order = 1;
12632 break;
12633 case OPT_DECREASING:
12634 info.order = -1;
12635 break;
12636 case OPT_UNIQUE:
12637 info.unique = 1;
12638 break;
12639 case OPT_COMMAND:
12640 if (i >= (argc - 2)) {
12641 Jim_SetResultString(interp, "\"-command\" option must be followed by comparison command", -1);
12642 return JIM_ERR;
12644 info.type = JIM_LSORT_COMMAND;
12645 info.command = argv[i + 1];
12646 i++;
12647 break;
12648 case OPT_INDEX:
12649 if (i >= (argc - 2)) {
12650 Jim_SetResultString(interp, "\"-index\" option must be followed by list index", -1);
12651 return JIM_ERR;
12653 if (Jim_GetIndex(interp, argv[i + 1], &info.index) != JIM_OK) {
12654 return JIM_ERR;
12656 info.indexed = 1;
12657 i++;
12658 break;
12661 resObj = argv[argc - 1];
12662 if ((shared = Jim_IsShared(resObj)))
12663 resObj = Jim_DuplicateObj(interp, resObj);
12664 retCode = ListSortElements(interp, resObj, &info);
12665 if (retCode == JIM_OK) {
12666 Jim_SetResult(interp, resObj);
12668 else if (shared) {
12669 Jim_FreeNewObj(interp, resObj);
12671 return retCode;
12674 /* [append] */
12675 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12677 Jim_Obj *stringObjPtr;
12678 int i;
12680 if (argc < 2) {
12681 Jim_WrongNumArgs(interp, 1, argv, "varName ?value ...?");
12682 return JIM_ERR;
12684 if (argc == 2) {
12685 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
12686 if (!stringObjPtr)
12687 return JIM_ERR;
12689 else {
12690 int new_obj = 0;
12691 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12692 if (!stringObjPtr) {
12693 /* Create the string if it doesn't exist */
12694 stringObjPtr = Jim_NewEmptyStringObj(interp);
12695 new_obj = 1;
12697 else if (Jim_IsShared(stringObjPtr)) {
12698 new_obj = 1;
12699 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
12701 for (i = 2; i < argc; i++) {
12702 Jim_AppendObj(interp, stringObjPtr, argv[i]);
12704 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
12705 if (new_obj) {
12706 Jim_FreeNewObj(interp, stringObjPtr);
12708 return JIM_ERR;
12711 Jim_SetResult(interp, stringObjPtr);
12712 return JIM_OK;
12715 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12717 * Returns a zero-refcount list describing the expression at 'node'
12719 static Jim_Obj *JimGetExprAsList(Jim_Interp *interp, struct JimExprNode *node)
12721 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
12723 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, jim_tt_name(node->type), -1));
12724 if (TOKEN_IS_EXPR_OP(node->type)) {
12725 if (node->left) {
12726 Jim_ListAppendElement(interp, listObjPtr, JimGetExprAsList(interp, node->left));
12728 if (node->right) {
12729 Jim_ListAppendElement(interp, listObjPtr, JimGetExprAsList(interp, node->right));
12731 if (node->ternary) {
12732 Jim_ListAppendElement(interp, listObjPtr, JimGetExprAsList(interp, node->ternary));
12735 else {
12736 Jim_ListAppendElement(interp, listObjPtr, node->objPtr);
12738 return listObjPtr;
12740 #endif /* JIM_DEBUG_COMMAND && !JIM_BOOTSTRAP */
12742 /* [debug] */
12743 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12744 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12746 static const char * const options[] = {
12747 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
12748 "exprbc", "show",
12749 NULL
12751 enum
12753 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
12754 OPT_EXPRLEN, OPT_EXPRBC, OPT_SHOW,
12756 int option;
12758 if (argc < 2) {
12759 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?...?");
12760 return JIM_ERR;
12762 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK)
12763 return Jim_CheckShowCommands(interp, argv[1], options);
12764 if (option == OPT_REFCOUNT) {
12765 if (argc != 3) {
12766 Jim_WrongNumArgs(interp, 2, argv, "object");
12767 return JIM_ERR;
12769 Jim_SetResultInt(interp, argv[2]->refCount);
12770 return JIM_OK;
12772 else if (option == OPT_OBJCOUNT) {
12773 int freeobj = 0, liveobj = 0;
12774 char buf[256];
12775 Jim_Obj *objPtr;
12777 if (argc != 2) {
12778 Jim_WrongNumArgs(interp, 2, argv, "");
12779 return JIM_ERR;
12781 /* Count the number of free objects. */
12782 objPtr = interp->freeList;
12783 while (objPtr) {
12784 freeobj++;
12785 objPtr = objPtr->nextObjPtr;
12787 /* Count the number of live objects. */
12788 objPtr = interp->liveList;
12789 while (objPtr) {
12790 liveobj++;
12791 objPtr = objPtr->nextObjPtr;
12793 /* Set the result string and return. */
12794 sprintf(buf, "free %d used %d", freeobj, liveobj);
12795 Jim_SetResultString(interp, buf, -1);
12796 return JIM_OK;
12798 else if (option == OPT_OBJECTS) {
12799 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
12801 if (argc != 2) {
12802 Jim_WrongNumArgs(interp, 2, argv, "");
12803 return JIM_ERR;
12806 /* Count the number of live objects. */
12807 objPtr = interp->liveList;
12808 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12809 while (objPtr) {
12810 char buf[128];
12811 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "";
12813 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
12814 sprintf(buf, "%p", objPtr);
12815 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, buf, -1));
12816 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, type, -1));
12817 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewIntObj(interp, objPtr->refCount));
12818 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
12819 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
12820 objPtr = objPtr->nextObjPtr;
12822 Jim_SetResult(interp, listObjPtr);
12823 return JIM_OK;
12825 else if (option == OPT_INVSTR) {
12826 Jim_Obj *objPtr;
12828 if (argc != 3) {
12829 Jim_WrongNumArgs(interp, 2, argv, "object");
12830 return JIM_ERR;
12832 objPtr = argv[2];
12833 if (objPtr->typePtr != NULL)
12834 Jim_InvalidateStringRep(objPtr);
12835 Jim_SetEmptyResult(interp);
12836 return JIM_OK;
12838 else if (option == OPT_SHOW) {
12839 const char *s;
12840 int len, charlen;
12842 if (argc != 3) {
12843 Jim_WrongNumArgs(interp, 2, argv, "object");
12844 return JIM_ERR;
12846 s = Jim_GetString(argv[2], &len);
12847 #ifdef JIM_UTF8
12848 charlen = utf8_strlen(s, len);
12849 #else
12850 charlen = len;
12851 #endif
12852 char buf[256];
12853 snprintf(buf, sizeof(buf), "refcount: %d, type: %s\n"
12854 "chars (%d):",
12855 argv[2]->refCount, JimObjTypeName(argv[2]), charlen);
12856 Jim_SetResultFormatted(interp, "%s <<%s>>\n", buf, s);
12857 snprintf(buf, sizeof(buf), "bytes (%d):", len);
12858 Jim_AppendString(interp, Jim_GetResult(interp), buf, -1);
12859 while (len--) {
12860 snprintf(buf, sizeof(buf), " %02x", (unsigned char)*s++);
12861 Jim_AppendString(interp, Jim_GetResult(interp), buf, -1);
12863 return JIM_OK;
12865 else if (option == OPT_SCRIPTLEN) {
12866 ScriptObj *script;
12868 if (argc != 3) {
12869 Jim_WrongNumArgs(interp, 2, argv, "script");
12870 return JIM_ERR;
12872 script = JimGetScript(interp, argv[2]);
12873 if (script == NULL)
12874 return JIM_ERR;
12875 Jim_SetResultInt(interp, script->len);
12876 return JIM_OK;
12878 else if (option == OPT_EXPRLEN) {
12879 struct ExprTree *expr;
12881 if (argc != 3) {
12882 Jim_WrongNumArgs(interp, 2, argv, "expression");
12883 return JIM_ERR;
12885 expr = JimGetExpression(interp, argv[2]);
12886 if (expr == NULL)
12887 return JIM_ERR;
12888 Jim_SetResultInt(interp, expr->len);
12889 return JIM_OK;
12891 else if (option == OPT_EXPRBC) {
12892 struct ExprTree *expr;
12894 if (argc != 3) {
12895 Jim_WrongNumArgs(interp, 2, argv, "expression");
12896 return JIM_ERR;
12898 expr = JimGetExpression(interp, argv[2]);
12899 if (expr == NULL)
12900 return JIM_ERR;
12901 Jim_SetResult(interp, JimGetExprAsList(interp, expr->expr));
12902 return JIM_OK;
12904 else {
12905 Jim_SetResultString(interp,
12906 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
12907 return JIM_ERR;
12909 /* unreached */
12911 #endif /* JIM_DEBUG_COMMAND && !JIM_BOOTSTRAP */
12913 /* [eval] */
12914 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12916 int rc;
12918 if (argc < 2) {
12919 Jim_WrongNumArgs(interp, 1, argv, "arg ?arg ...?");
12920 return JIM_ERR;
12923 if (argc == 2) {
12924 rc = Jim_EvalObj(interp, argv[1]);
12926 else {
12927 rc = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12930 if (rc == JIM_ERR) {
12931 /* eval is "interesting", so add a stack frame here */
12932 interp->addStackTrace++;
12934 return rc;
12937 /* [uplevel] */
12938 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12940 if (argc >= 2) {
12941 int retcode;
12942 Jim_CallFrame *savedCallFrame, *targetCallFrame;
12943 const char *str;
12945 /* Save the old callframe pointer */
12946 savedCallFrame = interp->framePtr;
12948 /* Lookup the target frame pointer */
12949 str = Jim_String(argv[1]);
12950 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#') {
12951 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
12952 argc--;
12953 argv++;
12955 else {
12956 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
12958 if (targetCallFrame == NULL) {
12959 return JIM_ERR;
12961 if (argc < 2) {
12962 Jim_WrongNumArgs(interp, 1, argv - 1, "?level? command ?arg ...?");
12963 return JIM_ERR;
12965 /* Eval the code in the target callframe. */
12966 interp->framePtr = targetCallFrame;
12967 if (argc == 2) {
12968 retcode = Jim_EvalObj(interp, argv[1]);
12970 else {
12971 retcode = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12973 interp->framePtr = savedCallFrame;
12974 return retcode;
12976 else {
12977 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
12978 return JIM_ERR;
12982 /* [expr] */
12983 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12985 int retcode;
12987 if (argc == 2) {
12988 retcode = Jim_EvalExpression(interp, argv[1]);
12990 else if (argc > 2) {
12991 Jim_Obj *objPtr;
12993 objPtr = Jim_ConcatObj(interp, argc - 1, argv + 1);
12994 Jim_IncrRefCount(objPtr);
12995 retcode = Jim_EvalExpression(interp, objPtr);
12996 Jim_DecrRefCount(interp, objPtr);
12998 else {
12999 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
13000 return JIM_ERR;
13002 if (retcode != JIM_OK)
13003 return retcode;
13004 return JIM_OK;
13007 /* [break] */
13008 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13010 if (argc != 1) {
13011 Jim_WrongNumArgs(interp, 1, argv, "");
13012 return JIM_ERR;
13014 return JIM_BREAK;
13017 /* [continue] */
13018 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13020 if (argc != 1) {
13021 Jim_WrongNumArgs(interp, 1, argv, "");
13022 return JIM_ERR;
13024 return JIM_CONTINUE;
13027 /* [return] */
13028 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13030 int i;
13031 Jim_Obj *stackTraceObj = NULL;
13032 Jim_Obj *errorCodeObj = NULL;
13033 int returnCode = JIM_OK;
13034 long level = 1;
13036 for (i = 1; i < argc - 1; i += 2) {
13037 if (Jim_CompareStringImmediate(interp, argv[i], "-code")) {
13038 if (Jim_GetReturnCode(interp, argv[i + 1], &returnCode) == JIM_ERR) {
13039 return JIM_ERR;
13042 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorinfo")) {
13043 stackTraceObj = argv[i + 1];
13045 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorcode")) {
13046 errorCodeObj = argv[i + 1];
13048 else if (Jim_CompareStringImmediate(interp, argv[i], "-level")) {
13049 if (Jim_GetLong(interp, argv[i + 1], &level) != JIM_OK || level < 0) {
13050 Jim_SetResultFormatted(interp, "bad level \"%#s\"", argv[i + 1]);
13051 return JIM_ERR;
13054 else {
13055 break;
13059 if (i != argc - 1 && i != argc) {
13060 Jim_WrongNumArgs(interp, 1, argv,
13061 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
13064 /* If a stack trace is supplied and code is error, set the stack trace */
13065 if (stackTraceObj && returnCode == JIM_ERR) {
13066 JimSetStackTrace(interp, stackTraceObj);
13068 /* If an error code list is supplied, set the global $errorCode */
13069 if (errorCodeObj && returnCode == JIM_ERR) {
13070 Jim_SetGlobalVariableStr(interp, "errorCode", errorCodeObj);
13072 interp->returnCode = returnCode;
13073 interp->returnLevel = level;
13075 if (i == argc - 1) {
13076 Jim_SetResult(interp, argv[i]);
13078 return level == 0 ? returnCode : JIM_RETURN;
13081 /* [tailcall] */
13082 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13084 if (interp->framePtr->level == 0) {
13085 Jim_SetResultString(interp, "tailcall can only be called from a proc or lambda", -1);
13086 return JIM_ERR;
13088 else if (argc >= 2) {
13089 /* Need to resolve the tailcall command in the current context */
13090 Jim_CallFrame *cf = interp->framePtr->parent;
13092 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13093 if (cmdPtr == NULL) {
13094 return JIM_ERR;
13097 JimPanic((cf->tailcallCmd != NULL, "Already have a tailcallCmd"));
13099 /* And stash this pre-resolved command */
13100 JimIncrCmdRefCount(cmdPtr);
13101 cf->tailcallCmd = cmdPtr;
13103 /* And stash the command list */
13104 JimPanic((cf->tailcallObj != NULL, "Already have a tailcallobj"));
13106 cf->tailcallObj = Jim_NewListObj(interp, argv + 1, argc - 1);
13107 Jim_IncrRefCount(cf->tailcallObj);
13109 /* When the stack unwinds to the previous proc, the stashed command will be evaluated */
13110 return JIM_EVAL;
13112 return JIM_OK;
13115 static int JimAliasCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13117 Jim_Obj *cmdList;
13118 Jim_Obj *prefixListObj = Jim_CmdPrivData(interp);
13120 /* prefixListObj is a list to which the args need to be appended */
13121 cmdList = Jim_DuplicateObj(interp, prefixListObj);
13122 Jim_ListInsertElements(interp, cmdList, Jim_ListLength(interp, cmdList), argc - 1, argv + 1);
13124 return JimEvalObjList(interp, cmdList);
13127 static void JimAliasCmdDelete(Jim_Interp *interp, void *privData)
13129 Jim_Obj *prefixListObj = privData;
13130 Jim_DecrRefCount(interp, prefixListObj);
13133 static int Jim_AliasCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13135 Jim_Obj *prefixListObj;
13137 if (argc < 3) {
13138 Jim_WrongNumArgs(interp, 1, argv, "newname command ?args ...?");
13139 return JIM_ERR;
13142 prefixListObj = Jim_NewListObj(interp, argv + 2, argc - 2);
13143 Jim_IncrRefCount(prefixListObj);
13144 Jim_SetResult(interp, argv[1]);
13146 return Jim_CreateCommandObj(interp, argv[1], JimAliasCmd, prefixListObj, JimAliasCmdDelete);
13149 /* [proc] */
13150 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13152 Jim_Cmd *cmd;
13154 if (argc != 4 && argc != 5) {
13155 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
13156 return JIM_ERR;
13159 if (argc == 4) {
13160 cmd = JimCreateProcedureCmd(interp, argv[2], NULL, argv[3], NULL);
13162 else {
13163 cmd = JimCreateProcedureCmd(interp, argv[2], argv[3], argv[4], NULL);
13166 if (cmd) {
13167 /* Add the new command */
13168 Jim_Obj *nameObjPtr = JimQualifyName(interp, argv[1]);
13169 JimCreateCommand(interp, nameObjPtr, cmd);
13171 /* Calculate and set the namespace for this proc */
13172 JimUpdateProcNamespace(interp, cmd, nameObjPtr);
13173 Jim_DecrRefCount(interp, nameObjPtr);
13175 /* Unlike Tcl, set the name of the proc as the result */
13176 Jim_SetResult(interp, argv[1]);
13177 return JIM_OK;
13179 return JIM_ERR;
13182 /* [local] */
13183 static int Jim_LocalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13185 int retcode;
13187 if (argc < 2) {
13188 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13189 return JIM_ERR;
13192 /* Evaluate the arguments with 'local' in force */
13193 interp->local++;
13194 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13195 interp->local--;
13198 /* If OK, and the result is a proc, add it to the list of local procs */
13199 if (retcode == 0) {
13200 Jim_Obj *cmdNameObj = Jim_GetResult(interp);
13202 if (Jim_GetCommand(interp, cmdNameObj, JIM_ERRMSG) == NULL) {
13203 return JIM_ERR;
13205 if (interp->framePtr->localCommands == NULL) {
13206 interp->framePtr->localCommands = Jim_Alloc(sizeof(*interp->framePtr->localCommands));
13207 Jim_InitStack(interp->framePtr->localCommands);
13209 Jim_IncrRefCount(cmdNameObj);
13210 Jim_StackPush(interp->framePtr->localCommands, cmdNameObj);
13213 return retcode;
13216 /* [upcall] */
13217 static int Jim_UpcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13219 if (argc < 2) {
13220 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13221 return JIM_ERR;
13223 else {
13224 int retcode;
13226 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13227 if (cmdPtr == NULL || !cmdPtr->isproc || !cmdPtr->prevCmd) {
13228 Jim_SetResultFormatted(interp, "no previous command: \"%#s\"", argv[1]);
13229 return JIM_ERR;
13231 /* OK. Mark this command as being in an upcall */
13232 cmdPtr->u.proc.upcall++;
13233 JimIncrCmdRefCount(cmdPtr);
13235 /* Invoke the command as normal */
13236 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13238 /* No longer in an upcall */
13239 cmdPtr->u.proc.upcall--;
13240 JimDecrCmdRefCount(interp, cmdPtr);
13242 return retcode;
13246 /* [apply] */
13247 static int Jim_ApplyCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13249 if (argc < 2) {
13250 Jim_WrongNumArgs(interp, 1, argv, "lambdaExpr ?arg ...?");
13251 return JIM_ERR;
13253 else {
13254 int ret;
13255 Jim_Cmd *cmd;
13256 Jim_Obj *argListObjPtr;
13257 Jim_Obj *bodyObjPtr;
13258 Jim_Obj *nsObj = NULL;
13259 Jim_Obj **nargv;
13261 int len = Jim_ListLength(interp, argv[1]);
13262 if (len != 2 && len != 3) {
13263 Jim_SetResultFormatted(interp, "can't interpret \"%#s\" as a lambda expression", argv[1]);
13264 return JIM_ERR;
13267 if (len == 3) {
13268 #ifdef jim_ext_namespace
13269 /* Note that the namespace is always treated as global */
13270 nsObj = Jim_ListGetIndex(interp, argv[1], 2);
13271 #else
13272 Jim_SetResultString(interp, "namespaces not enabled", -1);
13273 return JIM_ERR;
13274 #endif
13276 argListObjPtr = Jim_ListGetIndex(interp, argv[1], 0);
13277 bodyObjPtr = Jim_ListGetIndex(interp, argv[1], 1);
13279 cmd = JimCreateProcedureCmd(interp, argListObjPtr, NULL, bodyObjPtr, nsObj);
13281 if (cmd) {
13282 /* Create a new argv array with a dummy argv[0], for error messages */
13283 nargv = Jim_Alloc((argc - 2 + 1) * sizeof(*nargv));
13284 nargv[0] = Jim_NewStringObj(interp, "apply lambdaExpr", -1);
13285 Jim_IncrRefCount(nargv[0]);
13286 memcpy(&nargv[1], argv + 2, (argc - 2) * sizeof(*nargv));
13287 ret = JimCallProcedure(interp, cmd, argc - 2 + 1, nargv);
13288 Jim_DecrRefCount(interp, nargv[0]);
13289 Jim_Free(nargv);
13291 JimDecrCmdRefCount(interp, cmd);
13292 return ret;
13294 return JIM_ERR;
13299 /* [concat] */
13300 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13302 Jim_SetResult(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13303 return JIM_OK;
13306 /* [upvar] */
13307 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13309 int i;
13310 Jim_CallFrame *targetCallFrame;
13312 /* Lookup the target frame pointer */
13313 if (argc > 3 && (argc % 2 == 0)) {
13314 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
13315 argc--;
13316 argv++;
13318 else {
13319 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
13321 if (targetCallFrame == NULL) {
13322 return JIM_ERR;
13325 /* Check for arity */
13326 if (argc < 3) {
13327 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
13328 return JIM_ERR;
13331 /* Now... for every other/local couple: */
13332 for (i = 1; i < argc; i += 2) {
13333 if (Jim_SetVariableLink(interp, argv[i + 1], argv[i], targetCallFrame) != JIM_OK)
13334 return JIM_ERR;
13336 return JIM_OK;
13339 /* [global] */
13340 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13342 int i;
13344 if (argc < 2) {
13345 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
13346 return JIM_ERR;
13348 /* Link every var to the toplevel having the same name */
13349 if (interp->framePtr->level == 0)
13350 return JIM_OK; /* global at toplevel... */
13351 for (i = 1; i < argc; i++) {
13352 /* global ::blah does nothing */
13353 const char *name = Jim_String(argv[i]);
13354 if (name[0] != ':' || name[1] != ':') {
13355 if (Jim_SetVariableLink(interp, argv[i], argv[i], interp->topFramePtr) != JIM_OK)
13356 return JIM_ERR;
13359 return JIM_OK;
13362 /* does the [string map] operation. On error NULL is returned,
13363 * otherwise a new string object with the result, having refcount = 0,
13364 * is returned. */
13365 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
13366 Jim_Obj *objPtr, int nocase)
13368 int numMaps;
13369 const char *str, *noMatchStart = NULL;
13370 int strLen, i;
13371 Jim_Obj *resultObjPtr;
13373 numMaps = Jim_ListLength(interp, mapListObjPtr);
13374 if (numMaps % 2) {
13375 Jim_SetResultString(interp, "list must contain an even number of elements", -1);
13376 return NULL;
13379 str = Jim_String(objPtr);
13380 strLen = Jim_Utf8Length(interp, objPtr);
13382 /* Map it */
13383 resultObjPtr = Jim_NewStringObj(interp, "", 0);
13384 while (strLen) {
13385 for (i = 0; i < numMaps; i += 2) {
13386 Jim_Obj *eachObjPtr;
13387 const char *k;
13388 int kl;
13390 eachObjPtr = Jim_ListGetIndex(interp, mapListObjPtr, i);
13391 k = Jim_String(eachObjPtr);
13392 kl = Jim_Utf8Length(interp, eachObjPtr);
13394 if (strLen >= kl && kl) {
13395 int rc;
13396 rc = JimStringCompareUtf8(str, kl, k, kl, nocase);
13397 if (rc == 0) {
13398 if (noMatchStart) {
13399 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13400 noMatchStart = NULL;
13402 Jim_AppendObj(interp, resultObjPtr, Jim_ListGetIndex(interp, mapListObjPtr, i + 1));
13403 str += utf8_index(str, kl);
13404 strLen -= kl;
13405 break;
13409 if (i == numMaps) { /* no match */
13410 int c;
13411 if (noMatchStart == NULL)
13412 noMatchStart = str;
13413 str += utf8_tounicode(str, &c);
13414 strLen--;
13417 if (noMatchStart) {
13418 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13420 return resultObjPtr;
13423 /* [string] */
13424 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13426 int len;
13427 int opt_case = 1;
13428 int option;
13429 static const char * const options[] = {
13430 "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "replace",
13431 "map", "repeat", "reverse", "index", "first", "last", "cat",
13432 "trim", "trimleft", "trimright", "tolower", "toupper", "totitle", NULL
13434 enum
13436 OPT_BYTELENGTH, OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_IS, OPT_BYTERANGE, OPT_RANGE, OPT_REPLACE,
13437 OPT_MAP, OPT_REPEAT, OPT_REVERSE, OPT_INDEX, OPT_FIRST, OPT_LAST, OPT_CAT,
13438 OPT_TRIM, OPT_TRIMLEFT, OPT_TRIMRIGHT, OPT_TOLOWER, OPT_TOUPPER, OPT_TOTITLE
13440 static const char * const nocase_options[] = {
13441 "-nocase", NULL
13443 static const char * const nocase_length_options[] = {
13444 "-nocase", "-length", NULL
13447 if (argc < 2) {
13448 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
13449 return JIM_ERR;
13451 if (Jim_GetEnum(interp, argv[1], options, &option, NULL,
13452 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK)
13453 return Jim_CheckShowCommands(interp, argv[1], options);
13455 switch (option) {
13456 case OPT_LENGTH:
13457 case OPT_BYTELENGTH:
13458 if (argc != 3) {
13459 Jim_WrongNumArgs(interp, 2, argv, "string");
13460 return JIM_ERR;
13462 if (option == OPT_LENGTH) {
13463 len = Jim_Utf8Length(interp, argv[2]);
13465 else {
13466 len = Jim_Length(argv[2]);
13468 Jim_SetResultInt(interp, len);
13469 return JIM_OK;
13471 case OPT_CAT:{
13472 Jim_Obj *objPtr;
13473 if (argc == 3) {
13474 /* optimise the one-arg case */
13475 objPtr = argv[2];
13477 else {
13478 int i;
13480 objPtr = Jim_NewStringObj(interp, "", 0);
13482 for (i = 2; i < argc; i++) {
13483 Jim_AppendObj(interp, objPtr, argv[i]);
13486 Jim_SetResult(interp, objPtr);
13487 return JIM_OK;
13490 case OPT_COMPARE:
13491 case OPT_EQUAL:
13493 /* n is the number of remaining option args */
13494 long opt_length = -1;
13495 int n = argc - 4;
13496 int i = 2;
13497 while (n > 0) {
13498 int subopt;
13499 if (Jim_GetEnum(interp, argv[i++], nocase_length_options, &subopt, NULL,
13500 JIM_ENUM_ABBREV) != JIM_OK) {
13501 badcompareargs:
13502 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? ?-length int? string1 string2");
13503 return JIM_ERR;
13505 if (subopt == 0) {
13506 /* -nocase */
13507 opt_case = 0;
13508 n--;
13510 else {
13511 /* -length */
13512 if (n < 2) {
13513 goto badcompareargs;
13515 if (Jim_GetLong(interp, argv[i++], &opt_length) != JIM_OK) {
13516 return JIM_ERR;
13518 n -= 2;
13521 if (n) {
13522 goto badcompareargs;
13524 argv += argc - 2;
13525 if (opt_length < 0 && option != OPT_COMPARE && opt_case) {
13526 /* Fast version - [string equal], case sensitive, no length */
13527 Jim_SetResultBool(interp, Jim_StringEqObj(argv[0], argv[1]));
13529 else {
13530 const char *s1 = Jim_String(argv[0]);
13531 int l1 = Jim_Utf8Length(interp, argv[0]);
13532 const char *s2 = Jim_String(argv[1]);
13533 int l2 = Jim_Utf8Length(interp, argv[1]);
13534 if (opt_length >= 0) {
13535 if (l1 > opt_length) {
13536 l1 = opt_length;
13538 if (l2 > opt_length) {
13539 l2 = opt_length;
13542 n = JimStringCompareUtf8(s1, l1, s2, l2, !opt_case);
13543 Jim_SetResultInt(interp, option == OPT_COMPARE ? n : n == 0);
13545 return JIM_OK;
13548 case OPT_MATCH:
13549 if (argc != 4 &&
13550 (argc != 5 ||
13551 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13552 JIM_ENUM_ABBREV) != JIM_OK)) {
13553 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern string");
13554 return JIM_ERR;
13556 if (opt_case == 0) {
13557 argv++;
13559 Jim_SetResultBool(interp, Jim_StringMatchObj(interp, argv[2], argv[3], !opt_case));
13560 return JIM_OK;
13562 case OPT_MAP:{
13563 Jim_Obj *objPtr;
13565 if (argc != 4 &&
13566 (argc != 5 ||
13567 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13568 JIM_ENUM_ABBREV) != JIM_OK)) {
13569 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList string");
13570 return JIM_ERR;
13573 if (opt_case == 0) {
13574 argv++;
13576 objPtr = JimStringMap(interp, argv[2], argv[3], !opt_case);
13577 if (objPtr == NULL) {
13578 return JIM_ERR;
13580 Jim_SetResult(interp, objPtr);
13581 return JIM_OK;
13584 case OPT_RANGE:
13585 case OPT_BYTERANGE:{
13586 Jim_Obj *objPtr;
13588 if (argc != 5) {
13589 Jim_WrongNumArgs(interp, 2, argv, "string first last");
13590 return JIM_ERR;
13592 if (option == OPT_RANGE) {
13593 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
13595 else
13597 objPtr = Jim_StringByteRangeObj(interp, argv[2], argv[3], argv[4]);
13600 if (objPtr == NULL) {
13601 return JIM_ERR;
13603 Jim_SetResult(interp, objPtr);
13604 return JIM_OK;
13607 case OPT_REPLACE:{
13608 Jim_Obj *objPtr;
13610 if (argc != 5 && argc != 6) {
13611 Jim_WrongNumArgs(interp, 2, argv, "string first last ?string?");
13612 return JIM_ERR;
13614 objPtr = JimStringReplaceObj(interp, argv[2], argv[3], argv[4], argc == 6 ? argv[5] : NULL);
13615 if (objPtr == NULL) {
13616 return JIM_ERR;
13618 Jim_SetResult(interp, objPtr);
13619 return JIM_OK;
13623 case OPT_REPEAT:{
13624 Jim_Obj *objPtr;
13625 jim_wide count;
13627 if (argc != 4) {
13628 Jim_WrongNumArgs(interp, 2, argv, "string count");
13629 return JIM_ERR;
13631 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK) {
13632 return JIM_ERR;
13634 objPtr = Jim_NewStringObj(interp, "", 0);
13635 if (count > 0) {
13636 while (count--) {
13637 Jim_AppendObj(interp, objPtr, argv[2]);
13640 Jim_SetResult(interp, objPtr);
13641 return JIM_OK;
13644 case OPT_REVERSE:{
13645 char *buf, *p;
13646 const char *str;
13647 int i;
13649 if (argc != 3) {
13650 Jim_WrongNumArgs(interp, 2, argv, "string");
13651 return JIM_ERR;
13654 str = Jim_GetString(argv[2], &len);
13655 buf = Jim_Alloc(len + 1);
13656 p = buf + len;
13657 *p = 0;
13658 for (i = 0; i < len; ) {
13659 int c;
13660 int l = utf8_tounicode(str, &c);
13661 memcpy(p - l, str, l);
13662 p -= l;
13663 i += l;
13664 str += l;
13666 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
13667 return JIM_OK;
13670 case OPT_INDEX:{
13671 int idx;
13672 const char *str;
13674 if (argc != 4) {
13675 Jim_WrongNumArgs(interp, 2, argv, "string index");
13676 return JIM_ERR;
13678 if (Jim_GetIndex(interp, argv[3], &idx) != JIM_OK) {
13679 return JIM_ERR;
13681 str = Jim_String(argv[2]);
13682 len = Jim_Utf8Length(interp, argv[2]);
13683 if (idx != INT_MIN && idx != INT_MAX) {
13684 idx = JimRelToAbsIndex(len, idx);
13686 if (idx < 0 || idx >= len || str == NULL) {
13687 Jim_SetResultString(interp, "", 0);
13689 else if (len == Jim_Length(argv[2])) {
13690 /* ASCII optimisation */
13691 Jim_SetResultString(interp, str + idx, 1);
13693 else {
13694 int c;
13695 int i = utf8_index(str, idx);
13696 Jim_SetResultString(interp, str + i, utf8_tounicode(str + i, &c));
13698 return JIM_OK;
13701 case OPT_FIRST:
13702 case OPT_LAST:{
13703 int idx = 0, l1, l2;
13704 const char *s1, *s2;
13706 if (argc != 4 && argc != 5) {
13707 Jim_WrongNumArgs(interp, 2, argv, "subString string ?index?");
13708 return JIM_ERR;
13710 s1 = Jim_String(argv[2]);
13711 s2 = Jim_String(argv[3]);
13712 l1 = Jim_Utf8Length(interp, argv[2]);
13713 l2 = Jim_Utf8Length(interp, argv[3]);
13714 if (argc == 5) {
13715 if (Jim_GetIndex(interp, argv[4], &idx) != JIM_OK) {
13716 return JIM_ERR;
13718 idx = JimRelToAbsIndex(l2, idx);
13720 else if (option == OPT_LAST) {
13721 idx = l2;
13723 if (option == OPT_FIRST) {
13724 Jim_SetResultInt(interp, JimStringFirst(s1, l1, s2, l2, idx));
13726 else {
13727 #ifdef JIM_UTF8
13728 Jim_SetResultInt(interp, JimStringLastUtf8(s1, l1, s2, idx));
13729 #else
13730 Jim_SetResultInt(interp, JimStringLast(s1, l1, s2, idx));
13731 #endif
13733 return JIM_OK;
13736 case OPT_TRIM:
13737 case OPT_TRIMLEFT:
13738 case OPT_TRIMRIGHT:{
13739 Jim_Obj *trimchars;
13741 if (argc != 3 && argc != 4) {
13742 Jim_WrongNumArgs(interp, 2, argv, "string ?trimchars?");
13743 return JIM_ERR;
13745 trimchars = (argc == 4 ? argv[3] : NULL);
13746 if (option == OPT_TRIM) {
13747 Jim_SetResult(interp, JimStringTrim(interp, argv[2], trimchars));
13749 else if (option == OPT_TRIMLEFT) {
13750 Jim_SetResult(interp, JimStringTrimLeft(interp, argv[2], trimchars));
13752 else if (option == OPT_TRIMRIGHT) {
13753 Jim_SetResult(interp, JimStringTrimRight(interp, argv[2], trimchars));
13755 return JIM_OK;
13758 case OPT_TOLOWER:
13759 case OPT_TOUPPER:
13760 case OPT_TOTITLE:
13761 if (argc != 3) {
13762 Jim_WrongNumArgs(interp, 2, argv, "string");
13763 return JIM_ERR;
13765 if (option == OPT_TOLOWER) {
13766 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
13768 else if (option == OPT_TOUPPER) {
13769 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
13771 else {
13772 Jim_SetResult(interp, JimStringToTitle(interp, argv[2]));
13774 return JIM_OK;
13776 case OPT_IS:
13777 if (argc == 4 || (argc == 5 && Jim_CompareStringImmediate(interp, argv[3], "-strict"))) {
13778 return JimStringIs(interp, argv[argc - 1], argv[2], argc == 5);
13780 Jim_WrongNumArgs(interp, 2, argv, "class ?-strict? str");
13781 return JIM_ERR;
13783 return JIM_OK;
13786 /* [time] */
13787 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13789 long i, count = 1;
13790 jim_wide start, elapsed;
13791 char buf[60];
13792 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
13794 if (argc < 2) {
13795 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
13796 return JIM_ERR;
13798 if (argc == 3) {
13799 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
13800 return JIM_ERR;
13802 if (count < 0)
13803 return JIM_OK;
13804 i = count;
13805 start = JimClock();
13806 while (i-- > 0) {
13807 int retval;
13809 retval = Jim_EvalObj(interp, argv[1]);
13810 if (retval != JIM_OK) {
13811 return retval;
13814 elapsed = JimClock() - start;
13815 sprintf(buf, fmt, count == 0 ? 0 : elapsed / count);
13816 Jim_SetResultString(interp, buf, -1);
13817 return JIM_OK;
13820 /* [exit] */
13821 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13823 long exitCode = 0;
13825 if (argc > 2) {
13826 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
13827 return JIM_ERR;
13829 if (argc == 2) {
13830 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
13831 return JIM_ERR;
13832 Jim_SetResult(interp, argv[1]);
13834 interp->exitCode = exitCode;
13835 return JIM_EXIT;
13838 /* [catch] */
13839 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13841 int exitCode = 0;
13842 int i;
13843 int sig = 0;
13845 /* Which return codes are ignored (passed through)? By default, only exit, eval and signal */
13846 jim_wide ignore_mask = (1 << JIM_EXIT) | (1 << JIM_EVAL) | (1 << JIM_SIGNAL);
13847 static const int max_ignore_code = sizeof(ignore_mask) * 8;
13849 /* Reset the error code before catch.
13850 * Note that this is not strictly correct.
13852 Jim_SetGlobalVariableStr(interp, "errorCode", Jim_NewStringObj(interp, "NONE", -1));
13854 for (i = 1; i < argc - 1; i++) {
13855 const char *arg = Jim_String(argv[i]);
13856 jim_wide option;
13857 int ignore;
13859 /* It's a pity we can't use Jim_GetEnum here :-( */
13860 if (strcmp(arg, "--") == 0) {
13861 i++;
13862 break;
13864 if (*arg != '-') {
13865 break;
13868 if (strncmp(arg, "-no", 3) == 0) {
13869 arg += 3;
13870 ignore = 1;
13872 else {
13873 arg++;
13874 ignore = 0;
13877 if (Jim_StringToWide(arg, &option, 10) != JIM_OK) {
13878 option = -1;
13880 if (option < 0) {
13881 option = Jim_FindByName(arg, jimReturnCodes, jimReturnCodesSize);
13883 if (option < 0) {
13884 goto wrongargs;
13887 if (ignore) {
13888 ignore_mask |= ((jim_wide)1 << option);
13890 else {
13891 ignore_mask &= (~((jim_wide)1 << option));
13895 argc -= i;
13896 if (argc < 1 || argc > 3) {
13897 wrongargs:
13898 Jim_WrongNumArgs(interp, 1, argv,
13899 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
13900 return JIM_ERR;
13902 argv += i;
13904 if ((ignore_mask & (1 << JIM_SIGNAL)) == 0) {
13905 sig++;
13908 interp->signal_level += sig;
13909 if (Jim_CheckSignal(interp)) {
13910 /* If a signal is set, don't even try to execute the body */
13911 exitCode = JIM_SIGNAL;
13913 else {
13914 exitCode = Jim_EvalObj(interp, argv[0]);
13915 /* Don't want any caught error included in a later stack trace */
13916 interp->errorFlag = 0;
13918 interp->signal_level -= sig;
13920 /* Catch or pass through? Only the first 32/64 codes can be passed through */
13921 if (exitCode >= 0 && exitCode < max_ignore_code && (((unsigned jim_wide)1 << exitCode) & ignore_mask)) {
13922 /* Not caught, pass it up */
13923 return exitCode;
13926 if (sig && exitCode == JIM_SIGNAL) {
13927 /* Catch the signal at this level */
13928 if (interp->signal_set_result) {
13929 interp->signal_set_result(interp, interp->sigmask);
13931 else {
13932 Jim_SetResultInt(interp, interp->sigmask);
13934 interp->sigmask = 0;
13937 if (argc >= 2) {
13938 if (Jim_SetVariable(interp, argv[1], Jim_GetResult(interp)) != JIM_OK) {
13939 return JIM_ERR;
13941 if (argc == 3) {
13942 Jim_Obj *optListObj = Jim_NewListObj(interp, NULL, 0);
13944 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-code", -1));
13945 Jim_ListAppendElement(interp, optListObj,
13946 Jim_NewIntObj(interp, exitCode == JIM_RETURN ? interp->returnCode : exitCode));
13947 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-level", -1));
13948 Jim_ListAppendElement(interp, optListObj, Jim_NewIntObj(interp, interp->returnLevel));
13949 if (exitCode == JIM_ERR) {
13950 Jim_Obj *errorCode;
13951 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorinfo",
13952 -1));
13953 Jim_ListAppendElement(interp, optListObj, interp->stackTrace);
13955 errorCode = Jim_GetGlobalVariableStr(interp, "errorCode", JIM_NONE);
13956 if (errorCode) {
13957 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorcode", -1));
13958 Jim_ListAppendElement(interp, optListObj, errorCode);
13961 if (Jim_SetVariable(interp, argv[2], optListObj) != JIM_OK) {
13962 return JIM_ERR;
13966 Jim_SetResultInt(interp, exitCode);
13967 return JIM_OK;
13970 #if defined(JIM_REFERENCES) && !defined(JIM_BOOTSTRAP)
13972 /* [ref] */
13973 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13975 if (argc != 3 && argc != 4) {
13976 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
13977 return JIM_ERR;
13979 if (argc == 3) {
13980 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
13982 else {
13983 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], argv[3]));
13985 return JIM_OK;
13988 /* [getref] */
13989 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13991 Jim_Reference *refPtr;
13993 if (argc != 2) {
13994 Jim_WrongNumArgs(interp, 1, argv, "reference");
13995 return JIM_ERR;
13997 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
13998 return JIM_ERR;
13999 Jim_SetResult(interp, refPtr->objPtr);
14000 return JIM_OK;
14003 /* [setref] */
14004 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14006 Jim_Reference *refPtr;
14008 if (argc != 3) {
14009 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
14010 return JIM_ERR;
14012 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
14013 return JIM_ERR;
14014 Jim_IncrRefCount(argv[2]);
14015 Jim_DecrRefCount(interp, refPtr->objPtr);
14016 refPtr->objPtr = argv[2];
14017 Jim_SetResult(interp, argv[2]);
14018 return JIM_OK;
14021 /* [collect] */
14022 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14024 if (argc != 1) {
14025 Jim_WrongNumArgs(interp, 1, argv, "");
14026 return JIM_ERR;
14028 Jim_SetResultInt(interp, Jim_Collect(interp));
14030 /* Free all the freed objects. */
14031 while (interp->freeList) {
14032 Jim_Obj *nextObjPtr = interp->freeList->nextObjPtr;
14033 Jim_Free(interp->freeList);
14034 interp->freeList = nextObjPtr;
14037 return JIM_OK;
14040 /* [finalize] reference ?newValue? */
14041 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14043 if (argc != 2 && argc != 3) {
14044 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
14045 return JIM_ERR;
14047 if (argc == 2) {
14048 Jim_Obj *cmdNamePtr;
14050 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
14051 return JIM_ERR;
14052 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
14053 Jim_SetResult(interp, cmdNamePtr);
14055 else {
14056 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
14057 return JIM_ERR;
14058 Jim_SetResult(interp, argv[2]);
14060 return JIM_OK;
14063 /* [info references] */
14064 static int JimInfoReferences(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14066 Jim_Obj *listObjPtr;
14067 Jim_HashTableIterator htiter;
14068 Jim_HashEntry *he;
14070 listObjPtr = Jim_NewListObj(interp, NULL, 0);
14072 JimInitHashTableIterator(&interp->references, &htiter);
14073 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14074 char buf[JIM_REFERENCE_SPACE + 1];
14075 Jim_Reference *refPtr = Jim_GetHashEntryVal(he);
14076 const unsigned long *refId = he->key;
14078 JimFormatReference(buf, refPtr, *refId);
14079 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, buf, -1));
14081 Jim_SetResult(interp, listObjPtr);
14082 return JIM_OK;
14084 #endif /* JIM_REFERENCES && !JIM_BOOTSTRAP */
14086 /* [rename] */
14087 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14089 if (argc != 3) {
14090 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
14091 return JIM_ERR;
14094 return Jim_RenameCommand(interp, argv[1], argv[2]);
14097 #define JIM_DICTMATCH_KEYS 0x0001
14098 #define JIM_DICTMATCH_VALUES 0x002
14101 * match_type must be one of JIM_DICTMATCH_KEYS or JIM_DICTMATCH_VALUES
14102 * return_types should be either or both
14104 int Jim_DictMatchTypes(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObj, int match_type, int return_types)
14106 Jim_HashEntry *he;
14107 Jim_Obj *listObjPtr;
14108 Jim_HashTableIterator htiter;
14110 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14111 return JIM_ERR;
14114 listObjPtr = Jim_NewListObj(interp, NULL, 0);
14116 JimInitHashTableIterator(objPtr->internalRep.ptr, &htiter);
14117 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14118 if (patternObj) {
14119 Jim_Obj *matchObj = (match_type == JIM_DICTMATCH_KEYS) ? (Jim_Obj *)he->key : Jim_GetHashEntryVal(he);
14120 if (!Jim_StringMatchObj(interp, patternObj, matchObj, 0)) {
14121 /* no match */
14122 continue;
14125 if (return_types & JIM_DICTMATCH_KEYS) {
14126 Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->key);
14128 if (return_types & JIM_DICTMATCH_VALUES) {
14129 Jim_ListAppendElement(interp, listObjPtr, Jim_GetHashEntryVal(he));
14133 Jim_SetResult(interp, listObjPtr);
14134 return JIM_OK;
14137 int Jim_DictSize(Jim_Interp *interp, Jim_Obj *objPtr)
14139 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14140 return -1;
14142 return ((Jim_HashTable *)objPtr->internalRep.ptr)->used;
14146 * Must be called with at least one object.
14147 * Returns the new dictionary, or NULL on error.
14149 Jim_Obj *Jim_DictMerge(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
14151 Jim_Obj *objPtr = Jim_NewDictObj(interp, NULL, 0);
14152 int i;
14154 JimPanic((objc == 0, "Jim_DictMerge called with objc=0"));
14156 /* Note that we don't optimise the trivial case of a single argument */
14158 for (i = 0; i < objc; i++) {
14159 Jim_HashTable *ht;
14160 Jim_HashTableIterator htiter;
14161 Jim_HashEntry *he;
14163 if (SetDictFromAny(interp, objv[i]) != JIM_OK) {
14164 Jim_FreeNewObj(interp, objPtr);
14165 return NULL;
14167 ht = objv[i]->internalRep.ptr;
14168 JimInitHashTableIterator(ht, &htiter);
14169 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14170 Jim_ReplaceHashEntry(objPtr->internalRep.ptr, Jim_GetHashEntryKey(he), Jim_GetHashEntryVal(he));
14173 return objPtr;
14176 int Jim_DictInfo(Jim_Interp *interp, Jim_Obj *objPtr)
14178 Jim_HashTable *ht;
14179 unsigned int i;
14180 char buffer[100];
14181 int sum = 0;
14182 int nonzero_count = 0;
14183 Jim_Obj *output;
14184 int bucket_counts[11] = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 };
14186 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14187 return JIM_ERR;
14190 ht = (Jim_HashTable *)objPtr->internalRep.ptr;
14192 /* Note that this uses internal knowledge of the hash table */
14193 snprintf(buffer, sizeof(buffer), "%d entries in table, %d buckets\n", ht->used, ht->size);
14194 output = Jim_NewStringObj(interp, buffer, -1);
14196 for (i = 0; i < ht->size; i++) {
14197 Jim_HashEntry *he = ht->table[i];
14198 int entries = 0;
14199 while (he) {
14200 entries++;
14201 he = he->next;
14203 if (entries > 9) {
14204 bucket_counts[10]++;
14206 else {
14207 bucket_counts[entries]++;
14209 if (entries) {
14210 sum += entries;
14211 nonzero_count++;
14214 for (i = 0; i < 10; i++) {
14215 snprintf(buffer, sizeof(buffer), "number of buckets with %d entries: %d\n", i, bucket_counts[i]);
14216 Jim_AppendString(interp, output, buffer, -1);
14218 snprintf(buffer, sizeof(buffer), "number of buckets with 10 or more entries: %d\n", bucket_counts[10]);
14219 Jim_AppendString(interp, output, buffer, -1);
14220 snprintf(buffer, sizeof(buffer), "average search distance for entry: %.1f", nonzero_count ? (double)sum / nonzero_count : 0.0);
14221 Jim_AppendString(interp, output, buffer, -1);
14222 Jim_SetResult(interp, output);
14223 return JIM_OK;
14226 static int Jim_EvalEnsemble(Jim_Interp *interp, const char *basecmd, const char *subcmd, int argc, Jim_Obj *const *argv)
14228 Jim_Obj *prefixObj = Jim_NewStringObj(interp, basecmd, -1);
14230 Jim_AppendString(interp, prefixObj, " ", 1);
14231 Jim_AppendString(interp, prefixObj, subcmd, -1);
14233 return Jim_EvalObjPrefix(interp, prefixObj, argc, argv);
14237 * Implements the [dict with] command
14239 static int JimDictWith(Jim_Interp *interp, Jim_Obj *dictVarName, Jim_Obj *const *keyv, int keyc, Jim_Obj *scriptObj)
14241 int i;
14242 Jim_Obj *objPtr;
14243 Jim_Obj *dictObj;
14244 Jim_Obj **dictValues;
14245 int len;
14246 int ret = JIM_OK;
14248 /* Open up the appropriate level of the dictionary */
14249 dictObj = Jim_GetVariable(interp, dictVarName, JIM_ERRMSG);
14250 if (dictObj == NULL || Jim_DictKeysVector(interp, dictObj, keyv, keyc, &objPtr, JIM_ERRMSG) != JIM_OK) {
14251 return JIM_ERR;
14253 /* Set the local variables */
14254 if (Jim_DictPairs(interp, objPtr, &dictValues, &len) == JIM_ERR) {
14255 return JIM_ERR;
14257 for (i = 0; i < len; i += 2) {
14258 if (Jim_SetVariable(interp, dictValues[i], dictValues[i + 1]) == JIM_ERR) {
14259 Jim_Free(dictValues);
14260 return JIM_ERR;
14264 /* As an optimisation, if the script is empty, no need to evaluate it or update the dict */
14265 if (Jim_Length(scriptObj)) {
14266 ret = Jim_EvalObj(interp, scriptObj);
14268 /* Now if the dictionary still exists, update it based on the local variables */
14269 if (ret == JIM_OK && Jim_GetVariable(interp, dictVarName, 0) != NULL) {
14270 /* We need a copy of keyv with one extra element at the end for Jim_SetDictKeysVector() */
14271 Jim_Obj **newkeyv = Jim_Alloc(sizeof(*newkeyv) * (keyc + 1));
14272 for (i = 0; i < keyc; i++) {
14273 newkeyv[i] = keyv[i];
14276 for (i = 0; i < len; i += 2) {
14277 /* This will be NULL if the variable no longer exists, thus deleting the variable */
14278 objPtr = Jim_GetVariable(interp, dictValues[i], 0);
14279 newkeyv[keyc] = dictValues[i];
14280 Jim_SetDictKeysVector(interp, dictVarName, newkeyv, keyc + 1, objPtr, 0);
14282 Jim_Free(newkeyv);
14286 Jim_Free(dictValues);
14288 return ret;
14291 /* [dict] */
14292 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14294 Jim_Obj *objPtr;
14295 int types = JIM_DICTMATCH_KEYS;
14296 int option;
14297 static const char * const options[] = {
14298 "create", "get", "set", "unset", "exists", "keys", "size", "info",
14299 "merge", "with", "append", "lappend", "incr", "remove", "values", "for",
14300 "replace", "update", NULL
14302 enum
14304 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXISTS, OPT_KEYS, OPT_SIZE, OPT_INFO,
14305 OPT_MERGE, OPT_WITH, OPT_APPEND, OPT_LAPPEND, OPT_INCR, OPT_REMOVE, OPT_VALUES, OPT_FOR,
14306 OPT_REPLACE, OPT_UPDATE,
14309 if (argc < 2) {
14310 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?arguments ...?");
14311 return JIM_ERR;
14314 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK) {
14315 return Jim_CheckShowCommands(interp, argv[1], options);
14318 switch (option) {
14319 case OPT_GET:
14320 if (argc < 3) {
14321 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?key ...?");
14322 return JIM_ERR;
14324 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr,
14325 JIM_ERRMSG) != JIM_OK) {
14326 return JIM_ERR;
14328 Jim_SetResult(interp, objPtr);
14329 return JIM_OK;
14331 case OPT_SET:
14332 if (argc < 5) {
14333 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
14334 return JIM_ERR;
14336 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 4, argv[argc - 1], JIM_ERRMSG);
14338 case OPT_EXISTS:
14339 if (argc < 4) {
14340 Jim_WrongNumArgs(interp, 2, argv, "dictionary key ?key ...?");
14341 return JIM_ERR;
14343 else {
14344 int rc = Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr, JIM_ERRMSG);
14345 if (rc < 0) {
14346 return JIM_ERR;
14348 Jim_SetResultBool(interp, rc == JIM_OK);
14349 return JIM_OK;
14352 case OPT_UNSET:
14353 if (argc < 4) {
14354 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
14355 return JIM_ERR;
14357 if (Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 3, NULL, 0) != JIM_OK) {
14358 return JIM_ERR;
14360 return JIM_OK;
14362 case OPT_VALUES:
14363 types = JIM_DICTMATCH_VALUES;
14364 /* fallthru */
14365 case OPT_KEYS:
14366 if (argc != 3 && argc != 4) {
14367 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?pattern?");
14368 return JIM_ERR;
14370 return Jim_DictMatchTypes(interp, argv[2], argc == 4 ? argv[3] : NULL, types, types);
14372 case OPT_SIZE:
14373 if (argc != 3) {
14374 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14375 return JIM_ERR;
14377 else if (Jim_DictSize(interp, argv[2]) < 0) {
14378 return JIM_ERR;
14380 Jim_SetResultInt(interp, Jim_DictSize(interp, argv[2]));
14381 return JIM_OK;
14383 case OPT_MERGE:
14384 if (argc == 2) {
14385 return JIM_OK;
14387 objPtr = Jim_DictMerge(interp, argc - 2, argv + 2);
14388 if (objPtr == NULL) {
14389 return JIM_ERR;
14391 Jim_SetResult(interp, objPtr);
14392 return JIM_OK;
14394 case OPT_UPDATE:
14395 if (argc < 6 || argc % 2) {
14396 /* Better error message */
14397 argc = 2;
14399 break;
14401 case OPT_CREATE:
14402 if (argc % 2) {
14403 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
14404 return JIM_ERR;
14406 objPtr = Jim_NewDictObj(interp, argv + 2, argc - 2);
14407 Jim_SetResult(interp, objPtr);
14408 return JIM_OK;
14410 case OPT_INFO:
14411 if (argc != 3) {
14412 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14413 return JIM_ERR;
14415 return Jim_DictInfo(interp, argv[2]);
14417 case OPT_WITH:
14418 if (argc < 4) {
14419 Jim_WrongNumArgs(interp, 2, argv, "dictVar ?key ...? script");
14420 return JIM_ERR;
14422 return JimDictWith(interp, argv[2], argv + 3, argc - 4, argv[argc - 1]);
14424 /* Handle command as an ensemble */
14425 return Jim_EvalEnsemble(interp, "dict", options[option], argc - 2, argv + 2);
14428 /* [subst] */
14429 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14431 static const char * const options[] = {
14432 "-nobackslashes", "-nocommands", "-novariables", NULL
14434 enum
14435 { OPT_NOBACKSLASHES, OPT_NOCOMMANDS, OPT_NOVARIABLES };
14436 int i;
14437 int flags = JIM_SUBST_FLAG;
14438 Jim_Obj *objPtr;
14440 if (argc < 2) {
14441 Jim_WrongNumArgs(interp, 1, argv, "?options? string");
14442 return JIM_ERR;
14444 for (i = 1; i < (argc - 1); i++) {
14445 int option;
14447 if (Jim_GetEnum(interp, argv[i], options, &option, NULL,
14448 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14449 return JIM_ERR;
14451 switch (option) {
14452 case OPT_NOBACKSLASHES:
14453 flags |= JIM_SUBST_NOESC;
14454 break;
14455 case OPT_NOCOMMANDS:
14456 flags |= JIM_SUBST_NOCMD;
14457 break;
14458 case OPT_NOVARIABLES:
14459 flags |= JIM_SUBST_NOVAR;
14460 break;
14463 if (Jim_SubstObj(interp, argv[argc - 1], &objPtr, flags) != JIM_OK) {
14464 return JIM_ERR;
14466 Jim_SetResult(interp, objPtr);
14467 return JIM_OK;
14470 #ifdef jim_ext_namespace
14471 static int JimIsGlobalNamespace(Jim_Obj *objPtr)
14473 int len;
14474 const char *str = Jim_GetString(objPtr, &len);
14475 return len >= 2 && str[0] == ':' && str[1] == ':';
14477 #endif
14479 /* [info] */
14480 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14482 int cmd;
14483 Jim_Obj *objPtr;
14484 int mode = 0;
14486 static const char * const commands[] = {
14487 "body", "statics", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
14488 "vars", "version", "patchlevel", "complete", "args", "hostname",
14489 "script", "source", "stacktrace", "nameofexecutable", "returncodes",
14490 "references", "alias", NULL
14492 enum
14493 { INFO_BODY, INFO_STATICS, INFO_COMMANDS, INFO_PROCS, INFO_CHANNELS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
14494 INFO_FRAME, INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_PATCHLEVEL, INFO_COMPLETE, INFO_ARGS,
14495 INFO_HOSTNAME, INFO_SCRIPT, INFO_SOURCE, INFO_STACKTRACE, INFO_NAMEOFEXECUTABLE,
14496 INFO_RETURNCODES, INFO_REFERENCES, INFO_ALIAS,
14499 #ifdef jim_ext_namespace
14500 int nons = 0;
14502 if (argc > 2 && Jim_CompareStringImmediate(interp, argv[1], "-nons")) {
14503 /* This is for internal use only */
14504 argc--;
14505 argv++;
14506 nons = 1;
14508 #endif
14510 if (argc < 2) {
14511 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?args ...?");
14512 return JIM_ERR;
14514 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "subcommand", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14515 return Jim_CheckShowCommands(interp, argv[1], commands);
14518 /* Test for the most common commands first, just in case it makes a difference */
14519 switch (cmd) {
14520 case INFO_EXISTS:
14521 if (argc != 3) {
14522 Jim_WrongNumArgs(interp, 2, argv, "varName");
14523 return JIM_ERR;
14525 Jim_SetResultBool(interp, Jim_GetVariable(interp, argv[2], 0) != NULL);
14526 break;
14528 case INFO_ALIAS:{
14529 Jim_Cmd *cmdPtr;
14531 if (argc != 3) {
14532 Jim_WrongNumArgs(interp, 2, argv, "command");
14533 return JIM_ERR;
14535 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14536 return JIM_ERR;
14538 if (cmdPtr->isproc || cmdPtr->u.native.cmdProc != JimAliasCmd) {
14539 Jim_SetResultFormatted(interp, "command \"%#s\" is not an alias", argv[2]);
14540 return JIM_ERR;
14542 Jim_SetResult(interp, (Jim_Obj *)cmdPtr->u.native.privData);
14543 return JIM_OK;
14546 case INFO_CHANNELS:
14547 mode++; /* JIM_CMDLIST_CHANNELS */
14548 #ifndef jim_ext_aio
14549 Jim_SetResultString(interp, "aio not enabled", -1);
14550 return JIM_ERR;
14551 #endif
14552 /* fall through */
14553 case INFO_PROCS:
14554 mode++; /* JIM_CMDLIST_PROCS */
14555 /* fall through */
14556 case INFO_COMMANDS:
14557 /* mode 0 => JIM_CMDLIST_COMMANDS */
14558 if (argc != 2 && argc != 3) {
14559 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14560 return JIM_ERR;
14562 #ifdef jim_ext_namespace
14563 if (!nons) {
14564 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimIsGlobalNamespace(argv[2]))) {
14565 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14568 #endif
14569 Jim_SetResult(interp, JimCommandsList(interp, (argc == 3) ? argv[2] : NULL, mode));
14570 break;
14572 case INFO_VARS:
14573 mode++; /* JIM_VARLIST_VARS */
14574 /* fall through */
14575 case INFO_LOCALS:
14576 mode++; /* JIM_VARLIST_LOCALS */
14577 /* fall through */
14578 case INFO_GLOBALS:
14579 /* mode 0 => JIM_VARLIST_GLOBALS */
14580 if (argc != 2 && argc != 3) {
14581 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14582 return JIM_ERR;
14584 #ifdef jim_ext_namespace
14585 if (!nons) {
14586 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimIsGlobalNamespace(argv[2]))) {
14587 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14590 #endif
14591 Jim_SetResult(interp, JimVariablesList(interp, argc == 3 ? argv[2] : NULL, mode));
14592 break;
14594 case INFO_SCRIPT:
14595 if (argc != 2) {
14596 Jim_WrongNumArgs(interp, 2, argv, "");
14597 return JIM_ERR;
14599 Jim_SetResult(interp, JimGetScript(interp, interp->currentScriptObj)->fileNameObj);
14600 break;
14602 case INFO_SOURCE:{
14603 jim_wide line;
14604 Jim_Obj *resObjPtr;
14605 Jim_Obj *fileNameObj;
14607 if (argc != 3 && argc != 5) {
14608 Jim_WrongNumArgs(interp, 2, argv, "source ?filename line?");
14609 return JIM_ERR;
14611 if (argc == 5) {
14612 if (Jim_GetWide(interp, argv[4], &line) != JIM_OK) {
14613 return JIM_ERR;
14615 resObjPtr = Jim_NewStringObj(interp, Jim_String(argv[2]), Jim_Length(argv[2]));
14616 JimSetSourceInfo(interp, resObjPtr, argv[3], line);
14618 else {
14619 if (argv[2]->typePtr == &sourceObjType) {
14620 fileNameObj = argv[2]->internalRep.sourceValue.fileNameObj;
14621 line = argv[2]->internalRep.sourceValue.lineNumber;
14623 else if (argv[2]->typePtr == &scriptObjType) {
14624 ScriptObj *script = JimGetScript(interp, argv[2]);
14625 fileNameObj = script->fileNameObj;
14626 line = script->firstline;
14628 else {
14629 fileNameObj = interp->emptyObj;
14630 line = 1;
14632 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14633 Jim_ListAppendElement(interp, resObjPtr, fileNameObj);
14634 Jim_ListAppendElement(interp, resObjPtr, Jim_NewIntObj(interp, line));
14636 Jim_SetResult(interp, resObjPtr);
14637 break;
14640 case INFO_STACKTRACE:
14641 Jim_SetResult(interp, interp->stackTrace);
14642 break;
14644 case INFO_LEVEL:
14645 case INFO_FRAME:
14646 switch (argc) {
14647 case 2:
14648 Jim_SetResultInt(interp, interp->framePtr->level);
14649 break;
14651 case 3:
14652 if (JimInfoLevel(interp, argv[2], &objPtr, cmd == INFO_LEVEL) != JIM_OK) {
14653 return JIM_ERR;
14655 Jim_SetResult(interp, objPtr);
14656 break;
14658 default:
14659 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
14660 return JIM_ERR;
14662 break;
14664 case INFO_BODY:
14665 case INFO_STATICS:
14666 case INFO_ARGS:{
14667 Jim_Cmd *cmdPtr;
14669 if (argc != 3) {
14670 Jim_WrongNumArgs(interp, 2, argv, "procname");
14671 return JIM_ERR;
14673 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14674 return JIM_ERR;
14676 if (!cmdPtr->isproc) {
14677 Jim_SetResultFormatted(interp, "command \"%#s\" is not a procedure", argv[2]);
14678 return JIM_ERR;
14680 switch (cmd) {
14681 case INFO_BODY:
14682 Jim_SetResult(interp, cmdPtr->u.proc.bodyObjPtr);
14683 break;
14684 case INFO_ARGS:
14685 Jim_SetResult(interp, cmdPtr->u.proc.argListObjPtr);
14686 break;
14687 case INFO_STATICS:
14688 if (cmdPtr->u.proc.staticVars) {
14689 Jim_SetResult(interp, JimHashtablePatternMatch(interp, cmdPtr->u.proc.staticVars,
14690 NULL, JimVariablesMatch, JIM_VARLIST_LOCALS | JIM_VARLIST_VALUES));
14692 break;
14694 break;
14697 case INFO_VERSION:
14698 case INFO_PATCHLEVEL:{
14699 char buf[(JIM_INTEGER_SPACE * 2) + 1];
14701 sprintf(buf, "%d.%d", JIM_VERSION / 100, JIM_VERSION % 100);
14702 Jim_SetResultString(interp, buf, -1);
14703 break;
14706 case INFO_COMPLETE:
14707 if (argc != 3 && argc != 4) {
14708 Jim_WrongNumArgs(interp, 2, argv, "script ?missing?");
14709 return JIM_ERR;
14711 else {
14712 char missing;
14714 Jim_SetResultBool(interp, Jim_ScriptIsComplete(interp, argv[2], &missing));
14715 if (missing != ' ' && argc == 4) {
14716 Jim_SetVariable(interp, argv[3], Jim_NewStringObj(interp, &missing, 1));
14719 break;
14721 case INFO_HOSTNAME:
14722 /* Redirect to os.gethostname if it exists */
14723 return Jim_Eval(interp, "os.gethostname");
14725 case INFO_NAMEOFEXECUTABLE:
14726 /* Redirect to Tcl proc */
14727 return Jim_Eval(interp, "{info nameofexecutable}");
14729 case INFO_RETURNCODES:
14730 if (argc == 2) {
14731 int i;
14732 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14734 for (i = 0; jimReturnCodes[i]; i++) {
14735 Jim_ListAppendElement(interp, listObjPtr, Jim_NewIntObj(interp, i));
14736 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp,
14737 jimReturnCodes[i], -1));
14740 Jim_SetResult(interp, listObjPtr);
14742 else if (argc == 3) {
14743 long code;
14744 const char *name;
14746 if (Jim_GetLong(interp, argv[2], &code) != JIM_OK) {
14747 return JIM_ERR;
14749 name = Jim_ReturnCode(code);
14750 if (*name == '?') {
14751 Jim_SetResultInt(interp, code);
14753 else {
14754 Jim_SetResultString(interp, name, -1);
14757 else {
14758 Jim_WrongNumArgs(interp, 2, argv, "?code?");
14759 return JIM_ERR;
14761 break;
14762 case INFO_REFERENCES:
14763 #ifdef JIM_REFERENCES
14764 return JimInfoReferences(interp, argc, argv);
14765 #else
14766 Jim_SetResultString(interp, "not supported", -1);
14767 return JIM_ERR;
14768 #endif
14770 return JIM_OK;
14773 /* [exists] */
14774 static int Jim_ExistsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14776 Jim_Obj *objPtr;
14777 int result = 0;
14779 static const char * const options[] = {
14780 "-command", "-proc", "-alias", "-var", NULL
14782 enum
14784 OPT_COMMAND, OPT_PROC, OPT_ALIAS, OPT_VAR
14786 int option;
14788 if (argc == 2) {
14789 option = OPT_VAR;
14790 objPtr = argv[1];
14792 else if (argc == 3) {
14793 if (Jim_GetEnum(interp, argv[1], options, &option, NULL, JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14794 return JIM_ERR;
14796 objPtr = argv[2];
14798 else {
14799 Jim_WrongNumArgs(interp, 1, argv, "?option? name");
14800 return JIM_ERR;
14803 if (option == OPT_VAR) {
14804 result = Jim_GetVariable(interp, objPtr, 0) != NULL;
14806 else {
14807 /* Now different kinds of commands */
14808 Jim_Cmd *cmd = Jim_GetCommand(interp, objPtr, JIM_NONE);
14810 if (cmd) {
14811 switch (option) {
14812 case OPT_COMMAND:
14813 result = 1;
14814 break;
14816 case OPT_ALIAS:
14817 result = cmd->isproc == 0 && cmd->u.native.cmdProc == JimAliasCmd;
14818 break;
14820 case OPT_PROC:
14821 result = cmd->isproc;
14822 break;
14826 Jim_SetResultBool(interp, result);
14827 return JIM_OK;
14830 /* [split] */
14831 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14833 const char *str, *splitChars, *noMatchStart;
14834 int splitLen, strLen;
14835 Jim_Obj *resObjPtr;
14836 int c;
14837 int len;
14839 if (argc != 2 && argc != 3) {
14840 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
14841 return JIM_ERR;
14844 str = Jim_GetString(argv[1], &len);
14845 if (len == 0) {
14846 return JIM_OK;
14848 strLen = Jim_Utf8Length(interp, argv[1]);
14850 /* Init */
14851 if (argc == 2) {
14852 splitChars = " \n\t\r";
14853 splitLen = 4;
14855 else {
14856 splitChars = Jim_String(argv[2]);
14857 splitLen = Jim_Utf8Length(interp, argv[2]);
14860 noMatchStart = str;
14861 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14863 /* Split */
14864 if (splitLen) {
14865 Jim_Obj *objPtr;
14866 while (strLen--) {
14867 const char *sc = splitChars;
14868 int scLen = splitLen;
14869 int sl = utf8_tounicode(str, &c);
14870 while (scLen--) {
14871 int pc;
14872 sc += utf8_tounicode(sc, &pc);
14873 if (c == pc) {
14874 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14875 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14876 noMatchStart = str + sl;
14877 break;
14880 str += sl;
14882 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14883 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14885 else {
14886 /* This handles the special case of splitchars eq {}
14887 * Optimise by sharing common (ASCII) characters
14889 Jim_Obj **commonObj = NULL;
14890 #define NUM_COMMON (128 - 9)
14891 while (strLen--) {
14892 int n = utf8_tounicode(str, &c);
14893 #ifdef JIM_OPTIMIZATION
14894 if (c >= 9 && c < 128) {
14895 /* Common ASCII char. Note that 9 is the tab character */
14896 c -= 9;
14897 if (!commonObj) {
14898 commonObj = Jim_Alloc(sizeof(*commonObj) * NUM_COMMON);
14899 memset(commonObj, 0, sizeof(*commonObj) * NUM_COMMON);
14901 if (!commonObj[c]) {
14902 commonObj[c] = Jim_NewStringObj(interp, str, 1);
14904 Jim_ListAppendElement(interp, resObjPtr, commonObj[c]);
14905 str++;
14906 continue;
14908 #endif
14909 Jim_ListAppendElement(interp, resObjPtr, Jim_NewStringObjUtf8(interp, str, 1));
14910 str += n;
14912 Jim_Free(commonObj);
14915 Jim_SetResult(interp, resObjPtr);
14916 return JIM_OK;
14919 /* [join] */
14920 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14922 const char *joinStr;
14923 int joinStrLen;
14925 if (argc != 2 && argc != 3) {
14926 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
14927 return JIM_ERR;
14929 /* Init */
14930 if (argc == 2) {
14931 joinStr = " ";
14932 joinStrLen = 1;
14934 else {
14935 joinStr = Jim_GetString(argv[2], &joinStrLen);
14937 Jim_SetResult(interp, Jim_ListJoin(interp, argv[1], joinStr, joinStrLen));
14938 return JIM_OK;
14941 /* [format] */
14942 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14944 Jim_Obj *objPtr;
14946 if (argc < 2) {
14947 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
14948 return JIM_ERR;
14950 objPtr = Jim_FormatString(interp, argv[1], argc - 2, argv + 2);
14951 if (objPtr == NULL)
14952 return JIM_ERR;
14953 Jim_SetResult(interp, objPtr);
14954 return JIM_OK;
14957 /* [scan] */
14958 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14960 Jim_Obj *listPtr, **outVec;
14961 int outc, i;
14963 if (argc < 3) {
14964 Jim_WrongNumArgs(interp, 1, argv, "string format ?varName varName ...?");
14965 return JIM_ERR;
14967 if (argv[2]->typePtr != &scanFmtStringObjType)
14968 SetScanFmtFromAny(interp, argv[2]);
14969 if (FormatGetError(argv[2]) != 0) {
14970 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
14971 return JIM_ERR;
14973 if (argc > 3) {
14974 int maxPos = FormatGetMaxPos(argv[2]);
14975 int count = FormatGetCnvCount(argv[2]);
14977 if (maxPos > argc - 3) {
14978 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
14979 return JIM_ERR;
14981 else if (count > argc - 3) {
14982 Jim_SetResultString(interp, "different numbers of variable names and "
14983 "field specifiers", -1);
14984 return JIM_ERR;
14986 else if (count < argc - 3) {
14987 Jim_SetResultString(interp, "variable is not assigned by any "
14988 "conversion specifiers", -1);
14989 return JIM_ERR;
14992 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
14993 if (listPtr == 0)
14994 return JIM_ERR;
14995 if (argc > 3) {
14996 int rc = JIM_OK;
14997 int count = 0;
14999 if (listPtr != 0 && listPtr != (Jim_Obj *)EOF) {
15000 int len = Jim_ListLength(interp, listPtr);
15002 if (len != 0) {
15003 JimListGetElements(interp, listPtr, &outc, &outVec);
15004 for (i = 0; i < outc; ++i) {
15005 if (Jim_Length(outVec[i]) > 0) {
15006 ++count;
15007 if (Jim_SetVariable(interp, argv[3 + i], outVec[i]) != JIM_OK) {
15008 rc = JIM_ERR;
15013 Jim_FreeNewObj(interp, listPtr);
15015 else {
15016 count = -1;
15018 if (rc == JIM_OK) {
15019 Jim_SetResultInt(interp, count);
15021 return rc;
15023 else {
15024 if (listPtr == (Jim_Obj *)EOF) {
15025 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
15026 return JIM_OK;
15028 Jim_SetResult(interp, listPtr);
15030 return JIM_OK;
15033 /* [error] */
15034 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15036 if (argc != 2 && argc != 3) {
15037 Jim_WrongNumArgs(interp, 1, argv, "message ?stacktrace?");
15038 return JIM_ERR;
15040 Jim_SetResult(interp, argv[1]);
15041 if (argc == 3) {
15042 JimSetStackTrace(interp, argv[2]);
15043 return JIM_ERR;
15045 interp->addStackTrace++;
15046 return JIM_ERR;
15049 /* [lrange] */
15050 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15052 Jim_Obj *objPtr;
15054 if (argc != 4) {
15055 Jim_WrongNumArgs(interp, 1, argv, "list first last");
15056 return JIM_ERR;
15058 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
15059 return JIM_ERR;
15060 Jim_SetResult(interp, objPtr);
15061 return JIM_OK;
15064 /* [lrepeat] */
15065 static int Jim_LrepeatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15067 Jim_Obj *objPtr;
15068 long count;
15070 if (argc < 2 || Jim_GetLong(interp, argv[1], &count) != JIM_OK || count < 0) {
15071 Jim_WrongNumArgs(interp, 1, argv, "count ?value ...?");
15072 return JIM_ERR;
15075 if (count == 0 || argc == 2) {
15076 return JIM_OK;
15079 argc -= 2;
15080 argv += 2;
15082 objPtr = Jim_NewListObj(interp, argv, argc);
15083 while (--count) {
15084 ListInsertElements(objPtr, -1, argc, argv);
15087 Jim_SetResult(interp, objPtr);
15088 return JIM_OK;
15091 char **Jim_GetEnviron(void)
15093 #if defined(HAVE__NSGETENVIRON)
15094 return *_NSGetEnviron();
15095 #else
15096 #if !defined(NO_ENVIRON_EXTERN)
15097 extern char **environ;
15098 #endif
15100 return environ;
15101 #endif
15104 void Jim_SetEnviron(char **env)
15106 #if defined(HAVE__NSGETENVIRON)
15107 *_NSGetEnviron() = env;
15108 #else
15109 #if !defined(NO_ENVIRON_EXTERN)
15110 extern char **environ;
15111 #endif
15113 environ = env;
15114 #endif
15117 /* [env] */
15118 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15120 const char *key;
15121 const char *val;
15123 if (argc == 1) {
15124 char **e = Jim_GetEnviron();
15126 int i;
15127 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
15129 for (i = 0; e[i]; i++) {
15130 const char *equals = strchr(e[i], '=');
15132 if (equals) {
15133 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, e[i],
15134 equals - e[i]));
15135 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
15139 Jim_SetResult(interp, listObjPtr);
15140 return JIM_OK;
15143 if (argc > 3) {
15144 Jim_WrongNumArgs(interp, 1, argv, "varName ?default?");
15145 return JIM_ERR;
15147 key = Jim_String(argv[1]);
15148 val = getenv(key);
15149 if (val == NULL) {
15150 if (argc < 3) {
15151 Jim_SetResultFormatted(interp, "environment variable \"%#s\" does not exist", argv[1]);
15152 return JIM_ERR;
15154 val = Jim_String(argv[2]);
15156 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
15157 return JIM_OK;
15160 /* [source] */
15161 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15163 int retval;
15165 if (argc != 2) {
15166 Jim_WrongNumArgs(interp, 1, argv, "fileName");
15167 return JIM_ERR;
15169 retval = Jim_EvalFile(interp, Jim_String(argv[1]));
15170 if (retval == JIM_RETURN)
15171 return JIM_OK;
15172 return retval;
15175 /* [lreverse] */
15176 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15178 Jim_Obj *revObjPtr, **ele;
15179 int len;
15181 if (argc != 2) {
15182 Jim_WrongNumArgs(interp, 1, argv, "list");
15183 return JIM_ERR;
15185 JimListGetElements(interp, argv[1], &len, &ele);
15186 len--;
15187 revObjPtr = Jim_NewListObj(interp, NULL, 0);
15188 while (len >= 0)
15189 ListAppendElement(revObjPtr, ele[len--]);
15190 Jim_SetResult(interp, revObjPtr);
15191 return JIM_OK;
15194 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
15196 jim_wide len;
15198 if (step == 0)
15199 return -1;
15200 if (start == end)
15201 return 0;
15202 else if (step > 0 && start > end)
15203 return -1;
15204 else if (step < 0 && end > start)
15205 return -1;
15206 len = end - start;
15207 if (len < 0)
15208 len = -len; /* abs(len) */
15209 if (step < 0)
15210 step = -step; /* abs(step) */
15211 len = 1 + ((len - 1) / step);
15212 /* We can truncate safely to INT_MAX, the range command
15213 * will always return an error for a such long range
15214 * because Tcl lists can't be so long. */
15215 if (len > INT_MAX)
15216 len = INT_MAX;
15217 return (int)((len < 0) ? -1 : len);
15220 /* [range] */
15221 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15223 jim_wide start = 0, end, step = 1;
15224 int len, i;
15225 Jim_Obj *objPtr;
15227 if (argc < 2 || argc > 4) {
15228 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
15229 return JIM_ERR;
15231 if (argc == 2) {
15232 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
15233 return JIM_ERR;
15235 else {
15236 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
15237 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
15238 return JIM_ERR;
15239 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
15240 return JIM_ERR;
15242 if ((len = JimRangeLen(start, end, step)) == -1) {
15243 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
15244 return JIM_ERR;
15246 objPtr = Jim_NewListObj(interp, NULL, 0);
15247 for (i = 0; i < len; i++)
15248 ListAppendElement(objPtr, Jim_NewIntObj(interp, start + i * step));
15249 Jim_SetResult(interp, objPtr);
15250 return JIM_OK;
15253 /* [rand] */
15254 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15256 jim_wide min = 0, max = 0, len, maxMul;
15258 if (argc < 1 || argc > 3) {
15259 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
15260 return JIM_ERR;
15262 if (argc == 1) {
15263 max = JIM_WIDE_MAX;
15264 } else if (argc == 2) {
15265 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
15266 return JIM_ERR;
15267 } else if (argc == 3) {
15268 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
15269 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
15270 return JIM_ERR;
15272 len = max-min;
15273 if (len < 0) {
15274 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
15275 return JIM_ERR;
15277 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
15278 while (1) {
15279 jim_wide r;
15281 JimRandomBytes(interp, &r, sizeof(jim_wide));
15282 if (r < 0 || r >= maxMul) continue;
15283 r = (len == 0) ? 0 : r%len;
15284 Jim_SetResultInt(interp, min+r);
15285 return JIM_OK;
15289 static const struct {
15290 const char *name;
15291 Jim_CmdProc *cmdProc;
15292 } Jim_CoreCommandsTable[] = {
15293 {"alias", Jim_AliasCoreCommand},
15294 {"set", Jim_SetCoreCommand},
15295 {"unset", Jim_UnsetCoreCommand},
15296 {"puts", Jim_PutsCoreCommand},
15297 {"+", Jim_AddCoreCommand},
15298 {"*", Jim_MulCoreCommand},
15299 {"-", Jim_SubCoreCommand},
15300 {"/", Jim_DivCoreCommand},
15301 {"incr", Jim_IncrCoreCommand},
15302 {"while", Jim_WhileCoreCommand},
15303 {"loop", Jim_LoopCoreCommand},
15304 {"for", Jim_ForCoreCommand},
15305 {"foreach", Jim_ForeachCoreCommand},
15306 {"lmap", Jim_LmapCoreCommand},
15307 {"lassign", Jim_LassignCoreCommand},
15308 {"if", Jim_IfCoreCommand},
15309 {"switch", Jim_SwitchCoreCommand},
15310 {"list", Jim_ListCoreCommand},
15311 {"lindex", Jim_LindexCoreCommand},
15312 {"lset", Jim_LsetCoreCommand},
15313 {"lsearch", Jim_LsearchCoreCommand},
15314 {"llength", Jim_LlengthCoreCommand},
15315 {"lappend", Jim_LappendCoreCommand},
15316 {"linsert", Jim_LinsertCoreCommand},
15317 {"lreplace", Jim_LreplaceCoreCommand},
15318 {"lsort", Jim_LsortCoreCommand},
15319 {"append", Jim_AppendCoreCommand},
15320 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
15321 {"debug", Jim_DebugCoreCommand},
15322 #endif
15323 {"eval", Jim_EvalCoreCommand},
15324 {"uplevel", Jim_UplevelCoreCommand},
15325 {"expr", Jim_ExprCoreCommand},
15326 {"break", Jim_BreakCoreCommand},
15327 {"continue", Jim_ContinueCoreCommand},
15328 {"proc", Jim_ProcCoreCommand},
15329 {"concat", Jim_ConcatCoreCommand},
15330 {"return", Jim_ReturnCoreCommand},
15331 {"upvar", Jim_UpvarCoreCommand},
15332 {"global", Jim_GlobalCoreCommand},
15333 {"string", Jim_StringCoreCommand},
15334 {"time", Jim_TimeCoreCommand},
15335 {"exit", Jim_ExitCoreCommand},
15336 {"catch", Jim_CatchCoreCommand},
15337 #ifdef JIM_REFERENCES
15338 {"ref", Jim_RefCoreCommand},
15339 {"getref", Jim_GetrefCoreCommand},
15340 {"setref", Jim_SetrefCoreCommand},
15341 {"finalize", Jim_FinalizeCoreCommand},
15342 {"collect", Jim_CollectCoreCommand},
15343 #endif
15344 {"rename", Jim_RenameCoreCommand},
15345 {"dict", Jim_DictCoreCommand},
15346 {"subst", Jim_SubstCoreCommand},
15347 {"info", Jim_InfoCoreCommand},
15348 {"exists", Jim_ExistsCoreCommand},
15349 {"split", Jim_SplitCoreCommand},
15350 {"join", Jim_JoinCoreCommand},
15351 {"format", Jim_FormatCoreCommand},
15352 {"scan", Jim_ScanCoreCommand},
15353 {"error", Jim_ErrorCoreCommand},
15354 {"lrange", Jim_LrangeCoreCommand},
15355 {"lrepeat", Jim_LrepeatCoreCommand},
15356 {"env", Jim_EnvCoreCommand},
15357 {"source", Jim_SourceCoreCommand},
15358 {"lreverse", Jim_LreverseCoreCommand},
15359 {"range", Jim_RangeCoreCommand},
15360 {"rand", Jim_RandCoreCommand},
15361 {"tailcall", Jim_TailcallCoreCommand},
15362 {"local", Jim_LocalCoreCommand},
15363 {"upcall", Jim_UpcallCoreCommand},
15364 {"apply", Jim_ApplyCoreCommand},
15365 {NULL, NULL},
15368 void Jim_RegisterCoreCommands(Jim_Interp *interp)
15370 int i = 0;
15372 while (Jim_CoreCommandsTable[i].name != NULL) {
15373 Jim_CreateCommand(interp,
15374 Jim_CoreCommandsTable[i].name, Jim_CoreCommandsTable[i].cmdProc, NULL, NULL);
15375 i++;
15379 /* -----------------------------------------------------------------------------
15380 * Interactive prompt
15381 * ---------------------------------------------------------------------------*/
15382 void Jim_MakeErrorMessage(Jim_Interp *interp)
15384 Jim_Obj *argv[2];
15386 argv[0] = Jim_NewStringObj(interp, "errorInfo", -1);
15387 argv[1] = interp->result;
15389 Jim_EvalObjVector(interp, 2, argv);
15393 * Given a null terminated array of strings, returns an allocated, sorted
15394 * copy of the array.
15396 static char **JimSortStringTable(const char *const *tablePtr)
15398 int count;
15399 char **tablePtrSorted;
15401 /* Find the size of the table */
15402 for (count = 0; tablePtr[count]; count++) {
15405 /* Allocate one extra for the terminating NULL pointer */
15406 tablePtrSorted = Jim_Alloc(sizeof(char *) * (count + 1));
15407 memcpy(tablePtrSorted, tablePtr, sizeof(char *) * count);
15408 qsort(tablePtrSorted, count, sizeof(char *), qsortCompareStringPointers);
15409 tablePtrSorted[count] = NULL;
15411 return tablePtrSorted;
15414 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
15415 const char *prefix, const char *const *tablePtr, const char *name)
15417 char **tablePtrSorted;
15418 int i;
15420 if (name == NULL) {
15421 name = "option";
15424 Jim_SetResultFormatted(interp, "%s%s \"%s\": must be ", badtype, name, arg);
15425 tablePtrSorted = JimSortStringTable(tablePtr);
15426 for (i = 0; tablePtrSorted[i]; i++) {
15427 if (tablePtrSorted[i + 1] == NULL && i > 0) {
15428 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
15430 Jim_AppendStrings(interp, Jim_GetResult(interp), prefix, tablePtrSorted[i], NULL);
15431 if (tablePtrSorted[i + 1]) {
15432 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
15435 Jim_Free(tablePtrSorted);
15440 * If objPtr is "-commands" sets the Jim result as a sorted list of options in the table
15441 * and returns JIM_OK.
15443 * Otherwise returns JIM_ERR.
15445 int Jim_CheckShowCommands(Jim_Interp *interp, Jim_Obj *objPtr, const char *const *tablePtr)
15447 if (Jim_CompareStringImmediate(interp, objPtr, "-commands")) {
15448 int i;
15449 char **tablePtrSorted = JimSortStringTable(tablePtr);
15450 Jim_SetResult(interp, Jim_NewListObj(interp, NULL, 0));
15451 for (i = 0; tablePtrSorted[i]; i++) {
15452 Jim_ListAppendElement(interp, Jim_GetResult(interp), Jim_NewStringObj(interp, tablePtrSorted[i], -1));
15454 Jim_Free(tablePtrSorted);
15455 return JIM_OK;
15457 return JIM_ERR;
15460 /* internal rep is stored in ptrIntvalue
15461 * ptr = tablePtr
15462 * int1 = flags
15463 * int2 = index
15465 static const Jim_ObjType getEnumObjType = {
15466 "get-enum",
15467 NULL,
15468 NULL,
15469 NULL,
15470 JIM_TYPE_REFERENCES
15473 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
15474 const char *const *tablePtr, int *indexPtr, const char *name, int flags)
15476 const char *bad = "bad ";
15477 const char *const *entryPtr = NULL;
15478 int i;
15479 int match = -1;
15480 int arglen;
15481 const char *arg;
15483 if (objPtr->typePtr == &getEnumObjType) {
15484 if (objPtr->internalRep.ptrIntValue.ptr == tablePtr && objPtr->internalRep.ptrIntValue.int1 == flags) {
15485 *indexPtr = objPtr->internalRep.ptrIntValue.int2;
15486 return JIM_OK;
15490 arg = Jim_GetString(objPtr, &arglen);
15492 *indexPtr = -1;
15494 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
15495 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
15496 /* Found an exact match */
15497 match = i;
15498 goto found;
15500 if (flags & JIM_ENUM_ABBREV) {
15501 /* Accept an unambiguous abbreviation.
15502 * Note that '-' doesnt' consitute a valid abbreviation
15504 if (strncmp(arg, *entryPtr, arglen) == 0) {
15505 if (*arg == '-' && arglen == 1) {
15506 break;
15508 if (match >= 0) {
15509 bad = "ambiguous ";
15510 goto ambiguous;
15512 match = i;
15517 /* If we had an unambiguous partial match */
15518 if (match >= 0) {
15519 found:
15520 /* Record the match in the object */
15521 Jim_FreeIntRep(interp, objPtr);
15522 objPtr->typePtr = &getEnumObjType;
15523 objPtr->internalRep.ptrIntValue.ptr = (void *)tablePtr;
15524 objPtr->internalRep.ptrIntValue.int1 = flags;
15525 objPtr->internalRep.ptrIntValue.int2 = match;
15526 /* Return the result */
15527 *indexPtr = match;
15528 return JIM_OK;
15531 ambiguous:
15532 if (flags & JIM_ERRMSG) {
15533 JimSetFailedEnumResult(interp, arg, bad, "", tablePtr, name);
15535 return JIM_ERR;
15538 int Jim_FindByName(const char *name, const char * const array[], size_t len)
15540 int i;
15542 for (i = 0; i < (int)len; i++) {
15543 if (array[i] && strcmp(array[i], name) == 0) {
15544 return i;
15547 return -1;
15550 int Jim_IsDict(Jim_Obj *objPtr)
15552 return objPtr->typePtr == &dictObjType;
15555 int Jim_IsList(Jim_Obj *objPtr)
15557 return objPtr->typePtr == &listObjType;
15561 * Very simple printf-like formatting, designed for error messages.
15563 * The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
15564 * The resulting string is created and set as the result.
15566 * Each '%s' should correspond to a regular string parameter.
15567 * Each '%#s' should correspond to a (Jim_Obj *) parameter.
15568 * Any other printf specifier is not allowed (but %% is allowed for the % character).
15570 * e.g. Jim_SetResultFormatted(interp, "Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
15572 * Note: We take advantage of the fact that printf has the same behaviour for both %s and %#s
15574 * Note that any Jim_Obj parameters with zero ref count will be freed as a result of this call.
15576 void Jim_SetResultFormatted(Jim_Interp *interp, const char *format, ...)
15578 /* Initial space needed */
15579 int len = strlen(format);
15580 int extra = 0;
15581 int n = 0;
15582 const char *params[5];
15583 int nobjparam = 0;
15584 Jim_Obj *objparam[5];
15585 char *buf;
15586 va_list args;
15587 int i;
15589 va_start(args, format);
15591 for (i = 0; i < len && n < 5; i++) {
15592 int l;
15594 if (strncmp(format + i, "%s", 2) == 0) {
15595 params[n] = va_arg(args, char *);
15597 l = strlen(params[n]);
15599 else if (strncmp(format + i, "%#s", 3) == 0) {
15600 Jim_Obj *objPtr = va_arg(args, Jim_Obj *);
15602 params[n] = Jim_GetString(objPtr, &l);
15603 objparam[nobjparam++] = objPtr;
15604 Jim_IncrRefCount(objPtr);
15606 else {
15607 if (format[i] == '%') {
15608 i++;
15610 continue;
15612 n++;
15613 extra += l;
15616 len += extra;
15617 buf = Jim_Alloc(len + 1);
15618 len = snprintf(buf, len + 1, format, params[0], params[1], params[2], params[3], params[4]);
15620 va_end(args);
15622 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
15624 for (i = 0; i < nobjparam; i++) {
15625 Jim_DecrRefCount(interp, objparam[i]);
15629 /* stubs */
15630 #ifndef jim_ext_package
15631 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver, int flags)
15633 return JIM_OK;
15635 #endif
15636 #ifndef jim_ext_aio
15637 FILE *Jim_AioFilehandle(Jim_Interp *interp, Jim_Obj *fhObj)
15639 Jim_SetResultString(interp, "aio not enabled", -1);
15640 return NULL;
15642 #endif
15646 * Local Variables: ***
15647 * c-basic-offset: 4 ***
15648 * tab-width: 4 ***
15649 * End: ***