dict exists: Improve performance when when key not found
[jimtcl.git] / jim.c
blob71d6de1d0ee59f8c33a1ed34e34ac4bce1868531
1 /* Jim - A small embeddable Tcl interpreter
3 * Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
4 * Copyright 2005 Clemens Hintze <c.hintze@gmx.net>
5 * Copyright 2005 patthoyts - Pat Thoyts <patthoyts@users.sf.net>
6 * Copyright 2008,2009 oharboe - Øyvind Harboe - oyvind.harboe@zylin.com
7 * Copyright 2008 Andrew Lunn <andrew@lunn.ch>
8 * Copyright 2008 Duane Ellis <openocd@duaneellis.com>
9 * Copyright 2008 Uwe Klein <uklein@klein-messgeraete.de>
10 * Copyright 2008 Steve Bennett <steveb@workware.net.au>
11 * Copyright 2009 Nico Coesel <ncoesel@dealogic.nl>
12 * Copyright 2009 Zachary T Welch zw@superlucidity.net
13 * Copyright 2009 David Brownell
15 * Redistribution and use in source and binary forms, with or without
16 * modification, are permitted provided that the following conditions
17 * are met:
19 * 1. Redistributions of source code must retain the above copyright
20 * notice, this list of conditions and the following disclaimer.
21 * 2. Redistributions in binary form must reproduce the above
22 * copyright notice, this list of conditions and the following
23 * disclaimer in the documentation and/or other materials
24 * provided with the distribution.
26 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
27 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
28 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
29 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
30 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
31 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
32 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
33 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
34 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
35 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
36 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
37 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
39 * The views and conclusions contained in the software and documentation
40 * are those of the authors and should not be interpreted as representing
41 * official policies, either expressed or implied, of the Jim Tcl Project.
42 **/
43 #define JIM_OPTIMIZATION /* comment to avoid optimizations and reduce size */
44 #ifndef _GNU_SOURCE
45 #define _GNU_SOURCE /* Mostly just for environ */
46 #endif
48 #include <stdio.h>
49 #include <stdlib.h>
51 #include <string.h>
52 #include <stdarg.h>
53 #include <ctype.h>
54 #include <limits.h>
55 #include <assert.h>
56 #include <errno.h>
57 #include <time.h>
58 #include <setjmp.h>
60 #include "jim.h"
61 #include "jimautoconf.h"
62 #include "utf8.h"
64 #ifdef HAVE_SYS_TIME_H
65 #include <sys/time.h>
66 #endif
67 #ifdef HAVE_BACKTRACE
68 #include <execinfo.h>
69 #endif
70 #ifdef HAVE_CRT_EXTERNS_H
71 #include <crt_externs.h>
72 #endif
74 /* For INFINITY, even if math functions are not enabled */
75 #include <math.h>
77 /* We may decide to switch to using $[...] after all, so leave it as an option */
78 /*#define EXPRSUGAR_BRACKET*/
80 /* For the no-autoconf case */
81 #ifndef TCL_LIBRARY
82 #define TCL_LIBRARY "."
83 #endif
84 #ifndef TCL_PLATFORM_OS
85 #define TCL_PLATFORM_OS "unknown"
86 #endif
87 #ifndef TCL_PLATFORM_PLATFORM
88 #define TCL_PLATFORM_PLATFORM "unknown"
89 #endif
90 #ifndef TCL_PLATFORM_PATH_SEPARATOR
91 #define TCL_PLATFORM_PATH_SEPARATOR ":"
92 #endif
94 /*#define DEBUG_SHOW_SCRIPT*/
95 /*#define DEBUG_SHOW_SCRIPT_TOKENS*/
96 /*#define DEBUG_SHOW_SUBST*/
97 /*#define DEBUG_SHOW_EXPR*/
98 /*#define DEBUG_SHOW_EXPR_TOKENS*/
99 /*#define JIM_DEBUG_GC*/
100 #ifdef JIM_MAINTAINER
101 #define JIM_DEBUG_COMMAND
102 #define JIM_DEBUG_PANIC
103 #endif
104 /* Enable this (in conjunction with valgrind) to help debug
105 * reference counting issues
107 /*#define JIM_DISABLE_OBJECT_POOL*/
109 /* Maximum size of an integer */
110 #define JIM_INTEGER_SPACE 24
112 const char *jim_tt_name(int type);
114 #ifdef JIM_DEBUG_PANIC
115 static void JimPanicDump(int fail_condition, const char *fmt, ...);
116 #define JimPanic(X) JimPanicDump X
117 #else
118 #define JimPanic(X)
119 #endif
121 #ifdef JIM_OPTIMIZATION
122 #define JIM_IF_OPTIM(X) X
123 #else
124 #define JIM_IF_OPTIM(X)
125 #endif
127 /* -----------------------------------------------------------------------------
128 * Global variables
129 * ---------------------------------------------------------------------------*/
131 /* A shared empty string for the objects string representation.
132 * Jim_InvalidateStringRep knows about it and doesn't try to free it. */
133 static char JimEmptyStringRep[] = "";
135 /* -----------------------------------------------------------------------------
136 * Required prototypes of not exported functions
137 * ---------------------------------------------------------------------------*/
138 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action);
139 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int listindex, Jim_Obj *newObjPtr,
140 int flags);
141 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands);
142 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr);
143 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
144 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len);
145 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
146 const char *prefix, const char *const *tablePtr, const char *name);
147 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv);
148 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr);
149 static int JimSign(jim_wide w);
150 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen);
151 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len);
152 static int JimSetNewVariable(Jim_HashTable *ht, Jim_Obj *nameObjPtr, Jim_Var *var);
153 static Jim_Var *JimFindVariable(Jim_HashTable *ht, Jim_Obj *nameObjPtr);
156 /* Fast access to the int (wide) value of an object which is known to be of int type */
157 #define JimWideValue(objPtr) (objPtr)->internalRep.wideValue
159 #define JimObjTypeName(O) ((O)->typePtr ? (O)->typePtr->name : "none")
161 static int utf8_tounicode_case(const char *s, int *uc, int upper)
163 int l = utf8_tounicode(s, uc);
164 if (upper) {
165 *uc = utf8_upper(*uc);
167 return l;
170 /* These can be used in addition to JIM_CASESENS/JIM_NOCASE */
171 #define JIM_CHARSET_SCAN 2
172 #define JIM_CHARSET_GLOB 0
175 * pattern points to a string like "[^a-z\ub5]"
177 * The pattern may contain trailing chars, which are ignored.
179 * The pattern is matched against unicode char 'c'.
181 * If (flags & JIM_NOCASE), case is ignored when matching.
182 * If (flags & JIM_CHARSET_SCAN), the considers ^ and ] special at the start
183 * of the charset, per scan, rather than glob/string match.
185 * If the unicode char 'c' matches that set, returns a pointer to the ']' character,
186 * or the null character if the ']' is missing.
188 * Returns NULL on no match.
190 static const char *JimCharsetMatch(const char *pattern, int plen, int c, int flags)
192 int not = 0;
193 int pchar;
194 int match = 0;
195 int nocase = 0;
196 int n;
198 if (flags & JIM_NOCASE) {
199 nocase++;
200 c = utf8_upper(c);
203 if (flags & JIM_CHARSET_SCAN) {
204 if (*pattern == '^') {
205 not++;
206 pattern++;
207 plen--;
210 /* Special case. If the first char is ']', it is part of the set */
211 if (*pattern == ']') {
212 goto first;
216 while (plen && *pattern != ']') {
217 /* Exact match */
218 if (pattern[0] == '\\') {
219 first:
220 n = utf8_tounicode_case(pattern, &pchar, nocase);
221 pattern += n;
222 plen -= n;
224 else {
225 /* Is this a range? a-z */
226 int start;
227 int end;
229 n = utf8_tounicode_case(pattern, &start, nocase);
230 pattern += n;
231 plen -= n;
232 if (pattern[0] == '-' && plen > 1) {
233 /* skip '-' */
234 n = 1 + utf8_tounicode_case(pattern + 1, &end, nocase);
235 pattern += n;
236 plen -= n;
238 /* Handle reversed range too */
239 if ((c >= start && c <= end) || (c >= end && c <= start)) {
240 match = 1;
242 continue;
244 pchar = start;
247 if (pchar == c) {
248 match = 1;
251 if (not) {
252 match = !match;
255 return match ? pattern : NULL;
258 /* Glob-style pattern matching. */
260 /* Note: string *must* be valid UTF-8 sequences
262 static int JimGlobMatch(const char *pattern, int plen, const char *string, int slen, int nocase)
264 int c;
265 int pchar;
266 int n;
267 const char *p;
268 while (plen) {
269 switch (pattern[0]) {
270 case '*':
271 while (pattern[1] == '*' && plen) {
272 pattern++;
273 plen--;
275 pattern++;
276 plen--;
277 if (!plen) {
278 return 1; /* match */
280 while (slen) {
281 /* Recursive call - Does the remaining pattern match anywhere? */
282 if (JimGlobMatch(pattern, plen, string, slen, nocase))
283 return 1; /* match */
284 n = utf8_tounicode(string, &c);
285 string += n;
286 slen -= n;
288 return 0; /* no match */
290 case '?':
291 n = utf8_tounicode(string, &c);
292 string += n;
293 slen -= n;
294 break;
296 case '[': {
297 n = utf8_tounicode(string, &c);
298 string += n;
299 slen -= n;
300 p = JimCharsetMatch(pattern + 1, plen - 1, c, nocase ? JIM_NOCASE : 0);
301 if (!p) {
302 return 0;
304 plen -= p - pattern;
305 pattern = p;
307 if (!plen) {
308 /* Ran out of pattern (no ']') */
309 continue;
311 break;
313 case '\\':
314 if (pattern[1]) {
315 pattern++;
316 plen--;
318 /* fall through */
319 default:
320 n = utf8_tounicode_case(string, &c, nocase);
321 string += n;
322 slen -= n;
323 utf8_tounicode_case(pattern, &pchar, nocase);
324 if (pchar != c) {
325 return 0;
327 break;
329 n = utf8_tounicode_case(pattern, &pchar, nocase);
330 pattern += n;
331 plen -= n;
332 if (!slen) {
333 while (*pattern == '*' && plen) {
334 pattern++;
335 plen--;
337 break;
340 if (!plen && !slen) {
341 return 1;
343 return 0;
347 * utf-8 string comparison. case-insensitive if nocase is set.
349 * Returns -1, 0 or 1
351 * Note that the lengths are character lengths, not byte lengths.
353 static int JimStringCompareUtf8(const char *s1, int l1, const char *s2, int l2, int nocase)
355 int minlen = l1;
356 if (l2 < l1) {
357 minlen = l2;
359 while (minlen) {
360 int c1, c2;
361 s1 += utf8_tounicode_case(s1, &c1, nocase);
362 s2 += utf8_tounicode_case(s2, &c2, nocase);
363 if (c1 != c2) {
364 return JimSign(c1 - c2);
366 minlen--;
368 /* Equal to this point, so the shorter string is less */
369 if (l1 < l2) {
370 return -1;
372 if (l1 > l2) {
373 return 1;
375 return 0;
378 /* Search for 's1' inside 's2', starting to search from char 'index' of 's2'.
379 * The index of the first occurrence of s1 in s2 is returned.
380 * If s1 is not found inside s2, -1 is returned.
382 * Note: Lengths and return value are in bytes, not chars.
384 static int JimStringFirst(const char *s1, int l1, const char *s2, int l2, int idx)
386 int i;
387 int l1bytelen;
389 if (!l1 || !l2 || l1 > l2) {
390 return -1;
392 if (idx < 0)
393 idx = 0;
394 s2 += utf8_index(s2, idx);
396 l1bytelen = utf8_index(s1, l1);
398 for (i = idx; i <= l2 - l1; i++) {
399 int c;
400 if (memcmp(s2, s1, l1bytelen) == 0) {
401 return i;
403 s2 += utf8_tounicode(s2, &c);
405 return -1;
408 /* Search for the last occurrence 's1' inside 's2', starting to search from char 'index' of 's2'.
409 * The index of the last occurrence of s1 in s2 is returned.
410 * If s1 is not found inside s2, -1 is returned.
412 * Note: Lengths and return value are in bytes, not chars.
414 static int JimStringLast(const char *s1, int l1, const char *s2, int l2)
416 const char *p;
418 if (!l1 || !l2 || l1 > l2)
419 return -1;
421 /* Now search for the needle */
422 for (p = s2 + l2 - 1; p != s2 - 1; p--) {
423 if (*p == *s1 && memcmp(s1, p, l1) == 0) {
424 return p - s2;
427 return -1;
430 #ifdef JIM_UTF8
432 * Per JimStringLast but lengths and return value are in chars, not bytes.
434 static int JimStringLastUtf8(const char *s1, int l1, const char *s2, int l2)
436 int n = JimStringLast(s1, utf8_index(s1, l1), s2, utf8_index(s2, l2));
437 if (n > 0) {
438 n = utf8_strlen(s2, n);
440 return n;
442 #endif
445 * After an strtol()/strtod()-like conversion,
446 * check whether something was converted and that
447 * the only thing left is white space.
449 * Returns JIM_OK or JIM_ERR.
451 static int JimCheckConversion(const char *str, const char *endptr)
453 if (str[0] == '\0' || str == endptr) {
454 return JIM_ERR;
457 if (endptr[0] != '\0') {
458 while (*endptr) {
459 if (!isspace(UCHAR(*endptr))) {
460 return JIM_ERR;
462 endptr++;
465 return JIM_OK;
468 /* Parses the front of a number to determine its sign and base.
469 * Returns the index to start parsing according to the given base
471 static int JimNumberBase(const char *str, int *base, int *sign)
473 int i = 0;
475 *base = 10;
477 while (isspace(UCHAR(str[i]))) {
478 i++;
481 if (str[i] == '-') {
482 *sign = -1;
483 i++;
485 else {
486 if (str[i] == '+') {
487 i++;
489 *sign = 1;
492 if (str[i] != '0') {
493 /* base 10 */
494 return 0;
497 /* We have 0<x>, so see if we can convert it */
498 switch (str[i + 1]) {
499 case 'x': case 'X': *base = 16; break;
500 case 'o': case 'O': *base = 8; break;
501 case 'b': case 'B': *base = 2; break;
502 default: return 0;
504 i += 2;
505 /* Ensure that (e.g.) 0x-5 fails to parse */
506 if (str[i] != '-' && str[i] != '+' && !isspace(UCHAR(str[i]))) {
507 /* Parse according to this base */
508 return i;
510 /* Parse as base 10 */
511 *base = 10;
512 return 0;
515 /* Converts a number as per strtol(..., 0) except leading zeros do *not*
516 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
518 static long jim_strtol(const char *str, char **endptr)
520 int sign;
521 int base;
522 int i = JimNumberBase(str, &base, &sign);
524 if (base != 10) {
525 long value = strtol(str + i, endptr, base);
526 if (endptr == NULL || *endptr != str + i) {
527 return value * sign;
531 /* Can just do a regular base-10 conversion */
532 return strtol(str, endptr, 10);
536 /* Converts a number as per strtoull(..., 0) except leading zeros do *not*
537 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
539 static jim_wide jim_strtoull(const char *str, char **endptr)
541 #ifdef HAVE_LONG_LONG
542 int sign;
543 int base;
544 int i = JimNumberBase(str, &base, &sign);
546 if (base != 10) {
547 jim_wide value = strtoull(str + i, endptr, base);
548 if (endptr == NULL || *endptr != str + i) {
549 return value * sign;
553 /* Can just do a regular base-10 conversion */
554 return strtoull(str, endptr, 10);
555 #else
556 return (unsigned long)jim_strtol(str, endptr);
557 #endif
560 int Jim_StringToWide(const char *str, jim_wide * widePtr, int base)
562 char *endptr;
564 if (base) {
565 *widePtr = strtoull(str, &endptr, base);
567 else {
568 *widePtr = jim_strtoull(str, &endptr);
571 return JimCheckConversion(str, endptr);
574 int Jim_StringToDouble(const char *str, double *doublePtr)
576 char *endptr;
578 /* Callers can check for underflow via ERANGE */
579 errno = 0;
581 *doublePtr = strtod(str, &endptr);
583 return JimCheckConversion(str, endptr);
586 static jim_wide JimPowWide(jim_wide b, jim_wide e)
588 jim_wide res = 1;
590 /* Special cases */
591 if (b == 1) {
592 /* 1 ^ any = 1 */
593 return 1;
595 if (e < 0) {
596 if (b != -1) {
597 return 0;
599 /* Only special case is -1 ^ -n
600 * -1^-1 = -1
601 * -1^-2 = 1
602 * i.e. same as +ve n
604 e = -e;
606 while (e)
608 if (e & 1) {
609 res *= b;
611 e >>= 1;
612 b *= b;
614 return res;
617 /* -----------------------------------------------------------------------------
618 * Special functions
619 * ---------------------------------------------------------------------------*/
620 #ifdef JIM_DEBUG_PANIC
621 static void JimPanicDump(int condition, const char *fmt, ...)
623 va_list ap;
625 if (!condition) {
626 return;
629 va_start(ap, fmt);
631 fprintf(stderr, "\nJIM INTERPRETER PANIC: ");
632 vfprintf(stderr, fmt, ap);
633 fprintf(stderr, "\n\n");
634 va_end(ap);
636 #ifdef HAVE_BACKTRACE
638 void *array[40];
639 int size, i;
640 char **strings;
642 size = backtrace(array, 40);
643 strings = backtrace_symbols(array, size);
644 for (i = 0; i < size; i++)
645 fprintf(stderr, "[backtrace] %s\n", strings[i]);
646 fprintf(stderr, "[backtrace] Include the above lines and the output\n");
647 fprintf(stderr, "[backtrace] of 'nm <executable>' in the bug report.\n");
649 #endif
651 exit(1);
653 #endif
655 /* -----------------------------------------------------------------------------
656 * Memory allocation
657 * ---------------------------------------------------------------------------*/
659 void *Jim_Alloc(int size)
661 return size ? malloc(size) : NULL;
664 void Jim_Free(void *ptr)
666 free(ptr);
669 void *Jim_Realloc(void *ptr, int size)
671 return realloc(ptr, size);
674 char *Jim_StrDup(const char *s)
676 return strdup(s);
679 char *Jim_StrDupLen(const char *s, int l)
681 char *copy = Jim_Alloc(l + 1);
683 memcpy(copy, s, l + 1);
684 copy[l] = 0; /* Just to be sure, original could be substring */
685 return copy;
688 /* -----------------------------------------------------------------------------
689 * Time related functions
690 * ---------------------------------------------------------------------------*/
692 /* Returns current time in microseconds */
693 static jim_wide JimClock(void)
695 struct timeval tv;
697 gettimeofday(&tv, NULL);
698 return (jim_wide) tv.tv_sec * 1000000 + tv.tv_usec;
701 /* -----------------------------------------------------------------------------
702 * Hash Tables
703 * ---------------------------------------------------------------------------*/
705 /* -------------------------- private prototypes ---------------------------- */
706 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht);
707 static unsigned int JimHashTableNextPower(unsigned int size);
708 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace);
710 /* -------------------------- hash functions -------------------------------- */
712 /* Thomas Wang's 32 bit Mix Function */
713 unsigned int Jim_IntHashFunction(unsigned int key)
715 key += ~(key << 15);
716 key ^= (key >> 10);
717 key += (key << 3);
718 key ^= (key >> 6);
719 key += ~(key << 11);
720 key ^= (key >> 16);
721 return key;
724 /* Generic hash function (we are using to multiply by 9 and add the byte
725 * as Tcl) */
726 unsigned int Jim_GenHashFunction(const unsigned char *buf, int len)
728 unsigned int h = 0;
730 while (len--)
731 h += (h << 3) + *buf++;
732 return h;
735 /* ----------------------------- API implementation ------------------------- */
738 * Reset a hashtable already initialized.
739 * The table data should already have been freed.
741 * Note that type and privdata are not initialised
742 * to allow the now-empty hashtable to be reused
744 static void JimResetHashTable(Jim_HashTable *ht)
746 ht->table = NULL;
747 ht->size = 0;
748 ht->sizemask = 0;
749 ht->used = 0;
750 ht->collisions = 0;
751 #ifdef JIM_RANDOMISE_HASH
752 /* This is initialised to a random value to avoid a hash collision attack.
753 * See: n.runs-SA-2011.004
755 ht->uniq = (rand() ^ time(NULL) ^ clock());
756 #else
757 ht->uniq = 0;
758 #endif
761 static void JimInitHashTableIterator(Jim_HashTable *ht, Jim_HashTableIterator *iter)
763 iter->ht = ht;
764 iter->index = -1;
765 iter->entry = NULL;
766 iter->nextEntry = NULL;
769 /* Initialize the hash table */
770 int Jim_InitHashTable(Jim_HashTable *ht, const Jim_HashTableType *type, void *privDataPtr)
772 JimResetHashTable(ht);
773 ht->type = type;
774 ht->privdata = privDataPtr;
775 return JIM_OK;
778 /* Expand or create the hashtable */
779 void Jim_ExpandHashTable(Jim_HashTable *ht, unsigned int size)
781 Jim_HashTable n; /* the new hashtable */
782 unsigned int realsize = JimHashTableNextPower(size), i;
784 /* the size is invalid if it is smaller than the number of
785 * elements already inside the hashtable */
786 if (size <= ht->used)
787 return;
789 Jim_InitHashTable(&n, ht->type, ht->privdata);
790 n.size = realsize;
791 n.sizemask = realsize - 1;
792 n.table = Jim_Alloc(realsize * sizeof(Jim_HashEntry *));
793 /* Keep the same 'uniq' as the original */
794 n.uniq = ht->uniq;
796 /* Initialize all the pointers to NULL */
797 memset(n.table, 0, realsize * sizeof(Jim_HashEntry *));
799 /* Copy all the elements from the old to the new table:
800 * note that if the old hash table is empty ht->used is zero,
801 * so Jim_ExpandHashTable just creates an empty hash table. */
802 n.used = ht->used;
803 for (i = 0; ht->used > 0; i++) {
804 Jim_HashEntry *he, *nextHe;
806 if (ht->table[i] == NULL)
807 continue;
809 /* For each hash entry on this slot... */
810 he = ht->table[i];
811 while (he) {
812 unsigned int h;
814 nextHe = he->next;
815 /* Get the new element index */
816 h = Jim_HashKey(ht, he->key) & n.sizemask;
817 he->next = n.table[h];
818 n.table[h] = he;
819 ht->used--;
820 /* Pass to the next element */
821 he = nextHe;
824 assert(ht->used == 0);
825 Jim_Free(ht->table);
827 /* Remap the new hashtable in the old */
828 *ht = n;
831 /* Add an element to the target hash table */
832 int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val)
834 Jim_HashEntry *entry;
836 /* Get the index of the new element, or -1 if
837 * the element already exists. */
838 entry = JimInsertHashEntry(ht, key, 0);
839 if (entry == NULL)
840 return JIM_ERR;
842 /* Set the hash entry fields. */
843 Jim_SetHashKey(ht, entry, key);
844 Jim_SetHashVal(ht, entry, val);
845 return JIM_OK;
848 /* Add an element, discarding the old if the key already exists */
849 int Jim_ReplaceHashEntry(Jim_HashTable *ht, const void *key, void *val)
851 int existed;
852 Jim_HashEntry *entry;
854 /* Get the index of the new element, or -1 if
855 * the element already exists. */
856 entry = JimInsertHashEntry(ht, key, 1);
857 if (entry->key) {
858 /* It already exists, so only replace the value.
859 * Note if both a destructor and a duplicate function exist,
860 * need to dup before destroy. perhaps they are the same
861 * reference counted object
863 if (ht->type->valDestructor && ht->type->valDup) {
864 void *newval = ht->type->valDup(ht->privdata, val);
865 ht->type->valDestructor(ht->privdata, entry->u.val);
866 entry->u.val = newval;
868 else {
869 Jim_FreeEntryVal(ht, entry);
870 Jim_SetHashVal(ht, entry, val);
872 existed = 1;
874 else {
875 /* Doesn't exist, so set the key */
876 Jim_SetHashKey(ht, entry, key);
877 Jim_SetHashVal(ht, entry, val);
878 existed = 0;
881 return existed;
884 /* Search and remove an element */
885 int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key)
887 unsigned int h;
888 Jim_HashEntry *he, *prevHe;
890 if (ht->used == 0)
891 return JIM_ERR;
892 h = Jim_HashKey(ht, key) & ht->sizemask;
893 he = ht->table[h];
895 prevHe = NULL;
896 while (he) {
897 if (Jim_CompareHashKeys(ht, key, he->key)) {
898 /* Unlink the element from the list */
899 if (prevHe)
900 prevHe->next = he->next;
901 else
902 ht->table[h] = he->next;
903 Jim_FreeEntryKey(ht, he);
904 Jim_FreeEntryVal(ht, he);
905 Jim_Free(he);
906 ht->used--;
907 return JIM_OK;
909 prevHe = he;
910 he = he->next;
912 return JIM_ERR; /* not found */
916 * Clear all hash entries from the table, but don't free
917 * the table.
919 void Jim_ClearHashTable(Jim_HashTable *ht)
921 unsigned int i;
923 /* Free all the elements */
924 for (i = 0; ht->used > 0; i++) {
925 Jim_HashEntry *he, *nextHe;
927 he = ht->table[i];
928 while (he) {
929 nextHe = he->next;
930 Jim_FreeEntryKey(ht, he);
931 Jim_FreeEntryVal(ht, he);
932 Jim_Free(he);
933 ht->used--;
934 he = nextHe;
936 ht->table[i] = NULL;
940 /* Remove all entries from the hash table
941 * and leave it empty for reuse
943 int Jim_FreeHashTable(Jim_HashTable *ht)
945 Jim_ClearHashTable(ht);
946 /* Free the table and the allocated cache structure */
947 Jim_Free(ht->table);
948 /* Re-initialize the table */
949 JimResetHashTable(ht);
950 return JIM_OK; /* never fails */
953 Jim_HashEntry *Jim_FindHashEntry(Jim_HashTable *ht, const void *key)
955 Jim_HashEntry *he;
956 unsigned int h;
958 if (ht->used == 0)
959 return NULL;
960 h = Jim_HashKey(ht, key) & ht->sizemask;
961 he = ht->table[h];
962 while (he) {
963 if (Jim_CompareHashKeys(ht, key, he->key))
964 return he;
965 he = he->next;
967 return NULL;
970 Jim_HashTableIterator *Jim_GetHashTableIterator(Jim_HashTable *ht)
972 Jim_HashTableIterator *iter = Jim_Alloc(sizeof(*iter));
973 JimInitHashTableIterator(ht, iter);
974 return iter;
977 Jim_HashEntry *Jim_NextHashEntry(Jim_HashTableIterator *iter)
979 while (1) {
980 if (iter->entry == NULL) {
981 iter->index++;
982 if (iter->index >= (signed)iter->ht->size)
983 break;
984 iter->entry = iter->ht->table[iter->index];
986 else {
987 iter->entry = iter->nextEntry;
989 if (iter->entry) {
990 /* We need to save the 'next' here, the iterator user
991 * may delete the entry we are returning. */
992 iter->nextEntry = iter->entry->next;
993 return iter->entry;
996 return NULL;
999 /* ------------------------- private functions ------------------------------ */
1001 /* Expand the hash table if needed */
1002 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht)
1004 /* If the hash table is empty expand it to the intial size,
1005 * if the table is "full" double its size. */
1006 if (ht->size == 0)
1007 Jim_ExpandHashTable(ht, JIM_HT_INITIAL_SIZE);
1008 if (ht->size == ht->used)
1009 Jim_ExpandHashTable(ht, ht->size * 2);
1012 /* Our hash table capability is a power of two */
1013 static unsigned int JimHashTableNextPower(unsigned int size)
1015 unsigned int i = JIM_HT_INITIAL_SIZE;
1017 if (size >= 2147483648U)
1018 return 2147483648U;
1019 while (1) {
1020 if (i >= size)
1021 return i;
1022 i *= 2;
1026 /* Returns the index of a free slot that can be populated with
1027 * a hash entry for the given 'key'.
1028 * If the key already exists, -1 is returned. */
1029 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace)
1031 unsigned int h;
1032 Jim_HashEntry *he;
1034 /* Expand the hashtable if needed */
1035 JimExpandHashTableIfNeeded(ht);
1037 /* Compute the key hash value */
1038 h = Jim_HashKey(ht, key) & ht->sizemask;
1039 /* Search if this slot does not already contain the given key */
1040 he = ht->table[h];
1041 while (he) {
1042 if (Jim_CompareHashKeys(ht, key, he->key))
1043 return replace ? he : NULL;
1044 he = he->next;
1047 /* Allocates the memory and stores key */
1048 he = Jim_Alloc(sizeof(*he));
1049 he->next = ht->table[h];
1050 ht->table[h] = he;
1051 ht->used++;
1052 he->key = NULL;
1054 return he;
1057 /* ----------------------- StringCopy Hash Table Type ------------------------*/
1059 static unsigned int JimStringCopyHTHashFunction(const void *key)
1061 return Jim_GenHashFunction(key, strlen(key));
1064 static void *JimStringCopyHTDup(void *privdata, const void *key)
1066 return Jim_StrDup(key);
1069 static int JimStringCopyHTKeyCompare(void *privdata, const void *key1, const void *key2)
1071 return strcmp(key1, key2) == 0;
1074 static void JimStringCopyHTKeyDestructor(void *privdata, void *key)
1076 Jim_Free(key);
1079 static const Jim_HashTableType JimPackageHashTableType = {
1080 JimStringCopyHTHashFunction, /* hash function */
1081 JimStringCopyHTDup, /* key dup */
1082 NULL, /* val dup */
1083 JimStringCopyHTKeyCompare, /* key compare */
1084 JimStringCopyHTKeyDestructor, /* key destructor */
1085 NULL /* val destructor */
1088 typedef struct AssocDataValue
1090 Jim_InterpDeleteProc *delProc;
1091 void *data;
1092 } AssocDataValue;
1094 static void JimAssocDataHashTableValueDestructor(void *privdata, void *data)
1096 AssocDataValue *assocPtr = (AssocDataValue *) data;
1098 if (assocPtr->delProc != NULL)
1099 assocPtr->delProc((Jim_Interp *)privdata, assocPtr->data);
1100 Jim_Free(data);
1103 static const Jim_HashTableType JimAssocDataHashTableType = {
1104 JimStringCopyHTHashFunction, /* hash function */
1105 JimStringCopyHTDup, /* key dup */
1106 NULL, /* val dup */
1107 JimStringCopyHTKeyCompare, /* key compare */
1108 JimStringCopyHTKeyDestructor, /* key destructor */
1109 JimAssocDataHashTableValueDestructor /* val destructor */
1112 /* -----------------------------------------------------------------------------
1113 * Stack - This is a simple generic stack implementation. It is used for
1114 * example in the 'expr' expression compiler.
1115 * ---------------------------------------------------------------------------*/
1116 void Jim_InitStack(Jim_Stack *stack)
1118 stack->len = 0;
1119 stack->maxlen = 0;
1120 stack->vector = NULL;
1123 void Jim_FreeStack(Jim_Stack *stack)
1125 Jim_Free(stack->vector);
1128 int Jim_StackLen(Jim_Stack *stack)
1130 return stack->len;
1133 void Jim_StackPush(Jim_Stack *stack, void *element)
1135 int neededLen = stack->len + 1;
1137 if (neededLen > stack->maxlen) {
1138 stack->maxlen = neededLen < 20 ? 20 : neededLen * 2;
1139 stack->vector = Jim_Realloc(stack->vector, sizeof(void *) * stack->maxlen);
1141 stack->vector[stack->len] = element;
1142 stack->len++;
1145 void *Jim_StackPop(Jim_Stack *stack)
1147 if (stack->len == 0)
1148 return NULL;
1149 stack->len--;
1150 return stack->vector[stack->len];
1153 void *Jim_StackPeek(Jim_Stack *stack)
1155 if (stack->len == 0)
1156 return NULL;
1157 return stack->vector[stack->len - 1];
1160 void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc) (void *ptr))
1162 int i;
1164 for (i = 0; i < stack->len; i++)
1165 freeFunc(stack->vector[i]);
1168 /* -----------------------------------------------------------------------------
1169 * Tcl Parser
1170 * ---------------------------------------------------------------------------*/
1172 /* Token types */
1173 #define JIM_TT_NONE 0 /* No token returned */
1174 #define JIM_TT_STR 1 /* simple string */
1175 #define JIM_TT_ESC 2 /* string that needs escape chars conversion */
1176 #define JIM_TT_VAR 3 /* var substitution */
1177 #define JIM_TT_DICTSUGAR 4 /* Syntax sugar for [dict get], $foo(bar) */
1178 #define JIM_TT_CMD 5 /* command substitution */
1179 /* Note: Keep these three together for TOKEN_IS_SEP() */
1180 #define JIM_TT_SEP 6 /* word separator (white space) */
1181 #define JIM_TT_EOL 7 /* line separator */
1182 #define JIM_TT_EOF 8 /* end of script */
1184 #define JIM_TT_LINE 9 /* special 'start-of-line' token. arg is # of arguments to the command. -ve if {*} */
1185 #define JIM_TT_WORD 10 /* special 'start-of-word' token. arg is # of tokens to combine. -ve if {*} */
1187 /* Additional token types needed for expressions */
1188 #define JIM_TT_SUBEXPR_START 11
1189 #define JIM_TT_SUBEXPR_END 12
1190 #define JIM_TT_SUBEXPR_COMMA 13
1191 #define JIM_TT_EXPR_INT 14
1192 #define JIM_TT_EXPR_DOUBLE 15
1193 #define JIM_TT_EXPR_BOOLEAN 16
1195 #define JIM_TT_EXPRSUGAR 17 /* $(expression) */
1197 /* Operator token types start here */
1198 #define JIM_TT_EXPR_OP 20
1200 #define TOKEN_IS_SEP(type) (type >= JIM_TT_SEP && type <= JIM_TT_EOF)
1201 /* Can this token start an expression? */
1202 #define TOKEN_IS_EXPR_START(type) (type == JIM_TT_NONE || type == JIM_TT_SUBEXPR_START || type == JIM_TT_SUBEXPR_COMMA)
1203 /* Is this token an expression operator? */
1204 #define TOKEN_IS_EXPR_OP(type) (type >= JIM_TT_EXPR_OP)
1207 * Results of missing quotes, braces, etc. from parsing.
1209 struct JimParseMissing {
1210 int ch; /* At end of parse, ' ' if complete or '{', '[', '"', '\\', '}' if incomplete */
1211 int line; /* Line number starting the missing token */
1214 /* Parser context structure. The same context is used to parse
1215 * Tcl scripts, expressions and lists. */
1216 struct JimParserCtx
1218 const char *p; /* Pointer to the point of the program we are parsing */
1219 int len; /* Remaining length */
1220 int linenr; /* Current line number */
1221 const char *tstart;
1222 const char *tend; /* Returned token is at tstart-tend in 'prg'. */
1223 int tline; /* Line number of the returned token */
1224 int tt; /* Token type */
1225 int eof; /* Non zero if EOF condition is true. */
1226 int inquote; /* Parsing a quoted string */
1227 int comment; /* Non zero if the next chars may be a comment. */
1228 struct JimParseMissing missing; /* Details of any missing quotes, etc. */
1231 static int JimParseScript(struct JimParserCtx *pc);
1232 static int JimParseSep(struct JimParserCtx *pc);
1233 static int JimParseEol(struct JimParserCtx *pc);
1234 static int JimParseCmd(struct JimParserCtx *pc);
1235 static int JimParseQuote(struct JimParserCtx *pc);
1236 static int JimParseVar(struct JimParserCtx *pc);
1237 static int JimParseBrace(struct JimParserCtx *pc);
1238 static int JimParseStr(struct JimParserCtx *pc);
1239 static int JimParseComment(struct JimParserCtx *pc);
1240 static void JimParseSubCmd(struct JimParserCtx *pc);
1241 static int JimParseSubQuote(struct JimParserCtx *pc);
1242 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc);
1244 /* Initialize a parser context.
1245 * 'prg' is a pointer to the program text, linenr is the line
1246 * number of the first line contained in the program. */
1247 static void JimParserInit(struct JimParserCtx *pc, const char *prg, int len, int linenr)
1249 pc->p = prg;
1250 pc->len = len;
1251 pc->tstart = NULL;
1252 pc->tend = NULL;
1253 pc->tline = 0;
1254 pc->tt = JIM_TT_NONE;
1255 pc->eof = 0;
1256 pc->inquote = 0;
1257 pc->linenr = linenr;
1258 pc->comment = 1;
1259 pc->missing.ch = ' ';
1260 pc->missing.line = linenr;
1263 static int JimParseScript(struct JimParserCtx *pc)
1265 while (1) { /* the while is used to reiterate with continue if needed */
1266 if (!pc->len) {
1267 pc->tstart = pc->p;
1268 pc->tend = pc->p - 1;
1269 pc->tline = pc->linenr;
1270 pc->tt = JIM_TT_EOL;
1271 pc->eof = 1;
1272 return JIM_OK;
1274 switch (*(pc->p)) {
1275 case '\\':
1276 if (*(pc->p + 1) == '\n' && !pc->inquote) {
1277 return JimParseSep(pc);
1279 pc->comment = 0;
1280 return JimParseStr(pc);
1281 case ' ':
1282 case '\t':
1283 case '\r':
1284 case '\f':
1285 if (!pc->inquote)
1286 return JimParseSep(pc);
1287 pc->comment = 0;
1288 return JimParseStr(pc);
1289 case '\n':
1290 case ';':
1291 pc->comment = 1;
1292 if (!pc->inquote)
1293 return JimParseEol(pc);
1294 return JimParseStr(pc);
1295 case '[':
1296 pc->comment = 0;
1297 return JimParseCmd(pc);
1298 case '$':
1299 pc->comment = 0;
1300 if (JimParseVar(pc) == JIM_ERR) {
1301 /* An orphan $. Create as a separate token */
1302 pc->tstart = pc->tend = pc->p++;
1303 pc->len--;
1304 pc->tt = JIM_TT_ESC;
1306 return JIM_OK;
1307 case '#':
1308 if (pc->comment) {
1309 JimParseComment(pc);
1310 continue;
1312 return JimParseStr(pc);
1313 default:
1314 pc->comment = 0;
1315 return JimParseStr(pc);
1317 return JIM_OK;
1321 static int JimParseSep(struct JimParserCtx *pc)
1323 pc->tstart = pc->p;
1324 pc->tline = pc->linenr;
1325 while (isspace(UCHAR(*pc->p)) || (*pc->p == '\\' && *(pc->p + 1) == '\n')) {
1326 if (*pc->p == '\n') {
1327 break;
1329 if (*pc->p == '\\') {
1330 pc->p++;
1331 pc->len--;
1332 pc->linenr++;
1334 pc->p++;
1335 pc->len--;
1337 pc->tend = pc->p - 1;
1338 pc->tt = JIM_TT_SEP;
1339 return JIM_OK;
1342 static int JimParseEol(struct JimParserCtx *pc)
1344 pc->tstart = pc->p;
1345 pc->tline = pc->linenr;
1346 while (isspace(UCHAR(*pc->p)) || *pc->p == ';') {
1347 if (*pc->p == '\n')
1348 pc->linenr++;
1349 pc->p++;
1350 pc->len--;
1352 pc->tend = pc->p - 1;
1353 pc->tt = JIM_TT_EOL;
1354 return JIM_OK;
1358 ** Here are the rules for parsing:
1359 ** {braced expression}
1360 ** - Count open and closing braces
1361 ** - Backslash escapes meaning of braces but doesn't remove the backslash
1363 ** "quoted expression"
1364 ** - Unescaped double quote terminates the expression
1365 ** - Backslash escapes next char
1366 ** - [commands brackets] are counted/nested
1367 ** - command rules apply within [brackets], not quoting rules (i.e. brackets have their own rules)
1369 ** [command expression]
1370 ** - Count open and closing brackets
1371 ** - Backslash escapes next char
1372 ** - [commands brackets] are counted/nested
1373 ** - "quoted expressions" are parsed according to quoting rules
1374 ** - {braced expressions} are parsed according to brace rules
1376 ** For everything, backslash escapes the next char, newline increments current line
1380 * Parses a braced expression starting at pc->p.
1382 * Positions the parser at the end of the braced expression,
1383 * sets pc->tend and possibly pc->missing.
1385 static void JimParseSubBrace(struct JimParserCtx *pc)
1387 int level = 1;
1389 /* Skip the brace */
1390 pc->p++;
1391 pc->len--;
1392 while (pc->len) {
1393 switch (*pc->p) {
1394 case '\\':
1395 if (pc->len > 1) {
1396 if (*++pc->p == '\n') {
1397 pc->linenr++;
1399 pc->len--;
1401 break;
1403 case '{':
1404 level++;
1405 break;
1407 case '}':
1408 if (--level == 0) {
1409 pc->tend = pc->p - 1;
1410 pc->p++;
1411 pc->len--;
1412 return;
1414 break;
1416 case '\n':
1417 pc->linenr++;
1418 break;
1420 pc->p++;
1421 pc->len--;
1423 pc->missing.ch = '{';
1424 pc->missing.line = pc->tline;
1425 pc->tend = pc->p - 1;
1429 * Parses a quoted expression starting at pc->p.
1431 * Positions the parser at the end of the quoted expression,
1432 * sets pc->tend and possibly pc->missing.
1434 * Returns the type of the token of the string,
1435 * either JIM_TT_ESC (if it contains values which need to be [subst]ed)
1436 * or JIM_TT_STR.
1438 static int JimParseSubQuote(struct JimParserCtx *pc)
1440 int tt = JIM_TT_STR;
1441 int line = pc->tline;
1443 /* Skip the quote */
1444 pc->p++;
1445 pc->len--;
1446 while (pc->len) {
1447 switch (*pc->p) {
1448 case '\\':
1449 if (pc->len > 1) {
1450 if (*++pc->p == '\n') {
1451 pc->linenr++;
1453 pc->len--;
1454 tt = JIM_TT_ESC;
1456 break;
1458 case '"':
1459 pc->tend = pc->p - 1;
1460 pc->p++;
1461 pc->len--;
1462 return tt;
1464 case '[':
1465 JimParseSubCmd(pc);
1466 tt = JIM_TT_ESC;
1467 continue;
1469 case '\n':
1470 pc->linenr++;
1471 break;
1473 case '$':
1474 tt = JIM_TT_ESC;
1475 break;
1477 pc->p++;
1478 pc->len--;
1480 pc->missing.ch = '"';
1481 pc->missing.line = line;
1482 pc->tend = pc->p - 1;
1483 return tt;
1487 * Parses a [command] expression starting at pc->p.
1489 * Positions the parser at the end of the command expression,
1490 * sets pc->tend and possibly pc->missing.
1492 static void JimParseSubCmd(struct JimParserCtx *pc)
1494 int level = 1;
1495 int startofword = 1;
1496 int line = pc->tline;
1498 /* Skip the bracket */
1499 pc->p++;
1500 pc->len--;
1501 while (pc->len) {
1502 switch (*pc->p) {
1503 case '\\':
1504 if (pc->len > 1) {
1505 if (*++pc->p == '\n') {
1506 pc->linenr++;
1508 pc->len--;
1510 break;
1512 case '[':
1513 level++;
1514 break;
1516 case ']':
1517 if (--level == 0) {
1518 pc->tend = pc->p - 1;
1519 pc->p++;
1520 pc->len--;
1521 return;
1523 break;
1525 case '"':
1526 if (startofword) {
1527 JimParseSubQuote(pc);
1528 if (pc->missing.ch == '"') {
1529 return;
1531 continue;
1533 break;
1535 case '{':
1536 JimParseSubBrace(pc);
1537 startofword = 0;
1538 continue;
1540 case '\n':
1541 pc->linenr++;
1542 break;
1544 startofword = isspace(UCHAR(*pc->p));
1545 pc->p++;
1546 pc->len--;
1548 pc->missing.ch = '[';
1549 pc->missing.line = line;
1550 pc->tend = pc->p - 1;
1553 static int JimParseBrace(struct JimParserCtx *pc)
1555 pc->tstart = pc->p + 1;
1556 pc->tline = pc->linenr;
1557 pc->tt = JIM_TT_STR;
1558 JimParseSubBrace(pc);
1559 return JIM_OK;
1562 static int JimParseCmd(struct JimParserCtx *pc)
1564 pc->tstart = pc->p + 1;
1565 pc->tline = pc->linenr;
1566 pc->tt = JIM_TT_CMD;
1567 JimParseSubCmd(pc);
1568 return JIM_OK;
1571 static int JimParseQuote(struct JimParserCtx *pc)
1573 pc->tstart = pc->p + 1;
1574 pc->tline = pc->linenr;
1575 pc->tt = JimParseSubQuote(pc);
1576 return JIM_OK;
1579 static int JimParseVar(struct JimParserCtx *pc)
1581 /* skip the $ */
1582 pc->p++;
1583 pc->len--;
1585 #ifdef EXPRSUGAR_BRACKET
1586 if (*pc->p == '[') {
1587 /* Parse $[...] expr shorthand syntax */
1588 JimParseCmd(pc);
1589 pc->tt = JIM_TT_EXPRSUGAR;
1590 return JIM_OK;
1592 #endif
1594 pc->tstart = pc->p;
1595 pc->tt = JIM_TT_VAR;
1596 pc->tline = pc->linenr;
1598 if (*pc->p == '{') {
1599 pc->tstart = ++pc->p;
1600 pc->len--;
1602 while (pc->len && *pc->p != '}') {
1603 if (*pc->p == '\n') {
1604 pc->linenr++;
1606 pc->p++;
1607 pc->len--;
1609 pc->tend = pc->p - 1;
1610 if (pc->len) {
1611 pc->p++;
1612 pc->len--;
1615 else {
1616 while (1) {
1617 /* Skip double colon, but not single colon! */
1618 if (pc->p[0] == ':' && pc->p[1] == ':') {
1619 while (*pc->p == ':') {
1620 pc->p++;
1621 pc->len--;
1623 continue;
1625 /* Note that any char >= 0x80 must be part of a utf-8 char.
1626 * We consider all unicode points outside of ASCII as letters
1628 if (isalnum(UCHAR(*pc->p)) || *pc->p == '_' || UCHAR(*pc->p) >= 0x80) {
1629 pc->p++;
1630 pc->len--;
1631 continue;
1633 break;
1635 /* Parse [dict get] syntax sugar. */
1636 if (*pc->p == '(') {
1637 int count = 1;
1638 const char *paren = NULL;
1640 pc->tt = JIM_TT_DICTSUGAR;
1642 while (count && pc->len) {
1643 pc->p++;
1644 pc->len--;
1645 if (*pc->p == '\\' && pc->len >= 1) {
1646 pc->p++;
1647 pc->len--;
1649 else if (*pc->p == '(') {
1650 count++;
1652 else if (*pc->p == ')') {
1653 paren = pc->p;
1654 count--;
1657 if (count == 0) {
1658 pc->p++;
1659 pc->len--;
1661 else if (paren) {
1662 /* Did not find a matching paren. Back up */
1663 paren++;
1664 pc->len += (pc->p - paren);
1665 pc->p = paren;
1667 #ifndef EXPRSUGAR_BRACKET
1668 if (*pc->tstart == '(') {
1669 pc->tt = JIM_TT_EXPRSUGAR;
1671 #endif
1673 pc->tend = pc->p - 1;
1675 /* Check if we parsed just the '$' character.
1676 * That's not a variable so an error is returned
1677 * to tell the state machine to consider this '$' just
1678 * a string. */
1679 if (pc->tstart == pc->p) {
1680 pc->p--;
1681 pc->len++;
1682 return JIM_ERR;
1684 return JIM_OK;
1687 static int JimParseStr(struct JimParserCtx *pc)
1689 if (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1690 pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR) {
1691 /* Starting a new word */
1692 if (*pc->p == '{') {
1693 return JimParseBrace(pc);
1695 if (*pc->p == '"') {
1696 pc->inquote = 1;
1697 pc->p++;
1698 pc->len--;
1699 /* In case the end quote is missing */
1700 pc->missing.line = pc->tline;
1703 pc->tstart = pc->p;
1704 pc->tline = pc->linenr;
1705 while (1) {
1706 if (pc->len == 0) {
1707 if (pc->inquote) {
1708 pc->missing.ch = '"';
1710 pc->tend = pc->p - 1;
1711 pc->tt = JIM_TT_ESC;
1712 return JIM_OK;
1714 switch (*pc->p) {
1715 case '\\':
1716 if (!pc->inquote && *(pc->p + 1) == '\n') {
1717 pc->tend = pc->p - 1;
1718 pc->tt = JIM_TT_ESC;
1719 return JIM_OK;
1721 if (pc->len >= 2) {
1722 if (*(pc->p + 1) == '\n') {
1723 pc->linenr++;
1725 pc->p++;
1726 pc->len--;
1728 else if (pc->len == 1) {
1729 /* End of script with trailing backslash */
1730 pc->missing.ch = '\\';
1732 break;
1733 case '(':
1734 /* If the following token is not '$' just keep going */
1735 if (pc->len > 1 && pc->p[1] != '$') {
1736 break;
1738 /* fall through */
1739 case ')':
1740 /* Only need a separate ')' token if the previous was a var */
1741 if (*pc->p == '(' || pc->tt == JIM_TT_VAR) {
1742 if (pc->p == pc->tstart) {
1743 /* At the start of the token, so just return this char */
1744 pc->p++;
1745 pc->len--;
1747 pc->tend = pc->p - 1;
1748 pc->tt = JIM_TT_ESC;
1749 return JIM_OK;
1751 break;
1753 case '$':
1754 case '[':
1755 pc->tend = pc->p - 1;
1756 pc->tt = JIM_TT_ESC;
1757 return JIM_OK;
1758 case ' ':
1759 case '\t':
1760 case '\n':
1761 case '\r':
1762 case '\f':
1763 case ';':
1764 if (!pc->inquote) {
1765 pc->tend = pc->p - 1;
1766 pc->tt = JIM_TT_ESC;
1767 return JIM_OK;
1769 else if (*pc->p == '\n') {
1770 pc->linenr++;
1772 break;
1773 case '"':
1774 if (pc->inquote) {
1775 pc->tend = pc->p - 1;
1776 pc->tt = JIM_TT_ESC;
1777 pc->p++;
1778 pc->len--;
1779 pc->inquote = 0;
1780 return JIM_OK;
1782 break;
1784 pc->p++;
1785 pc->len--;
1787 return JIM_OK; /* unreached */
1790 static int JimParseComment(struct JimParserCtx *pc)
1792 while (*pc->p) {
1793 if (*pc->p == '\\') {
1794 pc->p++;
1795 pc->len--;
1796 if (pc->len == 0) {
1797 pc->missing.ch = '\\';
1798 return JIM_OK;
1800 if (*pc->p == '\n') {
1801 pc->linenr++;
1804 else if (*pc->p == '\n') {
1805 pc->p++;
1806 pc->len--;
1807 pc->linenr++;
1808 break;
1810 pc->p++;
1811 pc->len--;
1813 return JIM_OK;
1816 /* xdigitval and odigitval are helper functions for JimEscape() */
1817 static int xdigitval(int c)
1819 if (c >= '0' && c <= '9')
1820 return c - '0';
1821 if (c >= 'a' && c <= 'f')
1822 return c - 'a' + 10;
1823 if (c >= 'A' && c <= 'F')
1824 return c - 'A' + 10;
1825 return -1;
1828 static int odigitval(int c)
1830 if (c >= '0' && c <= '7')
1831 return c - '0';
1832 return -1;
1835 /* Perform Tcl escape substitution of 's', storing the result
1836 * string into 'dest'. The escaped string is guaranteed to
1837 * be the same length or shorter than the source string.
1838 * slen is the length of the string at 's'.
1840 * The function returns the length of the resulting string. */
1841 static int JimEscape(char *dest, const char *s, int slen)
1843 char *p = dest;
1844 int i, len;
1846 for (i = 0; i < slen; i++) {
1847 switch (s[i]) {
1848 case '\\':
1849 switch (s[i + 1]) {
1850 case 'a':
1851 *p++ = 0x7;
1852 i++;
1853 break;
1854 case 'b':
1855 *p++ = 0x8;
1856 i++;
1857 break;
1858 case 'f':
1859 *p++ = 0xc;
1860 i++;
1861 break;
1862 case 'n':
1863 *p++ = 0xa;
1864 i++;
1865 break;
1866 case 'r':
1867 *p++ = 0xd;
1868 i++;
1869 break;
1870 case 't':
1871 *p++ = 0x9;
1872 i++;
1873 break;
1874 case 'u':
1875 case 'U':
1876 case 'x':
1877 /* A unicode or hex sequence.
1878 * \x Expect 1-2 hex chars and convert to hex.
1879 * \u Expect 1-4 hex chars and convert to utf-8.
1880 * \U Expect 1-8 hex chars and convert to utf-8.
1881 * \u{NNN} supports 1-6 hex chars and convert to utf-8.
1882 * An invalid sequence means simply the escaped char.
1885 unsigned val = 0;
1886 int k;
1887 int maxchars = 2;
1889 i++;
1891 if (s[i] == 'U') {
1892 maxchars = 8;
1894 else if (s[i] == 'u') {
1895 if (s[i + 1] == '{') {
1896 maxchars = 6;
1897 i++;
1899 else {
1900 maxchars = 4;
1904 for (k = 0; k < maxchars; k++) {
1905 int c = xdigitval(s[i + k + 1]);
1906 if (c == -1) {
1907 break;
1909 val = (val << 4) | c;
1911 /* The \u{nnn} syntax supports up to 21 bit codepoints. */
1912 if (s[i] == '{') {
1913 if (k == 0 || val > 0x1fffff || s[i + k + 1] != '}') {
1914 /* Back up */
1915 i--;
1916 k = 0;
1918 else {
1919 /* Skip the closing brace */
1920 k++;
1923 if (k) {
1924 /* Got a valid sequence, so convert */
1925 if (s[i] == 'x') {
1926 *p++ = val;
1928 else {
1929 p += utf8_fromunicode(p, val);
1931 i += k;
1932 break;
1934 /* Not a valid codepoint, just an escaped char */
1935 *p++ = s[i];
1937 break;
1938 case 'v':
1939 *p++ = 0xb;
1940 i++;
1941 break;
1942 case '\0':
1943 *p++ = '\\';
1944 i++;
1945 break;
1946 case '\n':
1947 /* Replace all spaces and tabs after backslash newline with a single space*/
1948 *p++ = ' ';
1949 do {
1950 i++;
1951 } while (s[i + 1] == ' ' || s[i + 1] == '\t');
1952 break;
1953 case '0':
1954 case '1':
1955 case '2':
1956 case '3':
1957 case '4':
1958 case '5':
1959 case '6':
1960 case '7':
1961 /* octal escape */
1963 int val = 0;
1964 int c = odigitval(s[i + 1]);
1966 val = c;
1967 c = odigitval(s[i + 2]);
1968 if (c == -1) {
1969 *p++ = val;
1970 i++;
1971 break;
1973 val = (val * 8) + c;
1974 c = odigitval(s[i + 3]);
1975 if (c == -1) {
1976 *p++ = val;
1977 i += 2;
1978 break;
1980 val = (val * 8) + c;
1981 *p++ = val;
1982 i += 3;
1984 break;
1985 default:
1986 *p++ = s[i + 1];
1987 i++;
1988 break;
1990 break;
1991 default:
1992 *p++ = s[i];
1993 break;
1996 len = p - dest;
1997 *p = '\0';
1998 return len;
2001 /* Returns a dynamically allocated copy of the current token in the
2002 * parser context. The function performs conversion of escapes if
2003 * the token is of type JIM_TT_ESC.
2005 * Note that after the conversion, tokens that are grouped with
2006 * braces in the source code, are always recognizable from the
2007 * identical string obtained in a different way from the type.
2009 * For example the string:
2011 * {*}$a
2013 * will return as first token "*", of type JIM_TT_STR
2015 * While the string:
2017 * *$a
2019 * will return as first token "*", of type JIM_TT_ESC
2021 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc)
2023 const char *start, *end;
2024 char *token;
2025 int len;
2027 start = pc->tstart;
2028 end = pc->tend;
2029 len = (end - start) + 1;
2030 if (len < 0) {
2031 len = 0;
2033 token = Jim_Alloc(len + 1);
2034 if (pc->tt != JIM_TT_ESC) {
2035 /* No escape conversion needed? Just copy it. */
2036 memcpy(token, start, len);
2037 token[len] = '\0';
2039 else {
2040 /* Else convert the escape chars. */
2041 len = JimEscape(token, start, len);
2044 return Jim_NewStringObjNoAlloc(interp, token, len);
2047 /* -----------------------------------------------------------------------------
2048 * Tcl Lists parsing
2049 * ---------------------------------------------------------------------------*/
2050 static int JimParseListSep(struct JimParserCtx *pc);
2051 static int JimParseListStr(struct JimParserCtx *pc);
2052 static int JimParseListQuote(struct JimParserCtx *pc);
2054 static int JimParseList(struct JimParserCtx *pc)
2056 if (isspace(UCHAR(*pc->p))) {
2057 return JimParseListSep(pc);
2059 switch (*pc->p) {
2060 case '"':
2061 return JimParseListQuote(pc);
2063 case '{':
2064 return JimParseBrace(pc);
2066 default:
2067 if (pc->len) {
2068 return JimParseListStr(pc);
2070 break;
2073 pc->tstart = pc->tend = pc->p;
2074 pc->tline = pc->linenr;
2075 pc->tt = JIM_TT_EOL;
2076 pc->eof = 1;
2077 return JIM_OK;
2080 static int JimParseListSep(struct JimParserCtx *pc)
2082 pc->tstart = pc->p;
2083 pc->tline = pc->linenr;
2084 while (isspace(UCHAR(*pc->p))) {
2085 if (*pc->p == '\n') {
2086 pc->linenr++;
2088 pc->p++;
2089 pc->len--;
2091 pc->tend = pc->p - 1;
2092 pc->tt = JIM_TT_SEP;
2093 return JIM_OK;
2096 static int JimParseListQuote(struct JimParserCtx *pc)
2098 pc->p++;
2099 pc->len--;
2101 pc->tstart = pc->p;
2102 pc->tline = pc->linenr;
2103 pc->tt = JIM_TT_STR;
2105 while (pc->len) {
2106 switch (*pc->p) {
2107 case '\\':
2108 pc->tt = JIM_TT_ESC;
2109 if (--pc->len == 0) {
2110 /* Trailing backslash */
2111 pc->tend = pc->p;
2112 return JIM_OK;
2114 pc->p++;
2115 break;
2116 case '\n':
2117 pc->linenr++;
2118 break;
2119 case '"':
2120 pc->tend = pc->p - 1;
2121 pc->p++;
2122 pc->len--;
2123 return JIM_OK;
2125 pc->p++;
2126 pc->len--;
2129 pc->tend = pc->p - 1;
2130 return JIM_OK;
2133 static int JimParseListStr(struct JimParserCtx *pc)
2135 pc->tstart = pc->p;
2136 pc->tline = pc->linenr;
2137 pc->tt = JIM_TT_STR;
2139 while (pc->len) {
2140 if (isspace(UCHAR(*pc->p))) {
2141 pc->tend = pc->p - 1;
2142 return JIM_OK;
2144 if (*pc->p == '\\') {
2145 if (--pc->len == 0) {
2146 /* Trailing backslash */
2147 pc->tend = pc->p;
2148 return JIM_OK;
2150 pc->tt = JIM_TT_ESC;
2151 pc->p++;
2153 pc->p++;
2154 pc->len--;
2156 pc->tend = pc->p - 1;
2157 return JIM_OK;
2160 /* -----------------------------------------------------------------------------
2161 * Jim_Obj related functions
2162 * ---------------------------------------------------------------------------*/
2164 /* Return a new initialized object. */
2165 Jim_Obj *Jim_NewObj(Jim_Interp *interp)
2167 Jim_Obj *objPtr;
2169 /* -- Check if there are objects in the free list -- */
2170 if (interp->freeList != NULL) {
2171 /* -- Unlink the object from the free list -- */
2172 objPtr = interp->freeList;
2173 interp->freeList = objPtr->nextObjPtr;
2175 else {
2176 /* -- No ready to use objects: allocate a new one -- */
2177 objPtr = Jim_Alloc(sizeof(*objPtr));
2180 /* Object is returned with refCount of 0. Every
2181 * kind of GC implemented should take care to avoid
2182 * scanning objects with refCount == 0. */
2183 objPtr->refCount = 0;
2184 /* All the other fields are left uninitialized to save time.
2185 * The caller will probably want to set them to the right
2186 * value anyway. */
2188 /* -- Put the object into the live list -- */
2189 objPtr->prevObjPtr = NULL;
2190 objPtr->nextObjPtr = interp->liveList;
2191 if (interp->liveList)
2192 interp->liveList->prevObjPtr = objPtr;
2193 interp->liveList = objPtr;
2195 return objPtr;
2198 /* Free an object. Actually objects are never freed, but
2199 * just moved to the free objects list, where they will be
2200 * reused by Jim_NewObj(). */
2201 void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr)
2203 /* Check if the object was already freed, panic. */
2204 JimPanic((objPtr->refCount != 0, "!!!Object %p freed with bad refcount %d, type=%s", objPtr,
2205 objPtr->refCount, objPtr->typePtr ? objPtr->typePtr->name : "<none>"));
2207 /* Free the internal representation */
2208 Jim_FreeIntRep(interp, objPtr);
2209 /* Free the string representation */
2210 if (objPtr->bytes != NULL) {
2211 if (objPtr->bytes != JimEmptyStringRep)
2212 Jim_Free(objPtr->bytes);
2214 /* Unlink the object from the live objects list */
2215 if (objPtr->prevObjPtr)
2216 objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr;
2217 if (objPtr->nextObjPtr)
2218 objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr;
2219 if (interp->liveList == objPtr)
2220 interp->liveList = objPtr->nextObjPtr;
2221 #ifdef JIM_DISABLE_OBJECT_POOL
2222 Jim_Free(objPtr);
2223 #else
2224 /* Link the object into the free objects list */
2225 objPtr->prevObjPtr = NULL;
2226 objPtr->nextObjPtr = interp->freeList;
2227 if (interp->freeList)
2228 interp->freeList->prevObjPtr = objPtr;
2229 interp->freeList = objPtr;
2230 objPtr->refCount = -1;
2231 #endif
2234 /* Invalidate the string representation of an object. */
2235 void Jim_InvalidateStringRep(Jim_Obj *objPtr)
2237 if (objPtr->bytes != NULL) {
2238 if (objPtr->bytes != JimEmptyStringRep)
2239 Jim_Free(objPtr->bytes);
2241 objPtr->bytes = NULL;
2244 /* Duplicate an object. The returned object has refcount = 0. */
2245 Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
2247 Jim_Obj *dupPtr;
2249 dupPtr = Jim_NewObj(interp);
2250 if (objPtr->bytes == NULL) {
2251 /* Object does not have a valid string representation. */
2252 dupPtr->bytes = NULL;
2254 else if (objPtr->length == 0) {
2255 /* Zero length, so don't even bother with the type-specific dup,
2256 * since all zero length objects look the same
2258 dupPtr->bytes = JimEmptyStringRep;
2259 dupPtr->length = 0;
2260 dupPtr->typePtr = NULL;
2261 return dupPtr;
2263 else {
2264 dupPtr->bytes = Jim_Alloc(objPtr->length + 1);
2265 dupPtr->length = objPtr->length;
2266 /* Copy the null byte too */
2267 memcpy(dupPtr->bytes, objPtr->bytes, objPtr->length + 1);
2270 /* By default, the new object has the same type as the old object */
2271 dupPtr->typePtr = objPtr->typePtr;
2272 if (objPtr->typePtr != NULL) {
2273 if (objPtr->typePtr->dupIntRepProc == NULL) {
2274 dupPtr->internalRep = objPtr->internalRep;
2276 else {
2277 /* The dup proc may set a different type, e.g. NULL */
2278 objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr);
2281 return dupPtr;
2284 /* Return the string representation for objPtr. If the object's
2285 * string representation is invalid, calls the updateStringProc method to create
2286 * a new one from the internal representation of the object.
2288 const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr)
2290 if (objPtr->bytes == NULL) {
2291 /* Invalid string repr. Generate it. */
2292 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2293 objPtr->typePtr->updateStringProc(objPtr);
2295 if (lenPtr)
2296 *lenPtr = objPtr->length;
2297 return objPtr->bytes;
2300 /* Just returns the length (in bytes) of the object's string rep */
2301 int Jim_Length(Jim_Obj *objPtr)
2303 if (objPtr->bytes == NULL) {
2304 /* Invalid string repr. Generate it. */
2305 Jim_GetString(objPtr, NULL);
2307 return objPtr->length;
2310 /* Just returns object's string rep */
2311 const char *Jim_String(Jim_Obj *objPtr)
2313 if (objPtr->bytes == NULL) {
2314 /* Invalid string repr. Generate it. */
2315 Jim_GetString(objPtr, NULL);
2317 return objPtr->bytes;
2320 static void JimSetStringBytes(Jim_Obj *objPtr, const char *str)
2322 objPtr->bytes = Jim_StrDup(str);
2323 objPtr->length = strlen(str);
2326 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2327 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2329 static const Jim_ObjType dictSubstObjType = {
2330 "dict-substitution",
2331 FreeDictSubstInternalRep,
2332 DupDictSubstInternalRep,
2333 NULL,
2334 JIM_TYPE_NONE,
2337 static void FreeInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2338 static void DupInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2340 static const Jim_ObjType interpolatedObjType = {
2341 "interpolated",
2342 FreeInterpolatedInternalRep,
2343 DupInterpolatedInternalRep,
2344 NULL,
2345 JIM_TYPE_NONE,
2348 static void FreeInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2350 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
2353 static void DupInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2355 /* Copy the interal rep */
2356 dupPtr->internalRep = srcPtr->internalRep;
2357 /* Need to increment the key ref count */
2358 Jim_IncrRefCount(dupPtr->internalRep.dictSubstValue.indexObjPtr);
2361 /* -----------------------------------------------------------------------------
2362 * String Object
2363 * ---------------------------------------------------------------------------*/
2364 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2365 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2367 static const Jim_ObjType stringObjType = {
2368 "string",
2369 NULL,
2370 DupStringInternalRep,
2371 NULL,
2372 JIM_TYPE_REFERENCES,
2375 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2377 JIM_NOTUSED(interp);
2379 /* This is a bit subtle: the only caller of this function
2380 * should be Jim_DuplicateObj(), that will copy the
2381 * string representaion. After the copy, the duplicated
2382 * object will not have more room in the buffer than
2383 * srcPtr->length bytes. So we just set it to length. */
2384 dupPtr->internalRep.strValue.maxLength = srcPtr->length;
2385 dupPtr->internalRep.strValue.charLength = srcPtr->internalRep.strValue.charLength;
2388 static int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
2390 if (objPtr->typePtr != &stringObjType) {
2391 /* Get a fresh string representation. */
2392 if (objPtr->bytes == NULL) {
2393 /* Invalid string repr. Generate it. */
2394 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2395 objPtr->typePtr->updateStringProc(objPtr);
2397 /* Free any other internal representation. */
2398 Jim_FreeIntRep(interp, objPtr);
2399 /* Set it as string, i.e. just set the maxLength field. */
2400 objPtr->typePtr = &stringObjType;
2401 objPtr->internalRep.strValue.maxLength = objPtr->length;
2402 /* Don't know the utf-8 length yet */
2403 objPtr->internalRep.strValue.charLength = -1;
2405 return JIM_OK;
2409 * Returns the length of the object string in chars, not bytes.
2411 * These may be different for a utf-8 string.
2413 int Jim_Utf8Length(Jim_Interp *interp, Jim_Obj *objPtr)
2415 #ifdef JIM_UTF8
2416 SetStringFromAny(interp, objPtr);
2418 if (objPtr->internalRep.strValue.charLength < 0) {
2419 objPtr->internalRep.strValue.charLength = utf8_strlen(objPtr->bytes, objPtr->length);
2421 return objPtr->internalRep.strValue.charLength;
2422 #else
2423 return Jim_Length(objPtr);
2424 #endif
2427 /* len is in bytes -- see also Jim_NewStringObjUtf8() */
2428 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
2430 Jim_Obj *objPtr = Jim_NewObj(interp);
2432 /* Need to find out how many bytes the string requires */
2433 if (len == -1)
2434 len = strlen(s);
2435 /* Alloc/Set the string rep. */
2436 if (len == 0) {
2437 objPtr->bytes = JimEmptyStringRep;
2439 else {
2440 objPtr->bytes = Jim_StrDupLen(s, len);
2442 objPtr->length = len;
2444 /* No typePtr field for the vanilla string object. */
2445 objPtr->typePtr = NULL;
2446 return objPtr;
2449 /* charlen is in characters -- see also Jim_NewStringObj() */
2450 Jim_Obj *Jim_NewStringObjUtf8(Jim_Interp *interp, const char *s, int charlen)
2452 #ifdef JIM_UTF8
2453 /* Need to find out how many bytes the string requires */
2454 int bytelen = utf8_index(s, charlen);
2456 Jim_Obj *objPtr = Jim_NewStringObj(interp, s, bytelen);
2458 /* Remember the utf8 length, so set the type */
2459 objPtr->typePtr = &stringObjType;
2460 objPtr->internalRep.strValue.maxLength = bytelen;
2461 objPtr->internalRep.strValue.charLength = charlen;
2463 return objPtr;
2464 #else
2465 return Jim_NewStringObj(interp, s, charlen);
2466 #endif
2469 /* This version does not try to duplicate the 's' pointer, but
2470 * use it directly. */
2471 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
2473 Jim_Obj *objPtr = Jim_NewObj(interp);
2475 objPtr->bytes = s;
2476 objPtr->length = (len == -1) ? strlen(s) : len;
2477 objPtr->typePtr = NULL;
2478 return objPtr;
2481 /* Low-level string append. Use it only against unshared objects
2482 * of type "string". */
2483 static void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
2485 int needlen;
2487 if (len == -1)
2488 len = strlen(str);
2489 needlen = objPtr->length + len;
2490 if (objPtr->internalRep.strValue.maxLength < needlen ||
2491 objPtr->internalRep.strValue.maxLength == 0) {
2492 needlen *= 2;
2493 /* Inefficient to malloc() for less than 8 bytes */
2494 if (needlen < 7) {
2495 needlen = 7;
2497 if (objPtr->bytes == JimEmptyStringRep) {
2498 objPtr->bytes = Jim_Alloc(needlen + 1);
2500 else {
2501 objPtr->bytes = Jim_Realloc(objPtr->bytes, needlen + 1);
2503 objPtr->internalRep.strValue.maxLength = needlen;
2505 memcpy(objPtr->bytes + objPtr->length, str, len);
2506 objPtr->bytes[objPtr->length + len] = '\0';
2508 if (objPtr->internalRep.strValue.charLength >= 0) {
2509 /* Update the utf-8 char length */
2510 objPtr->internalRep.strValue.charLength += utf8_strlen(objPtr->bytes + objPtr->length, len);
2512 objPtr->length += len;
2515 /* Higher level API to append strings to objects.
2516 * Object must not be unshared for each of these.
2518 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str, int len)
2520 JimPanic((Jim_IsShared(objPtr), "Jim_AppendString called with shared object"));
2521 SetStringFromAny(interp, objPtr);
2522 StringAppendString(objPtr, str, len);
2525 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *appendObjPtr)
2527 int len;
2528 const char *str = Jim_GetString(appendObjPtr, &len);
2529 Jim_AppendString(interp, objPtr, str, len);
2532 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2534 va_list ap;
2536 SetStringFromAny(interp, objPtr);
2537 va_start(ap, objPtr);
2538 while (1) {
2539 const char *s = va_arg(ap, const char *);
2541 if (s == NULL)
2542 break;
2543 Jim_AppendString(interp, objPtr, s, -1);
2545 va_end(ap);
2548 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr)
2550 if (aObjPtr == bObjPtr) {
2551 return 1;
2553 else {
2554 int Alen, Blen;
2555 const char *sA = Jim_GetString(aObjPtr, &Alen);
2556 const char *sB = Jim_GetString(bObjPtr, &Blen);
2558 return Alen == Blen && memcmp(sA, sB, Alen) == 0;
2563 * Note. Does not support embedded nulls in either the pattern or the object.
2565 int Jim_StringMatchObj(Jim_Interp *interp, Jim_Obj *patternObjPtr, Jim_Obj *objPtr, int nocase)
2567 int plen, slen;
2568 const char *pattern = Jim_GetString(patternObjPtr, &plen);
2569 const char *string = Jim_GetString(objPtr, &slen);
2570 return JimGlobMatch(pattern, plen, string, slen, nocase);
2573 int Jim_StringCompareObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2575 const char *s1 = Jim_String(firstObjPtr);
2576 int l1 = Jim_Utf8Length(interp, firstObjPtr);
2577 const char *s2 = Jim_String(secondObjPtr);
2578 int l2 = Jim_Utf8Length(interp, secondObjPtr);
2579 return JimStringCompareUtf8(s1, l1, s2, l2, nocase);
2582 /* Convert a range, as returned by Jim_GetRange(), into
2583 * an absolute index into an object of the specified length.
2584 * This function may return negative values, or values
2585 * greater than or equal to the length of the list if the index
2586 * is out of range. */
2587 static int JimRelToAbsIndex(int len, int idx)
2589 if (idx < 0)
2590 return len + idx;
2591 return idx;
2594 /* Convert a pair of indexes (*firstPtr, *lastPtr) as normalized by JimRelToAbsIndex(),
2595 * into a form suitable for implementation of commands like [string range] and [lrange].
2597 * The resulting range is guaranteed to address valid elements of
2598 * the structure.
2600 static void JimRelToAbsRange(int len, int *firstPtr, int *lastPtr, int *rangeLenPtr)
2602 int rangeLen;
2604 if (*firstPtr > *lastPtr) {
2605 rangeLen = 0;
2607 else {
2608 rangeLen = *lastPtr - *firstPtr + 1;
2609 if (rangeLen) {
2610 if (*firstPtr < 0) {
2611 rangeLen += *firstPtr;
2612 *firstPtr = 0;
2614 if (*lastPtr >= len) {
2615 rangeLen -= (*lastPtr - (len - 1));
2616 *lastPtr = len - 1;
2620 if (rangeLen < 0)
2621 rangeLen = 0;
2623 *rangeLenPtr = rangeLen;
2626 static int JimStringGetRange(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr,
2627 int len, int *first, int *last, int *range)
2629 if (Jim_GetIndex(interp, firstObjPtr, first) != JIM_OK) {
2630 return JIM_ERR;
2632 if (Jim_GetIndex(interp, lastObjPtr, last) != JIM_OK) {
2633 return JIM_ERR;
2635 *first = JimRelToAbsIndex(len, *first);
2636 *last = JimRelToAbsIndex(len, *last);
2637 JimRelToAbsRange(len, first, last, range);
2638 return JIM_OK;
2641 Jim_Obj *Jim_StringByteRangeObj(Jim_Interp *interp,
2642 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2644 int first, last;
2645 const char *str;
2646 int rangeLen;
2647 int bytelen;
2649 str = Jim_GetString(strObjPtr, &bytelen);
2651 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, bytelen, &first, &last, &rangeLen) != JIM_OK) {
2652 return NULL;
2655 if (first == 0 && rangeLen == bytelen) {
2656 return strObjPtr;
2658 return Jim_NewStringObj(interp, str + first, rangeLen);
2661 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2662 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2664 #ifdef JIM_UTF8
2665 int first, last;
2666 const char *str;
2667 int len, rangeLen;
2668 int bytelen;
2670 str = Jim_GetString(strObjPtr, &bytelen);
2671 len = Jim_Utf8Length(interp, strObjPtr);
2673 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2674 return NULL;
2677 if (first == 0 && rangeLen == len) {
2678 return strObjPtr;
2680 if (len == bytelen) {
2681 /* ASCII optimisation */
2682 return Jim_NewStringObj(interp, str + first, rangeLen);
2684 return Jim_NewStringObjUtf8(interp, str + utf8_index(str, first), rangeLen);
2685 #else
2686 return Jim_StringByteRangeObj(interp, strObjPtr, firstObjPtr, lastObjPtr);
2687 #endif
2690 Jim_Obj *JimStringReplaceObj(Jim_Interp *interp,
2691 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr, Jim_Obj *newStrObj)
2693 int first, last;
2694 const char *str;
2695 int len, rangeLen;
2696 Jim_Obj *objPtr;
2698 len = Jim_Utf8Length(interp, strObjPtr);
2700 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2701 return NULL;
2704 if (last < first) {
2705 return strObjPtr;
2708 str = Jim_String(strObjPtr);
2710 /* Before part */
2711 objPtr = Jim_NewStringObjUtf8(interp, str, first);
2713 /* Replacement */
2714 if (newStrObj) {
2715 Jim_AppendObj(interp, objPtr, newStrObj);
2718 /* After part */
2719 Jim_AppendString(interp, objPtr, str + utf8_index(str, last + 1), len - last - 1);
2721 return objPtr;
2725 * Note: does not support embedded nulls.
2727 static void JimStrCopyUpperLower(char *dest, const char *str, int uc)
2729 while (*str) {
2730 int c;
2731 str += utf8_tounicode(str, &c);
2732 dest += utf8_getchars(dest, uc ? utf8_upper(c) : utf8_lower(c));
2734 *dest = 0;
2738 * Note: does not support embedded nulls.
2740 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2742 char *buf;
2743 int len;
2744 const char *str;
2746 str = Jim_GetString(strObjPtr, &len);
2748 #ifdef JIM_UTF8
2749 /* Case mapping can change the utf-8 length of the string.
2750 * But at worst it will be by one extra byte per char
2752 len *= 2;
2753 #endif
2754 buf = Jim_Alloc(len + 1);
2755 JimStrCopyUpperLower(buf, str, 0);
2756 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2760 * Note: does not support embedded nulls.
2762 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2764 char *buf;
2765 const char *str;
2766 int len;
2768 str = Jim_GetString(strObjPtr, &len);
2770 #ifdef JIM_UTF8
2771 /* Case mapping can change the utf-8 length of the string.
2772 * But at worst it will be by one extra byte per char
2774 len *= 2;
2775 #endif
2776 buf = Jim_Alloc(len + 1);
2777 JimStrCopyUpperLower(buf, str, 1);
2778 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2782 * Note: does not support embedded nulls.
2784 static Jim_Obj *JimStringToTitle(Jim_Interp *interp, Jim_Obj *strObjPtr)
2786 char *buf, *p;
2787 int len;
2788 int c;
2789 const char *str;
2791 str = Jim_GetString(strObjPtr, &len);
2793 #ifdef JIM_UTF8
2794 /* Case mapping can change the utf-8 length of the string.
2795 * But at worst it will be by one extra byte per char
2797 len *= 2;
2798 #endif
2799 buf = p = Jim_Alloc(len + 1);
2801 str += utf8_tounicode(str, &c);
2802 p += utf8_getchars(p, utf8_title(c));
2804 JimStrCopyUpperLower(p, str, 0);
2806 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2809 /* Similar to memchr() except searches a UTF-8 string 'str' of byte length 'len'
2810 * for unicode character 'c'.
2811 * Returns the position if found or NULL if not
2813 static const char *utf8_memchr(const char *str, int len, int c)
2815 #ifdef JIM_UTF8
2816 while (len) {
2817 int sc;
2818 int n = utf8_tounicode(str, &sc);
2819 if (sc == c) {
2820 return str;
2822 str += n;
2823 len -= n;
2825 return NULL;
2826 #else
2827 return memchr(str, c, len);
2828 #endif
2832 * Searches for the first non-trim char in string (str, len)
2834 * If none is found, returns just past the last char.
2836 * Lengths are in bytes.
2838 static const char *JimFindTrimLeft(const char *str, int len, const char *trimchars, int trimlen)
2840 while (len) {
2841 int c;
2842 int n = utf8_tounicode(str, &c);
2844 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2845 /* Not a trim char, so stop */
2846 break;
2848 str += n;
2849 len -= n;
2851 return str;
2855 * Searches backwards for a non-trim char in string (str, len).
2857 * Returns a pointer to just after the non-trim char, or NULL if not found.
2859 * Lengths are in bytes.
2861 static const char *JimFindTrimRight(const char *str, int len, const char *trimchars, int trimlen)
2863 str += len;
2865 while (len) {
2866 int c;
2867 int n = utf8_prev_len(str, len);
2869 len -= n;
2870 str -= n;
2872 n = utf8_tounicode(str, &c);
2874 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2875 return str + n;
2879 return NULL;
2882 static const char default_trim_chars[] = " \t\n\r";
2883 /* sizeof() here includes the null byte */
2884 static int default_trim_chars_len = sizeof(default_trim_chars);
2886 static Jim_Obj *JimStringTrimLeft(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2888 int len;
2889 const char *str = Jim_GetString(strObjPtr, &len);
2890 const char *trimchars = default_trim_chars;
2891 int trimcharslen = default_trim_chars_len;
2892 const char *newstr;
2894 if (trimcharsObjPtr) {
2895 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2898 newstr = JimFindTrimLeft(str, len, trimchars, trimcharslen);
2899 if (newstr == str) {
2900 return strObjPtr;
2903 return Jim_NewStringObj(interp, newstr, len - (newstr - str));
2906 static Jim_Obj *JimStringTrimRight(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2908 int len;
2909 const char *trimchars = default_trim_chars;
2910 int trimcharslen = default_trim_chars_len;
2911 const char *nontrim;
2913 if (trimcharsObjPtr) {
2914 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2917 SetStringFromAny(interp, strObjPtr);
2919 len = Jim_Length(strObjPtr);
2920 nontrim = JimFindTrimRight(strObjPtr->bytes, len, trimchars, trimcharslen);
2922 if (nontrim == NULL) {
2923 /* All trim, so return a zero-length string */
2924 return Jim_NewEmptyStringObj(interp);
2926 if (nontrim == strObjPtr->bytes + len) {
2927 /* All non-trim, so return the original object */
2928 return strObjPtr;
2931 if (Jim_IsShared(strObjPtr)) {
2932 strObjPtr = Jim_NewStringObj(interp, strObjPtr->bytes, (nontrim - strObjPtr->bytes));
2934 else {
2935 /* Can modify this string in place */
2936 strObjPtr->bytes[nontrim - strObjPtr->bytes] = 0;
2937 strObjPtr->length = (nontrim - strObjPtr->bytes);
2940 return strObjPtr;
2943 static Jim_Obj *JimStringTrim(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2945 /* First trim left. */
2946 Jim_Obj *objPtr = JimStringTrimLeft(interp, strObjPtr, trimcharsObjPtr);
2948 /* Now trim right */
2949 strObjPtr = JimStringTrimRight(interp, objPtr, trimcharsObjPtr);
2951 /* Note: refCount check is needed since objPtr may be emptyObj */
2952 if (objPtr != strObjPtr && objPtr->refCount == 0) {
2953 /* We don't want this object to be leaked */
2954 Jim_FreeNewObj(interp, objPtr);
2957 return strObjPtr;
2960 /* Some platforms don't have isascii - need a non-macro version */
2961 #ifdef HAVE_ISASCII
2962 #define jim_isascii isascii
2963 #else
2964 static int jim_isascii(int c)
2966 return !(c & ~0x7f);
2968 #endif
2970 static int JimStringIs(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *strClass, int strict)
2972 static const char * const strclassnames[] = {
2973 "integer", "alpha", "alnum", "ascii", "digit",
2974 "double", "lower", "upper", "space", "xdigit",
2975 "control", "print", "graph", "punct", "boolean",
2976 NULL
2978 enum {
2979 STR_IS_INTEGER, STR_IS_ALPHA, STR_IS_ALNUM, STR_IS_ASCII, STR_IS_DIGIT,
2980 STR_IS_DOUBLE, STR_IS_LOWER, STR_IS_UPPER, STR_IS_SPACE, STR_IS_XDIGIT,
2981 STR_IS_CONTROL, STR_IS_PRINT, STR_IS_GRAPH, STR_IS_PUNCT, STR_IS_BOOLEAN,
2983 int strclass;
2984 int len;
2985 int i;
2986 const char *str;
2987 int (*isclassfunc)(int c) = NULL;
2989 if (Jim_GetEnum(interp, strClass, strclassnames, &strclass, "class", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
2990 return JIM_ERR;
2993 str = Jim_GetString(strObjPtr, &len);
2994 if (len == 0) {
2995 Jim_SetResultBool(interp, !strict);
2996 return JIM_OK;
2999 switch (strclass) {
3000 case STR_IS_INTEGER:
3002 jim_wide w;
3003 Jim_SetResultBool(interp, JimGetWideNoErr(interp, strObjPtr, &w) == JIM_OK);
3004 return JIM_OK;
3007 case STR_IS_DOUBLE:
3009 double d;
3010 Jim_SetResultBool(interp, Jim_GetDouble(interp, strObjPtr, &d) == JIM_OK && errno != ERANGE);
3011 return JIM_OK;
3014 case STR_IS_BOOLEAN:
3016 int b;
3017 Jim_SetResultBool(interp, Jim_GetBoolean(interp, strObjPtr, &b) == JIM_OK);
3018 return JIM_OK;
3021 case STR_IS_ALPHA: isclassfunc = isalpha; break;
3022 case STR_IS_ALNUM: isclassfunc = isalnum; break;
3023 case STR_IS_ASCII: isclassfunc = jim_isascii; break;
3024 case STR_IS_DIGIT: isclassfunc = isdigit; break;
3025 case STR_IS_LOWER: isclassfunc = islower; break;
3026 case STR_IS_UPPER: isclassfunc = isupper; break;
3027 case STR_IS_SPACE: isclassfunc = isspace; break;
3028 case STR_IS_XDIGIT: isclassfunc = isxdigit; break;
3029 case STR_IS_CONTROL: isclassfunc = iscntrl; break;
3030 case STR_IS_PRINT: isclassfunc = isprint; break;
3031 case STR_IS_GRAPH: isclassfunc = isgraph; break;
3032 case STR_IS_PUNCT: isclassfunc = ispunct; break;
3033 default:
3034 return JIM_ERR;
3037 for (i = 0; i < len; i++) {
3038 if (!isclassfunc(UCHAR(str[i]))) {
3039 Jim_SetResultBool(interp, 0);
3040 return JIM_OK;
3043 Jim_SetResultBool(interp, 1);
3044 return JIM_OK;
3047 /* -----------------------------------------------------------------------------
3048 * Compared String Object
3049 * ---------------------------------------------------------------------------*/
3051 /* This is strange object that allows comparison of a C literal string
3052 * with a Jim object in a very short time if the same comparison is done
3053 * multiple times. For example every time the [if] command is executed,
3054 * Jim has to check if a given argument is "else".
3055 * If the code has no errors, this comparison is true most of the time,
3056 * so we can cache the pointer of the string of the last matching
3057 * comparison inside the object. Because most C compilers perform literal sharing,
3058 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
3059 * this works pretty well even if comparisons are at different places
3060 * inside the C code. */
3062 static const Jim_ObjType comparedStringObjType = {
3063 "compared-string",
3064 NULL,
3065 NULL,
3066 NULL,
3067 JIM_TYPE_REFERENCES,
3070 /* The only way this object is exposed to the API is via the following
3071 * function. Returns true if the string and the object string repr.
3072 * are the same, otherwise zero is returned.
3074 * Note: this isn't binary safe, but it hardly needs to be.*/
3075 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr, const char *str)
3077 if (objPtr->typePtr == &comparedStringObjType && objPtr->internalRep.ptr == str) {
3078 return 1;
3080 else {
3081 if (strcmp(str, Jim_String(objPtr)) != 0)
3082 return 0;
3084 if (objPtr->typePtr != &comparedStringObjType) {
3085 Jim_FreeIntRep(interp, objPtr);
3086 objPtr->typePtr = &comparedStringObjType;
3088 objPtr->internalRep.ptr = (char *)str; /*ATTENTION: const cast */
3089 return 1;
3093 static int qsortCompareStringPointers(const void *a, const void *b)
3095 char *const *sa = (char *const *)a;
3096 char *const *sb = (char *const *)b;
3098 return strcmp(*sa, *sb);
3102 /* -----------------------------------------------------------------------------
3103 * Source Object
3105 * This object is just a string from the language point of view, but
3106 * the internal representation contains the filename and line number
3107 * where this token was read. This information is used by
3108 * Jim_EvalObj() if the object passed happens to be of type "source".
3110 * This allows propagation of the information about line numbers and file
3111 * names and gives error messages with absolute line numbers.
3113 * Note that this object uses the internal representation of the Jim_Object,
3114 * so there is almost no memory overhead. (One Jim_Obj for each filename).
3116 * Also the object will be converted to something else if the given
3117 * token it represents in the source file is not something to be
3118 * evaluated (not a script), and will be specialized in some other way,
3119 * so the time overhead is also almost zero.
3120 * ---------------------------------------------------------------------------*/
3122 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3123 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3125 static const Jim_ObjType sourceObjType = {
3126 "source",
3127 FreeSourceInternalRep,
3128 DupSourceInternalRep,
3129 NULL,
3130 JIM_TYPE_REFERENCES,
3133 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3135 Jim_DecrRefCount(interp, objPtr->internalRep.sourceValue.fileNameObj);
3138 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3140 dupPtr->internalRep.sourceValue = srcPtr->internalRep.sourceValue;
3141 Jim_IncrRefCount(dupPtr->internalRep.sourceValue.fileNameObj);
3144 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
3145 Jim_Obj *fileNameObj, int lineNumber)
3147 JimPanic((Jim_IsShared(objPtr), "JimSetSourceInfo called with shared object"));
3148 JimPanic((objPtr->typePtr != NULL, "JimSetSourceInfo called with typed object"));
3149 Jim_IncrRefCount(fileNameObj);
3150 objPtr->internalRep.sourceValue.fileNameObj = fileNameObj;
3151 objPtr->internalRep.sourceValue.lineNumber = lineNumber;
3152 objPtr->typePtr = &sourceObjType;
3155 /* -----------------------------------------------------------------------------
3156 * ScriptLine Object
3158 * This object is used only in the Script internal represenation.
3159 * For each line of the script, it holds the number of tokens on the line
3160 * and the source line number.
3162 static const Jim_ObjType scriptLineObjType = {
3163 "scriptline",
3164 NULL,
3165 NULL,
3166 NULL,
3167 JIM_NONE,
3170 static Jim_Obj *JimNewScriptLineObj(Jim_Interp *interp, int argc, int line)
3172 Jim_Obj *objPtr;
3174 #ifdef DEBUG_SHOW_SCRIPT
3175 char buf[100];
3176 snprintf(buf, sizeof(buf), "line=%d, argc=%d", line, argc);
3177 objPtr = Jim_NewStringObj(interp, buf, -1);
3178 #else
3179 objPtr = Jim_NewEmptyStringObj(interp);
3180 #endif
3181 objPtr->typePtr = &scriptLineObjType;
3182 objPtr->internalRep.scriptLineValue.argc = argc;
3183 objPtr->internalRep.scriptLineValue.line = line;
3185 return objPtr;
3188 /* -----------------------------------------------------------------------------
3189 * Script Object
3191 * This object holds the parsed internal representation of a script.
3192 * This representation is help within an allocated ScriptObj (see below)
3194 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3195 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3197 static const Jim_ObjType scriptObjType = {
3198 "script",
3199 FreeScriptInternalRep,
3200 DupScriptInternalRep,
3201 NULL,
3202 JIM_TYPE_REFERENCES,
3205 /* Each token of a script is represented by a ScriptToken.
3206 * The ScriptToken contains a type and a Jim_Obj. The Jim_Obj
3207 * can be specialized by commands operating on it.
3209 typedef struct ScriptToken
3211 Jim_Obj *objPtr;
3212 int type;
3213 } ScriptToken;
3215 /* This is the script object internal representation. An array of
3216 * ScriptToken structures, including a pre-computed representation of the
3217 * command length and arguments.
3219 * For example the script:
3221 * puts hello
3222 * set $i $x$y [foo]BAR
3224 * will produce a ScriptObj with the following ScriptToken's:
3226 * LIN 2
3227 * ESC puts
3228 * ESC hello
3229 * LIN 4
3230 * ESC set
3231 * VAR i
3232 * WRD 2
3233 * VAR x
3234 * VAR y
3235 * WRD 2
3236 * CMD foo
3237 * ESC BAR
3239 * "puts hello" has two args (LIN 2), composed of single tokens.
3240 * (Note that the WRD token is omitted for the common case of a single token.)
3242 * "set $i $x$y [foo]BAR" has four (LIN 4) args, the first word
3243 * has 1 token (ESC SET), and the last has two tokens (WRD 2 CMD foo ESC BAR)
3245 * The precomputation of the command structure makes Jim_Eval() faster,
3246 * and simpler because there aren't dynamic lengths / allocations.
3248 * -- {expand}/{*} handling --
3250 * Expand is handled in a special way.
3252 * If a "word" begins with {*}, the word token count is -ve.
3254 * For example the command:
3256 * list {*}{a b}
3258 * Will produce the following cmdstruct array:
3260 * LIN 2
3261 * ESC list
3262 * WRD -1
3263 * STR a b
3265 * Note that the 'LIN' token also contains the source information for the
3266 * first word of the line for error reporting purposes
3268 * -- the substFlags field of the structure --
3270 * The scriptObj structure is used to represent both "script" objects
3271 * and "subst" objects. In the second case, there are no LIN and WRD
3272 * tokens. Instead SEP and EOL tokens are added as-is.
3273 * In addition, the field 'substFlags' is used to represent the flags used to turn
3274 * the string into the internal representation.
3275 * If these flags do not match what the application requires,
3276 * the scriptObj is created again. For example the script:
3278 * subst -nocommands $string
3279 * subst -novariables $string
3281 * Will (re)create the internal representation of the $string object
3282 * two times.
3284 typedef struct ScriptObj
3286 ScriptToken *token; /* Tokens array. */
3287 Jim_Obj *fileNameObj; /* Filename */
3288 int len; /* Length of token[] */
3289 int substFlags; /* flags used for the compilation of "subst" objects */
3290 int inUse; /* Used to share a ScriptObj. Currently
3291 only used by Jim_EvalObj() as protection against
3292 shimmering of the currently evaluated object. */
3293 int firstline; /* Line number of the first line */
3294 int linenr; /* Error line number, if any */
3295 int missing; /* Missing char if script failed to parse, (or space or backslash if OK) */
3296 } ScriptObj;
3298 static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3299 static int JimParseCheckMissing(Jim_Interp *interp, int ch);
3300 static ScriptObj *JimGetScript(Jim_Interp *interp, Jim_Obj *objPtr);
3302 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3304 int i;
3305 struct ScriptObj *script = (void *)objPtr->internalRep.ptr;
3307 if (--script->inUse != 0)
3308 return;
3309 for (i = 0; i < script->len; i++) {
3310 Jim_DecrRefCount(interp, script->token[i].objPtr);
3312 Jim_Free(script->token);
3313 Jim_DecrRefCount(interp, script->fileNameObj);
3314 Jim_Free(script);
3317 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3319 JIM_NOTUSED(interp);
3320 JIM_NOTUSED(srcPtr);
3322 /* Just return a simple string. We don't try to preserve the source info
3323 * since in practice scripts are never duplicated
3325 dupPtr->typePtr = NULL;
3328 /* A simple parse token.
3329 * As the script is parsed, the created tokens point into the script string rep.
3331 typedef struct
3333 const char *token; /* Pointer to the start of the token */
3334 int len; /* Length of this token */
3335 int type; /* Token type */
3336 int line; /* Line number */
3337 } ParseToken;
3339 /* A list of parsed tokens representing a script.
3340 * Tokens are added to this list as the script is parsed.
3341 * It grows as needed.
3343 typedef struct
3345 /* Start with a statically allocated list of tokens which will be expanded with realloc if needed */
3346 ParseToken *list; /* Array of tokens */
3347 int size; /* Current size of the list */
3348 int count; /* Number of entries used */
3349 ParseToken static_list[20]; /* Small initial token space to avoid allocation */
3350 } ParseTokenList;
3352 static void ScriptTokenListInit(ParseTokenList *tokenlist)
3354 tokenlist->list = tokenlist->static_list;
3355 tokenlist->size = sizeof(tokenlist->static_list) / sizeof(ParseToken);
3356 tokenlist->count = 0;
3359 static void ScriptTokenListFree(ParseTokenList *tokenlist)
3361 if (tokenlist->list != tokenlist->static_list) {
3362 Jim_Free(tokenlist->list);
3367 * Adds the new token to the tokenlist.
3368 * The token has the given length, type and line number.
3369 * The token list is resized as necessary.
3371 static void ScriptAddToken(ParseTokenList *tokenlist, const char *token, int len, int type,
3372 int line)
3374 ParseToken *t;
3376 if (tokenlist->count == tokenlist->size) {
3377 /* Resize the list */
3378 tokenlist->size *= 2;
3379 if (tokenlist->list != tokenlist->static_list) {
3380 tokenlist->list =
3381 Jim_Realloc(tokenlist->list, tokenlist->size * sizeof(*tokenlist->list));
3383 else {
3384 /* The list needs to become allocated */
3385 tokenlist->list = Jim_Alloc(tokenlist->size * sizeof(*tokenlist->list));
3386 memcpy(tokenlist->list, tokenlist->static_list,
3387 tokenlist->count * sizeof(*tokenlist->list));
3390 t = &tokenlist->list[tokenlist->count++];
3391 t->token = token;
3392 t->len = len;
3393 t->type = type;
3394 t->line = line;
3397 /* Counts the number of adjoining non-separator tokens.
3399 * Returns -ve if the first token is the expansion
3400 * operator (in which case the count doesn't include
3401 * that token).
3403 static int JimCountWordTokens(struct ScriptObj *script, ParseToken *t)
3405 int expand = 1;
3406 int count = 0;
3408 /* Is the first word {*} or {expand}? */
3409 if (t->type == JIM_TT_STR && !TOKEN_IS_SEP(t[1].type)) {
3410 if ((t->len == 1 && *t->token == '*') || (t->len == 6 && strncmp(t->token, "expand", 6) == 0)) {
3411 /* Create an expand token */
3412 expand = -1;
3413 t++;
3415 else {
3416 if (script->missing == ' ') {
3417 /* This is a "extra characters after close-brace" error. Report the first error */
3418 script->missing = '}';
3419 script->linenr = t[1].line;
3424 /* Now count non-separator words */
3425 while (!TOKEN_IS_SEP(t->type)) {
3426 t++;
3427 count++;
3430 return count * expand;
3434 * Create a script/subst object from the given token.
3436 static Jim_Obj *JimMakeScriptObj(Jim_Interp *interp, const ParseToken *t)
3438 Jim_Obj *objPtr;
3440 if (t->type == JIM_TT_ESC && memchr(t->token, '\\', t->len) != NULL) {
3441 /* Convert backlash escapes. The result will never be longer than the original */
3442 int len = t->len;
3443 char *str = Jim_Alloc(len + 1);
3444 len = JimEscape(str, t->token, len);
3445 objPtr = Jim_NewStringObjNoAlloc(interp, str, len);
3447 else {
3448 /* XXX: For strict Tcl compatibility, JIM_TT_STR should replace <backslash><newline><whitespace>
3449 * with a single space.
3451 objPtr = Jim_NewStringObj(interp, t->token, t->len);
3453 return objPtr;
3457 * Takes a tokenlist and creates the allocated list of script tokens
3458 * in script->token, of length script->len.
3460 * Unnecessary tokens are discarded, and LINE and WORD tokens are inserted
3461 * as required.
3463 * Also sets script->line to the line number of the first token
3465 static void ScriptObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3466 ParseTokenList *tokenlist)
3468 int i;
3469 struct ScriptToken *token;
3470 /* Number of tokens so far for the current command */
3471 int lineargs = 0;
3472 /* This is the first token for the current command */
3473 ScriptToken *linefirst;
3474 int count;
3475 int linenr;
3477 #ifdef DEBUG_SHOW_SCRIPT_TOKENS
3478 printf("==== Tokens ====\n");
3479 for (i = 0; i < tokenlist->count; i++) {
3480 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist->list[i].line, jim_tt_name(tokenlist->list[i].type),
3481 tokenlist->list[i].len, tokenlist->list[i].token);
3483 #endif
3485 /* May need up to one extra script token for each EOL in the worst case */
3486 count = tokenlist->count;
3487 for (i = 0; i < tokenlist->count; i++) {
3488 if (tokenlist->list[i].type == JIM_TT_EOL) {
3489 count++;
3492 linenr = script->firstline = tokenlist->list[0].line;
3494 token = script->token = Jim_Alloc(sizeof(ScriptToken) * count);
3496 /* This is the first token for the current command */
3497 linefirst = token++;
3499 for (i = 0; i < tokenlist->count; ) {
3500 /* Look ahead to find out how many tokens make up the next word */
3501 int wordtokens;
3503 /* Skip any leading separators */
3504 while (tokenlist->list[i].type == JIM_TT_SEP) {
3505 i++;
3508 wordtokens = JimCountWordTokens(script, tokenlist->list + i);
3510 if (wordtokens == 0) {
3511 /* None, so at end of line */
3512 if (lineargs) {
3513 linefirst->type = JIM_TT_LINE;
3514 linefirst->objPtr = JimNewScriptLineObj(interp, lineargs, linenr);
3515 Jim_IncrRefCount(linefirst->objPtr);
3517 /* Reset for new line */
3518 lineargs = 0;
3519 linefirst = token++;
3521 i++;
3522 continue;
3524 else if (wordtokens != 1) {
3525 /* More than 1, or {*}, so insert a WORD token */
3526 token->type = JIM_TT_WORD;
3527 token->objPtr = Jim_NewIntObj(interp, wordtokens);
3528 Jim_IncrRefCount(token->objPtr);
3529 token++;
3530 if (wordtokens < 0) {
3531 /* Skip the expand token */
3532 i++;
3533 wordtokens = -wordtokens - 1;
3534 lineargs--;
3538 if (lineargs == 0) {
3539 /* First real token on the line, so record the line number */
3540 linenr = tokenlist->list[i].line;
3542 lineargs++;
3544 /* Add each non-separator word token to the line */
3545 while (wordtokens--) {
3546 const ParseToken *t = &tokenlist->list[i++];
3548 token->type = t->type;
3549 token->objPtr = JimMakeScriptObj(interp, t);
3550 Jim_IncrRefCount(token->objPtr);
3552 /* Every object is initially a string of type 'source', but the
3553 * internal type may be specialized during execution of the
3554 * script. */
3555 JimSetSourceInfo(interp, token->objPtr, script->fileNameObj, t->line);
3556 token++;
3560 if (lineargs == 0) {
3561 token--;
3564 script->len = token - script->token;
3566 JimPanic((script->len >= count, "allocated script array is too short"));
3568 #ifdef DEBUG_SHOW_SCRIPT
3569 printf("==== Script (%s) ====\n", Jim_String(script->fileNameObj));
3570 for (i = 0; i < script->len; i++) {
3571 const ScriptToken *t = &script->token[i];
3572 printf("[%2d] %s %s\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
3574 #endif
3578 /* Parses the given string object to determine if it represents a complete script.
3580 * This is useful for interactive shells implementation, for [info complete].
3582 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
3583 * '{' on scripts incomplete missing one or more '}' to be balanced.
3584 * '[' on scripts incomplete missing one or more ']' to be balanced.
3585 * '"' on scripts incomplete missing a '"' char.
3586 * '\\' on scripts with a trailing backslash.
3588 * If the script is complete, 1 is returned, otherwise 0.
3590 * If the script has extra characters after a close brace, this still returns 1,
3591 * but sets *stateCharPtr to '}'
3592 * Evaluating the script will give the error "extra characters after close-brace".
3594 int Jim_ScriptIsComplete(Jim_Interp *interp, Jim_Obj *scriptObj, char *stateCharPtr)
3596 ScriptObj *script = JimGetScript(interp, scriptObj);
3597 if (stateCharPtr) {
3598 *stateCharPtr = script->missing;
3600 return script->missing == ' ' || script->missing == '}';
3604 * Sets an appropriate error message for a missing script/expression terminator.
3606 * Returns JIM_ERR if 'ch' represents an unmatched/missing character.
3608 * Note that a trailing backslash is not considered to be an error.
3610 static int JimParseCheckMissing(Jim_Interp *interp, int ch)
3612 const char *msg;
3614 switch (ch) {
3615 case '\\':
3616 case ' ':
3617 return JIM_OK;
3619 case '[':
3620 msg = "unmatched \"[\"";
3621 break;
3622 case '{':
3623 msg = "missing close-brace";
3624 break;
3625 case '}':
3626 msg = "extra characters after close-brace";
3627 break;
3628 case '"':
3629 default:
3630 msg = "missing quote";
3631 break;
3634 Jim_SetResultString(interp, msg, -1);
3635 return JIM_ERR;
3639 * Similar to ScriptObjAddTokens(), but for subst objects.
3641 static void SubstObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3642 ParseTokenList *tokenlist)
3644 int i;
3645 struct ScriptToken *token;
3647 token = script->token = Jim_Alloc(sizeof(ScriptToken) * tokenlist->count);
3649 for (i = 0; i < tokenlist->count; i++) {
3650 const ParseToken *t = &tokenlist->list[i];
3652 /* Create a token for 't' */
3653 token->type = t->type;
3654 token->objPtr = JimMakeScriptObj(interp, t);
3655 Jim_IncrRefCount(token->objPtr);
3656 token++;
3659 script->len = i;
3662 /* This method takes the string representation of an object
3663 * as a Tcl script, and generates the pre-parsed internal representation
3664 * of the script.
3666 * On parse error, sets an error message and returns JIM_ERR
3667 * (Note: the object is still converted to a script, even if an error occurs)
3669 static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3671 int scriptTextLen;
3672 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
3673 struct JimParserCtx parser;
3674 struct ScriptObj *script;
3675 ParseTokenList tokenlist;
3676 int line = 1;
3678 /* Try to get information about filename / line number */
3679 if (objPtr->typePtr == &sourceObjType) {
3680 line = objPtr->internalRep.sourceValue.lineNumber;
3683 /* Initially parse the script into tokens (in tokenlist) */
3684 ScriptTokenListInit(&tokenlist);
3686 JimParserInit(&parser, scriptText, scriptTextLen, line);
3687 while (!parser.eof) {
3688 JimParseScript(&parser);
3689 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
3690 parser.tline);
3693 /* Add a final EOF token */
3694 ScriptAddToken(&tokenlist, scriptText + scriptTextLen, 0, JIM_TT_EOF, 0);
3696 /* Create the "real" script tokens from the parsed tokens */
3697 script = Jim_Alloc(sizeof(*script));
3698 memset(script, 0, sizeof(*script));
3699 script->inUse = 1;
3700 if (objPtr->typePtr == &sourceObjType) {
3701 script->fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
3703 else {
3704 script->fileNameObj = interp->emptyObj;
3706 Jim_IncrRefCount(script->fileNameObj);
3707 script->missing = parser.missing.ch;
3708 script->linenr = parser.missing.line;
3710 ScriptObjAddTokens(interp, script, &tokenlist);
3712 /* No longer need the token list */
3713 ScriptTokenListFree(&tokenlist);
3715 /* Free the old internal rep and set the new one. */
3716 Jim_FreeIntRep(interp, objPtr);
3717 Jim_SetIntRepPtr(objPtr, script);
3718 objPtr->typePtr = &scriptObjType;
3721 static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script);
3724 * Returns the parsed script.
3725 * Note that if there is any possibility that the script is not valid,
3726 * call JimScriptValid() to check
3728 static ScriptObj *JimGetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3730 if (objPtr == interp->emptyObj) {
3731 /* Avoid converting emptyObj to a script. use nullScriptObj instead. */
3732 objPtr = interp->nullScriptObj;
3735 if (objPtr->typePtr != &scriptObjType || ((struct ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags) {
3736 JimSetScriptFromAny(interp, objPtr);
3739 return (ScriptObj *)Jim_GetIntRepPtr(objPtr);
3743 * Returns 1 if the script is valid (parsed ok), otherwise returns 0
3744 * and leaves an error message in the interp result.
3747 static int JimScriptValid(Jim_Interp *interp, ScriptObj *script)
3749 if (JimParseCheckMissing(interp, script->missing) == JIM_ERR) {
3750 JimAddErrorToStack(interp, script);
3751 return 0;
3753 return 1;
3757 /* -----------------------------------------------------------------------------
3758 * Commands
3759 * ---------------------------------------------------------------------------*/
3760 void Jim_InterpIncrProcEpoch(Jim_Interp *interp)
3762 interp->procEpoch++;
3764 /* Now discard all out-of-date Jim_Cmd entries */
3765 while (interp->oldCmdCache) {
3766 Jim_Cmd *next = interp->oldCmdCache->prevCmd;
3767 Jim_Free(interp->oldCmdCache);
3768 interp->oldCmdCache = next;
3770 interp->oldCmdCacheSize = 0;
3773 static void JimIncrCmdRefCount(Jim_Cmd *cmdPtr)
3775 cmdPtr->inUse++;
3778 static void JimDecrCmdRefCount(Jim_Interp *interp, Jim_Cmd *cmdPtr)
3780 if (--cmdPtr->inUse == 0) {
3781 if (cmdPtr->isproc) {
3782 Jim_DecrRefCount(interp, cmdPtr->u.proc.argListObjPtr);
3783 Jim_DecrRefCount(interp, cmdPtr->u.proc.bodyObjPtr);
3784 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
3785 if (cmdPtr->u.proc.staticVars) {
3786 Jim_FreeHashTable(cmdPtr->u.proc.staticVars);
3787 Jim_Free(cmdPtr->u.proc.staticVars);
3790 else {
3791 /* native (C) */
3792 if (cmdPtr->u.native.delProc) {
3793 cmdPtr->u.native.delProc(interp, cmdPtr->u.native.privData);
3796 if (cmdPtr->prevCmd) {
3797 /* Delete any pushed command too */
3798 JimDecrCmdRefCount(interp, cmdPtr->prevCmd);
3801 if (interp->quitting) {
3802 Jim_Free(cmdPtr);
3804 else {
3805 /* Preserve the structure with inUse = 0 so that
3806 * cached references will continue to work.
3807 * These will be discarding at the next procEpoch increment
3808 * or once 1000 have been accumulated.
3810 cmdPtr->prevCmd = interp->oldCmdCache;
3811 interp->oldCmdCache = cmdPtr;
3812 if (++interp->oldCmdCacheSize >= 1000) {
3813 Jim_InterpIncrProcEpoch(interp);
3819 /* Variables HashTable Type.
3821 * Keys are dynamically allocated strings, Values are Jim_Var structures.
3823 static void JimVariablesHTValDestructor(void *interp, void *val)
3825 Jim_DecrRefCount(interp, ((Jim_Var *)val)->objPtr);
3826 Jim_Free(val);
3829 static unsigned int JimObjectHTHashFunction(const void *key)
3831 int len;
3832 const char *str = Jim_GetString((Jim_Obj *)key, &len);
3833 return Jim_GenHashFunction((const unsigned char *)str, len);
3836 static int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
3838 return Jim_StringEqObj((Jim_Obj *)key1, (Jim_Obj *)key2);
3841 static void *JimObjectHTKeyValDup(void *privdata, const void *val)
3843 Jim_IncrRefCount((Jim_Obj *)val);
3844 return (void *)val;
3847 static void JimObjectHTKeyValDestructor(void *interp, void *val)
3849 Jim_DecrRefCount(interp, (Jim_Obj *)val);
3853 static const Jim_HashTableType JimVariablesHashTableType = {
3854 JimObjectHTHashFunction, /* hash function */
3855 JimObjectHTKeyValDup, /* key dup */
3856 NULL, /* val dup */
3857 JimObjectHTKeyCompare, /* key compare */
3858 JimObjectHTKeyValDestructor, /* key destructor */
3859 JimVariablesHTValDestructor /* val destructor */
3862 /* Commands HashTable Type.
3864 * Keys are Jim Objects where any leading namespace qualifier
3865 * is ignored. Values are Jim_Cmd structures.
3869 * Like Jim_GetString() but strips any leading namespace qualifier.
3871 static const char *Jim_GetStringNoQualifier(Jim_Obj *objPtr, int *length)
3873 int len;
3874 const char *str = Jim_GetString(objPtr, &len);
3875 if (len >= 2 && str[0] == ':' && str[1] == ':') {
3876 while (len && *str == ':') {
3877 len--;
3878 str++;
3881 *length = len;
3882 return str;
3885 static unsigned int JimCommandsHT_HashFunction(const void *key)
3887 int len;
3888 const char *str = Jim_GetStringNoQualifier((Jim_Obj *)key, &len);
3889 return Jim_GenHashFunction((const unsigned char *)str, len);
3892 static int JimCommandsHT_KeyCompare(void *privdata, const void *key1, const void *key2)
3894 int len1, len2;
3895 const char *str1 = Jim_GetStringNoQualifier((Jim_Obj *)key1, &len1);
3896 const char *str2 = Jim_GetStringNoQualifier((Jim_Obj *)key2, &len2);
3897 return len1 == len2 && memcmp(str1, str2, len1) == 0;
3900 static void JimCommandsHT_ValDestructor(void *interp, void *val)
3902 JimDecrCmdRefCount(interp, val);
3905 static const Jim_HashTableType JimCommandsHashTableType = {
3906 JimCommandsHT_HashFunction, /* hash function */
3907 JimObjectHTKeyValDup, /* key dup */
3908 NULL, /* val dup */
3909 JimCommandsHT_KeyCompare, /* key compare */
3910 JimObjectHTKeyValDestructor, /* key destructor */
3911 JimCommandsHT_ValDestructor /* val destructor */
3914 /* ------------------------- Commands related functions --------------------- */
3917 * If nameObjPtr starts with "::", returns it.
3918 * Otherwise returns a new object with nameObjPtr prefixed with "::".
3919 * In this case, decrements the ref count of nameObjPtr.
3921 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3923 #ifdef jim_ext_namespace
3924 Jim_Obj *resultObj;
3926 const char *name = Jim_String(nameObjPtr);
3927 if (name[0] == ':' && name[1] == ':') {
3928 return nameObjPtr;
3930 Jim_IncrRefCount(nameObjPtr);
3931 resultObj = Jim_NewStringObj(interp, "::", -1);
3932 Jim_AppendObj(interp, resultObj, nameObjPtr);
3933 Jim_DecrRefCount(interp, nameObjPtr);
3935 return resultObj;
3936 #else
3937 return nameObjPtr;
3938 #endif
3942 * If the name in objPtr is not fully qualified, and a non-global namespace
3943 * is in effect, qualifies the name with the current namespace and returns the new name.
3944 * Otherwise returns objPtr.
3946 * In either case the ref count is incremented and should be decremented by the caller.
3947 * with Jim_DecrRefCount()
3949 static Jim_Obj *JimQualifyName(Jim_Interp *interp, Jim_Obj *objPtr)
3951 #ifdef jim_ext_namespace
3952 if (Jim_Length(interp->framePtr->nsObj)) {
3953 int len;
3954 const char *name = Jim_GetString(objPtr, &len);
3955 if (len < 2 || name[0] != ':' || name[1] != ':') {
3956 /* OK. Need to qualify this name */
3957 objPtr = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3958 Jim_AppendStrings(interp, objPtr, "::", name, NULL);
3961 #endif
3962 Jim_IncrRefCount(objPtr);
3963 return objPtr;
3967 * Note that nameObjPtr must already be namespace qualified.
3969 static int JimCreateCommand(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Cmd *cmd)
3971 /* It may already exist, so we try to delete the old one.
3972 * Note that reference count means that it won't be deleted yet if
3973 * it exists in the call stack.
3975 * BUT, if 'local' is in force, instead of deleting the existing
3976 * proc, we stash a reference to the old proc here.
3978 Jim_HashEntry *he = Jim_FindHashEntry(&interp->commands, nameObjPtr);
3979 if (he) {
3980 /* There was an old cmd with the same name,
3981 * so this requires a 'proc epoch' update. */
3983 /* If a procedure with the same name didn't exist there is no need
3984 * to increment the 'proc epoch' because creation of a new procedure
3985 * can never affect existing cached commands. We don't do
3986 * negative caching. */
3987 //Jim_InterpIncrProcEpoch(interp);
3990 if (he && interp->local) {
3991 /* Push this command over the top of the previous one */
3992 cmd->prevCmd = Jim_GetHashEntryVal(he);
3993 Jim_SetHashVal(&interp->commands, he, cmd);
3994 /* Need to increment the proc epoch here so that the new command will be used */
3995 Jim_InterpIncrProcEpoch(interp);
3997 else {
3998 if (he) {
3999 /* Replace the existing command */
4000 Jim_DeleteHashEntry(&interp->commands, nameObjPtr);
4003 Jim_AddHashEntry(&interp->commands, nameObjPtr, cmd);
4005 return JIM_OK;
4008 int Jim_CreateCommandObj(Jim_Interp *interp, Jim_Obj *cmdNameObj,
4009 Jim_CmdProc *cmdProc, void *privData, Jim_DelCmdProc *delProc)
4011 Jim_Cmd *cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
4013 /* Store the new details for this command */
4014 memset(cmdPtr, 0, sizeof(*cmdPtr));
4015 cmdPtr->inUse = 1;
4016 cmdPtr->u.native.delProc = delProc;
4017 cmdPtr->u.native.cmdProc = cmdProc;
4018 cmdPtr->u.native.privData = privData;
4020 JimCreateCommand(interp, cmdNameObj, cmdPtr);
4022 return JIM_OK;
4026 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdNameStr,
4027 Jim_CmdProc *cmdProc, void *privData, Jim_DelCmdProc *delProc)
4029 return Jim_CreateCommandObj(interp, Jim_NewStringObj(interp, cmdNameStr, -1), cmdProc, privData, delProc);
4032 static int JimCreateProcedureStatics(Jim_Interp *interp, Jim_Cmd *cmdPtr, Jim_Obj *staticsListObjPtr)
4034 int len, i;
4036 len = Jim_ListLength(interp, staticsListObjPtr);
4037 if (len == 0) {
4038 return JIM_OK;
4041 cmdPtr->u.proc.staticVars = Jim_Alloc(sizeof(Jim_HashTable));
4042 Jim_InitHashTable(cmdPtr->u.proc.staticVars, &JimVariablesHashTableType, interp);
4043 for (i = 0; i < len; i++) {
4044 Jim_Obj *objPtr, *initObjPtr, *nameObjPtr;
4045 Jim_Var *varPtr;
4046 int subLen;
4048 objPtr = Jim_ListGetIndex(interp, staticsListObjPtr, i);
4049 /* Check if it's composed of two elements. */
4050 subLen = Jim_ListLength(interp, objPtr);
4051 if (subLen == 1 || subLen == 2) {
4052 /* Try to get the variable value from the current
4053 * environment. */
4054 nameObjPtr = Jim_ListGetIndex(interp, objPtr, 0);
4055 if (subLen == 1) {
4056 initObjPtr = Jim_GetVariable(interp, nameObjPtr, JIM_NONE);
4057 if (initObjPtr == NULL) {
4058 Jim_SetResultFormatted(interp,
4059 "variable for initialization of static \"%#s\" not found in the local context",
4060 nameObjPtr);
4061 return JIM_ERR;
4064 else {
4065 initObjPtr = Jim_ListGetIndex(interp, objPtr, 1);
4068 varPtr = Jim_Alloc(sizeof(*varPtr));
4069 varPtr->objPtr = initObjPtr;
4070 Jim_IncrRefCount(initObjPtr);
4071 varPtr->linkFramePtr = NULL;
4072 if (JimSetNewVariable(cmdPtr->u.proc.staticVars, nameObjPtr, varPtr) != JIM_OK) {
4073 Jim_SetResultFormatted(interp,
4074 "static variable name \"%#s\" duplicated in statics list", nameObjPtr);
4075 Jim_DecrRefCount(interp, initObjPtr);
4076 Jim_Free(varPtr);
4077 return JIM_ERR;
4080 else {
4081 Jim_SetResultFormatted(interp, "too many fields in static specifier \"%#s\"",
4082 objPtr);
4083 return JIM_ERR;
4086 return JIM_OK;
4089 /* memrchr() is not standard */
4090 static const char *Jim_memrchr(const char *p, int c, int len)
4092 int i;
4093 for (i = len; i > 0; i--) {
4094 if (p[i] == c) {
4095 return p + i;
4098 return NULL;
4102 * If the command is a proc, sets/updates the cached namespace (nsObj)
4103 * based on the command name.
4105 static void JimUpdateProcNamespace(Jim_Interp *interp, Jim_Cmd *cmdPtr, Jim_Obj *nameObjPtr)
4107 #ifdef jim_ext_namespace
4108 if (cmdPtr->isproc) {
4109 int len;
4110 const char *cmdname = Jim_GetStringNoQualifier(nameObjPtr, &len);
4111 /* XXX: Really need JimNamespaceSplit() */
4112 const char *pt = Jim_memrchr(cmdname, ':', len);
4113 if (pt && pt != cmdname && pt[-1] == ':') {
4114 pt++;
4115 /* Now pt points to the base name .e.g. ::abc::def::ghi points to ghi
4116 * while cmdname points to abc
4118 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
4119 cmdPtr->u.proc.nsObj = Jim_NewStringObj(interp, cmdname, pt - cmdname - 2);
4120 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
4122 Jim_Obj *tempObj = Jim_NewStringObj(interp, pt, len - (pt - cmdname));
4123 if (Jim_FindHashEntry(&interp->commands, tempObj)) {
4124 /* This command shadows a global command, so a proc epoch update is required */
4125 Jim_InterpIncrProcEpoch(interp);
4127 Jim_FreeNewObj(interp, tempObj);
4130 #endif
4133 static Jim_Cmd *JimCreateProcedureCmd(Jim_Interp *interp, Jim_Obj *argListObjPtr,
4134 Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr, Jim_Obj *nsObj)
4136 Jim_Cmd *cmdPtr;
4137 int argListLen;
4138 int i;
4140 argListLen = Jim_ListLength(interp, argListObjPtr);
4142 /* Allocate space for both the command pointer and the arg list */
4143 cmdPtr = Jim_Alloc(sizeof(*cmdPtr) + sizeof(struct Jim_ProcArg) * argListLen);
4144 memset(cmdPtr, 0, sizeof(*cmdPtr));
4145 cmdPtr->inUse = 1;
4146 cmdPtr->isproc = 1;
4147 cmdPtr->u.proc.argListObjPtr = argListObjPtr;
4148 cmdPtr->u.proc.argListLen = argListLen;
4149 cmdPtr->u.proc.bodyObjPtr = bodyObjPtr;
4150 cmdPtr->u.proc.argsPos = -1;
4151 cmdPtr->u.proc.arglist = (struct Jim_ProcArg *)(cmdPtr + 1);
4152 cmdPtr->u.proc.nsObj = nsObj ? nsObj : interp->emptyObj;
4153 Jim_IncrRefCount(argListObjPtr);
4154 Jim_IncrRefCount(bodyObjPtr);
4155 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
4157 /* Create the statics hash table. */
4158 if (staticsListObjPtr && JimCreateProcedureStatics(interp, cmdPtr, staticsListObjPtr) != JIM_OK) {
4159 goto err;
4162 /* Parse the args out into arglist, validating as we go */
4163 /* Examine the argument list for default parameters and 'args' */
4164 for (i = 0; i < argListLen; i++) {
4165 Jim_Obj *argPtr;
4166 Jim_Obj *nameObjPtr;
4167 Jim_Obj *defaultObjPtr;
4168 int len;
4170 /* Examine a parameter */
4171 argPtr = Jim_ListGetIndex(interp, argListObjPtr, i);
4172 len = Jim_ListLength(interp, argPtr);
4173 if (len == 0) {
4174 Jim_SetResultString(interp, "argument with no name", -1);
4175 err:
4176 JimDecrCmdRefCount(interp, cmdPtr);
4177 return NULL;
4179 if (len > 2) {
4180 Jim_SetResultFormatted(interp, "too many fields in argument specifier \"%#s\"", argPtr);
4181 goto err;
4184 if (len == 2) {
4185 /* Optional parameter */
4186 nameObjPtr = Jim_ListGetIndex(interp, argPtr, 0);
4187 defaultObjPtr = Jim_ListGetIndex(interp, argPtr, 1);
4189 else {
4190 /* Required parameter */
4191 nameObjPtr = argPtr;
4192 defaultObjPtr = NULL;
4196 if (Jim_CompareStringImmediate(interp, nameObjPtr, "args")) {
4197 if (cmdPtr->u.proc.argsPos >= 0) {
4198 Jim_SetResultString(interp, "'args' specified more than once", -1);
4199 goto err;
4201 cmdPtr->u.proc.argsPos = i;
4203 else {
4204 if (len == 2) {
4205 cmdPtr->u.proc.optArity++;
4207 else {
4208 cmdPtr->u.proc.reqArity++;
4212 cmdPtr->u.proc.arglist[i].nameObjPtr = nameObjPtr;
4213 cmdPtr->u.proc.arglist[i].defaultObjPtr = defaultObjPtr;
4216 return cmdPtr;
4219 int Jim_DeleteCommand(Jim_Interp *interp, Jim_Obj *nameObj)
4221 int ret = JIM_OK;
4223 nameObj = JimQualifyName(interp, nameObj);
4225 if (Jim_DeleteHashEntry(&interp->commands, nameObj) == JIM_ERR) {
4226 Jim_SetResultFormatted(interp, "can't delete \"%#s\": command doesn't exist", nameObj);
4227 ret = JIM_ERR;
4229 Jim_DecrRefCount(interp, nameObj);
4231 return ret;
4234 int Jim_RenameCommand(Jim_Interp *interp, Jim_Obj *oldNameObj, Jim_Obj *newNameObj)
4236 int ret = JIM_ERR;
4237 Jim_HashEntry *he;
4238 Jim_Cmd *cmdPtr;
4240 if (Jim_Length(newNameObj) == 0) {
4241 return Jim_DeleteCommand(interp, oldNameObj);
4244 /* each name may need to have the current namespace added to it */
4246 oldNameObj = JimQualifyName(interp, oldNameObj);
4247 newNameObj = JimQualifyName(interp, newNameObj);
4249 /* Does it exist? */
4250 he = Jim_FindHashEntry(&interp->commands, oldNameObj);
4251 if (he == NULL) {
4252 Jim_SetResultFormatted(interp, "can't rename \"%#s\": command doesn't exist", oldNameObj);
4254 else if (Jim_FindHashEntry(&interp->commands, newNameObj)) {
4255 Jim_SetResultFormatted(interp, "can't rename to \"%#s\": command already exists", newNameObj);
4257 else {
4258 cmdPtr = Jim_GetHashEntryVal(he);
4259 if (cmdPtr->prevCmd) {
4260 /* If the command replaced another command with 'local', renaming it
4261 * would break the usage of upcall, so don't allow it.
4263 Jim_SetResultFormatted(interp, "can't rename local command \"%#s\"", oldNameObj);
4265 else {
4266 /* Add the new name first */
4267 JimIncrCmdRefCount(cmdPtr);
4268 JimUpdateProcNamespace(interp, cmdPtr, newNameObj);
4269 Jim_AddHashEntry(&interp->commands, newNameObj, cmdPtr);
4271 /* Now remove the old name */
4272 Jim_DeleteHashEntry(&interp->commands, oldNameObj);
4274 /* Increment the epoch */
4275 Jim_InterpIncrProcEpoch(interp);
4277 ret = JIM_OK;
4281 Jim_DecrRefCount(interp, oldNameObj);
4282 Jim_DecrRefCount(interp, newNameObj);
4284 return ret;
4287 /* -----------------------------------------------------------------------------
4288 * Command object
4289 * ---------------------------------------------------------------------------*/
4291 static void FreeCommandInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4293 Jim_DecrRefCount(interp, objPtr->internalRep.cmdValue.nsObj);
4296 static void DupCommandInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4298 dupPtr->internalRep.cmdValue = srcPtr->internalRep.cmdValue;
4299 dupPtr->typePtr = srcPtr->typePtr;
4300 Jim_IncrRefCount(dupPtr->internalRep.cmdValue.nsObj);
4303 static const Jim_ObjType commandObjType = {
4304 "command",
4305 FreeCommandInternalRep,
4306 DupCommandInternalRep,
4307 NULL,
4308 JIM_TYPE_REFERENCES,
4311 /* This function returns the command structure for the command name
4312 * stored in objPtr. It specializes the objPtr to contain
4313 * cached info instead of performing the lookup into the hash table
4314 * every time. The information cached may not be up-to-date, in this
4315 * case the lookup is performed and the cache updated.
4317 * Respects the 'upcall' setting.
4319 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4321 Jim_Cmd *cmd;
4323 /* In order to be valid, the proc epoch must match and
4324 * the lookup must have occurred in the same namespace
4326 if (objPtr->typePtr == &commandObjType
4327 && objPtr->internalRep.cmdValue.procEpoch == interp->procEpoch
4328 #ifdef jim_ext_namespace
4329 && Jim_StringEqObj(objPtr->internalRep.cmdValue.nsObj, interp->framePtr->nsObj)
4330 #endif
4331 && objPtr->internalRep.cmdValue.cmdPtr->inUse) {
4332 /* Cached value is valid */
4333 cmd = objPtr->internalRep.cmdValue.cmdPtr;
4335 else {
4336 Jim_Obj *qualifiedNameObj = JimQualifyName(interp, objPtr);
4337 Jim_HashEntry *he = Jim_FindHashEntry(&interp->commands, qualifiedNameObj);
4338 #ifdef jim_ext_namespace
4339 if (he == NULL && Jim_Length(interp->framePtr->nsObj)) {
4340 he = Jim_FindHashEntry(&interp->commands, objPtr);
4342 #endif
4343 if (he == NULL) {
4344 if (flags & JIM_ERRMSG) {
4345 Jim_SetResultFormatted(interp, "invalid command name \"%#s\"", objPtr);
4347 Jim_DecrRefCount(interp, qualifiedNameObj);
4348 return NULL;
4350 cmd = Jim_GetHashEntryVal(he);
4352 /* Free the old internal rep and set the new one. */
4353 Jim_FreeIntRep(interp, objPtr);
4354 objPtr->typePtr = &commandObjType;
4355 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
4356 objPtr->internalRep.cmdValue.cmdPtr = cmd;
4357 objPtr->internalRep.cmdValue.nsObj = interp->framePtr->nsObj;
4358 Jim_IncrRefCount(interp->framePtr->nsObj);
4359 Jim_DecrRefCount(interp, qualifiedNameObj);
4361 while (cmd->u.proc.upcall) {
4362 cmd = cmd->prevCmd;
4364 return cmd;
4367 /* -----------------------------------------------------------------------------
4368 * Variables
4369 * ---------------------------------------------------------------------------*/
4371 /* -----------------------------------------------------------------------------
4372 * Variable object
4373 * ---------------------------------------------------------------------------*/
4375 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
4377 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4379 static const Jim_ObjType variableObjType = {
4380 "variable",
4381 NULL,
4382 NULL,
4383 NULL,
4384 JIM_TYPE_REFERENCES,
4387 /* This method should be called only by the variable API.
4388 * It returns JIM_OK on success (variable already exists),
4389 * JIM_ERR if it does not exist, JIM_DICT_SUGAR if it's not
4390 * a variable name, but syntax glue for [dict] i.e. the last
4391 * character is ')' */
4392 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
4394 const char *varName;
4395 Jim_CallFrame *framePtr;
4396 int global;
4397 int len;
4398 Jim_Var *var;
4400 /* Check if the object is already an uptodate variable */
4401 if (objPtr->typePtr == &variableObjType) {
4402 framePtr = objPtr->internalRep.varValue.global ? interp->topFramePtr : interp->framePtr;
4403 if (objPtr->internalRep.varValue.callFrameId == framePtr->id) {
4404 /* nothing to do */
4405 return JIM_OK;
4407 /* Need to re-resolve the variable in the updated callframe */
4409 else if (objPtr->typePtr == &dictSubstObjType) {
4410 return JIM_DICT_SUGAR;
4413 varName = Jim_GetString(objPtr, &len);
4415 /* Make sure it's not syntax glue to get/set dict. */
4416 if (len && varName[len - 1] == ')' && strchr(varName, '(') != NULL) {
4417 return JIM_DICT_SUGAR;
4420 if (varName[0] == ':' && varName[1] == ':') {
4421 while (*varName == ':') {
4422 varName++;
4423 len--;
4425 global = 1;
4426 framePtr = interp->topFramePtr;
4427 /* XXX should use length */
4428 Jim_Obj *tempObj = Jim_NewStringObj(interp, varName, len);
4429 var = JimFindVariable(&framePtr->vars, tempObj);
4430 Jim_FreeNewObj(interp, tempObj);
4432 else {
4433 global = 0;
4434 framePtr = interp->framePtr;
4435 /* Resolve this name in the variables hash table */
4436 var = JimFindVariable(&framePtr->vars, objPtr);
4437 if (var == NULL && framePtr->staticVars) {
4438 /* Try with static vars. */
4439 var = JimFindVariable(framePtr->staticVars, objPtr);
4443 if (var == NULL) {
4444 return JIM_ERR;
4447 /* Free the old internal repr and set the new one. */
4448 Jim_FreeIntRep(interp, objPtr);
4449 objPtr->typePtr = &variableObjType;
4450 objPtr->internalRep.varValue.callFrameId = framePtr->id;
4451 objPtr->internalRep.varValue.varPtr = var;
4452 objPtr->internalRep.varValue.global = global;
4453 return JIM_OK;
4456 /* -------------------- Variables related functions ------------------------- */
4457 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr, Jim_Obj *valObjPtr);
4458 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr, int flags);
4460 static int JimSetNewVariable(Jim_HashTable *ht, Jim_Obj *nameObjPtr, Jim_Var *var)
4462 return Jim_AddHashEntry(ht, nameObjPtr, var);
4465 static Jim_Var *JimFindVariable(Jim_HashTable *ht, Jim_Obj *nameObjPtr)
4467 Jim_HashEntry *he = Jim_FindHashEntry(ht, nameObjPtr);
4468 if (he) {
4469 return (Jim_Var *)Jim_GetHashEntryVal(he);
4471 return NULL;
4474 static int JimUnsetVariable(Jim_HashTable *ht, Jim_Obj *nameObjPtr)
4476 return Jim_DeleteHashEntry(ht, nameObjPtr);
4479 static Jim_Var *JimCreateVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4481 const char *name;
4482 Jim_CallFrame *framePtr;
4483 int global;
4484 int len;
4486 /* New variable to create */
4487 Jim_Var *var = Jim_Alloc(sizeof(*var));
4489 var->objPtr = valObjPtr;
4490 Jim_IncrRefCount(valObjPtr);
4491 var->linkFramePtr = NULL;
4493 name = Jim_GetString(nameObjPtr, &len);
4494 if (name[0] == ':' && name[1] == ':') {
4495 while (*name == ':') {
4496 name++;
4497 len--;
4499 framePtr = interp->topFramePtr;
4500 global = 1;
4501 JimSetNewVariable(&framePtr->vars, Jim_NewStringObj(interp, name, len), var);
4503 else {
4504 framePtr = interp->framePtr;
4505 global = 0;
4506 JimSetNewVariable(&framePtr->vars, nameObjPtr, var);
4509 /* Make the object int rep a variable */
4510 Jim_FreeIntRep(interp, nameObjPtr);
4511 nameObjPtr->typePtr = &variableObjType;
4512 nameObjPtr->internalRep.varValue.callFrameId = framePtr->id;
4513 nameObjPtr->internalRep.varValue.varPtr = var;
4514 nameObjPtr->internalRep.varValue.global = global;
4516 return var;
4519 /* For now that's dummy. Variables lookup should be optimized
4520 * in many ways, with caching of lookups, and possibly with
4521 * a table of pre-allocated vars in every CallFrame for local vars.
4522 * All the caching should also have an 'epoch' mechanism similar
4523 * to the one used by Tcl for procedures lookup caching. */
4526 * Set the variable nameObjPtr to value valObjptr.
4528 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4530 int err;
4531 Jim_Var *var;
4533 switch (SetVariableFromAny(interp, nameObjPtr)) {
4534 case JIM_DICT_SUGAR:
4535 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
4537 case JIM_ERR:
4538 JimCreateVariable(interp, nameObjPtr, valObjPtr);
4539 break;
4541 case JIM_OK:
4542 var = nameObjPtr->internalRep.varValue.varPtr;
4543 if (var->linkFramePtr == NULL) {
4544 Jim_IncrRefCount(valObjPtr);
4545 Jim_DecrRefCount(interp, var->objPtr);
4546 var->objPtr = valObjPtr;
4548 else { /* Else handle the link */
4549 Jim_CallFrame *savedCallFrame;
4551 savedCallFrame = interp->framePtr;
4552 interp->framePtr = var->linkFramePtr;
4553 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
4554 interp->framePtr = savedCallFrame;
4555 if (err != JIM_OK)
4556 return err;
4559 return JIM_OK;
4562 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4564 Jim_Obj *nameObjPtr;
4565 int result;
4567 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4568 Jim_IncrRefCount(nameObjPtr);
4569 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
4570 Jim_DecrRefCount(interp, nameObjPtr);
4571 return result;
4574 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4576 Jim_CallFrame *savedFramePtr;
4577 int result;
4579 savedFramePtr = interp->framePtr;
4580 interp->framePtr = interp->topFramePtr;
4581 result = Jim_SetVariableStr(interp, name, objPtr);
4582 interp->framePtr = savedFramePtr;
4583 return result;
4586 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
4588 Jim_Obj *valObjPtr;
4589 int result;
4591 valObjPtr = Jim_NewStringObj(interp, val, -1);
4592 Jim_IncrRefCount(valObjPtr);
4593 result = Jim_SetVariableStr(interp, name, valObjPtr);
4594 Jim_DecrRefCount(interp, valObjPtr);
4595 return result;
4598 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
4599 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
4601 const char *varName;
4602 const char *targetName;
4603 Jim_CallFrame *framePtr;
4604 Jim_Var *varPtr;
4605 int len;
4606 int varnamelen;
4608 /* Check for an existing variable or link */
4609 switch (SetVariableFromAny(interp, nameObjPtr)) {
4610 case JIM_DICT_SUGAR:
4611 /* XXX: This message seem unnecessarily verbose, but it matches Tcl */
4612 Jim_SetResultFormatted(interp, "bad variable name \"%#s\": upvar won't create a scalar variable that looks like an array element", nameObjPtr);
4613 return JIM_ERR;
4615 case JIM_OK:
4616 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4618 if (varPtr->linkFramePtr == NULL) {
4619 Jim_SetResultFormatted(interp, "variable \"%#s\" already exists", nameObjPtr);
4620 return JIM_ERR;
4623 /* It exists, but is a link, so first delete the link */
4624 varPtr->linkFramePtr = NULL;
4625 break;
4628 /* Resolve the call frames for both variables */
4629 /* XXX: SetVariableFromAny() already did this! */
4630 varName = Jim_GetString(nameObjPtr, &varnamelen);
4632 if (varName[0] == ':' && varName[1] == ':') {
4633 while (*varName == ':') {
4634 varName++;
4635 varnamelen--;
4637 /* Linking a global var does nothing */
4638 framePtr = interp->topFramePtr;
4640 else {
4641 framePtr = interp->framePtr;
4644 targetName = Jim_GetString(targetNameObjPtr, &len);
4645 if (targetName[0] == ':' && targetName[1] == ':') {
4646 while (*targetName == ':') {
4647 targetName++;
4648 len--;
4650 targetNameObjPtr = Jim_NewStringObj(interp, targetName, len);
4651 targetCallFrame = interp->topFramePtr;
4653 Jim_IncrRefCount(targetNameObjPtr);
4655 if (framePtr->level < targetCallFrame->level) {
4656 Jim_SetResultFormatted(interp,
4657 "bad variable name \"%#s\": upvar won't create namespace variable that refers to procedure variable",
4658 nameObjPtr);
4659 Jim_DecrRefCount(interp, targetNameObjPtr);
4660 return JIM_ERR;
4663 /* Check for cycles. */
4664 if (framePtr == targetCallFrame) {
4665 Jim_Obj *objPtr = targetNameObjPtr;
4667 /* Cycles are only possible with 'uplevel 0' */
4668 while (1) {
4669 if (Jim_Length(objPtr) == varnamelen && memcmp(Jim_String(objPtr), varName, varnamelen) == 0) {
4670 Jim_SetResultString(interp, "can't upvar from variable to itself", -1);
4671 Jim_DecrRefCount(interp, targetNameObjPtr);
4672 return JIM_ERR;
4674 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
4675 break;
4676 varPtr = objPtr->internalRep.varValue.varPtr;
4677 if (varPtr->linkFramePtr != targetCallFrame)
4678 break;
4679 objPtr = varPtr->objPtr;
4683 /* Perform the binding */
4684 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
4685 /* We are now sure 'nameObjPtr' type is variableObjType */
4686 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
4687 Jim_DecrRefCount(interp, targetNameObjPtr);
4688 return JIM_OK;
4691 /* Return the Jim_Obj pointer associated with a variable name,
4692 * or NULL if the variable was not found in the current context.
4693 * The same optimization discussed in the comment to the
4694 * 'SetVariable' function should apply here.
4696 * If JIM_UNSHARED is set and the variable is an array element (dict sugar)
4697 * in a dictionary which is shared, the array variable value is duplicated first.
4698 * This allows the array element to be updated (e.g. append, lappend) without
4699 * affecting other references to the dictionary.
4701 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4703 switch (SetVariableFromAny(interp, nameObjPtr)) {
4704 case JIM_OK:{
4705 Jim_Var *varPtr = nameObjPtr->internalRep.varValue.varPtr;
4707 if (varPtr->linkFramePtr == NULL) {
4708 return varPtr->objPtr;
4710 else {
4711 Jim_Obj *objPtr;
4713 /* The variable is a link? Resolve it. */
4714 Jim_CallFrame *savedCallFrame = interp->framePtr;
4716 interp->framePtr = varPtr->linkFramePtr;
4717 objPtr = Jim_GetVariable(interp, varPtr->objPtr, flags);
4718 interp->framePtr = savedCallFrame;
4719 if (objPtr) {
4720 return objPtr;
4722 /* Error, so fall through to the error message */
4725 break;
4727 case JIM_DICT_SUGAR:
4728 /* [dict] syntax sugar. */
4729 return JimDictSugarGet(interp, nameObjPtr, flags);
4731 if (flags & JIM_ERRMSG) {
4732 Jim_SetResultFormatted(interp, "can't read \"%#s\": no such variable", nameObjPtr);
4734 return NULL;
4737 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4739 Jim_CallFrame *savedFramePtr;
4740 Jim_Obj *objPtr;
4742 savedFramePtr = interp->framePtr;
4743 interp->framePtr = interp->topFramePtr;
4744 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4745 interp->framePtr = savedFramePtr;
4747 return objPtr;
4750 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
4752 Jim_Obj *nameObjPtr, *varObjPtr;
4754 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4755 Jim_IncrRefCount(nameObjPtr);
4756 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4757 Jim_DecrRefCount(interp, nameObjPtr);
4758 return varObjPtr;
4761 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name, int flags)
4763 Jim_CallFrame *savedFramePtr;
4764 Jim_Obj *objPtr;
4766 savedFramePtr = interp->framePtr;
4767 interp->framePtr = interp->topFramePtr;
4768 objPtr = Jim_GetVariableStr(interp, name, flags);
4769 interp->framePtr = savedFramePtr;
4771 return objPtr;
4774 /* Unset a variable.
4775 * Note: On success unset invalidates all the (cached) variable objects
4776 * by incrementing callFrameEpoch
4778 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4780 Jim_Var *varPtr;
4781 int retval;
4782 Jim_CallFrame *framePtr;
4784 retval = SetVariableFromAny(interp, nameObjPtr);
4785 if (retval == JIM_DICT_SUGAR) {
4786 /* [dict] syntax sugar. */
4787 return JimDictSugarSet(interp, nameObjPtr, NULL);
4789 else if (retval == JIM_OK) {
4790 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4792 /* If it's a link call UnsetVariable recursively */
4793 if (varPtr->linkFramePtr) {
4794 framePtr = interp->framePtr;
4795 interp->framePtr = varPtr->linkFramePtr;
4796 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
4797 interp->framePtr = framePtr;
4799 else {
4800 if (nameObjPtr->internalRep.varValue.global) {
4801 int len;
4802 const char *name = Jim_GetString(nameObjPtr, &len);
4803 while (*name == ':') {
4804 name++;
4805 len--;
4807 framePtr = interp->topFramePtr;
4808 Jim_Obj *tempObj = Jim_NewStringObj(interp, name, len);
4809 retval = JimUnsetVariable(&framePtr->vars, tempObj);
4810 Jim_FreeNewObj(interp, tempObj);
4812 else {
4813 framePtr = interp->framePtr;
4814 retval = JimUnsetVariable(&framePtr->vars, nameObjPtr);
4817 if (retval == JIM_OK) {
4818 /* Change the callframe id, invalidating var lookup caching */
4819 framePtr->id = interp->callFrameEpoch++;
4823 if (retval != JIM_OK && (flags & JIM_ERRMSG)) {
4824 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such variable", nameObjPtr);
4826 return retval;
4829 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
4831 /* Given a variable name for [dict] operation syntax sugar,
4832 * this function returns two objects, the first with the name
4833 * of the variable to set, and the second with the respective key.
4834 * For example "foo(bar)" will return objects with string repr. of
4835 * "foo" and "bar".
4837 * The returned objects have refcount = 1. The function can't fail. */
4838 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
4839 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
4841 const char *str, *p;
4842 int len, keyLen;
4843 Jim_Obj *varObjPtr, *keyObjPtr;
4845 str = Jim_GetString(objPtr, &len);
4847 p = strchr(str, '(');
4848 JimPanic((p == NULL, "JimDictSugarParseVarKey() called for non-dict-sugar (%s)", str));
4850 varObjPtr = Jim_NewStringObj(interp, str, p - str);
4852 p++;
4853 keyLen = (str + len) - p;
4854 if (str[len - 1] == ')') {
4855 keyLen--;
4858 /* Create the objects with the variable name and key. */
4859 keyObjPtr = Jim_NewStringObj(interp, p, keyLen);
4861 Jim_IncrRefCount(varObjPtr);
4862 Jim_IncrRefCount(keyObjPtr);
4863 *varPtrPtr = varObjPtr;
4864 *keyPtrPtr = keyObjPtr;
4867 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
4868 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
4869 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *valObjPtr)
4871 int err;
4873 SetDictSubstFromAny(interp, objPtr);
4875 err = Jim_SetDictKeysVector(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4876 &objPtr->internalRep.dictSubstValue.indexObjPtr, 1, valObjPtr, JIM_MUSTEXIST);
4878 if (err == JIM_OK) {
4879 /* Don't keep an extra ref to the result */
4880 Jim_SetEmptyResult(interp);
4882 else {
4883 if (!valObjPtr) {
4884 /* Better error message for unset a(2) where a exists but a(2) doesn't */
4885 if (Jim_GetVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_NONE)) {
4886 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such element in array",
4887 objPtr);
4888 return err;
4891 /* Make the error more informative and Tcl-compatible */
4892 Jim_SetResultFormatted(interp, "can't %s \"%#s\": variable isn't array",
4893 (valObjPtr ? "set" : "unset"), objPtr);
4895 return err;
4899 * Expands the array variable (dict sugar) and returns the result, or NULL on error.
4901 * If JIM_UNSHARED is set and the dictionary is shared, it will be duplicated
4902 * and stored back to the variable before expansion.
4904 static Jim_Obj *JimDictExpandArrayVariable(Jim_Interp *interp, Jim_Obj *varObjPtr,
4905 Jim_Obj *keyObjPtr, int flags)
4907 Jim_Obj *dictObjPtr;
4908 Jim_Obj *resObjPtr = NULL;
4909 int ret;
4911 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
4912 if (!dictObjPtr) {
4913 return NULL;
4916 ret = Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_NONE);
4917 if (ret != JIM_OK) {
4918 Jim_SetResultFormatted(interp,
4919 "can't read \"%#s(%#s)\": %s array", varObjPtr, keyObjPtr,
4920 ret < 0 ? "variable isn't" : "no such element in");
4922 else if ((flags & JIM_UNSHARED) && Jim_IsShared(dictObjPtr)) {
4923 /* Update the variable to have an unshared copy */
4924 Jim_SetVariable(interp, varObjPtr, Jim_DuplicateObj(interp, dictObjPtr));
4927 return resObjPtr;
4930 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
4931 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4933 SetDictSubstFromAny(interp, objPtr);
4935 return JimDictExpandArrayVariable(interp,
4936 objPtr->internalRep.dictSubstValue.varNameObjPtr,
4937 objPtr->internalRep.dictSubstValue.indexObjPtr, flags);
4940 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
4942 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4944 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
4945 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
4948 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4950 /* Copy the internal rep */
4951 dupPtr->internalRep = srcPtr->internalRep;
4952 /* Need to increment the ref counts */
4953 Jim_IncrRefCount(dupPtr->internalRep.dictSubstValue.varNameObjPtr);
4954 Jim_IncrRefCount(dupPtr->internalRep.dictSubstValue.indexObjPtr);
4957 /* Note: The object *must* be in dict-sugar format */
4958 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4960 if (objPtr->typePtr != &dictSubstObjType) {
4961 Jim_Obj *varObjPtr, *keyObjPtr;
4963 if (objPtr->typePtr == &interpolatedObjType) {
4964 /* An interpolated object in dict-sugar form */
4966 varObjPtr = objPtr->internalRep.dictSubstValue.varNameObjPtr;
4967 keyObjPtr = objPtr->internalRep.dictSubstValue.indexObjPtr;
4969 Jim_IncrRefCount(varObjPtr);
4970 Jim_IncrRefCount(keyObjPtr);
4972 else {
4973 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
4976 Jim_FreeIntRep(interp, objPtr);
4977 objPtr->typePtr = &dictSubstObjType;
4978 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
4979 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
4983 /* This function is used to expand [dict get] sugar in the form
4984 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
4985 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
4986 * object that is *guaranteed* to be in the form VARNAME(INDEX).
4987 * The 'index' part is [subst]ituted, and is used to lookup a key inside
4988 * the [dict]ionary contained in variable VARNAME. */
4989 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4991 Jim_Obj *resObjPtr = NULL;
4992 Jim_Obj *substKeyObjPtr = NULL;
4994 SetDictSubstFromAny(interp, objPtr);
4996 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
4997 &substKeyObjPtr, JIM_NONE)
4998 != JIM_OK) {
4999 return NULL;
5001 Jim_IncrRefCount(substKeyObjPtr);
5002 resObjPtr =
5003 JimDictExpandArrayVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
5004 substKeyObjPtr, 0);
5005 Jim_DecrRefCount(interp, substKeyObjPtr);
5007 return resObjPtr;
5010 /* -----------------------------------------------------------------------------
5011 * CallFrame
5012 * ---------------------------------------------------------------------------*/
5014 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp, Jim_CallFrame *parent, Jim_Obj *nsObj)
5016 Jim_CallFrame *cf;
5018 if (interp->freeFramesList) {
5019 cf = interp->freeFramesList;
5020 interp->freeFramesList = cf->next;
5022 cf->argv = NULL;
5023 cf->argc = 0;
5024 cf->procArgsObjPtr = NULL;
5025 cf->procBodyObjPtr = NULL;
5026 cf->next = NULL;
5027 cf->staticVars = NULL;
5028 cf->localCommands = NULL;
5029 cf->tailcallObj = NULL;
5030 cf->tailcallCmd = NULL;
5032 else {
5033 cf = Jim_Alloc(sizeof(*cf));
5034 memset(cf, 0, sizeof(*cf));
5036 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
5039 cf->id = interp->callFrameEpoch++;
5040 cf->parent = parent;
5041 cf->level = parent ? parent->level + 1 : 0;
5042 cf->nsObj = nsObj;
5043 Jim_IncrRefCount(nsObj);
5045 return cf;
5048 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands)
5050 /* Delete any local procs */
5051 if (localCommands) {
5052 Jim_Obj *cmdNameObj;
5054 while ((cmdNameObj = Jim_StackPop(localCommands)) != NULL) {
5055 Jim_HashTable *ht = &interp->commands;
5056 Jim_HashEntry *he = Jim_FindHashEntry(ht, cmdNameObj);
5057 if (he) {
5058 Jim_Cmd *cmd = Jim_GetHashEntryVal(he);
5059 if (cmd->prevCmd) {
5060 Jim_Cmd *prevCmd = cmd->prevCmd;
5061 cmd->prevCmd = NULL;
5063 /* Delete the old command */
5064 JimDecrCmdRefCount(interp, cmd);
5066 /* And restore the original */
5067 Jim_SetHashVal(ht, he, prevCmd);
5069 else {
5070 Jim_DeleteHashEntry(ht, cmdNameObj);
5073 Jim_DecrRefCount(interp, cmdNameObj);
5075 Jim_FreeStack(localCommands);
5076 Jim_Free(localCommands);
5078 return JIM_OK;
5082 * Run any $jim::defer scripts for the current call frame.
5084 * retcode is the return code from the current proc.
5086 * Returns the new return code.
5088 static int JimInvokeDefer(Jim_Interp *interp, int retcode)
5090 Jim_Obj *objPtr;
5092 /* Fast check for the likely case that the variable doesn't exist */
5093 if (JimFindVariable(&interp->framePtr->vars, interp->defer) == NULL) {
5094 return retcode;
5096 objPtr = Jim_GetVariable(interp, interp->defer, JIM_NONE);
5098 if (objPtr) {
5099 int ret = JIM_OK;
5100 int i;
5101 int listLen = Jim_ListLength(interp, objPtr);
5102 Jim_Obj *resultObjPtr;
5104 Jim_IncrRefCount(objPtr);
5106 /* Need to save away the current interp result and
5107 * restore it if appropriate
5109 resultObjPtr = Jim_GetResult(interp);
5110 Jim_IncrRefCount(resultObjPtr);
5111 Jim_SetEmptyResult(interp);
5113 /* Invoke in reverse order */
5114 for (i = listLen; i > 0; i--) {
5115 /* If a defer script returns an error, don't evaluate remaining scripts */
5116 Jim_Obj *scriptObjPtr = Jim_ListGetIndex(interp, objPtr, i - 1);
5117 ret = Jim_EvalObj(interp, scriptObjPtr);
5118 if (ret != JIM_OK) {
5119 break;
5123 if (ret == JIM_OK || retcode == JIM_ERR) {
5124 /* defer script had no error, or proc had an error so restore proc result */
5125 Jim_SetResult(interp, resultObjPtr);
5127 else {
5128 retcode = ret;
5131 Jim_DecrRefCount(interp, resultObjPtr);
5132 Jim_DecrRefCount(interp, objPtr);
5134 return retcode;
5137 #define JIM_FCF_FULL 0 /* Always free the vars hash table */
5138 #define JIM_FCF_REUSE 1 /* Reuse the vars hash table if possible */
5139 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action)
5141 JimDeleteLocalProcs(interp, cf->localCommands);
5143 if (cf->procArgsObjPtr)
5144 Jim_DecrRefCount(interp, cf->procArgsObjPtr);
5145 if (cf->procBodyObjPtr)
5146 Jim_DecrRefCount(interp, cf->procBodyObjPtr);
5147 Jim_DecrRefCount(interp, cf->nsObj);
5148 if (action == JIM_FCF_FULL || cf->vars.size != JIM_HT_INITIAL_SIZE)
5149 Jim_FreeHashTable(&cf->vars);
5150 else {
5151 Jim_ClearHashTable(&cf->vars);
5153 cf->next = interp->freeFramesList;
5154 interp->freeFramesList = cf;
5158 /* -----------------------------------------------------------------------------
5159 * References
5160 * ---------------------------------------------------------------------------*/
5161 #if defined(JIM_REFERENCES) && !defined(JIM_BOOTSTRAP)
5163 /* References HashTable Type.
5165 * Keys are unsigned long integers, dynamically allocated for now but in the
5166 * future it's worth to cache this 4 bytes objects. Values are pointers
5167 * to Jim_References. */
5168 static void JimReferencesHTValDestructor(void *interp, void *val)
5170 Jim_Reference *refPtr = (void *)val;
5172 Jim_DecrRefCount(interp, refPtr->objPtr);
5173 if (refPtr->finalizerCmdNamePtr != NULL) {
5174 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5176 Jim_Free(val);
5179 static unsigned int JimReferencesHTHashFunction(const void *key)
5181 /* Only the least significant bits are used. */
5182 const unsigned long *widePtr = key;
5183 unsigned int intValue = (unsigned int)*widePtr;
5185 return Jim_IntHashFunction(intValue);
5188 static void *JimReferencesHTKeyDup(void *privdata, const void *key)
5190 void *copy = Jim_Alloc(sizeof(unsigned long));
5192 JIM_NOTUSED(privdata);
5194 memcpy(copy, key, sizeof(unsigned long));
5195 return copy;
5198 static int JimReferencesHTKeyCompare(void *privdata, const void *key1, const void *key2)
5200 JIM_NOTUSED(privdata);
5202 return memcmp(key1, key2, sizeof(unsigned long)) == 0;
5205 static void JimReferencesHTKeyDestructor(void *privdata, void *key)
5207 JIM_NOTUSED(privdata);
5209 Jim_Free(key);
5212 static const Jim_HashTableType JimReferencesHashTableType = {
5213 JimReferencesHTHashFunction, /* hash function */
5214 JimReferencesHTKeyDup, /* key dup */
5215 NULL, /* val dup */
5216 JimReferencesHTKeyCompare, /* key compare */
5217 JimReferencesHTKeyDestructor, /* key destructor */
5218 JimReferencesHTValDestructor /* val destructor */
5221 /* -----------------------------------------------------------------------------
5222 * Reference object type and References API
5223 * ---------------------------------------------------------------------------*/
5225 /* The string representation of references has two features in order
5226 * to make the GC faster. The first is that every reference starts
5227 * with a non common character '<', in order to make the string matching
5228 * faster. The second is that the reference string rep is 42 characters
5229 * in length, this means that it is not necessary to check any object with a string
5230 * repr < 42, and usually there aren't many of these objects. */
5232 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
5234 static int JimFormatReference(char *buf, Jim_Reference *refPtr, unsigned long id)
5236 const char *fmt = "<reference.<%s>.%020lu>";
5238 sprintf(buf, fmt, refPtr->tag, id);
5239 return JIM_REFERENCE_SPACE;
5242 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
5244 static const Jim_ObjType referenceObjType = {
5245 "reference",
5246 NULL,
5247 NULL,
5248 UpdateStringOfReference,
5249 JIM_TYPE_REFERENCES,
5252 static void UpdateStringOfReference(struct Jim_Obj *objPtr)
5254 char buf[JIM_REFERENCE_SPACE + 1];
5256 JimFormatReference(buf, objPtr->internalRep.refValue.refPtr, objPtr->internalRep.refValue.id);
5257 JimSetStringBytes(objPtr, buf);
5260 /* returns true if 'c' is a valid reference tag character.
5261 * i.e. inside the range [_a-zA-Z0-9] */
5262 static int isrefchar(int c)
5264 return (c == '_' || isalnum(c));
5267 static int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5269 unsigned long value;
5270 int i, len;
5271 const char *str, *start, *end;
5272 char refId[21];
5273 Jim_Reference *refPtr;
5274 Jim_HashEntry *he;
5275 char *endptr;
5277 /* Get the string representation */
5278 str = Jim_GetString(objPtr, &len);
5279 /* Check if it looks like a reference */
5280 if (len < JIM_REFERENCE_SPACE)
5281 goto badformat;
5282 /* Trim spaces */
5283 start = str;
5284 end = str + len - 1;
5285 while (*start == ' ')
5286 start++;
5287 while (*end == ' ' && end > start)
5288 end--;
5289 if (end - start + 1 != JIM_REFERENCE_SPACE)
5290 goto badformat;
5291 /* <reference.<1234567>.%020> */
5292 if (memcmp(start, "<reference.<", 12) != 0)
5293 goto badformat;
5294 if (start[12 + JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>')
5295 goto badformat;
5296 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
5297 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5298 if (!isrefchar(start[12 + i]))
5299 goto badformat;
5301 /* Extract info from the reference. */
5302 memcpy(refId, start + 14 + JIM_REFERENCE_TAGLEN, 20);
5303 refId[20] = '\0';
5304 /* Try to convert the ID into an unsigned long */
5305 value = strtoul(refId, &endptr, 10);
5306 if (JimCheckConversion(refId, endptr) != JIM_OK)
5307 goto badformat;
5308 /* Check if the reference really exists! */
5309 he = Jim_FindHashEntry(&interp->references, &value);
5310 if (he == NULL) {
5311 Jim_SetResultFormatted(interp, "invalid reference id \"%#s\"", objPtr);
5312 return JIM_ERR;
5314 refPtr = Jim_GetHashEntryVal(he);
5315 /* Free the old internal repr and set the new one. */
5316 Jim_FreeIntRep(interp, objPtr);
5317 objPtr->typePtr = &referenceObjType;
5318 objPtr->internalRep.refValue.id = value;
5319 objPtr->internalRep.refValue.refPtr = refPtr;
5320 return JIM_OK;
5322 badformat:
5323 Jim_SetResultFormatted(interp, "expected reference but got \"%#s\"", objPtr);
5324 return JIM_ERR;
5327 /* Returns a new reference pointing to objPtr, having cmdNamePtr
5328 * as finalizer command (or NULL if there is no finalizer).
5329 * The returned reference object has refcount = 0. */
5330 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr, Jim_Obj *cmdNamePtr)
5332 struct Jim_Reference *refPtr;
5333 unsigned long id;
5334 Jim_Obj *refObjPtr;
5335 const char *tag;
5336 int tagLen, i;
5338 /* Perform the Garbage Collection if needed. */
5339 Jim_CollectIfNeeded(interp);
5341 refPtr = Jim_Alloc(sizeof(*refPtr));
5342 refPtr->objPtr = objPtr;
5343 Jim_IncrRefCount(objPtr);
5344 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5345 if (cmdNamePtr)
5346 Jim_IncrRefCount(cmdNamePtr);
5347 id = interp->referenceNextId++;
5348 Jim_AddHashEntry(&interp->references, &id, refPtr);
5349 refObjPtr = Jim_NewObj(interp);
5350 refObjPtr->typePtr = &referenceObjType;
5351 refObjPtr->bytes = NULL;
5352 refObjPtr->internalRep.refValue.id = id;
5353 refObjPtr->internalRep.refValue.refPtr = refPtr;
5354 interp->referenceNextId++;
5355 /* Set the tag. Trimmed at JIM_REFERENCE_TAGLEN. Everything
5356 * that does not pass the 'isrefchar' test is replaced with '_' */
5357 tag = Jim_GetString(tagPtr, &tagLen);
5358 if (tagLen > JIM_REFERENCE_TAGLEN)
5359 tagLen = JIM_REFERENCE_TAGLEN;
5360 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5361 if (i < tagLen && isrefchar(tag[i]))
5362 refPtr->tag[i] = tag[i];
5363 else
5364 refPtr->tag[i] = '_';
5366 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
5367 return refObjPtr;
5370 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
5372 if (objPtr->typePtr != &referenceObjType && SetReferenceFromAny(interp, objPtr) == JIM_ERR)
5373 return NULL;
5374 return objPtr->internalRep.refValue.refPtr;
5377 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
5379 Jim_Reference *refPtr;
5381 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5382 return JIM_ERR;
5383 Jim_IncrRefCount(cmdNamePtr);
5384 if (refPtr->finalizerCmdNamePtr)
5385 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5386 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5387 return JIM_OK;
5390 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
5392 Jim_Reference *refPtr;
5394 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5395 return JIM_ERR;
5396 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
5397 return JIM_OK;
5400 /* -----------------------------------------------------------------------------
5401 * References Garbage Collection
5402 * ---------------------------------------------------------------------------*/
5404 /* This the hash table type for the "MARK" phase of the GC */
5405 static const Jim_HashTableType JimRefMarkHashTableType = {
5406 JimReferencesHTHashFunction, /* hash function */
5407 JimReferencesHTKeyDup, /* key dup */
5408 NULL, /* val dup */
5409 JimReferencesHTKeyCompare, /* key compare */
5410 JimReferencesHTKeyDestructor, /* key destructor */
5411 NULL /* val destructor */
5414 /* Performs the garbage collection. */
5415 int Jim_Collect(Jim_Interp *interp)
5417 int collected = 0;
5418 Jim_HashTable marks;
5419 Jim_HashTableIterator htiter;
5420 Jim_HashEntry *he;
5421 Jim_Obj *objPtr;
5423 /* Avoid recursive calls */
5424 if (interp->lastCollectId == (unsigned long)~0) {
5425 /* Jim_Collect() already running. Return just now. */
5426 return 0;
5428 interp->lastCollectId = ~0;
5430 /* Mark all the references found into the 'mark' hash table.
5431 * The references are searched in every live object that
5432 * is of a type that can contain references. */
5433 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
5434 objPtr = interp->liveList;
5435 while (objPtr) {
5436 if (objPtr->typePtr == NULL || objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
5437 const char *str, *p;
5438 int len;
5440 /* If the object is of type reference, to get the
5441 * Id is simple... */
5442 if (objPtr->typePtr == &referenceObjType) {
5443 Jim_AddHashEntry(&marks, &objPtr->internalRep.refValue.id, NULL);
5444 #ifdef JIM_DEBUG_GC
5445 printf("MARK (reference): %d refcount: %d\n",
5446 (int)objPtr->internalRep.refValue.id, objPtr->refCount);
5447 #endif
5448 objPtr = objPtr->nextObjPtr;
5449 continue;
5451 /* Get the string repr of the object we want
5452 * to scan for references. */
5453 p = str = Jim_GetString(objPtr, &len);
5454 /* Skip objects too little to contain references. */
5455 if (len < JIM_REFERENCE_SPACE) {
5456 objPtr = objPtr->nextObjPtr;
5457 continue;
5460 /* Maybe the entire string is a reference that is also in the commands table with a refcount of 1.
5461 * If so, this can be collected */
5462 if (objPtr->refCount == 1) {
5463 if (Jim_FindHashEntry(&interp->commands, objPtr)) {
5464 #ifdef JIM_DEBUG_GC
5465 printf("Found %s which is a command with refcount=1, so not marking\n", Jim_String(objPtr));
5466 #endif
5467 /* Yes, a command with refcount of 1 */
5468 objPtr = objPtr->nextObjPtr;
5469 continue;
5473 /* Extract references from the object string repr. */
5474 while (1) {
5475 int i;
5476 unsigned long id;
5478 if ((p = strstr(p, "<reference.<")) == NULL)
5479 break;
5480 /* Check if it's a valid reference. */
5481 if (len - (p - str) < JIM_REFERENCE_SPACE)
5482 break;
5483 if (p[41] != '>' || p[19] != '>' || p[20] != '.')
5484 break;
5485 for (i = 21; i <= 40; i++)
5486 if (!isdigit(UCHAR(p[i])))
5487 break;
5488 /* Get the ID */
5489 id = strtoul(p + 21, NULL, 10);
5491 /* Ok, a reference for the given ID
5492 * was found. Mark it. */
5493 Jim_AddHashEntry(&marks, &id, NULL);
5494 #ifdef JIM_DEBUG_GC
5495 printf("MARK: %d\n", (int)id);
5496 #endif
5497 p += JIM_REFERENCE_SPACE;
5500 objPtr = objPtr->nextObjPtr;
5503 /* Run the references hash table to destroy every reference that
5504 * is not referenced outside (not present in the mark HT). */
5505 JimInitHashTableIterator(&interp->references, &htiter);
5506 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
5507 const unsigned long *refId;
5508 Jim_Reference *refPtr;
5510 refId = he->key;
5511 /* Check if in the mark phase we encountered
5512 * this reference. */
5513 if (Jim_FindHashEntry(&marks, refId) == NULL) {
5514 #ifdef JIM_DEBUG_GC
5515 printf("COLLECTING %d\n", (int)*refId);
5516 #endif
5517 collected++;
5518 /* Drop the reference, but call the
5519 * finalizer first if registered. */
5520 refPtr = Jim_GetHashEntryVal(he);
5521 if (refPtr->finalizerCmdNamePtr) {
5522 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE + 1);
5523 Jim_Obj *objv[3], *oldResult;
5525 JimFormatReference(refstr, refPtr, *refId);
5527 objv[0] = refPtr->finalizerCmdNamePtr;
5528 objv[1] = Jim_NewStringObjNoAlloc(interp, refstr, JIM_REFERENCE_SPACE);
5529 objv[2] = refPtr->objPtr;
5531 /* Drop the reference itself */
5532 /* Avoid the finaliser being freed here */
5533 Jim_IncrRefCount(objv[0]);
5534 /* Don't remove the reference from the hash table just yet
5535 * since that will free refPtr, and hence refPtr->objPtr
5538 /* Call the finalizer. Errors ignored. (should we use bgerror?) */
5539 oldResult = interp->result;
5540 Jim_IncrRefCount(oldResult);
5541 Jim_EvalObjVector(interp, 3, objv);
5542 Jim_SetResult(interp, oldResult);
5543 Jim_DecrRefCount(interp, oldResult);
5545 Jim_DecrRefCount(interp, objv[0]);
5547 Jim_DeleteHashEntry(&interp->references, refId);
5550 Jim_FreeHashTable(&marks);
5551 interp->lastCollectId = interp->referenceNextId;
5552 interp->lastCollectTime = JimClock();
5553 return collected;
5556 #define JIM_COLLECT_ID_PERIOD 5000000
5557 #define JIM_COLLECT_TIME_PERIOD 300000
5559 void Jim_CollectIfNeeded(Jim_Interp *interp)
5561 unsigned long elapsedId;
5562 jim_wide elapsedTime;
5564 elapsedId = interp->referenceNextId - interp->lastCollectId;
5565 elapsedTime = JimClock() - interp->lastCollectTime;
5568 if (elapsedId > JIM_COLLECT_ID_PERIOD || elapsedTime > JIM_COLLECT_TIME_PERIOD) {
5569 Jim_Collect(interp);
5572 #endif /* JIM_REFERENCES && !JIM_BOOTSTRAP */
5574 int Jim_IsBigEndian(void)
5576 union {
5577 unsigned short s;
5578 unsigned char c[2];
5579 } uval = {0x0102};
5581 return uval.c[0] == 1;
5584 /* -----------------------------------------------------------------------------
5585 * Interpreter related functions
5586 * ---------------------------------------------------------------------------*/
5588 Jim_Interp *Jim_CreateInterp(void)
5590 Jim_Interp *i = Jim_Alloc(sizeof(*i));
5592 memset(i, 0, sizeof(*i));
5594 i->maxCallFrameDepth = JIM_MAX_CALLFRAME_DEPTH;
5595 i->maxEvalDepth = JIM_MAX_EVAL_DEPTH;
5596 i->lastCollectTime = JimClock();
5598 /* Note that we can create objects only after the
5599 * interpreter liveList and freeList pointers are
5600 * initialized to NULL. */
5601 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
5602 #ifdef JIM_REFERENCES
5603 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
5604 #endif
5605 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
5606 Jim_InitHashTable(&i->packages, &JimPackageHashTableType, NULL);
5607 i->emptyObj = Jim_NewEmptyStringObj(i);
5608 i->trueObj = Jim_NewIntObj(i, 1);
5609 i->falseObj = Jim_NewIntObj(i, 0);
5610 i->framePtr = i->topFramePtr = JimCreateCallFrame(i, NULL, i->emptyObj);
5611 i->errorFileNameObj = i->emptyObj;
5612 i->result = i->emptyObj;
5613 i->stackTrace = Jim_NewListObj(i, NULL, 0);
5614 i->unknown = Jim_NewStringObj(i, "unknown", -1);
5615 i->defer = Jim_NewStringObj(i, "jim::defer", -1);
5616 i->errorProc = i->emptyObj;
5617 i->currentScriptObj = Jim_NewEmptyStringObj(i);
5618 i->nullScriptObj = Jim_NewEmptyStringObj(i);
5619 Jim_IncrRefCount(i->emptyObj);
5620 Jim_IncrRefCount(i->errorFileNameObj);
5621 Jim_IncrRefCount(i->result);
5622 Jim_IncrRefCount(i->stackTrace);
5623 Jim_IncrRefCount(i->unknown);
5624 Jim_IncrRefCount(i->defer);
5625 Jim_IncrRefCount(i->currentScriptObj);
5626 Jim_IncrRefCount(i->nullScriptObj);
5627 Jim_IncrRefCount(i->errorProc);
5628 Jim_IncrRefCount(i->trueObj);
5629 Jim_IncrRefCount(i->falseObj);
5631 /* Initialize key variables every interpreter should contain */
5632 Jim_SetVariableStrWithStr(i, JIM_LIBPATH, TCL_LIBRARY);
5633 Jim_SetVariableStrWithStr(i, JIM_INTERACTIVE, "0");
5635 Jim_SetVariableStrWithStr(i, "tcl_platform(engine)", "Jim");
5636 Jim_SetVariableStrWithStr(i, "tcl_platform(os)", TCL_PLATFORM_OS);
5637 Jim_SetVariableStrWithStr(i, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM);
5638 Jim_SetVariableStrWithStr(i, "tcl_platform(pathSeparator)", TCL_PLATFORM_PATH_SEPARATOR);
5639 Jim_SetVariableStrWithStr(i, "tcl_platform(byteOrder)", Jim_IsBigEndian() ? "bigEndian" : "littleEndian");
5640 Jim_SetVariableStrWithStr(i, "tcl_platform(threaded)", "0");
5641 Jim_SetVariableStr(i, "tcl_platform(pointerSize)", Jim_NewIntObj(i, sizeof(void *)));
5642 Jim_SetVariableStr(i, "tcl_platform(wordSize)", Jim_NewIntObj(i, sizeof(jim_wide)));
5644 return i;
5647 void Jim_FreeInterp(Jim_Interp *i)
5649 Jim_CallFrame *cf, *cfx;
5651 Jim_Obj *objPtr, *nextObjPtr;
5653 i->quitting = 1;
5655 /* Free the active call frames list - must be done before i->commands is destroyed */
5656 for (cf = i->framePtr; cf; cf = cfx) {
5657 /* Note that we ignore any errors */
5658 JimInvokeDefer(i, JIM_OK);
5659 cfx = cf->parent;
5660 JimFreeCallFrame(i, cf, JIM_FCF_FULL);
5663 Jim_DecrRefCount(i, i->emptyObj);
5664 Jim_DecrRefCount(i, i->trueObj);
5665 Jim_DecrRefCount(i, i->falseObj);
5666 Jim_DecrRefCount(i, i->result);
5667 Jim_DecrRefCount(i, i->stackTrace);
5668 Jim_DecrRefCount(i, i->errorProc);
5669 Jim_DecrRefCount(i, i->unknown);
5670 Jim_DecrRefCount(i, i->defer);
5671 Jim_DecrRefCount(i, i->errorFileNameObj);
5672 Jim_DecrRefCount(i, i->currentScriptObj);
5673 Jim_DecrRefCount(i, i->nullScriptObj);
5675 Jim_InterpIncrProcEpoch(i);
5677 Jim_FreeHashTable(&i->commands);
5678 #ifdef JIM_REFERENCES
5679 Jim_FreeHashTable(&i->references);
5680 #endif
5681 Jim_FreeHashTable(&i->packages);
5682 Jim_Free(i->prngState);
5683 Jim_FreeHashTable(&i->assocData);
5685 /* Check that the live object list is empty, otherwise
5686 * there is a memory leak. */
5687 #ifdef JIM_MAINTAINER
5688 if (i->liveList != NULL) {
5689 objPtr = i->liveList;
5691 printf("\n-------------------------------------\n");
5692 printf("Objects still in the free list:\n");
5693 while (objPtr) {
5694 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "string";
5695 Jim_String(objPtr);
5697 if (objPtr->bytes && strlen(objPtr->bytes) > 20) {
5698 printf("%p (%d) %-10s: '%.20s...'\n",
5699 (void *)objPtr, objPtr->refCount, type, objPtr->bytes);
5701 else {
5702 printf("%p (%d) %-10s: '%s'\n",
5703 (void *)objPtr, objPtr->refCount, type, objPtr->bytes ? objPtr->bytes : "(null)");
5705 if (objPtr->typePtr == &sourceObjType) {
5706 printf("FILE %s LINE %d\n",
5707 Jim_String(objPtr->internalRep.sourceValue.fileNameObj),
5708 objPtr->internalRep.sourceValue.lineNumber);
5710 objPtr = objPtr->nextObjPtr;
5712 printf("-------------------------------------\n\n");
5713 JimPanic((1, "Live list non empty freeing the interpreter! Leak?"));
5715 #endif
5717 /* Free all the freed objects. */
5718 objPtr = i->freeList;
5719 while (objPtr) {
5720 nextObjPtr = objPtr->nextObjPtr;
5721 Jim_Free(objPtr);
5722 objPtr = nextObjPtr;
5725 /* Free the free call frames list */
5726 for (cf = i->freeFramesList; cf; cf = cfx) {
5727 cfx = cf->next;
5728 if (cf->vars.table)
5729 Jim_FreeHashTable(&cf->vars);
5730 Jim_Free(cf);
5733 /* Free the interpreter structure. */
5734 Jim_Free(i);
5737 /* Returns the call frame relative to the level represented by
5738 * levelObjPtr. If levelObjPtr == NULL, the level is assumed to be '1'.
5740 * This function accepts the 'level' argument in the form
5741 * of the commands [uplevel] and [upvar].
5743 * Returns NULL on error.
5745 * Note: for a function accepting a relative integer as level suitable
5746 * for implementation of [info level ?level?], see JimGetCallFrameByInteger()
5748 Jim_CallFrame *Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5750 long level;
5751 const char *str;
5752 Jim_CallFrame *framePtr;
5754 if (levelObjPtr) {
5755 str = Jim_String(levelObjPtr);
5756 if (str[0] == '#') {
5757 char *endptr;
5759 level = jim_strtol(str + 1, &endptr);
5760 if (str[1] == '\0' || endptr[0] != '\0') {
5761 level = -1;
5764 else {
5765 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0) {
5766 level = -1;
5768 else {
5769 /* Convert from a relative to an absolute level */
5770 level = interp->framePtr->level - level;
5774 else {
5775 str = "1"; /* Needed to format the error message. */
5776 level = interp->framePtr->level - 1;
5779 if (level == 0) {
5780 return interp->topFramePtr;
5782 if (level > 0) {
5783 /* Lookup */
5784 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5785 if (framePtr->level == level) {
5786 return framePtr;
5791 Jim_SetResultFormatted(interp, "bad level \"%s\"", str);
5792 return NULL;
5795 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
5796 * as a relative integer like in the [info level ?level?] command.
5798 static Jim_CallFrame *JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5800 long level;
5801 Jim_CallFrame *framePtr;
5803 if (Jim_GetLong(interp, levelObjPtr, &level) == JIM_OK) {
5804 if (level <= 0) {
5805 /* Convert from a relative to an absolute level */
5806 level = interp->framePtr->level + level;
5809 if (level == 0) {
5810 return interp->topFramePtr;
5813 /* Lookup */
5814 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5815 if (framePtr->level == level) {
5816 return framePtr;
5821 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
5822 return NULL;
5825 static void JimResetStackTrace(Jim_Interp *interp)
5827 Jim_DecrRefCount(interp, interp->stackTrace);
5828 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
5829 Jim_IncrRefCount(interp->stackTrace);
5832 static void JimSetStackTrace(Jim_Interp *interp, Jim_Obj *stackTraceObj)
5834 int len;
5836 /* Increment reference first in case these are the same object */
5837 Jim_IncrRefCount(stackTraceObj);
5838 Jim_DecrRefCount(interp, interp->stackTrace);
5839 interp->stackTrace = stackTraceObj;
5840 interp->errorFlag = 1;
5842 /* This is a bit ugly.
5843 * If the filename of the last entry of the stack trace is empty,
5844 * the next stack level should be added.
5846 len = Jim_ListLength(interp, interp->stackTrace);
5847 if (len >= 3) {
5848 if (Jim_Length(Jim_ListGetIndex(interp, interp->stackTrace, len - 2)) == 0) {
5849 interp->addStackTrace = 1;
5854 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
5855 Jim_Obj *fileNameObj, int linenr)
5857 if (strcmp(procname, "unknown") == 0) {
5858 procname = "";
5860 if (!*procname && !Jim_Length(fileNameObj)) {
5861 /* No useful info here */
5862 return;
5865 if (Jim_IsShared(interp->stackTrace)) {
5866 Jim_DecrRefCount(interp, interp->stackTrace);
5867 interp->stackTrace = Jim_DuplicateObj(interp, interp->stackTrace);
5868 Jim_IncrRefCount(interp->stackTrace);
5871 /* If we have no procname but the previous element did, merge with that frame */
5872 if (!*procname && Jim_Length(fileNameObj)) {
5873 /* Just a filename. Check the previous entry */
5874 int len = Jim_ListLength(interp, interp->stackTrace);
5876 if (len >= 3) {
5877 Jim_Obj *objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 3);
5878 if (Jim_Length(objPtr)) {
5879 /* Yes, the previous level had procname */
5880 objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 2);
5881 if (Jim_Length(objPtr) == 0) {
5882 /* But no filename, so merge the new info with that frame */
5883 ListSetIndex(interp, interp->stackTrace, len - 2, fileNameObj, 0);
5884 ListSetIndex(interp, interp->stackTrace, len - 1, Jim_NewIntObj(interp, linenr), 0);
5885 return;
5891 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewStringObj(interp, procname, -1));
5892 Jim_ListAppendElement(interp, interp->stackTrace, fileNameObj);
5893 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewIntObj(interp, linenr));
5896 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc * delProc,
5897 void *data)
5899 AssocDataValue *assocEntryPtr = (AssocDataValue *) Jim_Alloc(sizeof(AssocDataValue));
5901 assocEntryPtr->delProc = delProc;
5902 assocEntryPtr->data = data;
5903 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
5906 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
5908 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
5910 if (entryPtr != NULL) {
5911 AssocDataValue *assocEntryPtr = Jim_GetHashEntryVal(entryPtr);
5912 return assocEntryPtr->data;
5914 return NULL;
5917 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
5919 return Jim_DeleteHashEntry(&interp->assocData, key);
5922 int Jim_GetExitCode(Jim_Interp *interp)
5924 return interp->exitCode;
5927 /* -----------------------------------------------------------------------------
5928 * Integer object
5929 * ---------------------------------------------------------------------------*/
5930 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
5931 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
5933 static const Jim_ObjType intObjType = {
5934 "int",
5935 NULL,
5936 NULL,
5937 UpdateStringOfInt,
5938 JIM_TYPE_NONE,
5941 /* A coerced double is closer to an int than a double.
5942 * It is an int value temporarily masquerading as a double value.
5943 * i.e. it has the same string value as an int and Jim_GetWide()
5944 * succeeds, but also Jim_GetDouble() returns the value directly.
5946 static const Jim_ObjType coercedDoubleObjType = {
5947 "coerced-double",
5948 NULL,
5949 NULL,
5950 UpdateStringOfInt,
5951 JIM_TYPE_NONE,
5955 static void UpdateStringOfInt(struct Jim_Obj *objPtr)
5957 char buf[JIM_INTEGER_SPACE + 1];
5958 jim_wide wideValue = JimWideValue(objPtr);
5959 int pos = 0;
5961 if (wideValue == 0) {
5962 buf[pos++] = '0';
5964 else {
5965 char tmp[JIM_INTEGER_SPACE];
5966 int num = 0;
5967 int i;
5969 if (wideValue < 0) {
5970 buf[pos++] = '-';
5971 i = wideValue % 10;
5972 /* C89 is implementation defined as to whether (-106 % 10) is -6 or 4,
5973 * whereas C99 is always -6
5974 * coverity[dead_error_line]
5976 tmp[num++] = (i > 0) ? (10 - i) : -i;
5977 wideValue /= -10;
5980 while (wideValue) {
5981 tmp[num++] = wideValue % 10;
5982 wideValue /= 10;
5985 for (i = 0; i < num; i++) {
5986 buf[pos++] = '0' + tmp[num - i - 1];
5989 buf[pos] = 0;
5991 JimSetStringBytes(objPtr, buf);
5994 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
5996 jim_wide wideValue;
5997 const char *str;
5999 if (objPtr->typePtr == &coercedDoubleObjType) {
6000 /* Simple switch */
6001 objPtr->typePtr = &intObjType;
6002 return JIM_OK;
6005 /* Get the string representation */
6006 str = Jim_String(objPtr);
6007 /* Try to convert into a jim_wide */
6008 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
6009 if (flags & JIM_ERRMSG) {
6010 Jim_SetResultFormatted(interp, "expected integer but got \"%#s\"", objPtr);
6012 return JIM_ERR;
6014 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) && errno == ERANGE) {
6015 Jim_SetResultString(interp, "Integer value too big to be represented", -1);
6016 return JIM_ERR;
6018 /* Free the old internal repr and set the new one. */
6019 Jim_FreeIntRep(interp, objPtr);
6020 objPtr->typePtr = &intObjType;
6021 objPtr->internalRep.wideValue = wideValue;
6022 return JIM_OK;
6025 #ifdef JIM_OPTIMIZATION
6026 static int JimIsWide(Jim_Obj *objPtr)
6028 return objPtr->typePtr == &intObjType;
6030 #endif
6032 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
6034 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
6035 return JIM_ERR;
6036 *widePtr = JimWideValue(objPtr);
6037 return JIM_OK;
6040 /* Get a wide but does not set an error if the format is bad. */
6041 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
6043 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
6044 return JIM_ERR;
6045 *widePtr = JimWideValue(objPtr);
6046 return JIM_OK;
6049 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
6051 jim_wide wideValue;
6052 int retval;
6054 retval = Jim_GetWide(interp, objPtr, &wideValue);
6055 if (retval == JIM_OK) {
6056 *longPtr = (long)wideValue;
6057 return JIM_OK;
6059 return JIM_ERR;
6062 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
6064 Jim_Obj *objPtr;
6066 objPtr = Jim_NewObj(interp);
6067 objPtr->typePtr = &intObjType;
6068 objPtr->bytes = NULL;
6069 objPtr->internalRep.wideValue = wideValue;
6070 return objPtr;
6073 /* -----------------------------------------------------------------------------
6074 * Double object
6075 * ---------------------------------------------------------------------------*/
6076 #define JIM_DOUBLE_SPACE 30
6078 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
6079 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
6081 static const Jim_ObjType doubleObjType = {
6082 "double",
6083 NULL,
6084 NULL,
6085 UpdateStringOfDouble,
6086 JIM_TYPE_NONE,
6089 #ifndef HAVE_ISNAN
6090 #undef isnan
6091 #define isnan(X) ((X) != (X))
6092 #endif
6093 #ifndef HAVE_ISINF
6094 #undef isinf
6095 #define isinf(X) (1.0 / (X) == 0.0)
6096 #endif
6098 static void UpdateStringOfDouble(struct Jim_Obj *objPtr)
6100 double value = objPtr->internalRep.doubleValue;
6102 if (isnan(value)) {
6103 JimSetStringBytes(objPtr, "NaN");
6104 return;
6106 if (isinf(value)) {
6107 if (value < 0) {
6108 JimSetStringBytes(objPtr, "-Inf");
6110 else {
6111 JimSetStringBytes(objPtr, "Inf");
6113 return;
6116 char buf[JIM_DOUBLE_SPACE + 1];
6117 int i;
6118 int len = sprintf(buf, "%.12g", value);
6120 /* Add a final ".0" if necessary */
6121 for (i = 0; i < len; i++) {
6122 if (buf[i] == '.' || buf[i] == 'e') {
6123 #if defined(JIM_SPRINTF_DOUBLE_NEEDS_FIX)
6124 /* If 'buf' ends in e-0nn or e+0nn, remove
6125 * the 0 after the + or - and reduce the length by 1
6127 char *e = strchr(buf, 'e');
6128 if (e && (e[1] == '-' || e[1] == '+') && e[2] == '0') {
6129 /* Move it up */
6130 e += 2;
6131 memmove(e, e + 1, len - (e - buf));
6133 #endif
6134 break;
6137 if (buf[i] == '\0') {
6138 buf[i++] = '.';
6139 buf[i++] = '0';
6140 buf[i] = '\0';
6142 JimSetStringBytes(objPtr, buf);
6146 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6148 double doubleValue;
6149 jim_wide wideValue;
6150 const char *str;
6152 #ifdef HAVE_LONG_LONG
6153 /* Assume a 53 bit mantissa */
6154 #define MIN_INT_IN_DOUBLE -(1LL << 53)
6155 #define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1)
6157 if (objPtr->typePtr == &intObjType
6158 && JimWideValue(objPtr) >= MIN_INT_IN_DOUBLE
6159 && JimWideValue(objPtr) <= MAX_INT_IN_DOUBLE) {
6161 /* Direct conversion to coerced double */
6162 objPtr->typePtr = &coercedDoubleObjType;
6163 return JIM_OK;
6165 #endif
6166 /* Preserve the string representation.
6167 * Needed so we can convert back to int without loss
6169 str = Jim_String(objPtr);
6171 if (Jim_StringToWide(str, &wideValue, 10) == JIM_OK) {
6172 /* Managed to convert to an int, so we can use this as a cooerced double */
6173 Jim_FreeIntRep(interp, objPtr);
6174 objPtr->typePtr = &coercedDoubleObjType;
6175 objPtr->internalRep.wideValue = wideValue;
6176 return JIM_OK;
6178 else {
6179 /* Try to convert into a double */
6180 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
6181 Jim_SetResultFormatted(interp, "expected floating-point number but got \"%#s\"", objPtr);
6182 return JIM_ERR;
6184 /* Free the old internal repr and set the new one. */
6185 Jim_FreeIntRep(interp, objPtr);
6187 objPtr->typePtr = &doubleObjType;
6188 objPtr->internalRep.doubleValue = doubleValue;
6189 return JIM_OK;
6192 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
6194 if (objPtr->typePtr == &coercedDoubleObjType) {
6195 *doublePtr = JimWideValue(objPtr);
6196 return JIM_OK;
6198 if (objPtr->typePtr != &doubleObjType && SetDoubleFromAny(interp, objPtr) == JIM_ERR)
6199 return JIM_ERR;
6201 if (objPtr->typePtr == &coercedDoubleObjType) {
6202 *doublePtr = JimWideValue(objPtr);
6204 else {
6205 *doublePtr = objPtr->internalRep.doubleValue;
6207 return JIM_OK;
6210 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
6212 Jim_Obj *objPtr;
6214 objPtr = Jim_NewObj(interp);
6215 objPtr->typePtr = &doubleObjType;
6216 objPtr->bytes = NULL;
6217 objPtr->internalRep.doubleValue = doubleValue;
6218 return objPtr;
6221 /* -----------------------------------------------------------------------------
6222 * Boolean conversion
6223 * ---------------------------------------------------------------------------*/
6224 static int SetBooleanFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
6226 int Jim_GetBoolean(Jim_Interp *interp, Jim_Obj *objPtr, int * booleanPtr)
6228 if (objPtr->typePtr != &intObjType && SetBooleanFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
6229 return JIM_ERR;
6230 *booleanPtr = (int) JimWideValue(objPtr);
6231 return JIM_OK;
6234 static int SetBooleanFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
6236 static const char * const falses[] = {
6237 "0", "false", "no", "off", NULL
6239 static const char * const trues[] = {
6240 "1", "true", "yes", "on", NULL
6243 int boolean;
6245 int index;
6246 if (Jim_GetEnum(interp, objPtr, falses, &index, NULL, 0) == JIM_OK) {
6247 boolean = 0;
6248 } else if (Jim_GetEnum(interp, objPtr, trues, &index, NULL, 0) == JIM_OK) {
6249 boolean = 1;
6250 } else {
6251 if (flags & JIM_ERRMSG) {
6252 Jim_SetResultFormatted(interp, "expected boolean but got \"%#s\"", objPtr);
6254 return JIM_ERR;
6257 /* Free the old internal repr and set the new one. */
6258 Jim_FreeIntRep(interp, objPtr);
6259 objPtr->typePtr = &intObjType;
6260 objPtr->internalRep.wideValue = boolean;
6261 return JIM_OK;
6264 /* -----------------------------------------------------------------------------
6265 * List object
6266 * ---------------------------------------------------------------------------*/
6267 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec);
6268 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
6269 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6270 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6271 static void UpdateStringOfList(struct Jim_Obj *objPtr);
6272 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6274 /* Note that while the elements of the list may contain references,
6275 * the list object itself can't. This basically means that the
6276 * list object string representation as a whole can't contain references
6277 * that are not presents in the single elements. */
6278 static const Jim_ObjType listObjType = {
6279 "list",
6280 FreeListInternalRep,
6281 DupListInternalRep,
6282 UpdateStringOfList,
6283 JIM_TYPE_NONE,
6286 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6288 int i;
6290 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
6291 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
6293 Jim_Free(objPtr->internalRep.listValue.ele);
6296 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6298 int i;
6300 JIM_NOTUSED(interp);
6302 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
6303 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
6304 dupPtr->internalRep.listValue.ele =
6305 Jim_Alloc(sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.maxLen);
6306 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
6307 sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.len);
6308 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
6309 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
6311 dupPtr->typePtr = &listObjType;
6314 /* The following function checks if a given string can be encoded
6315 * into a list element without any kind of quoting, surrounded by braces,
6316 * or using escapes to quote. */
6317 #define JIM_ELESTR_SIMPLE 0
6318 #define JIM_ELESTR_BRACE 1
6319 #define JIM_ELESTR_QUOTE 2
6320 static unsigned char ListElementQuotingType(const char *s, int len)
6322 int i, level, blevel, trySimple = 1;
6324 /* Try with the SIMPLE case */
6325 if (len == 0)
6326 return JIM_ELESTR_BRACE;
6327 if (s[0] == '"' || s[0] == '{') {
6328 trySimple = 0;
6329 goto testbrace;
6331 for (i = 0; i < len; i++) {
6332 switch (s[i]) {
6333 case ' ':
6334 case '$':
6335 case '"':
6336 case '[':
6337 case ']':
6338 case ';':
6339 case '\\':
6340 case '\r':
6341 case '\n':
6342 case '\t':
6343 case '\f':
6344 case '\v':
6345 trySimple = 0;
6346 /* fall through */
6347 case '{':
6348 case '}':
6349 goto testbrace;
6352 return JIM_ELESTR_SIMPLE;
6354 testbrace:
6355 /* Test if it's possible to do with braces */
6356 if (s[len - 1] == '\\')
6357 return JIM_ELESTR_QUOTE;
6358 level = 0;
6359 blevel = 0;
6360 for (i = 0; i < len; i++) {
6361 switch (s[i]) {
6362 case '{':
6363 level++;
6364 break;
6365 case '}':
6366 level--;
6367 if (level < 0)
6368 return JIM_ELESTR_QUOTE;
6369 break;
6370 case '[':
6371 blevel++;
6372 break;
6373 case ']':
6374 blevel--;
6375 break;
6376 case '\\':
6377 if (s[i + 1] == '\n')
6378 return JIM_ELESTR_QUOTE;
6379 else if (s[i + 1] != '\0')
6380 i++;
6381 break;
6384 if (blevel < 0) {
6385 return JIM_ELESTR_QUOTE;
6388 if (level == 0) {
6389 if (!trySimple)
6390 return JIM_ELESTR_BRACE;
6391 for (i = 0; i < len; i++) {
6392 switch (s[i]) {
6393 case ' ':
6394 case '$':
6395 case '"':
6396 case '[':
6397 case ']':
6398 case ';':
6399 case '\\':
6400 case '\r':
6401 case '\n':
6402 case '\t':
6403 case '\f':
6404 case '\v':
6405 return JIM_ELESTR_BRACE;
6406 break;
6409 return JIM_ELESTR_SIMPLE;
6411 return JIM_ELESTR_QUOTE;
6414 /* Backslashes-escapes the null-terminated string 's' into the buffer at 'q'
6415 * The buffer must be at least strlen(s) * 2 + 1 bytes long for the worst-case
6416 * scenario.
6417 * Returns the length of the result.
6419 static int BackslashQuoteString(const char *s, int len, char *q)
6421 char *p = q;
6423 while (len--) {
6424 switch (*s) {
6425 case ' ':
6426 case '$':
6427 case '"':
6428 case '[':
6429 case ']':
6430 case '{':
6431 case '}':
6432 case ';':
6433 case '\\':
6434 *p++ = '\\';
6435 *p++ = *s++;
6436 break;
6437 case '\n':
6438 *p++ = '\\';
6439 *p++ = 'n';
6440 s++;
6441 break;
6442 case '\r':
6443 *p++ = '\\';
6444 *p++ = 'r';
6445 s++;
6446 break;
6447 case '\t':
6448 *p++ = '\\';
6449 *p++ = 't';
6450 s++;
6451 break;
6452 case '\f':
6453 *p++ = '\\';
6454 *p++ = 'f';
6455 s++;
6456 break;
6457 case '\v':
6458 *p++ = '\\';
6459 *p++ = 'v';
6460 s++;
6461 break;
6462 default:
6463 *p++ = *s++;
6464 break;
6467 *p = '\0';
6469 return p - q;
6472 static void JimMakeListStringRep(Jim_Obj *objPtr, Jim_Obj **objv, int objc)
6474 #define STATIC_QUOTING_LEN 32
6475 int i, bufLen, realLength;
6476 const char *strRep;
6477 char *p;
6478 unsigned char *quotingType, staticQuoting[STATIC_QUOTING_LEN];
6480 /* Estimate the space needed. */
6481 if (objc > STATIC_QUOTING_LEN) {
6482 quotingType = Jim_Alloc(objc);
6484 else {
6485 quotingType = staticQuoting;
6487 bufLen = 0;
6488 for (i = 0; i < objc; i++) {
6489 int len;
6491 strRep = Jim_GetString(objv[i], &len);
6492 quotingType[i] = ListElementQuotingType(strRep, len);
6493 switch (quotingType[i]) {
6494 case JIM_ELESTR_SIMPLE:
6495 if (i != 0 || strRep[0] != '#') {
6496 bufLen += len;
6497 break;
6499 /* Special case '#' on first element needs braces */
6500 quotingType[i] = JIM_ELESTR_BRACE;
6501 /* fall through */
6502 case JIM_ELESTR_BRACE:
6503 bufLen += len + 2;
6504 break;
6505 case JIM_ELESTR_QUOTE:
6506 bufLen += len * 2;
6507 break;
6509 bufLen++; /* elements separator. */
6511 bufLen++;
6513 /* Generate the string rep. */
6514 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
6515 realLength = 0;
6516 for (i = 0; i < objc; i++) {
6517 int len, qlen;
6519 strRep = Jim_GetString(objv[i], &len);
6521 switch (quotingType[i]) {
6522 case JIM_ELESTR_SIMPLE:
6523 memcpy(p, strRep, len);
6524 p += len;
6525 realLength += len;
6526 break;
6527 case JIM_ELESTR_BRACE:
6528 *p++ = '{';
6529 memcpy(p, strRep, len);
6530 p += len;
6531 *p++ = '}';
6532 realLength += len + 2;
6533 break;
6534 case JIM_ELESTR_QUOTE:
6535 if (i == 0 && strRep[0] == '#') {
6536 *p++ = '\\';
6537 realLength++;
6539 qlen = BackslashQuoteString(strRep, len, p);
6540 p += qlen;
6541 realLength += qlen;
6542 break;
6544 /* Add a separating space */
6545 if (i + 1 != objc) {
6546 *p++ = ' ';
6547 realLength++;
6550 *p = '\0'; /* nul term. */
6551 objPtr->length = realLength;
6553 if (quotingType != staticQuoting) {
6554 Jim_Free(quotingType);
6558 static void UpdateStringOfList(struct Jim_Obj *objPtr)
6560 JimMakeListStringRep(objPtr, objPtr->internalRep.listValue.ele, objPtr->internalRep.listValue.len);
6563 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6565 struct JimParserCtx parser;
6566 const char *str;
6567 int strLen;
6568 Jim_Obj *fileNameObj;
6569 int linenr;
6571 if (objPtr->typePtr == &listObjType) {
6572 return JIM_OK;
6575 /* Optimise dict -> list for object with no string rep. Note that this may only save a little time, but
6576 * it also preserves any source location of the dict elements
6577 * which can be very useful
6579 if (Jim_IsDict(objPtr) && objPtr->bytes == NULL) {
6580 Jim_Obj **listObjPtrPtr;
6581 int len;
6582 int i;
6584 listObjPtrPtr = JimDictPairs(objPtr, &len);
6585 for (i = 0; i < len; i++) {
6586 Jim_IncrRefCount(listObjPtrPtr[i]);
6589 /* Now just switch the internal rep */
6590 Jim_FreeIntRep(interp, objPtr);
6591 objPtr->typePtr = &listObjType;
6592 objPtr->internalRep.listValue.len = len;
6593 objPtr->internalRep.listValue.maxLen = len;
6594 objPtr->internalRep.listValue.ele = listObjPtrPtr;
6596 return JIM_OK;
6599 /* Try to preserve information about filename / line number */
6600 if (objPtr->typePtr == &sourceObjType) {
6601 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
6602 linenr = objPtr->internalRep.sourceValue.lineNumber;
6604 else {
6605 fileNameObj = interp->emptyObj;
6606 linenr = 1;
6608 Jim_IncrRefCount(fileNameObj);
6610 /* Get the string representation */
6611 str = Jim_GetString(objPtr, &strLen);
6613 /* Free the old internal repr just now and initialize the
6614 * new one just now. The string->list conversion can't fail. */
6615 Jim_FreeIntRep(interp, objPtr);
6616 objPtr->typePtr = &listObjType;
6617 objPtr->internalRep.listValue.len = 0;
6618 objPtr->internalRep.listValue.maxLen = 0;
6619 objPtr->internalRep.listValue.ele = NULL;
6621 /* Convert into a list */
6622 if (strLen) {
6623 JimParserInit(&parser, str, strLen, linenr);
6624 while (!parser.eof) {
6625 Jim_Obj *elementPtr;
6627 JimParseList(&parser);
6628 if (parser.tt != JIM_TT_STR && parser.tt != JIM_TT_ESC)
6629 continue;
6630 elementPtr = JimParserGetTokenObj(interp, &parser);
6631 JimSetSourceInfo(interp, elementPtr, fileNameObj, parser.tline);
6632 ListAppendElement(objPtr, elementPtr);
6635 Jim_DecrRefCount(interp, fileNameObj);
6636 return JIM_OK;
6639 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
6641 Jim_Obj *objPtr;
6643 objPtr = Jim_NewObj(interp);
6644 objPtr->typePtr = &listObjType;
6645 objPtr->bytes = NULL;
6646 objPtr->internalRep.listValue.ele = NULL;
6647 objPtr->internalRep.listValue.len = 0;
6648 objPtr->internalRep.listValue.maxLen = 0;
6650 if (len) {
6651 ListInsertElements(objPtr, 0, len, elements);
6654 return objPtr;
6657 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
6658 * length of the vector. Note that the user of this function should make
6659 * sure that the list object can't shimmer while the vector returned
6660 * is in use, this vector is the one stored inside the internal representation
6661 * of the list object. This function is not exported, extensions should
6662 * always access to the List object elements using Jim_ListIndex(). */
6663 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *listLen,
6664 Jim_Obj ***listVec)
6666 *listLen = Jim_ListLength(interp, listObj);
6667 *listVec = listObj->internalRep.listValue.ele;
6670 /* Sorting uses ints, but commands may return wide */
6671 static int JimSign(jim_wide w)
6673 if (w == 0) {
6674 return 0;
6676 else if (w < 0) {
6677 return -1;
6679 return 1;
6682 /* ListSortElements type values */
6683 struct lsort_info {
6684 jmp_buf jmpbuf;
6685 Jim_Obj *command;
6686 Jim_Interp *interp;
6687 enum {
6688 JIM_LSORT_ASCII,
6689 JIM_LSORT_NOCASE,
6690 JIM_LSORT_INTEGER,
6691 JIM_LSORT_REAL,
6692 JIM_LSORT_COMMAND
6693 } type;
6694 int order;
6695 int index;
6696 int indexed;
6697 int unique;
6698 int (*subfn)(Jim_Obj **, Jim_Obj **);
6701 static struct lsort_info *sort_info;
6703 static int ListSortIndexHelper(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6705 Jim_Obj *lObj, *rObj;
6707 if (Jim_ListIndex(sort_info->interp, *lhsObj, sort_info->index, &lObj, JIM_ERRMSG) != JIM_OK ||
6708 Jim_ListIndex(sort_info->interp, *rhsObj, sort_info->index, &rObj, JIM_ERRMSG) != JIM_OK) {
6709 longjmp(sort_info->jmpbuf, JIM_ERR);
6711 return sort_info->subfn(&lObj, &rObj);
6714 /* Sort the internal rep of a list. */
6715 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6717 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 0) * sort_info->order;
6720 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6722 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 1) * sort_info->order;
6725 static int ListSortInteger(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6727 jim_wide lhs = 0, rhs = 0;
6729 if (Jim_GetWide(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6730 Jim_GetWide(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6731 longjmp(sort_info->jmpbuf, JIM_ERR);
6734 return JimSign(lhs - rhs) * sort_info->order;
6737 static int ListSortReal(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6739 double lhs = 0, rhs = 0;
6741 if (Jim_GetDouble(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6742 Jim_GetDouble(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6743 longjmp(sort_info->jmpbuf, JIM_ERR);
6745 if (lhs == rhs) {
6746 return 0;
6748 if (lhs > rhs) {
6749 return sort_info->order;
6751 return -sort_info->order;
6754 static int ListSortCommand(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6756 Jim_Obj *compare_script;
6757 int rc;
6759 jim_wide ret = 0;
6761 /* This must be a valid list */
6762 compare_script = Jim_DuplicateObj(sort_info->interp, sort_info->command);
6763 Jim_ListAppendElement(sort_info->interp, compare_script, *lhsObj);
6764 Jim_ListAppendElement(sort_info->interp, compare_script, *rhsObj);
6766 rc = Jim_EvalObj(sort_info->interp, compare_script);
6768 if (rc != JIM_OK || Jim_GetWide(sort_info->interp, Jim_GetResult(sort_info->interp), &ret) != JIM_OK) {
6769 longjmp(sort_info->jmpbuf, rc);
6772 return JimSign(ret) * sort_info->order;
6775 /* Remove duplicate elements from the (sorted) list in-place, according to the
6776 * comparison function, comp.
6778 * Note that the last unique value is kept, not the first
6780 static void ListRemoveDuplicates(Jim_Obj *listObjPtr, int (*comp)(Jim_Obj **lhs, Jim_Obj **rhs))
6782 int src;
6783 int dst = 0;
6784 Jim_Obj **ele = listObjPtr->internalRep.listValue.ele;
6786 for (src = 1; src < listObjPtr->internalRep.listValue.len; src++) {
6787 if (comp(&ele[dst], &ele[src]) == 0) {
6788 /* Match, so replace the dest with the current source */
6789 Jim_DecrRefCount(sort_info->interp, ele[dst]);
6791 else {
6792 /* No match, so keep the current source and move to the next destination */
6793 dst++;
6795 ele[dst] = ele[src];
6798 /* At end of list, keep the final element unless all elements were kept */
6799 dst++;
6800 if (dst < listObjPtr->internalRep.listValue.len) {
6801 ele[dst] = ele[src];
6804 /* Set the new length */
6805 listObjPtr->internalRep.listValue.len = dst;
6808 /* Sort a list *in place*. MUST be called with a non-shared list. */
6809 static int ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, struct lsort_info *info)
6811 struct lsort_info *prev_info;
6813 typedef int (qsort_comparator) (const void *, const void *);
6814 int (*fn) (Jim_Obj **, Jim_Obj **);
6815 Jim_Obj **vector;
6816 int len;
6817 int rc;
6819 JimPanic((Jim_IsShared(listObjPtr), "ListSortElements called with shared object"));
6820 SetListFromAny(interp, listObjPtr);
6822 /* Allow lsort to be called reentrantly */
6823 prev_info = sort_info;
6824 sort_info = info;
6826 vector = listObjPtr->internalRep.listValue.ele;
6827 len = listObjPtr->internalRep.listValue.len;
6828 switch (info->type) {
6829 case JIM_LSORT_ASCII:
6830 fn = ListSortString;
6831 break;
6832 case JIM_LSORT_NOCASE:
6833 fn = ListSortStringNoCase;
6834 break;
6835 case JIM_LSORT_INTEGER:
6836 fn = ListSortInteger;
6837 break;
6838 case JIM_LSORT_REAL:
6839 fn = ListSortReal;
6840 break;
6841 case JIM_LSORT_COMMAND:
6842 fn = ListSortCommand;
6843 break;
6844 default:
6845 fn = NULL; /* avoid warning */
6846 JimPanic((1, "ListSort called with invalid sort type"));
6847 return -1; /* Should not be run but keeps static analysers happy */
6850 if (info->indexed) {
6851 /* Need to interpose a "list index" function */
6852 info->subfn = fn;
6853 fn = ListSortIndexHelper;
6856 if ((rc = setjmp(info->jmpbuf)) == 0) {
6857 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *) fn);
6859 if (info->unique && len > 1) {
6860 ListRemoveDuplicates(listObjPtr, fn);
6863 Jim_InvalidateStringRep(listObjPtr);
6865 sort_info = prev_info;
6867 return rc;
6870 /* This is the low-level function to insert elements into a list.
6871 * The higher-level Jim_ListInsertElements() performs shared object
6872 * check and invalidates the string repr. This version is used
6873 * in the internals of the List Object and is not exported.
6875 * NOTE: this function can be called only against objects
6876 * with internal type of List.
6878 * An insertion point (idx) of -1 means end-of-list.
6880 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec)
6882 int currentLen = listPtr->internalRep.listValue.len;
6883 int requiredLen = currentLen + elemc;
6884 int i;
6885 Jim_Obj **point;
6887 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
6888 if (requiredLen < 2) {
6889 /* Don't do allocations of under 4 pointers. */
6890 requiredLen = 4;
6892 else {
6893 requiredLen *= 2;
6896 listPtr->internalRep.listValue.ele = Jim_Realloc(listPtr->internalRep.listValue.ele,
6897 sizeof(Jim_Obj *) * requiredLen);
6899 listPtr->internalRep.listValue.maxLen = requiredLen;
6901 if (idx < 0) {
6902 idx = currentLen;
6904 point = listPtr->internalRep.listValue.ele + idx;
6905 memmove(point + elemc, point, (currentLen - idx) * sizeof(Jim_Obj *));
6906 for (i = 0; i < elemc; ++i) {
6907 point[i] = elemVec[i];
6908 Jim_IncrRefCount(point[i]);
6910 listPtr->internalRep.listValue.len += elemc;
6913 /* Convenience call to ListInsertElements() to append a single element.
6915 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
6917 ListInsertElements(listPtr, -1, 1, &objPtr);
6920 /* Appends every element of appendListPtr into listPtr.
6921 * Both have to be of the list type.
6922 * Convenience call to ListInsertElements()
6924 static void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6926 ListInsertElements(listPtr, -1,
6927 appendListPtr->internalRep.listValue.len, appendListPtr->internalRep.listValue.ele);
6930 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
6932 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendElement called with shared object"));
6933 SetListFromAny(interp, listPtr);
6934 Jim_InvalidateStringRep(listPtr);
6935 ListAppendElement(listPtr, objPtr);
6938 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6940 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendList called with shared object"));
6941 SetListFromAny(interp, listPtr);
6942 SetListFromAny(interp, appendListPtr);
6943 Jim_InvalidateStringRep(listPtr);
6944 ListAppendList(listPtr, appendListPtr);
6947 int Jim_ListLength(Jim_Interp *interp, Jim_Obj *objPtr)
6949 SetListFromAny(interp, objPtr);
6950 return objPtr->internalRep.listValue.len;
6953 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6954 int objc, Jim_Obj *const *objVec)
6956 JimPanic((Jim_IsShared(listPtr), "Jim_ListInsertElement called with shared object"));
6957 SetListFromAny(interp, listPtr);
6958 if (idx >= 0 && idx > listPtr->internalRep.listValue.len)
6959 idx = listPtr->internalRep.listValue.len;
6960 else if (idx < 0)
6961 idx = 0;
6962 Jim_InvalidateStringRep(listPtr);
6963 ListInsertElements(listPtr, idx, objc, objVec);
6966 Jim_Obj *Jim_ListGetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx)
6968 SetListFromAny(interp, listPtr);
6969 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6970 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6971 return NULL;
6973 if (idx < 0)
6974 idx = listPtr->internalRep.listValue.len + idx;
6975 return listPtr->internalRep.listValue.ele[idx];
6978 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx, Jim_Obj **objPtrPtr, int flags)
6980 *objPtrPtr = Jim_ListGetIndex(interp, listPtr, idx);
6981 if (*objPtrPtr == NULL) {
6982 if (flags & JIM_ERRMSG) {
6983 Jim_SetResultString(interp, "list index out of range", -1);
6985 return JIM_ERR;
6987 return JIM_OK;
6990 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6991 Jim_Obj *newObjPtr, int flags)
6993 SetListFromAny(interp, listPtr);
6994 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6995 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6996 if (flags & JIM_ERRMSG) {
6997 Jim_SetResultString(interp, "list index out of range", -1);
6999 return JIM_ERR;
7001 if (idx < 0)
7002 idx = listPtr->internalRep.listValue.len + idx;
7003 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[idx]);
7004 listPtr->internalRep.listValue.ele[idx] = newObjPtr;
7005 Jim_IncrRefCount(newObjPtr);
7006 return JIM_OK;
7009 /* Modify the list stored in the variable named 'varNamePtr'
7010 * setting the element specified by the 'indexc' indexes objects in 'indexv',
7011 * with the new element 'newObjptr'. (implements the [lset] command) */
7012 int Jim_ListSetIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
7013 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
7015 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
7016 int shared, i, idx;
7018 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG | JIM_UNSHARED);
7019 if (objPtr == NULL)
7020 return JIM_ERR;
7021 if ((shared = Jim_IsShared(objPtr)))
7022 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
7023 for (i = 0; i < indexc - 1; i++) {
7024 listObjPtr = objPtr;
7025 if (Jim_GetIndex(interp, indexv[i], &idx) != JIM_OK)
7026 goto err;
7027 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_ERRMSG) != JIM_OK) {
7028 goto err;
7030 if (Jim_IsShared(objPtr)) {
7031 objPtr = Jim_DuplicateObj(interp, objPtr);
7032 ListSetIndex(interp, listObjPtr, idx, objPtr, JIM_NONE);
7034 Jim_InvalidateStringRep(listObjPtr);
7036 if (Jim_GetIndex(interp, indexv[indexc - 1], &idx) != JIM_OK)
7037 goto err;
7038 if (ListSetIndex(interp, objPtr, idx, newObjPtr, JIM_ERRMSG) == JIM_ERR)
7039 goto err;
7040 Jim_InvalidateStringRep(objPtr);
7041 Jim_InvalidateStringRep(varObjPtr);
7042 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
7043 goto err;
7044 Jim_SetResult(interp, varObjPtr);
7045 return JIM_OK;
7046 err:
7047 if (shared) {
7048 Jim_FreeNewObj(interp, varObjPtr);
7050 return JIM_ERR;
7053 Jim_Obj *Jim_ListJoin(Jim_Interp *interp, Jim_Obj *listObjPtr, const char *joinStr, int joinStrLen)
7055 int i;
7056 int listLen = Jim_ListLength(interp, listObjPtr);
7057 Jim_Obj *resObjPtr = Jim_NewEmptyStringObj(interp);
7059 for (i = 0; i < listLen; ) {
7060 Jim_AppendObj(interp, resObjPtr, Jim_ListGetIndex(interp, listObjPtr, i));
7061 if (++i != listLen) {
7062 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
7065 return resObjPtr;
7068 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
7070 int i;
7072 /* If all the objects in objv are lists,
7073 * it's possible to return a list as result, that's the
7074 * concatenation of all the lists. */
7075 for (i = 0; i < objc; i++) {
7076 if (!Jim_IsList(objv[i]))
7077 break;
7079 if (i == objc) {
7080 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
7082 for (i = 0; i < objc; i++)
7083 ListAppendList(objPtr, objv[i]);
7084 return objPtr;
7086 else {
7087 /* Else... we have to glue strings together */
7088 int len = 0, objLen;
7089 char *bytes, *p;
7091 /* Compute the length */
7092 for (i = 0; i < objc; i++) {
7093 len += Jim_Length(objv[i]);
7095 if (objc)
7096 len += objc - 1;
7097 /* Create the string rep, and a string object holding it. */
7098 p = bytes = Jim_Alloc(len + 1);
7099 for (i = 0; i < objc; i++) {
7100 const char *s = Jim_GetString(objv[i], &objLen);
7102 /* Remove leading space */
7103 while (objLen && isspace(UCHAR(*s))) {
7104 s++;
7105 objLen--;
7106 len--;
7108 /* And trailing space */
7109 while (objLen && isspace(UCHAR(s[objLen - 1]))) {
7110 /* Handle trailing backslash-space case */
7111 if (objLen > 1 && s[objLen - 2] == '\\') {
7112 break;
7114 objLen--;
7115 len--;
7117 memcpy(p, s, objLen);
7118 p += objLen;
7119 if (i + 1 != objc) {
7120 if (objLen)
7121 *p++ = ' ';
7122 else {
7123 /* Drop the space calculated for this
7124 * element that is instead null. */
7125 len--;
7129 *p = '\0';
7130 return Jim_NewStringObjNoAlloc(interp, bytes, len);
7134 /* Returns a list composed of the elements in the specified range.
7135 * first and start are directly accepted as Jim_Objects and
7136 * processed for the end?-index? case. */
7137 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr,
7138 Jim_Obj *lastObjPtr)
7140 int first, last;
7141 int len, rangeLen;
7143 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
7144 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
7145 return NULL;
7146 len = Jim_ListLength(interp, listObjPtr); /* will convert into list */
7147 first = JimRelToAbsIndex(len, first);
7148 last = JimRelToAbsIndex(len, last);
7149 JimRelToAbsRange(len, &first, &last, &rangeLen);
7150 if (first == 0 && last == len) {
7151 return listObjPtr;
7153 return Jim_NewListObj(interp, listObjPtr->internalRep.listValue.ele + first, rangeLen);
7156 /* -----------------------------------------------------------------------------
7157 * Dict object
7158 * ---------------------------------------------------------------------------*/
7159 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
7160 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
7161 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
7162 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7164 /* Dict HashTable Type.
7166 * Keys and Values are Jim objects. */
7168 static const Jim_HashTableType JimDictHashTableType = {
7169 JimObjectHTHashFunction, /* hash function */
7170 JimObjectHTKeyValDup, /* key dup */
7171 JimObjectHTKeyValDup, /* val dup */
7172 JimObjectHTKeyCompare, /* key compare */
7173 JimObjectHTKeyValDestructor, /* key destructor */
7174 JimObjectHTKeyValDestructor /* val destructor */
7177 /* Note that while the elements of the dict may contain references,
7178 * the list object itself can't. This basically means that the
7179 * dict object string representation as a whole can't contain references
7180 * that are not presents in the single elements. */
7181 static const Jim_ObjType dictObjType = {
7182 "dict",
7183 FreeDictInternalRep,
7184 DupDictInternalRep,
7185 UpdateStringOfDict,
7186 JIM_TYPE_NONE,
7189 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
7191 JIM_NOTUSED(interp);
7193 Jim_FreeHashTable(objPtr->internalRep.ptr);
7194 Jim_Free(objPtr->internalRep.ptr);
7197 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
7199 Jim_HashTable *ht, *dupHt;
7200 Jim_HashTableIterator htiter;
7201 Jim_HashEntry *he;
7203 /* Create a new hash table */
7204 ht = srcPtr->internalRep.ptr;
7205 dupHt = Jim_Alloc(sizeof(*dupHt));
7206 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
7207 if (ht->size != 0)
7208 Jim_ExpandHashTable(dupHt, ht->size);
7209 /* Copy every element from the source to the dup hash table */
7210 JimInitHashTableIterator(ht, &htiter);
7211 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7212 Jim_AddHashEntry(dupHt, he->key, he->u.val);
7215 dupPtr->internalRep.ptr = dupHt;
7216 dupPtr->typePtr = &dictObjType;
7219 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len)
7221 Jim_HashTable *ht;
7222 Jim_HashTableIterator htiter;
7223 Jim_HashEntry *he;
7224 Jim_Obj **objv;
7225 int i;
7227 ht = dictPtr->internalRep.ptr;
7229 /* Turn the hash table into a flat vector of Jim_Objects. */
7230 objv = Jim_Alloc((ht->used * 2) * sizeof(Jim_Obj *));
7231 JimInitHashTableIterator(ht, &htiter);
7232 i = 0;
7233 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7234 objv[i++] = Jim_GetHashEntryKey(he);
7235 objv[i++] = Jim_GetHashEntryVal(he);
7237 *len = i;
7238 return objv;
7241 static void UpdateStringOfDict(struct Jim_Obj *objPtr)
7243 /* Turn the hash table into a flat vector of Jim_Objects. */
7244 int len;
7245 Jim_Obj **objv = JimDictPairs(objPtr, &len);
7247 /* And now generate the string rep as a list */
7248 JimMakeListStringRep(objPtr, objv, len);
7250 Jim_Free(objv);
7253 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
7255 int listlen;
7257 if (objPtr->typePtr == &dictObjType) {
7258 return JIM_OK;
7261 if (Jim_IsList(objPtr) && Jim_IsShared(objPtr)) {
7262 /* A shared list, so get the string representation now to avoid
7263 * changing the order in case of fast conversion to dict.
7265 Jim_String(objPtr);
7268 /* For simplicity, convert a non-list object to a list and then to a dict */
7269 listlen = Jim_ListLength(interp, objPtr);
7270 if (listlen % 2) {
7271 Jim_SetResultString(interp, "missing value to go with key", -1);
7272 return JIM_ERR;
7274 else {
7275 /* Converting from a list to a dict can't fail */
7276 Jim_HashTable *ht;
7277 int i;
7279 ht = Jim_Alloc(sizeof(*ht));
7280 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
7282 for (i = 0; i < listlen; i += 2) {
7283 Jim_Obj *keyObjPtr = Jim_ListGetIndex(interp, objPtr, i);
7284 Jim_Obj *valObjPtr = Jim_ListGetIndex(interp, objPtr, i + 1);
7286 Jim_ReplaceHashEntry(ht, keyObjPtr, valObjPtr);
7289 Jim_FreeIntRep(interp, objPtr);
7290 objPtr->typePtr = &dictObjType;
7291 objPtr->internalRep.ptr = ht;
7293 return JIM_OK;
7297 /* Dict object API */
7299 /* Add an element to a dict. objPtr must be of the "dict" type.
7300 * The higher-level exported function is Jim_DictAddElement().
7301 * If an element with the specified key already exists, the value
7302 * associated is replaced with the new one.
7304 * if valueObjPtr == NULL, the key is instead removed if it exists. */
7305 static int DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7306 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7308 Jim_HashTable *ht = objPtr->internalRep.ptr;
7310 if (valueObjPtr == NULL) { /* unset */
7311 return Jim_DeleteHashEntry(ht, keyObjPtr);
7313 Jim_ReplaceHashEntry(ht, keyObjPtr, valueObjPtr);
7314 return JIM_OK;
7317 /* Add an element, higher-level interface for DictAddElement().
7318 * If valueObjPtr == NULL, the key is removed if it exists. */
7319 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7320 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7322 JimPanic((Jim_IsShared(objPtr), "Jim_DictAddElement called with shared object"));
7323 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
7324 return JIM_ERR;
7326 Jim_InvalidateStringRep(objPtr);
7327 return DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
7330 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
7332 Jim_Obj *objPtr;
7333 int i;
7335 JimPanic((len % 2, "Jim_NewDictObj() 'len' argument must be even"));
7337 objPtr = Jim_NewObj(interp);
7338 objPtr->typePtr = &dictObjType;
7339 objPtr->bytes = NULL;
7340 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
7341 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
7342 for (i = 0; i < len; i += 2)
7343 DictAddElement(interp, objPtr, elements[i], elements[i + 1]);
7344 return objPtr;
7347 /* Return the value associated to the specified dict key
7348 * Returns JIM_OK if OK, JIM_ERR if entry not found or -1 if can't create dict value
7350 * Sets *objPtrPtr to non-NULL only upon success.
7352 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
7353 Jim_Obj **objPtrPtr, int flags)
7355 Jim_HashEntry *he;
7356 Jim_HashTable *ht;
7358 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7359 return -1;
7361 ht = dictPtr->internalRep.ptr;
7362 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
7363 if (flags & JIM_ERRMSG) {
7364 Jim_SetResultFormatted(interp, "key \"%#s\" not known in dictionary", keyPtr);
7366 return JIM_ERR;
7368 else {
7369 *objPtrPtr = Jim_GetHashEntryVal(he);
7370 return JIM_OK;
7374 /* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */
7375 int Jim_DictPairs(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj ***objPtrPtr, int *len)
7377 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7378 return JIM_ERR;
7380 *objPtrPtr = JimDictPairs(dictPtr, len);
7382 return JIM_OK;
7386 /* Return the value associated to the specified dict keys */
7387 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
7388 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
7390 int i;
7392 if (keyc == 0) {
7393 *objPtrPtr = dictPtr;
7394 return JIM_OK;
7397 for (i = 0; i < keyc; i++) {
7398 Jim_Obj *objPtr;
7400 int rc = Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags);
7401 if (rc != JIM_OK) {
7402 return rc;
7404 dictPtr = objPtr;
7406 *objPtrPtr = dictPtr;
7407 return JIM_OK;
7410 /* Modify the dict stored into the variable named 'varNamePtr'
7411 * setting the element specified by the 'keyc' keys objects in 'keyv',
7412 * with the new value of the element 'newObjPtr'.
7414 * If newObjPtr == NULL the operation is to remove the given key
7415 * from the dictionary.
7417 * If flags & JIM_ERRMSG, then failure to remove the key is considered an error
7418 * and JIM_ERR is returned. Otherwise it is ignored and JIM_OK is returned.
7420 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
7421 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr, int flags)
7423 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
7424 int shared, i;
7426 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, flags);
7427 if (objPtr == NULL) {
7428 if (newObjPtr == NULL && (flags & JIM_MUSTEXIST)) {
7429 /* Cannot remove a key from non existing var */
7430 return JIM_ERR;
7432 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
7433 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
7434 Jim_FreeNewObj(interp, varObjPtr);
7435 return JIM_ERR;
7438 if ((shared = Jim_IsShared(objPtr)))
7439 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
7440 for (i = 0; i < keyc; i++) {
7441 dictObjPtr = objPtr;
7443 /* Check if it's a valid dictionary */
7444 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK) {
7445 goto err;
7448 if (i == keyc - 1) {
7449 /* Last key: Note that error on unset with missing last key is OK */
7450 if (Jim_DictAddElement(interp, objPtr, keyv[keyc - 1], newObjPtr) != JIM_OK) {
7451 if (newObjPtr || (flags & JIM_MUSTEXIST)) {
7452 goto err;
7455 break;
7458 /* Check if the given key exists. */
7459 Jim_InvalidateStringRep(dictObjPtr);
7460 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
7461 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK) {
7462 /* This key exists at the current level.
7463 * Make sure it's not shared!. */
7464 if (Jim_IsShared(objPtr)) {
7465 objPtr = Jim_DuplicateObj(interp, objPtr);
7466 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7469 else {
7470 /* Key not found. If it's an [unset] operation
7471 * this is an error. Only the last key may not
7472 * exist. */
7473 if (newObjPtr == NULL) {
7474 goto err;
7476 /* Otherwise set an empty dictionary
7477 * as key's value. */
7478 objPtr = Jim_NewDictObj(interp, NULL, 0);
7479 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7482 /* XXX: Is this necessary? */
7483 Jim_InvalidateStringRep(objPtr);
7484 Jim_InvalidateStringRep(varObjPtr);
7485 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK) {
7486 goto err;
7488 Jim_SetResult(interp, varObjPtr);
7489 return JIM_OK;
7490 err:
7491 if (shared) {
7492 Jim_FreeNewObj(interp, varObjPtr);
7494 return JIM_ERR;
7497 /* -----------------------------------------------------------------------------
7498 * Index object
7499 * ---------------------------------------------------------------------------*/
7500 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
7501 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7503 static const Jim_ObjType indexObjType = {
7504 "index",
7505 NULL,
7506 NULL,
7507 UpdateStringOfIndex,
7508 JIM_TYPE_NONE,
7511 static void UpdateStringOfIndex(struct Jim_Obj *objPtr)
7513 if (objPtr->internalRep.intValue == -1) {
7514 JimSetStringBytes(objPtr, "end");
7516 else {
7517 char buf[JIM_INTEGER_SPACE + 1];
7518 if (objPtr->internalRep.intValue >= 0 || objPtr->internalRep.intValue == -INT_MAX) {
7519 sprintf(buf, "%d", objPtr->internalRep.intValue);
7521 else {
7522 /* Must be <= -2 */
7523 sprintf(buf, "end%d", objPtr->internalRep.intValue + 1);
7525 JimSetStringBytes(objPtr, buf);
7529 static int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7531 int idx, end = 0;
7532 const char *str;
7533 char *endptr;
7535 /* Get the string representation */
7536 str = Jim_String(objPtr);
7538 /* Try to convert into an index */
7539 if (strncmp(str, "end", 3) == 0) {
7540 end = 1;
7541 str += 3;
7542 idx = 0;
7544 else {
7545 idx = jim_strtol(str, &endptr);
7547 if (endptr == str) {
7548 goto badindex;
7550 str = endptr;
7553 /* Now str may include or +<num> or -<num> */
7554 if (*str == '+' || *str == '-') {
7555 int sign = (*str == '+' ? 1 : -1);
7557 idx += sign * jim_strtol(++str, &endptr);
7558 if (str == endptr || *endptr) {
7559 goto badindex;
7561 str = endptr;
7563 /* The only thing left should be spaces */
7564 while (isspace(UCHAR(*str))) {
7565 str++;
7567 if (*str) {
7568 goto badindex;
7570 if (end) {
7571 if (idx > 0) {
7572 idx = INT_MAX;
7574 else {
7575 /* end-1 is repesented as -2 */
7576 idx--;
7579 else if (idx < 0) {
7580 idx = -INT_MAX;
7583 /* Free the old internal repr and set the new one. */
7584 Jim_FreeIntRep(interp, objPtr);
7585 objPtr->typePtr = &indexObjType;
7586 objPtr->internalRep.intValue = idx;
7587 return JIM_OK;
7589 badindex:
7590 Jim_SetResultFormatted(interp,
7591 "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr);
7592 return JIM_ERR;
7595 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
7597 /* Avoid shimmering if the object is an integer. */
7598 if (objPtr->typePtr == &intObjType) {
7599 jim_wide val = JimWideValue(objPtr);
7601 if (val < 0)
7602 *indexPtr = -INT_MAX;
7603 else if (val > INT_MAX)
7604 *indexPtr = INT_MAX;
7605 else
7606 *indexPtr = (int)val;
7607 return JIM_OK;
7609 if (objPtr->typePtr != &indexObjType && SetIndexFromAny(interp, objPtr) == JIM_ERR)
7610 return JIM_ERR;
7611 *indexPtr = objPtr->internalRep.intValue;
7612 return JIM_OK;
7615 /* -----------------------------------------------------------------------------
7616 * Return Code Object.
7617 * ---------------------------------------------------------------------------*/
7619 /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
7620 static const char * const jimReturnCodes[] = {
7621 "ok",
7622 "error",
7623 "return",
7624 "break",
7625 "continue",
7626 "signal",
7627 "exit",
7628 "eval",
7629 NULL
7632 #define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes) - 1)
7634 static const Jim_ObjType returnCodeObjType = {
7635 "return-code",
7636 NULL,
7637 NULL,
7638 NULL,
7639 JIM_TYPE_NONE,
7642 /* Converts a (standard) return code to a string. Returns "?" for
7643 * non-standard return codes.
7645 const char *Jim_ReturnCode(int code)
7647 if (code < 0 || code >= (int)jimReturnCodesSize) {
7648 return "?";
7650 else {
7651 return jimReturnCodes[code];
7655 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7657 int returnCode;
7658 jim_wide wideValue;
7660 /* Try to convert into an integer */
7661 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
7662 returnCode = (int)wideValue;
7663 else if (Jim_GetEnum(interp, objPtr, jimReturnCodes, &returnCode, NULL, JIM_NONE) != JIM_OK) {
7664 Jim_SetResultFormatted(interp, "expected return code but got \"%#s\"", objPtr);
7665 return JIM_ERR;
7667 /* Free the old internal repr and set the new one. */
7668 Jim_FreeIntRep(interp, objPtr);
7669 objPtr->typePtr = &returnCodeObjType;
7670 objPtr->internalRep.intValue = returnCode;
7671 return JIM_OK;
7674 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
7676 if (objPtr->typePtr != &returnCodeObjType && SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
7677 return JIM_ERR;
7678 *intPtr = objPtr->internalRep.intValue;
7679 return JIM_OK;
7682 /* -----------------------------------------------------------------------------
7683 * Expression Parsing
7684 * ---------------------------------------------------------------------------*/
7685 static int JimParseExprOperator(struct JimParserCtx *pc);
7686 static int JimParseExprNumber(struct JimParserCtx *pc);
7687 static int JimParseExprIrrational(struct JimParserCtx *pc);
7688 static int JimParseExprBoolean(struct JimParserCtx *pc);
7690 /* expr operator opcodes. */
7691 enum
7693 /* Continues on from the JIM_TT_ space */
7695 /* Binary operators (numbers) */
7696 JIM_EXPROP_MUL = JIM_TT_EXPR_OP, /* 20 */
7697 JIM_EXPROP_DIV,
7698 JIM_EXPROP_MOD,
7699 JIM_EXPROP_SUB,
7700 JIM_EXPROP_ADD,
7701 JIM_EXPROP_LSHIFT,
7702 JIM_EXPROP_RSHIFT,
7703 JIM_EXPROP_ROTL,
7704 JIM_EXPROP_ROTR,
7705 JIM_EXPROP_LT,
7706 JIM_EXPROP_GT,
7707 JIM_EXPROP_LTE,
7708 JIM_EXPROP_GTE,
7709 JIM_EXPROP_NUMEQ,
7710 JIM_EXPROP_NUMNE,
7711 JIM_EXPROP_BITAND, /* 35 */
7712 JIM_EXPROP_BITXOR,
7713 JIM_EXPROP_BITOR,
7714 JIM_EXPROP_LOGICAND, /* 38 */
7715 JIM_EXPROP_LOGICOR, /* 39 */
7716 JIM_EXPROP_TERNARY, /* 40 */
7717 JIM_EXPROP_COLON, /* 41 */
7718 JIM_EXPROP_POW, /* 42 */
7720 /* Binary operators (strings) */
7721 JIM_EXPROP_STREQ, /* 43 */
7722 JIM_EXPROP_STRNE,
7723 JIM_EXPROP_STRIN,
7724 JIM_EXPROP_STRNI,
7726 /* Unary operators (numbers) */
7727 JIM_EXPROP_NOT, /* 47 */
7728 JIM_EXPROP_BITNOT,
7729 JIM_EXPROP_UNARYMINUS,
7730 JIM_EXPROP_UNARYPLUS,
7732 /* Functions */
7733 JIM_EXPROP_FUNC_INT, /* 51 */
7734 JIM_EXPROP_FUNC_WIDE,
7735 JIM_EXPROP_FUNC_ABS,
7736 JIM_EXPROP_FUNC_DOUBLE,
7737 JIM_EXPROP_FUNC_ROUND,
7738 JIM_EXPROP_FUNC_RAND,
7739 JIM_EXPROP_FUNC_SRAND,
7741 /* math functions from libm */
7742 JIM_EXPROP_FUNC_SIN, /* 65 */
7743 JIM_EXPROP_FUNC_COS,
7744 JIM_EXPROP_FUNC_TAN,
7745 JIM_EXPROP_FUNC_ASIN,
7746 JIM_EXPROP_FUNC_ACOS,
7747 JIM_EXPROP_FUNC_ATAN,
7748 JIM_EXPROP_FUNC_ATAN2,
7749 JIM_EXPROP_FUNC_SINH,
7750 JIM_EXPROP_FUNC_COSH,
7751 JIM_EXPROP_FUNC_TANH,
7752 JIM_EXPROP_FUNC_CEIL,
7753 JIM_EXPROP_FUNC_FLOOR,
7754 JIM_EXPROP_FUNC_EXP,
7755 JIM_EXPROP_FUNC_LOG,
7756 JIM_EXPROP_FUNC_LOG10,
7757 JIM_EXPROP_FUNC_SQRT,
7758 JIM_EXPROP_FUNC_POW,
7759 JIM_EXPROP_FUNC_HYPOT,
7760 JIM_EXPROP_FUNC_FMOD,
7763 /* A expression node is either a term or an operator
7764 * If a node is an operator, 'op' points to the details of the operator and it's terms.
7766 struct JimExprNode {
7767 int type; /* JIM_TT_xxx */
7768 struct Jim_Obj *objPtr; /* The object for a term, or NULL for an operator */
7770 struct JimExprNode *left; /* For all operators */
7771 struct JimExprNode *right; /* For binary operators */
7772 struct JimExprNode *ternary; /* For ternary operator only */
7775 /* Operators table */
7776 typedef struct Jim_ExprOperator
7778 const char *name;
7779 int (*funcop) (Jim_Interp *interp, struct JimExprNode *opnode);
7780 unsigned char precedence;
7781 unsigned char arity;
7782 unsigned char attr;
7783 unsigned char namelen;
7784 } Jim_ExprOperator;
7786 static int JimExprGetTerm(Jim_Interp *interp, struct JimExprNode *node, Jim_Obj **objPtrPtr);
7787 static int JimExprGetTermBoolean(Jim_Interp *interp, struct JimExprNode *node);
7788 static int JimExprEvalTermNode(Jim_Interp *interp, struct JimExprNode *node);
7790 static int JimExprOpNumUnary(Jim_Interp *interp, struct JimExprNode *node)
7792 int intresult = 1;
7793 int rc;
7794 double dA, dC = 0;
7795 jim_wide wA, wC = 0;
7796 Jim_Obj *A;
7798 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7799 return rc;
7802 if ((A->typePtr != &doubleObjType || A->bytes) && JimGetWideNoErr(interp, A, &wA) == JIM_OK) {
7803 switch (node->type) {
7804 case JIM_EXPROP_FUNC_INT:
7805 case JIM_EXPROP_FUNC_WIDE:
7806 case JIM_EXPROP_FUNC_ROUND:
7807 case JIM_EXPROP_UNARYPLUS:
7808 wC = wA;
7809 break;
7810 case JIM_EXPROP_FUNC_DOUBLE:
7811 dC = wA;
7812 intresult = 0;
7813 break;
7814 case JIM_EXPROP_FUNC_ABS:
7815 wC = wA >= 0 ? wA : -wA;
7816 break;
7817 case JIM_EXPROP_UNARYMINUS:
7818 wC = -wA;
7819 break;
7820 case JIM_EXPROP_NOT:
7821 wC = !wA;
7822 break;
7823 default:
7824 abort();
7827 else if ((rc = Jim_GetDouble(interp, A, &dA)) == JIM_OK) {
7828 switch (node->type) {
7829 case JIM_EXPROP_FUNC_INT:
7830 case JIM_EXPROP_FUNC_WIDE:
7831 wC = dA;
7832 break;
7833 case JIM_EXPROP_FUNC_ROUND:
7834 wC = dA < 0 ? (dA - 0.5) : (dA + 0.5);
7835 break;
7836 case JIM_EXPROP_FUNC_DOUBLE:
7837 case JIM_EXPROP_UNARYPLUS:
7838 dC = dA;
7839 intresult = 0;
7840 break;
7841 case JIM_EXPROP_FUNC_ABS:
7842 #ifdef JIM_MATH_FUNCTIONS
7843 dC = fabs(dA);
7844 #else
7845 dC = dA >= 0 ? dA : -dA;
7846 #endif
7847 intresult = 0;
7848 break;
7849 case JIM_EXPROP_UNARYMINUS:
7850 dC = -dA;
7851 intresult = 0;
7852 break;
7853 case JIM_EXPROP_NOT:
7854 wC = !dA;
7855 break;
7856 default:
7857 abort();
7861 if (rc == JIM_OK) {
7862 if (intresult) {
7863 Jim_SetResultInt(interp, wC);
7865 else {
7866 Jim_SetResult(interp, Jim_NewDoubleObj(interp, dC));
7870 Jim_DecrRefCount(interp, A);
7872 return rc;
7875 static double JimRandDouble(Jim_Interp *interp)
7877 unsigned long x;
7878 JimRandomBytes(interp, &x, sizeof(x));
7880 return (double)x / (unsigned long)~0;
7883 static int JimExprOpIntUnary(Jim_Interp *interp, struct JimExprNode *node)
7885 jim_wide wA;
7886 Jim_Obj *A;
7887 int rc;
7889 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7890 return rc;
7893 rc = Jim_GetWide(interp, A, &wA);
7894 if (rc == JIM_OK) {
7895 switch (node->type) {
7896 case JIM_EXPROP_BITNOT:
7897 Jim_SetResultInt(interp, ~wA);
7898 break;
7899 case JIM_EXPROP_FUNC_SRAND:
7900 JimPrngSeed(interp, (unsigned char *)&wA, sizeof(wA));
7901 Jim_SetResult(interp, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7902 break;
7903 default:
7904 abort();
7908 Jim_DecrRefCount(interp, A);
7910 return rc;
7913 static int JimExprOpNone(Jim_Interp *interp, struct JimExprNode *node)
7915 JimPanic((node->type != JIM_EXPROP_FUNC_RAND, "JimExprOpNone only support rand()"));
7917 Jim_SetResult(interp, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7919 return JIM_OK;
7922 #ifdef JIM_MATH_FUNCTIONS
7923 static int JimExprOpDoubleUnary(Jim_Interp *interp, struct JimExprNode *node)
7925 int rc;
7926 double dA, dC;
7927 Jim_Obj *A;
7929 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7930 return rc;
7933 rc = Jim_GetDouble(interp, A, &dA);
7934 if (rc == JIM_OK) {
7935 switch (node->type) {
7936 case JIM_EXPROP_FUNC_SIN:
7937 dC = sin(dA);
7938 break;
7939 case JIM_EXPROP_FUNC_COS:
7940 dC = cos(dA);
7941 break;
7942 case JIM_EXPROP_FUNC_TAN:
7943 dC = tan(dA);
7944 break;
7945 case JIM_EXPROP_FUNC_ASIN:
7946 dC = asin(dA);
7947 break;
7948 case JIM_EXPROP_FUNC_ACOS:
7949 dC = acos(dA);
7950 break;
7951 case JIM_EXPROP_FUNC_ATAN:
7952 dC = atan(dA);
7953 break;
7954 case JIM_EXPROP_FUNC_SINH:
7955 dC = sinh(dA);
7956 break;
7957 case JIM_EXPROP_FUNC_COSH:
7958 dC = cosh(dA);
7959 break;
7960 case JIM_EXPROP_FUNC_TANH:
7961 dC = tanh(dA);
7962 break;
7963 case JIM_EXPROP_FUNC_CEIL:
7964 dC = ceil(dA);
7965 break;
7966 case JIM_EXPROP_FUNC_FLOOR:
7967 dC = floor(dA);
7968 break;
7969 case JIM_EXPROP_FUNC_EXP:
7970 dC = exp(dA);
7971 break;
7972 case JIM_EXPROP_FUNC_LOG:
7973 dC = log(dA);
7974 break;
7975 case JIM_EXPROP_FUNC_LOG10:
7976 dC = log10(dA);
7977 break;
7978 case JIM_EXPROP_FUNC_SQRT:
7979 dC = sqrt(dA);
7980 break;
7981 default:
7982 abort();
7984 Jim_SetResult(interp, Jim_NewDoubleObj(interp, dC));
7987 Jim_DecrRefCount(interp, A);
7989 return rc;
7991 #endif
7993 /* A binary operation on two ints */
7994 static int JimExprOpIntBin(Jim_Interp *interp, struct JimExprNode *node)
7996 jim_wide wA, wB;
7997 int rc;
7998 Jim_Obj *A, *B;
8000 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
8001 return rc;
8003 if ((rc = JimExprGetTerm(interp, node->right, &B)) != JIM_OK) {
8004 Jim_DecrRefCount(interp, A);
8005 return rc;
8008 rc = JIM_ERR;
8010 if (Jim_GetWide(interp, A, &wA) == JIM_OK && Jim_GetWide(interp, B, &wB) == JIM_OK) {
8011 jim_wide wC;
8013 rc = JIM_OK;
8015 switch (node->type) {
8016 case JIM_EXPROP_LSHIFT:
8017 wC = wA << wB;
8018 break;
8019 case JIM_EXPROP_RSHIFT:
8020 wC = wA >> wB;
8021 break;
8022 case JIM_EXPROP_BITAND:
8023 wC = wA & wB;
8024 break;
8025 case JIM_EXPROP_BITXOR:
8026 wC = wA ^ wB;
8027 break;
8028 case JIM_EXPROP_BITOR:
8029 wC = wA | wB;
8030 break;
8031 case JIM_EXPROP_MOD:
8032 if (wB == 0) {
8033 wC = 0;
8034 Jim_SetResultString(interp, "Division by zero", -1);
8035 rc = JIM_ERR;
8037 else {
8039 * From Tcl 8.x
8041 * This code is tricky: C doesn't guarantee much
8042 * about the quotient or remainder, but Tcl does.
8043 * The remainder always has the same sign as the
8044 * divisor and a smaller absolute value.
8046 int negative = 0;
8048 if (wB < 0) {
8049 wB = -wB;
8050 wA = -wA;
8051 negative = 1;
8053 wC = wA % wB;
8054 if (wC < 0) {
8055 wC += wB;
8057 if (negative) {
8058 wC = -wC;
8061 break;
8062 case JIM_EXPROP_ROTL:
8063 case JIM_EXPROP_ROTR:{
8064 /* uint32_t would be better. But not everyone has inttypes.h? */
8065 unsigned long uA = (unsigned long)wA;
8066 unsigned long uB = (unsigned long)wB;
8067 const unsigned int S = sizeof(unsigned long) * 8;
8069 /* Shift left by the word size or more is undefined. */
8070 uB %= S;
8072 if (node->type == JIM_EXPROP_ROTR) {
8073 uB = S - uB;
8075 wC = (unsigned long)(uA << uB) | (uA >> (S - uB));
8076 break;
8078 default:
8079 abort();
8081 Jim_SetResultInt(interp, wC);
8084 Jim_DecrRefCount(interp, A);
8085 Jim_DecrRefCount(interp, B);
8087 return rc;
8091 /* A binary operation on two ints or two doubles (or two strings for some ops) */
8092 static int JimExprOpBin(Jim_Interp *interp, struct JimExprNode *node)
8094 int rc = JIM_OK;
8095 double dA, dB, dC = 0;
8096 jim_wide wA, wB, wC = 0;
8097 Jim_Obj *A, *B;
8099 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
8100 return rc;
8102 if ((rc = JimExprGetTerm(interp, node->right, &B)) != JIM_OK) {
8103 Jim_DecrRefCount(interp, A);
8104 return rc;
8107 if ((A->typePtr != &doubleObjType || A->bytes) &&
8108 (B->typePtr != &doubleObjType || B->bytes) &&
8109 JimGetWideNoErr(interp, A, &wA) == JIM_OK && JimGetWideNoErr(interp, B, &wB) == JIM_OK) {
8111 /* Both are ints */
8113 switch (node->type) {
8114 case JIM_EXPROP_POW:
8115 case JIM_EXPROP_FUNC_POW:
8116 if (wA == 0 && wB < 0) {
8117 Jim_SetResultString(interp, "exponentiation of zero by negative power", -1);
8118 rc = JIM_ERR;
8119 goto done;
8121 wC = JimPowWide(wA, wB);
8122 goto intresult;
8123 case JIM_EXPROP_ADD:
8124 wC = wA + wB;
8125 goto intresult;
8126 case JIM_EXPROP_SUB:
8127 wC = wA - wB;
8128 goto intresult;
8129 case JIM_EXPROP_MUL:
8130 wC = wA * wB;
8131 goto intresult;
8132 case JIM_EXPROP_DIV:
8133 if (wB == 0) {
8134 Jim_SetResultString(interp, "Division by zero", -1);
8135 rc = JIM_ERR;
8136 goto done;
8138 else {
8140 * From Tcl 8.x
8142 * This code is tricky: C doesn't guarantee much
8143 * about the quotient or remainder, but Tcl does.
8144 * The remainder always has the same sign as the
8145 * divisor and a smaller absolute value.
8147 if (wB < 0) {
8148 wB = -wB;
8149 wA = -wA;
8151 wC = wA / wB;
8152 if (wA % wB < 0) {
8153 wC--;
8155 goto intresult;
8157 case JIM_EXPROP_LT:
8158 wC = wA < wB;
8159 goto intresult;
8160 case JIM_EXPROP_GT:
8161 wC = wA > wB;
8162 goto intresult;
8163 case JIM_EXPROP_LTE:
8164 wC = wA <= wB;
8165 goto intresult;
8166 case JIM_EXPROP_GTE:
8167 wC = wA >= wB;
8168 goto intresult;
8169 case JIM_EXPROP_NUMEQ:
8170 wC = wA == wB;
8171 goto intresult;
8172 case JIM_EXPROP_NUMNE:
8173 wC = wA != wB;
8174 goto intresult;
8177 if (Jim_GetDouble(interp, A, &dA) == JIM_OK && Jim_GetDouble(interp, B, &dB) == JIM_OK) {
8178 switch (node->type) {
8179 #ifndef JIM_MATH_FUNCTIONS
8180 case JIM_EXPROP_POW:
8181 case JIM_EXPROP_FUNC_POW:
8182 case JIM_EXPROP_FUNC_ATAN2:
8183 case JIM_EXPROP_FUNC_HYPOT:
8184 case JIM_EXPROP_FUNC_FMOD:
8185 Jim_SetResultString(interp, "unsupported", -1);
8186 rc = JIM_ERR;
8187 goto done;
8188 #else
8189 case JIM_EXPROP_POW:
8190 case JIM_EXPROP_FUNC_POW:
8191 dC = pow(dA, dB);
8192 goto doubleresult;
8193 case JIM_EXPROP_FUNC_ATAN2:
8194 dC = atan2(dA, dB);
8195 goto doubleresult;
8196 case JIM_EXPROP_FUNC_HYPOT:
8197 dC = hypot(dA, dB);
8198 goto doubleresult;
8199 case JIM_EXPROP_FUNC_FMOD:
8200 dC = fmod(dA, dB);
8201 goto doubleresult;
8202 #endif
8203 case JIM_EXPROP_ADD:
8204 dC = dA + dB;
8205 goto doubleresult;
8206 case JIM_EXPROP_SUB:
8207 dC = dA - dB;
8208 goto doubleresult;
8209 case JIM_EXPROP_MUL:
8210 dC = dA * dB;
8211 goto doubleresult;
8212 case JIM_EXPROP_DIV:
8213 if (dB == 0) {
8214 #ifdef INFINITY
8215 dC = dA < 0 ? -INFINITY : INFINITY;
8216 #else
8217 dC = (dA < 0 ? -1.0 : 1.0) * strtod("Inf", NULL);
8218 #endif
8220 else {
8221 dC = dA / dB;
8223 goto doubleresult;
8224 case JIM_EXPROP_LT:
8225 wC = dA < dB;
8226 goto intresult;
8227 case JIM_EXPROP_GT:
8228 wC = dA > dB;
8229 goto intresult;
8230 case JIM_EXPROP_LTE:
8231 wC = dA <= dB;
8232 goto intresult;
8233 case JIM_EXPROP_GTE:
8234 wC = dA >= dB;
8235 goto intresult;
8236 case JIM_EXPROP_NUMEQ:
8237 wC = dA == dB;
8238 goto intresult;
8239 case JIM_EXPROP_NUMNE:
8240 wC = dA != dB;
8241 goto intresult;
8244 else {
8245 /* Handle the string case */
8247 /* XXX: Could optimise the eq/ne case by checking lengths */
8248 int i = Jim_StringCompareObj(interp, A, B, 0);
8250 switch (node->type) {
8251 case JIM_EXPROP_LT:
8252 wC = i < 0;
8253 goto intresult;
8254 case JIM_EXPROP_GT:
8255 wC = i > 0;
8256 goto intresult;
8257 case JIM_EXPROP_LTE:
8258 wC = i <= 0;
8259 goto intresult;
8260 case JIM_EXPROP_GTE:
8261 wC = i >= 0;
8262 goto intresult;
8263 case JIM_EXPROP_NUMEQ:
8264 wC = i == 0;
8265 goto intresult;
8266 case JIM_EXPROP_NUMNE:
8267 wC = i != 0;
8268 goto intresult;
8271 /* If we get here, it is an error */
8272 rc = JIM_ERR;
8273 done:
8274 Jim_DecrRefCount(interp, A);
8275 Jim_DecrRefCount(interp, B);
8276 return rc;
8277 intresult:
8278 Jim_SetResultInt(interp, wC);
8279 goto done;
8280 doubleresult:
8281 Jim_SetResult(interp, Jim_NewDoubleObj(interp, dC));
8282 goto done;
8285 static int JimSearchList(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *valObj)
8287 int listlen;
8288 int i;
8290 listlen = Jim_ListLength(interp, listObjPtr);
8291 for (i = 0; i < listlen; i++) {
8292 if (Jim_StringEqObj(Jim_ListGetIndex(interp, listObjPtr, i), valObj)) {
8293 return 1;
8296 return 0;
8301 static int JimExprOpStrBin(Jim_Interp *interp, struct JimExprNode *node)
8303 Jim_Obj *A, *B;
8304 jim_wide wC;
8305 int rc;
8307 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
8308 return rc;
8310 if ((rc = JimExprGetTerm(interp, node->right, &B)) != JIM_OK) {
8311 Jim_DecrRefCount(interp, A);
8312 return rc;
8315 switch (node->type) {
8316 case JIM_EXPROP_STREQ:
8317 case JIM_EXPROP_STRNE:
8318 wC = Jim_StringEqObj(A, B);
8319 if (node->type == JIM_EXPROP_STRNE) {
8320 wC = !wC;
8322 break;
8323 case JIM_EXPROP_STRIN:
8324 wC = JimSearchList(interp, B, A);
8325 break;
8326 case JIM_EXPROP_STRNI:
8327 wC = !JimSearchList(interp, B, A);
8328 break;
8329 default:
8330 abort();
8332 Jim_SetResultInt(interp, wC);
8334 Jim_DecrRefCount(interp, A);
8335 Jim_DecrRefCount(interp, B);
8337 return rc;
8340 static int ExprBool(Jim_Interp *interp, Jim_Obj *obj)
8342 long l;
8343 double d;
8344 int b;
8345 int ret = -1;
8347 /* In case the object is interp->result with refcount 1*/
8348 Jim_IncrRefCount(obj);
8350 if (Jim_GetLong(interp, obj, &l) == JIM_OK) {
8351 ret = (l != 0);
8353 else if (Jim_GetDouble(interp, obj, &d) == JIM_OK) {
8354 ret = (d != 0);
8356 else if (Jim_GetBoolean(interp, obj, &b) == JIM_OK) {
8357 ret = (b != 0);
8360 Jim_DecrRefCount(interp, obj);
8361 return ret;
8364 static int JimExprOpAnd(Jim_Interp *interp, struct JimExprNode *node)
8366 /* evaluate left */
8367 int result = JimExprGetTermBoolean(interp, node->left);
8369 if (result == 1) {
8370 /* true so evaluate right */
8371 result = JimExprGetTermBoolean(interp, node->right);
8373 if (result == -1) {
8374 return JIM_ERR;
8376 Jim_SetResultInt(interp, result);
8377 return JIM_OK;
8380 static int JimExprOpOr(Jim_Interp *interp, struct JimExprNode *node)
8382 /* evaluate left */
8383 int result = JimExprGetTermBoolean(interp, node->left);
8385 if (result == 0) {
8386 /* false so evaluate right */
8387 result = JimExprGetTermBoolean(interp, node->right);
8389 if (result == -1) {
8390 return JIM_ERR;
8392 Jim_SetResultInt(interp, result);
8393 return JIM_OK;
8396 static int JimExprOpTernary(Jim_Interp *interp, struct JimExprNode *node)
8398 /* evaluate left */
8399 int result = JimExprGetTermBoolean(interp, node->left);
8401 if (result == 1) {
8402 /* true so select right */
8403 return JimExprEvalTermNode(interp, node->right);
8405 else if (result == 0) {
8406 /* false so select ternary */
8407 return JimExprEvalTermNode(interp, node->ternary);
8409 /* error */
8410 return JIM_ERR;
8413 enum
8415 OP_FUNC = 0x0001, /* function syntax */
8416 OP_RIGHT_ASSOC = 0x0002, /* right associative */
8419 /* name - precedence - arity - opcode
8421 * This array *must* be kept in sync with the JIM_EXPROP enum.
8423 * The following macros pre-compute the string length at compile time.
8425 #define OPRINIT_ATTR(N, P, ARITY, F, ATTR) {N, F, P, ARITY, ATTR, sizeof(N) - 1}
8426 #define OPRINIT(N, P, ARITY, F) OPRINIT_ATTR(N, P, ARITY, F, 0)
8428 static const struct Jim_ExprOperator Jim_ExprOperators[] = {
8429 OPRINIT("*", 110, 2, JimExprOpBin),
8430 OPRINIT("/", 110, 2, JimExprOpBin),
8431 OPRINIT("%", 110, 2, JimExprOpIntBin),
8433 OPRINIT("-", 100, 2, JimExprOpBin),
8434 OPRINIT("+", 100, 2, JimExprOpBin),
8436 OPRINIT("<<", 90, 2, JimExprOpIntBin),
8437 OPRINIT(">>", 90, 2, JimExprOpIntBin),
8439 OPRINIT("<<<", 90, 2, JimExprOpIntBin),
8440 OPRINIT(">>>", 90, 2, JimExprOpIntBin),
8442 OPRINIT("<", 80, 2, JimExprOpBin),
8443 OPRINIT(">", 80, 2, JimExprOpBin),
8444 OPRINIT("<=", 80, 2, JimExprOpBin),
8445 OPRINIT(">=", 80, 2, JimExprOpBin),
8447 OPRINIT("==", 70, 2, JimExprOpBin),
8448 OPRINIT("!=", 70, 2, JimExprOpBin),
8450 OPRINIT("&", 50, 2, JimExprOpIntBin),
8451 OPRINIT("^", 49, 2, JimExprOpIntBin),
8452 OPRINIT("|", 48, 2, JimExprOpIntBin),
8454 OPRINIT("&&", 10, 2, JimExprOpAnd),
8455 OPRINIT("||", 9, 2, JimExprOpOr),
8456 OPRINIT_ATTR("?", 5, 3, JimExprOpTernary, OP_RIGHT_ASSOC),
8457 OPRINIT_ATTR(":", 5, 3, NULL, OP_RIGHT_ASSOC),
8459 /* Precedence is higher than * and / but lower than ! and ~, and right-associative */
8460 OPRINIT_ATTR("**", 120, 2, JimExprOpBin, OP_RIGHT_ASSOC),
8462 OPRINIT("eq", 60, 2, JimExprOpStrBin),
8463 OPRINIT("ne", 60, 2, JimExprOpStrBin),
8465 OPRINIT("in", 55, 2, JimExprOpStrBin),
8466 OPRINIT("ni", 55, 2, JimExprOpStrBin),
8468 OPRINIT_ATTR("!", 150, 1, JimExprOpNumUnary, OP_RIGHT_ASSOC),
8469 OPRINIT_ATTR("~", 150, 1, JimExprOpIntUnary, OP_RIGHT_ASSOC),
8470 OPRINIT_ATTR(" -", 150, 1, JimExprOpNumUnary, OP_RIGHT_ASSOC),
8471 OPRINIT_ATTR(" +", 150, 1, JimExprOpNumUnary, OP_RIGHT_ASSOC),
8475 OPRINIT_ATTR("int", 200, 1, JimExprOpNumUnary, OP_FUNC),
8476 OPRINIT_ATTR("wide", 200, 1, JimExprOpNumUnary, OP_FUNC),
8477 OPRINIT_ATTR("abs", 200, 1, JimExprOpNumUnary, OP_FUNC),
8478 OPRINIT_ATTR("double", 200, 1, JimExprOpNumUnary, OP_FUNC),
8479 OPRINIT_ATTR("round", 200, 1, JimExprOpNumUnary, OP_FUNC),
8480 OPRINIT_ATTR("rand", 200, 0, JimExprOpNone, OP_FUNC),
8481 OPRINIT_ATTR("srand", 200, 1, JimExprOpIntUnary, OP_FUNC),
8483 #ifdef JIM_MATH_FUNCTIONS
8484 OPRINIT_ATTR("sin", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8485 OPRINIT_ATTR("cos", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8486 OPRINIT_ATTR("tan", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8487 OPRINIT_ATTR("asin", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8488 OPRINIT_ATTR("acos", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8489 OPRINIT_ATTR("atan", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8490 OPRINIT_ATTR("atan2", 200, 2, JimExprOpBin, OP_FUNC),
8491 OPRINIT_ATTR("sinh", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8492 OPRINIT_ATTR("cosh", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8493 OPRINIT_ATTR("tanh", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8494 OPRINIT_ATTR("ceil", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8495 OPRINIT_ATTR("floor", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8496 OPRINIT_ATTR("exp", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8497 OPRINIT_ATTR("log", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8498 OPRINIT_ATTR("log10", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8499 OPRINIT_ATTR("sqrt", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8500 OPRINIT_ATTR("pow", 200, 2, JimExprOpBin, OP_FUNC),
8501 OPRINIT_ATTR("hypot", 200, 2, JimExprOpBin, OP_FUNC),
8502 OPRINIT_ATTR("fmod", 200, 2, JimExprOpBin, OP_FUNC),
8503 #endif
8505 #undef OPRINIT
8506 #undef OPRINIT_ATTR
8508 #define JIM_EXPR_OPERATORS_NUM \
8509 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
8511 static int JimParseExpression(struct JimParserCtx *pc)
8513 /* Discard spaces and quoted newline */
8514 while (isspace(UCHAR(*pc->p)) || (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) {
8515 if (*pc->p == '\n') {
8516 pc->linenr++;
8518 pc->p++;
8519 pc->len--;
8522 /* Common case */
8523 pc->tline = pc->linenr;
8524 pc->tstart = pc->p;
8526 if (pc->len == 0) {
8527 pc->tend = pc->p;
8528 pc->tt = JIM_TT_EOL;
8529 pc->eof = 1;
8530 return JIM_OK;
8532 switch (*(pc->p)) {
8533 case '(':
8534 pc->tt = JIM_TT_SUBEXPR_START;
8535 goto singlechar;
8536 case ')':
8537 pc->tt = JIM_TT_SUBEXPR_END;
8538 goto singlechar;
8539 case ',':
8540 pc->tt = JIM_TT_SUBEXPR_COMMA;
8541 singlechar:
8542 pc->tend = pc->p;
8543 pc->p++;
8544 pc->len--;
8545 break;
8546 case '[':
8547 return JimParseCmd(pc);
8548 case '$':
8549 if (JimParseVar(pc) == JIM_ERR)
8550 return JimParseExprOperator(pc);
8551 else {
8552 /* Don't allow expr sugar in expressions */
8553 if (pc->tt == JIM_TT_EXPRSUGAR) {
8554 return JIM_ERR;
8556 return JIM_OK;
8558 break;
8559 case '0':
8560 case '1':
8561 case '2':
8562 case '3':
8563 case '4':
8564 case '5':
8565 case '6':
8566 case '7':
8567 case '8':
8568 case '9':
8569 case '.':
8570 return JimParseExprNumber(pc);
8571 case '"':
8572 return JimParseQuote(pc);
8573 case '{':
8574 return JimParseBrace(pc);
8576 case 'N':
8577 case 'I':
8578 case 'n':
8579 case 'i':
8580 if (JimParseExprIrrational(pc) == JIM_ERR)
8581 if (JimParseExprBoolean(pc) == JIM_ERR)
8582 return JimParseExprOperator(pc);
8583 break;
8584 case 't':
8585 case 'f':
8586 case 'o':
8587 case 'y':
8588 if (JimParseExprBoolean(pc) == JIM_ERR)
8589 return JimParseExprOperator(pc);
8590 break;
8591 default:
8592 return JimParseExprOperator(pc);
8593 break;
8595 return JIM_OK;
8598 static int JimParseExprNumber(struct JimParserCtx *pc)
8600 char *end;
8602 /* Assume an integer for now */
8603 pc->tt = JIM_TT_EXPR_INT;
8605 jim_strtoull(pc->p, (char **)&pc->p);
8606 /* Tried as an integer, but perhaps it parses as a double */
8607 if (strchr("eENnIi.", *pc->p) || pc->p == pc->tstart) {
8608 /* Some stupid compilers insist they are cleverer that
8609 * we are. Even a (void) cast doesn't prevent this warning!
8611 if (strtod(pc->tstart, &end)) { /* nothing */ }
8612 if (end == pc->tstart)
8613 return JIM_ERR;
8614 if (end > pc->p) {
8615 /* Yes, double captured more chars */
8616 pc->tt = JIM_TT_EXPR_DOUBLE;
8617 pc->p = end;
8620 pc->tend = pc->p - 1;
8621 pc->len -= (pc->p - pc->tstart);
8622 return JIM_OK;
8625 static int JimParseExprIrrational(struct JimParserCtx *pc)
8627 const char *irrationals[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL };
8628 int i;
8630 for (i = 0; irrationals[i]; i++) {
8631 const char *irr = irrationals[i];
8633 if (strncmp(irr, pc->p, 3) == 0) {
8634 pc->p += 3;
8635 pc->len -= 3;
8636 pc->tend = pc->p - 1;
8637 pc->tt = JIM_TT_EXPR_DOUBLE;
8638 return JIM_OK;
8641 return JIM_ERR;
8644 static int JimParseExprBoolean(struct JimParserCtx *pc)
8646 const char *booleans[] = { "false", "no", "off", "true", "yes", "on", NULL };
8647 const int lengths[] = { 5, 2, 3, 4, 3, 2, 0 };
8648 int i;
8650 for (i = 0; booleans[i]; i++) {
8651 const char *boolean = booleans[i];
8652 int length = lengths[i];
8654 if (strncmp(boolean, pc->p, length) == 0) {
8655 pc->p += length;
8656 pc->len -= length;
8657 pc->tend = pc->p - 1;
8658 pc->tt = JIM_TT_EXPR_BOOLEAN;
8659 return JIM_OK;
8662 return JIM_ERR;
8665 static const struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
8667 static Jim_ExprOperator dummy_op;
8668 if (opcode < JIM_TT_EXPR_OP) {
8669 return &dummy_op;
8671 return &Jim_ExprOperators[opcode - JIM_TT_EXPR_OP];
8674 static int JimParseExprOperator(struct JimParserCtx *pc)
8676 int i;
8677 const struct Jim_ExprOperator *bestOp = NULL;
8678 int bestLen = 0;
8680 /* Try to get the longest match. */
8681 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
8682 const struct Jim_ExprOperator *op = &Jim_ExprOperators[i];
8684 if (op->name[0] != pc->p[0]) {
8685 continue;
8688 if (op->namelen > bestLen && strncmp(op->name, pc->p, op->namelen) == 0) {
8689 bestOp = op;
8690 bestLen = op->namelen;
8693 if (bestOp == NULL) {
8694 return JIM_ERR;
8697 /* Validate paretheses around function arguments */
8698 if (bestOp->attr & OP_FUNC) {
8699 const char *p = pc->p + bestLen;
8700 int len = pc->len - bestLen;
8702 while (len && isspace(UCHAR(*p))) {
8703 len--;
8704 p++;
8706 if (*p != '(') {
8707 return JIM_ERR;
8710 pc->tend = pc->p + bestLen - 1;
8711 pc->p += bestLen;
8712 pc->len -= bestLen;
8714 pc->tt = (bestOp - Jim_ExprOperators) + JIM_TT_EXPR_OP;
8715 return JIM_OK;
8718 const char *jim_tt_name(int type)
8720 static const char * const tt_names[JIM_TT_EXPR_OP] =
8721 { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "LIN", "WRD", "(((", ")))", ",,,", "INT",
8722 "DBL", "BOO", "$()" };
8723 if (type < JIM_TT_EXPR_OP) {
8724 return tt_names[type];
8726 else if (type == JIM_EXPROP_UNARYMINUS) {
8727 return "-VE";
8729 else if (type == JIM_EXPROP_UNARYPLUS) {
8730 return "+VE";
8732 else {
8733 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(type);
8734 static char buf[20];
8736 if (op->name) {
8737 return op->name;
8739 sprintf(buf, "(%d)", type);
8740 return buf;
8744 /* -----------------------------------------------------------------------------
8745 * Expression Object
8746 * ---------------------------------------------------------------------------*/
8747 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
8748 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
8749 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
8751 static const Jim_ObjType exprObjType = {
8752 "expression",
8753 FreeExprInternalRep,
8754 DupExprInternalRep,
8755 NULL,
8756 JIM_TYPE_REFERENCES,
8759 /* expr tree structure */
8760 struct ExprTree
8762 struct JimExprNode *expr; /* The first operator or term */
8763 struct JimExprNode *nodes; /* Storage of all nodes in the tree */
8764 int len; /* Number of nodes in use */
8765 int inUse; /* Used for sharing. */
8768 static void ExprTreeFreeNodes(Jim_Interp *interp, struct JimExprNode *nodes, int num)
8770 int i;
8771 for (i = 0; i < num; i++) {
8772 if (nodes[i].objPtr) {
8773 Jim_DecrRefCount(interp, nodes[i].objPtr);
8776 Jim_Free(nodes);
8779 static void ExprTreeFree(Jim_Interp *interp, struct ExprTree *expr)
8781 ExprTreeFreeNodes(interp, expr->nodes, expr->len);
8782 Jim_Free(expr);
8785 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
8787 struct ExprTree *expr = (void *)objPtr->internalRep.ptr;
8789 if (expr) {
8790 if (--expr->inUse != 0) {
8791 return;
8794 ExprTreeFree(interp, expr);
8798 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
8800 JIM_NOTUSED(interp);
8801 JIM_NOTUSED(srcPtr);
8803 /* Just returns an simple string. */
8804 dupPtr->typePtr = NULL;
8807 struct ExprBuilder {
8808 int parencount; /* count of outstanding parentheses */
8809 int level; /* recursion depth */
8810 ParseToken *token; /* The current token */
8811 ParseToken *first_token; /* The first token */
8812 Jim_Stack stack; /* stack of pending terms */
8813 Jim_Obj *exprObjPtr; /* the original expression */
8814 Jim_Obj *fileNameObj; /* filename of the original expression */
8815 struct JimExprNode *nodes; /* storage for all nodes */
8816 struct JimExprNode *next; /* storage for the next node */
8819 #ifdef DEBUG_SHOW_EXPR
8820 static void JimShowExprNode(struct JimExprNode *node, int level)
8822 int i;
8823 for (i = 0; i < level; i++) {
8824 printf(" ");
8826 if (TOKEN_IS_EXPR_OP(node->type)) {
8827 printf("%s\n", jim_tt_name(node->type));
8828 if (node->left) {
8829 JimShowExprNode(node->left, level + 1);
8831 if (node->right) {
8832 JimShowExprNode(node->right, level + 1);
8834 if (node->ternary) {
8835 JimShowExprNode(node->ternary, level + 1);
8838 else {
8839 printf("[%s] %s\n", jim_tt_name(node->type), Jim_String(node->objPtr));
8842 #endif
8844 #define EXPR_UNTIL_CLOSE 0x0001
8845 #define EXPR_FUNC_ARGS 0x0002
8846 #define EXPR_TERNARY 0x0004
8849 * Parse the subexpression at builder->token and return with the node on the stack.
8850 * builder->token is advanced to the next unconsumed token.
8851 * Returns JIM_OK if OK or JIM_ERR on error and leaves a message in the interpreter result.
8853 * 'precedence' is the precedence of the current operator. Tokens are consumed until an operator
8854 * with an equal or lower precedence is reached (or strictly lower if right associative).
8856 * If EXPR_UNTIL_CLOSE is set, the subexpression extends up to and including the next close parenthesis.
8857 * If EXPR_FUNC_ARGS is set, multiple subexpressions (terms) are expected separated by comma
8858 * If EXPR_TERNARY is set, two subexpressions (terms) are expected separated by colon
8860 * 'exp_numterms' indicates how many terms are expected. Normally this is 1, but may be more for EXPR_FUNC_ARGS and EXPR_TERNARY.
8862 static int ExprTreeBuildTree(Jim_Interp *interp, struct ExprBuilder *builder, int precedence, int flags, int exp_numterms)
8864 int rc;
8865 struct JimExprNode *node;
8866 /* Calculate the stack length expected after pushing the number of expected terms */
8867 int exp_stacklen = builder->stack.len + exp_numterms;
8869 if (builder->level++ > 200) {
8870 Jim_SetResultString(interp, "Expression too complex", -1);
8871 return JIM_ERR;
8874 while (builder->token->type != JIM_TT_EOL) {
8875 ParseToken *t = builder->token++;
8876 int prevtt;
8878 if (t == builder->first_token) {
8879 prevtt = JIM_TT_NONE;
8881 else {
8882 prevtt = t[-1].type;
8885 if (t->type == JIM_TT_SUBEXPR_START) {
8886 if (builder->stack.len == exp_stacklen) {
8887 Jim_SetResultFormatted(interp, "unexpected open parenthesis in expression: \"%#s\"", builder->exprObjPtr);
8888 return JIM_ERR;
8890 builder->parencount++;
8891 rc = ExprTreeBuildTree(interp, builder, 0, EXPR_UNTIL_CLOSE, 1);
8892 if (rc != JIM_OK) {
8893 return rc;
8895 /* A complete subexpression is on the stack */
8897 else if (t->type == JIM_TT_SUBEXPR_END) {
8898 if (!(flags & EXPR_UNTIL_CLOSE)) {
8899 if (builder->stack.len == exp_stacklen && builder->level > 1) {
8900 builder->token--;
8901 builder->level--;
8902 return JIM_OK;
8904 Jim_SetResultFormatted(interp, "unexpected closing parenthesis in expression: \"%#s\"", builder->exprObjPtr);
8905 return JIM_ERR;
8907 builder->parencount--;
8908 if (builder->stack.len == exp_stacklen) {
8909 /* Return with the expected number of subexpressions on the stack */
8910 break;
8913 else if (t->type == JIM_TT_SUBEXPR_COMMA) {
8914 if (!(flags & EXPR_FUNC_ARGS)) {
8915 if (builder->stack.len == exp_stacklen) {
8916 /* handle the comma back at the parent level */
8917 builder->token--;
8918 builder->level--;
8919 return JIM_OK;
8921 Jim_SetResultFormatted(interp, "unexpected comma in expression: \"%#s\"", builder->exprObjPtr);
8922 return JIM_ERR;
8924 else {
8925 /* If we see more terms than expected, it is an error */
8926 if (builder->stack.len > exp_stacklen) {
8927 Jim_SetResultFormatted(interp, "too many arguments to math function");
8928 return JIM_ERR;
8931 /* just go onto the next arg */
8933 else if (t->type == JIM_EXPROP_COLON) {
8934 if (!(flags & EXPR_TERNARY)) {
8935 if (builder->level != 1) {
8936 /* handle the comma back at the parent level */
8937 builder->token--;
8938 builder->level--;
8939 return JIM_OK;
8941 Jim_SetResultFormatted(interp, ": without ? in expression: \"%#s\"", builder->exprObjPtr);
8942 return JIM_ERR;
8944 if (builder->stack.len == exp_stacklen) {
8945 /* handle the comma back at the parent level */
8946 builder->token--;
8947 builder->level--;
8948 return JIM_OK;
8950 /* just go onto the next term */
8952 else if (TOKEN_IS_EXPR_OP(t->type)) {
8953 const struct Jim_ExprOperator *op;
8955 /* Convert -/+ to unary minus or unary plus if necessary */
8956 if (TOKEN_IS_EXPR_OP(prevtt) || TOKEN_IS_EXPR_START(prevtt)) {
8957 if (t->type == JIM_EXPROP_SUB) {
8958 t->type = JIM_EXPROP_UNARYMINUS;
8960 else if (t->type == JIM_EXPROP_ADD) {
8961 t->type = JIM_EXPROP_UNARYPLUS;
8965 op = JimExprOperatorInfoByOpcode(t->type);
8967 if (op->precedence < precedence || (!(op->attr & OP_RIGHT_ASSOC) && op->precedence == precedence)) {
8968 /* next op is lower precedence, or equal and left associative, so done here */
8969 builder->token--;
8970 break;
8973 if (op->attr & OP_FUNC) {
8974 if (builder->token->type != JIM_TT_SUBEXPR_START) {
8975 Jim_SetResultString(interp, "missing arguments for math function", -1);
8976 return JIM_ERR;
8978 builder->token++;
8979 if (op->arity == 0) {
8980 if (builder->token->type != JIM_TT_SUBEXPR_END) {
8981 Jim_SetResultString(interp, "too many arguments for math function", -1);
8982 return JIM_ERR;
8984 builder->token++;
8985 goto noargs;
8987 builder->parencount++;
8989 /* This will push left and return right */
8990 rc = ExprTreeBuildTree(interp, builder, 0, EXPR_FUNC_ARGS | EXPR_UNTIL_CLOSE, op->arity);
8992 else if (t->type == JIM_EXPROP_TERNARY) {
8993 /* Collect the two arguments to the ternary operator */
8994 rc = ExprTreeBuildTree(interp, builder, op->precedence, EXPR_TERNARY, 2);
8996 else {
8997 /* Recursively handle everything on the right until we see a precendence <= op->precedence or == and right associative
8998 * and push that on the term stack
9000 rc = ExprTreeBuildTree(interp, builder, op->precedence, 0, 1);
9003 if (rc != JIM_OK) {
9004 return rc;
9007 noargs:
9008 node = builder->next++;
9009 node->type = t->type;
9011 if (op->arity >= 3) {
9012 node->ternary = Jim_StackPop(&builder->stack);
9013 if (node->ternary == NULL) {
9014 goto missingoperand;
9017 if (op->arity >= 2) {
9018 node->right = Jim_StackPop(&builder->stack);
9019 if (node->right == NULL) {
9020 goto missingoperand;
9023 if (op->arity >= 1) {
9024 node->left = Jim_StackPop(&builder->stack);
9025 if (node->left == NULL) {
9026 missingoperand:
9027 Jim_SetResultFormatted(interp, "missing operand to %s in expression: \"%#s\"", op->name, builder->exprObjPtr);
9028 builder->next--;
9029 return JIM_ERR;
9034 /* Now push the node */
9035 Jim_StackPush(&builder->stack, node);
9037 else {
9038 Jim_Obj *objPtr = NULL;
9040 /* This is a simple non-operator term, so create and push the appropriate object */
9042 /* Two consecutive terms without an operator is invalid */
9043 if (!TOKEN_IS_EXPR_START(prevtt) && !TOKEN_IS_EXPR_OP(prevtt)) {
9044 Jim_SetResultFormatted(interp, "missing operator in expression: \"%#s\"", builder->exprObjPtr);
9045 return JIM_ERR;
9048 /* Immediately create a double or int object? */
9049 if (t->type == JIM_TT_EXPR_INT || t->type == JIM_TT_EXPR_DOUBLE) {
9050 char *endptr;
9051 if (t->type == JIM_TT_EXPR_INT) {
9052 objPtr = Jim_NewIntObj(interp, jim_strtoull(t->token, &endptr));
9054 else {
9055 objPtr = Jim_NewDoubleObj(interp, strtod(t->token, &endptr));
9057 if (endptr != t->token + t->len) {
9058 /* Conversion failed, so just store it as a string */
9059 Jim_FreeNewObj(interp, objPtr);
9060 objPtr = NULL;
9064 if (!objPtr) {
9065 /* Everything else is stored a simple string term */
9066 objPtr = Jim_NewStringObj(interp, t->token, t->len);
9067 if (t->type == JIM_TT_CMD) {
9068 /* Only commands need source info */
9069 JimSetSourceInfo(interp, objPtr, builder->fileNameObj, t->line);
9073 /* Now push a term node */
9074 node = builder->next++;
9075 node->objPtr = objPtr;
9076 Jim_IncrRefCount(node->objPtr);
9077 node->type = t->type;
9078 Jim_StackPush(&builder->stack, node);
9082 if (builder->stack.len == exp_stacklen) {
9083 builder->level--;
9084 return JIM_OK;
9087 if ((flags & EXPR_FUNC_ARGS)) {
9088 Jim_SetResultFormatted(interp, "too %s arguments for math function", (builder->stack.len < exp_stacklen) ? "few" : "many");
9090 else {
9091 if (builder->stack.len < exp_stacklen) {
9092 if (builder->level == 0) {
9093 Jim_SetResultFormatted(interp, "empty expression");
9095 else {
9096 Jim_SetResultFormatted(interp, "syntax error in expression \"%#s\": premature end of expression", builder->exprObjPtr);
9099 else {
9100 Jim_SetResultFormatted(interp, "extra terms after expression");
9104 return JIM_ERR;
9107 static struct ExprTree *ExprTreeCreateTree(Jim_Interp *interp, const ParseTokenList *tokenlist, Jim_Obj *exprObjPtr, Jim_Obj *fileNameObj)
9109 struct ExprTree *expr;
9110 struct ExprBuilder builder;
9111 int rc;
9112 struct JimExprNode *top = NULL;
9114 builder.parencount = 0;
9115 builder.level = 0;
9116 builder.token = builder.first_token = tokenlist->list;
9117 builder.exprObjPtr = exprObjPtr;
9118 builder.fileNameObj = fileNameObj;
9119 /* The bytecode will never produce more nodes than there are tokens - 1 (for EOL)*/
9120 builder.nodes = Jim_Alloc(sizeof(struct JimExprNode) * (tokenlist->count - 1));
9121 memset(builder.nodes, 0, sizeof(struct JimExprNode) * (tokenlist->count - 1));
9122 builder.next = builder.nodes;
9123 Jim_InitStack(&builder.stack);
9125 rc = ExprTreeBuildTree(interp, &builder, 0, 0, 1);
9127 if (rc == JIM_OK) {
9128 top = Jim_StackPop(&builder.stack);
9130 if (builder.parencount) {
9131 Jim_SetResultString(interp, "missing close parenthesis", -1);
9132 rc = JIM_ERR;
9136 /* Free the stack used for the compilation. */
9137 Jim_FreeStack(&builder.stack);
9139 if (rc != JIM_OK) {
9140 ExprTreeFreeNodes(interp, builder.nodes, builder.next - builder.nodes);
9141 return NULL;
9144 expr = Jim_Alloc(sizeof(*expr));
9145 expr->inUse = 1;
9146 expr->expr = top;
9147 expr->nodes = builder.nodes;
9148 expr->len = builder.next - builder.nodes;
9150 assert(expr->len <= tokenlist->count - 1);
9152 return expr;
9155 /* This method takes the string representation of an expression
9156 * and generates a program for the expr engine */
9157 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
9159 int exprTextLen;
9160 const char *exprText;
9161 struct JimParserCtx parser;
9162 struct ExprTree *expr;
9163 ParseTokenList tokenlist;
9164 int line;
9165 Jim_Obj *fileNameObj;
9166 int rc = JIM_ERR;
9168 /* Try to get information about filename / line number */
9169 if (objPtr->typePtr == &sourceObjType) {
9170 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
9171 line = objPtr->internalRep.sourceValue.lineNumber;
9173 else {
9174 fileNameObj = interp->emptyObj;
9175 line = 1;
9177 Jim_IncrRefCount(fileNameObj);
9179 exprText = Jim_GetString(objPtr, &exprTextLen);
9181 /* Initially tokenise the expression into tokenlist */
9182 ScriptTokenListInit(&tokenlist);
9184 JimParserInit(&parser, exprText, exprTextLen, line);
9185 while (!parser.eof) {
9186 if (JimParseExpression(&parser) != JIM_OK) {
9187 ScriptTokenListFree(&tokenlist);
9188 Jim_SetResultFormatted(interp, "syntax error in expression: \"%#s\"", objPtr);
9189 expr = NULL;
9190 goto err;
9193 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
9194 parser.tline);
9197 #ifdef DEBUG_SHOW_EXPR_TOKENS
9199 int i;
9200 printf("==== Expr Tokens (%s) ====\n", Jim_String(fileNameObj));
9201 for (i = 0; i < tokenlist.count; i++) {
9202 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist.list[i].line, jim_tt_name(tokenlist.list[i].type),
9203 tokenlist.list[i].len, tokenlist.list[i].token);
9206 #endif
9208 if (JimParseCheckMissing(interp, parser.missing.ch) == JIM_ERR) {
9209 ScriptTokenListFree(&tokenlist);
9210 Jim_DecrRefCount(interp, fileNameObj);
9211 return JIM_ERR;
9214 /* Now create the expression bytecode from the tokenlist */
9215 expr = ExprTreeCreateTree(interp, &tokenlist, objPtr, fileNameObj);
9217 /* No longer need the token list */
9218 ScriptTokenListFree(&tokenlist);
9220 if (!expr) {
9221 goto err;
9224 #ifdef DEBUG_SHOW_EXPR
9225 printf("==== Expr ====\n");
9226 JimShowExprNode(expr->expr, 0);
9227 #endif
9229 rc = JIM_OK;
9231 err:
9232 /* Free the old internal rep and set the new one. */
9233 Jim_DecrRefCount(interp, fileNameObj);
9234 Jim_FreeIntRep(interp, objPtr);
9235 Jim_SetIntRepPtr(objPtr, expr);
9236 objPtr->typePtr = &exprObjType;
9237 return rc;
9240 static struct ExprTree *JimGetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
9242 if (objPtr->typePtr != &exprObjType) {
9243 if (SetExprFromAny(interp, objPtr) != JIM_OK) {
9244 return NULL;
9247 return (struct ExprTree *) Jim_GetIntRepPtr(objPtr);
9250 #ifdef JIM_OPTIMIZATION
9251 static Jim_Obj *JimExprIntValOrVar(Jim_Interp *interp, struct JimExprNode *node)
9253 if (node->type == JIM_TT_EXPR_INT)
9254 return node->objPtr;
9255 else if (node->type == JIM_TT_VAR)
9256 return Jim_GetVariable(interp, node->objPtr, JIM_NONE);
9257 else if (node->type == JIM_TT_DICTSUGAR)
9258 return JimExpandDictSugar(interp, node->objPtr);
9259 else
9260 return NULL;
9262 #endif
9264 /* -----------------------------------------------------------------------------
9265 * Expressions evaluation.
9266 * Jim uses a recursive evaluation engine for expressions,
9267 * that takes advantage of the fact that expr's operators
9268 * can't be redefined.
9270 * Jim_EvalExpression() uses the expression tree compiled by
9271 * SetExprFromAny() method of the "expression" object.
9273 * On success a Tcl Object containing the result of the evaluation
9274 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
9275 * returned.
9276 * On error the function returns a retcode != to JIM_OK and set a suitable
9277 * error on the interp.
9278 * ---------------------------------------------------------------------------*/
9280 static int JimExprEvalTermNode(Jim_Interp *interp, struct JimExprNode *node)
9282 if (TOKEN_IS_EXPR_OP(node->type)) {
9283 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(node->type);
9284 return op->funcop(interp, node);
9286 else {
9287 Jim_Obj *objPtr;
9289 /* A term */
9290 switch (node->type) {
9291 case JIM_TT_EXPR_INT:
9292 case JIM_TT_EXPR_DOUBLE:
9293 case JIM_TT_EXPR_BOOLEAN:
9294 case JIM_TT_STR:
9295 Jim_SetResult(interp, node->objPtr);
9296 return JIM_OK;
9298 case JIM_TT_VAR:
9299 objPtr = Jim_GetVariable(interp, node->objPtr, JIM_ERRMSG);
9300 if (objPtr) {
9301 Jim_SetResult(interp, objPtr);
9302 return JIM_OK;
9304 return JIM_ERR;
9306 case JIM_TT_DICTSUGAR:
9307 objPtr = JimExpandDictSugar(interp, node->objPtr);
9308 if (objPtr) {
9309 Jim_SetResult(interp, objPtr);
9310 return JIM_OK;
9312 return JIM_ERR;
9314 case JIM_TT_ESC:
9315 if (Jim_SubstObj(interp, node->objPtr, &objPtr, JIM_NONE) == JIM_OK) {
9316 Jim_SetResult(interp, objPtr);
9317 return JIM_OK;
9319 return JIM_ERR;
9321 case JIM_TT_CMD:
9322 return Jim_EvalObj(interp, node->objPtr);
9324 default:
9325 /* Should never get here */
9326 return JIM_ERR;
9331 static int JimExprGetTerm(Jim_Interp *interp, struct JimExprNode *node, Jim_Obj **objPtrPtr)
9333 int rc = JimExprEvalTermNode(interp, node);
9334 if (rc == JIM_OK) {
9335 *objPtrPtr = Jim_GetResult(interp);
9336 Jim_IncrRefCount(*objPtrPtr);
9338 return rc;
9341 static int JimExprGetTermBoolean(Jim_Interp *interp, struct JimExprNode *node)
9343 if (JimExprEvalTermNode(interp, node) == JIM_OK) {
9344 return ExprBool(interp, Jim_GetResult(interp));
9346 return -1;
9349 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr)
9351 struct ExprTree *expr;
9352 int retcode = JIM_OK;
9354 Jim_IncrRefCount(exprObjPtr); /* Make sure it's shared. */
9355 expr = JimGetExpression(interp, exprObjPtr);
9356 if (!expr) {
9357 retcode = JIM_ERR;
9358 goto done;
9361 #ifdef JIM_OPTIMIZATION
9362 /* Check for one of the following common expressions used by while/for
9364 * CONST
9365 * $a
9366 * !$a
9367 * $a < CONST, $a < $b
9368 * $a <= CONST, $a <= $b
9369 * $a > CONST, $a > $b
9370 * $a >= CONST, $a >= $b
9371 * $a != CONST, $a != $b
9372 * $a == CONST, $a == $b
9375 Jim_Obj *objPtr;
9377 /* STEP 1 -- Check if there are the conditions to run the specialized
9378 * version of while */
9380 switch (expr->len) {
9381 case 1:
9382 objPtr = JimExprIntValOrVar(interp, expr->expr);
9383 if (objPtr) {
9384 Jim_SetResult(interp, objPtr);
9385 goto done;
9387 break;
9389 case 2:
9390 if (expr->expr->type == JIM_EXPROP_NOT) {
9391 objPtr = JimExprIntValOrVar(interp, expr->expr->left);
9393 if (objPtr && JimIsWide(objPtr)) {
9394 Jim_SetResult(interp, JimWideValue(objPtr) ? interp->falseObj : interp->trueObj);
9395 goto done;
9398 break;
9400 case 3:
9401 objPtr = JimExprIntValOrVar(interp, expr->expr->left);
9402 if (objPtr && JimIsWide(objPtr)) {
9403 Jim_Obj *objPtr2 = JimExprIntValOrVar(interp, expr->expr->right);
9404 if (objPtr2 && JimIsWide(objPtr2)) {
9405 jim_wide wideValueA = JimWideValue(objPtr);
9406 jim_wide wideValueB = JimWideValue(objPtr2);
9407 int cmpRes;
9408 switch (expr->expr->type) {
9409 case JIM_EXPROP_LT:
9410 cmpRes = wideValueA < wideValueB;
9411 break;
9412 case JIM_EXPROP_LTE:
9413 cmpRes = wideValueA <= wideValueB;
9414 break;
9415 case JIM_EXPROP_GT:
9416 cmpRes = wideValueA > wideValueB;
9417 break;
9418 case JIM_EXPROP_GTE:
9419 cmpRes = wideValueA >= wideValueB;
9420 break;
9421 case JIM_EXPROP_NUMEQ:
9422 cmpRes = wideValueA == wideValueB;
9423 break;
9424 case JIM_EXPROP_NUMNE:
9425 cmpRes = wideValueA != wideValueB;
9426 break;
9427 default:
9428 goto noopt;
9430 Jim_SetResult(interp, cmpRes ? interp->trueObj : interp->falseObj);
9431 goto done;
9434 break;
9437 noopt:
9438 #endif
9440 /* In order to avoid the internal repr being freed due to
9441 * shimmering of the exprObjPtr's object, we increment the use count
9442 * and keep our own pointer outside the object.
9444 expr->inUse++;
9446 /* Evaluate with the recursive expr engine */
9447 retcode = JimExprEvalTermNode(interp, expr->expr);
9449 /* Now transfer ownership of expr back into the object in case it shimmered away */
9450 Jim_FreeIntRep(interp, exprObjPtr);
9451 exprObjPtr->typePtr = &exprObjType;
9452 Jim_SetIntRepPtr(exprObjPtr, expr);
9454 done:
9455 Jim_DecrRefCount(interp, exprObjPtr);
9457 return retcode;
9460 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
9462 int retcode = Jim_EvalExpression(interp, exprObjPtr);
9464 if (retcode == JIM_OK) {
9465 switch (ExprBool(interp, Jim_GetResult(interp))) {
9466 case 0:
9467 *boolPtr = 0;
9468 break;
9470 case 1:
9471 *boolPtr = 1;
9472 break;
9474 case -1:
9475 retcode = JIM_ERR;
9476 break;
9479 return retcode;
9482 /* -----------------------------------------------------------------------------
9483 * ScanFormat String Object
9484 * ---------------------------------------------------------------------------*/
9486 /* This Jim_Obj will held a parsed representation of a format string passed to
9487 * the Jim_ScanString command. For error diagnostics, the scanformat string has
9488 * to be parsed in its entirely first and then, if correct, can be used for
9489 * scanning. To avoid endless re-parsing, the parsed representation will be
9490 * stored in an internal representation and re-used for performance reason. */
9492 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
9493 * scanformat string. This part will later be used to extract information
9494 * out from the string to be parsed by Jim_ScanString */
9496 typedef struct ScanFmtPartDescr
9498 const char *arg; /* Specification of a CHARSET conversion */
9499 const char *prefix; /* Prefix to be scanned literally before conversion */
9500 size_t width; /* Maximal width of input to be converted */
9501 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
9502 char type; /* Type of conversion (e.g. c, d, f) */
9503 char modifier; /* Modify type (e.g. l - long, h - short */
9504 } ScanFmtPartDescr;
9506 /* The ScanFmtStringObj will hold the internal representation of a scanformat
9507 * string parsed and separated in part descriptions. Furthermore it contains
9508 * the original string representation of the scanformat string to allow for
9509 * fast update of the Jim_Obj's string representation part.
9511 * As an add-on the internal object representation adds some scratch pad area
9512 * for usage by Jim_ScanString to avoid endless allocating and freeing of
9513 * memory for purpose of string scanning.
9515 * The error member points to a static allocated string in case of a mal-
9516 * formed scanformat string or it contains '0' (NULL) in case of a valid
9517 * parse representation.
9519 * The whole memory of the internal representation is allocated as a single
9520 * area of memory that will be internally separated. So freeing and duplicating
9521 * of such an object is cheap */
9523 typedef struct ScanFmtStringObj
9525 jim_wide size; /* Size of internal repr in bytes */
9526 char *stringRep; /* Original string representation */
9527 size_t count; /* Number of ScanFmtPartDescr contained */
9528 size_t convCount; /* Number of conversions that will assign */
9529 size_t maxPos; /* Max position index if XPG3 is used */
9530 const char *error; /* Ptr to error text (NULL if no error */
9531 char *scratch; /* Some scratch pad used by Jim_ScanString */
9532 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
9533 } ScanFmtStringObj;
9536 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
9537 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
9538 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
9540 static const Jim_ObjType scanFmtStringObjType = {
9541 "scanformatstring",
9542 FreeScanFmtInternalRep,
9543 DupScanFmtInternalRep,
9544 UpdateStringOfScanFmt,
9545 JIM_TYPE_NONE,
9548 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
9550 JIM_NOTUSED(interp);
9551 Jim_Free((char *)objPtr->internalRep.ptr);
9552 objPtr->internalRep.ptr = 0;
9555 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
9557 size_t size = (size_t) ((ScanFmtStringObj *) srcPtr->internalRep.ptr)->size;
9558 ScanFmtStringObj *newVec = (ScanFmtStringObj *) Jim_Alloc(size);
9560 JIM_NOTUSED(interp);
9561 memcpy(newVec, srcPtr->internalRep.ptr, size);
9562 dupPtr->internalRep.ptr = newVec;
9563 dupPtr->typePtr = &scanFmtStringObjType;
9566 static void UpdateStringOfScanFmt(Jim_Obj *objPtr)
9568 JimSetStringBytes(objPtr, ((ScanFmtStringObj *) objPtr->internalRep.ptr)->stringRep);
9571 /* SetScanFmtFromAny will parse a given string and create the internal
9572 * representation of the format specification. In case of an error
9573 * the error data member of the internal representation will be set
9574 * to an descriptive error text and the function will be left with
9575 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
9576 * specification */
9578 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
9580 ScanFmtStringObj *fmtObj;
9581 char *buffer;
9582 int maxCount, i, approxSize, lastPos = -1;
9583 const char *fmt = Jim_String(objPtr);
9584 int maxFmtLen = Jim_Length(objPtr);
9585 const char *fmtEnd = fmt + maxFmtLen;
9586 int curr;
9588 Jim_FreeIntRep(interp, objPtr);
9589 /* Count how many conversions could take place maximally */
9590 for (i = 0, maxCount = 0; i < maxFmtLen; ++i)
9591 if (fmt[i] == '%')
9592 ++maxCount;
9593 /* Calculate an approximation of the memory necessary */
9594 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
9595 +(maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
9596 +maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
9597 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
9598 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
9599 +(maxCount + 1) * sizeof(char) /* '\0' for every partial */
9600 +1; /* safety byte */
9601 fmtObj = (ScanFmtStringObj *) Jim_Alloc(approxSize);
9602 memset(fmtObj, 0, approxSize);
9603 fmtObj->size = approxSize;
9604 fmtObj->maxPos = 0;
9605 fmtObj->scratch = (char *)&fmtObj->descr[maxCount + 1];
9606 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
9607 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
9608 buffer = fmtObj->stringRep + maxFmtLen + 1;
9609 objPtr->internalRep.ptr = fmtObj;
9610 objPtr->typePtr = &scanFmtStringObjType;
9611 for (i = 0, curr = 0; fmt < fmtEnd; ++fmt) {
9612 int width = 0, skip;
9613 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
9615 fmtObj->count++;
9616 descr->width = 0; /* Assume width unspecified */
9617 /* Overread and store any "literal" prefix */
9618 if (*fmt != '%' || fmt[1] == '%') {
9619 descr->type = 0;
9620 descr->prefix = &buffer[i];
9621 for (; fmt < fmtEnd; ++fmt) {
9622 if (*fmt == '%') {
9623 if (fmt[1] != '%')
9624 break;
9625 ++fmt;
9627 buffer[i++] = *fmt;
9629 buffer[i++] = 0;
9631 /* Skip the conversion introducing '%' sign */
9632 ++fmt;
9633 /* End reached due to non-conversion literal only? */
9634 if (fmt >= fmtEnd)
9635 goto done;
9636 descr->pos = 0; /* Assume "natural" positioning */
9637 if (*fmt == '*') {
9638 descr->pos = -1; /* Okay, conversion will not be assigned */
9639 ++fmt;
9641 else
9642 fmtObj->convCount++; /* Otherwise count as assign-conversion */
9643 /* Check if next token is a number (could be width or pos */
9644 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9645 fmt += skip;
9646 /* Was the number a XPG3 position specifier? */
9647 if (descr->pos != -1 && *fmt == '$') {
9648 int prev;
9650 ++fmt;
9651 descr->pos = width;
9652 width = 0;
9653 /* Look if "natural" postioning and XPG3 one was mixed */
9654 if ((lastPos == 0 && descr->pos > 0)
9655 || (lastPos > 0 && descr->pos == 0)) {
9656 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
9657 return JIM_ERR;
9659 /* Look if this position was already used */
9660 for (prev = 0; prev < curr; ++prev) {
9661 if (fmtObj->descr[prev].pos == -1)
9662 continue;
9663 if (fmtObj->descr[prev].pos == descr->pos) {
9664 fmtObj->error =
9665 "variable is assigned by multiple \"%n$\" conversion specifiers";
9666 return JIM_ERR;
9669 if (descr->pos < 0) {
9670 fmtObj->error =
9671 "\"%n$\" conversion specifier is negative";
9672 return JIM_ERR;
9674 /* Try to find a width after the XPG3 specifier */
9675 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9676 descr->width = width;
9677 fmt += skip;
9679 if (descr->pos > 0 && (size_t) descr->pos > fmtObj->maxPos)
9680 fmtObj->maxPos = descr->pos;
9682 else {
9683 /* Number was not a XPG3, so it has to be a width */
9684 descr->width = width;
9687 /* If positioning mode was undetermined yet, fix this */
9688 if (lastPos == -1)
9689 lastPos = descr->pos;
9690 /* Handle CHARSET conversion type ... */
9691 if (*fmt == '[') {
9692 int swapped = 1, beg = i, end, j;
9694 descr->type = '[';
9695 descr->arg = &buffer[i];
9696 ++fmt;
9697 if (*fmt == '^')
9698 buffer[i++] = *fmt++;
9699 if (*fmt == ']')
9700 buffer[i++] = *fmt++;
9701 while (*fmt && *fmt != ']')
9702 buffer[i++] = *fmt++;
9703 if (*fmt != ']') {
9704 fmtObj->error = "unmatched [ in format string";
9705 return JIM_ERR;
9707 end = i;
9708 buffer[i++] = 0;
9709 /* In case a range fence was given "backwards", swap it */
9710 while (swapped) {
9711 swapped = 0;
9712 for (j = beg + 1; j < end - 1; ++j) {
9713 if (buffer[j] == '-' && buffer[j - 1] > buffer[j + 1]) {
9714 char tmp = buffer[j - 1];
9716 buffer[j - 1] = buffer[j + 1];
9717 buffer[j + 1] = tmp;
9718 swapped = 1;
9723 else {
9724 /* Remember any valid modifier if given */
9725 if (fmt < fmtEnd && strchr("hlL", *fmt))
9726 descr->modifier = tolower((int)*fmt++);
9728 if (fmt >= fmtEnd) {
9729 fmtObj->error = "missing scan conversion character";
9730 return JIM_ERR;
9733 descr->type = *fmt;
9734 if (strchr("efgcsndoxui", *fmt) == 0) {
9735 fmtObj->error = "bad scan conversion character";
9736 return JIM_ERR;
9738 else if (*fmt == 'c' && descr->width != 0) {
9739 fmtObj->error = "field width may not be specified in %c " "conversion";
9740 return JIM_ERR;
9742 else if (*fmt == 'u' && descr->modifier == 'l') {
9743 fmtObj->error = "unsigned wide not supported";
9744 return JIM_ERR;
9747 curr++;
9749 done:
9750 return JIM_OK;
9753 /* Some accessor macros to allow lowlevel access to fields of internal repr */
9755 #define FormatGetCnvCount(_fo_) \
9756 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
9757 #define FormatGetMaxPos(_fo_) \
9758 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
9759 #define FormatGetError(_fo_) \
9760 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
9762 /* JimScanAString is used to scan an unspecified string that ends with
9763 * next WS, or a string that is specified via a charset.
9766 static Jim_Obj *JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
9768 char *buffer = Jim_StrDup(str);
9769 char *p = buffer;
9771 while (*str) {
9772 int c;
9773 int n;
9775 if (!sdescr && isspace(UCHAR(*str)))
9776 break; /* EOS via WS if unspecified */
9778 n = utf8_tounicode(str, &c);
9779 if (sdescr && !JimCharsetMatch(sdescr, strlen(sdescr), c, JIM_CHARSET_SCAN))
9780 break;
9781 while (n--)
9782 *p++ = *str++;
9784 *p = 0;
9785 return Jim_NewStringObjNoAlloc(interp, buffer, p - buffer);
9788 /* ScanOneEntry will scan one entry out of the string passed as argument.
9789 * It use the sscanf() function for this task. After extracting and
9790 * converting of the value, the count of scanned characters will be
9791 * returned of -1 in case of no conversion tool place and string was
9792 * already scanned thru */
9794 static int ScanOneEntry(Jim_Interp *interp, const char *str, int pos, int str_bytelen,
9795 ScanFmtStringObj * fmtObj, long idx, Jim_Obj **valObjPtr)
9797 const char *tok;
9798 const ScanFmtPartDescr *descr = &fmtObj->descr[idx];
9799 size_t scanned = 0;
9800 size_t anchor = pos;
9801 int i;
9802 Jim_Obj *tmpObj = NULL;
9804 /* First pessimistically assume, we will not scan anything :-) */
9805 *valObjPtr = 0;
9806 if (descr->prefix) {
9807 /* There was a prefix given before the conversion, skip it and adjust
9808 * the string-to-be-parsed accordingly */
9809 for (i = 0; pos < str_bytelen && descr->prefix[i]; ++i) {
9810 /* If prefix require, skip WS */
9811 if (isspace(UCHAR(descr->prefix[i])))
9812 while (pos < str_bytelen && isspace(UCHAR(str[pos])))
9813 ++pos;
9814 else if (descr->prefix[i] != str[pos])
9815 break; /* Prefix do not match here, leave the loop */
9816 else
9817 ++pos; /* Prefix matched so far, next round */
9819 if (pos >= str_bytelen) {
9820 return -1; /* All of str consumed: EOF condition */
9822 else if (descr->prefix[i] != 0)
9823 return 0; /* Not whole prefix consumed, no conversion possible */
9825 /* For all but following conversion, skip leading WS */
9826 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
9827 while (isspace(UCHAR(str[pos])))
9828 ++pos;
9830 /* Determine how much skipped/scanned so far */
9831 scanned = pos - anchor;
9833 /* %c is a special, simple case. no width */
9834 if (descr->type == 'n') {
9835 /* Return pseudo conversion means: how much scanned so far? */
9836 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
9838 else if (pos >= str_bytelen) {
9839 /* Cannot scan anything, as str is totally consumed */
9840 return -1;
9842 else if (descr->type == 'c') {
9843 int c;
9844 scanned += utf8_tounicode(&str[pos], &c);
9845 *valObjPtr = Jim_NewIntObj(interp, c);
9846 return scanned;
9848 else {
9849 /* Processing of conversions follows ... */
9850 if (descr->width > 0) {
9851 /* Do not try to scan as fas as possible but only the given width.
9852 * To ensure this, we copy the part that should be scanned. */
9853 size_t sLen = utf8_strlen(&str[pos], str_bytelen - pos);
9854 size_t tLen = descr->width > sLen ? sLen : descr->width;
9856 tmpObj = Jim_NewStringObjUtf8(interp, str + pos, tLen);
9857 tok = tmpObj->bytes;
9859 else {
9860 /* As no width was given, simply refer to the original string */
9861 tok = &str[pos];
9863 switch (descr->type) {
9864 case 'd':
9865 case 'o':
9866 case 'x':
9867 case 'u':
9868 case 'i':{
9869 char *endp; /* Position where the number finished */
9870 jim_wide w;
9872 int base = descr->type == 'o' ? 8
9873 : descr->type == 'x' ? 16 : descr->type == 'i' ? 0 : 10;
9875 /* Try to scan a number with the given base */
9876 if (base == 0) {
9877 w = jim_strtoull(tok, &endp);
9879 else {
9880 w = strtoull(tok, &endp, base);
9883 if (endp != tok) {
9884 /* There was some number sucessfully scanned! */
9885 *valObjPtr = Jim_NewIntObj(interp, w);
9887 /* Adjust the number-of-chars scanned so far */
9888 scanned += endp - tok;
9890 else {
9891 /* Nothing was scanned. We have to determine if this
9892 * happened due to e.g. prefix mismatch or input str
9893 * exhausted */
9894 scanned = *tok ? 0 : -1;
9896 break;
9898 case 's':
9899 case '[':{
9900 *valObjPtr = JimScanAString(interp, descr->arg, tok);
9901 scanned += Jim_Length(*valObjPtr);
9902 break;
9904 case 'e':
9905 case 'f':
9906 case 'g':{
9907 char *endp;
9908 double value = strtod(tok, &endp);
9910 if (endp != tok) {
9911 /* There was some number sucessfully scanned! */
9912 *valObjPtr = Jim_NewDoubleObj(interp, value);
9913 /* Adjust the number-of-chars scanned so far */
9914 scanned += endp - tok;
9916 else {
9917 /* Nothing was scanned. We have to determine if this
9918 * happened due to e.g. prefix mismatch or input str
9919 * exhausted */
9920 scanned = *tok ? 0 : -1;
9922 break;
9925 /* If a substring was allocated (due to pre-defined width) do not
9926 * forget to free it */
9927 if (tmpObj) {
9928 Jim_FreeNewObj(interp, tmpObj);
9931 return scanned;
9934 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
9935 * string and returns all converted (and not ignored) values in a list back
9936 * to the caller. If an error occured, a NULL pointer will be returned */
9938 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *fmtObjPtr, int flags)
9940 size_t i, pos;
9941 int scanned = 1;
9942 const char *str = Jim_String(strObjPtr);
9943 int str_bytelen = Jim_Length(strObjPtr);
9944 Jim_Obj *resultList = 0;
9945 Jim_Obj **resultVec = 0;
9946 int resultc;
9947 Jim_Obj *emptyStr = 0;
9948 ScanFmtStringObj *fmtObj;
9950 /* This should never happen. The format object should already be of the correct type */
9951 JimPanic((fmtObjPtr->typePtr != &scanFmtStringObjType, "Jim_ScanString() for non-scan format"));
9953 fmtObj = (ScanFmtStringObj *) fmtObjPtr->internalRep.ptr;
9954 /* Check if format specification was valid */
9955 if (fmtObj->error != 0) {
9956 if (flags & JIM_ERRMSG)
9957 Jim_SetResultString(interp, fmtObj->error, -1);
9958 return 0;
9960 /* Allocate a new "shared" empty string for all unassigned conversions */
9961 emptyStr = Jim_NewEmptyStringObj(interp);
9962 Jim_IncrRefCount(emptyStr);
9963 /* Create a list and fill it with empty strings up to max specified XPG3 */
9964 resultList = Jim_NewListObj(interp, NULL, 0);
9965 if (fmtObj->maxPos > 0) {
9966 for (i = 0; i < fmtObj->maxPos; ++i)
9967 Jim_ListAppendElement(interp, resultList, emptyStr);
9968 JimListGetElements(interp, resultList, &resultc, &resultVec);
9970 /* Now handle every partial format description */
9971 for (i = 0, pos = 0; i < fmtObj->count; ++i) {
9972 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
9973 Jim_Obj *value = 0;
9975 /* Only last type may be "literal" w/o conversion - skip it! */
9976 if (descr->type == 0)
9977 continue;
9978 /* As long as any conversion could be done, we will proceed */
9979 if (scanned > 0)
9980 scanned = ScanOneEntry(interp, str, pos, str_bytelen, fmtObj, i, &value);
9981 /* In case our first try results in EOF, we will leave */
9982 if (scanned == -1 && i == 0)
9983 goto eof;
9984 /* Advance next pos-to-be-scanned for the amount scanned already */
9985 pos += scanned;
9987 /* value == 0 means no conversion took place so take empty string */
9988 if (value == 0)
9989 value = Jim_NewEmptyStringObj(interp);
9990 /* If value is a non-assignable one, skip it */
9991 if (descr->pos == -1) {
9992 Jim_FreeNewObj(interp, value);
9994 else if (descr->pos == 0)
9995 /* Otherwise append it to the result list if no XPG3 was given */
9996 Jim_ListAppendElement(interp, resultList, value);
9997 else if (resultVec[descr->pos - 1] == emptyStr) {
9998 /* But due to given XPG3, put the value into the corr. slot */
9999 Jim_DecrRefCount(interp, resultVec[descr->pos - 1]);
10000 Jim_IncrRefCount(value);
10001 resultVec[descr->pos - 1] = value;
10003 else {
10004 /* Otherwise, the slot was already used - free obj and ERROR */
10005 Jim_FreeNewObj(interp, value);
10006 goto err;
10009 Jim_DecrRefCount(interp, emptyStr);
10010 return resultList;
10011 eof:
10012 Jim_DecrRefCount(interp, emptyStr);
10013 Jim_FreeNewObj(interp, resultList);
10014 return (Jim_Obj *)EOF;
10015 err:
10016 Jim_DecrRefCount(interp, emptyStr);
10017 Jim_FreeNewObj(interp, resultList);
10018 return 0;
10021 /* -----------------------------------------------------------------------------
10022 * Pseudo Random Number Generation
10023 * ---------------------------------------------------------------------------*/
10024 /* Initialize the sbox with the numbers from 0 to 255 */
10025 static void JimPrngInit(Jim_Interp *interp)
10027 #define PRNG_SEED_SIZE 256
10028 int i;
10029 unsigned int *seed;
10030 time_t t = time(NULL);
10032 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
10034 seed = Jim_Alloc(PRNG_SEED_SIZE * sizeof(*seed));
10035 for (i = 0; i < PRNG_SEED_SIZE; i++) {
10036 seed[i] = (rand() ^ t ^ clock());
10038 JimPrngSeed(interp, (unsigned char *)seed, PRNG_SEED_SIZE * sizeof(*seed));
10039 Jim_Free(seed);
10042 /* Generates N bytes of random data */
10043 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
10045 Jim_PrngState *prng;
10046 unsigned char *destByte = (unsigned char *)dest;
10047 unsigned int si, sj, x;
10049 /* initialization, only needed the first time */
10050 if (interp->prngState == NULL)
10051 JimPrngInit(interp);
10052 prng = interp->prngState;
10053 /* generates 'len' bytes of pseudo-random numbers */
10054 for (x = 0; x < len; x++) {
10055 prng->i = (prng->i + 1) & 0xff;
10056 si = prng->sbox[prng->i];
10057 prng->j = (prng->j + si) & 0xff;
10058 sj = prng->sbox[prng->j];
10059 prng->sbox[prng->i] = sj;
10060 prng->sbox[prng->j] = si;
10061 *destByte++ = prng->sbox[(si + sj) & 0xff];
10065 /* Re-seed the generator with user-provided bytes */
10066 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen)
10068 int i;
10069 Jim_PrngState *prng;
10071 /* initialization, only needed the first time */
10072 if (interp->prngState == NULL)
10073 JimPrngInit(interp);
10074 prng = interp->prngState;
10076 /* Set the sbox[i] with i */
10077 for (i = 0; i < 256; i++)
10078 prng->sbox[i] = i;
10079 /* Now use the seed to perform a random permutation of the sbox */
10080 for (i = 0; i < seedLen; i++) {
10081 unsigned char t;
10083 t = prng->sbox[i & 0xFF];
10084 prng->sbox[i & 0xFF] = prng->sbox[seed[i]];
10085 prng->sbox[seed[i]] = t;
10087 prng->i = prng->j = 0;
10089 /* discard at least the first 256 bytes of stream.
10090 * borrow the seed buffer for this
10092 for (i = 0; i < 256; i += seedLen) {
10093 JimRandomBytes(interp, seed, seedLen);
10097 /* [incr] */
10098 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10100 jim_wide wideValue, increment = 1;
10101 Jim_Obj *intObjPtr;
10103 if (argc != 2 && argc != 3) {
10104 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
10105 return JIM_ERR;
10107 if (argc == 3) {
10108 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
10109 return JIM_ERR;
10111 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
10112 if (!intObjPtr) {
10113 /* Set missing variable to 0 */
10114 wideValue = 0;
10116 else if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK) {
10117 return JIM_ERR;
10119 if (!intObjPtr || Jim_IsShared(intObjPtr)) {
10120 intObjPtr = Jim_NewIntObj(interp, wideValue + increment);
10121 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
10122 Jim_FreeNewObj(interp, intObjPtr);
10123 return JIM_ERR;
10126 else {
10127 /* Can do it the quick way */
10128 Jim_InvalidateStringRep(intObjPtr);
10129 JimWideValue(intObjPtr) = wideValue + increment;
10131 /* The following step is required in order to invalidate the
10132 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
10133 if (argv[1]->typePtr != &variableObjType) {
10134 /* Note that this can't fail since GetVariable already succeeded */
10135 Jim_SetVariable(interp, argv[1], intObjPtr);
10138 Jim_SetResult(interp, intObjPtr);
10139 return JIM_OK;
10143 /* -----------------------------------------------------------------------------
10144 * Eval
10145 * ---------------------------------------------------------------------------*/
10146 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
10147 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
10149 /* Handle calls to the [unknown] command */
10150 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10152 int retcode;
10154 /* If JimUnknown() is recursively called too many times...
10155 * done here
10157 if (interp->unknown_called > 50) {
10158 return JIM_ERR;
10161 /* The object interp->unknown just contains
10162 * the "unknown" string, it is used in order to
10163 * avoid to lookup the unknown command every time
10164 * but instead to cache the result. */
10166 /* If the [unknown] command does not exist ... */
10167 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
10168 return JIM_ERR;
10170 interp->unknown_called++;
10171 /* XXX: Are we losing fileNameObj and linenr? */
10172 retcode = Jim_EvalObjPrefix(interp, interp->unknown, argc, argv);
10173 interp->unknown_called--;
10175 return retcode;
10178 static int JimInvokeCommand(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10180 int retcode;
10181 Jim_Cmd *cmdPtr;
10182 void *prevPrivData;
10183 Jim_Obj *tailcallObj = NULL;
10185 #if 0
10186 printf("invoke");
10187 int j;
10188 for (j = 0; j < objc; j++) {
10189 printf(" '%s'", Jim_String(objv[j]));
10191 printf("\n");
10192 #endif
10194 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
10195 if (cmdPtr == NULL) {
10196 return JimUnknown(interp, objc, objv);
10198 JimIncrCmdRefCount(cmdPtr);
10200 if (interp->evalDepth == interp->maxEvalDepth) {
10201 Jim_SetResultString(interp, "Infinite eval recursion", -1);
10202 retcode = JIM_ERR;
10203 goto out;
10205 interp->evalDepth++;
10206 prevPrivData = interp->cmdPrivData;
10208 tailcall:
10210 /* Call it -- Make sure result is an empty object. */
10211 Jim_SetEmptyResult(interp);
10212 if (cmdPtr->isproc) {
10213 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
10215 else {
10216 interp->cmdPrivData = cmdPtr->u.native.privData;
10217 retcode = cmdPtr->u.native.cmdProc(interp, objc, objv);
10220 if (tailcallObj) {
10221 /* clean up previous tailcall if we were invoking one */
10222 Jim_DecrRefCount(interp, tailcallObj);
10223 tailcallObj = NULL;
10226 /* If a tailcall is returned for this frame, loop to invoke the new command */
10227 if (retcode == JIM_EVAL && interp->framePtr->tailcallObj) {
10228 JimDecrCmdRefCount(interp, cmdPtr);
10230 /* Replace the current command with the new tailcall command */
10231 cmdPtr = interp->framePtr->tailcallCmd;
10232 interp->framePtr->tailcallCmd = NULL;
10233 tailcallObj = interp->framePtr->tailcallObj;
10234 interp->framePtr->tailcallObj = NULL;
10235 /* We can access the internal rep here because the object can only
10236 * be constructed by the tailcall command
10238 objc = tailcallObj->internalRep.listValue.len;
10239 objv = tailcallObj->internalRep.listValue.ele;
10240 goto tailcall;
10243 interp->cmdPrivData = prevPrivData;
10244 interp->evalDepth--;
10246 out:
10247 JimDecrCmdRefCount(interp, cmdPtr);
10249 if (interp->framePtr->tailcallObj) {
10250 /* We might have skipped invoking a tailcall, perhaps because of an error
10251 * in defer handling so cleanup now
10253 JimDecrCmdRefCount(interp, interp->framePtr->tailcallCmd);
10254 Jim_DecrRefCount(interp, interp->framePtr->tailcallObj);
10255 interp->framePtr->tailcallCmd = NULL;
10256 interp->framePtr->tailcallObj = NULL;
10259 return retcode;
10262 /* Eval the object vector 'objv' composed of 'objc' elements.
10263 * Every element is used as single argument.
10264 * Jim_EvalObj() will call this function every time its object
10265 * argument is of "list" type, with no string representation.
10267 * This is possible because the string representation of a
10268 * list object generated by the UpdateStringOfList is made
10269 * in a way that ensures that every list element is a different
10270 * command argument. */
10271 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10273 int i, retcode;
10275 /* Incr refcount of arguments. */
10276 for (i = 0; i < objc; i++)
10277 Jim_IncrRefCount(objv[i]);
10279 retcode = JimInvokeCommand(interp, objc, objv);
10281 /* Decr refcount of arguments and return the retcode */
10282 for (i = 0; i < objc; i++)
10283 Jim_DecrRefCount(interp, objv[i]);
10285 return retcode;
10289 * Invokes 'prefix' as a command with the objv array as arguments.
10291 int Jim_EvalObjPrefix(Jim_Interp *interp, Jim_Obj *prefix, int objc, Jim_Obj *const *objv)
10293 int ret;
10294 Jim_Obj **nargv = Jim_Alloc((objc + 1) * sizeof(*nargv));
10296 nargv[0] = prefix;
10297 memcpy(&nargv[1], &objv[0], sizeof(nargv[0]) * objc);
10298 ret = Jim_EvalObjVector(interp, objc + 1, nargv);
10299 Jim_Free(nargv);
10300 return ret;
10303 static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script)
10305 if (!interp->errorFlag) {
10306 /* This is the first error, so save the file/line information and reset the stack */
10307 interp->errorFlag = 1;
10308 Jim_IncrRefCount(script->fileNameObj);
10309 Jim_DecrRefCount(interp, interp->errorFileNameObj);
10310 interp->errorFileNameObj = script->fileNameObj;
10311 interp->errorLine = script->linenr;
10313 JimResetStackTrace(interp);
10314 /* Always add a level where the error first occurs */
10315 interp->addStackTrace++;
10318 /* Now if this is an "interesting" level, add it to the stack trace */
10319 if (interp->addStackTrace > 0) {
10320 /* Add the stack info for the current level */
10322 JimAppendStackTrace(interp, Jim_String(interp->errorProc), script->fileNameObj, script->linenr);
10324 /* Note: if we didn't have a filename for this level,
10325 * don't clear the addStackTrace flag
10326 * so we can pick it up at the next level
10328 if (Jim_Length(script->fileNameObj)) {
10329 interp->addStackTrace = 0;
10332 Jim_DecrRefCount(interp, interp->errorProc);
10333 interp->errorProc = interp->emptyObj;
10334 Jim_IncrRefCount(interp->errorProc);
10338 static int JimSubstOneToken(Jim_Interp *interp, const ScriptToken *token, Jim_Obj **objPtrPtr)
10340 Jim_Obj *objPtr;
10341 int ret = JIM_ERR;
10343 switch (token->type) {
10344 case JIM_TT_STR:
10345 case JIM_TT_ESC:
10346 objPtr = token->objPtr;
10347 break;
10348 case JIM_TT_VAR:
10349 objPtr = Jim_GetVariable(interp, token->objPtr, JIM_ERRMSG);
10350 break;
10351 case JIM_TT_DICTSUGAR:
10352 objPtr = JimExpandDictSugar(interp, token->objPtr);
10353 break;
10354 case JIM_TT_EXPRSUGAR:
10355 ret = Jim_EvalExpression(interp, token->objPtr);
10356 if (ret == JIM_OK) {
10357 objPtr = Jim_GetResult(interp);
10359 else {
10360 objPtr = NULL;
10362 break;
10363 case JIM_TT_CMD:
10364 ret = Jim_EvalObj(interp, token->objPtr);
10365 if (ret == JIM_OK || ret == JIM_RETURN) {
10366 objPtr = interp->result;
10367 } else {
10368 /* includes JIM_BREAK, JIM_CONTINUE */
10369 objPtr = NULL;
10371 break;
10372 default:
10373 JimPanic((1,
10374 "default token type (%d) reached " "in Jim_SubstObj().", token->type));
10375 objPtr = NULL;
10376 break;
10378 if (objPtr) {
10379 *objPtrPtr = objPtr;
10380 return JIM_OK;
10382 return ret;
10385 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
10386 * via *objPtrPtr. This function is only called by Jim_EvalObj() and Jim_SubstObj()
10387 * The returned object has refcount = 0.
10389 static Jim_Obj *JimInterpolateTokens(Jim_Interp *interp, const ScriptToken * token, int tokens, int flags)
10391 int totlen = 0, i;
10392 Jim_Obj **intv;
10393 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
10394 Jim_Obj *objPtr;
10395 char *s;
10397 if (tokens <= JIM_EVAL_SINTV_LEN)
10398 intv = sintv;
10399 else
10400 intv = Jim_Alloc(sizeof(Jim_Obj *) * tokens);
10402 /* Compute every token forming the argument
10403 * in the intv objects vector. */
10404 for (i = 0; i < tokens; i++) {
10405 switch (JimSubstOneToken(interp, &token[i], &intv[i])) {
10406 case JIM_OK:
10407 case JIM_RETURN:
10408 break;
10409 case JIM_BREAK:
10410 if (flags & JIM_SUBST_FLAG) {
10411 /* Stop here */
10412 tokens = i;
10413 continue;
10415 /* XXX: Should probably set an error about break outside loop */
10416 /* fall through to error */
10417 case JIM_CONTINUE:
10418 if (flags & JIM_SUBST_FLAG) {
10419 intv[i] = NULL;
10420 continue;
10422 /* XXX: Ditto continue outside loop */
10423 /* fall through to error */
10424 default:
10425 while (i--) {
10426 Jim_DecrRefCount(interp, intv[i]);
10428 if (intv != sintv) {
10429 Jim_Free(intv);
10431 return NULL;
10433 Jim_IncrRefCount(intv[i]);
10434 Jim_String(intv[i]);
10435 totlen += intv[i]->length;
10438 /* Fast path return for a single token */
10439 if (tokens == 1 && intv[0] && intv == sintv) {
10440 /* Reverse the Jim_IncrRefCount() above, but don't free the object */
10441 intv[0]->refCount--;
10442 return intv[0];
10445 /* Concatenate every token in an unique
10446 * object. */
10447 objPtr = Jim_NewStringObjNoAlloc(interp, NULL, 0);
10449 if (tokens == 4 && token[0].type == JIM_TT_ESC && token[1].type == JIM_TT_ESC
10450 && token[2].type == JIM_TT_VAR) {
10451 /* May be able to do fast interpolated object -> dictSubst */
10452 objPtr->typePtr = &interpolatedObjType;
10453 objPtr->internalRep.dictSubstValue.varNameObjPtr = token[0].objPtr;
10454 objPtr->internalRep.dictSubstValue.indexObjPtr = intv[2];
10455 Jim_IncrRefCount(intv[2]);
10457 else if (tokens && intv[0] && intv[0]->typePtr == &sourceObjType) {
10458 /* The first interpolated token is source, so preserve the source info */
10459 JimSetSourceInfo(interp, objPtr, intv[0]->internalRep.sourceValue.fileNameObj, intv[0]->internalRep.sourceValue.lineNumber);
10463 s = objPtr->bytes = Jim_Alloc(totlen + 1);
10464 objPtr->length = totlen;
10465 for (i = 0; i < tokens; i++) {
10466 if (intv[i]) {
10467 memcpy(s, intv[i]->bytes, intv[i]->length);
10468 s += intv[i]->length;
10469 Jim_DecrRefCount(interp, intv[i]);
10472 objPtr->bytes[totlen] = '\0';
10473 /* Free the intv vector if not static. */
10474 if (intv != sintv) {
10475 Jim_Free(intv);
10478 return objPtr;
10482 /* listPtr *must* be a list.
10483 * The contents of the list is evaluated with the first element as the command and
10484 * the remaining elements as the arguments.
10486 static int JimEvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10488 int retcode = JIM_OK;
10490 JimPanic((Jim_IsList(listPtr) == 0, "JimEvalObjList() invoked on non-list."));
10492 if (listPtr->internalRep.listValue.len) {
10493 Jim_IncrRefCount(listPtr);
10494 retcode = JimInvokeCommand(interp,
10495 listPtr->internalRep.listValue.len,
10496 listPtr->internalRep.listValue.ele);
10497 Jim_DecrRefCount(interp, listPtr);
10499 return retcode;
10502 int Jim_EvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10504 SetListFromAny(interp, listPtr);
10505 return JimEvalObjList(interp, listPtr);
10508 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
10510 int i;
10511 ScriptObj *script;
10512 ScriptToken *token;
10513 int retcode = JIM_OK;
10514 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL;
10515 Jim_Obj *prevScriptObj;
10517 /* If the object is of type "list", with no string rep we can call
10518 * a specialized version of Jim_EvalObj() */
10519 if (Jim_IsList(scriptObjPtr) && scriptObjPtr->bytes == NULL) {
10520 return JimEvalObjList(interp, scriptObjPtr);
10523 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
10524 script = JimGetScript(interp, scriptObjPtr);
10525 if (!JimScriptValid(interp, script)) {
10526 Jim_DecrRefCount(interp, scriptObjPtr);
10527 return JIM_ERR;
10530 /* Reset the interpreter result. This is useful to
10531 * return the empty result in the case of empty program. */
10532 Jim_SetEmptyResult(interp);
10534 token = script->token;
10536 #ifdef JIM_OPTIMIZATION
10537 /* Check for one of the following common scripts used by for, while
10539 * {}
10540 * incr a
10542 if (script->len == 0) {
10543 Jim_DecrRefCount(interp, scriptObjPtr);
10544 return JIM_OK;
10546 if (script->len == 3
10547 && token[1].objPtr->typePtr == &commandObjType
10548 && token[1].objPtr->internalRep.cmdValue.cmdPtr->isproc == 0
10549 && token[1].objPtr->internalRep.cmdValue.cmdPtr->u.native.cmdProc == Jim_IncrCoreCommand
10550 && token[2].objPtr->typePtr == &variableObjType) {
10552 Jim_Obj *objPtr = Jim_GetVariable(interp, token[2].objPtr, JIM_NONE);
10554 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
10555 JimWideValue(objPtr)++;
10556 Jim_InvalidateStringRep(objPtr);
10557 Jim_DecrRefCount(interp, scriptObjPtr);
10558 Jim_SetResult(interp, objPtr);
10559 return JIM_OK;
10562 #endif
10564 /* Now we have to make sure the internal repr will not be
10565 * freed on shimmering.
10567 * Think for example to this:
10569 * set x {llength $x; ... some more code ...}; eval $x
10571 * In order to preserve the internal rep, we increment the
10572 * inUse field of the script internal rep structure. */
10573 script->inUse++;
10575 /* Stash the current script */
10576 prevScriptObj = interp->currentScriptObj;
10577 interp->currentScriptObj = scriptObjPtr;
10579 interp->errorFlag = 0;
10580 argv = sargv;
10582 /* Execute every command sequentially until the end of the script
10583 * or an error occurs.
10585 for (i = 0; i < script->len && retcode == JIM_OK; ) {
10586 int argc;
10587 int j;
10589 /* First token of the line is always JIM_TT_LINE */
10590 argc = token[i].objPtr->internalRep.scriptLineValue.argc;
10591 script->linenr = token[i].objPtr->internalRep.scriptLineValue.line;
10593 /* Allocate the arguments vector if required */
10594 if (argc > JIM_EVAL_SARGV_LEN)
10595 argv = Jim_Alloc(sizeof(Jim_Obj *) * argc);
10597 /* Skip the JIM_TT_LINE token */
10598 i++;
10600 /* Populate the arguments objects.
10601 * If an error occurs, retcode will be set and
10602 * 'j' will be set to the number of args expanded
10604 for (j = 0; j < argc; j++) {
10605 long wordtokens = 1;
10606 int expand = 0;
10607 Jim_Obj *wordObjPtr = NULL;
10609 if (token[i].type == JIM_TT_WORD) {
10610 wordtokens = JimWideValue(token[i++].objPtr);
10611 if (wordtokens < 0) {
10612 expand = 1;
10613 wordtokens = -wordtokens;
10617 if (wordtokens == 1) {
10618 /* Fast path if the token does not
10619 * need interpolation */
10621 switch (token[i].type) {
10622 case JIM_TT_ESC:
10623 case JIM_TT_STR:
10624 wordObjPtr = token[i].objPtr;
10625 break;
10626 case JIM_TT_VAR:
10627 wordObjPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
10628 break;
10629 case JIM_TT_EXPRSUGAR:
10630 retcode = Jim_EvalExpression(interp, token[i].objPtr);
10631 if (retcode == JIM_OK) {
10632 wordObjPtr = Jim_GetResult(interp);
10634 else {
10635 wordObjPtr = NULL;
10637 break;
10638 case JIM_TT_DICTSUGAR:
10639 wordObjPtr = JimExpandDictSugar(interp, token[i].objPtr);
10640 break;
10641 case JIM_TT_CMD:
10642 retcode = Jim_EvalObj(interp, token[i].objPtr);
10643 if (retcode == JIM_OK) {
10644 wordObjPtr = Jim_GetResult(interp);
10646 break;
10647 default:
10648 JimPanic((1, "default token type reached " "in Jim_EvalObj()."));
10651 else {
10652 /* For interpolation we call a helper
10653 * function to do the work for us. */
10654 wordObjPtr = JimInterpolateTokens(interp, token + i, wordtokens, JIM_NONE);
10657 if (!wordObjPtr) {
10658 if (retcode == JIM_OK) {
10659 retcode = JIM_ERR;
10661 break;
10664 Jim_IncrRefCount(wordObjPtr);
10665 i += wordtokens;
10667 if (!expand) {
10668 argv[j] = wordObjPtr;
10670 else {
10671 /* Need to expand wordObjPtr into multiple args from argv[j] ... */
10672 int len = Jim_ListLength(interp, wordObjPtr);
10673 int newargc = argc + len - 1;
10674 int k;
10676 if (len > 1) {
10677 if (argv == sargv) {
10678 if (newargc > JIM_EVAL_SARGV_LEN) {
10679 argv = Jim_Alloc(sizeof(*argv) * newargc);
10680 memcpy(argv, sargv, sizeof(*argv) * j);
10683 else {
10684 /* Need to realloc to make room for (len - 1) more entries */
10685 argv = Jim_Realloc(argv, sizeof(*argv) * newargc);
10689 /* Now copy in the expanded version */
10690 for (k = 0; k < len; k++) {
10691 argv[j++] = wordObjPtr->internalRep.listValue.ele[k];
10692 Jim_IncrRefCount(wordObjPtr->internalRep.listValue.ele[k]);
10695 /* The original object reference is no longer needed,
10696 * after the expansion it is no longer present on
10697 * the argument vector, but the single elements are
10698 * in its place. */
10699 Jim_DecrRefCount(interp, wordObjPtr);
10701 /* And update the indexes */
10702 j--;
10703 argc += len - 1;
10707 if (retcode == JIM_OK && argc) {
10708 /* Invoke the command */
10709 retcode = JimInvokeCommand(interp, argc, argv);
10710 /* Check for a signal after each command */
10711 if (Jim_CheckSignal(interp)) {
10712 retcode = JIM_SIGNAL;
10716 /* Finished with the command, so decrement ref counts of each argument */
10717 while (j-- > 0) {
10718 Jim_DecrRefCount(interp, argv[j]);
10721 if (argv != sargv) {
10722 Jim_Free(argv);
10723 argv = sargv;
10727 /* Possibly add to the error stack trace */
10728 if (retcode == JIM_ERR) {
10729 JimAddErrorToStack(interp, script);
10731 /* Propagate the addStackTrace value through 'return -code error' */
10732 else if (retcode != JIM_RETURN || interp->returnCode != JIM_ERR) {
10733 /* No need to add stack trace */
10734 interp->addStackTrace = 0;
10737 /* Restore the current script */
10738 interp->currentScriptObj = prevScriptObj;
10740 /* Note that we don't have to decrement inUse, because the
10741 * following code transfers our use of the reference again to
10742 * the script object. */
10743 Jim_FreeIntRep(interp, scriptObjPtr);
10744 scriptObjPtr->typePtr = &scriptObjType;
10745 Jim_SetIntRepPtr(scriptObjPtr, script);
10746 Jim_DecrRefCount(interp, scriptObjPtr);
10748 return retcode;
10751 static int JimSetProcArg(Jim_Interp *interp, Jim_Obj *argNameObj, Jim_Obj *argValObj)
10753 int retcode;
10754 /* If argObjPtr begins with '&', do an automatic upvar */
10755 const char *varname = Jim_String(argNameObj);
10756 if (*varname == '&') {
10757 /* First check that the target variable exists */
10758 Jim_Obj *objPtr;
10759 Jim_CallFrame *savedCallFrame = interp->framePtr;
10761 interp->framePtr = interp->framePtr->parent;
10762 objPtr = Jim_GetVariable(interp, argValObj, JIM_ERRMSG);
10763 interp->framePtr = savedCallFrame;
10764 if (!objPtr) {
10765 return JIM_ERR;
10768 /* It exists, so perform the binding. */
10769 objPtr = Jim_NewStringObj(interp, varname + 1, -1);
10770 Jim_IncrRefCount(objPtr);
10771 retcode = Jim_SetVariableLink(interp, objPtr, argValObj, interp->framePtr->parent);
10772 Jim_DecrRefCount(interp, objPtr);
10774 else {
10775 retcode = Jim_SetVariable(interp, argNameObj, argValObj);
10777 return retcode;
10781 * Sets the interp result to be an error message indicating the required proc args.
10783 static void JimSetProcWrongArgs(Jim_Interp *interp, Jim_Obj *procNameObj, Jim_Cmd *cmd)
10785 /* Create a nice error message, consistent with Tcl 8.5 */
10786 Jim_Obj *argmsg = Jim_NewStringObj(interp, "", 0);
10787 int i;
10789 for (i = 0; i < cmd->u.proc.argListLen; i++) {
10790 Jim_AppendString(interp, argmsg, " ", 1);
10792 if (i == cmd->u.proc.argsPos) {
10793 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10794 /* Renamed args */
10795 Jim_AppendString(interp, argmsg, "?", 1);
10796 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].defaultObjPtr);
10797 Jim_AppendString(interp, argmsg, " ...?", -1);
10799 else {
10800 /* We have plain args */
10801 Jim_AppendString(interp, argmsg, "?arg...?", -1);
10804 else {
10805 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10806 Jim_AppendString(interp, argmsg, "?", 1);
10807 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].nameObjPtr);
10808 Jim_AppendString(interp, argmsg, "?", 1);
10810 else {
10811 const char *arg = Jim_String(cmd->u.proc.arglist[i].nameObjPtr);
10812 if (*arg == '&') {
10813 arg++;
10815 Jim_AppendString(interp, argmsg, arg, -1);
10819 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s%#s\"", procNameObj, argmsg);
10822 #ifdef jim_ext_namespace
10824 * [namespace eval]
10826 int Jim_EvalNamespace(Jim_Interp *interp, Jim_Obj *scriptObj, Jim_Obj *nsObj)
10828 Jim_CallFrame *callFramePtr;
10829 int retcode;
10831 /* Create a new callframe */
10832 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, nsObj);
10833 callFramePtr->argv = &interp->emptyObj;
10834 callFramePtr->argc = 0;
10835 callFramePtr->procArgsObjPtr = NULL;
10836 callFramePtr->procBodyObjPtr = scriptObj;
10837 callFramePtr->staticVars = NULL;
10838 callFramePtr->fileNameObj = interp->emptyObj;
10839 callFramePtr->line = 0;
10840 Jim_IncrRefCount(scriptObj);
10841 interp->framePtr = callFramePtr;
10843 /* Check if there are too nested calls */
10844 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10845 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10846 retcode = JIM_ERR;
10848 else {
10849 /* Eval the body */
10850 retcode = Jim_EvalObj(interp, scriptObj);
10853 /* Destroy the callframe */
10854 interp->framePtr = interp->framePtr->parent;
10855 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10857 return retcode;
10859 #endif
10861 /* Call a procedure implemented in Tcl.
10862 * It's possible to speed-up a lot this function, currently
10863 * the callframes are not cached, but allocated and
10864 * destroied every time. What is expecially costly is
10865 * to create/destroy the local vars hash table every time.
10867 * This can be fixed just implementing callframes caching
10868 * in JimCreateCallFrame() and JimFreeCallFrame(). */
10869 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv)
10871 Jim_CallFrame *callFramePtr;
10872 int i, d, retcode, optargs;
10873 ScriptObj *script;
10875 /* Check arity */
10876 if (argc - 1 < cmd->u.proc.reqArity ||
10877 (cmd->u.proc.argsPos < 0 && argc - 1 > cmd->u.proc.reqArity + cmd->u.proc.optArity)) {
10878 JimSetProcWrongArgs(interp, argv[0], cmd);
10879 return JIM_ERR;
10882 if (Jim_Length(cmd->u.proc.bodyObjPtr) == 0) {
10883 /* Optimise for procedure with no body - useful for optional debugging */
10884 return JIM_OK;
10887 /* Check if there are too nested calls */
10888 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10889 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10890 return JIM_ERR;
10893 /* Create a new callframe */
10894 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, cmd->u.proc.nsObj);
10895 callFramePtr->argv = argv;
10896 callFramePtr->argc = argc;
10897 callFramePtr->procArgsObjPtr = cmd->u.proc.argListObjPtr;
10898 callFramePtr->procBodyObjPtr = cmd->u.proc.bodyObjPtr;
10899 callFramePtr->staticVars = cmd->u.proc.staticVars;
10901 /* Remember where we were called from. */
10902 script = JimGetScript(interp, interp->currentScriptObj);
10903 callFramePtr->fileNameObj = script->fileNameObj;
10904 callFramePtr->line = script->linenr;
10906 Jim_IncrRefCount(cmd->u.proc.argListObjPtr);
10907 Jim_IncrRefCount(cmd->u.proc.bodyObjPtr);
10908 interp->framePtr = callFramePtr;
10910 /* How many optional args are available */
10911 optargs = (argc - 1 - cmd->u.proc.reqArity);
10913 /* Step 'i' along the actual args, and step 'd' along the formal args */
10914 i = 1;
10915 for (d = 0; d < cmd->u.proc.argListLen; d++) {
10916 Jim_Obj *nameObjPtr = cmd->u.proc.arglist[d].nameObjPtr;
10917 if (d == cmd->u.proc.argsPos) {
10918 /* assign $args */
10919 Jim_Obj *listObjPtr;
10920 int argsLen = 0;
10921 if (cmd->u.proc.reqArity + cmd->u.proc.optArity < argc - 1) {
10922 argsLen = argc - 1 - (cmd->u.proc.reqArity + cmd->u.proc.optArity);
10924 listObjPtr = Jim_NewListObj(interp, &argv[i], argsLen);
10926 /* It is possible to rename args. */
10927 if (cmd->u.proc.arglist[d].defaultObjPtr) {
10928 nameObjPtr =cmd->u.proc.arglist[d].defaultObjPtr;
10930 retcode = Jim_SetVariable(interp, nameObjPtr, listObjPtr);
10931 if (retcode != JIM_OK) {
10932 goto badargset;
10935 i += argsLen;
10936 continue;
10939 /* Optional or required? */
10940 if (cmd->u.proc.arglist[d].defaultObjPtr == NULL || optargs-- > 0) {
10941 retcode = JimSetProcArg(interp, nameObjPtr, argv[i++]);
10943 else {
10944 /* Ran out, so use the default */
10945 retcode = Jim_SetVariable(interp, nameObjPtr, cmd->u.proc.arglist[d].defaultObjPtr);
10947 if (retcode != JIM_OK) {
10948 goto badargset;
10952 /* Eval the body */
10953 retcode = Jim_EvalObj(interp, cmd->u.proc.bodyObjPtr);
10955 badargset:
10957 /* Invoke $jim::defer then destroy the callframe */
10958 retcode = JimInvokeDefer(interp, retcode);
10959 interp->framePtr = interp->framePtr->parent;
10960 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10962 /* Handle the JIM_RETURN return code */
10963 if (retcode == JIM_RETURN) {
10964 if (--interp->returnLevel <= 0) {
10965 retcode = interp->returnCode;
10966 interp->returnCode = JIM_OK;
10967 interp->returnLevel = 0;
10970 else if (retcode == JIM_ERR) {
10971 interp->addStackTrace++;
10972 Jim_DecrRefCount(interp, interp->errorProc);
10973 interp->errorProc = argv[0];
10974 Jim_IncrRefCount(interp->errorProc);
10977 return retcode;
10980 int Jim_EvalSource(Jim_Interp *interp, const char *filename, int lineno, const char *script)
10982 int retval;
10983 Jim_Obj *scriptObjPtr;
10985 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
10986 Jim_IncrRefCount(scriptObjPtr);
10988 if (filename) {
10989 Jim_Obj *prevScriptObj;
10991 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), lineno);
10993 prevScriptObj = interp->currentScriptObj;
10994 interp->currentScriptObj = scriptObjPtr;
10996 retval = Jim_EvalObj(interp, scriptObjPtr);
10998 interp->currentScriptObj = prevScriptObj;
11000 else {
11001 retval = Jim_EvalObj(interp, scriptObjPtr);
11003 Jim_DecrRefCount(interp, scriptObjPtr);
11004 return retval;
11007 int Jim_Eval(Jim_Interp *interp, const char *script)
11009 return Jim_EvalObj(interp, Jim_NewStringObj(interp, script, -1));
11012 /* Execute script in the scope of the global level */
11013 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
11015 int retval;
11016 Jim_CallFrame *savedFramePtr = interp->framePtr;
11018 interp->framePtr = interp->topFramePtr;
11019 retval = Jim_Eval(interp, script);
11020 interp->framePtr = savedFramePtr;
11022 return retval;
11025 int Jim_EvalFileGlobal(Jim_Interp *interp, const char *filename)
11027 int retval;
11028 Jim_CallFrame *savedFramePtr = interp->framePtr;
11030 interp->framePtr = interp->topFramePtr;
11031 retval = Jim_EvalFile(interp, filename);
11032 interp->framePtr = savedFramePtr;
11034 return retval;
11037 #include <sys/stat.h>
11039 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
11041 FILE *fp;
11042 char *buf;
11043 Jim_Obj *scriptObjPtr;
11044 Jim_Obj *prevScriptObj;
11045 struct stat sb;
11046 int retcode;
11047 int readlen;
11049 if (stat(filename, &sb) != 0 || (fp = fopen(filename, "rt")) == NULL) {
11050 Jim_SetResultFormatted(interp, "couldn't read file \"%s\": %s", filename, strerror(errno));
11051 return JIM_ERR;
11053 if (sb.st_size == 0) {
11054 fclose(fp);
11055 return JIM_OK;
11058 buf = Jim_Alloc(sb.st_size + 1);
11059 readlen = fread(buf, 1, sb.st_size, fp);
11060 if (ferror(fp)) {
11061 fclose(fp);
11062 Jim_Free(buf);
11063 Jim_SetResultFormatted(interp, "failed to load file \"%s\": %s", filename, strerror(errno));
11064 return JIM_ERR;
11066 fclose(fp);
11067 buf[readlen] = 0;
11069 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, buf, readlen);
11070 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), 1);
11071 Jim_IncrRefCount(scriptObjPtr);
11073 prevScriptObj = interp->currentScriptObj;
11074 interp->currentScriptObj = scriptObjPtr;
11076 retcode = Jim_EvalObj(interp, scriptObjPtr);
11078 /* Handle the JIM_RETURN return code */
11079 if (retcode == JIM_RETURN) {
11080 if (--interp->returnLevel <= 0) {
11081 retcode = interp->returnCode;
11082 interp->returnCode = JIM_OK;
11083 interp->returnLevel = 0;
11086 if (retcode == JIM_ERR) {
11087 /* EvalFile changes context, so add a stack frame here */
11088 interp->addStackTrace++;
11091 interp->currentScriptObj = prevScriptObj;
11093 Jim_DecrRefCount(interp, scriptObjPtr);
11095 return retcode;
11098 /* -----------------------------------------------------------------------------
11099 * Subst
11100 * ---------------------------------------------------------------------------*/
11101 static void JimParseSubst(struct JimParserCtx *pc, int flags)
11103 pc->tstart = pc->p;
11104 pc->tline = pc->linenr;
11106 if (pc->len == 0) {
11107 pc->tend = pc->p;
11108 pc->tt = JIM_TT_EOL;
11109 pc->eof = 1;
11110 return;
11112 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11113 JimParseCmd(pc);
11114 return;
11116 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11117 if (JimParseVar(pc) == JIM_OK) {
11118 return;
11120 /* Not a var, so treat as a string */
11121 pc->tstart = pc->p;
11122 flags |= JIM_SUBST_NOVAR;
11124 while (pc->len) {
11125 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11126 break;
11128 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11129 break;
11131 if (*pc->p == '\\' && pc->len > 1) {
11132 pc->p++;
11133 pc->len--;
11135 pc->p++;
11136 pc->len--;
11138 pc->tend = pc->p - 1;
11139 pc->tt = (flags & JIM_SUBST_NOESC) ? JIM_TT_STR : JIM_TT_ESC;
11142 /* The subst object type reuses most of the data structures and functions
11143 * of the script object. Script's data structures are a bit more complex
11144 * for what is needed for [subst]itution tasks, but the reuse helps to
11145 * deal with a single data structure at the cost of some more memory
11146 * usage for substitutions. */
11148 /* This method takes the string representation of an object
11149 * as a Tcl string where to perform [subst]itution, and generates
11150 * the pre-parsed internal representation. */
11151 static int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
11153 int scriptTextLen;
11154 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
11155 struct JimParserCtx parser;
11156 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
11157 ParseTokenList tokenlist;
11159 /* Initially parse the subst into tokens (in tokenlist) */
11160 ScriptTokenListInit(&tokenlist);
11162 JimParserInit(&parser, scriptText, scriptTextLen, 1);
11163 while (1) {
11164 JimParseSubst(&parser, flags);
11165 if (parser.eof) {
11166 /* Note that subst doesn't need the EOL token */
11167 break;
11169 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
11170 parser.tline);
11173 /* Create the "real" subst/script tokens from the initial token list */
11174 script->inUse = 1;
11175 script->substFlags = flags;
11176 script->fileNameObj = interp->emptyObj;
11177 Jim_IncrRefCount(script->fileNameObj);
11178 SubstObjAddTokens(interp, script, &tokenlist);
11180 /* No longer need the token list */
11181 ScriptTokenListFree(&tokenlist);
11183 #ifdef DEBUG_SHOW_SUBST
11185 int i;
11187 printf("==== Subst ====\n");
11188 for (i = 0; i < script->len; i++) {
11189 printf("[%2d] %s '%s'\n", i, jim_tt_name(script->token[i].type),
11190 Jim_String(script->token[i].objPtr));
11193 #endif
11195 /* Free the old internal rep and set the new one. */
11196 Jim_FreeIntRep(interp, objPtr);
11197 Jim_SetIntRepPtr(objPtr, script);
11198 objPtr->typePtr = &scriptObjType;
11199 return JIM_OK;
11202 static ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
11204 if (objPtr->typePtr != &scriptObjType || ((ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags != flags)
11205 SetSubstFromAny(interp, objPtr, flags);
11206 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
11209 /* Performs commands,variables,blackslashes substitution,
11210 * storing the result object (with refcount 0) into
11211 * resObjPtrPtr. */
11212 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr, Jim_Obj **resObjPtrPtr, int flags)
11214 ScriptObj *script;
11216 JimPanic((substObjPtr->refCount == 0, "Jim_SubstObj() called with zero refcount object"));
11218 script = Jim_GetSubst(interp, substObjPtr, flags);
11220 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
11221 /* In order to preserve the internal rep, we increment the
11222 * inUse field of the script internal rep structure. */
11223 script->inUse++;
11225 *resObjPtrPtr = JimInterpolateTokens(interp, script->token, script->len, flags);
11227 script->inUse--;
11228 Jim_DecrRefCount(interp, substObjPtr);
11229 if (*resObjPtrPtr == NULL) {
11230 return JIM_ERR;
11232 return JIM_OK;
11235 /* -----------------------------------------------------------------------------
11236 * Core commands utility functions
11237 * ---------------------------------------------------------------------------*/
11238 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv, const char *msg)
11240 Jim_Obj *objPtr;
11241 Jim_Obj *listObjPtr;
11243 JimPanic((argc == 0, "Jim_WrongNumArgs() called with argc=0"));
11245 listObjPtr = Jim_NewListObj(interp, argv, argc);
11247 if (msg && *msg) {
11248 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, msg, -1));
11250 Jim_IncrRefCount(listObjPtr);
11251 objPtr = Jim_ListJoin(interp, listObjPtr, " ", 1);
11252 Jim_DecrRefCount(interp, listObjPtr);
11254 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s\"", objPtr);
11258 * May add the key and/or value to the list.
11260 typedef void JimHashtableIteratorCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr,
11261 Jim_HashEntry *he, int type);
11263 #define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL)
11266 * For each key of the hash table 'ht' with object keys that
11267 * matches the glob pattern (all if NULL), invoke the callback to add entries to a list.
11268 * Returns the list.
11270 static Jim_Obj *JimHashtablePatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
11271 JimHashtableIteratorCallbackType *callback, int type)
11273 Jim_HashEntry *he;
11274 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
11276 /* Check for the non-pattern case. We can do this much more efficiently. */
11277 if (patternObjPtr && JimTrivialMatch(Jim_String(patternObjPtr))) {
11278 he = Jim_FindHashEntry(ht, patternObjPtr);
11279 if (he) {
11280 callback(interp, listObjPtr, he, type);
11283 else {
11284 Jim_HashTableIterator htiter;
11285 JimInitHashTableIterator(ht, &htiter);
11286 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
11287 if (!patternObjPtr || Jim_StringMatchObj(interp, patternObjPtr, he->key, 0)) {
11288 callback(interp, listObjPtr, he, type);
11292 return listObjPtr;
11295 /* Keep these in order */
11296 #define JIM_CMDLIST_COMMANDS 0
11297 #define JIM_CMDLIST_PROCS 1
11298 #define JIM_CMDLIST_CHANNELS 2
11301 * Adds matching command names (procs, channels) to the list.
11303 static void JimCommandMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11304 Jim_HashEntry *he, int type)
11306 Jim_Cmd *cmdPtr = Jim_GetHashEntryVal(he);
11307 Jim_Obj *objPtr;
11309 if (type == JIM_CMDLIST_PROCS && !cmdPtr->isproc) {
11310 /* not a proc */
11311 return;
11314 objPtr = (Jim_Obj *)he->key;
11315 Jim_IncrRefCount(objPtr);
11317 if (type != JIM_CMDLIST_CHANNELS || Jim_AioFilehandle(interp, objPtr)) {
11318 Jim_ListAppendElement(interp, listObjPtr, objPtr);
11320 Jim_DecrRefCount(interp, objPtr);
11323 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int type)
11325 return JimHashtablePatternMatch(interp, &interp->commands, patternObjPtr, JimCommandMatch, type);
11328 /* Keep these in order */
11329 #define JIM_VARLIST_GLOBALS 0
11330 #define JIM_VARLIST_LOCALS 1
11331 #define JIM_VARLIST_VARS 2
11332 #define JIM_VARLIST_MASK 0x000f
11334 #define JIM_VARLIST_VALUES 0x1000
11337 * Adds matching variable names to the list.
11339 static void JimVariablesMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11340 Jim_HashEntry *he, int type)
11342 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
11344 if ((type & JIM_VARLIST_MASK) != JIM_VARLIST_LOCALS || varPtr->linkFramePtr == NULL) {
11345 Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->key);
11346 if (type & JIM_VARLIST_VALUES) {
11347 Jim_ListAppendElement(interp, listObjPtr, varPtr->objPtr);
11352 /* mode is JIM_VARLIST_xxx */
11353 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int mode)
11355 if (mode == JIM_VARLIST_LOCALS && interp->framePtr == interp->topFramePtr) {
11356 /* For [info locals], if we are at top level an empty list
11357 * is returned. I don't agree, but we aim at compatibility (SS) */
11358 return interp->emptyObj;
11360 else {
11361 Jim_CallFrame *framePtr = (mode == JIM_VARLIST_GLOBALS) ? interp->topFramePtr : interp->framePtr;
11362 return JimHashtablePatternMatch(interp, &framePtr->vars, patternObjPtr, JimVariablesMatch,
11363 mode);
11367 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
11368 Jim_Obj **objPtrPtr, int info_level_cmd)
11370 Jim_CallFrame *targetCallFrame;
11372 targetCallFrame = JimGetCallFrameByInteger(interp, levelObjPtr);
11373 if (targetCallFrame == NULL) {
11374 return JIM_ERR;
11376 /* No proc call at toplevel callframe */
11377 if (targetCallFrame == interp->topFramePtr) {
11378 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
11379 return JIM_ERR;
11381 if (info_level_cmd) {
11382 *objPtrPtr = Jim_NewListObj(interp, targetCallFrame->argv, targetCallFrame->argc);
11384 else {
11385 Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0);
11387 Jim_ListAppendElement(interp, listObj, targetCallFrame->argv[0]);
11388 Jim_ListAppendElement(interp, listObj, targetCallFrame->fileNameObj);
11389 Jim_ListAppendElement(interp, listObj, Jim_NewIntObj(interp, targetCallFrame->line));
11390 *objPtrPtr = listObj;
11392 return JIM_OK;
11395 /* -----------------------------------------------------------------------------
11396 * Core commands
11397 * ---------------------------------------------------------------------------*/
11399 /* fake [puts] -- not the real puts, just for debugging. */
11400 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11402 if (argc != 2 && argc != 3) {
11403 Jim_WrongNumArgs(interp, 1, argv, "?-nonewline? string");
11404 return JIM_ERR;
11406 if (argc == 3) {
11407 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline")) {
11408 Jim_SetResultString(interp, "The second argument must " "be -nonewline", -1);
11409 return JIM_ERR;
11411 else {
11412 fputs(Jim_String(argv[2]), stdout);
11415 else {
11416 puts(Jim_String(argv[1]));
11418 return JIM_OK;
11421 /* Helper for [+] and [*] */
11422 static int JimAddMulHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11424 jim_wide wideValue, res;
11425 double doubleValue, doubleRes;
11426 int i;
11428 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
11430 for (i = 1; i < argc; i++) {
11431 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
11432 goto trydouble;
11433 if (op == JIM_EXPROP_ADD)
11434 res += wideValue;
11435 else
11436 res *= wideValue;
11438 Jim_SetResultInt(interp, res);
11439 return JIM_OK;
11440 trydouble:
11441 doubleRes = (double)res;
11442 for (; i < argc; i++) {
11443 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11444 return JIM_ERR;
11445 if (op == JIM_EXPROP_ADD)
11446 doubleRes += doubleValue;
11447 else
11448 doubleRes *= doubleValue;
11450 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11451 return JIM_OK;
11454 /* Helper for [-] and [/] */
11455 static int JimSubDivHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11457 jim_wide wideValue, res = 0;
11458 double doubleValue, doubleRes = 0;
11459 int i = 2;
11461 if (argc < 2) {
11462 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
11463 return JIM_ERR;
11465 else if (argc == 2) {
11466 /* The arity = 2 case is different. For [- x] returns -x,
11467 * while [/ x] returns 1/x. */
11468 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
11469 if (Jim_GetDouble(interp, argv[1], &doubleValue) != JIM_OK) {
11470 return JIM_ERR;
11472 else {
11473 if (op == JIM_EXPROP_SUB)
11474 doubleRes = -doubleValue;
11475 else
11476 doubleRes = 1.0 / doubleValue;
11477 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11478 return JIM_OK;
11481 if (op == JIM_EXPROP_SUB) {
11482 res = -wideValue;
11483 Jim_SetResultInt(interp, res);
11485 else {
11486 doubleRes = 1.0 / wideValue;
11487 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11489 return JIM_OK;
11491 else {
11492 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
11493 if (Jim_GetDouble(interp, argv[1], &doubleRes)
11494 != JIM_OK) {
11495 return JIM_ERR;
11497 else {
11498 goto trydouble;
11502 for (i = 2; i < argc; i++) {
11503 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
11504 doubleRes = (double)res;
11505 goto trydouble;
11507 if (op == JIM_EXPROP_SUB)
11508 res -= wideValue;
11509 else {
11510 if (wideValue == 0) {
11511 Jim_SetResultString(interp, "Division by zero", -1);
11512 return JIM_ERR;
11514 res /= wideValue;
11517 Jim_SetResultInt(interp, res);
11518 return JIM_OK;
11519 trydouble:
11520 for (; i < argc; i++) {
11521 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11522 return JIM_ERR;
11523 if (op == JIM_EXPROP_SUB)
11524 doubleRes -= doubleValue;
11525 else
11526 doubleRes /= doubleValue;
11528 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11529 return JIM_OK;
11533 /* [+] */
11534 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11536 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
11539 /* [*] */
11540 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11542 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
11545 /* [-] */
11546 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11548 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
11551 /* [/] */
11552 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11554 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
11557 /* [set] */
11558 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11560 if (argc != 2 && argc != 3) {
11561 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
11562 return JIM_ERR;
11564 if (argc == 2) {
11565 Jim_Obj *objPtr;
11567 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11568 if (!objPtr)
11569 return JIM_ERR;
11570 Jim_SetResult(interp, objPtr);
11571 return JIM_OK;
11573 /* argc == 3 case. */
11574 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
11575 return JIM_ERR;
11576 Jim_SetResult(interp, argv[2]);
11577 return JIM_OK;
11580 /* [unset]
11582 * unset ?-nocomplain? ?--? ?varName ...?
11584 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11586 int i = 1;
11587 int complain = 1;
11589 while (i < argc) {
11590 if (Jim_CompareStringImmediate(interp, argv[i], "--")) {
11591 i++;
11592 break;
11594 if (Jim_CompareStringImmediate(interp, argv[i], "-nocomplain")) {
11595 complain = 0;
11596 i++;
11597 continue;
11599 break;
11602 while (i < argc) {
11603 if (Jim_UnsetVariable(interp, argv[i], complain ? JIM_ERRMSG : JIM_NONE) != JIM_OK
11604 && complain) {
11605 return JIM_ERR;
11607 i++;
11609 return JIM_OK;
11612 /* [while] */
11613 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11615 if (argc != 3) {
11616 Jim_WrongNumArgs(interp, 1, argv, "condition body");
11617 return JIM_ERR;
11620 /* The general purpose implementation of while starts here */
11621 while (1) {
11622 int boolean, retval;
11624 if ((retval = Jim_GetBoolFromExpr(interp, argv[1], &boolean)) != JIM_OK)
11625 return retval;
11626 if (!boolean)
11627 break;
11629 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
11630 switch (retval) {
11631 case JIM_BREAK:
11632 goto out;
11633 break;
11634 case JIM_CONTINUE:
11635 continue;
11636 break;
11637 default:
11638 return retval;
11642 out:
11643 Jim_SetEmptyResult(interp);
11644 return JIM_OK;
11647 /* [for] */
11648 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11650 int retval;
11651 int boolean = 1;
11652 Jim_Obj *varNamePtr = NULL;
11653 Jim_Obj *stopVarNamePtr = NULL;
11655 if (argc != 5) {
11656 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
11657 return JIM_ERR;
11660 /* Do the initialisation */
11661 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK) {
11662 return retval;
11665 /* And do the first test now. Better for optimisation
11666 * if we can do next/test at the bottom of the loop
11668 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11670 /* Ready to do the body as follows:
11671 * while (1) {
11672 * body // check retcode
11673 * next // check retcode
11674 * test // check retcode/test bool
11678 #ifdef JIM_OPTIMIZATION
11679 /* Check if the for is on the form:
11680 * for ... {$i < CONST} {incr i}
11681 * for ... {$i < $j} {incr i}
11683 if (retval == JIM_OK && boolean) {
11684 ScriptObj *incrScript;
11685 struct ExprTree *expr;
11686 jim_wide stop, currentVal;
11687 Jim_Obj *objPtr;
11688 int cmpOffset;
11690 /* Do it only if there aren't shared arguments */
11691 expr = JimGetExpression(interp, argv[2]);
11692 incrScript = JimGetScript(interp, argv[3]);
11694 /* Ensure proper lengths to start */
11695 if (incrScript == NULL || incrScript->len != 3 || !expr || expr->len != 3) {
11696 goto evalstart;
11698 /* Ensure proper token types. */
11699 if (incrScript->token[1].type != JIM_TT_ESC) {
11700 goto evalstart;
11703 if (expr->expr->type == JIM_EXPROP_LT) {
11704 cmpOffset = 0;
11706 else if (expr->expr->type == JIM_EXPROP_LTE) {
11707 cmpOffset = 1;
11709 else {
11710 goto evalstart;
11713 if (expr->expr->left->type != JIM_TT_VAR) {
11714 goto evalstart;
11717 if (expr->expr->right->type != JIM_TT_VAR && expr->expr->right->type != JIM_TT_EXPR_INT) {
11718 goto evalstart;
11721 /* Update command must be incr */
11722 if (!Jim_CompareStringImmediate(interp, incrScript->token[1].objPtr, "incr")) {
11723 goto evalstart;
11726 /* incr, expression must be about the same variable */
11727 if (!Jim_StringEqObj(incrScript->token[2].objPtr, expr->expr->left->objPtr)) {
11728 goto evalstart;
11731 /* Get the stop condition (must be a variable or integer) */
11732 if (expr->expr->right->type == JIM_TT_EXPR_INT) {
11733 if (Jim_GetWide(interp, expr->expr->right->objPtr, &stop) == JIM_ERR) {
11734 goto evalstart;
11737 else {
11738 stopVarNamePtr = expr->expr->right->objPtr;
11739 Jim_IncrRefCount(stopVarNamePtr);
11740 /* Keep the compiler happy */
11741 stop = 0;
11744 /* Initialization */
11745 varNamePtr = expr->expr->left->objPtr;
11746 Jim_IncrRefCount(varNamePtr);
11748 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
11749 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK) {
11750 goto testcond;
11753 /* --- OPTIMIZED FOR --- */
11754 while (retval == JIM_OK) {
11755 /* === Check condition === */
11756 /* Note that currentVal is already set here */
11758 /* Immediate or Variable? get the 'stop' value if the latter. */
11759 if (stopVarNamePtr) {
11760 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
11761 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &stop) != JIM_OK) {
11762 goto testcond;
11766 if (currentVal >= stop + cmpOffset) {
11767 break;
11770 /* Eval body */
11771 retval = Jim_EvalObj(interp, argv[4]);
11772 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11773 retval = JIM_OK;
11775 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
11777 /* Increment */
11778 if (objPtr == NULL) {
11779 retval = JIM_ERR;
11780 goto out;
11782 if (!Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11783 currentVal = ++JimWideValue(objPtr);
11784 Jim_InvalidateStringRep(objPtr);
11786 else {
11787 if (Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK ||
11788 Jim_SetVariable(interp, varNamePtr, Jim_NewIntObj(interp,
11789 ++currentVal)) != JIM_OK) {
11790 goto evalnext;
11795 goto out;
11797 evalstart:
11798 #endif
11800 while (boolean && (retval == JIM_OK || retval == JIM_CONTINUE)) {
11801 /* Body */
11802 retval = Jim_EvalObj(interp, argv[4]);
11804 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11805 /* increment */
11806 JIM_IF_OPTIM(evalnext:)
11807 retval = Jim_EvalObj(interp, argv[3]);
11808 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11809 /* test */
11810 JIM_IF_OPTIM(testcond:)
11811 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11815 JIM_IF_OPTIM(out:)
11816 if (stopVarNamePtr) {
11817 Jim_DecrRefCount(interp, stopVarNamePtr);
11819 if (varNamePtr) {
11820 Jim_DecrRefCount(interp, varNamePtr);
11823 if (retval == JIM_CONTINUE || retval == JIM_BREAK || retval == JIM_OK) {
11824 Jim_SetEmptyResult(interp);
11825 return JIM_OK;
11828 return retval;
11831 /* [loop] */
11832 static int Jim_LoopCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11834 int retval;
11835 jim_wide i;
11836 jim_wide limit;
11837 jim_wide incr = 1;
11838 Jim_Obj *bodyObjPtr;
11840 if (argc != 5 && argc != 6) {
11841 Jim_WrongNumArgs(interp, 1, argv, "var first limit ?incr? body");
11842 return JIM_ERR;
11845 if (Jim_GetWide(interp, argv[2], &i) != JIM_OK ||
11846 Jim_GetWide(interp, argv[3], &limit) != JIM_OK ||
11847 (argc == 6 && Jim_GetWide(interp, argv[4], &incr) != JIM_OK)) {
11848 return JIM_ERR;
11850 bodyObjPtr = (argc == 5) ? argv[4] : argv[5];
11852 retval = Jim_SetVariable(interp, argv[1], argv[2]);
11854 while (((i < limit && incr > 0) || (i > limit && incr < 0)) && retval == JIM_OK) {
11855 retval = Jim_EvalObj(interp, bodyObjPtr);
11856 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11857 Jim_Obj *objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11859 retval = JIM_OK;
11861 /* Increment */
11862 i += incr;
11864 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11865 if (argv[1]->typePtr != &variableObjType) {
11866 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11867 return JIM_ERR;
11870 JimWideValue(objPtr) = i;
11871 Jim_InvalidateStringRep(objPtr);
11873 /* The following step is required in order to invalidate the
11874 * string repr of "FOO" if the var name is of the form of "FOO(IDX)" */
11875 if (argv[1]->typePtr != &variableObjType) {
11876 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11877 retval = JIM_ERR;
11878 break;
11882 else {
11883 objPtr = Jim_NewIntObj(interp, i);
11884 retval = Jim_SetVariable(interp, argv[1], objPtr);
11885 if (retval != JIM_OK) {
11886 Jim_FreeNewObj(interp, objPtr);
11892 if (retval == JIM_OK || retval == JIM_CONTINUE || retval == JIM_BREAK) {
11893 Jim_SetEmptyResult(interp);
11894 return JIM_OK;
11896 return retval;
11899 /* List iterators make it easy to iterate over a list.
11900 * At some point iterators will be expanded to support generators.
11902 typedef struct {
11903 Jim_Obj *objPtr;
11904 int idx;
11905 } Jim_ListIter;
11908 * Initialise the iterator at the start of the list.
11910 static void JimListIterInit(Jim_ListIter *iter, Jim_Obj *objPtr)
11912 iter->objPtr = objPtr;
11913 iter->idx = 0;
11917 * Returns the next object from the list, or NULL on end-of-list.
11919 static Jim_Obj *JimListIterNext(Jim_Interp *interp, Jim_ListIter *iter)
11921 if (iter->idx >= Jim_ListLength(interp, iter->objPtr)) {
11922 return NULL;
11924 return iter->objPtr->internalRep.listValue.ele[iter->idx++];
11928 * Returns 1 if end-of-list has been reached.
11930 static int JimListIterDone(Jim_Interp *interp, Jim_ListIter *iter)
11932 return iter->idx >= Jim_ListLength(interp, iter->objPtr);
11935 /* foreach + lmap implementation. */
11936 static int JimForeachMapHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int doMap)
11938 int result = JIM_OK;
11939 int i, numargs;
11940 Jim_ListIter twoiters[2]; /* Avoid allocation for a single list */
11941 Jim_ListIter *iters;
11942 Jim_Obj *script;
11943 Jim_Obj *resultObj;
11945 if (argc < 4 || argc % 2 != 0) {
11946 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
11947 return JIM_ERR;
11949 script = argv[argc - 1]; /* Last argument is a script */
11950 numargs = (argc - 1 - 1); /* argc - 'foreach' - script */
11952 if (numargs == 2) {
11953 iters = twoiters;
11955 else {
11956 iters = Jim_Alloc(numargs * sizeof(*iters));
11958 for (i = 0; i < numargs; i++) {
11959 JimListIterInit(&iters[i], argv[i + 1]);
11960 if (i % 2 == 0 && JimListIterDone(interp, &iters[i])) {
11961 result = JIM_ERR;
11964 if (result != JIM_OK) {
11965 Jim_SetResultString(interp, "foreach varlist is empty", -1);
11966 goto empty_varlist;
11969 if (doMap) {
11970 resultObj = Jim_NewListObj(interp, NULL, 0);
11972 else {
11973 resultObj = interp->emptyObj;
11975 Jim_IncrRefCount(resultObj);
11977 while (1) {
11978 /* Have we expired all lists? */
11979 for (i = 0; i < numargs; i += 2) {
11980 if (!JimListIterDone(interp, &iters[i + 1])) {
11981 break;
11984 if (i == numargs) {
11985 /* All done */
11986 break;
11989 /* For each list */
11990 for (i = 0; i < numargs; i += 2) {
11991 Jim_Obj *varName;
11993 /* foreach var */
11994 JimListIterInit(&iters[i], argv[i + 1]);
11995 while ((varName = JimListIterNext(interp, &iters[i])) != NULL) {
11996 Jim_Obj *valObj = JimListIterNext(interp, &iters[i + 1]);
11997 if (!valObj) {
11998 /* Ran out, so store the empty string */
11999 valObj = interp->emptyObj;
12001 /* Avoid shimmering */
12002 Jim_IncrRefCount(valObj);
12003 result = Jim_SetVariable(interp, varName, valObj);
12004 Jim_DecrRefCount(interp, valObj);
12005 if (result != JIM_OK) {
12006 goto err;
12010 switch (result = Jim_EvalObj(interp, script)) {
12011 case JIM_OK:
12012 if (doMap) {
12013 Jim_ListAppendElement(interp, resultObj, interp->result);
12015 break;
12016 case JIM_CONTINUE:
12017 break;
12018 case JIM_BREAK:
12019 goto out;
12020 default:
12021 goto err;
12024 out:
12025 result = JIM_OK;
12026 Jim_SetResult(interp, resultObj);
12027 err:
12028 Jim_DecrRefCount(interp, resultObj);
12029 empty_varlist:
12030 if (numargs > 2) {
12031 Jim_Free(iters);
12033 return result;
12036 /* [foreach] */
12037 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12039 return JimForeachMapHelper(interp, argc, argv, 0);
12042 /* [lmap] */
12043 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12045 return JimForeachMapHelper(interp, argc, argv, 1);
12048 /* [lassign] */
12049 static int Jim_LassignCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12051 int result = JIM_ERR;
12052 int i;
12053 Jim_ListIter iter;
12054 Jim_Obj *resultObj;
12056 if (argc < 2) {
12057 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varName ...?");
12058 return JIM_ERR;
12061 JimListIterInit(&iter, argv[1]);
12063 for (i = 2; i < argc; i++) {
12064 Jim_Obj *valObj = JimListIterNext(interp, &iter);
12065 result = Jim_SetVariable(interp, argv[i], valObj ? valObj : interp->emptyObj);
12066 if (result != JIM_OK) {
12067 return result;
12071 resultObj = Jim_NewListObj(interp, NULL, 0);
12072 while (!JimListIterDone(interp, &iter)) {
12073 Jim_ListAppendElement(interp, resultObj, JimListIterNext(interp, &iter));
12076 Jim_SetResult(interp, resultObj);
12078 return JIM_OK;
12081 /* [if] */
12082 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12084 int boolean, retval, current = 1, falsebody = 0;
12086 if (argc >= 3) {
12087 while (1) {
12088 /* Far not enough arguments given! */
12089 if (current >= argc)
12090 goto err;
12091 if ((retval = Jim_GetBoolFromExpr(interp, argv[current++], &boolean))
12092 != JIM_OK)
12093 return retval;
12094 /* There lacks something, isn't it? */
12095 if (current >= argc)
12096 goto err;
12097 if (Jim_CompareStringImmediate(interp, argv[current], "then"))
12098 current++;
12099 /* Tsk tsk, no then-clause? */
12100 if (current >= argc)
12101 goto err;
12102 if (boolean)
12103 return Jim_EvalObj(interp, argv[current]);
12104 /* Ok: no else-clause follows */
12105 if (++current >= argc) {
12106 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
12107 return JIM_OK;
12109 falsebody = current++;
12110 if (Jim_CompareStringImmediate(interp, argv[falsebody], "else")) {
12111 /* IIICKS - else-clause isn't last cmd? */
12112 if (current != argc - 1)
12113 goto err;
12114 return Jim_EvalObj(interp, argv[current]);
12116 else if (Jim_CompareStringImmediate(interp, argv[falsebody], "elseif"))
12117 /* Ok: elseif follows meaning all the stuff
12118 * again (how boring...) */
12119 continue;
12120 /* OOPS - else-clause is not last cmd? */
12121 else if (falsebody != argc - 1)
12122 goto err;
12123 return Jim_EvalObj(interp, argv[falsebody]);
12125 return JIM_OK;
12127 err:
12128 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
12129 return JIM_ERR;
12133 /* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)
12134 * flags may contain JIM_NOCASE and/or JIM_OPT_END
12136 int Jim_CommandMatchObj(Jim_Interp *interp, Jim_Obj *commandObj, Jim_Obj *patternObj,
12137 Jim_Obj *stringObj, int flags)
12139 Jim_Obj *parms[5];
12140 int argc = 0;
12141 long eq;
12142 int rc;
12144 parms[argc++] = commandObj;
12145 if (flags & JIM_NOCASE) {
12146 parms[argc++] = Jim_NewStringObj(interp, "-nocase", -1);
12148 if (flags & JIM_OPT_END) {
12149 parms[argc++] = Jim_NewStringObj(interp, "--", -1);
12151 parms[argc++] = patternObj;
12152 parms[argc++] = stringObj;
12154 rc = Jim_EvalObjVector(interp, argc, parms);
12156 if (rc != JIM_OK || Jim_GetLong(interp, Jim_GetResult(interp), &eq) != JIM_OK) {
12157 eq = -rc;
12160 return eq;
12163 /* [switch] */
12164 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12166 enum { SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD };
12167 int matchOpt = SWITCH_EXACT, opt = 1, patCount, i;
12168 int match_flags = 0;
12169 Jim_Obj *command = NULL, *scriptObj = NULL, *strObj;
12170 Jim_Obj **caseList;
12172 if (argc < 3) {
12173 wrongnumargs:
12174 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
12175 "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}");
12176 return JIM_ERR;
12178 for (opt = 1; opt < argc; ++opt) {
12179 const char *option = Jim_String(argv[opt]);
12181 if (*option != '-')
12182 break;
12183 else if (strncmp(option, "--", 2) == 0) {
12184 ++opt;
12185 break;
12187 else if (strncmp(option, "-exact", 2) == 0)
12188 matchOpt = SWITCH_EXACT;
12189 else if (strncmp(option, "-glob", 2) == 0)
12190 matchOpt = SWITCH_GLOB;
12191 else if (strncmp(option, "-regexp", 2) == 0) {
12192 matchOpt = SWITCH_RE;
12193 match_flags |= JIM_OPT_END;
12195 else if (strncmp(option, "-command", 2) == 0) {
12196 matchOpt = SWITCH_CMD;
12197 if ((argc - opt) < 2)
12198 goto wrongnumargs;
12199 command = argv[++opt];
12201 else {
12202 Jim_SetResultFormatted(interp,
12203 "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --",
12204 argv[opt]);
12205 return JIM_ERR;
12207 if ((argc - opt) < 2)
12208 goto wrongnumargs;
12210 strObj = argv[opt++];
12211 patCount = argc - opt;
12212 if (patCount == 1) {
12213 JimListGetElements(interp, argv[opt], &patCount, &caseList);
12215 else
12216 caseList = (Jim_Obj **)&argv[opt];
12217 if (patCount == 0 || patCount % 2 != 0)
12218 goto wrongnumargs;
12219 for (i = 0; scriptObj == NULL && i < patCount; i += 2) {
12220 Jim_Obj *patObj = caseList[i];
12222 if (!Jim_CompareStringImmediate(interp, patObj, "default")
12223 || i < (patCount - 2)) {
12224 switch (matchOpt) {
12225 case SWITCH_EXACT:
12226 if (Jim_StringEqObj(strObj, patObj))
12227 scriptObj = caseList[i + 1];
12228 break;
12229 case SWITCH_GLOB:
12230 if (Jim_StringMatchObj(interp, patObj, strObj, 0))
12231 scriptObj = caseList[i + 1];
12232 break;
12233 case SWITCH_RE:
12234 command = Jim_NewStringObj(interp, "regexp", -1);
12235 /* Fall thru intentionally */
12236 case SWITCH_CMD:{
12237 int rc = Jim_CommandMatchObj(interp, command, patObj, strObj, match_flags);
12239 /* After the execution of a command we need to
12240 * make sure to reconvert the object into a list
12241 * again. Only for the single-list style [switch]. */
12242 if (argc - opt == 1) {
12243 JimListGetElements(interp, argv[opt], &patCount, &caseList);
12245 /* command is here already decref'd */
12246 if (rc < 0) {
12247 return -rc;
12249 if (rc)
12250 scriptObj = caseList[i + 1];
12251 break;
12255 else {
12256 scriptObj = caseList[i + 1];
12259 for (; i < patCount && Jim_CompareStringImmediate(interp, scriptObj, "-"); i += 2)
12260 scriptObj = caseList[i + 1];
12261 if (scriptObj && Jim_CompareStringImmediate(interp, scriptObj, "-")) {
12262 Jim_SetResultFormatted(interp, "no body specified for pattern \"%#s\"", caseList[i - 2]);
12263 return JIM_ERR;
12265 Jim_SetEmptyResult(interp);
12266 if (scriptObj) {
12267 return Jim_EvalObj(interp, scriptObj);
12269 return JIM_OK;
12272 /* [list] */
12273 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12275 Jim_Obj *listObjPtr;
12277 listObjPtr = Jim_NewListObj(interp, argv + 1, argc - 1);
12278 Jim_SetResult(interp, listObjPtr);
12279 return JIM_OK;
12282 /* [lindex] */
12283 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12285 Jim_Obj *objPtr, *listObjPtr;
12286 int i;
12287 int idx;
12289 if (argc < 2) {
12290 Jim_WrongNumArgs(interp, 1, argv, "list ?index ...?");
12291 return JIM_ERR;
12293 objPtr = argv[1];
12294 Jim_IncrRefCount(objPtr);
12295 for (i = 2; i < argc; i++) {
12296 listObjPtr = objPtr;
12297 if (Jim_GetIndex(interp, argv[i], &idx) != JIM_OK) {
12298 Jim_DecrRefCount(interp, listObjPtr);
12299 return JIM_ERR;
12301 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_NONE) != JIM_OK) {
12302 /* Returns an empty object if the index
12303 * is out of range. */
12304 Jim_DecrRefCount(interp, listObjPtr);
12305 Jim_SetEmptyResult(interp);
12306 return JIM_OK;
12308 Jim_IncrRefCount(objPtr);
12309 Jim_DecrRefCount(interp, listObjPtr);
12311 Jim_SetResult(interp, objPtr);
12312 Jim_DecrRefCount(interp, objPtr);
12313 return JIM_OK;
12316 /* [llength] */
12317 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12319 if (argc != 2) {
12320 Jim_WrongNumArgs(interp, 1, argv, "list");
12321 return JIM_ERR;
12323 Jim_SetResultInt(interp, Jim_ListLength(interp, argv[1]));
12324 return JIM_OK;
12327 /* [lsearch] */
12328 static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12330 static const char * const options[] = {
12331 "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
12332 NULL
12334 enum
12335 { OPT_BOOL, OPT_NOT, OPT_NOCASE, OPT_EXACT, OPT_GLOB, OPT_REGEXP, OPT_ALL, OPT_INLINE,
12336 OPT_COMMAND };
12337 int i;
12338 int opt_bool = 0;
12339 int opt_not = 0;
12340 int opt_all = 0;
12341 int opt_inline = 0;
12342 int opt_match = OPT_EXACT;
12343 int listlen;
12344 int rc = JIM_OK;
12345 Jim_Obj *listObjPtr = NULL;
12346 Jim_Obj *commandObj = NULL;
12347 int match_flags = 0;
12349 if (argc < 3) {
12350 wrongargs:
12351 Jim_WrongNumArgs(interp, 1, argv,
12352 "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
12353 return JIM_ERR;
12356 for (i = 1; i < argc - 2; i++) {
12357 int option;
12359 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG) != JIM_OK) {
12360 return JIM_ERR;
12362 switch (option) {
12363 case OPT_BOOL:
12364 opt_bool = 1;
12365 opt_inline = 0;
12366 break;
12367 case OPT_NOT:
12368 opt_not = 1;
12369 break;
12370 case OPT_NOCASE:
12371 match_flags |= JIM_NOCASE;
12372 break;
12373 case OPT_INLINE:
12374 opt_inline = 1;
12375 opt_bool = 0;
12376 break;
12377 case OPT_ALL:
12378 opt_all = 1;
12379 break;
12380 case OPT_REGEXP:
12381 opt_match = option;
12382 match_flags |= JIM_OPT_END;
12383 break;
12384 case OPT_COMMAND:
12385 if (i >= argc - 2) {
12386 goto wrongargs;
12388 commandObj = argv[++i];
12389 /* fallthru */
12390 case OPT_EXACT:
12391 case OPT_GLOB:
12392 opt_match = option;
12393 break;
12397 argc -= i;
12398 if (argc < 2) {
12399 goto wrongargs;
12401 argv += i;
12403 if (opt_all) {
12404 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12406 if (opt_match == OPT_REGEXP) {
12407 commandObj = Jim_NewStringObj(interp, "regexp", -1);
12409 if (commandObj) {
12410 Jim_IncrRefCount(commandObj);
12413 listlen = Jim_ListLength(interp, argv[0]);
12414 for (i = 0; i < listlen; i++) {
12415 int eq = 0;
12416 Jim_Obj *objPtr = Jim_ListGetIndex(interp, argv[0], i);
12418 switch (opt_match) {
12419 case OPT_EXACT:
12420 eq = Jim_StringCompareObj(interp, argv[1], objPtr, match_flags) == 0;
12421 break;
12423 case OPT_GLOB:
12424 eq = Jim_StringMatchObj(interp, argv[1], objPtr, match_flags);
12425 break;
12427 case OPT_REGEXP:
12428 case OPT_COMMAND:
12429 eq = Jim_CommandMatchObj(interp, commandObj, argv[1], objPtr, match_flags);
12430 if (eq < 0) {
12431 if (listObjPtr) {
12432 Jim_FreeNewObj(interp, listObjPtr);
12434 rc = JIM_ERR;
12435 goto done;
12437 break;
12440 /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
12441 if (!eq && opt_bool && opt_not && !opt_all) {
12442 continue;
12445 if ((!opt_bool && eq == !opt_not) || (opt_bool && (eq || opt_all))) {
12446 /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
12447 Jim_Obj *resultObj;
12449 if (opt_bool) {
12450 resultObj = Jim_NewIntObj(interp, eq ^ opt_not);
12452 else if (!opt_inline) {
12453 resultObj = Jim_NewIntObj(interp, i);
12455 else {
12456 resultObj = objPtr;
12459 if (opt_all) {
12460 Jim_ListAppendElement(interp, listObjPtr, resultObj);
12462 else {
12463 Jim_SetResult(interp, resultObj);
12464 goto done;
12469 if (opt_all) {
12470 Jim_SetResult(interp, listObjPtr);
12472 else {
12473 /* No match */
12474 if (opt_bool) {
12475 Jim_SetResultBool(interp, opt_not);
12477 else if (!opt_inline) {
12478 Jim_SetResultInt(interp, -1);
12482 done:
12483 if (commandObj) {
12484 Jim_DecrRefCount(interp, commandObj);
12486 return rc;
12489 /* [lappend] */
12490 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12492 Jim_Obj *listObjPtr;
12493 int new_obj = 0;
12494 int i;
12496 if (argc < 2) {
12497 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
12498 return JIM_ERR;
12500 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12501 if (!listObjPtr) {
12502 /* Create the list if it does not exist */
12503 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12504 new_obj = 1;
12506 else if (Jim_IsShared(listObjPtr)) {
12507 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
12508 new_obj = 1;
12510 for (i = 2; i < argc; i++)
12511 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
12512 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
12513 if (new_obj)
12514 Jim_FreeNewObj(interp, listObjPtr);
12515 return JIM_ERR;
12517 Jim_SetResult(interp, listObjPtr);
12518 return JIM_OK;
12521 /* [linsert] */
12522 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12524 int idx, len;
12525 Jim_Obj *listPtr;
12527 if (argc < 3) {
12528 Jim_WrongNumArgs(interp, 1, argv, "list index ?element ...?");
12529 return JIM_ERR;
12531 listPtr = argv[1];
12532 if (Jim_IsShared(listPtr))
12533 listPtr = Jim_DuplicateObj(interp, listPtr);
12534 if (Jim_GetIndex(interp, argv[2], &idx) != JIM_OK)
12535 goto err;
12536 len = Jim_ListLength(interp, listPtr);
12537 if (idx >= len)
12538 idx = len;
12539 else if (idx < 0)
12540 idx = len + idx + 1;
12541 Jim_ListInsertElements(interp, listPtr, idx, argc - 3, &argv[3]);
12542 Jim_SetResult(interp, listPtr);
12543 return JIM_OK;
12544 err:
12545 if (listPtr != argv[1]) {
12546 Jim_FreeNewObj(interp, listPtr);
12548 return JIM_ERR;
12551 /* [lreplace] */
12552 static int Jim_LreplaceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12554 int first, last, len, rangeLen;
12555 Jim_Obj *listObj;
12556 Jim_Obj *newListObj;
12558 if (argc < 4) {
12559 Jim_WrongNumArgs(interp, 1, argv, "list first last ?element ...?");
12560 return JIM_ERR;
12562 if (Jim_GetIndex(interp, argv[2], &first) != JIM_OK ||
12563 Jim_GetIndex(interp, argv[3], &last) != JIM_OK) {
12564 return JIM_ERR;
12567 listObj = argv[1];
12568 len = Jim_ListLength(interp, listObj);
12570 first = JimRelToAbsIndex(len, first);
12571 last = JimRelToAbsIndex(len, last);
12572 JimRelToAbsRange(len, &first, &last, &rangeLen);
12574 /* Now construct a new list which consists of:
12575 * <elements before first> <supplied elements> <elements after last>
12578 /* Trying to replace past the end of the list means end of list
12579 * See TIP #505
12581 if (first > len) {
12582 first = len;
12585 /* Add the first set of elements */
12586 newListObj = Jim_NewListObj(interp, listObj->internalRep.listValue.ele, first);
12588 /* Add supplied elements */
12589 ListInsertElements(newListObj, -1, argc - 4, argv + 4);
12591 /* Add the remaining elements */
12592 ListInsertElements(newListObj, -1, len - first - rangeLen, listObj->internalRep.listValue.ele + first + rangeLen);
12594 Jim_SetResult(interp, newListObj);
12595 return JIM_OK;
12598 /* [lset] */
12599 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12601 if (argc < 3) {
12602 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
12603 return JIM_ERR;
12605 else if (argc == 3) {
12606 /* With no indexes, simply implements [set] */
12607 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
12608 return JIM_ERR;
12609 Jim_SetResult(interp, argv[2]);
12610 return JIM_OK;
12612 return Jim_ListSetIndex(interp, argv[1], argv + 2, argc - 3, argv[argc - 1]);
12615 /* [lsort] */
12616 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
12618 static const char * const options[] = {
12619 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", NULL
12621 enum
12622 { OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_REAL, OPT_INDEX, OPT_UNIQUE };
12623 Jim_Obj *resObj;
12624 int i;
12625 int retCode;
12626 int shared;
12628 struct lsort_info info;
12630 if (argc < 2) {
12631 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
12632 return JIM_ERR;
12635 info.type = JIM_LSORT_ASCII;
12636 info.order = 1;
12637 info.indexed = 0;
12638 info.unique = 0;
12639 info.command = NULL;
12640 info.interp = interp;
12642 for (i = 1; i < (argc - 1); i++) {
12643 int option;
12645 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ENUM_ABBREV | JIM_ERRMSG)
12646 != JIM_OK)
12647 return JIM_ERR;
12648 switch (option) {
12649 case OPT_ASCII:
12650 info.type = JIM_LSORT_ASCII;
12651 break;
12652 case OPT_NOCASE:
12653 info.type = JIM_LSORT_NOCASE;
12654 break;
12655 case OPT_INTEGER:
12656 info.type = JIM_LSORT_INTEGER;
12657 break;
12658 case OPT_REAL:
12659 info.type = JIM_LSORT_REAL;
12660 break;
12661 case OPT_INCREASING:
12662 info.order = 1;
12663 break;
12664 case OPT_DECREASING:
12665 info.order = -1;
12666 break;
12667 case OPT_UNIQUE:
12668 info.unique = 1;
12669 break;
12670 case OPT_COMMAND:
12671 if (i >= (argc - 2)) {
12672 Jim_SetResultString(interp, "\"-command\" option must be followed by comparison command", -1);
12673 return JIM_ERR;
12675 info.type = JIM_LSORT_COMMAND;
12676 info.command = argv[i + 1];
12677 i++;
12678 break;
12679 case OPT_INDEX:
12680 if (i >= (argc - 2)) {
12681 Jim_SetResultString(interp, "\"-index\" option must be followed by list index", -1);
12682 return JIM_ERR;
12684 if (Jim_GetIndex(interp, argv[i + 1], &info.index) != JIM_OK) {
12685 return JIM_ERR;
12687 info.indexed = 1;
12688 i++;
12689 break;
12692 resObj = argv[argc - 1];
12693 if ((shared = Jim_IsShared(resObj)))
12694 resObj = Jim_DuplicateObj(interp, resObj);
12695 retCode = ListSortElements(interp, resObj, &info);
12696 if (retCode == JIM_OK) {
12697 Jim_SetResult(interp, resObj);
12699 else if (shared) {
12700 Jim_FreeNewObj(interp, resObj);
12702 return retCode;
12705 /* [append] */
12706 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12708 Jim_Obj *stringObjPtr;
12709 int i;
12711 if (argc < 2) {
12712 Jim_WrongNumArgs(interp, 1, argv, "varName ?value ...?");
12713 return JIM_ERR;
12715 if (argc == 2) {
12716 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
12717 if (!stringObjPtr)
12718 return JIM_ERR;
12720 else {
12721 int new_obj = 0;
12722 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12723 if (!stringObjPtr) {
12724 /* Create the string if it doesn't exist */
12725 stringObjPtr = Jim_NewEmptyStringObj(interp);
12726 new_obj = 1;
12728 else if (Jim_IsShared(stringObjPtr)) {
12729 new_obj = 1;
12730 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
12732 for (i = 2; i < argc; i++) {
12733 Jim_AppendObj(interp, stringObjPtr, argv[i]);
12735 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
12736 if (new_obj) {
12737 Jim_FreeNewObj(interp, stringObjPtr);
12739 return JIM_ERR;
12742 Jim_SetResult(interp, stringObjPtr);
12743 return JIM_OK;
12746 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12748 * Returns a zero-refcount list describing the expression at 'node'
12750 static Jim_Obj *JimGetExprAsList(Jim_Interp *interp, struct JimExprNode *node)
12752 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
12754 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, jim_tt_name(node->type), -1));
12755 if (TOKEN_IS_EXPR_OP(node->type)) {
12756 if (node->left) {
12757 Jim_ListAppendElement(interp, listObjPtr, JimGetExprAsList(interp, node->left));
12759 if (node->right) {
12760 Jim_ListAppendElement(interp, listObjPtr, JimGetExprAsList(interp, node->right));
12762 if (node->ternary) {
12763 Jim_ListAppendElement(interp, listObjPtr, JimGetExprAsList(interp, node->ternary));
12766 else {
12767 Jim_ListAppendElement(interp, listObjPtr, node->objPtr);
12769 return listObjPtr;
12771 #endif /* JIM_DEBUG_COMMAND && !JIM_BOOTSTRAP */
12773 /* [debug] */
12774 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12775 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12777 static const char * const options[] = {
12778 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
12779 "exprbc", "show",
12780 NULL
12782 enum
12784 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
12785 OPT_EXPRLEN, OPT_EXPRBC, OPT_SHOW,
12787 int option;
12789 if (argc < 2) {
12790 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?...?");
12791 return JIM_ERR;
12793 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK)
12794 return Jim_CheckShowCommands(interp, argv[1], options);
12795 if (option == OPT_REFCOUNT) {
12796 if (argc != 3) {
12797 Jim_WrongNumArgs(interp, 2, argv, "object");
12798 return JIM_ERR;
12800 Jim_SetResultInt(interp, argv[2]->refCount);
12801 return JIM_OK;
12803 else if (option == OPT_OBJCOUNT) {
12804 int freeobj = 0, liveobj = 0;
12805 char buf[256];
12806 Jim_Obj *objPtr;
12808 if (argc != 2) {
12809 Jim_WrongNumArgs(interp, 2, argv, "");
12810 return JIM_ERR;
12812 /* Count the number of free objects. */
12813 objPtr = interp->freeList;
12814 while (objPtr) {
12815 freeobj++;
12816 objPtr = objPtr->nextObjPtr;
12818 /* Count the number of live objects. */
12819 objPtr = interp->liveList;
12820 while (objPtr) {
12821 liveobj++;
12822 objPtr = objPtr->nextObjPtr;
12824 /* Set the result string and return. */
12825 sprintf(buf, "free %d used %d", freeobj, liveobj);
12826 Jim_SetResultString(interp, buf, -1);
12827 return JIM_OK;
12829 else if (option == OPT_OBJECTS) {
12830 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
12832 if (argc != 2) {
12833 Jim_WrongNumArgs(interp, 2, argv, "");
12834 return JIM_ERR;
12837 /* Count the number of live objects. */
12838 objPtr = interp->liveList;
12839 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12840 while (objPtr) {
12841 char buf[128];
12842 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "";
12844 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
12845 sprintf(buf, "%p", objPtr);
12846 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, buf, -1));
12847 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, type, -1));
12848 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewIntObj(interp, objPtr->refCount));
12849 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
12850 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
12851 objPtr = objPtr->nextObjPtr;
12853 Jim_SetResult(interp, listObjPtr);
12854 return JIM_OK;
12856 else if (option == OPT_INVSTR) {
12857 Jim_Obj *objPtr;
12859 if (argc != 3) {
12860 Jim_WrongNumArgs(interp, 2, argv, "object");
12861 return JIM_ERR;
12863 objPtr = argv[2];
12864 if (objPtr->typePtr != NULL)
12865 Jim_InvalidateStringRep(objPtr);
12866 Jim_SetEmptyResult(interp);
12867 return JIM_OK;
12869 else if (option == OPT_SHOW) {
12870 const char *s;
12871 int len, charlen;
12873 if (argc != 3) {
12874 Jim_WrongNumArgs(interp, 2, argv, "object");
12875 return JIM_ERR;
12877 s = Jim_GetString(argv[2], &len);
12878 #ifdef JIM_UTF8
12879 charlen = utf8_strlen(s, len);
12880 #else
12881 charlen = len;
12882 #endif
12883 char buf[256];
12884 snprintf(buf, sizeof(buf), "refcount: %d, type: %s\n"
12885 "chars (%d):",
12886 argv[2]->refCount, JimObjTypeName(argv[2]), charlen);
12887 Jim_SetResultFormatted(interp, "%s <<%s>>\n", buf, s);
12888 snprintf(buf, sizeof(buf), "bytes (%d):", len);
12889 Jim_AppendString(interp, Jim_GetResult(interp), buf, -1);
12890 while (len--) {
12891 snprintf(buf, sizeof(buf), " %02x", (unsigned char)*s++);
12892 Jim_AppendString(interp, Jim_GetResult(interp), buf, -1);
12894 return JIM_OK;
12896 else if (option == OPT_SCRIPTLEN) {
12897 ScriptObj *script;
12899 if (argc != 3) {
12900 Jim_WrongNumArgs(interp, 2, argv, "script");
12901 return JIM_ERR;
12903 script = JimGetScript(interp, argv[2]);
12904 if (script == NULL)
12905 return JIM_ERR;
12906 Jim_SetResultInt(interp, script->len);
12907 return JIM_OK;
12909 else if (option == OPT_EXPRLEN) {
12910 struct ExprTree *expr;
12912 if (argc != 3) {
12913 Jim_WrongNumArgs(interp, 2, argv, "expression");
12914 return JIM_ERR;
12916 expr = JimGetExpression(interp, argv[2]);
12917 if (expr == NULL)
12918 return JIM_ERR;
12919 Jim_SetResultInt(interp, expr->len);
12920 return JIM_OK;
12922 else if (option == OPT_EXPRBC) {
12923 struct ExprTree *expr;
12925 if (argc != 3) {
12926 Jim_WrongNumArgs(interp, 2, argv, "expression");
12927 return JIM_ERR;
12929 expr = JimGetExpression(interp, argv[2]);
12930 if (expr == NULL)
12931 return JIM_ERR;
12932 Jim_SetResult(interp, JimGetExprAsList(interp, expr->expr));
12933 return JIM_OK;
12935 else {
12936 Jim_SetResultString(interp,
12937 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
12938 return JIM_ERR;
12940 /* unreached */
12942 #endif /* JIM_DEBUG_COMMAND && !JIM_BOOTSTRAP */
12944 /* [eval] */
12945 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12947 int rc;
12949 if (argc < 2) {
12950 Jim_WrongNumArgs(interp, 1, argv, "arg ?arg ...?");
12951 return JIM_ERR;
12954 if (argc == 2) {
12955 rc = Jim_EvalObj(interp, argv[1]);
12957 else {
12958 rc = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12961 if (rc == JIM_ERR) {
12962 /* eval is "interesting", so add a stack frame here */
12963 interp->addStackTrace++;
12965 return rc;
12968 /* [uplevel] */
12969 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12971 if (argc >= 2) {
12972 int retcode;
12973 Jim_CallFrame *savedCallFrame, *targetCallFrame;
12974 const char *str;
12976 /* Save the old callframe pointer */
12977 savedCallFrame = interp->framePtr;
12979 /* Lookup the target frame pointer */
12980 str = Jim_String(argv[1]);
12981 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#') {
12982 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
12983 argc--;
12984 argv++;
12986 else {
12987 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
12989 if (targetCallFrame == NULL) {
12990 return JIM_ERR;
12992 if (argc < 2) {
12993 Jim_WrongNumArgs(interp, 1, argv - 1, "?level? command ?arg ...?");
12994 return JIM_ERR;
12996 /* Eval the code in the target callframe. */
12997 interp->framePtr = targetCallFrame;
12998 if (argc == 2) {
12999 retcode = Jim_EvalObj(interp, argv[1]);
13001 else {
13002 retcode = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13004 interp->framePtr = savedCallFrame;
13005 return retcode;
13007 else {
13008 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
13009 return JIM_ERR;
13013 /* [expr] */
13014 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13016 int retcode;
13018 if (argc == 2) {
13019 retcode = Jim_EvalExpression(interp, argv[1]);
13021 else if (argc > 2) {
13022 Jim_Obj *objPtr;
13024 objPtr = Jim_ConcatObj(interp, argc - 1, argv + 1);
13025 Jim_IncrRefCount(objPtr);
13026 retcode = Jim_EvalExpression(interp, objPtr);
13027 Jim_DecrRefCount(interp, objPtr);
13029 else {
13030 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
13031 return JIM_ERR;
13033 if (retcode != JIM_OK)
13034 return retcode;
13035 return JIM_OK;
13038 /* [break] */
13039 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13041 if (argc != 1) {
13042 Jim_WrongNumArgs(interp, 1, argv, "");
13043 return JIM_ERR;
13045 return JIM_BREAK;
13048 /* [continue] */
13049 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13051 if (argc != 1) {
13052 Jim_WrongNumArgs(interp, 1, argv, "");
13053 return JIM_ERR;
13055 return JIM_CONTINUE;
13058 /* [return] */
13059 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13061 int i;
13062 Jim_Obj *stackTraceObj = NULL;
13063 Jim_Obj *errorCodeObj = NULL;
13064 int returnCode = JIM_OK;
13065 long level = 1;
13067 for (i = 1; i < argc - 1; i += 2) {
13068 if (Jim_CompareStringImmediate(interp, argv[i], "-code")) {
13069 if (Jim_GetReturnCode(interp, argv[i + 1], &returnCode) == JIM_ERR) {
13070 return JIM_ERR;
13073 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorinfo")) {
13074 stackTraceObj = argv[i + 1];
13076 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorcode")) {
13077 errorCodeObj = argv[i + 1];
13079 else if (Jim_CompareStringImmediate(interp, argv[i], "-level")) {
13080 if (Jim_GetLong(interp, argv[i + 1], &level) != JIM_OK || level < 0) {
13081 Jim_SetResultFormatted(interp, "bad level \"%#s\"", argv[i + 1]);
13082 return JIM_ERR;
13085 else {
13086 break;
13090 if (i != argc - 1 && i != argc) {
13091 Jim_WrongNumArgs(interp, 1, argv,
13092 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
13095 /* If a stack trace is supplied and code is error, set the stack trace */
13096 if (stackTraceObj && returnCode == JIM_ERR) {
13097 JimSetStackTrace(interp, stackTraceObj);
13099 /* If an error code list is supplied, set the global $errorCode */
13100 if (errorCodeObj && returnCode == JIM_ERR) {
13101 Jim_SetGlobalVariableStr(interp, "errorCode", errorCodeObj);
13103 interp->returnCode = returnCode;
13104 interp->returnLevel = level;
13106 if (i == argc - 1) {
13107 Jim_SetResult(interp, argv[i]);
13109 return level == 0 ? returnCode : JIM_RETURN;
13112 /* [tailcall] */
13113 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13115 if (interp->framePtr->level == 0) {
13116 Jim_SetResultString(interp, "tailcall can only be called from a proc or lambda", -1);
13117 return JIM_ERR;
13119 else if (argc >= 2) {
13120 /* Need to resolve the tailcall command in the current context */
13121 Jim_CallFrame *cf = interp->framePtr->parent;
13123 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13124 if (cmdPtr == NULL) {
13125 return JIM_ERR;
13128 JimPanic((cf->tailcallCmd != NULL, "Already have a tailcallCmd"));
13130 /* And stash this pre-resolved command */
13131 JimIncrCmdRefCount(cmdPtr);
13132 cf->tailcallCmd = cmdPtr;
13134 /* And stash the command list */
13135 JimPanic((cf->tailcallObj != NULL, "Already have a tailcallobj"));
13137 cf->tailcallObj = Jim_NewListObj(interp, argv + 1, argc - 1);
13138 Jim_IncrRefCount(cf->tailcallObj);
13140 /* When the stack unwinds to the previous proc, the stashed command will be evaluated */
13141 return JIM_EVAL;
13143 return JIM_OK;
13146 static int JimAliasCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13148 Jim_Obj *cmdList;
13149 Jim_Obj *prefixListObj = Jim_CmdPrivData(interp);
13151 /* prefixListObj is a list to which the args need to be appended */
13152 cmdList = Jim_DuplicateObj(interp, prefixListObj);
13153 Jim_ListInsertElements(interp, cmdList, Jim_ListLength(interp, cmdList), argc - 1, argv + 1);
13155 return JimEvalObjList(interp, cmdList);
13158 static void JimAliasCmdDelete(Jim_Interp *interp, void *privData)
13160 Jim_Obj *prefixListObj = privData;
13161 Jim_DecrRefCount(interp, prefixListObj);
13164 static int Jim_AliasCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13166 Jim_Obj *prefixListObj;
13168 if (argc < 3) {
13169 Jim_WrongNumArgs(interp, 1, argv, "newname command ?args ...?");
13170 return JIM_ERR;
13173 prefixListObj = Jim_NewListObj(interp, argv + 2, argc - 2);
13174 Jim_IncrRefCount(prefixListObj);
13175 Jim_SetResult(interp, argv[1]);
13177 return Jim_CreateCommandObj(interp, argv[1], JimAliasCmd, prefixListObj, JimAliasCmdDelete);
13180 /* [proc] */
13181 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13183 Jim_Cmd *cmd;
13185 if (argc != 4 && argc != 5) {
13186 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
13187 return JIM_ERR;
13190 if (argc == 4) {
13191 cmd = JimCreateProcedureCmd(interp, argv[2], NULL, argv[3], NULL);
13193 else {
13194 cmd = JimCreateProcedureCmd(interp, argv[2], argv[3], argv[4], NULL);
13197 if (cmd) {
13198 /* Add the new command */
13199 Jim_Obj *nameObjPtr = JimQualifyName(interp, argv[1]);
13200 JimCreateCommand(interp, nameObjPtr, cmd);
13202 /* Calculate and set the namespace for this proc */
13203 JimUpdateProcNamespace(interp, cmd, nameObjPtr);
13204 Jim_DecrRefCount(interp, nameObjPtr);
13206 /* Unlike Tcl, set the name of the proc as the result */
13207 Jim_SetResult(interp, argv[1]);
13208 return JIM_OK;
13210 return JIM_ERR;
13213 /* [local] */
13214 static int Jim_LocalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13216 int retcode;
13218 if (argc < 2) {
13219 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13220 return JIM_ERR;
13223 /* Evaluate the arguments with 'local' in force */
13224 interp->local++;
13225 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13226 interp->local--;
13229 /* If OK, and the result is a proc, add it to the list of local procs */
13230 if (retcode == 0) {
13231 Jim_Obj *cmdNameObj = Jim_GetResult(interp);
13233 if (Jim_GetCommand(interp, cmdNameObj, JIM_ERRMSG) == NULL) {
13234 return JIM_ERR;
13236 if (interp->framePtr->localCommands == NULL) {
13237 interp->framePtr->localCommands = Jim_Alloc(sizeof(*interp->framePtr->localCommands));
13238 Jim_InitStack(interp->framePtr->localCommands);
13240 Jim_IncrRefCount(cmdNameObj);
13241 Jim_StackPush(interp->framePtr->localCommands, cmdNameObj);
13244 return retcode;
13247 /* [upcall] */
13248 static int Jim_UpcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13250 if (argc < 2) {
13251 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13252 return JIM_ERR;
13254 else {
13255 int retcode;
13257 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13258 if (cmdPtr == NULL || !cmdPtr->isproc || !cmdPtr->prevCmd) {
13259 Jim_SetResultFormatted(interp, "no previous command: \"%#s\"", argv[1]);
13260 return JIM_ERR;
13262 /* OK. Mark this command as being in an upcall */
13263 cmdPtr->u.proc.upcall++;
13264 JimIncrCmdRefCount(cmdPtr);
13266 /* Invoke the command as normal */
13267 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13269 /* No longer in an upcall */
13270 cmdPtr->u.proc.upcall--;
13271 JimDecrCmdRefCount(interp, cmdPtr);
13273 return retcode;
13277 /* [apply] */
13278 static int Jim_ApplyCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13280 if (argc < 2) {
13281 Jim_WrongNumArgs(interp, 1, argv, "lambdaExpr ?arg ...?");
13282 return JIM_ERR;
13284 else {
13285 int ret;
13286 Jim_Cmd *cmd;
13287 Jim_Obj *argListObjPtr;
13288 Jim_Obj *bodyObjPtr;
13289 Jim_Obj *nsObj = NULL;
13290 Jim_Obj **nargv;
13292 int len = Jim_ListLength(interp, argv[1]);
13293 if (len != 2 && len != 3) {
13294 Jim_SetResultFormatted(interp, "can't interpret \"%#s\" as a lambda expression", argv[1]);
13295 return JIM_ERR;
13298 if (len == 3) {
13299 #ifdef jim_ext_namespace
13300 /* Note that the namespace is always treated as global */
13301 nsObj = Jim_ListGetIndex(interp, argv[1], 2);
13302 #else
13303 Jim_SetResultString(interp, "namespaces not enabled", -1);
13304 return JIM_ERR;
13305 #endif
13307 argListObjPtr = Jim_ListGetIndex(interp, argv[1], 0);
13308 bodyObjPtr = Jim_ListGetIndex(interp, argv[1], 1);
13310 cmd = JimCreateProcedureCmd(interp, argListObjPtr, NULL, bodyObjPtr, nsObj);
13312 if (cmd) {
13313 /* Create a new argv array with a dummy argv[0], for error messages */
13314 nargv = Jim_Alloc((argc - 2 + 1) * sizeof(*nargv));
13315 nargv[0] = Jim_NewStringObj(interp, "apply lambdaExpr", -1);
13316 Jim_IncrRefCount(nargv[0]);
13317 memcpy(&nargv[1], argv + 2, (argc - 2) * sizeof(*nargv));
13318 ret = JimCallProcedure(interp, cmd, argc - 2 + 1, nargv);
13319 Jim_DecrRefCount(interp, nargv[0]);
13320 Jim_Free(nargv);
13322 JimDecrCmdRefCount(interp, cmd);
13323 return ret;
13325 return JIM_ERR;
13330 /* [concat] */
13331 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13333 Jim_SetResult(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13334 return JIM_OK;
13337 /* [upvar] */
13338 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13340 int i;
13341 Jim_CallFrame *targetCallFrame;
13343 /* Lookup the target frame pointer */
13344 if (argc > 3 && (argc % 2 == 0)) {
13345 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
13346 argc--;
13347 argv++;
13349 else {
13350 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
13352 if (targetCallFrame == NULL) {
13353 return JIM_ERR;
13356 /* Check for arity */
13357 if (argc < 3) {
13358 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
13359 return JIM_ERR;
13362 /* Now... for every other/local couple: */
13363 for (i = 1; i < argc; i += 2) {
13364 if (Jim_SetVariableLink(interp, argv[i + 1], argv[i], targetCallFrame) != JIM_OK)
13365 return JIM_ERR;
13367 return JIM_OK;
13370 /* [global] */
13371 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13373 int i;
13375 if (argc < 2) {
13376 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
13377 return JIM_ERR;
13379 /* Link every var to the toplevel having the same name */
13380 if (interp->framePtr->level == 0)
13381 return JIM_OK; /* global at toplevel... */
13382 for (i = 1; i < argc; i++) {
13383 /* global ::blah does nothing */
13384 const char *name = Jim_String(argv[i]);
13385 if (name[0] != ':' || name[1] != ':') {
13386 if (Jim_SetVariableLink(interp, argv[i], argv[i], interp->topFramePtr) != JIM_OK)
13387 return JIM_ERR;
13390 return JIM_OK;
13393 /* does the [string map] operation. On error NULL is returned,
13394 * otherwise a new string object with the result, having refcount = 0,
13395 * is returned. */
13396 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
13397 Jim_Obj *objPtr, int nocase)
13399 int numMaps;
13400 const char *str, *noMatchStart = NULL;
13401 int strLen, i;
13402 Jim_Obj *resultObjPtr;
13404 numMaps = Jim_ListLength(interp, mapListObjPtr);
13405 if (numMaps % 2) {
13406 Jim_SetResultString(interp, "list must contain an even number of elements", -1);
13407 return NULL;
13410 str = Jim_String(objPtr);
13411 strLen = Jim_Utf8Length(interp, objPtr);
13413 /* Map it */
13414 resultObjPtr = Jim_NewStringObj(interp, "", 0);
13415 while (strLen) {
13416 for (i = 0; i < numMaps; i += 2) {
13417 Jim_Obj *eachObjPtr;
13418 const char *k;
13419 int kl;
13421 eachObjPtr = Jim_ListGetIndex(interp, mapListObjPtr, i);
13422 k = Jim_String(eachObjPtr);
13423 kl = Jim_Utf8Length(interp, eachObjPtr);
13425 if (strLen >= kl && kl) {
13426 int rc;
13427 rc = JimStringCompareUtf8(str, kl, k, kl, nocase);
13428 if (rc == 0) {
13429 if (noMatchStart) {
13430 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13431 noMatchStart = NULL;
13433 Jim_AppendObj(interp, resultObjPtr, Jim_ListGetIndex(interp, mapListObjPtr, i + 1));
13434 str += utf8_index(str, kl);
13435 strLen -= kl;
13436 break;
13440 if (i == numMaps) { /* no match */
13441 int c;
13442 if (noMatchStart == NULL)
13443 noMatchStart = str;
13444 str += utf8_tounicode(str, &c);
13445 strLen--;
13448 if (noMatchStart) {
13449 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13451 return resultObjPtr;
13454 /* [string] */
13455 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13457 int len;
13458 int opt_case = 1;
13459 int option;
13460 static const char * const options[] = {
13461 "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "replace",
13462 "map", "repeat", "reverse", "index", "first", "last", "cat",
13463 "trim", "trimleft", "trimright", "tolower", "toupper", "totitle", NULL
13465 enum
13467 OPT_BYTELENGTH, OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_IS, OPT_BYTERANGE, OPT_RANGE, OPT_REPLACE,
13468 OPT_MAP, OPT_REPEAT, OPT_REVERSE, OPT_INDEX, OPT_FIRST, OPT_LAST, OPT_CAT,
13469 OPT_TRIM, OPT_TRIMLEFT, OPT_TRIMRIGHT, OPT_TOLOWER, OPT_TOUPPER, OPT_TOTITLE
13471 static const char * const nocase_options[] = {
13472 "-nocase", NULL
13474 static const char * const nocase_length_options[] = {
13475 "-nocase", "-length", NULL
13478 if (argc < 2) {
13479 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
13480 return JIM_ERR;
13482 if (Jim_GetEnum(interp, argv[1], options, &option, NULL,
13483 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK)
13484 return Jim_CheckShowCommands(interp, argv[1], options);
13486 switch (option) {
13487 case OPT_LENGTH:
13488 case OPT_BYTELENGTH:
13489 if (argc != 3) {
13490 Jim_WrongNumArgs(interp, 2, argv, "string");
13491 return JIM_ERR;
13493 if (option == OPT_LENGTH) {
13494 len = Jim_Utf8Length(interp, argv[2]);
13496 else {
13497 len = Jim_Length(argv[2]);
13499 Jim_SetResultInt(interp, len);
13500 return JIM_OK;
13502 case OPT_CAT:{
13503 Jim_Obj *objPtr;
13504 if (argc == 3) {
13505 /* optimise the one-arg case */
13506 objPtr = argv[2];
13508 else {
13509 int i;
13511 objPtr = Jim_NewStringObj(interp, "", 0);
13513 for (i = 2; i < argc; i++) {
13514 Jim_AppendObj(interp, objPtr, argv[i]);
13517 Jim_SetResult(interp, objPtr);
13518 return JIM_OK;
13521 case OPT_COMPARE:
13522 case OPT_EQUAL:
13524 /* n is the number of remaining option args */
13525 long opt_length = -1;
13526 int n = argc - 4;
13527 int i = 2;
13528 while (n > 0) {
13529 int subopt;
13530 if (Jim_GetEnum(interp, argv[i++], nocase_length_options, &subopt, NULL,
13531 JIM_ENUM_ABBREV) != JIM_OK) {
13532 badcompareargs:
13533 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? ?-length int? string1 string2");
13534 return JIM_ERR;
13536 if (subopt == 0) {
13537 /* -nocase */
13538 opt_case = 0;
13539 n--;
13541 else {
13542 /* -length */
13543 if (n < 2) {
13544 goto badcompareargs;
13546 if (Jim_GetLong(interp, argv[i++], &opt_length) != JIM_OK) {
13547 return JIM_ERR;
13549 n -= 2;
13552 if (n) {
13553 goto badcompareargs;
13555 argv += argc - 2;
13556 if (opt_length < 0 && option != OPT_COMPARE && opt_case) {
13557 /* Fast version - [string equal], case sensitive, no length */
13558 Jim_SetResultBool(interp, Jim_StringEqObj(argv[0], argv[1]));
13560 else {
13561 const char *s1 = Jim_String(argv[0]);
13562 int l1 = Jim_Utf8Length(interp, argv[0]);
13563 const char *s2 = Jim_String(argv[1]);
13564 int l2 = Jim_Utf8Length(interp, argv[1]);
13565 if (opt_length >= 0) {
13566 if (l1 > opt_length) {
13567 l1 = opt_length;
13569 if (l2 > opt_length) {
13570 l2 = opt_length;
13573 n = JimStringCompareUtf8(s1, l1, s2, l2, !opt_case);
13574 Jim_SetResultInt(interp, option == OPT_COMPARE ? n : n == 0);
13576 return JIM_OK;
13579 case OPT_MATCH:
13580 if (argc != 4 &&
13581 (argc != 5 ||
13582 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13583 JIM_ENUM_ABBREV) != JIM_OK)) {
13584 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern string");
13585 return JIM_ERR;
13587 if (opt_case == 0) {
13588 argv++;
13590 Jim_SetResultBool(interp, Jim_StringMatchObj(interp, argv[2], argv[3], !opt_case));
13591 return JIM_OK;
13593 case OPT_MAP:{
13594 Jim_Obj *objPtr;
13596 if (argc != 4 &&
13597 (argc != 5 ||
13598 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13599 JIM_ENUM_ABBREV) != JIM_OK)) {
13600 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList string");
13601 return JIM_ERR;
13604 if (opt_case == 0) {
13605 argv++;
13607 objPtr = JimStringMap(interp, argv[2], argv[3], !opt_case);
13608 if (objPtr == NULL) {
13609 return JIM_ERR;
13611 Jim_SetResult(interp, objPtr);
13612 return JIM_OK;
13615 case OPT_RANGE:
13616 case OPT_BYTERANGE:{
13617 Jim_Obj *objPtr;
13619 if (argc != 5) {
13620 Jim_WrongNumArgs(interp, 2, argv, "string first last");
13621 return JIM_ERR;
13623 if (option == OPT_RANGE) {
13624 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
13626 else
13628 objPtr = Jim_StringByteRangeObj(interp, argv[2], argv[3], argv[4]);
13631 if (objPtr == NULL) {
13632 return JIM_ERR;
13634 Jim_SetResult(interp, objPtr);
13635 return JIM_OK;
13638 case OPT_REPLACE:{
13639 Jim_Obj *objPtr;
13641 if (argc != 5 && argc != 6) {
13642 Jim_WrongNumArgs(interp, 2, argv, "string first last ?string?");
13643 return JIM_ERR;
13645 objPtr = JimStringReplaceObj(interp, argv[2], argv[3], argv[4], argc == 6 ? argv[5] : NULL);
13646 if (objPtr == NULL) {
13647 return JIM_ERR;
13649 Jim_SetResult(interp, objPtr);
13650 return JIM_OK;
13654 case OPT_REPEAT:{
13655 Jim_Obj *objPtr;
13656 jim_wide count;
13658 if (argc != 4) {
13659 Jim_WrongNumArgs(interp, 2, argv, "string count");
13660 return JIM_ERR;
13662 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK) {
13663 return JIM_ERR;
13665 objPtr = Jim_NewStringObj(interp, "", 0);
13666 if (count > 0) {
13667 while (count--) {
13668 Jim_AppendObj(interp, objPtr, argv[2]);
13671 Jim_SetResult(interp, objPtr);
13672 return JIM_OK;
13675 case OPT_REVERSE:{
13676 char *buf, *p;
13677 const char *str;
13678 int i;
13680 if (argc != 3) {
13681 Jim_WrongNumArgs(interp, 2, argv, "string");
13682 return JIM_ERR;
13685 str = Jim_GetString(argv[2], &len);
13686 buf = Jim_Alloc(len + 1);
13687 p = buf + len;
13688 *p = 0;
13689 for (i = 0; i < len; ) {
13690 int c;
13691 int l = utf8_tounicode(str, &c);
13692 memcpy(p - l, str, l);
13693 p -= l;
13694 i += l;
13695 str += l;
13697 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
13698 return JIM_OK;
13701 case OPT_INDEX:{
13702 int idx;
13703 const char *str;
13705 if (argc != 4) {
13706 Jim_WrongNumArgs(interp, 2, argv, "string index");
13707 return JIM_ERR;
13709 if (Jim_GetIndex(interp, argv[3], &idx) != JIM_OK) {
13710 return JIM_ERR;
13712 str = Jim_String(argv[2]);
13713 len = Jim_Utf8Length(interp, argv[2]);
13714 if (idx != INT_MIN && idx != INT_MAX) {
13715 idx = JimRelToAbsIndex(len, idx);
13717 if (idx < 0 || idx >= len || str == NULL) {
13718 Jim_SetResultString(interp, "", 0);
13720 else if (len == Jim_Length(argv[2])) {
13721 /* ASCII optimisation */
13722 Jim_SetResultString(interp, str + idx, 1);
13724 else {
13725 int c;
13726 int i = utf8_index(str, idx);
13727 Jim_SetResultString(interp, str + i, utf8_tounicode(str + i, &c));
13729 return JIM_OK;
13732 case OPT_FIRST:
13733 case OPT_LAST:{
13734 int idx = 0, l1, l2;
13735 const char *s1, *s2;
13737 if (argc != 4 && argc != 5) {
13738 Jim_WrongNumArgs(interp, 2, argv, "subString string ?index?");
13739 return JIM_ERR;
13741 s1 = Jim_String(argv[2]);
13742 s2 = Jim_String(argv[3]);
13743 l1 = Jim_Utf8Length(interp, argv[2]);
13744 l2 = Jim_Utf8Length(interp, argv[3]);
13745 if (argc == 5) {
13746 if (Jim_GetIndex(interp, argv[4], &idx) != JIM_OK) {
13747 return JIM_ERR;
13749 idx = JimRelToAbsIndex(l2, idx);
13751 else if (option == OPT_LAST) {
13752 idx = l2;
13754 if (option == OPT_FIRST) {
13755 Jim_SetResultInt(interp, JimStringFirst(s1, l1, s2, l2, idx));
13757 else {
13758 #ifdef JIM_UTF8
13759 Jim_SetResultInt(interp, JimStringLastUtf8(s1, l1, s2, idx));
13760 #else
13761 Jim_SetResultInt(interp, JimStringLast(s1, l1, s2, idx));
13762 #endif
13764 return JIM_OK;
13767 case OPT_TRIM:
13768 case OPT_TRIMLEFT:
13769 case OPT_TRIMRIGHT:{
13770 Jim_Obj *trimchars;
13772 if (argc != 3 && argc != 4) {
13773 Jim_WrongNumArgs(interp, 2, argv, "string ?trimchars?");
13774 return JIM_ERR;
13776 trimchars = (argc == 4 ? argv[3] : NULL);
13777 if (option == OPT_TRIM) {
13778 Jim_SetResult(interp, JimStringTrim(interp, argv[2], trimchars));
13780 else if (option == OPT_TRIMLEFT) {
13781 Jim_SetResult(interp, JimStringTrimLeft(interp, argv[2], trimchars));
13783 else if (option == OPT_TRIMRIGHT) {
13784 Jim_SetResult(interp, JimStringTrimRight(interp, argv[2], trimchars));
13786 return JIM_OK;
13789 case OPT_TOLOWER:
13790 case OPT_TOUPPER:
13791 case OPT_TOTITLE:
13792 if (argc != 3) {
13793 Jim_WrongNumArgs(interp, 2, argv, "string");
13794 return JIM_ERR;
13796 if (option == OPT_TOLOWER) {
13797 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
13799 else if (option == OPT_TOUPPER) {
13800 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
13802 else {
13803 Jim_SetResult(interp, JimStringToTitle(interp, argv[2]));
13805 return JIM_OK;
13807 case OPT_IS:
13808 if (argc == 4 || (argc == 5 && Jim_CompareStringImmediate(interp, argv[3], "-strict"))) {
13809 return JimStringIs(interp, argv[argc - 1], argv[2], argc == 5);
13811 Jim_WrongNumArgs(interp, 2, argv, "class ?-strict? str");
13812 return JIM_ERR;
13814 return JIM_OK;
13817 /* [time] */
13818 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13820 long i, count = 1;
13821 jim_wide start, elapsed;
13822 char buf[60];
13823 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
13825 if (argc < 2) {
13826 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
13827 return JIM_ERR;
13829 if (argc == 3) {
13830 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
13831 return JIM_ERR;
13833 if (count < 0)
13834 return JIM_OK;
13835 i = count;
13836 start = JimClock();
13837 while (i-- > 0) {
13838 int retval;
13840 retval = Jim_EvalObj(interp, argv[1]);
13841 if (retval != JIM_OK) {
13842 return retval;
13845 elapsed = JimClock() - start;
13846 sprintf(buf, fmt, count == 0 ? 0 : elapsed / count);
13847 Jim_SetResultString(interp, buf, -1);
13848 return JIM_OK;
13851 /* [exit] */
13852 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13854 long exitCode = 0;
13856 if (argc > 2) {
13857 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
13858 return JIM_ERR;
13860 if (argc == 2) {
13861 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
13862 return JIM_ERR;
13863 Jim_SetResult(interp, argv[1]);
13865 interp->exitCode = exitCode;
13866 return JIM_EXIT;
13869 /* [catch] */
13870 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13872 int exitCode = 0;
13873 int i;
13874 int sig = 0;
13876 /* Which return codes are ignored (passed through)? By default, only exit, eval and signal */
13877 jim_wide ignore_mask = (1 << JIM_EXIT) | (1 << JIM_EVAL) | (1 << JIM_SIGNAL);
13878 static const int max_ignore_code = sizeof(ignore_mask) * 8;
13880 /* Reset the error code before catch.
13881 * Note that this is not strictly correct.
13883 Jim_SetGlobalVariableStr(interp, "errorCode", Jim_NewStringObj(interp, "NONE", -1));
13885 for (i = 1; i < argc - 1; i++) {
13886 const char *arg = Jim_String(argv[i]);
13887 jim_wide option;
13888 int ignore;
13890 /* It's a pity we can't use Jim_GetEnum here :-( */
13891 if (strcmp(arg, "--") == 0) {
13892 i++;
13893 break;
13895 if (*arg != '-') {
13896 break;
13899 if (strncmp(arg, "-no", 3) == 0) {
13900 arg += 3;
13901 ignore = 1;
13903 else {
13904 arg++;
13905 ignore = 0;
13908 if (Jim_StringToWide(arg, &option, 10) != JIM_OK) {
13909 option = -1;
13911 if (option < 0) {
13912 option = Jim_FindByName(arg, jimReturnCodes, jimReturnCodesSize);
13914 if (option < 0) {
13915 goto wrongargs;
13918 if (ignore) {
13919 ignore_mask |= ((jim_wide)1 << option);
13921 else {
13922 ignore_mask &= (~((jim_wide)1 << option));
13926 argc -= i;
13927 if (argc < 1 || argc > 3) {
13928 wrongargs:
13929 Jim_WrongNumArgs(interp, 1, argv,
13930 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
13931 return JIM_ERR;
13933 argv += i;
13935 if ((ignore_mask & (1 << JIM_SIGNAL)) == 0) {
13936 sig++;
13939 interp->signal_level += sig;
13940 if (Jim_CheckSignal(interp)) {
13941 /* If a signal is set, don't even try to execute the body */
13942 exitCode = JIM_SIGNAL;
13944 else {
13945 exitCode = Jim_EvalObj(interp, argv[0]);
13946 /* Don't want any caught error included in a later stack trace */
13947 interp->errorFlag = 0;
13949 interp->signal_level -= sig;
13951 /* Catch or pass through? Only the first 32/64 codes can be passed through */
13952 if (exitCode >= 0 && exitCode < max_ignore_code && (((unsigned jim_wide)1 << exitCode) & ignore_mask)) {
13953 /* Not caught, pass it up */
13954 return exitCode;
13957 if (sig && exitCode == JIM_SIGNAL) {
13958 /* Catch the signal at this level */
13959 if (interp->signal_set_result) {
13960 interp->signal_set_result(interp, interp->sigmask);
13962 else {
13963 Jim_SetResultInt(interp, interp->sigmask);
13965 interp->sigmask = 0;
13968 if (argc >= 2) {
13969 if (Jim_SetVariable(interp, argv[1], Jim_GetResult(interp)) != JIM_OK) {
13970 return JIM_ERR;
13972 if (argc == 3) {
13973 Jim_Obj *optListObj = Jim_NewListObj(interp, NULL, 0);
13975 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-code", -1));
13976 Jim_ListAppendElement(interp, optListObj,
13977 Jim_NewIntObj(interp, exitCode == JIM_RETURN ? interp->returnCode : exitCode));
13978 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-level", -1));
13979 Jim_ListAppendElement(interp, optListObj, Jim_NewIntObj(interp, interp->returnLevel));
13980 if (exitCode == JIM_ERR) {
13981 Jim_Obj *errorCode;
13982 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorinfo",
13983 -1));
13984 Jim_ListAppendElement(interp, optListObj, interp->stackTrace);
13986 errorCode = Jim_GetGlobalVariableStr(interp, "errorCode", JIM_NONE);
13987 if (errorCode) {
13988 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorcode", -1));
13989 Jim_ListAppendElement(interp, optListObj, errorCode);
13992 if (Jim_SetVariable(interp, argv[2], optListObj) != JIM_OK) {
13993 return JIM_ERR;
13997 Jim_SetResultInt(interp, exitCode);
13998 return JIM_OK;
14001 #if defined(JIM_REFERENCES) && !defined(JIM_BOOTSTRAP)
14003 /* [ref] */
14004 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14006 if (argc != 3 && argc != 4) {
14007 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
14008 return JIM_ERR;
14010 if (argc == 3) {
14011 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
14013 else {
14014 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], argv[3]));
14016 return JIM_OK;
14019 /* [getref] */
14020 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14022 Jim_Reference *refPtr;
14024 if (argc != 2) {
14025 Jim_WrongNumArgs(interp, 1, argv, "reference");
14026 return JIM_ERR;
14028 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
14029 return JIM_ERR;
14030 Jim_SetResult(interp, refPtr->objPtr);
14031 return JIM_OK;
14034 /* [setref] */
14035 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14037 Jim_Reference *refPtr;
14039 if (argc != 3) {
14040 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
14041 return JIM_ERR;
14043 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
14044 return JIM_ERR;
14045 Jim_IncrRefCount(argv[2]);
14046 Jim_DecrRefCount(interp, refPtr->objPtr);
14047 refPtr->objPtr = argv[2];
14048 Jim_SetResult(interp, argv[2]);
14049 return JIM_OK;
14052 /* [collect] */
14053 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14055 if (argc != 1) {
14056 Jim_WrongNumArgs(interp, 1, argv, "");
14057 return JIM_ERR;
14059 Jim_SetResultInt(interp, Jim_Collect(interp));
14061 /* Free all the freed objects. */
14062 while (interp->freeList) {
14063 Jim_Obj *nextObjPtr = interp->freeList->nextObjPtr;
14064 Jim_Free(interp->freeList);
14065 interp->freeList = nextObjPtr;
14068 return JIM_OK;
14071 /* [finalize] reference ?newValue? */
14072 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14074 if (argc != 2 && argc != 3) {
14075 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
14076 return JIM_ERR;
14078 if (argc == 2) {
14079 Jim_Obj *cmdNamePtr;
14081 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
14082 return JIM_ERR;
14083 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
14084 Jim_SetResult(interp, cmdNamePtr);
14086 else {
14087 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
14088 return JIM_ERR;
14089 Jim_SetResult(interp, argv[2]);
14091 return JIM_OK;
14094 /* [info references] */
14095 static int JimInfoReferences(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14097 Jim_Obj *listObjPtr;
14098 Jim_HashTableIterator htiter;
14099 Jim_HashEntry *he;
14101 listObjPtr = Jim_NewListObj(interp, NULL, 0);
14103 JimInitHashTableIterator(&interp->references, &htiter);
14104 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14105 char buf[JIM_REFERENCE_SPACE + 1];
14106 Jim_Reference *refPtr = Jim_GetHashEntryVal(he);
14107 const unsigned long *refId = he->key;
14109 JimFormatReference(buf, refPtr, *refId);
14110 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, buf, -1));
14112 Jim_SetResult(interp, listObjPtr);
14113 return JIM_OK;
14115 #endif /* JIM_REFERENCES && !JIM_BOOTSTRAP */
14117 /* [rename] */
14118 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14120 if (argc != 3) {
14121 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
14122 return JIM_ERR;
14125 return Jim_RenameCommand(interp, argv[1], argv[2]);
14128 #define JIM_DICTMATCH_KEYS 0x0001
14129 #define JIM_DICTMATCH_VALUES 0x002
14132 * match_type must be one of JIM_DICTMATCH_KEYS or JIM_DICTMATCH_VALUES
14133 * return_types should be either or both
14135 int Jim_DictMatchTypes(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObj, int match_type, int return_types)
14137 Jim_HashEntry *he;
14138 Jim_Obj *listObjPtr;
14139 Jim_HashTableIterator htiter;
14141 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14142 return JIM_ERR;
14145 listObjPtr = Jim_NewListObj(interp, NULL, 0);
14147 JimInitHashTableIterator(objPtr->internalRep.ptr, &htiter);
14148 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14149 if (patternObj) {
14150 Jim_Obj *matchObj = (match_type == JIM_DICTMATCH_KEYS) ? (Jim_Obj *)he->key : Jim_GetHashEntryVal(he);
14151 if (!Jim_StringMatchObj(interp, patternObj, matchObj, 0)) {
14152 /* no match */
14153 continue;
14156 if (return_types & JIM_DICTMATCH_KEYS) {
14157 Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->key);
14159 if (return_types & JIM_DICTMATCH_VALUES) {
14160 Jim_ListAppendElement(interp, listObjPtr, Jim_GetHashEntryVal(he));
14164 Jim_SetResult(interp, listObjPtr);
14165 return JIM_OK;
14168 int Jim_DictSize(Jim_Interp *interp, Jim_Obj *objPtr)
14170 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14171 return -1;
14173 return ((Jim_HashTable *)objPtr->internalRep.ptr)->used;
14177 * Must be called with at least one object.
14178 * Returns the new dictionary, or NULL on error.
14180 Jim_Obj *Jim_DictMerge(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
14182 Jim_Obj *objPtr = Jim_NewDictObj(interp, NULL, 0);
14183 int i;
14185 JimPanic((objc == 0, "Jim_DictMerge called with objc=0"));
14187 /* Note that we don't optimise the trivial case of a single argument */
14189 for (i = 0; i < objc; i++) {
14190 Jim_HashTable *ht;
14191 Jim_HashTableIterator htiter;
14192 Jim_HashEntry *he;
14194 if (SetDictFromAny(interp, objv[i]) != JIM_OK) {
14195 Jim_FreeNewObj(interp, objPtr);
14196 return NULL;
14198 ht = objv[i]->internalRep.ptr;
14199 JimInitHashTableIterator(ht, &htiter);
14200 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14201 Jim_ReplaceHashEntry(objPtr->internalRep.ptr, Jim_GetHashEntryKey(he), Jim_GetHashEntryVal(he));
14204 return objPtr;
14207 int Jim_DictInfo(Jim_Interp *interp, Jim_Obj *objPtr)
14209 Jim_HashTable *ht;
14210 unsigned int i;
14211 char buffer[100];
14212 int sum = 0;
14213 int nonzero_count = 0;
14214 Jim_Obj *output;
14215 int bucket_counts[11] = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 };
14217 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14218 return JIM_ERR;
14221 ht = (Jim_HashTable *)objPtr->internalRep.ptr;
14223 /* Note that this uses internal knowledge of the hash table */
14224 snprintf(buffer, sizeof(buffer), "%d entries in table, %d buckets\n", ht->used, ht->size);
14225 output = Jim_NewStringObj(interp, buffer, -1);
14227 for (i = 0; i < ht->size; i++) {
14228 Jim_HashEntry *he = ht->table[i];
14229 int entries = 0;
14230 while (he) {
14231 entries++;
14232 he = he->next;
14234 if (entries > 9) {
14235 bucket_counts[10]++;
14237 else {
14238 bucket_counts[entries]++;
14240 if (entries) {
14241 sum += entries;
14242 nonzero_count++;
14245 for (i = 0; i < 10; i++) {
14246 snprintf(buffer, sizeof(buffer), "number of buckets with %d entries: %d\n", i, bucket_counts[i]);
14247 Jim_AppendString(interp, output, buffer, -1);
14249 snprintf(buffer, sizeof(buffer), "number of buckets with 10 or more entries: %d\n", bucket_counts[10]);
14250 Jim_AppendString(interp, output, buffer, -1);
14251 snprintf(buffer, sizeof(buffer), "average search distance for entry: %.1f", nonzero_count ? (double)sum / nonzero_count : 0.0);
14252 Jim_AppendString(interp, output, buffer, -1);
14253 Jim_SetResult(interp, output);
14254 return JIM_OK;
14257 static int Jim_EvalEnsemble(Jim_Interp *interp, const char *basecmd, const char *subcmd, int argc, Jim_Obj *const *argv)
14259 Jim_Obj *prefixObj = Jim_NewStringObj(interp, basecmd, -1);
14261 Jim_AppendString(interp, prefixObj, " ", 1);
14262 Jim_AppendString(interp, prefixObj, subcmd, -1);
14264 return Jim_EvalObjPrefix(interp, prefixObj, argc, argv);
14268 * Implements the [dict with] command
14270 static int JimDictWith(Jim_Interp *interp, Jim_Obj *dictVarName, Jim_Obj *const *keyv, int keyc, Jim_Obj *scriptObj)
14272 int i;
14273 Jim_Obj *objPtr;
14274 Jim_Obj *dictObj;
14275 Jim_Obj **dictValues;
14276 int len;
14277 int ret = JIM_OK;
14279 /* Open up the appropriate level of the dictionary */
14280 dictObj = Jim_GetVariable(interp, dictVarName, JIM_ERRMSG);
14281 if (dictObj == NULL || Jim_DictKeysVector(interp, dictObj, keyv, keyc, &objPtr, JIM_ERRMSG) != JIM_OK) {
14282 return JIM_ERR;
14284 /* Set the local variables */
14285 if (Jim_DictPairs(interp, objPtr, &dictValues, &len) == JIM_ERR) {
14286 return JIM_ERR;
14288 for (i = 0; i < len; i += 2) {
14289 if (Jim_SetVariable(interp, dictValues[i], dictValues[i + 1]) == JIM_ERR) {
14290 Jim_Free(dictValues);
14291 return JIM_ERR;
14295 /* As an optimisation, if the script is empty, no need to evaluate it or update the dict */
14296 if (Jim_Length(scriptObj)) {
14297 ret = Jim_EvalObj(interp, scriptObj);
14299 /* Now if the dictionary still exists, update it based on the local variables */
14300 if (ret == JIM_OK && Jim_GetVariable(interp, dictVarName, 0) != NULL) {
14301 /* We need a copy of keyv with one extra element at the end for Jim_SetDictKeysVector() */
14302 Jim_Obj **newkeyv = Jim_Alloc(sizeof(*newkeyv) * (keyc + 1));
14303 for (i = 0; i < keyc; i++) {
14304 newkeyv[i] = keyv[i];
14307 for (i = 0; i < len; i += 2) {
14308 /* This will be NULL if the variable no longer exists, thus deleting the variable */
14309 objPtr = Jim_GetVariable(interp, dictValues[i], 0);
14310 newkeyv[keyc] = dictValues[i];
14311 Jim_SetDictKeysVector(interp, dictVarName, newkeyv, keyc + 1, objPtr, 0);
14313 Jim_Free(newkeyv);
14317 Jim_Free(dictValues);
14319 return ret;
14322 /* [dict] */
14323 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14325 Jim_Obj *objPtr;
14326 int types = JIM_DICTMATCH_KEYS;
14327 int option;
14328 static const char * const options[] = {
14329 "create", "get", "set", "unset", "exists", "keys", "size", "info",
14330 "merge", "with", "append", "lappend", "incr", "remove", "values", "for",
14331 "replace", "update", NULL
14333 enum
14335 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXISTS, OPT_KEYS, OPT_SIZE, OPT_INFO,
14336 OPT_MERGE, OPT_WITH, OPT_APPEND, OPT_LAPPEND, OPT_INCR, OPT_REMOVE, OPT_VALUES, OPT_FOR,
14337 OPT_REPLACE, OPT_UPDATE,
14340 if (argc < 2) {
14341 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?arguments ...?");
14342 return JIM_ERR;
14345 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK) {
14346 return Jim_CheckShowCommands(interp, argv[1], options);
14349 switch (option) {
14350 case OPT_GET:
14351 if (argc < 3) {
14352 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?key ...?");
14353 return JIM_ERR;
14355 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr,
14356 JIM_ERRMSG) != JIM_OK) {
14357 return JIM_ERR;
14359 Jim_SetResult(interp, objPtr);
14360 return JIM_OK;
14362 case OPT_SET:
14363 if (argc < 5) {
14364 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
14365 return JIM_ERR;
14367 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 4, argv[argc - 1], JIM_ERRMSG);
14369 case OPT_EXISTS:
14370 if (argc < 4) {
14371 Jim_WrongNumArgs(interp, 2, argv, "dictionary key ?key ...?");
14372 return JIM_ERR;
14374 else {
14375 int rc = Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr, JIM_NONE);
14376 if (rc < 0) {
14377 return JIM_ERR;
14379 Jim_SetResultBool(interp, rc == JIM_OK);
14380 return JIM_OK;
14383 case OPT_UNSET:
14384 if (argc < 4) {
14385 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
14386 return JIM_ERR;
14388 if (Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 3, NULL, JIM_NONE) != JIM_OK) {
14389 return JIM_ERR;
14391 return JIM_OK;
14393 case OPT_VALUES:
14394 types = JIM_DICTMATCH_VALUES;
14395 /* fallthru */
14396 case OPT_KEYS:
14397 if (argc != 3 && argc != 4) {
14398 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?pattern?");
14399 return JIM_ERR;
14401 return Jim_DictMatchTypes(interp, argv[2], argc == 4 ? argv[3] : NULL, types, types);
14403 case OPT_SIZE:
14404 if (argc != 3) {
14405 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14406 return JIM_ERR;
14408 else if (Jim_DictSize(interp, argv[2]) < 0) {
14409 return JIM_ERR;
14411 Jim_SetResultInt(interp, Jim_DictSize(interp, argv[2]));
14412 return JIM_OK;
14414 case OPT_MERGE:
14415 if (argc == 2) {
14416 return JIM_OK;
14418 objPtr = Jim_DictMerge(interp, argc - 2, argv + 2);
14419 if (objPtr == NULL) {
14420 return JIM_ERR;
14422 Jim_SetResult(interp, objPtr);
14423 return JIM_OK;
14425 case OPT_UPDATE:
14426 if (argc < 6 || argc % 2) {
14427 /* Better error message */
14428 argc = 2;
14430 break;
14432 case OPT_CREATE:
14433 if (argc % 2) {
14434 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
14435 return JIM_ERR;
14437 objPtr = Jim_NewDictObj(interp, argv + 2, argc - 2);
14438 Jim_SetResult(interp, objPtr);
14439 return JIM_OK;
14441 case OPT_INFO:
14442 if (argc != 3) {
14443 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14444 return JIM_ERR;
14446 return Jim_DictInfo(interp, argv[2]);
14448 case OPT_WITH:
14449 if (argc < 4) {
14450 Jim_WrongNumArgs(interp, 2, argv, "dictVar ?key ...? script");
14451 return JIM_ERR;
14453 return JimDictWith(interp, argv[2], argv + 3, argc - 4, argv[argc - 1]);
14455 /* Handle command as an ensemble */
14456 return Jim_EvalEnsemble(interp, "dict", options[option], argc - 2, argv + 2);
14459 /* [subst] */
14460 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14462 static const char * const options[] = {
14463 "-nobackslashes", "-nocommands", "-novariables", NULL
14465 enum
14466 { OPT_NOBACKSLASHES, OPT_NOCOMMANDS, OPT_NOVARIABLES };
14467 int i;
14468 int flags = JIM_SUBST_FLAG;
14469 Jim_Obj *objPtr;
14471 if (argc < 2) {
14472 Jim_WrongNumArgs(interp, 1, argv, "?options? string");
14473 return JIM_ERR;
14475 for (i = 1; i < (argc - 1); i++) {
14476 int option;
14478 if (Jim_GetEnum(interp, argv[i], options, &option, NULL,
14479 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14480 return JIM_ERR;
14482 switch (option) {
14483 case OPT_NOBACKSLASHES:
14484 flags |= JIM_SUBST_NOESC;
14485 break;
14486 case OPT_NOCOMMANDS:
14487 flags |= JIM_SUBST_NOCMD;
14488 break;
14489 case OPT_NOVARIABLES:
14490 flags |= JIM_SUBST_NOVAR;
14491 break;
14494 if (Jim_SubstObj(interp, argv[argc - 1], &objPtr, flags) != JIM_OK) {
14495 return JIM_ERR;
14497 Jim_SetResult(interp, objPtr);
14498 return JIM_OK;
14501 #ifdef jim_ext_namespace
14502 static int JimIsGlobalNamespace(Jim_Obj *objPtr)
14504 int len;
14505 const char *str = Jim_GetString(objPtr, &len);
14506 return len >= 2 && str[0] == ':' && str[1] == ':';
14508 #endif
14510 /* [info] */
14511 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14513 int cmd;
14514 Jim_Obj *objPtr;
14515 int mode = 0;
14517 static const char * const commands[] = {
14518 "body", "statics", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
14519 "vars", "version", "patchlevel", "complete", "args", "hostname",
14520 "script", "source", "stacktrace", "nameofexecutable", "returncodes",
14521 "references", "alias", NULL
14523 enum
14524 { INFO_BODY, INFO_STATICS, INFO_COMMANDS, INFO_PROCS, INFO_CHANNELS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
14525 INFO_FRAME, INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_PATCHLEVEL, INFO_COMPLETE, INFO_ARGS,
14526 INFO_HOSTNAME, INFO_SCRIPT, INFO_SOURCE, INFO_STACKTRACE, INFO_NAMEOFEXECUTABLE,
14527 INFO_RETURNCODES, INFO_REFERENCES, INFO_ALIAS,
14530 #ifdef jim_ext_namespace
14531 int nons = 0;
14533 if (argc > 2 && Jim_CompareStringImmediate(interp, argv[1], "-nons")) {
14534 /* This is for internal use only */
14535 argc--;
14536 argv++;
14537 nons = 1;
14539 #endif
14541 if (argc < 2) {
14542 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?args ...?");
14543 return JIM_ERR;
14545 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "subcommand", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14546 return Jim_CheckShowCommands(interp, argv[1], commands);
14549 /* Test for the most common commands first, just in case it makes a difference */
14550 switch (cmd) {
14551 case INFO_EXISTS:
14552 if (argc != 3) {
14553 Jim_WrongNumArgs(interp, 2, argv, "varName");
14554 return JIM_ERR;
14556 Jim_SetResultBool(interp, Jim_GetVariable(interp, argv[2], 0) != NULL);
14557 break;
14559 case INFO_ALIAS:{
14560 Jim_Cmd *cmdPtr;
14562 if (argc != 3) {
14563 Jim_WrongNumArgs(interp, 2, argv, "command");
14564 return JIM_ERR;
14566 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14567 return JIM_ERR;
14569 if (cmdPtr->isproc || cmdPtr->u.native.cmdProc != JimAliasCmd) {
14570 Jim_SetResultFormatted(interp, "command \"%#s\" is not an alias", argv[2]);
14571 return JIM_ERR;
14573 Jim_SetResult(interp, (Jim_Obj *)cmdPtr->u.native.privData);
14574 return JIM_OK;
14577 case INFO_CHANNELS:
14578 mode++; /* JIM_CMDLIST_CHANNELS */
14579 #ifndef jim_ext_aio
14580 Jim_SetResultString(interp, "aio not enabled", -1);
14581 return JIM_ERR;
14582 #endif
14583 /* fall through */
14584 case INFO_PROCS:
14585 mode++; /* JIM_CMDLIST_PROCS */
14586 /* fall through */
14587 case INFO_COMMANDS:
14588 /* mode 0 => JIM_CMDLIST_COMMANDS */
14589 if (argc != 2 && argc != 3) {
14590 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14591 return JIM_ERR;
14593 #ifdef jim_ext_namespace
14594 if (!nons) {
14595 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimIsGlobalNamespace(argv[2]))) {
14596 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14599 #endif
14600 Jim_SetResult(interp, JimCommandsList(interp, (argc == 3) ? argv[2] : NULL, mode));
14601 break;
14603 case INFO_VARS:
14604 mode++; /* JIM_VARLIST_VARS */
14605 /* fall through */
14606 case INFO_LOCALS:
14607 mode++; /* JIM_VARLIST_LOCALS */
14608 /* fall through */
14609 case INFO_GLOBALS:
14610 /* mode 0 => JIM_VARLIST_GLOBALS */
14611 if (argc != 2 && argc != 3) {
14612 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14613 return JIM_ERR;
14615 #ifdef jim_ext_namespace
14616 if (!nons) {
14617 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimIsGlobalNamespace(argv[2]))) {
14618 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14621 #endif
14622 Jim_SetResult(interp, JimVariablesList(interp, argc == 3 ? argv[2] : NULL, mode));
14623 break;
14625 case INFO_SCRIPT:
14626 if (argc != 2) {
14627 Jim_WrongNumArgs(interp, 2, argv, "");
14628 return JIM_ERR;
14630 Jim_SetResult(interp, JimGetScript(interp, interp->currentScriptObj)->fileNameObj);
14631 break;
14633 case INFO_SOURCE:{
14634 jim_wide line;
14635 Jim_Obj *resObjPtr;
14636 Jim_Obj *fileNameObj;
14638 if (argc != 3 && argc != 5) {
14639 Jim_WrongNumArgs(interp, 2, argv, "source ?filename line?");
14640 return JIM_ERR;
14642 if (argc == 5) {
14643 if (Jim_GetWide(interp, argv[4], &line) != JIM_OK) {
14644 return JIM_ERR;
14646 resObjPtr = Jim_NewStringObj(interp, Jim_String(argv[2]), Jim_Length(argv[2]));
14647 JimSetSourceInfo(interp, resObjPtr, argv[3], line);
14649 else {
14650 if (argv[2]->typePtr == &sourceObjType) {
14651 fileNameObj = argv[2]->internalRep.sourceValue.fileNameObj;
14652 line = argv[2]->internalRep.sourceValue.lineNumber;
14654 else if (argv[2]->typePtr == &scriptObjType) {
14655 ScriptObj *script = JimGetScript(interp, argv[2]);
14656 fileNameObj = script->fileNameObj;
14657 line = script->firstline;
14659 else {
14660 fileNameObj = interp->emptyObj;
14661 line = 1;
14663 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14664 Jim_ListAppendElement(interp, resObjPtr, fileNameObj);
14665 Jim_ListAppendElement(interp, resObjPtr, Jim_NewIntObj(interp, line));
14667 Jim_SetResult(interp, resObjPtr);
14668 break;
14671 case INFO_STACKTRACE:
14672 Jim_SetResult(interp, interp->stackTrace);
14673 break;
14675 case INFO_LEVEL:
14676 case INFO_FRAME:
14677 switch (argc) {
14678 case 2:
14679 Jim_SetResultInt(interp, interp->framePtr->level);
14680 break;
14682 case 3:
14683 if (JimInfoLevel(interp, argv[2], &objPtr, cmd == INFO_LEVEL) != JIM_OK) {
14684 return JIM_ERR;
14686 Jim_SetResult(interp, objPtr);
14687 break;
14689 default:
14690 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
14691 return JIM_ERR;
14693 break;
14695 case INFO_BODY:
14696 case INFO_STATICS:
14697 case INFO_ARGS:{
14698 Jim_Cmd *cmdPtr;
14700 if (argc != 3) {
14701 Jim_WrongNumArgs(interp, 2, argv, "procname");
14702 return JIM_ERR;
14704 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14705 return JIM_ERR;
14707 if (!cmdPtr->isproc) {
14708 Jim_SetResultFormatted(interp, "command \"%#s\" is not a procedure", argv[2]);
14709 return JIM_ERR;
14711 switch (cmd) {
14712 case INFO_BODY:
14713 Jim_SetResult(interp, cmdPtr->u.proc.bodyObjPtr);
14714 break;
14715 case INFO_ARGS:
14716 Jim_SetResult(interp, cmdPtr->u.proc.argListObjPtr);
14717 break;
14718 case INFO_STATICS:
14719 if (cmdPtr->u.proc.staticVars) {
14720 Jim_SetResult(interp, JimHashtablePatternMatch(interp, cmdPtr->u.proc.staticVars,
14721 NULL, JimVariablesMatch, JIM_VARLIST_LOCALS | JIM_VARLIST_VALUES));
14723 break;
14725 break;
14728 case INFO_VERSION:
14729 case INFO_PATCHLEVEL:{
14730 char buf[(JIM_INTEGER_SPACE * 2) + 1];
14732 sprintf(buf, "%d.%d", JIM_VERSION / 100, JIM_VERSION % 100);
14733 Jim_SetResultString(interp, buf, -1);
14734 break;
14737 case INFO_COMPLETE:
14738 if (argc != 3 && argc != 4) {
14739 Jim_WrongNumArgs(interp, 2, argv, "script ?missing?");
14740 return JIM_ERR;
14742 else {
14743 char missing;
14745 Jim_SetResultBool(interp, Jim_ScriptIsComplete(interp, argv[2], &missing));
14746 if (missing != ' ' && argc == 4) {
14747 Jim_SetVariable(interp, argv[3], Jim_NewStringObj(interp, &missing, 1));
14750 break;
14752 case INFO_HOSTNAME:
14753 /* Redirect to os.gethostname if it exists */
14754 return Jim_Eval(interp, "os.gethostname");
14756 case INFO_NAMEOFEXECUTABLE:
14757 /* Redirect to Tcl proc */
14758 return Jim_Eval(interp, "{info nameofexecutable}");
14760 case INFO_RETURNCODES:
14761 if (argc == 2) {
14762 int i;
14763 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14765 for (i = 0; jimReturnCodes[i]; i++) {
14766 Jim_ListAppendElement(interp, listObjPtr, Jim_NewIntObj(interp, i));
14767 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp,
14768 jimReturnCodes[i], -1));
14771 Jim_SetResult(interp, listObjPtr);
14773 else if (argc == 3) {
14774 long code;
14775 const char *name;
14777 if (Jim_GetLong(interp, argv[2], &code) != JIM_OK) {
14778 return JIM_ERR;
14780 name = Jim_ReturnCode(code);
14781 if (*name == '?') {
14782 Jim_SetResultInt(interp, code);
14784 else {
14785 Jim_SetResultString(interp, name, -1);
14788 else {
14789 Jim_WrongNumArgs(interp, 2, argv, "?code?");
14790 return JIM_ERR;
14792 break;
14793 case INFO_REFERENCES:
14794 #ifdef JIM_REFERENCES
14795 return JimInfoReferences(interp, argc, argv);
14796 #else
14797 Jim_SetResultString(interp, "not supported", -1);
14798 return JIM_ERR;
14799 #endif
14801 return JIM_OK;
14804 /* [exists] */
14805 static int Jim_ExistsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14807 Jim_Obj *objPtr;
14808 int result = 0;
14810 static const char * const options[] = {
14811 "-command", "-proc", "-alias", "-var", NULL
14813 enum
14815 OPT_COMMAND, OPT_PROC, OPT_ALIAS, OPT_VAR
14817 int option;
14819 if (argc == 2) {
14820 option = OPT_VAR;
14821 objPtr = argv[1];
14823 else if (argc == 3) {
14824 if (Jim_GetEnum(interp, argv[1], options, &option, NULL, JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14825 return JIM_ERR;
14827 objPtr = argv[2];
14829 else {
14830 Jim_WrongNumArgs(interp, 1, argv, "?option? name");
14831 return JIM_ERR;
14834 if (option == OPT_VAR) {
14835 result = Jim_GetVariable(interp, objPtr, 0) != NULL;
14837 else {
14838 /* Now different kinds of commands */
14839 Jim_Cmd *cmd = Jim_GetCommand(interp, objPtr, JIM_NONE);
14841 if (cmd) {
14842 switch (option) {
14843 case OPT_COMMAND:
14844 result = 1;
14845 break;
14847 case OPT_ALIAS:
14848 result = cmd->isproc == 0 && cmd->u.native.cmdProc == JimAliasCmd;
14849 break;
14851 case OPT_PROC:
14852 result = cmd->isproc;
14853 break;
14857 Jim_SetResultBool(interp, result);
14858 return JIM_OK;
14861 /* [split] */
14862 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14864 const char *str, *splitChars, *noMatchStart;
14865 int splitLen, strLen;
14866 Jim_Obj *resObjPtr;
14867 int c;
14868 int len;
14870 if (argc != 2 && argc != 3) {
14871 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
14872 return JIM_ERR;
14875 str = Jim_GetString(argv[1], &len);
14876 if (len == 0) {
14877 return JIM_OK;
14879 strLen = Jim_Utf8Length(interp, argv[1]);
14881 /* Init */
14882 if (argc == 2) {
14883 splitChars = " \n\t\r";
14884 splitLen = 4;
14886 else {
14887 splitChars = Jim_String(argv[2]);
14888 splitLen = Jim_Utf8Length(interp, argv[2]);
14891 noMatchStart = str;
14892 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14894 /* Split */
14895 if (splitLen) {
14896 Jim_Obj *objPtr;
14897 while (strLen--) {
14898 const char *sc = splitChars;
14899 int scLen = splitLen;
14900 int sl = utf8_tounicode(str, &c);
14901 while (scLen--) {
14902 int pc;
14903 sc += utf8_tounicode(sc, &pc);
14904 if (c == pc) {
14905 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14906 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14907 noMatchStart = str + sl;
14908 break;
14911 str += sl;
14913 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14914 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14916 else {
14917 /* This handles the special case of splitchars eq {}
14918 * Optimise by sharing common (ASCII) characters
14920 Jim_Obj **commonObj = NULL;
14921 #define NUM_COMMON (128 - 9)
14922 while (strLen--) {
14923 int n = utf8_tounicode(str, &c);
14924 #ifdef JIM_OPTIMIZATION
14925 if (c >= 9 && c < 128) {
14926 /* Common ASCII char. Note that 9 is the tab character */
14927 c -= 9;
14928 if (!commonObj) {
14929 commonObj = Jim_Alloc(sizeof(*commonObj) * NUM_COMMON);
14930 memset(commonObj, 0, sizeof(*commonObj) * NUM_COMMON);
14932 if (!commonObj[c]) {
14933 commonObj[c] = Jim_NewStringObj(interp, str, 1);
14935 Jim_ListAppendElement(interp, resObjPtr, commonObj[c]);
14936 str++;
14937 continue;
14939 #endif
14940 Jim_ListAppendElement(interp, resObjPtr, Jim_NewStringObjUtf8(interp, str, 1));
14941 str += n;
14943 Jim_Free(commonObj);
14946 Jim_SetResult(interp, resObjPtr);
14947 return JIM_OK;
14950 /* [join] */
14951 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14953 const char *joinStr;
14954 int joinStrLen;
14956 if (argc != 2 && argc != 3) {
14957 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
14958 return JIM_ERR;
14960 /* Init */
14961 if (argc == 2) {
14962 joinStr = " ";
14963 joinStrLen = 1;
14965 else {
14966 joinStr = Jim_GetString(argv[2], &joinStrLen);
14968 Jim_SetResult(interp, Jim_ListJoin(interp, argv[1], joinStr, joinStrLen));
14969 return JIM_OK;
14972 /* [format] */
14973 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14975 Jim_Obj *objPtr;
14977 if (argc < 2) {
14978 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
14979 return JIM_ERR;
14981 objPtr = Jim_FormatString(interp, argv[1], argc - 2, argv + 2);
14982 if (objPtr == NULL)
14983 return JIM_ERR;
14984 Jim_SetResult(interp, objPtr);
14985 return JIM_OK;
14988 /* [scan] */
14989 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14991 Jim_Obj *listPtr, **outVec;
14992 int outc, i;
14994 if (argc < 3) {
14995 Jim_WrongNumArgs(interp, 1, argv, "string format ?varName varName ...?");
14996 return JIM_ERR;
14998 if (argv[2]->typePtr != &scanFmtStringObjType)
14999 SetScanFmtFromAny(interp, argv[2]);
15000 if (FormatGetError(argv[2]) != 0) {
15001 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
15002 return JIM_ERR;
15004 if (argc > 3) {
15005 int maxPos = FormatGetMaxPos(argv[2]);
15006 int count = FormatGetCnvCount(argv[2]);
15008 if (maxPos > argc - 3) {
15009 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
15010 return JIM_ERR;
15012 else if (count > argc - 3) {
15013 Jim_SetResultString(interp, "different numbers of variable names and "
15014 "field specifiers", -1);
15015 return JIM_ERR;
15017 else if (count < argc - 3) {
15018 Jim_SetResultString(interp, "variable is not assigned by any "
15019 "conversion specifiers", -1);
15020 return JIM_ERR;
15023 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
15024 if (listPtr == 0)
15025 return JIM_ERR;
15026 if (argc > 3) {
15027 int rc = JIM_OK;
15028 int count = 0;
15030 if (listPtr != 0 && listPtr != (Jim_Obj *)EOF) {
15031 int len = Jim_ListLength(interp, listPtr);
15033 if (len != 0) {
15034 JimListGetElements(interp, listPtr, &outc, &outVec);
15035 for (i = 0; i < outc; ++i) {
15036 if (Jim_Length(outVec[i]) > 0) {
15037 ++count;
15038 if (Jim_SetVariable(interp, argv[3 + i], outVec[i]) != JIM_OK) {
15039 rc = JIM_ERR;
15044 Jim_FreeNewObj(interp, listPtr);
15046 else {
15047 count = -1;
15049 if (rc == JIM_OK) {
15050 Jim_SetResultInt(interp, count);
15052 return rc;
15054 else {
15055 if (listPtr == (Jim_Obj *)EOF) {
15056 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
15057 return JIM_OK;
15059 Jim_SetResult(interp, listPtr);
15061 return JIM_OK;
15064 /* [error] */
15065 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15067 if (argc != 2 && argc != 3) {
15068 Jim_WrongNumArgs(interp, 1, argv, "message ?stacktrace?");
15069 return JIM_ERR;
15071 Jim_SetResult(interp, argv[1]);
15072 if (argc == 3) {
15073 JimSetStackTrace(interp, argv[2]);
15074 return JIM_ERR;
15076 interp->addStackTrace++;
15077 return JIM_ERR;
15080 /* [lrange] */
15081 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15083 Jim_Obj *objPtr;
15085 if (argc != 4) {
15086 Jim_WrongNumArgs(interp, 1, argv, "list first last");
15087 return JIM_ERR;
15089 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
15090 return JIM_ERR;
15091 Jim_SetResult(interp, objPtr);
15092 return JIM_OK;
15095 /* [lrepeat] */
15096 static int Jim_LrepeatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15098 Jim_Obj *objPtr;
15099 long count;
15101 if (argc < 2 || Jim_GetLong(interp, argv[1], &count) != JIM_OK || count < 0) {
15102 Jim_WrongNumArgs(interp, 1, argv, "count ?value ...?");
15103 return JIM_ERR;
15106 if (count == 0 || argc == 2) {
15107 return JIM_OK;
15110 argc -= 2;
15111 argv += 2;
15113 objPtr = Jim_NewListObj(interp, argv, argc);
15114 while (--count) {
15115 ListInsertElements(objPtr, -1, argc, argv);
15118 Jim_SetResult(interp, objPtr);
15119 return JIM_OK;
15122 char **Jim_GetEnviron(void)
15124 #if defined(HAVE__NSGETENVIRON)
15125 return *_NSGetEnviron();
15126 #else
15127 #if !defined(NO_ENVIRON_EXTERN)
15128 extern char **environ;
15129 #endif
15131 return environ;
15132 #endif
15135 void Jim_SetEnviron(char **env)
15137 #if defined(HAVE__NSGETENVIRON)
15138 *_NSGetEnviron() = env;
15139 #else
15140 #if !defined(NO_ENVIRON_EXTERN)
15141 extern char **environ;
15142 #endif
15144 environ = env;
15145 #endif
15148 /* [env] */
15149 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15151 const char *key;
15152 const char *val;
15154 if (argc == 1) {
15155 char **e = Jim_GetEnviron();
15157 int i;
15158 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
15160 for (i = 0; e[i]; i++) {
15161 const char *equals = strchr(e[i], '=');
15163 if (equals) {
15164 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, e[i],
15165 equals - e[i]));
15166 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
15170 Jim_SetResult(interp, listObjPtr);
15171 return JIM_OK;
15174 if (argc > 3) {
15175 Jim_WrongNumArgs(interp, 1, argv, "varName ?default?");
15176 return JIM_ERR;
15178 key = Jim_String(argv[1]);
15179 val = getenv(key);
15180 if (val == NULL) {
15181 if (argc < 3) {
15182 Jim_SetResultFormatted(interp, "environment variable \"%#s\" does not exist", argv[1]);
15183 return JIM_ERR;
15185 val = Jim_String(argv[2]);
15187 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
15188 return JIM_OK;
15191 /* [source] */
15192 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15194 int retval;
15196 if (argc != 2) {
15197 Jim_WrongNumArgs(interp, 1, argv, "fileName");
15198 return JIM_ERR;
15200 retval = Jim_EvalFile(interp, Jim_String(argv[1]));
15201 if (retval == JIM_RETURN)
15202 return JIM_OK;
15203 return retval;
15206 /* [lreverse] */
15207 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15209 Jim_Obj *revObjPtr, **ele;
15210 int len;
15212 if (argc != 2) {
15213 Jim_WrongNumArgs(interp, 1, argv, "list");
15214 return JIM_ERR;
15216 JimListGetElements(interp, argv[1], &len, &ele);
15217 len--;
15218 revObjPtr = Jim_NewListObj(interp, NULL, 0);
15219 while (len >= 0)
15220 ListAppendElement(revObjPtr, ele[len--]);
15221 Jim_SetResult(interp, revObjPtr);
15222 return JIM_OK;
15225 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
15227 jim_wide len;
15229 if (step == 0)
15230 return -1;
15231 if (start == end)
15232 return 0;
15233 else if (step > 0 && start > end)
15234 return -1;
15235 else if (step < 0 && end > start)
15236 return -1;
15237 len = end - start;
15238 if (len < 0)
15239 len = -len; /* abs(len) */
15240 if (step < 0)
15241 step = -step; /* abs(step) */
15242 len = 1 + ((len - 1) / step);
15243 /* We can truncate safely to INT_MAX, the range command
15244 * will always return an error for a such long range
15245 * because Tcl lists can't be so long. */
15246 if (len > INT_MAX)
15247 len = INT_MAX;
15248 return (int)((len < 0) ? -1 : len);
15251 /* [range] */
15252 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15254 jim_wide start = 0, end, step = 1;
15255 int len, i;
15256 Jim_Obj *objPtr;
15258 if (argc < 2 || argc > 4) {
15259 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
15260 return JIM_ERR;
15262 if (argc == 2) {
15263 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
15264 return JIM_ERR;
15266 else {
15267 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
15268 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
15269 return JIM_ERR;
15270 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
15271 return JIM_ERR;
15273 if ((len = JimRangeLen(start, end, step)) == -1) {
15274 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
15275 return JIM_ERR;
15277 objPtr = Jim_NewListObj(interp, NULL, 0);
15278 for (i = 0; i < len; i++)
15279 ListAppendElement(objPtr, Jim_NewIntObj(interp, start + i * step));
15280 Jim_SetResult(interp, objPtr);
15281 return JIM_OK;
15284 /* [rand] */
15285 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15287 jim_wide min = 0, max = 0, len, maxMul;
15289 if (argc < 1 || argc > 3) {
15290 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
15291 return JIM_ERR;
15293 if (argc == 1) {
15294 max = JIM_WIDE_MAX;
15295 } else if (argc == 2) {
15296 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
15297 return JIM_ERR;
15298 } else if (argc == 3) {
15299 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
15300 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
15301 return JIM_ERR;
15303 len = max-min;
15304 if (len < 0) {
15305 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
15306 return JIM_ERR;
15308 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
15309 while (1) {
15310 jim_wide r;
15312 JimRandomBytes(interp, &r, sizeof(jim_wide));
15313 if (r < 0 || r >= maxMul) continue;
15314 r = (len == 0) ? 0 : r%len;
15315 Jim_SetResultInt(interp, min+r);
15316 return JIM_OK;
15320 static const struct {
15321 const char *name;
15322 Jim_CmdProc *cmdProc;
15323 } Jim_CoreCommandsTable[] = {
15324 {"alias", Jim_AliasCoreCommand},
15325 {"set", Jim_SetCoreCommand},
15326 {"unset", Jim_UnsetCoreCommand},
15327 {"puts", Jim_PutsCoreCommand},
15328 {"+", Jim_AddCoreCommand},
15329 {"*", Jim_MulCoreCommand},
15330 {"-", Jim_SubCoreCommand},
15331 {"/", Jim_DivCoreCommand},
15332 {"incr", Jim_IncrCoreCommand},
15333 {"while", Jim_WhileCoreCommand},
15334 {"loop", Jim_LoopCoreCommand},
15335 {"for", Jim_ForCoreCommand},
15336 {"foreach", Jim_ForeachCoreCommand},
15337 {"lmap", Jim_LmapCoreCommand},
15338 {"lassign", Jim_LassignCoreCommand},
15339 {"if", Jim_IfCoreCommand},
15340 {"switch", Jim_SwitchCoreCommand},
15341 {"list", Jim_ListCoreCommand},
15342 {"lindex", Jim_LindexCoreCommand},
15343 {"lset", Jim_LsetCoreCommand},
15344 {"lsearch", Jim_LsearchCoreCommand},
15345 {"llength", Jim_LlengthCoreCommand},
15346 {"lappend", Jim_LappendCoreCommand},
15347 {"linsert", Jim_LinsertCoreCommand},
15348 {"lreplace", Jim_LreplaceCoreCommand},
15349 {"lsort", Jim_LsortCoreCommand},
15350 {"append", Jim_AppendCoreCommand},
15351 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
15352 {"debug", Jim_DebugCoreCommand},
15353 #endif
15354 {"eval", Jim_EvalCoreCommand},
15355 {"uplevel", Jim_UplevelCoreCommand},
15356 {"expr", Jim_ExprCoreCommand},
15357 {"break", Jim_BreakCoreCommand},
15358 {"continue", Jim_ContinueCoreCommand},
15359 {"proc", Jim_ProcCoreCommand},
15360 {"concat", Jim_ConcatCoreCommand},
15361 {"return", Jim_ReturnCoreCommand},
15362 {"upvar", Jim_UpvarCoreCommand},
15363 {"global", Jim_GlobalCoreCommand},
15364 {"string", Jim_StringCoreCommand},
15365 {"time", Jim_TimeCoreCommand},
15366 {"exit", Jim_ExitCoreCommand},
15367 {"catch", Jim_CatchCoreCommand},
15368 #ifdef JIM_REFERENCES
15369 {"ref", Jim_RefCoreCommand},
15370 {"getref", Jim_GetrefCoreCommand},
15371 {"setref", Jim_SetrefCoreCommand},
15372 {"finalize", Jim_FinalizeCoreCommand},
15373 {"collect", Jim_CollectCoreCommand},
15374 #endif
15375 {"rename", Jim_RenameCoreCommand},
15376 {"dict", Jim_DictCoreCommand},
15377 {"subst", Jim_SubstCoreCommand},
15378 {"info", Jim_InfoCoreCommand},
15379 {"exists", Jim_ExistsCoreCommand},
15380 {"split", Jim_SplitCoreCommand},
15381 {"join", Jim_JoinCoreCommand},
15382 {"format", Jim_FormatCoreCommand},
15383 {"scan", Jim_ScanCoreCommand},
15384 {"error", Jim_ErrorCoreCommand},
15385 {"lrange", Jim_LrangeCoreCommand},
15386 {"lrepeat", Jim_LrepeatCoreCommand},
15387 {"env", Jim_EnvCoreCommand},
15388 {"source", Jim_SourceCoreCommand},
15389 {"lreverse", Jim_LreverseCoreCommand},
15390 {"range", Jim_RangeCoreCommand},
15391 {"rand", Jim_RandCoreCommand},
15392 {"tailcall", Jim_TailcallCoreCommand},
15393 {"local", Jim_LocalCoreCommand},
15394 {"upcall", Jim_UpcallCoreCommand},
15395 {"apply", Jim_ApplyCoreCommand},
15396 {NULL, NULL},
15399 void Jim_RegisterCoreCommands(Jim_Interp *interp)
15401 int i = 0;
15403 while (Jim_CoreCommandsTable[i].name != NULL) {
15404 Jim_CreateCommand(interp,
15405 Jim_CoreCommandsTable[i].name, Jim_CoreCommandsTable[i].cmdProc, NULL, NULL);
15406 i++;
15410 /* -----------------------------------------------------------------------------
15411 * Interactive prompt
15412 * ---------------------------------------------------------------------------*/
15413 void Jim_MakeErrorMessage(Jim_Interp *interp)
15415 Jim_Obj *argv[2];
15417 argv[0] = Jim_NewStringObj(interp, "errorInfo", -1);
15418 argv[1] = interp->result;
15420 Jim_EvalObjVector(interp, 2, argv);
15424 * Given a null terminated array of strings, returns an allocated, sorted
15425 * copy of the array.
15427 static char **JimSortStringTable(const char *const *tablePtr)
15429 int count;
15430 char **tablePtrSorted;
15432 /* Find the size of the table */
15433 for (count = 0; tablePtr[count]; count++) {
15436 /* Allocate one extra for the terminating NULL pointer */
15437 tablePtrSorted = Jim_Alloc(sizeof(char *) * (count + 1));
15438 memcpy(tablePtrSorted, tablePtr, sizeof(char *) * count);
15439 qsort(tablePtrSorted, count, sizeof(char *), qsortCompareStringPointers);
15440 tablePtrSorted[count] = NULL;
15442 return tablePtrSorted;
15445 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
15446 const char *prefix, const char *const *tablePtr, const char *name)
15448 char **tablePtrSorted;
15449 int i;
15451 if (name == NULL) {
15452 name = "option";
15455 Jim_SetResultFormatted(interp, "%s%s \"%s\": must be ", badtype, name, arg);
15456 tablePtrSorted = JimSortStringTable(tablePtr);
15457 for (i = 0; tablePtrSorted[i]; i++) {
15458 if (tablePtrSorted[i + 1] == NULL && i > 0) {
15459 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
15461 Jim_AppendStrings(interp, Jim_GetResult(interp), prefix, tablePtrSorted[i], NULL);
15462 if (tablePtrSorted[i + 1]) {
15463 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
15466 Jim_Free(tablePtrSorted);
15471 * If objPtr is "-commands" sets the Jim result as a sorted list of options in the table
15472 * and returns JIM_OK.
15474 * Otherwise returns JIM_ERR.
15476 int Jim_CheckShowCommands(Jim_Interp *interp, Jim_Obj *objPtr, const char *const *tablePtr)
15478 if (Jim_CompareStringImmediate(interp, objPtr, "-commands")) {
15479 int i;
15480 char **tablePtrSorted = JimSortStringTable(tablePtr);
15481 Jim_SetResult(interp, Jim_NewListObj(interp, NULL, 0));
15482 for (i = 0; tablePtrSorted[i]; i++) {
15483 Jim_ListAppendElement(interp, Jim_GetResult(interp), Jim_NewStringObj(interp, tablePtrSorted[i], -1));
15485 Jim_Free(tablePtrSorted);
15486 return JIM_OK;
15488 return JIM_ERR;
15491 /* internal rep is stored in ptrIntvalue
15492 * ptr = tablePtr
15493 * int1 = flags
15494 * int2 = index
15496 static const Jim_ObjType getEnumObjType = {
15497 "get-enum",
15498 NULL,
15499 NULL,
15500 NULL,
15501 JIM_TYPE_REFERENCES
15504 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
15505 const char *const *tablePtr, int *indexPtr, const char *name, int flags)
15507 const char *bad = "bad ";
15508 const char *const *entryPtr = NULL;
15509 int i;
15510 int match = -1;
15511 int arglen;
15512 const char *arg;
15514 if (objPtr->typePtr == &getEnumObjType) {
15515 if (objPtr->internalRep.ptrIntValue.ptr == tablePtr && objPtr->internalRep.ptrIntValue.int1 == flags) {
15516 *indexPtr = objPtr->internalRep.ptrIntValue.int2;
15517 return JIM_OK;
15521 arg = Jim_GetString(objPtr, &arglen);
15523 *indexPtr = -1;
15525 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
15526 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
15527 /* Found an exact match */
15528 match = i;
15529 goto found;
15531 if (flags & JIM_ENUM_ABBREV) {
15532 /* Accept an unambiguous abbreviation.
15533 * Note that '-' doesnt' consitute a valid abbreviation
15535 if (strncmp(arg, *entryPtr, arglen) == 0) {
15536 if (*arg == '-' && arglen == 1) {
15537 break;
15539 if (match >= 0) {
15540 bad = "ambiguous ";
15541 goto ambiguous;
15543 match = i;
15548 /* If we had an unambiguous partial match */
15549 if (match >= 0) {
15550 found:
15551 /* Record the match in the object */
15552 Jim_FreeIntRep(interp, objPtr);
15553 objPtr->typePtr = &getEnumObjType;
15554 objPtr->internalRep.ptrIntValue.ptr = (void *)tablePtr;
15555 objPtr->internalRep.ptrIntValue.int1 = flags;
15556 objPtr->internalRep.ptrIntValue.int2 = match;
15557 /* Return the result */
15558 *indexPtr = match;
15559 return JIM_OK;
15562 ambiguous:
15563 if (flags & JIM_ERRMSG) {
15564 JimSetFailedEnumResult(interp, arg, bad, "", tablePtr, name);
15566 return JIM_ERR;
15569 int Jim_FindByName(const char *name, const char * const array[], size_t len)
15571 int i;
15573 for (i = 0; i < (int)len; i++) {
15574 if (array[i] && strcmp(array[i], name) == 0) {
15575 return i;
15578 return -1;
15581 int Jim_IsDict(Jim_Obj *objPtr)
15583 return objPtr->typePtr == &dictObjType;
15586 int Jim_IsList(Jim_Obj *objPtr)
15588 return objPtr->typePtr == &listObjType;
15592 * Very simple printf-like formatting, designed for error messages.
15594 * The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
15595 * The resulting string is created and set as the result.
15597 * Each '%s' should correspond to a regular string parameter.
15598 * Each '%#s' should correspond to a (Jim_Obj *) parameter.
15599 * Any other printf specifier is not allowed (but %% is allowed for the % character).
15601 * e.g. Jim_SetResultFormatted(interp, "Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
15603 * Note: We take advantage of the fact that printf has the same behaviour for both %s and %#s
15605 * Note that any Jim_Obj parameters with zero ref count will be freed as a result of this call.
15607 void Jim_SetResultFormatted(Jim_Interp *interp, const char *format, ...)
15609 /* Initial space needed */
15610 int len = strlen(format);
15611 int extra = 0;
15612 int n = 0;
15613 const char *params[5];
15614 int nobjparam = 0;
15615 Jim_Obj *objparam[5];
15616 char *buf;
15617 va_list args;
15618 int i;
15620 va_start(args, format);
15622 for (i = 0; i < len && n < 5; i++) {
15623 int l;
15625 if (strncmp(format + i, "%s", 2) == 0) {
15626 params[n] = va_arg(args, char *);
15628 l = strlen(params[n]);
15630 else if (strncmp(format + i, "%#s", 3) == 0) {
15631 Jim_Obj *objPtr = va_arg(args, Jim_Obj *);
15633 params[n] = Jim_GetString(objPtr, &l);
15634 objparam[nobjparam++] = objPtr;
15635 Jim_IncrRefCount(objPtr);
15637 else {
15638 if (format[i] == '%') {
15639 i++;
15641 continue;
15643 n++;
15644 extra += l;
15647 len += extra;
15648 buf = Jim_Alloc(len + 1);
15649 len = snprintf(buf, len + 1, format, params[0], params[1], params[2], params[3], params[4]);
15651 va_end(args);
15653 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
15655 for (i = 0; i < nobjparam; i++) {
15656 Jim_DecrRefCount(interp, objparam[i]);
15660 /* stubs */
15661 #ifndef jim_ext_package
15662 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver, int flags)
15664 return JIM_OK;
15666 #endif
15667 #ifndef jim_ext_aio
15668 FILE *Jim_AioFilehandle(Jim_Interp *interp, Jim_Obj *fhObj)
15670 Jim_SetResultString(interp, "aio not enabled", -1);
15671 return NULL;
15673 #endif
15677 * Local Variables: ***
15678 * c-basic-offset: 4 ***
15679 * tab-width: 4 ***
15680 * End: ***