utf8_strlen: Improve performance
[jimtcl.git] / jim.c
blobeed6e70da9a394f260eb39f11608f12763a80a56
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 int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr);
151 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen);
152 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len);
155 /* Fast access to the int (wide) value of an object which is known to be of int type */
156 #define JimWideValue(objPtr) (objPtr)->internalRep.wideValue
158 #define JimObjTypeName(O) ((O)->typePtr ? (O)->typePtr->name : "none")
160 static int utf8_tounicode_case(const char *s, int *uc, int upper)
162 int l = utf8_tounicode(s, uc);
163 if (upper) {
164 *uc = utf8_upper(*uc);
166 return l;
169 /* These can be used in addition to JIM_CASESENS/JIM_NOCASE */
170 #define JIM_CHARSET_SCAN 2
171 #define JIM_CHARSET_GLOB 0
174 * pattern points to a string like "[^a-z\ub5]"
176 * The pattern may contain trailing chars, which are ignored.
178 * The pattern is matched against unicode char 'c'.
180 * If (flags & JIM_NOCASE), case is ignored when matching.
181 * If (flags & JIM_CHARSET_SCAN), the considers ^ and ] special at the start
182 * of the charset, per scan, rather than glob/string match.
184 * If the unicode char 'c' matches that set, returns a pointer to the ']' character,
185 * or the null character if the ']' is missing.
187 * Returns NULL on no match.
189 static const char *JimCharsetMatch(const char *pattern, int c, int flags)
191 int not = 0;
192 int pchar;
193 int match = 0;
194 int nocase = 0;
196 if (flags & JIM_NOCASE) {
197 nocase++;
198 c = utf8_upper(c);
201 if (flags & JIM_CHARSET_SCAN) {
202 if (*pattern == '^') {
203 not++;
204 pattern++;
207 /* Special case. If the first char is ']', it is part of the set */
208 if (*pattern == ']') {
209 goto first;
213 while (*pattern && *pattern != ']') {
214 /* Exact match */
215 if (pattern[0] == '\\') {
216 first:
217 pattern += utf8_tounicode_case(pattern, &pchar, nocase);
219 else {
220 /* Is this a range? a-z */
221 int start;
222 int end;
224 pattern += utf8_tounicode_case(pattern, &start, nocase);
225 if (pattern[0] == '-' && pattern[1]) {
226 /* skip '-' */
227 pattern++;
228 pattern += utf8_tounicode_case(pattern, &end, nocase);
230 /* Handle reversed range too */
231 if ((c >= start && c <= end) || (c >= end && c <= start)) {
232 match = 1;
234 continue;
236 pchar = start;
239 if (pchar == c) {
240 match = 1;
243 if (not) {
244 match = !match;
247 return match ? pattern : NULL;
250 /* Glob-style pattern matching. */
252 /* Note: string *must* be valid UTF-8 sequences
254 static int JimGlobMatch(const char *pattern, const char *string, int nocase)
256 int c;
257 int pchar;
258 while (*pattern) {
259 switch (pattern[0]) {
260 case '*':
261 while (pattern[1] == '*') {
262 pattern++;
264 pattern++;
265 if (!pattern[0]) {
266 return 1; /* match */
268 while (*string) {
269 /* Recursive call - Does the remaining pattern match anywhere? */
270 if (JimGlobMatch(pattern, string, nocase))
271 return 1; /* match */
272 string += utf8_tounicode(string, &c);
274 return 0; /* no match */
276 case '?':
277 string += utf8_tounicode(string, &c);
278 break;
280 case '[': {
281 string += utf8_tounicode(string, &c);
282 pattern = JimCharsetMatch(pattern + 1, c, nocase ? JIM_NOCASE : 0);
283 if (!pattern) {
284 return 0;
286 if (!*pattern) {
287 /* Ran out of pattern (no ']') */
288 continue;
290 break;
292 case '\\':
293 if (pattern[1]) {
294 pattern++;
296 /* fall through */
297 default:
298 string += utf8_tounicode_case(string, &c, nocase);
299 utf8_tounicode_case(pattern, &pchar, nocase);
300 if (pchar != c) {
301 return 0;
303 break;
305 pattern += utf8_tounicode_case(pattern, &pchar, nocase);
306 if (!*string) {
307 while (*pattern == '*') {
308 pattern++;
310 break;
313 if (!*pattern && !*string) {
314 return 1;
316 return 0;
320 * string comparison. Works on binary data.
322 * Returns -1, 0 or 1
324 * Note that the lengths are byte lengths, not char lengths.
326 static int JimStringCompare(const char *s1, int l1, const char *s2, int l2)
328 if (l1 < l2) {
329 return memcmp(s1, s2, l1) <= 0 ? -1 : 1;
331 else if (l2 < l1) {
332 return memcmp(s1, s2, l2) >= 0 ? 1 : -1;
334 else {
335 return JimSign(memcmp(s1, s2, l1));
340 * Compare null terminated strings, up to a maximum of 'maxchars' characters,
341 * (or end of string if 'maxchars' is -1).
343 * Returns -1, 0, 1 for s1 < s2, s1 == s2, s1 > s2 respectively.
345 * Note: does not support embedded nulls.
347 static int JimStringCompareLen(const char *s1, const char *s2, int maxchars, int nocase)
349 while (*s1 && *s2 && maxchars) {
350 int c1, c2;
351 s1 += utf8_tounicode_case(s1, &c1, nocase);
352 s2 += utf8_tounicode_case(s2, &c2, nocase);
353 if (c1 != c2) {
354 return JimSign(c1 - c2);
356 maxchars--;
358 if (!maxchars) {
359 return 0;
361 /* One string or both terminated */
362 if (*s1) {
363 return 1;
365 if (*s2) {
366 return -1;
368 return 0;
371 /* Search for 's1' inside 's2', starting to search from char 'index' of 's2'.
372 * The index of the first occurrence of s1 in s2 is returned.
373 * If s1 is not found inside s2, -1 is returned.
375 * Note: Lengths and return value are in bytes, not chars.
377 static int JimStringFirst(const char *s1, int l1, const char *s2, int l2, int idx)
379 int i;
380 int l1bytelen;
382 if (!l1 || !l2 || l1 > l2) {
383 return -1;
385 if (idx < 0)
386 idx = 0;
387 s2 += utf8_index(s2, idx);
389 l1bytelen = utf8_index(s1, l1);
391 for (i = idx; i <= l2 - l1; i++) {
392 int c;
393 if (memcmp(s2, s1, l1bytelen) == 0) {
394 return i;
396 s2 += utf8_tounicode(s2, &c);
398 return -1;
401 /* Search for the last occurrence 's1' inside 's2', starting to search from char 'index' of 's2'.
402 * The index of the last occurrence of s1 in s2 is returned.
403 * If s1 is not found inside s2, -1 is returned.
405 * Note: Lengths and return value are in bytes, not chars.
407 static int JimStringLast(const char *s1, int l1, const char *s2, int l2)
409 const char *p;
411 if (!l1 || !l2 || l1 > l2)
412 return -1;
414 /* Now search for the needle */
415 for (p = s2 + l2 - 1; p != s2 - 1; p--) {
416 if (*p == *s1 && memcmp(s1, p, l1) == 0) {
417 return p - s2;
420 return -1;
423 #ifdef JIM_UTF8
425 * Per JimStringLast but lengths and return value are in chars, not bytes.
427 static int JimStringLastUtf8(const char *s1, int l1, const char *s2, int l2)
429 int n = JimStringLast(s1, utf8_index(s1, l1), s2, utf8_index(s2, l2));
430 if (n > 0) {
431 n = utf8_strlen(s2, n);
433 return n;
435 #endif
438 * After an strtol()/strtod()-like conversion,
439 * check whether something was converted and that
440 * the only thing left is white space.
442 * Returns JIM_OK or JIM_ERR.
444 static int JimCheckConversion(const char *str, const char *endptr)
446 if (str[0] == '\0' || str == endptr) {
447 return JIM_ERR;
450 if (endptr[0] != '\0') {
451 while (*endptr) {
452 if (!isspace(UCHAR(*endptr))) {
453 return JIM_ERR;
455 endptr++;
458 return JIM_OK;
461 /* Parses the front of a number to determine its sign and base.
462 * Returns the index to start parsing according to the given base
464 static int JimNumberBase(const char *str, int *base, int *sign)
466 int i = 0;
468 *base = 10;
470 while (isspace(UCHAR(str[i]))) {
471 i++;
474 if (str[i] == '-') {
475 *sign = -1;
476 i++;
478 else {
479 if (str[i] == '+') {
480 i++;
482 *sign = 1;
485 if (str[i] != '0') {
486 /* base 10 */
487 return 0;
490 /* We have 0<x>, so see if we can convert it */
491 switch (str[i + 1]) {
492 case 'x': case 'X': *base = 16; break;
493 case 'o': case 'O': *base = 8; break;
494 case 'b': case 'B': *base = 2; break;
495 default: return 0;
497 i += 2;
498 /* Ensure that (e.g.) 0x-5 fails to parse */
499 if (str[i] != '-' && str[i] != '+' && !isspace(UCHAR(str[i]))) {
500 /* Parse according to this base */
501 return i;
503 /* Parse as base 10 */
504 *base = 10;
505 return 0;
508 /* Converts a number as per strtol(..., 0) except leading zeros do *not*
509 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
511 static long jim_strtol(const char *str, char **endptr)
513 int sign;
514 int base;
515 int i = JimNumberBase(str, &base, &sign);
517 if (base != 10) {
518 long value = strtol(str + i, endptr, base);
519 if (endptr == NULL || *endptr != str + i) {
520 return value * sign;
524 /* Can just do a regular base-10 conversion */
525 return strtol(str, endptr, 10);
529 /* Converts a number as per strtoull(..., 0) except leading zeros do *not*
530 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
532 static jim_wide jim_strtoull(const char *str, char **endptr)
534 #ifdef HAVE_LONG_LONG
535 int sign;
536 int base;
537 int i = JimNumberBase(str, &base, &sign);
539 if (base != 10) {
540 jim_wide value = strtoull(str + i, endptr, base);
541 if (endptr == NULL || *endptr != str + i) {
542 return value * sign;
546 /* Can just do a regular base-10 conversion */
547 return strtoull(str, endptr, 10);
548 #else
549 return (unsigned long)jim_strtol(str, endptr);
550 #endif
553 int Jim_StringToWide(const char *str, jim_wide * widePtr, int base)
555 char *endptr;
557 if (base) {
558 *widePtr = strtoull(str, &endptr, base);
560 else {
561 *widePtr = jim_strtoull(str, &endptr);
564 return JimCheckConversion(str, endptr);
567 int Jim_StringToDouble(const char *str, double *doublePtr)
569 char *endptr;
571 /* Callers can check for underflow via ERANGE */
572 errno = 0;
574 *doublePtr = strtod(str, &endptr);
576 return JimCheckConversion(str, endptr);
579 static jim_wide JimPowWide(jim_wide b, jim_wide e)
581 jim_wide res = 1;
583 /* Special cases */
584 if (b == 1) {
585 /* 1 ^ any = 1 */
586 return 1;
588 if (e < 0) {
589 if (b != -1) {
590 return 0;
592 /* Only special case is -1 ^ -n
593 * -1^-1 = -1
594 * -1^-2 = 1
595 * i.e. same as +ve n
597 e = -e;
599 while (e)
601 if (e & 1) {
602 res *= b;
604 e >>= 1;
605 b *= b;
607 return res;
610 /* -----------------------------------------------------------------------------
611 * Special functions
612 * ---------------------------------------------------------------------------*/
613 #ifdef JIM_DEBUG_PANIC
614 static void JimPanicDump(int condition, const char *fmt, ...)
616 va_list ap;
618 if (!condition) {
619 return;
622 va_start(ap, fmt);
624 fprintf(stderr, "\nJIM INTERPRETER PANIC: ");
625 vfprintf(stderr, fmt, ap);
626 fprintf(stderr, "\n\n");
627 va_end(ap);
629 #ifdef HAVE_BACKTRACE
631 void *array[40];
632 int size, i;
633 char **strings;
635 size = backtrace(array, 40);
636 strings = backtrace_symbols(array, size);
637 for (i = 0; i < size; i++)
638 fprintf(stderr, "[backtrace] %s\n", strings[i]);
639 fprintf(stderr, "[backtrace] Include the above lines and the output\n");
640 fprintf(stderr, "[backtrace] of 'nm <executable>' in the bug report.\n");
642 #endif
644 exit(1);
646 #endif
648 /* -----------------------------------------------------------------------------
649 * Memory allocation
650 * ---------------------------------------------------------------------------*/
652 void *Jim_Alloc(int size)
654 return size ? malloc(size) : NULL;
657 void Jim_Free(void *ptr)
659 free(ptr);
662 void *Jim_Realloc(void *ptr, int size)
664 return realloc(ptr, size);
667 char *Jim_StrDup(const char *s)
669 return strdup(s);
672 char *Jim_StrDupLen(const char *s, int l)
674 char *copy = Jim_Alloc(l + 1);
676 memcpy(copy, s, l + 1);
677 copy[l] = 0; /* Just to be sure, original could be substring */
678 return copy;
681 /* -----------------------------------------------------------------------------
682 * Time related functions
683 * ---------------------------------------------------------------------------*/
685 /* Returns current time in microseconds */
686 static jim_wide JimClock(void)
688 struct timeval tv;
690 gettimeofday(&tv, NULL);
691 return (jim_wide) tv.tv_sec * 1000000 + tv.tv_usec;
694 /* -----------------------------------------------------------------------------
695 * Hash Tables
696 * ---------------------------------------------------------------------------*/
698 /* -------------------------- private prototypes ---------------------------- */
699 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht);
700 static unsigned int JimHashTableNextPower(unsigned int size);
701 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace);
703 /* -------------------------- hash functions -------------------------------- */
705 /* Thomas Wang's 32 bit Mix Function */
706 unsigned int Jim_IntHashFunction(unsigned int key)
708 key += ~(key << 15);
709 key ^= (key >> 10);
710 key += (key << 3);
711 key ^= (key >> 6);
712 key += ~(key << 11);
713 key ^= (key >> 16);
714 return key;
717 /* Generic hash function (we are using to multiply by 9 and add the byte
718 * as Tcl) */
719 unsigned int Jim_GenHashFunction(const unsigned char *buf, int len)
721 unsigned int h = 0;
723 while (len--)
724 h += (h << 3) + *buf++;
725 return h;
728 /* ----------------------------- API implementation ------------------------- */
730 /* reset a hashtable already initialized */
731 static void JimResetHashTable(Jim_HashTable *ht)
733 ht->table = NULL;
734 ht->size = 0;
735 ht->sizemask = 0;
736 ht->used = 0;
737 ht->collisions = 0;
738 #ifdef JIM_RANDOMISE_HASH
739 /* This is initialised to a random value to avoid a hash collision attack.
740 * See: n.runs-SA-2011.004
742 ht->uniq = (rand() ^ time(NULL) ^ clock());
743 #else
744 ht->uniq = 0;
745 #endif
748 static void JimInitHashTableIterator(Jim_HashTable *ht, Jim_HashTableIterator *iter)
750 iter->ht = ht;
751 iter->index = -1;
752 iter->entry = NULL;
753 iter->nextEntry = NULL;
756 /* Initialize the hash table */
757 int Jim_InitHashTable(Jim_HashTable *ht, const Jim_HashTableType *type, void *privDataPtr)
759 JimResetHashTable(ht);
760 ht->type = type;
761 ht->privdata = privDataPtr;
762 return JIM_OK;
765 /* Expand or create the hashtable */
766 void Jim_ExpandHashTable(Jim_HashTable *ht, unsigned int size)
768 Jim_HashTable n; /* the new hashtable */
769 unsigned int realsize = JimHashTableNextPower(size), i;
771 /* the size is invalid if it is smaller than the number of
772 * elements already inside the hashtable */
773 if (size <= ht->used)
774 return;
776 Jim_InitHashTable(&n, ht->type, ht->privdata);
777 n.size = realsize;
778 n.sizemask = realsize - 1;
779 n.table = Jim_Alloc(realsize * sizeof(Jim_HashEntry *));
780 /* Keep the same 'uniq' as the original */
781 n.uniq = ht->uniq;
783 /* Initialize all the pointers to NULL */
784 memset(n.table, 0, realsize * sizeof(Jim_HashEntry *));
786 /* Copy all the elements from the old to the new table:
787 * note that if the old hash table is empty ht->used is zero,
788 * so Jim_ExpandHashTable just creates an empty hash table. */
789 n.used = ht->used;
790 for (i = 0; ht->used > 0; i++) {
791 Jim_HashEntry *he, *nextHe;
793 if (ht->table[i] == NULL)
794 continue;
796 /* For each hash entry on this slot... */
797 he = ht->table[i];
798 while (he) {
799 unsigned int h;
801 nextHe = he->next;
802 /* Get the new element index */
803 h = Jim_HashKey(ht, he->key) & n.sizemask;
804 he->next = n.table[h];
805 n.table[h] = he;
806 ht->used--;
807 /* Pass to the next element */
808 he = nextHe;
811 assert(ht->used == 0);
812 Jim_Free(ht->table);
814 /* Remap the new hashtable in the old */
815 *ht = n;
818 /* Add an element to the target hash table */
819 int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val)
821 Jim_HashEntry *entry;
823 /* Get the index of the new element, or -1 if
824 * the element already exists. */
825 entry = JimInsertHashEntry(ht, key, 0);
826 if (entry == NULL)
827 return JIM_ERR;
829 /* Set the hash entry fields. */
830 Jim_SetHashKey(ht, entry, key);
831 Jim_SetHashVal(ht, entry, val);
832 return JIM_OK;
835 /* Add an element, discarding the old if the key already exists */
836 int Jim_ReplaceHashEntry(Jim_HashTable *ht, const void *key, void *val)
838 int existed;
839 Jim_HashEntry *entry;
841 /* Get the index of the new element, or -1 if
842 * the element already exists. */
843 entry = JimInsertHashEntry(ht, key, 1);
844 if (entry->key) {
845 /* It already exists, so only replace the value.
846 * Note if both a destructor and a duplicate function exist,
847 * need to dup before destroy. perhaps they are the same
848 * reference counted object
850 if (ht->type->valDestructor && ht->type->valDup) {
851 void *newval = ht->type->valDup(ht->privdata, val);
852 ht->type->valDestructor(ht->privdata, entry->u.val);
853 entry->u.val = newval;
855 else {
856 Jim_FreeEntryVal(ht, entry);
857 Jim_SetHashVal(ht, entry, val);
859 existed = 1;
861 else {
862 /* Doesn't exist, so set the key */
863 Jim_SetHashKey(ht, entry, key);
864 Jim_SetHashVal(ht, entry, val);
865 existed = 0;
868 return existed;
871 /* Search and remove an element */
872 int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key)
874 unsigned int h;
875 Jim_HashEntry *he, *prevHe;
877 if (ht->used == 0)
878 return JIM_ERR;
879 h = Jim_HashKey(ht, key) & ht->sizemask;
880 he = ht->table[h];
882 prevHe = NULL;
883 while (he) {
884 if (Jim_CompareHashKeys(ht, key, he->key)) {
885 /* Unlink the element from the list */
886 if (prevHe)
887 prevHe->next = he->next;
888 else
889 ht->table[h] = he->next;
890 Jim_FreeEntryKey(ht, he);
891 Jim_FreeEntryVal(ht, he);
892 Jim_Free(he);
893 ht->used--;
894 return JIM_OK;
896 prevHe = he;
897 he = he->next;
899 return JIM_ERR; /* not found */
902 /* Destroy an entire hash table and leave it ready for reuse */
903 int Jim_FreeHashTable(Jim_HashTable *ht)
905 unsigned int i;
907 /* Free all the elements */
908 for (i = 0; ht->used > 0; i++) {
909 Jim_HashEntry *he, *nextHe;
911 if ((he = ht->table[i]) == NULL)
912 continue;
913 while (he) {
914 nextHe = he->next;
915 Jim_FreeEntryKey(ht, he);
916 Jim_FreeEntryVal(ht, he);
917 Jim_Free(he);
918 ht->used--;
919 he = nextHe;
922 /* Free the table and the allocated cache structure */
923 Jim_Free(ht->table);
924 /* Re-initialize the table */
925 JimResetHashTable(ht);
926 return JIM_OK; /* never fails */
929 Jim_HashEntry *Jim_FindHashEntry(Jim_HashTable *ht, const void *key)
931 Jim_HashEntry *he;
932 unsigned int h;
934 if (ht->used == 0)
935 return NULL;
936 h = Jim_HashKey(ht, key) & ht->sizemask;
937 he = ht->table[h];
938 while (he) {
939 if (Jim_CompareHashKeys(ht, key, he->key))
940 return he;
941 he = he->next;
943 return NULL;
946 Jim_HashTableIterator *Jim_GetHashTableIterator(Jim_HashTable *ht)
948 Jim_HashTableIterator *iter = Jim_Alloc(sizeof(*iter));
949 JimInitHashTableIterator(ht, iter);
950 return iter;
953 Jim_HashEntry *Jim_NextHashEntry(Jim_HashTableIterator *iter)
955 while (1) {
956 if (iter->entry == NULL) {
957 iter->index++;
958 if (iter->index >= (signed)iter->ht->size)
959 break;
960 iter->entry = iter->ht->table[iter->index];
962 else {
963 iter->entry = iter->nextEntry;
965 if (iter->entry) {
966 /* We need to save the 'next' here, the iterator user
967 * may delete the entry we are returning. */
968 iter->nextEntry = iter->entry->next;
969 return iter->entry;
972 return NULL;
975 /* ------------------------- private functions ------------------------------ */
977 /* Expand the hash table if needed */
978 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht)
980 /* If the hash table is empty expand it to the intial size,
981 * if the table is "full" double its size. */
982 if (ht->size == 0)
983 Jim_ExpandHashTable(ht, JIM_HT_INITIAL_SIZE);
984 if (ht->size == ht->used)
985 Jim_ExpandHashTable(ht, ht->size * 2);
988 /* Our hash table capability is a power of two */
989 static unsigned int JimHashTableNextPower(unsigned int size)
991 unsigned int i = JIM_HT_INITIAL_SIZE;
993 if (size >= 2147483648U)
994 return 2147483648U;
995 while (1) {
996 if (i >= size)
997 return i;
998 i *= 2;
1002 /* Returns the index of a free slot that can be populated with
1003 * a hash entry for the given 'key'.
1004 * If the key already exists, -1 is returned. */
1005 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace)
1007 unsigned int h;
1008 Jim_HashEntry *he;
1010 /* Expand the hashtable if needed */
1011 JimExpandHashTableIfNeeded(ht);
1013 /* Compute the key hash value */
1014 h = Jim_HashKey(ht, key) & ht->sizemask;
1015 /* Search if this slot does not already contain the given key */
1016 he = ht->table[h];
1017 while (he) {
1018 if (Jim_CompareHashKeys(ht, key, he->key))
1019 return replace ? he : NULL;
1020 he = he->next;
1023 /* Allocates the memory and stores key */
1024 he = Jim_Alloc(sizeof(*he));
1025 he->next = ht->table[h];
1026 ht->table[h] = he;
1027 ht->used++;
1028 he->key = NULL;
1030 return he;
1033 /* ----------------------- StringCopy Hash Table Type ------------------------*/
1035 static unsigned int JimStringCopyHTHashFunction(const void *key)
1037 return Jim_GenHashFunction(key, strlen(key));
1040 static void *JimStringCopyHTDup(void *privdata, const void *key)
1042 return Jim_StrDup(key);
1045 static int JimStringCopyHTKeyCompare(void *privdata, const void *key1, const void *key2)
1047 return strcmp(key1, key2) == 0;
1050 static void JimStringCopyHTKeyDestructor(void *privdata, void *key)
1052 Jim_Free(key);
1055 static const Jim_HashTableType JimPackageHashTableType = {
1056 JimStringCopyHTHashFunction, /* hash function */
1057 JimStringCopyHTDup, /* key dup */
1058 NULL, /* val dup */
1059 JimStringCopyHTKeyCompare, /* key compare */
1060 JimStringCopyHTKeyDestructor, /* key destructor */
1061 NULL /* val destructor */
1064 typedef struct AssocDataValue
1066 Jim_InterpDeleteProc *delProc;
1067 void *data;
1068 } AssocDataValue;
1070 static void JimAssocDataHashTableValueDestructor(void *privdata, void *data)
1072 AssocDataValue *assocPtr = (AssocDataValue *) data;
1074 if (assocPtr->delProc != NULL)
1075 assocPtr->delProc((Jim_Interp *)privdata, assocPtr->data);
1076 Jim_Free(data);
1079 static const Jim_HashTableType JimAssocDataHashTableType = {
1080 JimStringCopyHTHashFunction, /* hash function */
1081 JimStringCopyHTDup, /* key dup */
1082 NULL, /* val dup */
1083 JimStringCopyHTKeyCompare, /* key compare */
1084 JimStringCopyHTKeyDestructor, /* key destructor */
1085 JimAssocDataHashTableValueDestructor /* val destructor */
1088 /* -----------------------------------------------------------------------------
1089 * Stack - This is a simple generic stack implementation. It is used for
1090 * example in the 'expr' expression compiler.
1091 * ---------------------------------------------------------------------------*/
1092 void Jim_InitStack(Jim_Stack *stack)
1094 stack->len = 0;
1095 stack->maxlen = 0;
1096 stack->vector = NULL;
1099 void Jim_FreeStack(Jim_Stack *stack)
1101 Jim_Free(stack->vector);
1104 int Jim_StackLen(Jim_Stack *stack)
1106 return stack->len;
1109 void Jim_StackPush(Jim_Stack *stack, void *element)
1111 int neededLen = stack->len + 1;
1113 if (neededLen > stack->maxlen) {
1114 stack->maxlen = neededLen < 20 ? 20 : neededLen * 2;
1115 stack->vector = Jim_Realloc(stack->vector, sizeof(void *) * stack->maxlen);
1117 stack->vector[stack->len] = element;
1118 stack->len++;
1121 void *Jim_StackPop(Jim_Stack *stack)
1123 if (stack->len == 0)
1124 return NULL;
1125 stack->len--;
1126 return stack->vector[stack->len];
1129 void *Jim_StackPeek(Jim_Stack *stack)
1131 if (stack->len == 0)
1132 return NULL;
1133 return stack->vector[stack->len - 1];
1136 void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc) (void *ptr))
1138 int i;
1140 for (i = 0; i < stack->len; i++)
1141 freeFunc(stack->vector[i]);
1144 /* -----------------------------------------------------------------------------
1145 * Tcl Parser
1146 * ---------------------------------------------------------------------------*/
1148 /* Token types */
1149 #define JIM_TT_NONE 0 /* No token returned */
1150 #define JIM_TT_STR 1 /* simple string */
1151 #define JIM_TT_ESC 2 /* string that needs escape chars conversion */
1152 #define JIM_TT_VAR 3 /* var substitution */
1153 #define JIM_TT_DICTSUGAR 4 /* Syntax sugar for [dict get], $foo(bar) */
1154 #define JIM_TT_CMD 5 /* command substitution */
1155 /* Note: Keep these three together for TOKEN_IS_SEP() */
1156 #define JIM_TT_SEP 6 /* word separator (white space) */
1157 #define JIM_TT_EOL 7 /* line separator */
1158 #define JIM_TT_EOF 8 /* end of script */
1160 #define JIM_TT_LINE 9 /* special 'start-of-line' token. arg is # of arguments to the command. -ve if {*} */
1161 #define JIM_TT_WORD 10 /* special 'start-of-word' token. arg is # of tokens to combine. -ve if {*} */
1163 /* Additional token types needed for expressions */
1164 #define JIM_TT_SUBEXPR_START 11
1165 #define JIM_TT_SUBEXPR_END 12
1166 #define JIM_TT_SUBEXPR_COMMA 13
1167 #define JIM_TT_EXPR_INT 14
1168 #define JIM_TT_EXPR_DOUBLE 15
1169 #define JIM_TT_EXPR_BOOLEAN 16
1171 #define JIM_TT_EXPRSUGAR 17 /* $(expression) */
1173 /* Operator token types start here */
1174 #define JIM_TT_EXPR_OP 20
1176 #define TOKEN_IS_SEP(type) (type >= JIM_TT_SEP && type <= JIM_TT_EOF)
1177 /* Can this token start an expression? */
1178 #define TOKEN_IS_EXPR_START(type) (type == JIM_TT_NONE || type == JIM_TT_SUBEXPR_START || type == JIM_TT_SUBEXPR_COMMA)
1179 /* Is this token an expression operator? */
1180 #define TOKEN_IS_EXPR_OP(type) (type >= JIM_TT_EXPR_OP)
1183 * Results of missing quotes, braces, etc. from parsing.
1185 struct JimParseMissing {
1186 int ch; /* At end of parse, ' ' if complete or '{', '[', '"', '\\', '}' if incomplete */
1187 int line; /* Line number starting the missing token */
1190 /* Parser context structure. The same context is used to parse
1191 * Tcl scripts, expressions and lists. */
1192 struct JimParserCtx
1194 const char *p; /* Pointer to the point of the program we are parsing */
1195 int len; /* Remaining length */
1196 int linenr; /* Current line number */
1197 const char *tstart;
1198 const char *tend; /* Returned token is at tstart-tend in 'prg'. */
1199 int tline; /* Line number of the returned token */
1200 int tt; /* Token type */
1201 int eof; /* Non zero if EOF condition is true. */
1202 int inquote; /* Parsing a quoted string */
1203 int comment; /* Non zero if the next chars may be a comment. */
1204 struct JimParseMissing missing; /* Details of any missing quotes, etc. */
1207 static int JimParseScript(struct JimParserCtx *pc);
1208 static int JimParseSep(struct JimParserCtx *pc);
1209 static int JimParseEol(struct JimParserCtx *pc);
1210 static int JimParseCmd(struct JimParserCtx *pc);
1211 static int JimParseQuote(struct JimParserCtx *pc);
1212 static int JimParseVar(struct JimParserCtx *pc);
1213 static int JimParseBrace(struct JimParserCtx *pc);
1214 static int JimParseStr(struct JimParserCtx *pc);
1215 static int JimParseComment(struct JimParserCtx *pc);
1216 static void JimParseSubCmd(struct JimParserCtx *pc);
1217 static int JimParseSubQuote(struct JimParserCtx *pc);
1218 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc);
1220 /* Initialize a parser context.
1221 * 'prg' is a pointer to the program text, linenr is the line
1222 * number of the first line contained in the program. */
1223 static void JimParserInit(struct JimParserCtx *pc, const char *prg, int len, int linenr)
1225 pc->p = prg;
1226 pc->len = len;
1227 pc->tstart = NULL;
1228 pc->tend = NULL;
1229 pc->tline = 0;
1230 pc->tt = JIM_TT_NONE;
1231 pc->eof = 0;
1232 pc->inquote = 0;
1233 pc->linenr = linenr;
1234 pc->comment = 1;
1235 pc->missing.ch = ' ';
1236 pc->missing.line = linenr;
1239 static int JimParseScript(struct JimParserCtx *pc)
1241 while (1) { /* the while is used to reiterate with continue if needed */
1242 if (!pc->len) {
1243 pc->tstart = pc->p;
1244 pc->tend = pc->p - 1;
1245 pc->tline = pc->linenr;
1246 pc->tt = JIM_TT_EOL;
1247 pc->eof = 1;
1248 return JIM_OK;
1250 switch (*(pc->p)) {
1251 case '\\':
1252 if (*(pc->p + 1) == '\n' && !pc->inquote) {
1253 return JimParseSep(pc);
1255 pc->comment = 0;
1256 return JimParseStr(pc);
1257 case ' ':
1258 case '\t':
1259 case '\r':
1260 case '\f':
1261 if (!pc->inquote)
1262 return JimParseSep(pc);
1263 pc->comment = 0;
1264 return JimParseStr(pc);
1265 case '\n':
1266 case ';':
1267 pc->comment = 1;
1268 if (!pc->inquote)
1269 return JimParseEol(pc);
1270 return JimParseStr(pc);
1271 case '[':
1272 pc->comment = 0;
1273 return JimParseCmd(pc);
1274 case '$':
1275 pc->comment = 0;
1276 if (JimParseVar(pc) == JIM_ERR) {
1277 /* An orphan $. Create as a separate token */
1278 pc->tstart = pc->tend = pc->p++;
1279 pc->len--;
1280 pc->tt = JIM_TT_ESC;
1282 return JIM_OK;
1283 case '#':
1284 if (pc->comment) {
1285 JimParseComment(pc);
1286 continue;
1288 return JimParseStr(pc);
1289 default:
1290 pc->comment = 0;
1291 return JimParseStr(pc);
1293 return JIM_OK;
1297 static int JimParseSep(struct JimParserCtx *pc)
1299 pc->tstart = pc->p;
1300 pc->tline = pc->linenr;
1301 while (isspace(UCHAR(*pc->p)) || (*pc->p == '\\' && *(pc->p + 1) == '\n')) {
1302 if (*pc->p == '\n') {
1303 break;
1305 if (*pc->p == '\\') {
1306 pc->p++;
1307 pc->len--;
1308 pc->linenr++;
1310 pc->p++;
1311 pc->len--;
1313 pc->tend = pc->p - 1;
1314 pc->tt = JIM_TT_SEP;
1315 return JIM_OK;
1318 static int JimParseEol(struct JimParserCtx *pc)
1320 pc->tstart = pc->p;
1321 pc->tline = pc->linenr;
1322 while (isspace(UCHAR(*pc->p)) || *pc->p == ';') {
1323 if (*pc->p == '\n')
1324 pc->linenr++;
1325 pc->p++;
1326 pc->len--;
1328 pc->tend = pc->p - 1;
1329 pc->tt = JIM_TT_EOL;
1330 return JIM_OK;
1334 ** Here are the rules for parsing:
1335 ** {braced expression}
1336 ** - Count open and closing braces
1337 ** - Backslash escapes meaning of braces but doesn't remove the backslash
1339 ** "quoted expression"
1340 ** - Unescaped double quote terminates the expression
1341 ** - Backslash escapes next char
1342 ** - [commands brackets] are counted/nested
1343 ** - command rules apply within [brackets], not quoting rules (i.e. brackets have their own rules)
1345 ** [command expression]
1346 ** - Count open and closing brackets
1347 ** - Backslash escapes next char
1348 ** - [commands brackets] are counted/nested
1349 ** - "quoted expressions" are parsed according to quoting rules
1350 ** - {braced expressions} are parsed according to brace rules
1352 ** For everything, backslash escapes the next char, newline increments current line
1356 * Parses a braced expression starting at pc->p.
1358 * Positions the parser at the end of the braced expression,
1359 * sets pc->tend and possibly pc->missing.
1361 static void JimParseSubBrace(struct JimParserCtx *pc)
1363 int level = 1;
1365 /* Skip the brace */
1366 pc->p++;
1367 pc->len--;
1368 while (pc->len) {
1369 switch (*pc->p) {
1370 case '\\':
1371 if (pc->len > 1) {
1372 if (*++pc->p == '\n') {
1373 pc->linenr++;
1375 pc->len--;
1377 break;
1379 case '{':
1380 level++;
1381 break;
1383 case '}':
1384 if (--level == 0) {
1385 pc->tend = pc->p - 1;
1386 pc->p++;
1387 pc->len--;
1388 return;
1390 break;
1392 case '\n':
1393 pc->linenr++;
1394 break;
1396 pc->p++;
1397 pc->len--;
1399 pc->missing.ch = '{';
1400 pc->missing.line = pc->tline;
1401 pc->tend = pc->p - 1;
1405 * Parses a quoted expression starting at pc->p.
1407 * Positions the parser at the end of the quoted expression,
1408 * sets pc->tend and possibly pc->missing.
1410 * Returns the type of the token of the string,
1411 * either JIM_TT_ESC (if it contains values which need to be [subst]ed)
1412 * or JIM_TT_STR.
1414 static int JimParseSubQuote(struct JimParserCtx *pc)
1416 int tt = JIM_TT_STR;
1417 int line = pc->tline;
1419 /* Skip the quote */
1420 pc->p++;
1421 pc->len--;
1422 while (pc->len) {
1423 switch (*pc->p) {
1424 case '\\':
1425 if (pc->len > 1) {
1426 if (*++pc->p == '\n') {
1427 pc->linenr++;
1429 pc->len--;
1430 tt = JIM_TT_ESC;
1432 break;
1434 case '"':
1435 pc->tend = pc->p - 1;
1436 pc->p++;
1437 pc->len--;
1438 return tt;
1440 case '[':
1441 JimParseSubCmd(pc);
1442 tt = JIM_TT_ESC;
1443 continue;
1445 case '\n':
1446 pc->linenr++;
1447 break;
1449 case '$':
1450 tt = JIM_TT_ESC;
1451 break;
1453 pc->p++;
1454 pc->len--;
1456 pc->missing.ch = '"';
1457 pc->missing.line = line;
1458 pc->tend = pc->p - 1;
1459 return tt;
1463 * Parses a [command] expression starting at pc->p.
1465 * Positions the parser at the end of the command expression,
1466 * sets pc->tend and possibly pc->missing.
1468 static void JimParseSubCmd(struct JimParserCtx *pc)
1470 int level = 1;
1471 int startofword = 1;
1472 int line = pc->tline;
1474 /* Skip the bracket */
1475 pc->p++;
1476 pc->len--;
1477 while (pc->len) {
1478 switch (*pc->p) {
1479 case '\\':
1480 if (pc->len > 1) {
1481 if (*++pc->p == '\n') {
1482 pc->linenr++;
1484 pc->len--;
1486 break;
1488 case '[':
1489 level++;
1490 break;
1492 case ']':
1493 if (--level == 0) {
1494 pc->tend = pc->p - 1;
1495 pc->p++;
1496 pc->len--;
1497 return;
1499 break;
1501 case '"':
1502 if (startofword) {
1503 JimParseSubQuote(pc);
1504 continue;
1506 break;
1508 case '{':
1509 JimParseSubBrace(pc);
1510 startofword = 0;
1511 continue;
1513 case '\n':
1514 pc->linenr++;
1515 break;
1517 startofword = isspace(UCHAR(*pc->p));
1518 pc->p++;
1519 pc->len--;
1521 pc->missing.ch = '[';
1522 pc->missing.line = line;
1523 pc->tend = pc->p - 1;
1526 static int JimParseBrace(struct JimParserCtx *pc)
1528 pc->tstart = pc->p + 1;
1529 pc->tline = pc->linenr;
1530 pc->tt = JIM_TT_STR;
1531 JimParseSubBrace(pc);
1532 return JIM_OK;
1535 static int JimParseCmd(struct JimParserCtx *pc)
1537 pc->tstart = pc->p + 1;
1538 pc->tline = pc->linenr;
1539 pc->tt = JIM_TT_CMD;
1540 JimParseSubCmd(pc);
1541 return JIM_OK;
1544 static int JimParseQuote(struct JimParserCtx *pc)
1546 pc->tstart = pc->p + 1;
1547 pc->tline = pc->linenr;
1548 pc->tt = JimParseSubQuote(pc);
1549 return JIM_OK;
1552 static int JimParseVar(struct JimParserCtx *pc)
1554 /* skip the $ */
1555 pc->p++;
1556 pc->len--;
1558 #ifdef EXPRSUGAR_BRACKET
1559 if (*pc->p == '[') {
1560 /* Parse $[...] expr shorthand syntax */
1561 JimParseCmd(pc);
1562 pc->tt = JIM_TT_EXPRSUGAR;
1563 return JIM_OK;
1565 #endif
1567 pc->tstart = pc->p;
1568 pc->tt = JIM_TT_VAR;
1569 pc->tline = pc->linenr;
1571 if (*pc->p == '{') {
1572 pc->tstart = ++pc->p;
1573 pc->len--;
1575 while (pc->len && *pc->p != '}') {
1576 if (*pc->p == '\n') {
1577 pc->linenr++;
1579 pc->p++;
1580 pc->len--;
1582 pc->tend = pc->p - 1;
1583 if (pc->len) {
1584 pc->p++;
1585 pc->len--;
1588 else {
1589 while (1) {
1590 /* Skip double colon, but not single colon! */
1591 if (pc->p[0] == ':' && pc->p[1] == ':') {
1592 while (*pc->p == ':') {
1593 pc->p++;
1594 pc->len--;
1596 continue;
1598 /* Note that any char >= 0x80 must be part of a utf-8 char.
1599 * We consider all unicode points outside of ASCII as letters
1601 if (isalnum(UCHAR(*pc->p)) || *pc->p == '_' || UCHAR(*pc->p) >= 0x80) {
1602 pc->p++;
1603 pc->len--;
1604 continue;
1606 break;
1608 /* Parse [dict get] syntax sugar. */
1609 if (*pc->p == '(') {
1610 int count = 1;
1611 const char *paren = NULL;
1613 pc->tt = JIM_TT_DICTSUGAR;
1615 while (count && pc->len) {
1616 pc->p++;
1617 pc->len--;
1618 if (*pc->p == '\\' && pc->len >= 1) {
1619 pc->p++;
1620 pc->len--;
1622 else if (*pc->p == '(') {
1623 count++;
1625 else if (*pc->p == ')') {
1626 paren = pc->p;
1627 count--;
1630 if (count == 0) {
1631 pc->p++;
1632 pc->len--;
1634 else if (paren) {
1635 /* Did not find a matching paren. Back up */
1636 paren++;
1637 pc->len += (pc->p - paren);
1638 pc->p = paren;
1640 #ifndef EXPRSUGAR_BRACKET
1641 if (*pc->tstart == '(') {
1642 pc->tt = JIM_TT_EXPRSUGAR;
1644 #endif
1646 pc->tend = pc->p - 1;
1648 /* Check if we parsed just the '$' character.
1649 * That's not a variable so an error is returned
1650 * to tell the state machine to consider this '$' just
1651 * a string. */
1652 if (pc->tstart == pc->p) {
1653 pc->p--;
1654 pc->len++;
1655 return JIM_ERR;
1657 return JIM_OK;
1660 static int JimParseStr(struct JimParserCtx *pc)
1662 if (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1663 pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR) {
1664 /* Starting a new word */
1665 if (*pc->p == '{') {
1666 return JimParseBrace(pc);
1668 if (*pc->p == '"') {
1669 pc->inquote = 1;
1670 pc->p++;
1671 pc->len--;
1672 /* In case the end quote is missing */
1673 pc->missing.line = pc->tline;
1676 pc->tstart = pc->p;
1677 pc->tline = pc->linenr;
1678 while (1) {
1679 if (pc->len == 0) {
1680 if (pc->inquote) {
1681 pc->missing.ch = '"';
1683 pc->tend = pc->p - 1;
1684 pc->tt = JIM_TT_ESC;
1685 return JIM_OK;
1687 switch (*pc->p) {
1688 case '\\':
1689 if (!pc->inquote && *(pc->p + 1) == '\n') {
1690 pc->tend = pc->p - 1;
1691 pc->tt = JIM_TT_ESC;
1692 return JIM_OK;
1694 if (pc->len >= 2) {
1695 if (*(pc->p + 1) == '\n') {
1696 pc->linenr++;
1698 pc->p++;
1699 pc->len--;
1701 else if (pc->len == 1) {
1702 /* End of script with trailing backslash */
1703 pc->missing.ch = '\\';
1705 break;
1706 case '(':
1707 /* If the following token is not '$' just keep going */
1708 if (pc->len > 1 && pc->p[1] != '$') {
1709 break;
1711 /* fall through */
1712 case ')':
1713 /* Only need a separate ')' token if the previous was a var */
1714 if (*pc->p == '(' || pc->tt == JIM_TT_VAR) {
1715 if (pc->p == pc->tstart) {
1716 /* At the start of the token, so just return this char */
1717 pc->p++;
1718 pc->len--;
1720 pc->tend = pc->p - 1;
1721 pc->tt = JIM_TT_ESC;
1722 return JIM_OK;
1724 break;
1726 case '$':
1727 case '[':
1728 pc->tend = pc->p - 1;
1729 pc->tt = JIM_TT_ESC;
1730 return JIM_OK;
1731 case ' ':
1732 case '\t':
1733 case '\n':
1734 case '\r':
1735 case '\f':
1736 case ';':
1737 if (!pc->inquote) {
1738 pc->tend = pc->p - 1;
1739 pc->tt = JIM_TT_ESC;
1740 return JIM_OK;
1742 else if (*pc->p == '\n') {
1743 pc->linenr++;
1745 break;
1746 case '"':
1747 if (pc->inquote) {
1748 pc->tend = pc->p - 1;
1749 pc->tt = JIM_TT_ESC;
1750 pc->p++;
1751 pc->len--;
1752 pc->inquote = 0;
1753 return JIM_OK;
1755 break;
1757 pc->p++;
1758 pc->len--;
1760 return JIM_OK; /* unreached */
1763 static int JimParseComment(struct JimParserCtx *pc)
1765 while (*pc->p) {
1766 if (*pc->p == '\\') {
1767 pc->p++;
1768 pc->len--;
1769 if (pc->len == 0) {
1770 pc->missing.ch = '\\';
1771 return JIM_OK;
1773 if (*pc->p == '\n') {
1774 pc->linenr++;
1777 else if (*pc->p == '\n') {
1778 pc->p++;
1779 pc->len--;
1780 pc->linenr++;
1781 break;
1783 pc->p++;
1784 pc->len--;
1786 return JIM_OK;
1789 /* xdigitval and odigitval are helper functions for JimEscape() */
1790 static int xdigitval(int c)
1792 if (c >= '0' && c <= '9')
1793 return c - '0';
1794 if (c >= 'a' && c <= 'f')
1795 return c - 'a' + 10;
1796 if (c >= 'A' && c <= 'F')
1797 return c - 'A' + 10;
1798 return -1;
1801 static int odigitval(int c)
1803 if (c >= '0' && c <= '7')
1804 return c - '0';
1805 return -1;
1808 /* Perform Tcl escape substitution of 's', storing the result
1809 * string into 'dest'. The escaped string is guaranteed to
1810 * be the same length or shorter than the source string.
1811 * slen is the length of the string at 's'.
1813 * The function returns the length of the resulting string. */
1814 static int JimEscape(char *dest, const char *s, int slen)
1816 char *p = dest;
1817 int i, len;
1819 for (i = 0; i < slen; i++) {
1820 switch (s[i]) {
1821 case '\\':
1822 switch (s[i + 1]) {
1823 case 'a':
1824 *p++ = 0x7;
1825 i++;
1826 break;
1827 case 'b':
1828 *p++ = 0x8;
1829 i++;
1830 break;
1831 case 'f':
1832 *p++ = 0xc;
1833 i++;
1834 break;
1835 case 'n':
1836 *p++ = 0xa;
1837 i++;
1838 break;
1839 case 'r':
1840 *p++ = 0xd;
1841 i++;
1842 break;
1843 case 't':
1844 *p++ = 0x9;
1845 i++;
1846 break;
1847 case 'u':
1848 case 'U':
1849 case 'x':
1850 /* A unicode or hex sequence.
1851 * \x Expect 1-2 hex chars and convert to hex.
1852 * \u Expect 1-4 hex chars and convert to utf-8.
1853 * \U Expect 1-8 hex chars and convert to utf-8.
1854 * \u{NNN} supports 1-6 hex chars and convert to utf-8.
1855 * An invalid sequence means simply the escaped char.
1858 unsigned val = 0;
1859 int k;
1860 int maxchars = 2;
1862 i++;
1864 if (s[i] == 'U') {
1865 maxchars = 8;
1867 else if (s[i] == 'u') {
1868 if (s[i + 1] == '{') {
1869 maxchars = 6;
1870 i++;
1872 else {
1873 maxchars = 4;
1877 for (k = 0; k < maxchars; k++) {
1878 int c = xdigitval(s[i + k + 1]);
1879 if (c == -1) {
1880 break;
1882 val = (val << 4) | c;
1884 /* The \u{nnn} syntax supports up to 21 bit codepoints. */
1885 if (s[i] == '{') {
1886 if (k == 0 || val > 0x1fffff || s[i + k + 1] != '}') {
1887 /* Back up */
1888 i--;
1889 k = 0;
1891 else {
1892 /* Skip the closing brace */
1893 k++;
1896 if (k) {
1897 /* Got a valid sequence, so convert */
1898 if (s[i] == 'x') {
1899 *p++ = val;
1901 else {
1902 p += utf8_fromunicode(p, val);
1904 i += k;
1905 break;
1907 /* Not a valid codepoint, just an escaped char */
1908 *p++ = s[i];
1910 break;
1911 case 'v':
1912 *p++ = 0xb;
1913 i++;
1914 break;
1915 case '\0':
1916 *p++ = '\\';
1917 i++;
1918 break;
1919 case '\n':
1920 /* Replace all spaces and tabs after backslash newline with a single space*/
1921 *p++ = ' ';
1922 do {
1923 i++;
1924 } while (s[i + 1] == ' ' || s[i + 1] == '\t');
1925 break;
1926 case '0':
1927 case '1':
1928 case '2':
1929 case '3':
1930 case '4':
1931 case '5':
1932 case '6':
1933 case '7':
1934 /* octal escape */
1936 int val = 0;
1937 int c = odigitval(s[i + 1]);
1939 val = c;
1940 c = odigitval(s[i + 2]);
1941 if (c == -1) {
1942 *p++ = val;
1943 i++;
1944 break;
1946 val = (val * 8) + c;
1947 c = odigitval(s[i + 3]);
1948 if (c == -1) {
1949 *p++ = val;
1950 i += 2;
1951 break;
1953 val = (val * 8) + c;
1954 *p++ = val;
1955 i += 3;
1957 break;
1958 default:
1959 *p++ = s[i + 1];
1960 i++;
1961 break;
1963 break;
1964 default:
1965 *p++ = s[i];
1966 break;
1969 len = p - dest;
1970 *p = '\0';
1971 return len;
1974 /* Returns a dynamically allocated copy of the current token in the
1975 * parser context. The function performs conversion of escapes if
1976 * the token is of type JIM_TT_ESC.
1978 * Note that after the conversion, tokens that are grouped with
1979 * braces in the source code, are always recognizable from the
1980 * identical string obtained in a different way from the type.
1982 * For example the string:
1984 * {*}$a
1986 * will return as first token "*", of type JIM_TT_STR
1988 * While the string:
1990 * *$a
1992 * will return as first token "*", of type JIM_TT_ESC
1994 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc)
1996 const char *start, *end;
1997 char *token;
1998 int len;
2000 start = pc->tstart;
2001 end = pc->tend;
2002 len = (end - start) + 1;
2003 if (len < 0) {
2004 len = 0;
2006 token = Jim_Alloc(len + 1);
2007 if (pc->tt != JIM_TT_ESC) {
2008 /* No escape conversion needed? Just copy it. */
2009 memcpy(token, start, len);
2010 token[len] = '\0';
2012 else {
2013 /* Else convert the escape chars. */
2014 len = JimEscape(token, start, len);
2017 return Jim_NewStringObjNoAlloc(interp, token, len);
2020 /* -----------------------------------------------------------------------------
2021 * Tcl Lists parsing
2022 * ---------------------------------------------------------------------------*/
2023 static int JimParseListSep(struct JimParserCtx *pc);
2024 static int JimParseListStr(struct JimParserCtx *pc);
2025 static int JimParseListQuote(struct JimParserCtx *pc);
2027 static int JimParseList(struct JimParserCtx *pc)
2029 if (isspace(UCHAR(*pc->p))) {
2030 return JimParseListSep(pc);
2032 switch (*pc->p) {
2033 case '"':
2034 return JimParseListQuote(pc);
2036 case '{':
2037 return JimParseBrace(pc);
2039 default:
2040 if (pc->len) {
2041 return JimParseListStr(pc);
2043 break;
2046 pc->tstart = pc->tend = pc->p;
2047 pc->tline = pc->linenr;
2048 pc->tt = JIM_TT_EOL;
2049 pc->eof = 1;
2050 return JIM_OK;
2053 static int JimParseListSep(struct JimParserCtx *pc)
2055 pc->tstart = pc->p;
2056 pc->tline = pc->linenr;
2057 while (isspace(UCHAR(*pc->p))) {
2058 if (*pc->p == '\n') {
2059 pc->linenr++;
2061 pc->p++;
2062 pc->len--;
2064 pc->tend = pc->p - 1;
2065 pc->tt = JIM_TT_SEP;
2066 return JIM_OK;
2069 static int JimParseListQuote(struct JimParserCtx *pc)
2071 pc->p++;
2072 pc->len--;
2074 pc->tstart = pc->p;
2075 pc->tline = pc->linenr;
2076 pc->tt = JIM_TT_STR;
2078 while (pc->len) {
2079 switch (*pc->p) {
2080 case '\\':
2081 pc->tt = JIM_TT_ESC;
2082 if (--pc->len == 0) {
2083 /* Trailing backslash */
2084 pc->tend = pc->p;
2085 return JIM_OK;
2087 pc->p++;
2088 break;
2089 case '\n':
2090 pc->linenr++;
2091 break;
2092 case '"':
2093 pc->tend = pc->p - 1;
2094 pc->p++;
2095 pc->len--;
2096 return JIM_OK;
2098 pc->p++;
2099 pc->len--;
2102 pc->tend = pc->p - 1;
2103 return JIM_OK;
2106 static int JimParseListStr(struct JimParserCtx *pc)
2108 pc->tstart = pc->p;
2109 pc->tline = pc->linenr;
2110 pc->tt = JIM_TT_STR;
2112 while (pc->len) {
2113 if (isspace(UCHAR(*pc->p))) {
2114 pc->tend = pc->p - 1;
2115 return JIM_OK;
2117 if (*pc->p == '\\') {
2118 if (--pc->len == 0) {
2119 /* Trailing backslash */
2120 pc->tend = pc->p;
2121 return JIM_OK;
2123 pc->tt = JIM_TT_ESC;
2124 pc->p++;
2126 pc->p++;
2127 pc->len--;
2129 pc->tend = pc->p - 1;
2130 return JIM_OK;
2133 /* -----------------------------------------------------------------------------
2134 * Jim_Obj related functions
2135 * ---------------------------------------------------------------------------*/
2137 /* Return a new initialized object. */
2138 Jim_Obj *Jim_NewObj(Jim_Interp *interp)
2140 Jim_Obj *objPtr;
2142 /* -- Check if there are objects in the free list -- */
2143 if (interp->freeList != NULL) {
2144 /* -- Unlink the object from the free list -- */
2145 objPtr = interp->freeList;
2146 interp->freeList = objPtr->nextObjPtr;
2148 else {
2149 /* -- No ready to use objects: allocate a new one -- */
2150 objPtr = Jim_Alloc(sizeof(*objPtr));
2153 /* Object is returned with refCount of 0. Every
2154 * kind of GC implemented should take care to avoid
2155 * scanning objects with refCount == 0. */
2156 objPtr->refCount = 0;
2157 /* All the other fields are left uninitialized to save time.
2158 * The caller will probably want to set them to the right
2159 * value anyway. */
2161 /* -- Put the object into the live list -- */
2162 objPtr->prevObjPtr = NULL;
2163 objPtr->nextObjPtr = interp->liveList;
2164 if (interp->liveList)
2165 interp->liveList->prevObjPtr = objPtr;
2166 interp->liveList = objPtr;
2168 return objPtr;
2171 /* Free an object. Actually objects are never freed, but
2172 * just moved to the free objects list, where they will be
2173 * reused by Jim_NewObj(). */
2174 void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr)
2176 /* Check if the object was already freed, panic. */
2177 JimPanic((objPtr->refCount != 0, "!!!Object %p freed with bad refcount %d, type=%s", objPtr,
2178 objPtr->refCount, objPtr->typePtr ? objPtr->typePtr->name : "<none>"));
2180 /* Free the internal representation */
2181 Jim_FreeIntRep(interp, objPtr);
2182 /* Free the string representation */
2183 if (objPtr->bytes != NULL) {
2184 if (objPtr->bytes != JimEmptyStringRep)
2185 Jim_Free(objPtr->bytes);
2187 /* Unlink the object from the live objects list */
2188 if (objPtr->prevObjPtr)
2189 objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr;
2190 if (objPtr->nextObjPtr)
2191 objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr;
2192 if (interp->liveList == objPtr)
2193 interp->liveList = objPtr->nextObjPtr;
2194 #ifdef JIM_DISABLE_OBJECT_POOL
2195 Jim_Free(objPtr);
2196 #else
2197 /* Link the object into the free objects list */
2198 objPtr->prevObjPtr = NULL;
2199 objPtr->nextObjPtr = interp->freeList;
2200 if (interp->freeList)
2201 interp->freeList->prevObjPtr = objPtr;
2202 interp->freeList = objPtr;
2203 objPtr->refCount = -1;
2204 #endif
2207 /* Invalidate the string representation of an object. */
2208 void Jim_InvalidateStringRep(Jim_Obj *objPtr)
2210 if (objPtr->bytes != NULL) {
2211 if (objPtr->bytes != JimEmptyStringRep)
2212 Jim_Free(objPtr->bytes);
2214 objPtr->bytes = NULL;
2217 /* Duplicate an object. The returned object has refcount = 0. */
2218 Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
2220 Jim_Obj *dupPtr;
2222 dupPtr = Jim_NewObj(interp);
2223 if (objPtr->bytes == NULL) {
2224 /* Object does not have a valid string representation. */
2225 dupPtr->bytes = NULL;
2227 else if (objPtr->length == 0) {
2228 /* Zero length, so don't even bother with the type-specific dup,
2229 * since all zero length objects look the same
2231 dupPtr->bytes = JimEmptyStringRep;
2232 dupPtr->length = 0;
2233 dupPtr->typePtr = NULL;
2234 return dupPtr;
2236 else {
2237 dupPtr->bytes = Jim_Alloc(objPtr->length + 1);
2238 dupPtr->length = objPtr->length;
2239 /* Copy the null byte too */
2240 memcpy(dupPtr->bytes, objPtr->bytes, objPtr->length + 1);
2243 /* By default, the new object has the same type as the old object */
2244 dupPtr->typePtr = objPtr->typePtr;
2245 if (objPtr->typePtr != NULL) {
2246 if (objPtr->typePtr->dupIntRepProc == NULL) {
2247 dupPtr->internalRep = objPtr->internalRep;
2249 else {
2250 /* The dup proc may set a different type, e.g. NULL */
2251 objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr);
2254 return dupPtr;
2257 /* Return the string representation for objPtr. If the object's
2258 * string representation is invalid, calls the updateStringProc method to create
2259 * a new one from the internal representation of the object.
2261 const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr)
2263 if (objPtr->bytes == NULL) {
2264 /* Invalid string repr. Generate it. */
2265 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2266 objPtr->typePtr->updateStringProc(objPtr);
2268 if (lenPtr)
2269 *lenPtr = objPtr->length;
2270 return objPtr->bytes;
2273 /* Just returns the length (in bytes) of the object's string rep */
2274 int Jim_Length(Jim_Obj *objPtr)
2276 if (objPtr->bytes == NULL) {
2277 /* Invalid string repr. Generate it. */
2278 Jim_GetString(objPtr, NULL);
2280 return objPtr->length;
2283 /* Just returns object's string rep */
2284 const char *Jim_String(Jim_Obj *objPtr)
2286 if (objPtr->bytes == NULL) {
2287 /* Invalid string repr. Generate it. */
2288 Jim_GetString(objPtr, NULL);
2290 return objPtr->bytes;
2293 static void JimSetStringBytes(Jim_Obj *objPtr, const char *str)
2295 objPtr->bytes = Jim_StrDup(str);
2296 objPtr->length = strlen(str);
2299 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2300 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2302 static const Jim_ObjType dictSubstObjType = {
2303 "dict-substitution",
2304 FreeDictSubstInternalRep,
2305 DupDictSubstInternalRep,
2306 NULL,
2307 JIM_TYPE_NONE,
2310 static void FreeInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2311 static void DupInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2313 static const Jim_ObjType interpolatedObjType = {
2314 "interpolated",
2315 FreeInterpolatedInternalRep,
2316 DupInterpolatedInternalRep,
2317 NULL,
2318 JIM_TYPE_NONE,
2321 static void FreeInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2323 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
2326 static void DupInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2328 /* Copy the interal rep */
2329 dupPtr->internalRep = srcPtr->internalRep;
2330 /* Need to increment the key ref count */
2331 Jim_IncrRefCount(dupPtr->internalRep.dictSubstValue.indexObjPtr);
2334 /* -----------------------------------------------------------------------------
2335 * String Object
2336 * ---------------------------------------------------------------------------*/
2337 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2338 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2340 static const Jim_ObjType stringObjType = {
2341 "string",
2342 NULL,
2343 DupStringInternalRep,
2344 NULL,
2345 JIM_TYPE_REFERENCES,
2348 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2350 JIM_NOTUSED(interp);
2352 /* This is a bit subtle: the only caller of this function
2353 * should be Jim_DuplicateObj(), that will copy the
2354 * string representaion. After the copy, the duplicated
2355 * object will not have more room in the buffer than
2356 * srcPtr->length bytes. So we just set it to length. */
2357 dupPtr->internalRep.strValue.maxLength = srcPtr->length;
2358 dupPtr->internalRep.strValue.charLength = srcPtr->internalRep.strValue.charLength;
2361 static int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
2363 if (objPtr->typePtr != &stringObjType) {
2364 /* Get a fresh string representation. */
2365 if (objPtr->bytes == NULL) {
2366 /* Invalid string repr. Generate it. */
2367 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2368 objPtr->typePtr->updateStringProc(objPtr);
2370 /* Free any other internal representation. */
2371 Jim_FreeIntRep(interp, objPtr);
2372 /* Set it as string, i.e. just set the maxLength field. */
2373 objPtr->typePtr = &stringObjType;
2374 objPtr->internalRep.strValue.maxLength = objPtr->length;
2375 /* Don't know the utf-8 length yet */
2376 objPtr->internalRep.strValue.charLength = -1;
2378 return JIM_OK;
2382 * Returns the length of the object string in chars, not bytes.
2384 * These may be different for a utf-8 string.
2386 int Jim_Utf8Length(Jim_Interp *interp, Jim_Obj *objPtr)
2388 #ifdef JIM_UTF8
2389 SetStringFromAny(interp, objPtr);
2391 if (objPtr->internalRep.strValue.charLength < 0) {
2392 objPtr->internalRep.strValue.charLength = utf8_strlen(objPtr->bytes, objPtr->length);
2394 return objPtr->internalRep.strValue.charLength;
2395 #else
2396 return Jim_Length(objPtr);
2397 #endif
2400 /* len is in bytes -- see also Jim_NewStringObjUtf8() */
2401 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
2403 Jim_Obj *objPtr = Jim_NewObj(interp);
2405 /* Need to find out how many bytes the string requires */
2406 if (len == -1)
2407 len = strlen(s);
2408 /* Alloc/Set the string rep. */
2409 if (len == 0) {
2410 objPtr->bytes = JimEmptyStringRep;
2412 else {
2413 objPtr->bytes = Jim_StrDupLen(s, len);
2415 objPtr->length = len;
2417 /* No typePtr field for the vanilla string object. */
2418 objPtr->typePtr = NULL;
2419 return objPtr;
2422 /* charlen is in characters -- see also Jim_NewStringObj() */
2423 Jim_Obj *Jim_NewStringObjUtf8(Jim_Interp *interp, const char *s, int charlen)
2425 #ifdef JIM_UTF8
2426 /* Need to find out how many bytes the string requires */
2427 int bytelen = utf8_index(s, charlen);
2429 Jim_Obj *objPtr = Jim_NewStringObj(interp, s, bytelen);
2431 /* Remember the utf8 length, so set the type */
2432 objPtr->typePtr = &stringObjType;
2433 objPtr->internalRep.strValue.maxLength = bytelen;
2434 objPtr->internalRep.strValue.charLength = charlen;
2436 return objPtr;
2437 #else
2438 return Jim_NewStringObj(interp, s, charlen);
2439 #endif
2442 /* This version does not try to duplicate the 's' pointer, but
2443 * use it directly. */
2444 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
2446 Jim_Obj *objPtr = Jim_NewObj(interp);
2448 objPtr->bytes = s;
2449 objPtr->length = (len == -1) ? strlen(s) : len;
2450 objPtr->typePtr = NULL;
2451 return objPtr;
2454 /* Low-level string append. Use it only against unshared objects
2455 * of type "string". */
2456 static void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
2458 int needlen;
2460 if (len == -1)
2461 len = strlen(str);
2462 needlen = objPtr->length + len;
2463 if (objPtr->internalRep.strValue.maxLength < needlen ||
2464 objPtr->internalRep.strValue.maxLength == 0) {
2465 needlen *= 2;
2466 /* Inefficient to malloc() for less than 8 bytes */
2467 if (needlen < 7) {
2468 needlen = 7;
2470 if (objPtr->bytes == JimEmptyStringRep) {
2471 objPtr->bytes = Jim_Alloc(needlen + 1);
2473 else {
2474 objPtr->bytes = Jim_Realloc(objPtr->bytes, needlen + 1);
2476 objPtr->internalRep.strValue.maxLength = needlen;
2478 memcpy(objPtr->bytes + objPtr->length, str, len);
2479 objPtr->bytes[objPtr->length + len] = '\0';
2481 if (objPtr->internalRep.strValue.charLength >= 0) {
2482 /* Update the utf-8 char length */
2483 objPtr->internalRep.strValue.charLength += utf8_strlen(objPtr->bytes + objPtr->length, len);
2485 objPtr->length += len;
2488 /* Higher level API to append strings to objects.
2489 * Object must not be unshared for each of these.
2491 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str, int len)
2493 JimPanic((Jim_IsShared(objPtr), "Jim_AppendString called with shared object"));
2494 SetStringFromAny(interp, objPtr);
2495 StringAppendString(objPtr, str, len);
2498 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *appendObjPtr)
2500 int len;
2501 const char *str = Jim_GetString(appendObjPtr, &len);
2502 Jim_AppendString(interp, objPtr, str, len);
2505 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2507 va_list ap;
2509 SetStringFromAny(interp, objPtr);
2510 va_start(ap, objPtr);
2511 while (1) {
2512 const char *s = va_arg(ap, const char *);
2514 if (s == NULL)
2515 break;
2516 Jim_AppendString(interp, objPtr, s, -1);
2518 va_end(ap);
2521 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr)
2523 if (aObjPtr == bObjPtr) {
2524 return 1;
2526 else {
2527 int Alen, Blen;
2528 const char *sA = Jim_GetString(aObjPtr, &Alen);
2529 const char *sB = Jim_GetString(bObjPtr, &Blen);
2531 return Alen == Blen && memcmp(sA, sB, Alen) == 0;
2536 * Note. Does not support embedded nulls in either the pattern or the object.
2538 int Jim_StringMatchObj(Jim_Interp *interp, Jim_Obj *patternObjPtr, Jim_Obj *objPtr, int nocase)
2540 return JimGlobMatch(Jim_String(patternObjPtr), Jim_String(objPtr), nocase);
2544 * Note: does not support embedded nulls for the nocase option.
2546 int Jim_StringCompareObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2548 int l1, l2;
2549 const char *s1 = Jim_GetString(firstObjPtr, &l1);
2550 const char *s2 = Jim_GetString(secondObjPtr, &l2);
2552 if (nocase) {
2553 /* Do a character compare for nocase */
2554 return JimStringCompareLen(s1, s2, -1, nocase);
2556 return JimStringCompare(s1, l1, s2, l2);
2560 * Like Jim_StringCompareObj() except compares to a maximum of the length of firstObjPtr.
2562 * Note: does not support embedded nulls
2564 int Jim_StringCompareLenObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2566 const char *s1 = Jim_String(firstObjPtr);
2567 const char *s2 = Jim_String(secondObjPtr);
2569 return JimStringCompareLen(s1, s2, Jim_Utf8Length(interp, firstObjPtr), nocase);
2572 /* Convert a range, as returned by Jim_GetRange(), into
2573 * an absolute index into an object of the specified length.
2574 * This function may return negative values, or values
2575 * greater than or equal to the length of the list if the index
2576 * is out of range. */
2577 static int JimRelToAbsIndex(int len, int idx)
2579 if (idx < 0)
2580 return len + idx;
2581 return idx;
2584 /* Convert a pair of indexes (*firstPtr, *lastPtr) as normalized by JimRelToAbsIndex(),
2585 * into a form suitable for implementation of commands like [string range] and [lrange].
2587 * The resulting range is guaranteed to address valid elements of
2588 * the structure.
2590 static void JimRelToAbsRange(int len, int *firstPtr, int *lastPtr, int *rangeLenPtr)
2592 int rangeLen;
2594 if (*firstPtr > *lastPtr) {
2595 rangeLen = 0;
2597 else {
2598 rangeLen = *lastPtr - *firstPtr + 1;
2599 if (rangeLen) {
2600 if (*firstPtr < 0) {
2601 rangeLen += *firstPtr;
2602 *firstPtr = 0;
2604 if (*lastPtr >= len) {
2605 rangeLen -= (*lastPtr - (len - 1));
2606 *lastPtr = len - 1;
2610 if (rangeLen < 0)
2611 rangeLen = 0;
2613 *rangeLenPtr = rangeLen;
2616 static int JimStringGetRange(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr,
2617 int len, int *first, int *last, int *range)
2619 if (Jim_GetIndex(interp, firstObjPtr, first) != JIM_OK) {
2620 return JIM_ERR;
2622 if (Jim_GetIndex(interp, lastObjPtr, last) != JIM_OK) {
2623 return JIM_ERR;
2625 *first = JimRelToAbsIndex(len, *first);
2626 *last = JimRelToAbsIndex(len, *last);
2627 JimRelToAbsRange(len, first, last, range);
2628 return JIM_OK;
2631 Jim_Obj *Jim_StringByteRangeObj(Jim_Interp *interp,
2632 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2634 int first, last;
2635 const char *str;
2636 int rangeLen;
2637 int bytelen;
2639 str = Jim_GetString(strObjPtr, &bytelen);
2641 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, bytelen, &first, &last, &rangeLen) != JIM_OK) {
2642 return NULL;
2645 if (first == 0 && rangeLen == bytelen) {
2646 return strObjPtr;
2648 return Jim_NewStringObj(interp, str + first, rangeLen);
2651 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2652 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2654 #ifdef JIM_UTF8
2655 int first, last;
2656 const char *str;
2657 int len, rangeLen;
2658 int bytelen;
2660 str = Jim_GetString(strObjPtr, &bytelen);
2661 len = Jim_Utf8Length(interp, strObjPtr);
2663 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2664 return NULL;
2667 if (first == 0 && rangeLen == len) {
2668 return strObjPtr;
2670 if (len == bytelen) {
2671 /* ASCII optimisation */
2672 return Jim_NewStringObj(interp, str + first, rangeLen);
2674 return Jim_NewStringObjUtf8(interp, str + utf8_index(str, first), rangeLen);
2675 #else
2676 return Jim_StringByteRangeObj(interp, strObjPtr, firstObjPtr, lastObjPtr);
2677 #endif
2680 Jim_Obj *JimStringReplaceObj(Jim_Interp *interp,
2681 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr, Jim_Obj *newStrObj)
2683 int first, last;
2684 const char *str;
2685 int len, rangeLen;
2686 Jim_Obj *objPtr;
2688 len = Jim_Utf8Length(interp, strObjPtr);
2690 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2691 return NULL;
2694 if (last < first) {
2695 return strObjPtr;
2698 str = Jim_String(strObjPtr);
2700 /* Before part */
2701 objPtr = Jim_NewStringObjUtf8(interp, str, first);
2703 /* Replacement */
2704 if (newStrObj) {
2705 Jim_AppendObj(interp, objPtr, newStrObj);
2708 /* After part */
2709 Jim_AppendString(interp, objPtr, str + utf8_index(str, last + 1), len - last - 1);
2711 return objPtr;
2715 * Note: does not support embedded nulls.
2717 static void JimStrCopyUpperLower(char *dest, const char *str, int uc)
2719 while (*str) {
2720 int c;
2721 str += utf8_tounicode(str, &c);
2722 dest += utf8_getchars(dest, uc ? utf8_upper(c) : utf8_lower(c));
2724 *dest = 0;
2728 * Note: does not support embedded nulls.
2730 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2732 char *buf;
2733 int len;
2734 const char *str;
2736 str = Jim_GetString(strObjPtr, &len);
2738 #ifdef JIM_UTF8
2739 /* Case mapping can change the utf-8 length of the string.
2740 * But at worst it will be by one extra byte per char
2742 len *= 2;
2743 #endif
2744 buf = Jim_Alloc(len + 1);
2745 JimStrCopyUpperLower(buf, str, 0);
2746 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2750 * Note: does not support embedded nulls.
2752 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2754 char *buf;
2755 const char *str;
2756 int len;
2758 str = Jim_GetString(strObjPtr, &len);
2760 #ifdef JIM_UTF8
2761 /* Case mapping can change the utf-8 length of the string.
2762 * But at worst it will be by one extra byte per char
2764 len *= 2;
2765 #endif
2766 buf = Jim_Alloc(len + 1);
2767 JimStrCopyUpperLower(buf, str, 1);
2768 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2772 * Note: does not support embedded nulls.
2774 static Jim_Obj *JimStringToTitle(Jim_Interp *interp, Jim_Obj *strObjPtr)
2776 char *buf, *p;
2777 int len;
2778 int c;
2779 const char *str;
2781 str = Jim_GetString(strObjPtr, &len);
2783 #ifdef JIM_UTF8
2784 /* Case mapping can change the utf-8 length of the string.
2785 * But at worst it will be by one extra byte per char
2787 len *= 2;
2788 #endif
2789 buf = p = Jim_Alloc(len + 1);
2791 str += utf8_tounicode(str, &c);
2792 p += utf8_getchars(p, utf8_title(c));
2794 JimStrCopyUpperLower(p, str, 0);
2796 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2799 /* Similar to memchr() except searches a UTF-8 string 'str' of byte length 'len'
2800 * for unicode character 'c'.
2801 * Returns the position if found or NULL if not
2803 static const char *utf8_memchr(const char *str, int len, int c)
2805 #ifdef JIM_UTF8
2806 while (len) {
2807 int sc;
2808 int n = utf8_tounicode(str, &sc);
2809 if (sc == c) {
2810 return str;
2812 str += n;
2813 len -= n;
2815 return NULL;
2816 #else
2817 return memchr(str, c, len);
2818 #endif
2822 * Searches for the first non-trim char in string (str, len)
2824 * If none is found, returns just past the last char.
2826 * Lengths are in bytes.
2828 static const char *JimFindTrimLeft(const char *str, int len, const char *trimchars, int trimlen)
2830 while (len) {
2831 int c;
2832 int n = utf8_tounicode(str, &c);
2834 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2835 /* Not a trim char, so stop */
2836 break;
2838 str += n;
2839 len -= n;
2841 return str;
2845 * Searches backwards for a non-trim char in string (str, len).
2847 * Returns a pointer to just after the non-trim char, or NULL if not found.
2849 * Lengths are in bytes.
2851 static const char *JimFindTrimRight(const char *str, int len, const char *trimchars, int trimlen)
2853 str += len;
2855 while (len) {
2856 int c;
2857 int n = utf8_prev_len(str, len);
2859 len -= n;
2860 str -= n;
2862 n = utf8_tounicode(str, &c);
2864 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2865 return str + n;
2869 return NULL;
2872 static const char default_trim_chars[] = " \t\n\r";
2873 /* sizeof() here includes the null byte */
2874 static int default_trim_chars_len = sizeof(default_trim_chars);
2876 static Jim_Obj *JimStringTrimLeft(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2878 int len;
2879 const char *str = Jim_GetString(strObjPtr, &len);
2880 const char *trimchars = default_trim_chars;
2881 int trimcharslen = default_trim_chars_len;
2882 const char *newstr;
2884 if (trimcharsObjPtr) {
2885 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2888 newstr = JimFindTrimLeft(str, len, trimchars, trimcharslen);
2889 if (newstr == str) {
2890 return strObjPtr;
2893 return Jim_NewStringObj(interp, newstr, len - (newstr - str));
2896 static Jim_Obj *JimStringTrimRight(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2898 int len;
2899 const char *trimchars = default_trim_chars;
2900 int trimcharslen = default_trim_chars_len;
2901 const char *nontrim;
2903 if (trimcharsObjPtr) {
2904 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2907 SetStringFromAny(interp, strObjPtr);
2909 len = Jim_Length(strObjPtr);
2910 nontrim = JimFindTrimRight(strObjPtr->bytes, len, trimchars, trimcharslen);
2912 if (nontrim == NULL) {
2913 /* All trim, so return a zero-length string */
2914 return Jim_NewEmptyStringObj(interp);
2916 if (nontrim == strObjPtr->bytes + len) {
2917 /* All non-trim, so return the original object */
2918 return strObjPtr;
2921 if (Jim_IsShared(strObjPtr)) {
2922 strObjPtr = Jim_NewStringObj(interp, strObjPtr->bytes, (nontrim - strObjPtr->bytes));
2924 else {
2925 /* Can modify this string in place */
2926 strObjPtr->bytes[nontrim - strObjPtr->bytes] = 0;
2927 strObjPtr->length = (nontrim - strObjPtr->bytes);
2930 return strObjPtr;
2933 static Jim_Obj *JimStringTrim(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2935 /* First trim left. */
2936 Jim_Obj *objPtr = JimStringTrimLeft(interp, strObjPtr, trimcharsObjPtr);
2938 /* Now trim right */
2939 strObjPtr = JimStringTrimRight(interp, objPtr, trimcharsObjPtr);
2941 /* Note: refCount check is needed since objPtr may be emptyObj */
2942 if (objPtr != strObjPtr && objPtr->refCount == 0) {
2943 /* We don't want this object to be leaked */
2944 Jim_FreeNewObj(interp, objPtr);
2947 return strObjPtr;
2950 /* Some platforms don't have isascii - need a non-macro version */
2951 #ifdef HAVE_ISASCII
2952 #define jim_isascii isascii
2953 #else
2954 static int jim_isascii(int c)
2956 return !(c & ~0x7f);
2958 #endif
2960 static int JimStringIs(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *strClass, int strict)
2962 static const char * const strclassnames[] = {
2963 "integer", "alpha", "alnum", "ascii", "digit",
2964 "double", "lower", "upper", "space", "xdigit",
2965 "control", "print", "graph", "punct", "boolean",
2966 NULL
2968 enum {
2969 STR_IS_INTEGER, STR_IS_ALPHA, STR_IS_ALNUM, STR_IS_ASCII, STR_IS_DIGIT,
2970 STR_IS_DOUBLE, STR_IS_LOWER, STR_IS_UPPER, STR_IS_SPACE, STR_IS_XDIGIT,
2971 STR_IS_CONTROL, STR_IS_PRINT, STR_IS_GRAPH, STR_IS_PUNCT, STR_IS_BOOLEAN,
2973 int strclass;
2974 int len;
2975 int i;
2976 const char *str;
2977 int (*isclassfunc)(int c) = NULL;
2979 if (Jim_GetEnum(interp, strClass, strclassnames, &strclass, "class", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
2980 return JIM_ERR;
2983 str = Jim_GetString(strObjPtr, &len);
2984 if (len == 0) {
2985 Jim_SetResultBool(interp, !strict);
2986 return JIM_OK;
2989 switch (strclass) {
2990 case STR_IS_INTEGER:
2992 jim_wide w;
2993 Jim_SetResultBool(interp, JimGetWideNoErr(interp, strObjPtr, &w) == JIM_OK);
2994 return JIM_OK;
2997 case STR_IS_DOUBLE:
2999 double d;
3000 Jim_SetResultBool(interp, Jim_GetDouble(interp, strObjPtr, &d) == JIM_OK && errno != ERANGE);
3001 return JIM_OK;
3004 case STR_IS_BOOLEAN:
3006 int b;
3007 Jim_SetResultBool(interp, Jim_GetBoolean(interp, strObjPtr, &b) == JIM_OK);
3008 return JIM_OK;
3011 case STR_IS_ALPHA: isclassfunc = isalpha; break;
3012 case STR_IS_ALNUM: isclassfunc = isalnum; break;
3013 case STR_IS_ASCII: isclassfunc = jim_isascii; break;
3014 case STR_IS_DIGIT: isclassfunc = isdigit; break;
3015 case STR_IS_LOWER: isclassfunc = islower; break;
3016 case STR_IS_UPPER: isclassfunc = isupper; break;
3017 case STR_IS_SPACE: isclassfunc = isspace; break;
3018 case STR_IS_XDIGIT: isclassfunc = isxdigit; break;
3019 case STR_IS_CONTROL: isclassfunc = iscntrl; break;
3020 case STR_IS_PRINT: isclassfunc = isprint; break;
3021 case STR_IS_GRAPH: isclassfunc = isgraph; break;
3022 case STR_IS_PUNCT: isclassfunc = ispunct; break;
3023 default:
3024 return JIM_ERR;
3027 for (i = 0; i < len; i++) {
3028 if (!isclassfunc(UCHAR(str[i]))) {
3029 Jim_SetResultBool(interp, 0);
3030 return JIM_OK;
3033 Jim_SetResultBool(interp, 1);
3034 return JIM_OK;
3037 /* -----------------------------------------------------------------------------
3038 * Compared String Object
3039 * ---------------------------------------------------------------------------*/
3041 /* This is strange object that allows comparison of a C literal string
3042 * with a Jim object in a very short time if the same comparison is done
3043 * multiple times. For example every time the [if] command is executed,
3044 * Jim has to check if a given argument is "else".
3045 * If the code has no errors, this comparison is true most of the time,
3046 * so we can cache the pointer of the string of the last matching
3047 * comparison inside the object. Because most C compilers perform literal sharing,
3048 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
3049 * this works pretty well even if comparisons are at different places
3050 * inside the C code. */
3052 static const Jim_ObjType comparedStringObjType = {
3053 "compared-string",
3054 NULL,
3055 NULL,
3056 NULL,
3057 JIM_TYPE_REFERENCES,
3060 /* The only way this object is exposed to the API is via the following
3061 * function. Returns true if the string and the object string repr.
3062 * are the same, otherwise zero is returned.
3064 * Note: this isn't binary safe, but it hardly needs to be.*/
3065 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr, const char *str)
3067 if (objPtr->typePtr == &comparedStringObjType && objPtr->internalRep.ptr == str) {
3068 return 1;
3070 else {
3071 if (strcmp(str, Jim_String(objPtr)) != 0)
3072 return 0;
3074 if (objPtr->typePtr != &comparedStringObjType) {
3075 Jim_FreeIntRep(interp, objPtr);
3076 objPtr->typePtr = &comparedStringObjType;
3078 objPtr->internalRep.ptr = (char *)str; /*ATTENTION: const cast */
3079 return 1;
3083 static int qsortCompareStringPointers(const void *a, const void *b)
3085 char *const *sa = (char *const *)a;
3086 char *const *sb = (char *const *)b;
3088 return strcmp(*sa, *sb);
3092 /* -----------------------------------------------------------------------------
3093 * Source Object
3095 * This object is just a string from the language point of view, but
3096 * the internal representation contains the filename and line number
3097 * where this token was read. This information is used by
3098 * Jim_EvalObj() if the object passed happens to be of type "source".
3100 * This allows propagation of the information about line numbers and file
3101 * names and gives error messages with absolute line numbers.
3103 * Note that this object uses the internal representation of the Jim_Object,
3104 * so there is almost no memory overhead. (One Jim_Obj for each filename).
3106 * Also the object will be converted to something else if the given
3107 * token it represents in the source file is not something to be
3108 * evaluated (not a script), and will be specialized in some other way,
3109 * so the time overhead is also almost zero.
3110 * ---------------------------------------------------------------------------*/
3112 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3113 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3115 static const Jim_ObjType sourceObjType = {
3116 "source",
3117 FreeSourceInternalRep,
3118 DupSourceInternalRep,
3119 NULL,
3120 JIM_TYPE_REFERENCES,
3123 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3125 Jim_DecrRefCount(interp, objPtr->internalRep.sourceValue.fileNameObj);
3128 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3130 dupPtr->internalRep.sourceValue = srcPtr->internalRep.sourceValue;
3131 Jim_IncrRefCount(dupPtr->internalRep.sourceValue.fileNameObj);
3134 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
3135 Jim_Obj *fileNameObj, int lineNumber)
3137 JimPanic((Jim_IsShared(objPtr), "JimSetSourceInfo called with shared object"));
3138 JimPanic((objPtr->typePtr != NULL, "JimSetSourceInfo called with typed object"));
3139 Jim_IncrRefCount(fileNameObj);
3140 objPtr->internalRep.sourceValue.fileNameObj = fileNameObj;
3141 objPtr->internalRep.sourceValue.lineNumber = lineNumber;
3142 objPtr->typePtr = &sourceObjType;
3145 /* -----------------------------------------------------------------------------
3146 * ScriptLine Object
3148 * This object is used only in the Script internal represenation.
3149 * For each line of the script, it holds the number of tokens on the line
3150 * and the source line number.
3152 static const Jim_ObjType scriptLineObjType = {
3153 "scriptline",
3154 NULL,
3155 NULL,
3156 NULL,
3157 JIM_NONE,
3160 static Jim_Obj *JimNewScriptLineObj(Jim_Interp *interp, int argc, int line)
3162 Jim_Obj *objPtr;
3164 #ifdef DEBUG_SHOW_SCRIPT
3165 char buf[100];
3166 snprintf(buf, sizeof(buf), "line=%d, argc=%d", line, argc);
3167 objPtr = Jim_NewStringObj(interp, buf, -1);
3168 #else
3169 objPtr = Jim_NewEmptyStringObj(interp);
3170 #endif
3171 objPtr->typePtr = &scriptLineObjType;
3172 objPtr->internalRep.scriptLineValue.argc = argc;
3173 objPtr->internalRep.scriptLineValue.line = line;
3175 return objPtr;
3178 /* -----------------------------------------------------------------------------
3179 * Script Object
3181 * This object holds the parsed internal representation of a script.
3182 * This representation is help within an allocated ScriptObj (see below)
3184 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3185 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3187 static const Jim_ObjType scriptObjType = {
3188 "script",
3189 FreeScriptInternalRep,
3190 DupScriptInternalRep,
3191 NULL,
3192 JIM_TYPE_REFERENCES,
3195 /* Each token of a script is represented by a ScriptToken.
3196 * The ScriptToken contains a type and a Jim_Obj. The Jim_Obj
3197 * can be specialized by commands operating on it.
3199 typedef struct ScriptToken
3201 Jim_Obj *objPtr;
3202 int type;
3203 } ScriptToken;
3205 /* This is the script object internal representation. An array of
3206 * ScriptToken structures, including a pre-computed representation of the
3207 * command length and arguments.
3209 * For example the script:
3211 * puts hello
3212 * set $i $x$y [foo]BAR
3214 * will produce a ScriptObj with the following ScriptToken's:
3216 * LIN 2
3217 * ESC puts
3218 * ESC hello
3219 * LIN 4
3220 * ESC set
3221 * VAR i
3222 * WRD 2
3223 * VAR x
3224 * VAR y
3225 * WRD 2
3226 * CMD foo
3227 * ESC BAR
3229 * "puts hello" has two args (LIN 2), composed of single tokens.
3230 * (Note that the WRD token is omitted for the common case of a single token.)
3232 * "set $i $x$y [foo]BAR" has four (LIN 4) args, the first word
3233 * has 1 token (ESC SET), and the last has two tokens (WRD 2 CMD foo ESC BAR)
3235 * The precomputation of the command structure makes Jim_Eval() faster,
3236 * and simpler because there aren't dynamic lengths / allocations.
3238 * -- {expand}/{*} handling --
3240 * Expand is handled in a special way.
3242 * If a "word" begins with {*}, the word token count is -ve.
3244 * For example the command:
3246 * list {*}{a b}
3248 * Will produce the following cmdstruct array:
3250 * LIN 2
3251 * ESC list
3252 * WRD -1
3253 * STR a b
3255 * Note that the 'LIN' token also contains the source information for the
3256 * first word of the line for error reporting purposes
3258 * -- the substFlags field of the structure --
3260 * The scriptObj structure is used to represent both "script" objects
3261 * and "subst" objects. In the second case, there are no LIN and WRD
3262 * tokens. Instead SEP and EOL tokens are added as-is.
3263 * In addition, the field 'substFlags' is used to represent the flags used to turn
3264 * the string into the internal representation.
3265 * If these flags do not match what the application requires,
3266 * the scriptObj is created again. For example the script:
3268 * subst -nocommands $string
3269 * subst -novariables $string
3271 * Will (re)create the internal representation of the $string object
3272 * two times.
3274 typedef struct ScriptObj
3276 ScriptToken *token; /* Tokens array. */
3277 Jim_Obj *fileNameObj; /* Filename */
3278 int len; /* Length of token[] */
3279 int substFlags; /* flags used for the compilation of "subst" objects */
3280 int inUse; /* Used to share a ScriptObj. Currently
3281 only used by Jim_EvalObj() as protection against
3282 shimmering of the currently evaluated object. */
3283 int firstline; /* Line number of the first line */
3284 int linenr; /* Error line number, if any */
3285 int missing; /* Missing char if script failed to parse, (or space or backslash if OK) */
3286 } ScriptObj;
3288 static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3289 static int JimParseCheckMissing(Jim_Interp *interp, int ch);
3290 static ScriptObj *JimGetScript(Jim_Interp *interp, Jim_Obj *objPtr);
3292 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3294 int i;
3295 struct ScriptObj *script = (void *)objPtr->internalRep.ptr;
3297 if (--script->inUse != 0)
3298 return;
3299 for (i = 0; i < script->len; i++) {
3300 Jim_DecrRefCount(interp, script->token[i].objPtr);
3302 Jim_Free(script->token);
3303 Jim_DecrRefCount(interp, script->fileNameObj);
3304 Jim_Free(script);
3307 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3309 JIM_NOTUSED(interp);
3310 JIM_NOTUSED(srcPtr);
3312 /* Just return a simple string. We don't try to preserve the source info
3313 * since in practice scripts are never duplicated
3315 dupPtr->typePtr = NULL;
3318 /* A simple parse token.
3319 * As the script is parsed, the created tokens point into the script string rep.
3321 typedef struct
3323 const char *token; /* Pointer to the start of the token */
3324 int len; /* Length of this token */
3325 int type; /* Token type */
3326 int line; /* Line number */
3327 } ParseToken;
3329 /* A list of parsed tokens representing a script.
3330 * Tokens are added to this list as the script is parsed.
3331 * It grows as needed.
3333 typedef struct
3335 /* Start with a statically allocated list of tokens which will be expanded with realloc if needed */
3336 ParseToken *list; /* Array of tokens */
3337 int size; /* Current size of the list */
3338 int count; /* Number of entries used */
3339 ParseToken static_list[20]; /* Small initial token space to avoid allocation */
3340 } ParseTokenList;
3342 static void ScriptTokenListInit(ParseTokenList *tokenlist)
3344 tokenlist->list = tokenlist->static_list;
3345 tokenlist->size = sizeof(tokenlist->static_list) / sizeof(ParseToken);
3346 tokenlist->count = 0;
3349 static void ScriptTokenListFree(ParseTokenList *tokenlist)
3351 if (tokenlist->list != tokenlist->static_list) {
3352 Jim_Free(tokenlist->list);
3357 * Adds the new token to the tokenlist.
3358 * The token has the given length, type and line number.
3359 * The token list is resized as necessary.
3361 static void ScriptAddToken(ParseTokenList *tokenlist, const char *token, int len, int type,
3362 int line)
3364 ParseToken *t;
3366 if (tokenlist->count == tokenlist->size) {
3367 /* Resize the list */
3368 tokenlist->size *= 2;
3369 if (tokenlist->list != tokenlist->static_list) {
3370 tokenlist->list =
3371 Jim_Realloc(tokenlist->list, tokenlist->size * sizeof(*tokenlist->list));
3373 else {
3374 /* The list needs to become allocated */
3375 tokenlist->list = Jim_Alloc(tokenlist->size * sizeof(*tokenlist->list));
3376 memcpy(tokenlist->list, tokenlist->static_list,
3377 tokenlist->count * sizeof(*tokenlist->list));
3380 t = &tokenlist->list[tokenlist->count++];
3381 t->token = token;
3382 t->len = len;
3383 t->type = type;
3384 t->line = line;
3387 /* Counts the number of adjoining non-separator tokens.
3389 * Returns -ve if the first token is the expansion
3390 * operator (in which case the count doesn't include
3391 * that token).
3393 static int JimCountWordTokens(struct ScriptObj *script, ParseToken *t)
3395 int expand = 1;
3396 int count = 0;
3398 /* Is the first word {*} or {expand}? */
3399 if (t->type == JIM_TT_STR && !TOKEN_IS_SEP(t[1].type)) {
3400 if ((t->len == 1 && *t->token == '*') || (t->len == 6 && strncmp(t->token, "expand", 6) == 0)) {
3401 /* Create an expand token */
3402 expand = -1;
3403 t++;
3405 else {
3406 if (script->missing == ' ') {
3407 /* This is a "extra characters after close-brace" error. Report the first error */
3408 script->missing = '}';
3409 script->linenr = t[1].line;
3414 /* Now count non-separator words */
3415 while (!TOKEN_IS_SEP(t->type)) {
3416 t++;
3417 count++;
3420 return count * expand;
3424 * Create a script/subst object from the given token.
3426 static Jim_Obj *JimMakeScriptObj(Jim_Interp *interp, const ParseToken *t)
3428 Jim_Obj *objPtr;
3430 if (t->type == JIM_TT_ESC && memchr(t->token, '\\', t->len) != NULL) {
3431 /* Convert backlash escapes. The result will never be longer than the original */
3432 int len = t->len;
3433 char *str = Jim_Alloc(len + 1);
3434 len = JimEscape(str, t->token, len);
3435 objPtr = Jim_NewStringObjNoAlloc(interp, str, len);
3437 else {
3438 /* XXX: For strict Tcl compatibility, JIM_TT_STR should replace <backslash><newline><whitespace>
3439 * with a single space.
3441 objPtr = Jim_NewStringObj(interp, t->token, t->len);
3443 return objPtr;
3447 * Takes a tokenlist and creates the allocated list of script tokens
3448 * in script->token, of length script->len.
3450 * Unnecessary tokens are discarded, and LINE and WORD tokens are inserted
3451 * as required.
3453 * Also sets script->line to the line number of the first token
3455 static void ScriptObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3456 ParseTokenList *tokenlist)
3458 int i;
3459 struct ScriptToken *token;
3460 /* Number of tokens so far for the current command */
3461 int lineargs = 0;
3462 /* This is the first token for the current command */
3463 ScriptToken *linefirst;
3464 int count;
3465 int linenr;
3467 #ifdef DEBUG_SHOW_SCRIPT_TOKENS
3468 printf("==== Tokens ====\n");
3469 for (i = 0; i < tokenlist->count; i++) {
3470 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist->list[i].line, jim_tt_name(tokenlist->list[i].type),
3471 tokenlist->list[i].len, tokenlist->list[i].token);
3473 #endif
3475 /* May need up to one extra script token for each EOL in the worst case */
3476 count = tokenlist->count;
3477 for (i = 0; i < tokenlist->count; i++) {
3478 if (tokenlist->list[i].type == JIM_TT_EOL) {
3479 count++;
3482 linenr = script->firstline = tokenlist->list[0].line;
3484 token = script->token = Jim_Alloc(sizeof(ScriptToken) * count);
3486 /* This is the first token for the current command */
3487 linefirst = token++;
3489 for (i = 0; i < tokenlist->count; ) {
3490 /* Look ahead to find out how many tokens make up the next word */
3491 int wordtokens;
3493 /* Skip any leading separators */
3494 while (tokenlist->list[i].type == JIM_TT_SEP) {
3495 i++;
3498 wordtokens = JimCountWordTokens(script, tokenlist->list + i);
3500 if (wordtokens == 0) {
3501 /* None, so at end of line */
3502 if (lineargs) {
3503 linefirst->type = JIM_TT_LINE;
3504 linefirst->objPtr = JimNewScriptLineObj(interp, lineargs, linenr);
3505 Jim_IncrRefCount(linefirst->objPtr);
3507 /* Reset for new line */
3508 lineargs = 0;
3509 linefirst = token++;
3511 i++;
3512 continue;
3514 else if (wordtokens != 1) {
3515 /* More than 1, or {*}, so insert a WORD token */
3516 token->type = JIM_TT_WORD;
3517 token->objPtr = Jim_NewIntObj(interp, wordtokens);
3518 Jim_IncrRefCount(token->objPtr);
3519 token++;
3520 if (wordtokens < 0) {
3521 /* Skip the expand token */
3522 i++;
3523 wordtokens = -wordtokens - 1;
3524 lineargs--;
3528 if (lineargs == 0) {
3529 /* First real token on the line, so record the line number */
3530 linenr = tokenlist->list[i].line;
3532 lineargs++;
3534 /* Add each non-separator word token to the line */
3535 while (wordtokens--) {
3536 const ParseToken *t = &tokenlist->list[i++];
3538 token->type = t->type;
3539 token->objPtr = JimMakeScriptObj(interp, t);
3540 Jim_IncrRefCount(token->objPtr);
3542 /* Every object is initially a string of type 'source', but the
3543 * internal type may be specialized during execution of the
3544 * script. */
3545 JimSetSourceInfo(interp, token->objPtr, script->fileNameObj, t->line);
3546 token++;
3550 if (lineargs == 0) {
3551 token--;
3554 script->len = token - script->token;
3556 JimPanic((script->len >= count, "allocated script array is too short"));
3558 #ifdef DEBUG_SHOW_SCRIPT
3559 printf("==== Script (%s) ====\n", Jim_String(script->fileNameObj));
3560 for (i = 0; i < script->len; i++) {
3561 const ScriptToken *t = &script->token[i];
3562 printf("[%2d] %s %s\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
3564 #endif
3568 /* Parses the given string object to determine if it represents a complete script.
3570 * This is useful for interactive shells implementation, for [info complete].
3572 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
3573 * '{' on scripts incomplete missing one or more '}' to be balanced.
3574 * '[' on scripts incomplete missing one or more ']' to be balanced.
3575 * '"' on scripts incomplete missing a '"' char.
3576 * '\\' on scripts with a trailing backslash.
3578 * If the script is complete, 1 is returned, otherwise 0.
3580 * If the script has extra characters after a close brace, this still returns 1,
3581 * but sets *stateCharPtr to '}'
3582 * Evaluating the script will give the error "extra characters after close-brace".
3584 int Jim_ScriptIsComplete(Jim_Interp *interp, Jim_Obj *scriptObj, char *stateCharPtr)
3586 ScriptObj *script = JimGetScript(interp, scriptObj);
3587 if (stateCharPtr) {
3588 *stateCharPtr = script->missing;
3590 return script->missing == ' ' || script->missing == '}';
3594 * Sets an appropriate error message for a missing script/expression terminator.
3596 * Returns JIM_ERR if 'ch' represents an unmatched/missing character.
3598 * Note that a trailing backslash is not considered to be an error.
3600 static int JimParseCheckMissing(Jim_Interp *interp, int ch)
3602 const char *msg;
3604 switch (ch) {
3605 case '\\':
3606 case ' ':
3607 return JIM_OK;
3609 case '[':
3610 msg = "unmatched \"[\"";
3611 break;
3612 case '{':
3613 msg = "missing close-brace";
3614 break;
3615 case '}':
3616 msg = "extra characters after close-brace";
3617 break;
3618 case '"':
3619 default:
3620 msg = "missing quote";
3621 break;
3624 Jim_SetResultString(interp, msg, -1);
3625 return JIM_ERR;
3629 * Similar to ScriptObjAddTokens(), but for subst objects.
3631 static void SubstObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3632 ParseTokenList *tokenlist)
3634 int i;
3635 struct ScriptToken *token;
3637 token = script->token = Jim_Alloc(sizeof(ScriptToken) * tokenlist->count);
3639 for (i = 0; i < tokenlist->count; i++) {
3640 const ParseToken *t = &tokenlist->list[i];
3642 /* Create a token for 't' */
3643 token->type = t->type;
3644 token->objPtr = JimMakeScriptObj(interp, t);
3645 Jim_IncrRefCount(token->objPtr);
3646 token++;
3649 script->len = i;
3652 /* This method takes the string representation of an object
3653 * as a Tcl script, and generates the pre-parsed internal representation
3654 * of the script.
3656 * On parse error, sets an error message and returns JIM_ERR
3657 * (Note: the object is still converted to a script, even if an error occurs)
3659 static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3661 int scriptTextLen;
3662 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
3663 struct JimParserCtx parser;
3664 struct ScriptObj *script;
3665 ParseTokenList tokenlist;
3666 int line = 1;
3668 /* Try to get information about filename / line number */
3669 if (objPtr->typePtr == &sourceObjType) {
3670 line = objPtr->internalRep.sourceValue.lineNumber;
3673 /* Initially parse the script into tokens (in tokenlist) */
3674 ScriptTokenListInit(&tokenlist);
3676 JimParserInit(&parser, scriptText, scriptTextLen, line);
3677 while (!parser.eof) {
3678 JimParseScript(&parser);
3679 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
3680 parser.tline);
3683 /* Add a final EOF token */
3684 ScriptAddToken(&tokenlist, scriptText + scriptTextLen, 0, JIM_TT_EOF, 0);
3686 /* Create the "real" script tokens from the parsed tokens */
3687 script = Jim_Alloc(sizeof(*script));
3688 memset(script, 0, sizeof(*script));
3689 script->inUse = 1;
3690 if (objPtr->typePtr == &sourceObjType) {
3691 script->fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
3693 else {
3694 script->fileNameObj = interp->emptyObj;
3696 Jim_IncrRefCount(script->fileNameObj);
3697 script->missing = parser.missing.ch;
3698 script->linenr = parser.missing.line;
3700 ScriptObjAddTokens(interp, script, &tokenlist);
3702 /* No longer need the token list */
3703 ScriptTokenListFree(&tokenlist);
3705 /* Free the old internal rep and set the new one. */
3706 Jim_FreeIntRep(interp, objPtr);
3707 Jim_SetIntRepPtr(objPtr, script);
3708 objPtr->typePtr = &scriptObjType;
3711 static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script);
3714 * Returns the parsed script.
3715 * Note that if there is any possibility that the script is not valid,
3716 * call JimScriptValid() to check
3718 static ScriptObj *JimGetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3720 if (objPtr == interp->emptyObj) {
3721 /* Avoid converting emptyObj to a script. use nullScriptObj instead. */
3722 objPtr = interp->nullScriptObj;
3725 if (objPtr->typePtr != &scriptObjType || ((struct ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags) {
3726 JimSetScriptFromAny(interp, objPtr);
3729 return (ScriptObj *)Jim_GetIntRepPtr(objPtr);
3733 * Returns 1 if the script is valid (parsed ok), otherwise returns 0
3734 * and leaves an error message in the interp result.
3737 static int JimScriptValid(Jim_Interp *interp, ScriptObj *script)
3739 if (JimParseCheckMissing(interp, script->missing) == JIM_ERR) {
3740 JimAddErrorToStack(interp, script);
3741 return 0;
3743 return 1;
3747 /* -----------------------------------------------------------------------------
3748 * Commands
3749 * ---------------------------------------------------------------------------*/
3750 static void JimIncrCmdRefCount(Jim_Cmd *cmdPtr)
3752 cmdPtr->inUse++;
3755 static void JimDecrCmdRefCount(Jim_Interp *interp, Jim_Cmd *cmdPtr)
3757 if (--cmdPtr->inUse == 0) {
3758 if (cmdPtr->isproc) {
3759 Jim_DecrRefCount(interp, cmdPtr->u.proc.argListObjPtr);
3760 Jim_DecrRefCount(interp, cmdPtr->u.proc.bodyObjPtr);
3761 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
3762 if (cmdPtr->u.proc.staticVars) {
3763 Jim_FreeHashTable(cmdPtr->u.proc.staticVars);
3764 Jim_Free(cmdPtr->u.proc.staticVars);
3767 else {
3768 /* native (C) */
3769 if (cmdPtr->u.native.delProc) {
3770 cmdPtr->u.native.delProc(interp, cmdPtr->u.native.privData);
3773 if (cmdPtr->prevCmd) {
3774 /* Delete any pushed command too */
3775 JimDecrCmdRefCount(interp, cmdPtr->prevCmd);
3777 Jim_Free(cmdPtr);
3781 /* Variables HashTable Type.
3783 * Keys are dynamically allocated strings, Values are Jim_Var structures.
3785 static void JimVariablesHTValDestructor(void *interp, void *val)
3787 Jim_DecrRefCount(interp, ((Jim_Var *)val)->objPtr);
3788 Jim_Free(val);
3791 static const Jim_HashTableType JimVariablesHashTableType = {
3792 JimStringCopyHTHashFunction, /* hash function */
3793 JimStringCopyHTDup, /* key dup */
3794 NULL, /* val dup */
3795 JimStringCopyHTKeyCompare, /* key compare */
3796 JimStringCopyHTKeyDestructor, /* key destructor */
3797 JimVariablesHTValDestructor /* val destructor */
3800 /* Commands HashTable Type.
3802 * Keys are dynamic allocated strings, Values are Jim_Cmd structures.
3804 static void JimCommandsHT_ValDestructor(void *interp, void *val)
3806 JimDecrCmdRefCount(interp, val);
3809 static const Jim_HashTableType JimCommandsHashTableType = {
3810 JimStringCopyHTHashFunction, /* hash function */
3811 JimStringCopyHTDup, /* key dup */
3812 NULL, /* val dup */
3813 JimStringCopyHTKeyCompare, /* key compare */
3814 JimStringCopyHTKeyDestructor, /* key destructor */
3815 JimCommandsHT_ValDestructor /* val destructor */
3818 /* ------------------------- Commands related functions --------------------- */
3820 #ifdef jim_ext_namespace
3822 * Returns the "unscoped" version of the given namespace.
3823 * That is, the fully qualified name without the leading ::
3824 * The returned value is either nsObj, or an object with a zero ref count.
3826 static Jim_Obj *JimQualifyNameObj(Jim_Interp *interp, Jim_Obj *nsObj)
3828 const char *name = Jim_String(nsObj);
3829 if (name[0] == ':' && name[1] == ':') {
3830 /* This command is being defined in the global namespace */
3831 while (*++name == ':') {
3833 nsObj = Jim_NewStringObj(interp, name, -1);
3835 else if (Jim_Length(interp->framePtr->nsObj)) {
3836 /* This command is being defined in a non-global namespace */
3837 nsObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3838 Jim_AppendStrings(interp, nsObj, "::", name, NULL);
3840 return nsObj;
3844 * If nameObjPtr starts with "::", returns it.
3845 * Otherwise returns a new object with nameObjPtr prefixed with "::".
3846 * In this case, decrements the ref count of nameObjPtr.
3848 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3850 Jim_Obj *resultObj;
3852 const char *name = Jim_String(nameObjPtr);
3853 if (name[0] == ':' && name[1] == ':') {
3854 return nameObjPtr;
3856 Jim_IncrRefCount(nameObjPtr);
3857 resultObj = Jim_NewStringObj(interp, "::", -1);
3858 Jim_AppendObj(interp, resultObj, nameObjPtr);
3859 Jim_DecrRefCount(interp, nameObjPtr);
3861 return resultObj;
3865 * An efficient version of JimQualifyNameObj() where the name is
3866 * available (and needed) as a 'const char *'.
3867 * Avoids creating an object if not necessary.
3868 * The object stored in *objPtrPtr should be disposed of with JimFreeQualifiedName() after use.
3870 static const char *JimQualifyName(Jim_Interp *interp, const char *name, Jim_Obj **objPtrPtr)
3872 Jim_Obj *objPtr = interp->emptyObj;
3874 if (name[0] == ':' && name[1] == ':') {
3875 /* This command is being defined in the global namespace */
3876 while (*++name == ':') {
3879 else if (Jim_Length(interp->framePtr->nsObj)) {
3880 /* This command is being defined in a non-global namespace */
3881 objPtr = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3882 Jim_AppendStrings(interp, objPtr, "::", name, NULL);
3883 name = Jim_String(objPtr);
3885 Jim_IncrRefCount(objPtr);
3886 *objPtrPtr = objPtr;
3887 return name;
3890 #define JimFreeQualifiedName(INTERP, OBJ) Jim_DecrRefCount((INTERP), (OBJ))
3892 #else
3893 /* We can be more efficient in the no-namespace case */
3894 #define JimQualifyName(INTERP, NAME, DUMMY) (((NAME)[0] == ':' && (NAME)[1] == ':') ? (NAME) + 2 : (NAME))
3895 #define JimFreeQualifiedName(INTERP, DUMMY) (void)(DUMMY)
3897 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3899 return nameObjPtr;
3901 #endif
3903 static int JimCreateCommand(Jim_Interp *interp, const char *name, Jim_Cmd *cmd)
3905 /* It may already exist, so we try to delete the old one.
3906 * Note that reference count means that it won't be deleted yet if
3907 * it exists in the call stack.
3909 * BUT, if 'local' is in force, instead of deleting the existing
3910 * proc, we stash a reference to the old proc here.
3912 Jim_HashEntry *he = Jim_FindHashEntry(&interp->commands, name);
3913 if (he) {
3914 /* There was an old cmd with the same name,
3915 * so this requires a 'proc epoch' update. */
3917 /* If a procedure with the same name didn't exist there is no need
3918 * to increment the 'proc epoch' because creation of a new procedure
3919 * can never affect existing cached commands. We don't do
3920 * negative caching. */
3921 Jim_InterpIncrProcEpoch(interp);
3924 if (he && interp->local) {
3925 /* Push this command over the top of the previous one */
3926 cmd->prevCmd = Jim_GetHashEntryVal(he);
3927 Jim_SetHashVal(&interp->commands, he, cmd);
3929 else {
3930 if (he) {
3931 /* Replace the existing command */
3932 Jim_DeleteHashEntry(&interp->commands, name);
3935 Jim_AddHashEntry(&interp->commands, name, cmd);
3937 return JIM_OK;
3941 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdNameStr,
3942 Jim_CmdProc *cmdProc, void *privData, Jim_DelCmdProc *delProc)
3944 Jim_Cmd *cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3946 /* Store the new details for this command */
3947 memset(cmdPtr, 0, sizeof(*cmdPtr));
3948 cmdPtr->inUse = 1;
3949 cmdPtr->u.native.delProc = delProc;
3950 cmdPtr->u.native.cmdProc = cmdProc;
3951 cmdPtr->u.native.privData = privData;
3953 JimCreateCommand(interp, cmdNameStr, cmdPtr);
3955 return JIM_OK;
3958 static int JimCreateProcedureStatics(Jim_Interp *interp, Jim_Cmd *cmdPtr, Jim_Obj *staticsListObjPtr)
3960 int len, i;
3962 len = Jim_ListLength(interp, staticsListObjPtr);
3963 if (len == 0) {
3964 return JIM_OK;
3967 cmdPtr->u.proc.staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3968 Jim_InitHashTable(cmdPtr->u.proc.staticVars, &JimVariablesHashTableType, interp);
3969 for (i = 0; i < len; i++) {
3970 Jim_Obj *objPtr, *initObjPtr, *nameObjPtr;
3971 Jim_Var *varPtr;
3972 int subLen;
3974 objPtr = Jim_ListGetIndex(interp, staticsListObjPtr, i);
3975 /* Check if it's composed of two elements. */
3976 subLen = Jim_ListLength(interp, objPtr);
3977 if (subLen == 1 || subLen == 2) {
3978 /* Try to get the variable value from the current
3979 * environment. */
3980 nameObjPtr = Jim_ListGetIndex(interp, objPtr, 0);
3981 if (subLen == 1) {
3982 initObjPtr = Jim_GetVariable(interp, nameObjPtr, JIM_NONE);
3983 if (initObjPtr == NULL) {
3984 Jim_SetResultFormatted(interp,
3985 "variable for initialization of static \"%#s\" not found in the local context",
3986 nameObjPtr);
3987 return JIM_ERR;
3990 else {
3991 initObjPtr = Jim_ListGetIndex(interp, objPtr, 1);
3993 if (JimValidName(interp, "static variable", nameObjPtr) != JIM_OK) {
3994 return JIM_ERR;
3997 varPtr = Jim_Alloc(sizeof(*varPtr));
3998 varPtr->objPtr = initObjPtr;
3999 Jim_IncrRefCount(initObjPtr);
4000 varPtr->linkFramePtr = NULL;
4001 if (Jim_AddHashEntry(cmdPtr->u.proc.staticVars,
4002 Jim_String(nameObjPtr), varPtr) != JIM_OK) {
4003 Jim_SetResultFormatted(interp,
4004 "static variable name \"%#s\" duplicated in statics list", nameObjPtr);
4005 Jim_DecrRefCount(interp, initObjPtr);
4006 Jim_Free(varPtr);
4007 return JIM_ERR;
4010 else {
4011 Jim_SetResultFormatted(interp, "too many fields in static specifier \"%#s\"",
4012 objPtr);
4013 return JIM_ERR;
4016 return JIM_OK;
4020 * If the command is a proc, sets/updates the cached namespace (nsObj)
4021 * based on the command name.
4023 static void JimUpdateProcNamespace(Jim_Interp *interp, Jim_Cmd *cmdPtr, const char *cmdname)
4025 #ifdef jim_ext_namespace
4026 if (cmdPtr->isproc) {
4027 /* XXX: Really need JimNamespaceSplit() */
4028 const char *pt = strrchr(cmdname, ':');
4029 if (pt && pt != cmdname && pt[-1] == ':') {
4030 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
4031 cmdPtr->u.proc.nsObj = Jim_NewStringObj(interp, cmdname, pt - cmdname - 1);
4032 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
4034 if (Jim_FindHashEntry(&interp->commands, pt + 1)) {
4035 /* This command shadows a global command, so a proc epoch update is required */
4036 Jim_InterpIncrProcEpoch(interp);
4040 #endif
4043 static Jim_Cmd *JimCreateProcedureCmd(Jim_Interp *interp, Jim_Obj *argListObjPtr,
4044 Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr, Jim_Obj *nsObj)
4046 Jim_Cmd *cmdPtr;
4047 int argListLen;
4048 int i;
4050 argListLen = Jim_ListLength(interp, argListObjPtr);
4052 /* Allocate space for both the command pointer and the arg list */
4053 cmdPtr = Jim_Alloc(sizeof(*cmdPtr) + sizeof(struct Jim_ProcArg) * argListLen);
4054 memset(cmdPtr, 0, sizeof(*cmdPtr));
4055 cmdPtr->inUse = 1;
4056 cmdPtr->isproc = 1;
4057 cmdPtr->u.proc.argListObjPtr = argListObjPtr;
4058 cmdPtr->u.proc.argListLen = argListLen;
4059 cmdPtr->u.proc.bodyObjPtr = bodyObjPtr;
4060 cmdPtr->u.proc.argsPos = -1;
4061 cmdPtr->u.proc.arglist = (struct Jim_ProcArg *)(cmdPtr + 1);
4062 cmdPtr->u.proc.nsObj = nsObj ? nsObj : interp->emptyObj;
4063 Jim_IncrRefCount(argListObjPtr);
4064 Jim_IncrRefCount(bodyObjPtr);
4065 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
4067 /* Create the statics hash table. */
4068 if (staticsListObjPtr && JimCreateProcedureStatics(interp, cmdPtr, staticsListObjPtr) != JIM_OK) {
4069 goto err;
4072 /* Parse the args out into arglist, validating as we go */
4073 /* Examine the argument list for default parameters and 'args' */
4074 for (i = 0; i < argListLen; i++) {
4075 Jim_Obj *argPtr;
4076 Jim_Obj *nameObjPtr;
4077 Jim_Obj *defaultObjPtr;
4078 int len;
4080 /* Examine a parameter */
4081 argPtr = Jim_ListGetIndex(interp, argListObjPtr, i);
4082 len = Jim_ListLength(interp, argPtr);
4083 if (len == 0) {
4084 Jim_SetResultString(interp, "argument with no name", -1);
4085 err:
4086 JimDecrCmdRefCount(interp, cmdPtr);
4087 return NULL;
4089 if (len > 2) {
4090 Jim_SetResultFormatted(interp, "too many fields in argument specifier \"%#s\"", argPtr);
4091 goto err;
4094 if (len == 2) {
4095 /* Optional parameter */
4096 nameObjPtr = Jim_ListGetIndex(interp, argPtr, 0);
4097 defaultObjPtr = Jim_ListGetIndex(interp, argPtr, 1);
4099 else {
4100 /* Required parameter */
4101 nameObjPtr = argPtr;
4102 defaultObjPtr = NULL;
4106 if (Jim_CompareStringImmediate(interp, nameObjPtr, "args")) {
4107 if (cmdPtr->u.proc.argsPos >= 0) {
4108 Jim_SetResultString(interp, "'args' specified more than once", -1);
4109 goto err;
4111 cmdPtr->u.proc.argsPos = i;
4113 else {
4114 if (len == 2) {
4115 cmdPtr->u.proc.optArity++;
4117 else {
4118 cmdPtr->u.proc.reqArity++;
4122 cmdPtr->u.proc.arglist[i].nameObjPtr = nameObjPtr;
4123 cmdPtr->u.proc.arglist[i].defaultObjPtr = defaultObjPtr;
4126 return cmdPtr;
4129 int Jim_DeleteCommand(Jim_Interp *interp, const char *name)
4131 int ret = JIM_OK;
4132 Jim_Obj *qualifiedNameObj;
4133 const char *qualname = JimQualifyName(interp, name, &qualifiedNameObj);
4135 if (Jim_DeleteHashEntry(&interp->commands, qualname) == JIM_ERR) {
4136 Jim_SetResultFormatted(interp, "can't delete \"%s\": command doesn't exist", name);
4137 ret = JIM_ERR;
4139 else {
4140 Jim_InterpIncrProcEpoch(interp);
4143 JimFreeQualifiedName(interp, qualifiedNameObj);
4145 return ret;
4148 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName, const char *newName)
4150 int ret = JIM_ERR;
4151 Jim_HashEntry *he;
4152 Jim_Cmd *cmdPtr;
4153 Jim_Obj *qualifiedOldNameObj;
4154 Jim_Obj *qualifiedNewNameObj;
4155 const char *fqold;
4156 const char *fqnew;
4158 if (newName[0] == 0) {
4159 return Jim_DeleteCommand(interp, oldName);
4162 fqold = JimQualifyName(interp, oldName, &qualifiedOldNameObj);
4163 fqnew = JimQualifyName(interp, newName, &qualifiedNewNameObj);
4165 /* Does it exist? */
4166 he = Jim_FindHashEntry(&interp->commands, fqold);
4167 if (he == NULL) {
4168 Jim_SetResultFormatted(interp, "can't rename \"%s\": command doesn't exist", oldName);
4170 else if (Jim_FindHashEntry(&interp->commands, fqnew)) {
4171 Jim_SetResultFormatted(interp, "can't rename to \"%s\": command already exists", newName);
4173 else {
4174 /* Add the new name first */
4175 cmdPtr = Jim_GetHashEntryVal(he);
4176 JimIncrCmdRefCount(cmdPtr);
4177 JimUpdateProcNamespace(interp, cmdPtr, fqnew);
4178 Jim_AddHashEntry(&interp->commands, fqnew, cmdPtr);
4180 /* Now remove the old name */
4181 Jim_DeleteHashEntry(&interp->commands, fqold);
4183 /* Increment the epoch */
4184 Jim_InterpIncrProcEpoch(interp);
4186 ret = JIM_OK;
4189 JimFreeQualifiedName(interp, qualifiedOldNameObj);
4190 JimFreeQualifiedName(interp, qualifiedNewNameObj);
4192 return ret;
4195 /* -----------------------------------------------------------------------------
4196 * Command object
4197 * ---------------------------------------------------------------------------*/
4199 static void FreeCommandInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4201 Jim_DecrRefCount(interp, objPtr->internalRep.cmdValue.nsObj);
4204 static void DupCommandInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4206 dupPtr->internalRep.cmdValue = srcPtr->internalRep.cmdValue;
4207 dupPtr->typePtr = srcPtr->typePtr;
4208 Jim_IncrRefCount(dupPtr->internalRep.cmdValue.nsObj);
4211 static const Jim_ObjType commandObjType = {
4212 "command",
4213 FreeCommandInternalRep,
4214 DupCommandInternalRep,
4215 NULL,
4216 JIM_TYPE_REFERENCES,
4219 /* This function returns the command structure for the command name
4220 * stored in objPtr. It specializes the objPtr to contain
4221 * cached info instead of performing the lookup into the hash table
4222 * every time. The information cached may not be up-to-date, in this
4223 * case the lookup is performed and the cache updated.
4225 * Respects the 'upcall' setting.
4227 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4229 Jim_Cmd *cmd;
4231 /* In order to be valid, the proc epoch must match and
4232 * the lookup must have occurred in the same namespace
4234 if (objPtr->typePtr != &commandObjType ||
4235 objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch
4236 #ifdef jim_ext_namespace
4237 || !Jim_StringEqObj(objPtr->internalRep.cmdValue.nsObj, interp->framePtr->nsObj)
4238 #endif
4240 /* Not cached or out of date, so lookup */
4242 /* Do we need to try the local namespace? */
4243 const char *name = Jim_String(objPtr);
4244 Jim_HashEntry *he;
4246 if (name[0] == ':' && name[1] == ':') {
4247 while (*++name == ':') {
4250 #ifdef jim_ext_namespace
4251 else if (Jim_Length(interp->framePtr->nsObj)) {
4252 /* This command is being defined in a non-global namespace */
4253 Jim_Obj *nameObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
4254 Jim_AppendStrings(interp, nameObj, "::", name, NULL);
4255 he = Jim_FindHashEntry(&interp->commands, Jim_String(nameObj));
4256 Jim_FreeNewObj(interp, nameObj);
4257 if (he) {
4258 goto found;
4261 #endif
4263 /* Lookup in the global namespace */
4264 he = Jim_FindHashEntry(&interp->commands, name);
4265 if (he == NULL) {
4266 if (flags & JIM_ERRMSG) {
4267 Jim_SetResultFormatted(interp, "invalid command name \"%#s\"", objPtr);
4269 return NULL;
4271 #ifdef jim_ext_namespace
4272 found:
4273 #endif
4274 cmd = Jim_GetHashEntryVal(he);
4276 /* Free the old internal rep and set the new one. */
4277 Jim_FreeIntRep(interp, objPtr);
4278 objPtr->typePtr = &commandObjType;
4279 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
4280 objPtr->internalRep.cmdValue.cmdPtr = cmd;
4281 objPtr->internalRep.cmdValue.nsObj = interp->framePtr->nsObj;
4282 Jim_IncrRefCount(interp->framePtr->nsObj);
4284 else {
4285 cmd = objPtr->internalRep.cmdValue.cmdPtr;
4287 while (cmd->u.proc.upcall) {
4288 cmd = cmd->prevCmd;
4290 return cmd;
4293 /* -----------------------------------------------------------------------------
4294 * Variables
4295 * ---------------------------------------------------------------------------*/
4297 /* -----------------------------------------------------------------------------
4298 * Variable object
4299 * ---------------------------------------------------------------------------*/
4301 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
4303 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4305 static const Jim_ObjType variableObjType = {
4306 "variable",
4307 NULL,
4308 NULL,
4309 NULL,
4310 JIM_TYPE_REFERENCES,
4314 * Check that the name does not contain embedded nulls.
4316 * Variable and procedure names are manipulated as null terminated strings, so
4317 * don't allow names with embedded nulls.
4319 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr)
4321 /* Variable names and proc names can't contain embedded nulls */
4322 if (nameObjPtr->typePtr != &variableObjType) {
4323 int len;
4324 const char *str = Jim_GetString(nameObjPtr, &len);
4325 if (memchr(str, '\0', len)) {
4326 Jim_SetResultFormatted(interp, "%s name contains embedded null", type);
4327 return JIM_ERR;
4330 return JIM_OK;
4333 /* This method should be called only by the variable API.
4334 * It returns JIM_OK on success (variable already exists),
4335 * JIM_ERR if it does not exist, JIM_DICT_SUGAR if it's not
4336 * a variable name, but syntax glue for [dict] i.e. the last
4337 * character is ')' */
4338 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
4340 const char *varName;
4341 Jim_CallFrame *framePtr;
4342 Jim_HashEntry *he;
4343 int global;
4344 int len;
4346 /* Check if the object is already an uptodate variable */
4347 if (objPtr->typePtr == &variableObjType) {
4348 framePtr = objPtr->internalRep.varValue.global ? interp->topFramePtr : interp->framePtr;
4349 if (objPtr->internalRep.varValue.callFrameId == framePtr->id) {
4350 /* nothing to do */
4351 return JIM_OK;
4353 /* Need to re-resolve the variable in the updated callframe */
4355 else if (objPtr->typePtr == &dictSubstObjType) {
4356 return JIM_DICT_SUGAR;
4358 else if (JimValidName(interp, "variable", objPtr) != JIM_OK) {
4359 return JIM_ERR;
4363 varName = Jim_GetString(objPtr, &len);
4365 /* Make sure it's not syntax glue to get/set dict. */
4366 if (len && varName[len - 1] == ')' && strchr(varName, '(') != NULL) {
4367 return JIM_DICT_SUGAR;
4370 if (varName[0] == ':' && varName[1] == ':') {
4371 while (*++varName == ':') {
4373 global = 1;
4374 framePtr = interp->topFramePtr;
4376 else {
4377 global = 0;
4378 framePtr = interp->framePtr;
4381 /* Resolve this name in the variables hash table */
4382 he = Jim_FindHashEntry(&framePtr->vars, varName);
4383 if (he == NULL) {
4384 if (!global && framePtr->staticVars) {
4385 /* Try with static vars. */
4386 he = Jim_FindHashEntry(framePtr->staticVars, varName);
4388 if (he == NULL) {
4389 return JIM_ERR;
4393 /* Free the old internal repr and set the new one. */
4394 Jim_FreeIntRep(interp, objPtr);
4395 objPtr->typePtr = &variableObjType;
4396 objPtr->internalRep.varValue.callFrameId = framePtr->id;
4397 objPtr->internalRep.varValue.varPtr = Jim_GetHashEntryVal(he);
4398 objPtr->internalRep.varValue.global = global;
4399 return JIM_OK;
4402 /* -------------------- Variables related functions ------------------------- */
4403 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr, Jim_Obj *valObjPtr);
4404 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr, int flags);
4406 static Jim_Var *JimCreateVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4408 const char *name;
4409 Jim_CallFrame *framePtr;
4410 int global;
4412 /* New variable to create */
4413 Jim_Var *var = Jim_Alloc(sizeof(*var));
4415 var->objPtr = valObjPtr;
4416 Jim_IncrRefCount(valObjPtr);
4417 var->linkFramePtr = NULL;
4419 name = Jim_String(nameObjPtr);
4420 if (name[0] == ':' && name[1] == ':') {
4421 while (*++name == ':') {
4423 framePtr = interp->topFramePtr;
4424 global = 1;
4426 else {
4427 framePtr = interp->framePtr;
4428 global = 0;
4431 /* Insert the new variable */
4432 Jim_AddHashEntry(&framePtr->vars, name, var);
4434 /* Make the object int rep a variable */
4435 Jim_FreeIntRep(interp, nameObjPtr);
4436 nameObjPtr->typePtr = &variableObjType;
4437 nameObjPtr->internalRep.varValue.callFrameId = framePtr->id;
4438 nameObjPtr->internalRep.varValue.varPtr = var;
4439 nameObjPtr->internalRep.varValue.global = global;
4441 return var;
4444 /* For now that's dummy. Variables lookup should be optimized
4445 * in many ways, with caching of lookups, and possibly with
4446 * a table of pre-allocated vars in every CallFrame for local vars.
4447 * All the caching should also have an 'epoch' mechanism similar
4448 * to the one used by Tcl for procedures lookup caching. */
4451 * Set the variable nameObjPtr to value valObjptr.
4453 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4455 int err;
4456 Jim_Var *var;
4458 switch (SetVariableFromAny(interp, nameObjPtr)) {
4459 case JIM_DICT_SUGAR:
4460 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
4462 case JIM_ERR:
4463 if (JimValidName(interp, "variable", nameObjPtr) != JIM_OK) {
4464 return JIM_ERR;
4466 JimCreateVariable(interp, nameObjPtr, valObjPtr);
4467 break;
4469 case JIM_OK:
4470 var = nameObjPtr->internalRep.varValue.varPtr;
4471 if (var->linkFramePtr == NULL) {
4472 Jim_IncrRefCount(valObjPtr);
4473 Jim_DecrRefCount(interp, var->objPtr);
4474 var->objPtr = valObjPtr;
4476 else { /* Else handle the link */
4477 Jim_CallFrame *savedCallFrame;
4479 savedCallFrame = interp->framePtr;
4480 interp->framePtr = var->linkFramePtr;
4481 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
4482 interp->framePtr = savedCallFrame;
4483 if (err != JIM_OK)
4484 return err;
4487 return JIM_OK;
4490 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4492 Jim_Obj *nameObjPtr;
4493 int result;
4495 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4496 Jim_IncrRefCount(nameObjPtr);
4497 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
4498 Jim_DecrRefCount(interp, nameObjPtr);
4499 return result;
4502 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4504 Jim_CallFrame *savedFramePtr;
4505 int result;
4507 savedFramePtr = interp->framePtr;
4508 interp->framePtr = interp->topFramePtr;
4509 result = Jim_SetVariableStr(interp, name, objPtr);
4510 interp->framePtr = savedFramePtr;
4511 return result;
4514 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
4516 Jim_Obj *valObjPtr;
4517 int result;
4519 valObjPtr = Jim_NewStringObj(interp, val, -1);
4520 Jim_IncrRefCount(valObjPtr);
4521 result = Jim_SetVariableStr(interp, name, valObjPtr);
4522 Jim_DecrRefCount(interp, valObjPtr);
4523 return result;
4526 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
4527 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
4529 const char *varName;
4530 const char *targetName;
4531 Jim_CallFrame *framePtr;
4532 Jim_Var *varPtr;
4534 /* Check for an existing variable or link */
4535 switch (SetVariableFromAny(interp, nameObjPtr)) {
4536 case JIM_DICT_SUGAR:
4537 /* XXX: This message seem unnecessarily verbose, but it matches Tcl */
4538 Jim_SetResultFormatted(interp, "bad variable name \"%#s\": upvar won't create a scalar variable that looks like an array element", nameObjPtr);
4539 return JIM_ERR;
4541 case JIM_OK:
4542 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4544 if (varPtr->linkFramePtr == NULL) {
4545 Jim_SetResultFormatted(interp, "variable \"%#s\" already exists", nameObjPtr);
4546 return JIM_ERR;
4549 /* It exists, but is a link, so first delete the link */
4550 varPtr->linkFramePtr = NULL;
4551 break;
4554 /* Resolve the call frames for both variables */
4555 /* XXX: SetVariableFromAny() already did this! */
4556 varName = Jim_String(nameObjPtr);
4558 if (varName[0] == ':' && varName[1] == ':') {
4559 while (*++varName == ':') {
4561 /* Linking a global var does nothing */
4562 framePtr = interp->topFramePtr;
4564 else {
4565 framePtr = interp->framePtr;
4568 targetName = Jim_String(targetNameObjPtr);
4569 if (targetName[0] == ':' && targetName[1] == ':') {
4570 while (*++targetName == ':') {
4572 targetNameObjPtr = Jim_NewStringObj(interp, targetName, -1);
4573 targetCallFrame = interp->topFramePtr;
4575 Jim_IncrRefCount(targetNameObjPtr);
4577 if (framePtr->level < targetCallFrame->level) {
4578 Jim_SetResultFormatted(interp,
4579 "bad variable name \"%#s\": upvar won't create namespace variable that refers to procedure variable",
4580 nameObjPtr);
4581 Jim_DecrRefCount(interp, targetNameObjPtr);
4582 return JIM_ERR;
4585 /* Check for cycles. */
4586 if (framePtr == targetCallFrame) {
4587 Jim_Obj *objPtr = targetNameObjPtr;
4589 /* Cycles are only possible with 'uplevel 0' */
4590 while (1) {
4591 if (strcmp(Jim_String(objPtr), varName) == 0) {
4592 Jim_SetResultString(interp, "can't upvar from variable to itself", -1);
4593 Jim_DecrRefCount(interp, targetNameObjPtr);
4594 return JIM_ERR;
4596 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
4597 break;
4598 varPtr = objPtr->internalRep.varValue.varPtr;
4599 if (varPtr->linkFramePtr != targetCallFrame)
4600 break;
4601 objPtr = varPtr->objPtr;
4605 /* Perform the binding */
4606 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
4607 /* We are now sure 'nameObjPtr' type is variableObjType */
4608 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
4609 Jim_DecrRefCount(interp, targetNameObjPtr);
4610 return JIM_OK;
4613 /* Return the Jim_Obj pointer associated with a variable name,
4614 * or NULL if the variable was not found in the current context.
4615 * The same optimization discussed in the comment to the
4616 * 'SetVariable' function should apply here.
4618 * If JIM_UNSHARED is set and the variable is an array element (dict sugar)
4619 * in a dictionary which is shared, the array variable value is duplicated first.
4620 * This allows the array element to be updated (e.g. append, lappend) without
4621 * affecting other references to the dictionary.
4623 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4625 switch (SetVariableFromAny(interp, nameObjPtr)) {
4626 case JIM_OK:{
4627 Jim_Var *varPtr = nameObjPtr->internalRep.varValue.varPtr;
4629 if (varPtr->linkFramePtr == NULL) {
4630 return varPtr->objPtr;
4632 else {
4633 Jim_Obj *objPtr;
4635 /* The variable is a link? Resolve it. */
4636 Jim_CallFrame *savedCallFrame = interp->framePtr;
4638 interp->framePtr = varPtr->linkFramePtr;
4639 objPtr = Jim_GetVariable(interp, varPtr->objPtr, flags);
4640 interp->framePtr = savedCallFrame;
4641 if (objPtr) {
4642 return objPtr;
4644 /* Error, so fall through to the error message */
4647 break;
4649 case JIM_DICT_SUGAR:
4650 /* [dict] syntax sugar. */
4651 return JimDictSugarGet(interp, nameObjPtr, flags);
4653 if (flags & JIM_ERRMSG) {
4654 Jim_SetResultFormatted(interp, "can't read \"%#s\": no such variable", nameObjPtr);
4656 return NULL;
4659 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4661 Jim_CallFrame *savedFramePtr;
4662 Jim_Obj *objPtr;
4664 savedFramePtr = interp->framePtr;
4665 interp->framePtr = interp->topFramePtr;
4666 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4667 interp->framePtr = savedFramePtr;
4669 return objPtr;
4672 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
4674 Jim_Obj *nameObjPtr, *varObjPtr;
4676 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4677 Jim_IncrRefCount(nameObjPtr);
4678 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4679 Jim_DecrRefCount(interp, nameObjPtr);
4680 return varObjPtr;
4683 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name, int flags)
4685 Jim_CallFrame *savedFramePtr;
4686 Jim_Obj *objPtr;
4688 savedFramePtr = interp->framePtr;
4689 interp->framePtr = interp->topFramePtr;
4690 objPtr = Jim_GetVariableStr(interp, name, flags);
4691 interp->framePtr = savedFramePtr;
4693 return objPtr;
4696 /* Unset a variable.
4697 * Note: On success unset invalidates all the (cached) variable objects
4698 * by incrementing callFrameEpoch
4700 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4702 Jim_Var *varPtr;
4703 int retval;
4704 Jim_CallFrame *framePtr;
4706 retval = SetVariableFromAny(interp, nameObjPtr);
4707 if (retval == JIM_DICT_SUGAR) {
4708 /* [dict] syntax sugar. */
4709 return JimDictSugarSet(interp, nameObjPtr, NULL);
4711 else if (retval == JIM_OK) {
4712 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4714 /* If it's a link call UnsetVariable recursively */
4715 if (varPtr->linkFramePtr) {
4716 framePtr = interp->framePtr;
4717 interp->framePtr = varPtr->linkFramePtr;
4718 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
4719 interp->framePtr = framePtr;
4721 else {
4722 const char *name = Jim_String(nameObjPtr);
4723 if (nameObjPtr->internalRep.varValue.global) {
4724 name += 2;
4725 framePtr = interp->topFramePtr;
4727 else {
4728 framePtr = interp->framePtr;
4731 retval = Jim_DeleteHashEntry(&framePtr->vars, name);
4732 if (retval == JIM_OK) {
4733 /* Change the callframe id, invalidating var lookup caching */
4734 framePtr->id = interp->callFrameEpoch++;
4738 if (retval != JIM_OK && (flags & JIM_ERRMSG)) {
4739 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such variable", nameObjPtr);
4741 return retval;
4744 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
4746 /* Given a variable name for [dict] operation syntax sugar,
4747 * this function returns two objects, the first with the name
4748 * of the variable to set, and the second with the respective key.
4749 * For example "foo(bar)" will return objects with string repr. of
4750 * "foo" and "bar".
4752 * The returned objects have refcount = 1. The function can't fail. */
4753 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
4754 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
4756 const char *str, *p;
4757 int len, keyLen;
4758 Jim_Obj *varObjPtr, *keyObjPtr;
4760 str = Jim_GetString(objPtr, &len);
4762 p = strchr(str, '(');
4763 JimPanic((p == NULL, "JimDictSugarParseVarKey() called for non-dict-sugar (%s)", str));
4765 varObjPtr = Jim_NewStringObj(interp, str, p - str);
4767 p++;
4768 keyLen = (str + len) - p;
4769 if (str[len - 1] == ')') {
4770 keyLen--;
4773 /* Create the objects with the variable name and key. */
4774 keyObjPtr = Jim_NewStringObj(interp, p, keyLen);
4776 Jim_IncrRefCount(varObjPtr);
4777 Jim_IncrRefCount(keyObjPtr);
4778 *varPtrPtr = varObjPtr;
4779 *keyPtrPtr = keyObjPtr;
4782 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
4783 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
4784 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *valObjPtr)
4786 int err;
4788 SetDictSubstFromAny(interp, objPtr);
4790 err = Jim_SetDictKeysVector(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4791 &objPtr->internalRep.dictSubstValue.indexObjPtr, 1, valObjPtr, JIM_MUSTEXIST);
4793 if (err == JIM_OK) {
4794 /* Don't keep an extra ref to the result */
4795 Jim_SetEmptyResult(interp);
4797 else {
4798 if (!valObjPtr) {
4799 /* Better error message for unset a(2) where a exists but a(2) doesn't */
4800 if (Jim_GetVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_NONE)) {
4801 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such element in array",
4802 objPtr);
4803 return err;
4806 /* Make the error more informative and Tcl-compatible */
4807 Jim_SetResultFormatted(interp, "can't %s \"%#s\": variable isn't array",
4808 (valObjPtr ? "set" : "unset"), objPtr);
4810 return err;
4814 * Expands the array variable (dict sugar) and returns the result, or NULL on error.
4816 * If JIM_UNSHARED is set and the dictionary is shared, it will be duplicated
4817 * and stored back to the variable before expansion.
4819 static Jim_Obj *JimDictExpandArrayVariable(Jim_Interp *interp, Jim_Obj *varObjPtr,
4820 Jim_Obj *keyObjPtr, int flags)
4822 Jim_Obj *dictObjPtr;
4823 Jim_Obj *resObjPtr = NULL;
4824 int ret;
4826 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
4827 if (!dictObjPtr) {
4828 return NULL;
4831 ret = Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_NONE);
4832 if (ret != JIM_OK) {
4833 Jim_SetResultFormatted(interp,
4834 "can't read \"%#s(%#s)\": %s array", varObjPtr, keyObjPtr,
4835 ret < 0 ? "variable isn't" : "no such element in");
4837 else if ((flags & JIM_UNSHARED) && Jim_IsShared(dictObjPtr)) {
4838 /* Update the variable to have an unshared copy */
4839 Jim_SetVariable(interp, varObjPtr, Jim_DuplicateObj(interp, dictObjPtr));
4842 return resObjPtr;
4845 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
4846 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4848 SetDictSubstFromAny(interp, objPtr);
4850 return JimDictExpandArrayVariable(interp,
4851 objPtr->internalRep.dictSubstValue.varNameObjPtr,
4852 objPtr->internalRep.dictSubstValue.indexObjPtr, flags);
4855 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
4857 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4859 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
4860 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
4863 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4865 /* Copy the internal rep */
4866 dupPtr->internalRep = srcPtr->internalRep;
4867 /* Need to increment the ref counts */
4868 Jim_IncrRefCount(dupPtr->internalRep.dictSubstValue.varNameObjPtr);
4869 Jim_IncrRefCount(dupPtr->internalRep.dictSubstValue.indexObjPtr);
4872 /* Note: The object *must* be in dict-sugar format */
4873 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4875 if (objPtr->typePtr != &dictSubstObjType) {
4876 Jim_Obj *varObjPtr, *keyObjPtr;
4878 if (objPtr->typePtr == &interpolatedObjType) {
4879 /* An interpolated object in dict-sugar form */
4881 varObjPtr = objPtr->internalRep.dictSubstValue.varNameObjPtr;
4882 keyObjPtr = objPtr->internalRep.dictSubstValue.indexObjPtr;
4884 Jim_IncrRefCount(varObjPtr);
4885 Jim_IncrRefCount(keyObjPtr);
4887 else {
4888 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
4891 Jim_FreeIntRep(interp, objPtr);
4892 objPtr->typePtr = &dictSubstObjType;
4893 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
4894 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
4898 /* This function is used to expand [dict get] sugar in the form
4899 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
4900 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
4901 * object that is *guaranteed* to be in the form VARNAME(INDEX).
4902 * The 'index' part is [subst]ituted, and is used to lookup a key inside
4903 * the [dict]ionary contained in variable VARNAME. */
4904 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4906 Jim_Obj *resObjPtr = NULL;
4907 Jim_Obj *substKeyObjPtr = NULL;
4909 SetDictSubstFromAny(interp, objPtr);
4911 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
4912 &substKeyObjPtr, JIM_NONE)
4913 != JIM_OK) {
4914 return NULL;
4916 Jim_IncrRefCount(substKeyObjPtr);
4917 resObjPtr =
4918 JimDictExpandArrayVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4919 substKeyObjPtr, 0);
4920 Jim_DecrRefCount(interp, substKeyObjPtr);
4922 return resObjPtr;
4925 static Jim_Obj *JimExpandExprSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4927 if (Jim_EvalExpression(interp, objPtr) == JIM_OK) {
4928 return Jim_GetResult(interp);
4930 return NULL;
4933 /* -----------------------------------------------------------------------------
4934 * CallFrame
4935 * ---------------------------------------------------------------------------*/
4937 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp, Jim_CallFrame *parent, Jim_Obj *nsObj)
4939 Jim_CallFrame *cf;
4941 if (interp->freeFramesList) {
4942 cf = interp->freeFramesList;
4943 interp->freeFramesList = cf->next;
4945 cf->argv = NULL;
4946 cf->argc = 0;
4947 cf->procArgsObjPtr = NULL;
4948 cf->procBodyObjPtr = NULL;
4949 cf->next = NULL;
4950 cf->staticVars = NULL;
4951 cf->localCommands = NULL;
4952 cf->tailcallObj = NULL;
4953 cf->tailcallCmd = NULL;
4955 else {
4956 cf = Jim_Alloc(sizeof(*cf));
4957 memset(cf, 0, sizeof(*cf));
4959 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
4962 cf->id = interp->callFrameEpoch++;
4963 cf->parent = parent;
4964 cf->level = parent ? parent->level + 1 : 0;
4965 cf->nsObj = nsObj;
4966 Jim_IncrRefCount(nsObj);
4968 return cf;
4971 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands)
4973 /* Delete any local procs */
4974 if (localCommands) {
4975 Jim_Obj *cmdNameObj;
4977 while ((cmdNameObj = Jim_StackPop(localCommands)) != NULL) {
4978 Jim_HashEntry *he;
4979 Jim_Obj *fqObjName;
4980 Jim_HashTable *ht = &interp->commands;
4982 const char *fqname = JimQualifyName(interp, Jim_String(cmdNameObj), &fqObjName);
4984 he = Jim_FindHashEntry(ht, fqname);
4986 if (he) {
4987 Jim_Cmd *cmd = Jim_GetHashEntryVal(he);
4988 if (cmd->prevCmd) {
4989 Jim_Cmd *prevCmd = cmd->prevCmd;
4990 cmd->prevCmd = NULL;
4992 /* Delete the old command */
4993 JimDecrCmdRefCount(interp, cmd);
4995 /* And restore the original */
4996 Jim_SetHashVal(ht, he, prevCmd);
4998 else {
4999 Jim_DeleteHashEntry(ht, fqname);
5001 Jim_InterpIncrProcEpoch(interp);
5003 Jim_DecrRefCount(interp, cmdNameObj);
5004 JimFreeQualifiedName(interp, fqObjName);
5006 Jim_FreeStack(localCommands);
5007 Jim_Free(localCommands);
5009 return JIM_OK;
5013 * Run any $jim::defer scripts for the current call frame.
5015 * retcode is the return code from the current proc.
5017 * Returns the new return code.
5019 static int JimInvokeDefer(Jim_Interp *interp, int retcode)
5021 Jim_Obj *objPtr;
5023 /* Fast check for the likely case that the variable doesn't exist */
5024 if (Jim_FindHashEntry(&interp->framePtr->vars, "jim::defer") == NULL) {
5025 return retcode;
5028 objPtr = Jim_GetVariableStr(interp, "jim::defer", JIM_NONE);
5030 if (objPtr) {
5031 int ret = JIM_OK;
5032 int i;
5033 int listLen = Jim_ListLength(interp, objPtr);
5034 Jim_Obj *resultObjPtr;
5036 Jim_IncrRefCount(objPtr);
5038 /* Need to save away the current interp result and
5039 * restore it if appropriate
5041 resultObjPtr = Jim_GetResult(interp);
5042 Jim_IncrRefCount(resultObjPtr);
5043 Jim_SetEmptyResult(interp);
5045 /* Invoke in reverse order */
5046 for (i = listLen; i > 0; i--) {
5047 /* If a defer script returns an error, don't evaluate remaining scripts */
5048 Jim_Obj *scriptObjPtr = Jim_ListGetIndex(interp, objPtr, i - 1);
5049 ret = Jim_EvalObj(interp, scriptObjPtr);
5050 if (ret != JIM_OK) {
5051 break;
5055 if (ret == JIM_OK || retcode == JIM_ERR) {
5056 /* defer script had no error, or proc had an error so restore proc result */
5057 Jim_SetResult(interp, resultObjPtr);
5059 else {
5060 retcode = ret;
5063 Jim_DecrRefCount(interp, resultObjPtr);
5064 Jim_DecrRefCount(interp, objPtr);
5066 return retcode;
5069 #define JIM_FCF_FULL 0 /* Always free the vars hash table */
5070 #define JIM_FCF_REUSE 1 /* Reuse the vars hash table if possible */
5071 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action)
5073 JimDeleteLocalProcs(interp, cf->localCommands);
5075 if (cf->procArgsObjPtr)
5076 Jim_DecrRefCount(interp, cf->procArgsObjPtr);
5077 if (cf->procBodyObjPtr)
5078 Jim_DecrRefCount(interp, cf->procBodyObjPtr);
5079 Jim_DecrRefCount(interp, cf->nsObj);
5080 if (action == JIM_FCF_FULL || cf->vars.size != JIM_HT_INITIAL_SIZE)
5081 Jim_FreeHashTable(&cf->vars);
5082 else {
5083 int i;
5084 Jim_HashEntry **table = cf->vars.table, *he;
5086 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
5087 he = table[i];
5088 while (he != NULL) {
5089 Jim_HashEntry *nextEntry = he->next;
5090 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
5092 Jim_DecrRefCount(interp, varPtr->objPtr);
5093 Jim_Free(Jim_GetHashEntryKey(he));
5094 Jim_Free(varPtr);
5095 Jim_Free(he);
5096 table[i] = NULL;
5097 he = nextEntry;
5100 cf->vars.used = 0;
5102 cf->next = interp->freeFramesList;
5103 interp->freeFramesList = cf;
5107 /* -----------------------------------------------------------------------------
5108 * References
5109 * ---------------------------------------------------------------------------*/
5110 #if defined(JIM_REFERENCES) && !defined(JIM_BOOTSTRAP)
5112 /* References HashTable Type.
5114 * Keys are unsigned long integers, dynamically allocated for now but in the
5115 * future it's worth to cache this 4 bytes objects. Values are pointers
5116 * to Jim_References. */
5117 static void JimReferencesHTValDestructor(void *interp, void *val)
5119 Jim_Reference *refPtr = (void *)val;
5121 Jim_DecrRefCount(interp, refPtr->objPtr);
5122 if (refPtr->finalizerCmdNamePtr != NULL) {
5123 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5125 Jim_Free(val);
5128 static unsigned int JimReferencesHTHashFunction(const void *key)
5130 /* Only the least significant bits are used. */
5131 const unsigned long *widePtr = key;
5132 unsigned int intValue = (unsigned int)*widePtr;
5134 return Jim_IntHashFunction(intValue);
5137 static void *JimReferencesHTKeyDup(void *privdata, const void *key)
5139 void *copy = Jim_Alloc(sizeof(unsigned long));
5141 JIM_NOTUSED(privdata);
5143 memcpy(copy, key, sizeof(unsigned long));
5144 return copy;
5147 static int JimReferencesHTKeyCompare(void *privdata, const void *key1, const void *key2)
5149 JIM_NOTUSED(privdata);
5151 return memcmp(key1, key2, sizeof(unsigned long)) == 0;
5154 static void JimReferencesHTKeyDestructor(void *privdata, void *key)
5156 JIM_NOTUSED(privdata);
5158 Jim_Free(key);
5161 static const Jim_HashTableType JimReferencesHashTableType = {
5162 JimReferencesHTHashFunction, /* hash function */
5163 JimReferencesHTKeyDup, /* key dup */
5164 NULL, /* val dup */
5165 JimReferencesHTKeyCompare, /* key compare */
5166 JimReferencesHTKeyDestructor, /* key destructor */
5167 JimReferencesHTValDestructor /* val destructor */
5170 /* -----------------------------------------------------------------------------
5171 * Reference object type and References API
5172 * ---------------------------------------------------------------------------*/
5174 /* The string representation of references has two features in order
5175 * to make the GC faster. The first is that every reference starts
5176 * with a non common character '<', in order to make the string matching
5177 * faster. The second is that the reference string rep is 42 characters
5178 * in length, this means that it is not necessary to check any object with a string
5179 * repr < 42, and usually there aren't many of these objects. */
5181 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
5183 static int JimFormatReference(char *buf, Jim_Reference *refPtr, unsigned long id)
5185 const char *fmt = "<reference.<%s>.%020lu>";
5187 sprintf(buf, fmt, refPtr->tag, id);
5188 return JIM_REFERENCE_SPACE;
5191 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
5193 static const Jim_ObjType referenceObjType = {
5194 "reference",
5195 NULL,
5196 NULL,
5197 UpdateStringOfReference,
5198 JIM_TYPE_REFERENCES,
5201 static void UpdateStringOfReference(struct Jim_Obj *objPtr)
5203 char buf[JIM_REFERENCE_SPACE + 1];
5205 JimFormatReference(buf, objPtr->internalRep.refValue.refPtr, objPtr->internalRep.refValue.id);
5206 JimSetStringBytes(objPtr, buf);
5209 /* returns true if 'c' is a valid reference tag character.
5210 * i.e. inside the range [_a-zA-Z0-9] */
5211 static int isrefchar(int c)
5213 return (c == '_' || isalnum(c));
5216 static int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5218 unsigned long value;
5219 int i, len;
5220 const char *str, *start, *end;
5221 char refId[21];
5222 Jim_Reference *refPtr;
5223 Jim_HashEntry *he;
5224 char *endptr;
5226 /* Get the string representation */
5227 str = Jim_GetString(objPtr, &len);
5228 /* Check if it looks like a reference */
5229 if (len < JIM_REFERENCE_SPACE)
5230 goto badformat;
5231 /* Trim spaces */
5232 start = str;
5233 end = str + len - 1;
5234 while (*start == ' ')
5235 start++;
5236 while (*end == ' ' && end > start)
5237 end--;
5238 if (end - start + 1 != JIM_REFERENCE_SPACE)
5239 goto badformat;
5240 /* <reference.<1234567>.%020> */
5241 if (memcmp(start, "<reference.<", 12) != 0)
5242 goto badformat;
5243 if (start[12 + JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>')
5244 goto badformat;
5245 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
5246 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5247 if (!isrefchar(start[12 + i]))
5248 goto badformat;
5250 /* Extract info from the reference. */
5251 memcpy(refId, start + 14 + JIM_REFERENCE_TAGLEN, 20);
5252 refId[20] = '\0';
5253 /* Try to convert the ID into an unsigned long */
5254 value = strtoul(refId, &endptr, 10);
5255 if (JimCheckConversion(refId, endptr) != JIM_OK)
5256 goto badformat;
5257 /* Check if the reference really exists! */
5258 he = Jim_FindHashEntry(&interp->references, &value);
5259 if (he == NULL) {
5260 Jim_SetResultFormatted(interp, "invalid reference id \"%#s\"", objPtr);
5261 return JIM_ERR;
5263 refPtr = Jim_GetHashEntryVal(he);
5264 /* Free the old internal repr and set the new one. */
5265 Jim_FreeIntRep(interp, objPtr);
5266 objPtr->typePtr = &referenceObjType;
5267 objPtr->internalRep.refValue.id = value;
5268 objPtr->internalRep.refValue.refPtr = refPtr;
5269 return JIM_OK;
5271 badformat:
5272 Jim_SetResultFormatted(interp, "expected reference but got \"%#s\"", objPtr);
5273 return JIM_ERR;
5276 /* Returns a new reference pointing to objPtr, having cmdNamePtr
5277 * as finalizer command (or NULL if there is no finalizer).
5278 * The returned reference object has refcount = 0. */
5279 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr, Jim_Obj *cmdNamePtr)
5281 struct Jim_Reference *refPtr;
5282 unsigned long id;
5283 Jim_Obj *refObjPtr;
5284 const char *tag;
5285 int tagLen, i;
5287 /* Perform the Garbage Collection if needed. */
5288 Jim_CollectIfNeeded(interp);
5290 refPtr = Jim_Alloc(sizeof(*refPtr));
5291 refPtr->objPtr = objPtr;
5292 Jim_IncrRefCount(objPtr);
5293 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5294 if (cmdNamePtr)
5295 Jim_IncrRefCount(cmdNamePtr);
5296 id = interp->referenceNextId++;
5297 Jim_AddHashEntry(&interp->references, &id, refPtr);
5298 refObjPtr = Jim_NewObj(interp);
5299 refObjPtr->typePtr = &referenceObjType;
5300 refObjPtr->bytes = NULL;
5301 refObjPtr->internalRep.refValue.id = id;
5302 refObjPtr->internalRep.refValue.refPtr = refPtr;
5303 interp->referenceNextId++;
5304 /* Set the tag. Trimmed at JIM_REFERENCE_TAGLEN. Everything
5305 * that does not pass the 'isrefchar' test is replaced with '_' */
5306 tag = Jim_GetString(tagPtr, &tagLen);
5307 if (tagLen > JIM_REFERENCE_TAGLEN)
5308 tagLen = JIM_REFERENCE_TAGLEN;
5309 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5310 if (i < tagLen && isrefchar(tag[i]))
5311 refPtr->tag[i] = tag[i];
5312 else
5313 refPtr->tag[i] = '_';
5315 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
5316 return refObjPtr;
5319 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
5321 if (objPtr->typePtr != &referenceObjType && SetReferenceFromAny(interp, objPtr) == JIM_ERR)
5322 return NULL;
5323 return objPtr->internalRep.refValue.refPtr;
5326 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
5328 Jim_Reference *refPtr;
5330 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5331 return JIM_ERR;
5332 Jim_IncrRefCount(cmdNamePtr);
5333 if (refPtr->finalizerCmdNamePtr)
5334 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5335 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5336 return JIM_OK;
5339 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
5341 Jim_Reference *refPtr;
5343 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5344 return JIM_ERR;
5345 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
5346 return JIM_OK;
5349 /* -----------------------------------------------------------------------------
5350 * References Garbage Collection
5351 * ---------------------------------------------------------------------------*/
5353 /* This the hash table type for the "MARK" phase of the GC */
5354 static const Jim_HashTableType JimRefMarkHashTableType = {
5355 JimReferencesHTHashFunction, /* hash function */
5356 JimReferencesHTKeyDup, /* key dup */
5357 NULL, /* val dup */
5358 JimReferencesHTKeyCompare, /* key compare */
5359 JimReferencesHTKeyDestructor, /* key destructor */
5360 NULL /* val destructor */
5363 /* Performs the garbage collection. */
5364 int Jim_Collect(Jim_Interp *interp)
5366 int collected = 0;
5367 Jim_HashTable marks;
5368 Jim_HashTableIterator htiter;
5369 Jim_HashEntry *he;
5370 Jim_Obj *objPtr;
5372 /* Avoid recursive calls */
5373 if (interp->lastCollectId == (unsigned long)~0) {
5374 /* Jim_Collect() already running. Return just now. */
5375 return 0;
5377 interp->lastCollectId = ~0;
5379 /* Mark all the references found into the 'mark' hash table.
5380 * The references are searched in every live object that
5381 * is of a type that can contain references. */
5382 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
5383 objPtr = interp->liveList;
5384 while (objPtr) {
5385 if (objPtr->typePtr == NULL || objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
5386 const char *str, *p;
5387 int len;
5389 /* If the object is of type reference, to get the
5390 * Id is simple... */
5391 if (objPtr->typePtr == &referenceObjType) {
5392 Jim_AddHashEntry(&marks, &objPtr->internalRep.refValue.id, NULL);
5393 #ifdef JIM_DEBUG_GC
5394 printf("MARK (reference): %d refcount: %d\n",
5395 (int)objPtr->internalRep.refValue.id, objPtr->refCount);
5396 #endif
5397 objPtr = objPtr->nextObjPtr;
5398 continue;
5400 /* Get the string repr of the object we want
5401 * to scan for references. */
5402 p = str = Jim_GetString(objPtr, &len);
5403 /* Skip objects too little to contain references. */
5404 if (len < JIM_REFERENCE_SPACE) {
5405 objPtr = objPtr->nextObjPtr;
5406 continue;
5408 /* Extract references from the object string repr. */
5409 while (1) {
5410 int i;
5411 unsigned long id;
5413 if ((p = strstr(p, "<reference.<")) == NULL)
5414 break;
5415 /* Check if it's a valid reference. */
5416 if (len - (p - str) < JIM_REFERENCE_SPACE)
5417 break;
5418 if (p[41] != '>' || p[19] != '>' || p[20] != '.')
5419 break;
5420 for (i = 21; i <= 40; i++)
5421 if (!isdigit(UCHAR(p[i])))
5422 break;
5423 /* Get the ID */
5424 id = strtoul(p + 21, NULL, 10);
5426 /* Ok, a reference for the given ID
5427 * was found. Mark it. */
5428 Jim_AddHashEntry(&marks, &id, NULL);
5429 #ifdef JIM_DEBUG_GC
5430 printf("MARK: %d\n", (int)id);
5431 #endif
5432 p += JIM_REFERENCE_SPACE;
5435 objPtr = objPtr->nextObjPtr;
5438 /* Run the references hash table to destroy every reference that
5439 * is not referenced outside (not present in the mark HT). */
5440 JimInitHashTableIterator(&interp->references, &htiter);
5441 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
5442 const unsigned long *refId;
5443 Jim_Reference *refPtr;
5445 refId = he->key;
5446 /* Check if in the mark phase we encountered
5447 * this reference. */
5448 if (Jim_FindHashEntry(&marks, refId) == NULL) {
5449 #ifdef JIM_DEBUG_GC
5450 printf("COLLECTING %d\n", (int)*refId);
5451 #endif
5452 collected++;
5453 /* Drop the reference, but call the
5454 * finalizer first if registered. */
5455 refPtr = Jim_GetHashEntryVal(he);
5456 if (refPtr->finalizerCmdNamePtr) {
5457 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE + 1);
5458 Jim_Obj *objv[3], *oldResult;
5460 JimFormatReference(refstr, refPtr, *refId);
5462 objv[0] = refPtr->finalizerCmdNamePtr;
5463 objv[1] = Jim_NewStringObjNoAlloc(interp, refstr, JIM_REFERENCE_SPACE);
5464 objv[2] = refPtr->objPtr;
5466 /* Drop the reference itself */
5467 /* Avoid the finaliser being freed here */
5468 Jim_IncrRefCount(objv[0]);
5469 /* Don't remove the reference from the hash table just yet
5470 * since that will free refPtr, and hence refPtr->objPtr
5473 /* Call the finalizer. Errors ignored. (should we use bgerror?) */
5474 oldResult = interp->result;
5475 Jim_IncrRefCount(oldResult);
5476 Jim_EvalObjVector(interp, 3, objv);
5477 Jim_SetResult(interp, oldResult);
5478 Jim_DecrRefCount(interp, oldResult);
5480 Jim_DecrRefCount(interp, objv[0]);
5482 Jim_DeleteHashEntry(&interp->references, refId);
5485 Jim_FreeHashTable(&marks);
5486 interp->lastCollectId = interp->referenceNextId;
5487 interp->lastCollectTime = time(NULL);
5488 return collected;
5491 #define JIM_COLLECT_ID_PERIOD 5000
5492 #define JIM_COLLECT_TIME_PERIOD 300
5494 void Jim_CollectIfNeeded(Jim_Interp *interp)
5496 unsigned long elapsedId;
5497 int elapsedTime;
5499 elapsedId = interp->referenceNextId - interp->lastCollectId;
5500 elapsedTime = time(NULL) - interp->lastCollectTime;
5503 if (elapsedId > JIM_COLLECT_ID_PERIOD || elapsedTime > JIM_COLLECT_TIME_PERIOD) {
5504 Jim_Collect(interp);
5507 #endif /* JIM_REFERENCES && !JIM_BOOTSTRAP */
5509 int Jim_IsBigEndian(void)
5511 union {
5512 unsigned short s;
5513 unsigned char c[2];
5514 } uval = {0x0102};
5516 return uval.c[0] == 1;
5519 /* -----------------------------------------------------------------------------
5520 * Interpreter related functions
5521 * ---------------------------------------------------------------------------*/
5523 Jim_Interp *Jim_CreateInterp(void)
5525 Jim_Interp *i = Jim_Alloc(sizeof(*i));
5527 memset(i, 0, sizeof(*i));
5529 i->maxCallFrameDepth = JIM_MAX_CALLFRAME_DEPTH;
5530 i->maxEvalDepth = JIM_MAX_EVAL_DEPTH;
5531 i->lastCollectTime = time(NULL);
5533 /* Note that we can create objects only after the
5534 * interpreter liveList and freeList pointers are
5535 * initialized to NULL. */
5536 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
5537 #ifdef JIM_REFERENCES
5538 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
5539 #endif
5540 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
5541 Jim_InitHashTable(&i->packages, &JimPackageHashTableType, NULL);
5542 i->emptyObj = Jim_NewEmptyStringObj(i);
5543 i->trueObj = Jim_NewIntObj(i, 1);
5544 i->falseObj = Jim_NewIntObj(i, 0);
5545 i->framePtr = i->topFramePtr = JimCreateCallFrame(i, NULL, i->emptyObj);
5546 i->errorFileNameObj = i->emptyObj;
5547 i->result = i->emptyObj;
5548 i->stackTrace = Jim_NewListObj(i, NULL, 0);
5549 i->unknown = Jim_NewStringObj(i, "unknown", -1);
5550 i->errorProc = i->emptyObj;
5551 i->currentScriptObj = Jim_NewEmptyStringObj(i);
5552 i->nullScriptObj = Jim_NewEmptyStringObj(i);
5553 Jim_IncrRefCount(i->emptyObj);
5554 Jim_IncrRefCount(i->errorFileNameObj);
5555 Jim_IncrRefCount(i->result);
5556 Jim_IncrRefCount(i->stackTrace);
5557 Jim_IncrRefCount(i->unknown);
5558 Jim_IncrRefCount(i->currentScriptObj);
5559 Jim_IncrRefCount(i->nullScriptObj);
5560 Jim_IncrRefCount(i->errorProc);
5561 Jim_IncrRefCount(i->trueObj);
5562 Jim_IncrRefCount(i->falseObj);
5564 /* Initialize key variables every interpreter should contain */
5565 Jim_SetVariableStrWithStr(i, JIM_LIBPATH, TCL_LIBRARY);
5566 Jim_SetVariableStrWithStr(i, JIM_INTERACTIVE, "0");
5568 Jim_SetVariableStrWithStr(i, "tcl_platform(engine)", "Jim");
5569 Jim_SetVariableStrWithStr(i, "tcl_platform(os)", TCL_PLATFORM_OS);
5570 Jim_SetVariableStrWithStr(i, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM);
5571 Jim_SetVariableStrWithStr(i, "tcl_platform(pathSeparator)", TCL_PLATFORM_PATH_SEPARATOR);
5572 Jim_SetVariableStrWithStr(i, "tcl_platform(byteOrder)", Jim_IsBigEndian() ? "bigEndian" : "littleEndian");
5573 Jim_SetVariableStrWithStr(i, "tcl_platform(threaded)", "0");
5574 Jim_SetVariableStr(i, "tcl_platform(pointerSize)", Jim_NewIntObj(i, sizeof(void *)));
5575 Jim_SetVariableStr(i, "tcl_platform(wordSize)", Jim_NewIntObj(i, sizeof(jim_wide)));
5577 return i;
5580 void Jim_FreeInterp(Jim_Interp *i)
5582 Jim_CallFrame *cf, *cfx;
5584 Jim_Obj *objPtr, *nextObjPtr;
5586 /* Free the active call frames list - must be done before i->commands is destroyed */
5587 for (cf = i->framePtr; cf; cf = cfx) {
5588 /* Note that we ignore any errors */
5589 JimInvokeDefer(i, JIM_OK);
5590 cfx = cf->parent;
5591 JimFreeCallFrame(i, cf, JIM_FCF_FULL);
5594 Jim_DecrRefCount(i, i->emptyObj);
5595 Jim_DecrRefCount(i, i->trueObj);
5596 Jim_DecrRefCount(i, i->falseObj);
5597 Jim_DecrRefCount(i, i->result);
5598 Jim_DecrRefCount(i, i->stackTrace);
5599 Jim_DecrRefCount(i, i->errorProc);
5600 Jim_DecrRefCount(i, i->unknown);
5601 Jim_DecrRefCount(i, i->errorFileNameObj);
5602 Jim_DecrRefCount(i, i->currentScriptObj);
5603 Jim_DecrRefCount(i, i->nullScriptObj);
5604 Jim_FreeHashTable(&i->commands);
5605 #ifdef JIM_REFERENCES
5606 Jim_FreeHashTable(&i->references);
5607 #endif
5608 Jim_FreeHashTable(&i->packages);
5609 Jim_Free(i->prngState);
5610 Jim_FreeHashTable(&i->assocData);
5612 /* Check that the live object list is empty, otherwise
5613 * there is a memory leak. */
5614 #ifdef JIM_MAINTAINER
5615 if (i->liveList != NULL) {
5616 objPtr = i->liveList;
5618 printf("\n-------------------------------------\n");
5619 printf("Objects still in the free list:\n");
5620 while (objPtr) {
5621 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "string";
5622 Jim_String(objPtr);
5624 if (objPtr->bytes && strlen(objPtr->bytes) > 20) {
5625 printf("%p (%d) %-10s: '%.20s...'\n",
5626 (void *)objPtr, objPtr->refCount, type, objPtr->bytes);
5628 else {
5629 printf("%p (%d) %-10s: '%s'\n",
5630 (void *)objPtr, objPtr->refCount, type, objPtr->bytes ? objPtr->bytes : "(null)");
5632 if (objPtr->typePtr == &sourceObjType) {
5633 printf("FILE %s LINE %d\n",
5634 Jim_String(objPtr->internalRep.sourceValue.fileNameObj),
5635 objPtr->internalRep.sourceValue.lineNumber);
5637 objPtr = objPtr->nextObjPtr;
5639 printf("-------------------------------------\n\n");
5640 JimPanic((1, "Live list non empty freeing the interpreter! Leak?"));
5642 #endif
5644 /* Free all the freed objects. */
5645 objPtr = i->freeList;
5646 while (objPtr) {
5647 nextObjPtr = objPtr->nextObjPtr;
5648 Jim_Free(objPtr);
5649 objPtr = nextObjPtr;
5652 /* Free the free call frames list */
5653 for (cf = i->freeFramesList; cf; cf = cfx) {
5654 cfx = cf->next;
5655 if (cf->vars.table)
5656 Jim_FreeHashTable(&cf->vars);
5657 Jim_Free(cf);
5660 /* Free the interpreter structure. */
5661 Jim_Free(i);
5664 /* Returns the call frame relative to the level represented by
5665 * levelObjPtr. If levelObjPtr == NULL, the level is assumed to be '1'.
5667 * This function accepts the 'level' argument in the form
5668 * of the commands [uplevel] and [upvar].
5670 * Returns NULL on error.
5672 * Note: for a function accepting a relative integer as level suitable
5673 * for implementation of [info level ?level?], see JimGetCallFrameByInteger()
5675 Jim_CallFrame *Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5677 long level;
5678 const char *str;
5679 Jim_CallFrame *framePtr;
5681 if (levelObjPtr) {
5682 str = Jim_String(levelObjPtr);
5683 if (str[0] == '#') {
5684 char *endptr;
5686 level = jim_strtol(str + 1, &endptr);
5687 if (str[1] == '\0' || endptr[0] != '\0') {
5688 level = -1;
5691 else {
5692 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0) {
5693 level = -1;
5695 else {
5696 /* Convert from a relative to an absolute level */
5697 level = interp->framePtr->level - level;
5701 else {
5702 str = "1"; /* Needed to format the error message. */
5703 level = interp->framePtr->level - 1;
5706 if (level == 0) {
5707 return interp->topFramePtr;
5709 if (level > 0) {
5710 /* Lookup */
5711 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5712 if (framePtr->level == level) {
5713 return framePtr;
5718 Jim_SetResultFormatted(interp, "bad level \"%s\"", str);
5719 return NULL;
5722 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
5723 * as a relative integer like in the [info level ?level?] command.
5725 static Jim_CallFrame *JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5727 long level;
5728 Jim_CallFrame *framePtr;
5730 if (Jim_GetLong(interp, levelObjPtr, &level) == JIM_OK) {
5731 if (level <= 0) {
5732 /* Convert from a relative to an absolute level */
5733 level = interp->framePtr->level + level;
5736 if (level == 0) {
5737 return interp->topFramePtr;
5740 /* Lookup */
5741 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5742 if (framePtr->level == level) {
5743 return framePtr;
5748 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
5749 return NULL;
5752 static void JimResetStackTrace(Jim_Interp *interp)
5754 Jim_DecrRefCount(interp, interp->stackTrace);
5755 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
5756 Jim_IncrRefCount(interp->stackTrace);
5759 static void JimSetStackTrace(Jim_Interp *interp, Jim_Obj *stackTraceObj)
5761 int len;
5763 /* Increment reference first in case these are the same object */
5764 Jim_IncrRefCount(stackTraceObj);
5765 Jim_DecrRefCount(interp, interp->stackTrace);
5766 interp->stackTrace = stackTraceObj;
5767 interp->errorFlag = 1;
5769 /* This is a bit ugly.
5770 * If the filename of the last entry of the stack trace is empty,
5771 * the next stack level should be added.
5773 len = Jim_ListLength(interp, interp->stackTrace);
5774 if (len >= 3) {
5775 if (Jim_Length(Jim_ListGetIndex(interp, interp->stackTrace, len - 2)) == 0) {
5776 interp->addStackTrace = 1;
5781 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
5782 Jim_Obj *fileNameObj, int linenr)
5784 if (strcmp(procname, "unknown") == 0) {
5785 procname = "";
5787 if (!*procname && !Jim_Length(fileNameObj)) {
5788 /* No useful info here */
5789 return;
5792 if (Jim_IsShared(interp->stackTrace)) {
5793 Jim_DecrRefCount(interp, interp->stackTrace);
5794 interp->stackTrace = Jim_DuplicateObj(interp, interp->stackTrace);
5795 Jim_IncrRefCount(interp->stackTrace);
5798 /* If we have no procname but the previous element did, merge with that frame */
5799 if (!*procname && Jim_Length(fileNameObj)) {
5800 /* Just a filename. Check the previous entry */
5801 int len = Jim_ListLength(interp, interp->stackTrace);
5803 if (len >= 3) {
5804 Jim_Obj *objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 3);
5805 if (Jim_Length(objPtr)) {
5806 /* Yes, the previous level had procname */
5807 objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 2);
5808 if (Jim_Length(objPtr) == 0) {
5809 /* But no filename, so merge the new info with that frame */
5810 ListSetIndex(interp, interp->stackTrace, len - 2, fileNameObj, 0);
5811 ListSetIndex(interp, interp->stackTrace, len - 1, Jim_NewIntObj(interp, linenr), 0);
5812 return;
5818 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewStringObj(interp, procname, -1));
5819 Jim_ListAppendElement(interp, interp->stackTrace, fileNameObj);
5820 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewIntObj(interp, linenr));
5823 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc * delProc,
5824 void *data)
5826 AssocDataValue *assocEntryPtr = (AssocDataValue *) Jim_Alloc(sizeof(AssocDataValue));
5828 assocEntryPtr->delProc = delProc;
5829 assocEntryPtr->data = data;
5830 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
5833 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
5835 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
5837 if (entryPtr != NULL) {
5838 AssocDataValue *assocEntryPtr = Jim_GetHashEntryVal(entryPtr);
5839 return assocEntryPtr->data;
5841 return NULL;
5844 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
5846 return Jim_DeleteHashEntry(&interp->assocData, key);
5849 int Jim_GetExitCode(Jim_Interp *interp)
5851 return interp->exitCode;
5854 /* -----------------------------------------------------------------------------
5855 * Integer object
5856 * ---------------------------------------------------------------------------*/
5857 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
5858 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
5860 static const Jim_ObjType intObjType = {
5861 "int",
5862 NULL,
5863 NULL,
5864 UpdateStringOfInt,
5865 JIM_TYPE_NONE,
5868 /* A coerced double is closer to an int than a double.
5869 * It is an int value temporarily masquerading as a double value.
5870 * i.e. it has the same string value as an int and Jim_GetWide()
5871 * succeeds, but also Jim_GetDouble() returns the value directly.
5873 static const Jim_ObjType coercedDoubleObjType = {
5874 "coerced-double",
5875 NULL,
5876 NULL,
5877 UpdateStringOfInt,
5878 JIM_TYPE_NONE,
5882 static void UpdateStringOfInt(struct Jim_Obj *objPtr)
5884 char buf[JIM_INTEGER_SPACE + 1];
5885 jim_wide wideValue = JimWideValue(objPtr);
5886 int pos = 0;
5888 if (wideValue == 0) {
5889 buf[pos++] = '0';
5891 else {
5892 char tmp[JIM_INTEGER_SPACE];
5893 int num = 0;
5894 int i;
5896 if (wideValue < 0) {
5897 buf[pos++] = '-';
5898 i = wideValue % 10;
5899 /* C89 is implementation defined as to whether (-106 % 10) is -6 or 4,
5900 * whereas C99 is always -6
5901 * coverity[dead_error_line]
5903 tmp[num++] = (i > 0) ? (10 - i) : -i;
5904 wideValue /= -10;
5907 while (wideValue) {
5908 tmp[num++] = wideValue % 10;
5909 wideValue /= 10;
5912 for (i = 0; i < num; i++) {
5913 buf[pos++] = '0' + tmp[num - i - 1];
5916 buf[pos] = 0;
5918 JimSetStringBytes(objPtr, buf);
5921 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
5923 jim_wide wideValue;
5924 const char *str;
5926 if (objPtr->typePtr == &coercedDoubleObjType) {
5927 /* Simple switch */
5928 objPtr->typePtr = &intObjType;
5929 return JIM_OK;
5932 /* Get the string representation */
5933 str = Jim_String(objPtr);
5934 /* Try to convert into a jim_wide */
5935 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
5936 if (flags & JIM_ERRMSG) {
5937 Jim_SetResultFormatted(interp, "expected integer but got \"%#s\"", objPtr);
5939 return JIM_ERR;
5941 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) && errno == ERANGE) {
5942 Jim_SetResultString(interp, "Integer value too big to be represented", -1);
5943 return JIM_ERR;
5945 /* Free the old internal repr and set the new one. */
5946 Jim_FreeIntRep(interp, objPtr);
5947 objPtr->typePtr = &intObjType;
5948 objPtr->internalRep.wideValue = wideValue;
5949 return JIM_OK;
5952 #ifdef JIM_OPTIMIZATION
5953 static int JimIsWide(Jim_Obj *objPtr)
5955 return objPtr->typePtr == &intObjType;
5957 #endif
5959 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5961 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
5962 return JIM_ERR;
5963 *widePtr = JimWideValue(objPtr);
5964 return JIM_OK;
5967 /* Get a wide but does not set an error if the format is bad. */
5968 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5970 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
5971 return JIM_ERR;
5972 *widePtr = JimWideValue(objPtr);
5973 return JIM_OK;
5976 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
5978 jim_wide wideValue;
5979 int retval;
5981 retval = Jim_GetWide(interp, objPtr, &wideValue);
5982 if (retval == JIM_OK) {
5983 *longPtr = (long)wideValue;
5984 return JIM_OK;
5986 return JIM_ERR;
5989 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
5991 Jim_Obj *objPtr;
5993 objPtr = Jim_NewObj(interp);
5994 objPtr->typePtr = &intObjType;
5995 objPtr->bytes = NULL;
5996 objPtr->internalRep.wideValue = wideValue;
5997 return objPtr;
6000 /* -----------------------------------------------------------------------------
6001 * Double object
6002 * ---------------------------------------------------------------------------*/
6003 #define JIM_DOUBLE_SPACE 30
6005 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
6006 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
6008 static const Jim_ObjType doubleObjType = {
6009 "double",
6010 NULL,
6011 NULL,
6012 UpdateStringOfDouble,
6013 JIM_TYPE_NONE,
6016 #ifndef HAVE_ISNAN
6017 #undef isnan
6018 #define isnan(X) ((X) != (X))
6019 #endif
6020 #ifndef HAVE_ISINF
6021 #undef isinf
6022 #define isinf(X) (1.0 / (X) == 0.0)
6023 #endif
6025 static void UpdateStringOfDouble(struct Jim_Obj *objPtr)
6027 double value = objPtr->internalRep.doubleValue;
6029 if (isnan(value)) {
6030 JimSetStringBytes(objPtr, "NaN");
6031 return;
6033 if (isinf(value)) {
6034 if (value < 0) {
6035 JimSetStringBytes(objPtr, "-Inf");
6037 else {
6038 JimSetStringBytes(objPtr, "Inf");
6040 return;
6043 char buf[JIM_DOUBLE_SPACE + 1];
6044 int i;
6045 int len = sprintf(buf, "%.12g", value);
6047 /* Add a final ".0" if necessary */
6048 for (i = 0; i < len; i++) {
6049 if (buf[i] == '.' || buf[i] == 'e') {
6050 #if defined(JIM_SPRINTF_DOUBLE_NEEDS_FIX)
6051 /* If 'buf' ends in e-0nn or e+0nn, remove
6052 * the 0 after the + or - and reduce the length by 1
6054 char *e = strchr(buf, 'e');
6055 if (e && (e[1] == '-' || e[1] == '+') && e[2] == '0') {
6056 /* Move it up */
6057 e += 2;
6058 memmove(e, e + 1, len - (e - buf));
6060 #endif
6061 break;
6064 if (buf[i] == '\0') {
6065 buf[i++] = '.';
6066 buf[i++] = '0';
6067 buf[i] = '\0';
6069 JimSetStringBytes(objPtr, buf);
6073 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6075 double doubleValue;
6076 jim_wide wideValue;
6077 const char *str;
6079 #ifdef HAVE_LONG_LONG
6080 /* Assume a 53 bit mantissa */
6081 #define MIN_INT_IN_DOUBLE -(1LL << 53)
6082 #define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1)
6084 if (objPtr->typePtr == &intObjType
6085 && JimWideValue(objPtr) >= MIN_INT_IN_DOUBLE
6086 && JimWideValue(objPtr) <= MAX_INT_IN_DOUBLE) {
6088 /* Direct conversion to coerced double */
6089 objPtr->typePtr = &coercedDoubleObjType;
6090 return JIM_OK;
6092 #endif
6093 /* Preserve the string representation.
6094 * Needed so we can convert back to int without loss
6096 str = Jim_String(objPtr);
6098 if (Jim_StringToWide(str, &wideValue, 10) == JIM_OK) {
6099 /* Managed to convert to an int, so we can use this as a cooerced double */
6100 Jim_FreeIntRep(interp, objPtr);
6101 objPtr->typePtr = &coercedDoubleObjType;
6102 objPtr->internalRep.wideValue = wideValue;
6103 return JIM_OK;
6105 else {
6106 /* Try to convert into a double */
6107 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
6108 Jim_SetResultFormatted(interp, "expected floating-point number but got \"%#s\"", objPtr);
6109 return JIM_ERR;
6111 /* Free the old internal repr and set the new one. */
6112 Jim_FreeIntRep(interp, objPtr);
6114 objPtr->typePtr = &doubleObjType;
6115 objPtr->internalRep.doubleValue = doubleValue;
6116 return JIM_OK;
6119 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
6121 if (objPtr->typePtr == &coercedDoubleObjType) {
6122 *doublePtr = JimWideValue(objPtr);
6123 return JIM_OK;
6125 if (objPtr->typePtr != &doubleObjType && SetDoubleFromAny(interp, objPtr) == JIM_ERR)
6126 return JIM_ERR;
6128 if (objPtr->typePtr == &coercedDoubleObjType) {
6129 *doublePtr = JimWideValue(objPtr);
6131 else {
6132 *doublePtr = objPtr->internalRep.doubleValue;
6134 return JIM_OK;
6137 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
6139 Jim_Obj *objPtr;
6141 objPtr = Jim_NewObj(interp);
6142 objPtr->typePtr = &doubleObjType;
6143 objPtr->bytes = NULL;
6144 objPtr->internalRep.doubleValue = doubleValue;
6145 return objPtr;
6148 /* -----------------------------------------------------------------------------
6149 * Boolean conversion
6150 * ---------------------------------------------------------------------------*/
6151 static int SetBooleanFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
6153 int Jim_GetBoolean(Jim_Interp *interp, Jim_Obj *objPtr, int * booleanPtr)
6155 if (objPtr->typePtr != &intObjType && SetBooleanFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
6156 return JIM_ERR;
6157 *booleanPtr = (int) JimWideValue(objPtr);
6158 return JIM_OK;
6161 static int SetBooleanFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
6163 static const char * const falses[] = {
6164 "0", "false", "no", "off", NULL
6166 static const char * const trues[] = {
6167 "1", "true", "yes", "on", NULL
6170 int boolean;
6172 int index;
6173 if (Jim_GetEnum(interp, objPtr, falses, &index, NULL, 0) == JIM_OK) {
6174 boolean = 0;
6175 } else if (Jim_GetEnum(interp, objPtr, trues, &index, NULL, 0) == JIM_OK) {
6176 boolean = 1;
6177 } else {
6178 if (flags & JIM_ERRMSG) {
6179 Jim_SetResultFormatted(interp, "expected boolean but got \"%#s\"", objPtr);
6181 return JIM_ERR;
6184 /* Free the old internal repr and set the new one. */
6185 Jim_FreeIntRep(interp, objPtr);
6186 objPtr->typePtr = &intObjType;
6187 objPtr->internalRep.wideValue = boolean;
6188 return JIM_OK;
6191 /* -----------------------------------------------------------------------------
6192 * List object
6193 * ---------------------------------------------------------------------------*/
6194 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec);
6195 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
6196 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6197 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6198 static void UpdateStringOfList(struct Jim_Obj *objPtr);
6199 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6201 /* Note that while the elements of the list may contain references,
6202 * the list object itself can't. This basically means that the
6203 * list object string representation as a whole can't contain references
6204 * that are not presents in the single elements. */
6205 static const Jim_ObjType listObjType = {
6206 "list",
6207 FreeListInternalRep,
6208 DupListInternalRep,
6209 UpdateStringOfList,
6210 JIM_TYPE_NONE,
6213 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6215 int i;
6217 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
6218 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
6220 Jim_Free(objPtr->internalRep.listValue.ele);
6223 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6225 int i;
6227 JIM_NOTUSED(interp);
6229 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
6230 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
6231 dupPtr->internalRep.listValue.ele =
6232 Jim_Alloc(sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.maxLen);
6233 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
6234 sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.len);
6235 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
6236 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
6238 dupPtr->typePtr = &listObjType;
6241 /* The following function checks if a given string can be encoded
6242 * into a list element without any kind of quoting, surrounded by braces,
6243 * or using escapes to quote. */
6244 #define JIM_ELESTR_SIMPLE 0
6245 #define JIM_ELESTR_BRACE 1
6246 #define JIM_ELESTR_QUOTE 2
6247 static unsigned char ListElementQuotingType(const char *s, int len)
6249 int i, level, blevel, trySimple = 1;
6251 /* Try with the SIMPLE case */
6252 if (len == 0)
6253 return JIM_ELESTR_BRACE;
6254 if (s[0] == '"' || s[0] == '{') {
6255 trySimple = 0;
6256 goto testbrace;
6258 for (i = 0; i < len; i++) {
6259 switch (s[i]) {
6260 case ' ':
6261 case '$':
6262 case '"':
6263 case '[':
6264 case ']':
6265 case ';':
6266 case '\\':
6267 case '\r':
6268 case '\n':
6269 case '\t':
6270 case '\f':
6271 case '\v':
6272 trySimple = 0;
6273 /* fall through */
6274 case '{':
6275 case '}':
6276 goto testbrace;
6279 return JIM_ELESTR_SIMPLE;
6281 testbrace:
6282 /* Test if it's possible to do with braces */
6283 if (s[len - 1] == '\\')
6284 return JIM_ELESTR_QUOTE;
6285 level = 0;
6286 blevel = 0;
6287 for (i = 0; i < len; i++) {
6288 switch (s[i]) {
6289 case '{':
6290 level++;
6291 break;
6292 case '}':
6293 level--;
6294 if (level < 0)
6295 return JIM_ELESTR_QUOTE;
6296 break;
6297 case '[':
6298 blevel++;
6299 break;
6300 case ']':
6301 blevel--;
6302 break;
6303 case '\\':
6304 if (s[i + 1] == '\n')
6305 return JIM_ELESTR_QUOTE;
6306 else if (s[i + 1] != '\0')
6307 i++;
6308 break;
6311 if (blevel < 0) {
6312 return JIM_ELESTR_QUOTE;
6315 if (level == 0) {
6316 if (!trySimple)
6317 return JIM_ELESTR_BRACE;
6318 for (i = 0; i < len; i++) {
6319 switch (s[i]) {
6320 case ' ':
6321 case '$':
6322 case '"':
6323 case '[':
6324 case ']':
6325 case ';':
6326 case '\\':
6327 case '\r':
6328 case '\n':
6329 case '\t':
6330 case '\f':
6331 case '\v':
6332 return JIM_ELESTR_BRACE;
6333 break;
6336 return JIM_ELESTR_SIMPLE;
6338 return JIM_ELESTR_QUOTE;
6341 /* Backslashes-escapes the null-terminated string 's' into the buffer at 'q'
6342 * The buffer must be at least strlen(s) * 2 + 1 bytes long for the worst-case
6343 * scenario.
6344 * Returns the length of the result.
6346 static int BackslashQuoteString(const char *s, int len, char *q)
6348 char *p = q;
6350 while (len--) {
6351 switch (*s) {
6352 case ' ':
6353 case '$':
6354 case '"':
6355 case '[':
6356 case ']':
6357 case '{':
6358 case '}':
6359 case ';':
6360 case '\\':
6361 *p++ = '\\';
6362 *p++ = *s++;
6363 break;
6364 case '\n':
6365 *p++ = '\\';
6366 *p++ = 'n';
6367 s++;
6368 break;
6369 case '\r':
6370 *p++ = '\\';
6371 *p++ = 'r';
6372 s++;
6373 break;
6374 case '\t':
6375 *p++ = '\\';
6376 *p++ = 't';
6377 s++;
6378 break;
6379 case '\f':
6380 *p++ = '\\';
6381 *p++ = 'f';
6382 s++;
6383 break;
6384 case '\v':
6385 *p++ = '\\';
6386 *p++ = 'v';
6387 s++;
6388 break;
6389 default:
6390 *p++ = *s++;
6391 break;
6394 *p = '\0';
6396 return p - q;
6399 static void JimMakeListStringRep(Jim_Obj *objPtr, Jim_Obj **objv, int objc)
6401 #define STATIC_QUOTING_LEN 32
6402 int i, bufLen, realLength;
6403 const char *strRep;
6404 char *p;
6405 unsigned char *quotingType, staticQuoting[STATIC_QUOTING_LEN];
6407 /* Estimate the space needed. */
6408 if (objc > STATIC_QUOTING_LEN) {
6409 quotingType = Jim_Alloc(objc);
6411 else {
6412 quotingType = staticQuoting;
6414 bufLen = 0;
6415 for (i = 0; i < objc; i++) {
6416 int len;
6418 strRep = Jim_GetString(objv[i], &len);
6419 quotingType[i] = ListElementQuotingType(strRep, len);
6420 switch (quotingType[i]) {
6421 case JIM_ELESTR_SIMPLE:
6422 if (i != 0 || strRep[0] != '#') {
6423 bufLen += len;
6424 break;
6426 /* Special case '#' on first element needs braces */
6427 quotingType[i] = JIM_ELESTR_BRACE;
6428 /* fall through */
6429 case JIM_ELESTR_BRACE:
6430 bufLen += len + 2;
6431 break;
6432 case JIM_ELESTR_QUOTE:
6433 bufLen += len * 2;
6434 break;
6436 bufLen++; /* elements separator. */
6438 bufLen++;
6440 /* Generate the string rep. */
6441 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
6442 realLength = 0;
6443 for (i = 0; i < objc; i++) {
6444 int len, qlen;
6446 strRep = Jim_GetString(objv[i], &len);
6448 switch (quotingType[i]) {
6449 case JIM_ELESTR_SIMPLE:
6450 memcpy(p, strRep, len);
6451 p += len;
6452 realLength += len;
6453 break;
6454 case JIM_ELESTR_BRACE:
6455 *p++ = '{';
6456 memcpy(p, strRep, len);
6457 p += len;
6458 *p++ = '}';
6459 realLength += len + 2;
6460 break;
6461 case JIM_ELESTR_QUOTE:
6462 if (i == 0 && strRep[0] == '#') {
6463 *p++ = '\\';
6464 realLength++;
6466 qlen = BackslashQuoteString(strRep, len, p);
6467 p += qlen;
6468 realLength += qlen;
6469 break;
6471 /* Add a separating space */
6472 if (i + 1 != objc) {
6473 *p++ = ' ';
6474 realLength++;
6477 *p = '\0'; /* nul term. */
6478 objPtr->length = realLength;
6480 if (quotingType != staticQuoting) {
6481 Jim_Free(quotingType);
6485 static void UpdateStringOfList(struct Jim_Obj *objPtr)
6487 JimMakeListStringRep(objPtr, objPtr->internalRep.listValue.ele, objPtr->internalRep.listValue.len);
6490 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6492 struct JimParserCtx parser;
6493 const char *str;
6494 int strLen;
6495 Jim_Obj *fileNameObj;
6496 int linenr;
6498 if (objPtr->typePtr == &listObjType) {
6499 return JIM_OK;
6502 /* Optimise dict -> list for object with no string rep. Note that this may only save a little time, but
6503 * it also preserves any source location of the dict elements
6504 * which can be very useful
6506 if (Jim_IsDict(objPtr) && objPtr->bytes == NULL) {
6507 Jim_Obj **listObjPtrPtr;
6508 int len;
6509 int i;
6511 listObjPtrPtr = JimDictPairs(objPtr, &len);
6512 for (i = 0; i < len; i++) {
6513 Jim_IncrRefCount(listObjPtrPtr[i]);
6516 /* Now just switch the internal rep */
6517 Jim_FreeIntRep(interp, objPtr);
6518 objPtr->typePtr = &listObjType;
6519 objPtr->internalRep.listValue.len = len;
6520 objPtr->internalRep.listValue.maxLen = len;
6521 objPtr->internalRep.listValue.ele = listObjPtrPtr;
6523 return JIM_OK;
6526 /* Try to preserve information about filename / line number */
6527 if (objPtr->typePtr == &sourceObjType) {
6528 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
6529 linenr = objPtr->internalRep.sourceValue.lineNumber;
6531 else {
6532 fileNameObj = interp->emptyObj;
6533 linenr = 1;
6535 Jim_IncrRefCount(fileNameObj);
6537 /* Get the string representation */
6538 str = Jim_GetString(objPtr, &strLen);
6540 /* Free the old internal repr just now and initialize the
6541 * new one just now. The string->list conversion can't fail. */
6542 Jim_FreeIntRep(interp, objPtr);
6543 objPtr->typePtr = &listObjType;
6544 objPtr->internalRep.listValue.len = 0;
6545 objPtr->internalRep.listValue.maxLen = 0;
6546 objPtr->internalRep.listValue.ele = NULL;
6548 /* Convert into a list */
6549 if (strLen) {
6550 JimParserInit(&parser, str, strLen, linenr);
6551 while (!parser.eof) {
6552 Jim_Obj *elementPtr;
6554 JimParseList(&parser);
6555 if (parser.tt != JIM_TT_STR && parser.tt != JIM_TT_ESC)
6556 continue;
6557 elementPtr = JimParserGetTokenObj(interp, &parser);
6558 JimSetSourceInfo(interp, elementPtr, fileNameObj, parser.tline);
6559 ListAppendElement(objPtr, elementPtr);
6562 Jim_DecrRefCount(interp, fileNameObj);
6563 return JIM_OK;
6566 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
6568 Jim_Obj *objPtr;
6570 objPtr = Jim_NewObj(interp);
6571 objPtr->typePtr = &listObjType;
6572 objPtr->bytes = NULL;
6573 objPtr->internalRep.listValue.ele = NULL;
6574 objPtr->internalRep.listValue.len = 0;
6575 objPtr->internalRep.listValue.maxLen = 0;
6577 if (len) {
6578 ListInsertElements(objPtr, 0, len, elements);
6581 return objPtr;
6584 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
6585 * length of the vector. Note that the user of this function should make
6586 * sure that the list object can't shimmer while the vector returned
6587 * is in use, this vector is the one stored inside the internal representation
6588 * of the list object. This function is not exported, extensions should
6589 * always access to the List object elements using Jim_ListIndex(). */
6590 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *listLen,
6591 Jim_Obj ***listVec)
6593 *listLen = Jim_ListLength(interp, listObj);
6594 *listVec = listObj->internalRep.listValue.ele;
6597 /* Sorting uses ints, but commands may return wide */
6598 static int JimSign(jim_wide w)
6600 if (w == 0) {
6601 return 0;
6603 else if (w < 0) {
6604 return -1;
6606 return 1;
6609 /* ListSortElements type values */
6610 struct lsort_info {
6611 jmp_buf jmpbuf;
6612 Jim_Obj *command;
6613 Jim_Interp *interp;
6614 enum {
6615 JIM_LSORT_ASCII,
6616 JIM_LSORT_NOCASE,
6617 JIM_LSORT_INTEGER,
6618 JIM_LSORT_REAL,
6619 JIM_LSORT_COMMAND
6620 } type;
6621 int order;
6622 int index;
6623 int indexed;
6624 int unique;
6625 int (*subfn)(Jim_Obj **, Jim_Obj **);
6628 static struct lsort_info *sort_info;
6630 static int ListSortIndexHelper(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6632 Jim_Obj *lObj, *rObj;
6634 if (Jim_ListIndex(sort_info->interp, *lhsObj, sort_info->index, &lObj, JIM_ERRMSG) != JIM_OK ||
6635 Jim_ListIndex(sort_info->interp, *rhsObj, sort_info->index, &rObj, JIM_ERRMSG) != JIM_OK) {
6636 longjmp(sort_info->jmpbuf, JIM_ERR);
6638 return sort_info->subfn(&lObj, &rObj);
6641 /* Sort the internal rep of a list. */
6642 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6644 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 0) * sort_info->order;
6647 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6649 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 1) * sort_info->order;
6652 static int ListSortInteger(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6654 jim_wide lhs = 0, rhs = 0;
6656 if (Jim_GetWide(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6657 Jim_GetWide(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6658 longjmp(sort_info->jmpbuf, JIM_ERR);
6661 return JimSign(lhs - rhs) * sort_info->order;
6664 static int ListSortReal(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6666 double lhs = 0, rhs = 0;
6668 if (Jim_GetDouble(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6669 Jim_GetDouble(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6670 longjmp(sort_info->jmpbuf, JIM_ERR);
6672 if (lhs == rhs) {
6673 return 0;
6675 if (lhs > rhs) {
6676 return sort_info->order;
6678 return -sort_info->order;
6681 static int ListSortCommand(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6683 Jim_Obj *compare_script;
6684 int rc;
6686 jim_wide ret = 0;
6688 /* This must be a valid list */
6689 compare_script = Jim_DuplicateObj(sort_info->interp, sort_info->command);
6690 Jim_ListAppendElement(sort_info->interp, compare_script, *lhsObj);
6691 Jim_ListAppendElement(sort_info->interp, compare_script, *rhsObj);
6693 rc = Jim_EvalObj(sort_info->interp, compare_script);
6695 if (rc != JIM_OK || Jim_GetWide(sort_info->interp, Jim_GetResult(sort_info->interp), &ret) != JIM_OK) {
6696 longjmp(sort_info->jmpbuf, rc);
6699 return JimSign(ret) * sort_info->order;
6702 /* Remove duplicate elements from the (sorted) list in-place, according to the
6703 * comparison function, comp.
6705 * Note that the last unique value is kept, not the first
6707 static void ListRemoveDuplicates(Jim_Obj *listObjPtr, int (*comp)(Jim_Obj **lhs, Jim_Obj **rhs))
6709 int src;
6710 int dst = 0;
6711 Jim_Obj **ele = listObjPtr->internalRep.listValue.ele;
6713 for (src = 1; src < listObjPtr->internalRep.listValue.len; src++) {
6714 if (comp(&ele[dst], &ele[src]) == 0) {
6715 /* Match, so replace the dest with the current source */
6716 Jim_DecrRefCount(sort_info->interp, ele[dst]);
6718 else {
6719 /* No match, so keep the current source and move to the next destination */
6720 dst++;
6722 ele[dst] = ele[src];
6725 /* At end of list, keep the final element unless all elements were kept */
6726 dst++;
6727 if (dst < listObjPtr->internalRep.listValue.len) {
6728 ele[dst] = ele[src];
6731 /* Set the new length */
6732 listObjPtr->internalRep.listValue.len = dst;
6735 /* Sort a list *in place*. MUST be called with a non-shared list. */
6736 static int ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, struct lsort_info *info)
6738 struct lsort_info *prev_info;
6740 typedef int (qsort_comparator) (const void *, const void *);
6741 int (*fn) (Jim_Obj **, Jim_Obj **);
6742 Jim_Obj **vector;
6743 int len;
6744 int rc;
6746 JimPanic((Jim_IsShared(listObjPtr), "ListSortElements called with shared object"));
6747 SetListFromAny(interp, listObjPtr);
6749 /* Allow lsort to be called reentrantly */
6750 prev_info = sort_info;
6751 sort_info = info;
6753 vector = listObjPtr->internalRep.listValue.ele;
6754 len = listObjPtr->internalRep.listValue.len;
6755 switch (info->type) {
6756 case JIM_LSORT_ASCII:
6757 fn = ListSortString;
6758 break;
6759 case JIM_LSORT_NOCASE:
6760 fn = ListSortStringNoCase;
6761 break;
6762 case JIM_LSORT_INTEGER:
6763 fn = ListSortInteger;
6764 break;
6765 case JIM_LSORT_REAL:
6766 fn = ListSortReal;
6767 break;
6768 case JIM_LSORT_COMMAND:
6769 fn = ListSortCommand;
6770 break;
6771 default:
6772 fn = NULL; /* avoid warning */
6773 JimPanic((1, "ListSort called with invalid sort type"));
6774 return -1; /* Should not be run but keeps static analysers happy */
6777 if (info->indexed) {
6778 /* Need to interpose a "list index" function */
6779 info->subfn = fn;
6780 fn = ListSortIndexHelper;
6783 if ((rc = setjmp(info->jmpbuf)) == 0) {
6784 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *) fn);
6786 if (info->unique && len > 1) {
6787 ListRemoveDuplicates(listObjPtr, fn);
6790 Jim_InvalidateStringRep(listObjPtr);
6792 sort_info = prev_info;
6794 return rc;
6797 /* This is the low-level function to insert elements into a list.
6798 * The higher-level Jim_ListInsertElements() performs shared object
6799 * check and invalidates the string repr. This version is used
6800 * in the internals of the List Object and is not exported.
6802 * NOTE: this function can be called only against objects
6803 * with internal type of List.
6805 * An insertion point (idx) of -1 means end-of-list.
6807 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec)
6809 int currentLen = listPtr->internalRep.listValue.len;
6810 int requiredLen = currentLen + elemc;
6811 int i;
6812 Jim_Obj **point;
6814 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
6815 if (requiredLen < 2) {
6816 /* Don't do allocations of under 4 pointers. */
6817 requiredLen = 4;
6819 else {
6820 requiredLen *= 2;
6823 listPtr->internalRep.listValue.ele = Jim_Realloc(listPtr->internalRep.listValue.ele,
6824 sizeof(Jim_Obj *) * requiredLen);
6826 listPtr->internalRep.listValue.maxLen = requiredLen;
6828 if (idx < 0) {
6829 idx = currentLen;
6831 point = listPtr->internalRep.listValue.ele + idx;
6832 memmove(point + elemc, point, (currentLen - idx) * sizeof(Jim_Obj *));
6833 for (i = 0; i < elemc; ++i) {
6834 point[i] = elemVec[i];
6835 Jim_IncrRefCount(point[i]);
6837 listPtr->internalRep.listValue.len += elemc;
6840 /* Convenience call to ListInsertElements() to append a single element.
6842 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
6844 ListInsertElements(listPtr, -1, 1, &objPtr);
6847 /* Appends every element of appendListPtr into listPtr.
6848 * Both have to be of the list type.
6849 * Convenience call to ListInsertElements()
6851 static void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6853 ListInsertElements(listPtr, -1,
6854 appendListPtr->internalRep.listValue.len, appendListPtr->internalRep.listValue.ele);
6857 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
6859 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendElement called with shared object"));
6860 SetListFromAny(interp, listPtr);
6861 Jim_InvalidateStringRep(listPtr);
6862 ListAppendElement(listPtr, objPtr);
6865 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6867 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendList called with shared object"));
6868 SetListFromAny(interp, listPtr);
6869 SetListFromAny(interp, appendListPtr);
6870 Jim_InvalidateStringRep(listPtr);
6871 ListAppendList(listPtr, appendListPtr);
6874 int Jim_ListLength(Jim_Interp *interp, Jim_Obj *objPtr)
6876 SetListFromAny(interp, objPtr);
6877 return objPtr->internalRep.listValue.len;
6880 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6881 int objc, Jim_Obj *const *objVec)
6883 JimPanic((Jim_IsShared(listPtr), "Jim_ListInsertElement called with shared object"));
6884 SetListFromAny(interp, listPtr);
6885 if (idx >= 0 && idx > listPtr->internalRep.listValue.len)
6886 idx = listPtr->internalRep.listValue.len;
6887 else if (idx < 0)
6888 idx = 0;
6889 Jim_InvalidateStringRep(listPtr);
6890 ListInsertElements(listPtr, idx, objc, objVec);
6893 Jim_Obj *Jim_ListGetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx)
6895 SetListFromAny(interp, listPtr);
6896 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6897 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6898 return NULL;
6900 if (idx < 0)
6901 idx = listPtr->internalRep.listValue.len + idx;
6902 return listPtr->internalRep.listValue.ele[idx];
6905 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx, Jim_Obj **objPtrPtr, int flags)
6907 *objPtrPtr = Jim_ListGetIndex(interp, listPtr, idx);
6908 if (*objPtrPtr == NULL) {
6909 if (flags & JIM_ERRMSG) {
6910 Jim_SetResultString(interp, "list index out of range", -1);
6912 return JIM_ERR;
6914 return JIM_OK;
6917 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6918 Jim_Obj *newObjPtr, int flags)
6920 SetListFromAny(interp, listPtr);
6921 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6922 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6923 if (flags & JIM_ERRMSG) {
6924 Jim_SetResultString(interp, "list index out of range", -1);
6926 return JIM_ERR;
6928 if (idx < 0)
6929 idx = listPtr->internalRep.listValue.len + idx;
6930 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[idx]);
6931 listPtr->internalRep.listValue.ele[idx] = newObjPtr;
6932 Jim_IncrRefCount(newObjPtr);
6933 return JIM_OK;
6936 /* Modify the list stored in the variable named 'varNamePtr'
6937 * setting the element specified by the 'indexc' indexes objects in 'indexv',
6938 * with the new element 'newObjptr'. (implements the [lset] command) */
6939 int Jim_ListSetIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
6940 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
6942 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
6943 int shared, i, idx;
6945 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG | JIM_UNSHARED);
6946 if (objPtr == NULL)
6947 return JIM_ERR;
6948 if ((shared = Jim_IsShared(objPtr)))
6949 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
6950 for (i = 0; i < indexc - 1; i++) {
6951 listObjPtr = objPtr;
6952 if (Jim_GetIndex(interp, indexv[i], &idx) != JIM_OK)
6953 goto err;
6954 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_ERRMSG) != JIM_OK) {
6955 goto err;
6957 if (Jim_IsShared(objPtr)) {
6958 objPtr = Jim_DuplicateObj(interp, objPtr);
6959 ListSetIndex(interp, listObjPtr, idx, objPtr, JIM_NONE);
6961 Jim_InvalidateStringRep(listObjPtr);
6963 if (Jim_GetIndex(interp, indexv[indexc - 1], &idx) != JIM_OK)
6964 goto err;
6965 if (ListSetIndex(interp, objPtr, idx, newObjPtr, JIM_ERRMSG) == JIM_ERR)
6966 goto err;
6967 Jim_InvalidateStringRep(objPtr);
6968 Jim_InvalidateStringRep(varObjPtr);
6969 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
6970 goto err;
6971 Jim_SetResult(interp, varObjPtr);
6972 return JIM_OK;
6973 err:
6974 if (shared) {
6975 Jim_FreeNewObj(interp, varObjPtr);
6977 return JIM_ERR;
6980 Jim_Obj *Jim_ListJoin(Jim_Interp *interp, Jim_Obj *listObjPtr, const char *joinStr, int joinStrLen)
6982 int i;
6983 int listLen = Jim_ListLength(interp, listObjPtr);
6984 Jim_Obj *resObjPtr = Jim_NewEmptyStringObj(interp);
6986 for (i = 0; i < listLen; ) {
6987 Jim_AppendObj(interp, resObjPtr, Jim_ListGetIndex(interp, listObjPtr, i));
6988 if (++i != listLen) {
6989 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
6992 return resObjPtr;
6995 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
6997 int i;
6999 /* If all the objects in objv are lists,
7000 * it's possible to return a list as result, that's the
7001 * concatenation of all the lists. */
7002 for (i = 0; i < objc; i++) {
7003 if (!Jim_IsList(objv[i]))
7004 break;
7006 if (i == objc) {
7007 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
7009 for (i = 0; i < objc; i++)
7010 ListAppendList(objPtr, objv[i]);
7011 return objPtr;
7013 else {
7014 /* Else... we have to glue strings together */
7015 int len = 0, objLen;
7016 char *bytes, *p;
7018 /* Compute the length */
7019 for (i = 0; i < objc; i++) {
7020 len += Jim_Length(objv[i]);
7022 if (objc)
7023 len += objc - 1;
7024 /* Create the string rep, and a string object holding it. */
7025 p = bytes = Jim_Alloc(len + 1);
7026 for (i = 0; i < objc; i++) {
7027 const char *s = Jim_GetString(objv[i], &objLen);
7029 /* Remove leading space */
7030 while (objLen && isspace(UCHAR(*s))) {
7031 s++;
7032 objLen--;
7033 len--;
7035 /* And trailing space */
7036 while (objLen && isspace(UCHAR(s[objLen - 1]))) {
7037 /* Handle trailing backslash-space case */
7038 if (objLen > 1 && s[objLen - 2] == '\\') {
7039 break;
7041 objLen--;
7042 len--;
7044 memcpy(p, s, objLen);
7045 p += objLen;
7046 if (i + 1 != objc) {
7047 if (objLen)
7048 *p++ = ' ';
7049 else {
7050 /* Drop the space calculated for this
7051 * element that is instead null. */
7052 len--;
7056 *p = '\0';
7057 return Jim_NewStringObjNoAlloc(interp, bytes, len);
7061 /* Returns a list composed of the elements in the specified range.
7062 * first and start are directly accepted as Jim_Objects and
7063 * processed for the end?-index? case. */
7064 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr,
7065 Jim_Obj *lastObjPtr)
7067 int first, last;
7068 int len, rangeLen;
7070 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
7071 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
7072 return NULL;
7073 len = Jim_ListLength(interp, listObjPtr); /* will convert into list */
7074 first = JimRelToAbsIndex(len, first);
7075 last = JimRelToAbsIndex(len, last);
7076 JimRelToAbsRange(len, &first, &last, &rangeLen);
7077 if (first == 0 && last == len) {
7078 return listObjPtr;
7080 return Jim_NewListObj(interp, listObjPtr->internalRep.listValue.ele + first, rangeLen);
7083 /* -----------------------------------------------------------------------------
7084 * Dict object
7085 * ---------------------------------------------------------------------------*/
7086 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
7087 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
7088 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
7089 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7091 /* Dict HashTable Type.
7093 * Keys and Values are Jim objects. */
7095 static unsigned int JimObjectHTHashFunction(const void *key)
7097 int len;
7098 const char *str = Jim_GetString((Jim_Obj *)key, &len);
7099 return Jim_GenHashFunction((const unsigned char *)str, len);
7102 static int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
7104 return Jim_StringEqObj((Jim_Obj *)key1, (Jim_Obj *)key2);
7107 static void *JimObjectHTKeyValDup(void *privdata, const void *val)
7109 Jim_IncrRefCount((Jim_Obj *)val);
7110 return (void *)val;
7113 static void JimObjectHTKeyValDestructor(void *interp, void *val)
7115 Jim_DecrRefCount(interp, (Jim_Obj *)val);
7118 static const Jim_HashTableType JimDictHashTableType = {
7119 JimObjectHTHashFunction, /* hash function */
7120 JimObjectHTKeyValDup, /* key dup */
7121 JimObjectHTKeyValDup, /* val dup */
7122 JimObjectHTKeyCompare, /* key compare */
7123 JimObjectHTKeyValDestructor, /* key destructor */
7124 JimObjectHTKeyValDestructor /* val destructor */
7127 /* Note that while the elements of the dict may contain references,
7128 * the list object itself can't. This basically means that the
7129 * dict object string representation as a whole can't contain references
7130 * that are not presents in the single elements. */
7131 static const Jim_ObjType dictObjType = {
7132 "dict",
7133 FreeDictInternalRep,
7134 DupDictInternalRep,
7135 UpdateStringOfDict,
7136 JIM_TYPE_NONE,
7139 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
7141 JIM_NOTUSED(interp);
7143 Jim_FreeHashTable(objPtr->internalRep.ptr);
7144 Jim_Free(objPtr->internalRep.ptr);
7147 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
7149 Jim_HashTable *ht, *dupHt;
7150 Jim_HashTableIterator htiter;
7151 Jim_HashEntry *he;
7153 /* Create a new hash table */
7154 ht = srcPtr->internalRep.ptr;
7155 dupHt = Jim_Alloc(sizeof(*dupHt));
7156 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
7157 if (ht->size != 0)
7158 Jim_ExpandHashTable(dupHt, ht->size);
7159 /* Copy every element from the source to the dup hash table */
7160 JimInitHashTableIterator(ht, &htiter);
7161 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7162 Jim_AddHashEntry(dupHt, he->key, he->u.val);
7165 dupPtr->internalRep.ptr = dupHt;
7166 dupPtr->typePtr = &dictObjType;
7169 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len)
7171 Jim_HashTable *ht;
7172 Jim_HashTableIterator htiter;
7173 Jim_HashEntry *he;
7174 Jim_Obj **objv;
7175 int i;
7177 ht = dictPtr->internalRep.ptr;
7179 /* Turn the hash table into a flat vector of Jim_Objects. */
7180 objv = Jim_Alloc((ht->used * 2) * sizeof(Jim_Obj *));
7181 JimInitHashTableIterator(ht, &htiter);
7182 i = 0;
7183 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7184 objv[i++] = Jim_GetHashEntryKey(he);
7185 objv[i++] = Jim_GetHashEntryVal(he);
7187 *len = i;
7188 return objv;
7191 static void UpdateStringOfDict(struct Jim_Obj *objPtr)
7193 /* Turn the hash table into a flat vector of Jim_Objects. */
7194 int len;
7195 Jim_Obj **objv = JimDictPairs(objPtr, &len);
7197 /* And now generate the string rep as a list */
7198 JimMakeListStringRep(objPtr, objv, len);
7200 Jim_Free(objv);
7203 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
7205 int listlen;
7207 if (objPtr->typePtr == &dictObjType) {
7208 return JIM_OK;
7211 if (Jim_IsList(objPtr) && Jim_IsShared(objPtr)) {
7212 /* A shared list, so get the string representation now to avoid
7213 * changing the order in case of fast conversion to dict.
7215 Jim_String(objPtr);
7218 /* For simplicity, convert a non-list object to a list and then to a dict */
7219 listlen = Jim_ListLength(interp, objPtr);
7220 if (listlen % 2) {
7221 Jim_SetResultString(interp, "missing value to go with key", -1);
7222 return JIM_ERR;
7224 else {
7225 /* Converting from a list to a dict can't fail */
7226 Jim_HashTable *ht;
7227 int i;
7229 ht = Jim_Alloc(sizeof(*ht));
7230 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
7232 for (i = 0; i < listlen; i += 2) {
7233 Jim_Obj *keyObjPtr = Jim_ListGetIndex(interp, objPtr, i);
7234 Jim_Obj *valObjPtr = Jim_ListGetIndex(interp, objPtr, i + 1);
7236 Jim_ReplaceHashEntry(ht, keyObjPtr, valObjPtr);
7239 Jim_FreeIntRep(interp, objPtr);
7240 objPtr->typePtr = &dictObjType;
7241 objPtr->internalRep.ptr = ht;
7243 return JIM_OK;
7247 /* Dict object API */
7249 /* Add an element to a dict. objPtr must be of the "dict" type.
7250 * The higher-level exported function is Jim_DictAddElement().
7251 * If an element with the specified key already exists, the value
7252 * associated is replaced with the new one.
7254 * if valueObjPtr == NULL, the key is instead removed if it exists. */
7255 static int DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7256 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7258 Jim_HashTable *ht = objPtr->internalRep.ptr;
7260 if (valueObjPtr == NULL) { /* unset */
7261 return Jim_DeleteHashEntry(ht, keyObjPtr);
7263 Jim_ReplaceHashEntry(ht, keyObjPtr, valueObjPtr);
7264 return JIM_OK;
7267 /* Add an element, higher-level interface for DictAddElement().
7268 * If valueObjPtr == NULL, the key is removed if it exists. */
7269 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7270 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7272 JimPanic((Jim_IsShared(objPtr), "Jim_DictAddElement called with shared object"));
7273 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
7274 return JIM_ERR;
7276 Jim_InvalidateStringRep(objPtr);
7277 return DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
7280 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
7282 Jim_Obj *objPtr;
7283 int i;
7285 JimPanic((len % 2, "Jim_NewDictObj() 'len' argument must be even"));
7287 objPtr = Jim_NewObj(interp);
7288 objPtr->typePtr = &dictObjType;
7289 objPtr->bytes = NULL;
7290 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
7291 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
7292 for (i = 0; i < len; i += 2)
7293 DictAddElement(interp, objPtr, elements[i], elements[i + 1]);
7294 return objPtr;
7297 /* Return the value associated to the specified dict key
7298 * Returns JIM_OK if OK, JIM_ERR if entry not found or -1 if can't create dict value
7300 * Sets *objPtrPtr to non-NULL only upon success.
7302 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
7303 Jim_Obj **objPtrPtr, int flags)
7305 Jim_HashEntry *he;
7306 Jim_HashTable *ht;
7308 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7309 return -1;
7311 ht = dictPtr->internalRep.ptr;
7312 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
7313 if (flags & JIM_ERRMSG) {
7314 Jim_SetResultFormatted(interp, "key \"%#s\" not known in dictionary", keyPtr);
7316 return JIM_ERR;
7318 else {
7319 *objPtrPtr = Jim_GetHashEntryVal(he);
7320 return JIM_OK;
7324 /* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */
7325 int Jim_DictPairs(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj ***objPtrPtr, int *len)
7327 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7328 return JIM_ERR;
7330 *objPtrPtr = JimDictPairs(dictPtr, len);
7332 return JIM_OK;
7336 /* Return the value associated to the specified dict keys */
7337 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
7338 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
7340 int i;
7342 if (keyc == 0) {
7343 *objPtrPtr = dictPtr;
7344 return JIM_OK;
7347 for (i = 0; i < keyc; i++) {
7348 Jim_Obj *objPtr;
7350 int rc = Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags);
7351 if (rc != JIM_OK) {
7352 return rc;
7354 dictPtr = objPtr;
7356 *objPtrPtr = dictPtr;
7357 return JIM_OK;
7360 /* Modify the dict stored into the variable named 'varNamePtr'
7361 * setting the element specified by the 'keyc' keys objects in 'keyv',
7362 * with the new value of the element 'newObjPtr'.
7364 * If newObjPtr == NULL the operation is to remove the given key
7365 * from the dictionary.
7367 * If flags & JIM_ERRMSG, then failure to remove the key is considered an error
7368 * and JIM_ERR is returned. Otherwise it is ignored and JIM_OK is returned.
7370 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
7371 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr, int flags)
7373 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
7374 int shared, i;
7376 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, flags);
7377 if (objPtr == NULL) {
7378 if (newObjPtr == NULL && (flags & JIM_MUSTEXIST)) {
7379 /* Cannot remove a key from non existing var */
7380 return JIM_ERR;
7382 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
7383 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
7384 Jim_FreeNewObj(interp, varObjPtr);
7385 return JIM_ERR;
7388 if ((shared = Jim_IsShared(objPtr)))
7389 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
7390 for (i = 0; i < keyc; i++) {
7391 dictObjPtr = objPtr;
7393 /* Check if it's a valid dictionary */
7394 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK) {
7395 goto err;
7398 if (i == keyc - 1) {
7399 /* Last key: Note that error on unset with missing last key is OK */
7400 if (Jim_DictAddElement(interp, objPtr, keyv[keyc - 1], newObjPtr) != JIM_OK) {
7401 if (newObjPtr || (flags & JIM_MUSTEXIST)) {
7402 goto err;
7405 break;
7408 /* Check if the given key exists. */
7409 Jim_InvalidateStringRep(dictObjPtr);
7410 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
7411 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK) {
7412 /* This key exists at the current level.
7413 * Make sure it's not shared!. */
7414 if (Jim_IsShared(objPtr)) {
7415 objPtr = Jim_DuplicateObj(interp, objPtr);
7416 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7419 else {
7420 /* Key not found. If it's an [unset] operation
7421 * this is an error. Only the last key may not
7422 * exist. */
7423 if (newObjPtr == NULL) {
7424 goto err;
7426 /* Otherwise set an empty dictionary
7427 * as key's value. */
7428 objPtr = Jim_NewDictObj(interp, NULL, 0);
7429 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7432 /* XXX: Is this necessary? */
7433 Jim_InvalidateStringRep(objPtr);
7434 Jim_InvalidateStringRep(varObjPtr);
7435 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK) {
7436 goto err;
7438 Jim_SetResult(interp, varObjPtr);
7439 return JIM_OK;
7440 err:
7441 if (shared) {
7442 Jim_FreeNewObj(interp, varObjPtr);
7444 return JIM_ERR;
7447 /* -----------------------------------------------------------------------------
7448 * Index object
7449 * ---------------------------------------------------------------------------*/
7450 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
7451 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7453 static const Jim_ObjType indexObjType = {
7454 "index",
7455 NULL,
7456 NULL,
7457 UpdateStringOfIndex,
7458 JIM_TYPE_NONE,
7461 static void UpdateStringOfIndex(struct Jim_Obj *objPtr)
7463 if (objPtr->internalRep.intValue == -1) {
7464 JimSetStringBytes(objPtr, "end");
7466 else {
7467 char buf[JIM_INTEGER_SPACE + 1];
7468 if (objPtr->internalRep.intValue >= 0) {
7469 sprintf(buf, "%d", objPtr->internalRep.intValue);
7471 else {
7472 /* Must be <= -2 */
7473 sprintf(buf, "end%d", objPtr->internalRep.intValue + 1);
7475 JimSetStringBytes(objPtr, buf);
7479 static int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7481 int idx, end = 0;
7482 const char *str;
7483 char *endptr;
7485 /* Get the string representation */
7486 str = Jim_String(objPtr);
7488 /* Try to convert into an index */
7489 if (strncmp(str, "end", 3) == 0) {
7490 end = 1;
7491 str += 3;
7492 idx = 0;
7494 else {
7495 idx = jim_strtol(str, &endptr);
7497 if (endptr == str) {
7498 goto badindex;
7500 str = endptr;
7503 /* Now str may include or +<num> or -<num> */
7504 if (*str == '+' || *str == '-') {
7505 int sign = (*str == '+' ? 1 : -1);
7507 idx += sign * jim_strtol(++str, &endptr);
7508 if (str == endptr || *endptr) {
7509 goto badindex;
7511 str = endptr;
7513 /* The only thing left should be spaces */
7514 while (isspace(UCHAR(*str))) {
7515 str++;
7517 if (*str) {
7518 goto badindex;
7520 if (end) {
7521 if (idx > 0) {
7522 idx = INT_MAX;
7524 else {
7525 /* end-1 is repesented as -2 */
7526 idx--;
7529 else if (idx < 0) {
7530 idx = -INT_MAX;
7533 /* Free the old internal repr and set the new one. */
7534 Jim_FreeIntRep(interp, objPtr);
7535 objPtr->typePtr = &indexObjType;
7536 objPtr->internalRep.intValue = idx;
7537 return JIM_OK;
7539 badindex:
7540 Jim_SetResultFormatted(interp,
7541 "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr);
7542 return JIM_ERR;
7545 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
7547 /* Avoid shimmering if the object is an integer. */
7548 if (objPtr->typePtr == &intObjType) {
7549 jim_wide val = JimWideValue(objPtr);
7551 if (val < 0)
7552 *indexPtr = -INT_MAX;
7553 else if (val > INT_MAX)
7554 *indexPtr = INT_MAX;
7555 else
7556 *indexPtr = (int)val;
7557 return JIM_OK;
7559 if (objPtr->typePtr != &indexObjType && SetIndexFromAny(interp, objPtr) == JIM_ERR)
7560 return JIM_ERR;
7561 *indexPtr = objPtr->internalRep.intValue;
7562 return JIM_OK;
7565 /* -----------------------------------------------------------------------------
7566 * Return Code Object.
7567 * ---------------------------------------------------------------------------*/
7569 /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
7570 static const char * const jimReturnCodes[] = {
7571 "ok",
7572 "error",
7573 "return",
7574 "break",
7575 "continue",
7576 "signal",
7577 "exit",
7578 "eval",
7579 NULL
7582 #define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes) - 1)
7584 static const Jim_ObjType returnCodeObjType = {
7585 "return-code",
7586 NULL,
7587 NULL,
7588 NULL,
7589 JIM_TYPE_NONE,
7592 /* Converts a (standard) return code to a string. Returns "?" for
7593 * non-standard return codes.
7595 const char *Jim_ReturnCode(int code)
7597 if (code < 0 || code >= (int)jimReturnCodesSize) {
7598 return "?";
7600 else {
7601 return jimReturnCodes[code];
7605 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7607 int returnCode;
7608 jim_wide wideValue;
7610 /* Try to convert into an integer */
7611 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
7612 returnCode = (int)wideValue;
7613 else if (Jim_GetEnum(interp, objPtr, jimReturnCodes, &returnCode, NULL, JIM_NONE) != JIM_OK) {
7614 Jim_SetResultFormatted(interp, "expected return code but got \"%#s\"", objPtr);
7615 return JIM_ERR;
7617 /* Free the old internal repr and set the new one. */
7618 Jim_FreeIntRep(interp, objPtr);
7619 objPtr->typePtr = &returnCodeObjType;
7620 objPtr->internalRep.intValue = returnCode;
7621 return JIM_OK;
7624 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
7626 if (objPtr->typePtr != &returnCodeObjType && SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
7627 return JIM_ERR;
7628 *intPtr = objPtr->internalRep.intValue;
7629 return JIM_OK;
7632 /* -----------------------------------------------------------------------------
7633 * Expression Parsing
7634 * ---------------------------------------------------------------------------*/
7635 static int JimParseExprOperator(struct JimParserCtx *pc);
7636 static int JimParseExprNumber(struct JimParserCtx *pc);
7637 static int JimParseExprIrrational(struct JimParserCtx *pc);
7638 static int JimParseExprBoolean(struct JimParserCtx *pc);
7640 /* expr operator opcodes. */
7641 enum
7643 /* Continues on from the JIM_TT_ space */
7645 /* Binary operators (numbers) */
7646 JIM_EXPROP_MUL = JIM_TT_EXPR_OP, /* 20 */
7647 JIM_EXPROP_DIV,
7648 JIM_EXPROP_MOD,
7649 JIM_EXPROP_SUB,
7650 JIM_EXPROP_ADD,
7651 JIM_EXPROP_LSHIFT,
7652 JIM_EXPROP_RSHIFT,
7653 JIM_EXPROP_ROTL,
7654 JIM_EXPROP_ROTR,
7655 JIM_EXPROP_LT,
7656 JIM_EXPROP_GT,
7657 JIM_EXPROP_LTE,
7658 JIM_EXPROP_GTE,
7659 JIM_EXPROP_NUMEQ,
7660 JIM_EXPROP_NUMNE,
7661 JIM_EXPROP_BITAND, /* 35 */
7662 JIM_EXPROP_BITXOR,
7663 JIM_EXPROP_BITOR,
7664 JIM_EXPROP_LOGICAND, /* 38 */
7665 JIM_EXPROP_LOGICOR, /* 39 */
7666 JIM_EXPROP_TERNARY, /* 40 */
7667 JIM_EXPROP_COLON, /* 41 */
7668 JIM_EXPROP_POW, /* 42 */
7670 /* Binary operators (strings) */
7671 JIM_EXPROP_STREQ, /* 43 */
7672 JIM_EXPROP_STRNE,
7673 JIM_EXPROP_STRIN,
7674 JIM_EXPROP_STRNI,
7676 /* Unary operators (numbers) */
7677 JIM_EXPROP_NOT, /* 47 */
7678 JIM_EXPROP_BITNOT,
7679 JIM_EXPROP_UNARYMINUS,
7680 JIM_EXPROP_UNARYPLUS,
7682 /* Functions */
7683 JIM_EXPROP_FUNC_INT, /* 51 */
7684 JIM_EXPROP_FUNC_WIDE,
7685 JIM_EXPROP_FUNC_ABS,
7686 JIM_EXPROP_FUNC_DOUBLE,
7687 JIM_EXPROP_FUNC_ROUND,
7688 JIM_EXPROP_FUNC_RAND,
7689 JIM_EXPROP_FUNC_SRAND,
7691 /* math functions from libm */
7692 JIM_EXPROP_FUNC_SIN, /* 65 */
7693 JIM_EXPROP_FUNC_COS,
7694 JIM_EXPROP_FUNC_TAN,
7695 JIM_EXPROP_FUNC_ASIN,
7696 JIM_EXPROP_FUNC_ACOS,
7697 JIM_EXPROP_FUNC_ATAN,
7698 JIM_EXPROP_FUNC_ATAN2,
7699 JIM_EXPROP_FUNC_SINH,
7700 JIM_EXPROP_FUNC_COSH,
7701 JIM_EXPROP_FUNC_TANH,
7702 JIM_EXPROP_FUNC_CEIL,
7703 JIM_EXPROP_FUNC_FLOOR,
7704 JIM_EXPROP_FUNC_EXP,
7705 JIM_EXPROP_FUNC_LOG,
7706 JIM_EXPROP_FUNC_LOG10,
7707 JIM_EXPROP_FUNC_SQRT,
7708 JIM_EXPROP_FUNC_POW,
7709 JIM_EXPROP_FUNC_HYPOT,
7710 JIM_EXPROP_FUNC_FMOD,
7713 /* A expression node is either a term or an operator
7714 * If a node is an operator, 'op' points to the details of the operator and it's terms.
7716 struct JimExprNode {
7717 int type; /* JIM_TT_xxx */
7718 struct Jim_Obj *objPtr; /* The object for a term, or NULL for an operator */
7720 struct JimExprNode *left; /* For all operators */
7721 struct JimExprNode *right; /* For binary operators */
7722 struct JimExprNode *ternary; /* For ternary operator only */
7725 /* Operators table */
7726 typedef struct Jim_ExprOperator
7728 const char *name;
7729 int (*funcop) (Jim_Interp *interp, struct JimExprNode *opnode);
7730 unsigned char precedence;
7731 unsigned char arity;
7732 unsigned char attr;
7733 unsigned char namelen;
7734 } Jim_ExprOperator;
7736 static int JimExprGetTerm(Jim_Interp *interp, struct JimExprNode *node, Jim_Obj **objPtrPtr);
7737 static int JimExprGetTermBoolean(Jim_Interp *interp, struct JimExprNode *node);
7738 static int JimExprEvalTermNode(Jim_Interp *interp, struct JimExprNode *node);
7740 static int JimExprOpNumUnary(Jim_Interp *interp, struct JimExprNode *node)
7742 int intresult = 1;
7743 int rc;
7744 double dA, dC = 0;
7745 jim_wide wA, wC = 0;
7746 Jim_Obj *A;
7748 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7749 return rc;
7752 if ((A->typePtr != &doubleObjType || A->bytes) && JimGetWideNoErr(interp, A, &wA) == JIM_OK) {
7753 switch (node->type) {
7754 case JIM_EXPROP_FUNC_INT:
7755 case JIM_EXPROP_FUNC_WIDE:
7756 case JIM_EXPROP_FUNC_ROUND:
7757 case JIM_EXPROP_UNARYPLUS:
7758 wC = wA;
7759 break;
7760 case JIM_EXPROP_FUNC_DOUBLE:
7761 dC = wA;
7762 intresult = 0;
7763 break;
7764 case JIM_EXPROP_FUNC_ABS:
7765 wC = wA >= 0 ? wA : -wA;
7766 break;
7767 case JIM_EXPROP_UNARYMINUS:
7768 wC = -wA;
7769 break;
7770 case JIM_EXPROP_NOT:
7771 wC = !wA;
7772 break;
7773 default:
7774 abort();
7777 else if ((rc = Jim_GetDouble(interp, A, &dA)) == JIM_OK) {
7778 switch (node->type) {
7779 case JIM_EXPROP_FUNC_INT:
7780 case JIM_EXPROP_FUNC_WIDE:
7781 wC = dA;
7782 break;
7783 case JIM_EXPROP_FUNC_ROUND:
7784 wC = dA < 0 ? (dA - 0.5) : (dA + 0.5);
7785 break;
7786 case JIM_EXPROP_FUNC_DOUBLE:
7787 case JIM_EXPROP_UNARYPLUS:
7788 dC = dA;
7789 intresult = 0;
7790 break;
7791 case JIM_EXPROP_FUNC_ABS:
7792 #ifdef JIM_MATH_FUNCTIONS
7793 dC = fabs(dA);
7794 #else
7795 dC = dA >= 0 ? dA : -dA;
7796 #endif
7797 intresult = 0;
7798 break;
7799 case JIM_EXPROP_UNARYMINUS:
7800 dC = -dA;
7801 intresult = 0;
7802 break;
7803 case JIM_EXPROP_NOT:
7804 wC = !dA;
7805 break;
7806 default:
7807 abort();
7811 if (rc == JIM_OK) {
7812 if (intresult) {
7813 Jim_SetResultInt(interp, wC);
7815 else {
7816 Jim_SetResult(interp, Jim_NewDoubleObj(interp, dC));
7820 Jim_DecrRefCount(interp, A);
7822 return rc;
7825 static double JimRandDouble(Jim_Interp *interp)
7827 unsigned long x;
7828 JimRandomBytes(interp, &x, sizeof(x));
7830 return (double)x / (unsigned long)~0;
7833 static int JimExprOpIntUnary(Jim_Interp *interp, struct JimExprNode *node)
7835 jim_wide wA;
7836 Jim_Obj *A;
7837 int rc;
7839 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7840 return rc;
7843 rc = Jim_GetWide(interp, A, &wA);
7844 if (rc == JIM_OK) {
7845 switch (node->type) {
7846 case JIM_EXPROP_BITNOT:
7847 Jim_SetResultInt(interp, ~wA);
7848 break;
7849 case JIM_EXPROP_FUNC_SRAND:
7850 JimPrngSeed(interp, (unsigned char *)&wA, sizeof(wA));
7851 Jim_SetResult(interp, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7852 break;
7853 default:
7854 abort();
7858 Jim_DecrRefCount(interp, A);
7860 return rc;
7863 static int JimExprOpNone(Jim_Interp *interp, struct JimExprNode *node)
7865 JimPanic((node->type != JIM_EXPROP_FUNC_RAND, "JimExprOpNone only support rand()"));
7867 Jim_SetResult(interp, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7869 return JIM_OK;
7872 #ifdef JIM_MATH_FUNCTIONS
7873 static int JimExprOpDoubleUnary(Jim_Interp *interp, struct JimExprNode *node)
7875 int rc;
7876 double dA, dC;
7877 Jim_Obj *A;
7879 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7880 return rc;
7883 rc = Jim_GetDouble(interp, A, &dA);
7884 if (rc == JIM_OK) {
7885 switch (node->type) {
7886 case JIM_EXPROP_FUNC_SIN:
7887 dC = sin(dA);
7888 break;
7889 case JIM_EXPROP_FUNC_COS:
7890 dC = cos(dA);
7891 break;
7892 case JIM_EXPROP_FUNC_TAN:
7893 dC = tan(dA);
7894 break;
7895 case JIM_EXPROP_FUNC_ASIN:
7896 dC = asin(dA);
7897 break;
7898 case JIM_EXPROP_FUNC_ACOS:
7899 dC = acos(dA);
7900 break;
7901 case JIM_EXPROP_FUNC_ATAN:
7902 dC = atan(dA);
7903 break;
7904 case JIM_EXPROP_FUNC_SINH:
7905 dC = sinh(dA);
7906 break;
7907 case JIM_EXPROP_FUNC_COSH:
7908 dC = cosh(dA);
7909 break;
7910 case JIM_EXPROP_FUNC_TANH:
7911 dC = tanh(dA);
7912 break;
7913 case JIM_EXPROP_FUNC_CEIL:
7914 dC = ceil(dA);
7915 break;
7916 case JIM_EXPROP_FUNC_FLOOR:
7917 dC = floor(dA);
7918 break;
7919 case JIM_EXPROP_FUNC_EXP:
7920 dC = exp(dA);
7921 break;
7922 case JIM_EXPROP_FUNC_LOG:
7923 dC = log(dA);
7924 break;
7925 case JIM_EXPROP_FUNC_LOG10:
7926 dC = log10(dA);
7927 break;
7928 case JIM_EXPROP_FUNC_SQRT:
7929 dC = sqrt(dA);
7930 break;
7931 default:
7932 abort();
7934 Jim_SetResult(interp, Jim_NewDoubleObj(interp, dC));
7937 Jim_DecrRefCount(interp, A);
7939 return rc;
7941 #endif
7943 /* A binary operation on two ints */
7944 static int JimExprOpIntBin(Jim_Interp *interp, struct JimExprNode *node)
7946 jim_wide wA, wB;
7947 int rc;
7948 Jim_Obj *A, *B;
7950 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7951 return rc;
7953 if ((rc = JimExprGetTerm(interp, node->right, &B)) != JIM_OK) {
7954 Jim_DecrRefCount(interp, A);
7955 return rc;
7958 rc = JIM_ERR;
7960 if (Jim_GetWide(interp, A, &wA) == JIM_OK && Jim_GetWide(interp, B, &wB) == JIM_OK) {
7961 jim_wide wC;
7963 rc = JIM_OK;
7965 switch (node->type) {
7966 case JIM_EXPROP_LSHIFT:
7967 wC = wA << wB;
7968 break;
7969 case JIM_EXPROP_RSHIFT:
7970 wC = wA >> wB;
7971 break;
7972 case JIM_EXPROP_BITAND:
7973 wC = wA & wB;
7974 break;
7975 case JIM_EXPROP_BITXOR:
7976 wC = wA ^ wB;
7977 break;
7978 case JIM_EXPROP_BITOR:
7979 wC = wA | wB;
7980 break;
7981 case JIM_EXPROP_MOD:
7982 if (wB == 0) {
7983 wC = 0;
7984 Jim_SetResultString(interp, "Division by zero", -1);
7985 rc = JIM_ERR;
7987 else {
7989 * From Tcl 8.x
7991 * This code is tricky: C doesn't guarantee much
7992 * about the quotient or remainder, but Tcl does.
7993 * The remainder always has the same sign as the
7994 * divisor and a smaller absolute value.
7996 int negative = 0;
7998 if (wB < 0) {
7999 wB = -wB;
8000 wA = -wA;
8001 negative = 1;
8003 wC = wA % wB;
8004 if (wC < 0) {
8005 wC += wB;
8007 if (negative) {
8008 wC = -wC;
8011 break;
8012 case JIM_EXPROP_ROTL:
8013 case JIM_EXPROP_ROTR:{
8014 /* uint32_t would be better. But not everyone has inttypes.h? */
8015 unsigned long uA = (unsigned long)wA;
8016 unsigned long uB = (unsigned long)wB;
8017 const unsigned int S = sizeof(unsigned long) * 8;
8019 /* Shift left by the word size or more is undefined. */
8020 uB %= S;
8022 if (node->type == JIM_EXPROP_ROTR) {
8023 uB = S - uB;
8025 wC = (unsigned long)(uA << uB) | (uA >> (S - uB));
8026 break;
8028 default:
8029 abort();
8031 Jim_SetResultInt(interp, wC);
8034 Jim_DecrRefCount(interp, A);
8035 Jim_DecrRefCount(interp, B);
8037 return rc;
8041 /* A binary operation on two ints or two doubles (or two strings for some ops) */
8042 static int JimExprOpBin(Jim_Interp *interp, struct JimExprNode *node)
8044 int rc = JIM_OK;
8045 double dA, dB, dC = 0;
8046 jim_wide wA, wB, wC = 0;
8047 Jim_Obj *A, *B;
8049 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
8050 return rc;
8052 if ((rc = JimExprGetTerm(interp, node->right, &B)) != JIM_OK) {
8053 Jim_DecrRefCount(interp, A);
8054 return rc;
8057 if ((A->typePtr != &doubleObjType || A->bytes) &&
8058 (B->typePtr != &doubleObjType || B->bytes) &&
8059 JimGetWideNoErr(interp, A, &wA) == JIM_OK && JimGetWideNoErr(interp, B, &wB) == JIM_OK) {
8061 /* Both are ints */
8063 switch (node->type) {
8064 case JIM_EXPROP_POW:
8065 case JIM_EXPROP_FUNC_POW:
8066 if (wA == 0 && wB < 0) {
8067 Jim_SetResultString(interp, "exponentiation of zero by negative power", -1);
8068 rc = JIM_ERR;
8069 goto done;
8071 wC = JimPowWide(wA, wB);
8072 goto intresult;
8073 case JIM_EXPROP_ADD:
8074 wC = wA + wB;
8075 goto intresult;
8076 case JIM_EXPROP_SUB:
8077 wC = wA - wB;
8078 goto intresult;
8079 case JIM_EXPROP_MUL:
8080 wC = wA * wB;
8081 goto intresult;
8082 case JIM_EXPROP_DIV:
8083 if (wB == 0) {
8084 Jim_SetResultString(interp, "Division by zero", -1);
8085 rc = JIM_ERR;
8086 goto done;
8088 else {
8090 * From Tcl 8.x
8092 * This code is tricky: C doesn't guarantee much
8093 * about the quotient or remainder, but Tcl does.
8094 * The remainder always has the same sign as the
8095 * divisor and a smaller absolute value.
8097 if (wB < 0) {
8098 wB = -wB;
8099 wA = -wA;
8101 wC = wA / wB;
8102 if (wA % wB < 0) {
8103 wC--;
8105 goto intresult;
8107 case JIM_EXPROP_LT:
8108 wC = wA < wB;
8109 goto intresult;
8110 case JIM_EXPROP_GT:
8111 wC = wA > wB;
8112 goto intresult;
8113 case JIM_EXPROP_LTE:
8114 wC = wA <= wB;
8115 goto intresult;
8116 case JIM_EXPROP_GTE:
8117 wC = wA >= wB;
8118 goto intresult;
8119 case JIM_EXPROP_NUMEQ:
8120 wC = wA == wB;
8121 goto intresult;
8122 case JIM_EXPROP_NUMNE:
8123 wC = wA != wB;
8124 goto intresult;
8127 if (Jim_GetDouble(interp, A, &dA) == JIM_OK && Jim_GetDouble(interp, B, &dB) == JIM_OK) {
8128 switch (node->type) {
8129 #ifndef JIM_MATH_FUNCTIONS
8130 case JIM_EXPROP_POW:
8131 case JIM_EXPROP_FUNC_POW:
8132 case JIM_EXPROP_FUNC_ATAN2:
8133 case JIM_EXPROP_FUNC_HYPOT:
8134 case JIM_EXPROP_FUNC_FMOD:
8135 Jim_SetResultString(interp, "unsupported", -1);
8136 rc = JIM_ERR;
8137 goto done;
8138 #else
8139 case JIM_EXPROP_POW:
8140 case JIM_EXPROP_FUNC_POW:
8141 dC = pow(dA, dB);
8142 goto doubleresult;
8143 case JIM_EXPROP_FUNC_ATAN2:
8144 dC = atan2(dA, dB);
8145 goto doubleresult;
8146 case JIM_EXPROP_FUNC_HYPOT:
8147 dC = hypot(dA, dB);
8148 goto doubleresult;
8149 case JIM_EXPROP_FUNC_FMOD:
8150 dC = fmod(dA, dB);
8151 goto doubleresult;
8152 #endif
8153 case JIM_EXPROP_ADD:
8154 dC = dA + dB;
8155 goto doubleresult;
8156 case JIM_EXPROP_SUB:
8157 dC = dA - dB;
8158 goto doubleresult;
8159 case JIM_EXPROP_MUL:
8160 dC = dA * dB;
8161 goto doubleresult;
8162 case JIM_EXPROP_DIV:
8163 if (dB == 0) {
8164 #ifdef INFINITY
8165 dC = dA < 0 ? -INFINITY : INFINITY;
8166 #else
8167 dC = (dA < 0 ? -1.0 : 1.0) * strtod("Inf", NULL);
8168 #endif
8170 else {
8171 dC = dA / dB;
8173 goto doubleresult;
8174 case JIM_EXPROP_LT:
8175 wC = dA < dB;
8176 goto intresult;
8177 case JIM_EXPROP_GT:
8178 wC = dA > dB;
8179 goto intresult;
8180 case JIM_EXPROP_LTE:
8181 wC = dA <= dB;
8182 goto intresult;
8183 case JIM_EXPROP_GTE:
8184 wC = dA >= dB;
8185 goto intresult;
8186 case JIM_EXPROP_NUMEQ:
8187 wC = dA == dB;
8188 goto intresult;
8189 case JIM_EXPROP_NUMNE:
8190 wC = dA != dB;
8191 goto intresult;
8194 else {
8195 /* Handle the string case */
8197 /* XXX: Could optimise the eq/ne case by checking lengths */
8198 int i = Jim_StringCompareObj(interp, A, B, 0);
8200 switch (node->type) {
8201 case JIM_EXPROP_LT:
8202 wC = i < 0;
8203 goto intresult;
8204 case JIM_EXPROP_GT:
8205 wC = i > 0;
8206 goto intresult;
8207 case JIM_EXPROP_LTE:
8208 wC = i <= 0;
8209 goto intresult;
8210 case JIM_EXPROP_GTE:
8211 wC = i >= 0;
8212 goto intresult;
8213 case JIM_EXPROP_NUMEQ:
8214 wC = i == 0;
8215 goto intresult;
8216 case JIM_EXPROP_NUMNE:
8217 wC = i != 0;
8218 goto intresult;
8221 /* If we get here, it is an error */
8222 rc = JIM_ERR;
8223 done:
8224 Jim_DecrRefCount(interp, A);
8225 Jim_DecrRefCount(interp, B);
8226 return rc;
8227 intresult:
8228 Jim_SetResultInt(interp, wC);
8229 goto done;
8230 doubleresult:
8231 Jim_SetResult(interp, Jim_NewDoubleObj(interp, dC));
8232 goto done;
8235 static int JimSearchList(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *valObj)
8237 int listlen;
8238 int i;
8240 listlen = Jim_ListLength(interp, listObjPtr);
8241 for (i = 0; i < listlen; i++) {
8242 if (Jim_StringEqObj(Jim_ListGetIndex(interp, listObjPtr, i), valObj)) {
8243 return 1;
8246 return 0;
8251 static int JimExprOpStrBin(Jim_Interp *interp, struct JimExprNode *node)
8253 Jim_Obj *A, *B;
8254 jim_wide wC;
8255 int rc;
8257 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
8258 return rc;
8260 if ((rc = JimExprGetTerm(interp, node->right, &B)) != JIM_OK) {
8261 Jim_DecrRefCount(interp, A);
8262 return rc;
8265 switch (node->type) {
8266 case JIM_EXPROP_STREQ:
8267 case JIM_EXPROP_STRNE:
8268 wC = Jim_StringEqObj(A, B);
8269 if (node->type == JIM_EXPROP_STRNE) {
8270 wC = !wC;
8272 break;
8273 case JIM_EXPROP_STRIN:
8274 wC = JimSearchList(interp, B, A);
8275 break;
8276 case JIM_EXPROP_STRNI:
8277 wC = !JimSearchList(interp, B, A);
8278 break;
8279 default:
8280 abort();
8282 Jim_SetResultInt(interp, wC);
8284 Jim_DecrRefCount(interp, A);
8285 Jim_DecrRefCount(interp, B);
8287 return rc;
8290 static int ExprBool(Jim_Interp *interp, Jim_Obj *obj)
8292 long l;
8293 double d;
8294 int b;
8295 int ret = -1;
8297 /* In case the object is interp->result with refcount 1*/
8298 Jim_IncrRefCount(obj);
8300 if (Jim_GetLong(interp, obj, &l) == JIM_OK) {
8301 ret = (l != 0);
8303 else if (Jim_GetDouble(interp, obj, &d) == JIM_OK) {
8304 ret = (d != 0);
8306 else if (Jim_GetBoolean(interp, obj, &b) == JIM_OK) {
8307 ret = (b != 0);
8310 Jim_DecrRefCount(interp, obj);
8311 return ret;
8314 static int JimExprOpAnd(Jim_Interp *interp, struct JimExprNode *node)
8316 /* evaluate left */
8317 int result = JimExprGetTermBoolean(interp, node->left);
8319 if (result == 1) {
8320 /* true so evaluate right */
8321 result = JimExprGetTermBoolean(interp, node->right);
8323 if (result == -1) {
8324 return JIM_ERR;
8326 Jim_SetResultInt(interp, result);
8327 return JIM_OK;
8330 static int JimExprOpOr(Jim_Interp *interp, struct JimExprNode *node)
8332 /* evaluate left */
8333 int result = JimExprGetTermBoolean(interp, node->left);
8335 if (result == 0) {
8336 /* false so evaluate right */
8337 result = JimExprGetTermBoolean(interp, node->right);
8339 if (result == -1) {
8340 return JIM_ERR;
8342 Jim_SetResultInt(interp, result);
8343 return JIM_OK;
8346 static int JimExprOpTernary(Jim_Interp *interp, struct JimExprNode *node)
8348 /* evaluate left */
8349 int result = JimExprGetTermBoolean(interp, node->left);
8351 if (result == 1) {
8352 /* true so select right */
8353 return JimExprEvalTermNode(interp, node->right);
8355 else if (result == 0) {
8356 /* false so select ternary */
8357 return JimExprEvalTermNode(interp, node->ternary);
8359 /* error */
8360 return JIM_ERR;
8363 enum
8365 OP_FUNC = 0x0001, /* function syntax */
8366 OP_RIGHT_ASSOC = 0x0002, /* right associative */
8369 /* name - precedence - arity - opcode
8371 * This array *must* be kept in sync with the JIM_EXPROP enum.
8373 * The following macros pre-compute the string length at compile time.
8375 #define OPRINIT_ATTR(N, P, ARITY, F, ATTR) {N, F, P, ARITY, ATTR, sizeof(N) - 1}
8376 #define OPRINIT(N, P, ARITY, F) OPRINIT_ATTR(N, P, ARITY, F, 0)
8378 static const struct Jim_ExprOperator Jim_ExprOperators[] = {
8379 OPRINIT("*", 110, 2, JimExprOpBin),
8380 OPRINIT("/", 110, 2, JimExprOpBin),
8381 OPRINIT("%", 110, 2, JimExprOpIntBin),
8383 OPRINIT("-", 100, 2, JimExprOpBin),
8384 OPRINIT("+", 100, 2, JimExprOpBin),
8386 OPRINIT("<<", 90, 2, JimExprOpIntBin),
8387 OPRINIT(">>", 90, 2, JimExprOpIntBin),
8389 OPRINIT("<<<", 90, 2, JimExprOpIntBin),
8390 OPRINIT(">>>", 90, 2, JimExprOpIntBin),
8392 OPRINIT("<", 80, 2, JimExprOpBin),
8393 OPRINIT(">", 80, 2, JimExprOpBin),
8394 OPRINIT("<=", 80, 2, JimExprOpBin),
8395 OPRINIT(">=", 80, 2, JimExprOpBin),
8397 OPRINIT("==", 70, 2, JimExprOpBin),
8398 OPRINIT("!=", 70, 2, JimExprOpBin),
8400 OPRINIT("&", 50, 2, JimExprOpIntBin),
8401 OPRINIT("^", 49, 2, JimExprOpIntBin),
8402 OPRINIT("|", 48, 2, JimExprOpIntBin),
8404 OPRINIT("&&", 10, 2, JimExprOpAnd),
8405 OPRINIT("||", 9, 2, JimExprOpOr),
8406 OPRINIT_ATTR("?", 5, 3, JimExprOpTernary, OP_RIGHT_ASSOC),
8407 OPRINIT_ATTR(":", 5, 3, NULL, OP_RIGHT_ASSOC),
8409 /* Precedence is higher than * and / but lower than ! and ~, and right-associative */
8410 OPRINIT_ATTR("**", 120, 2, JimExprOpBin, OP_RIGHT_ASSOC),
8412 OPRINIT("eq", 60, 2, JimExprOpStrBin),
8413 OPRINIT("ne", 60, 2, JimExprOpStrBin),
8415 OPRINIT("in", 55, 2, JimExprOpStrBin),
8416 OPRINIT("ni", 55, 2, JimExprOpStrBin),
8418 OPRINIT_ATTR("!", 150, 1, JimExprOpNumUnary, OP_RIGHT_ASSOC),
8419 OPRINIT_ATTR("~", 150, 1, JimExprOpIntUnary, OP_RIGHT_ASSOC),
8420 OPRINIT_ATTR(" -", 150, 1, JimExprOpNumUnary, OP_RIGHT_ASSOC),
8421 OPRINIT_ATTR(" +", 150, 1, JimExprOpNumUnary, OP_RIGHT_ASSOC),
8425 OPRINIT_ATTR("int", 200, 1, JimExprOpNumUnary, OP_FUNC),
8426 OPRINIT_ATTR("wide", 200, 1, JimExprOpNumUnary, OP_FUNC),
8427 OPRINIT_ATTR("abs", 200, 1, JimExprOpNumUnary, OP_FUNC),
8428 OPRINIT_ATTR("double", 200, 1, JimExprOpNumUnary, OP_FUNC),
8429 OPRINIT_ATTR("round", 200, 1, JimExprOpNumUnary, OP_FUNC),
8430 OPRINIT_ATTR("rand", 200, 0, JimExprOpNone, OP_FUNC),
8431 OPRINIT_ATTR("srand", 200, 1, JimExprOpIntUnary, OP_FUNC),
8433 #ifdef JIM_MATH_FUNCTIONS
8434 OPRINIT_ATTR("sin", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8435 OPRINIT_ATTR("cos", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8436 OPRINIT_ATTR("tan", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8437 OPRINIT_ATTR("asin", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8438 OPRINIT_ATTR("acos", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8439 OPRINIT_ATTR("atan", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8440 OPRINIT_ATTR("atan2", 200, 2, JimExprOpBin, OP_FUNC),
8441 OPRINIT_ATTR("sinh", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8442 OPRINIT_ATTR("cosh", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8443 OPRINIT_ATTR("tanh", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8444 OPRINIT_ATTR("ceil", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8445 OPRINIT_ATTR("floor", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8446 OPRINIT_ATTR("exp", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8447 OPRINIT_ATTR("log", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8448 OPRINIT_ATTR("log10", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8449 OPRINIT_ATTR("sqrt", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8450 OPRINIT_ATTR("pow", 200, 2, JimExprOpBin, OP_FUNC),
8451 OPRINIT_ATTR("hypot", 200, 2, JimExprOpBin, OP_FUNC),
8452 OPRINIT_ATTR("fmod", 200, 2, JimExprOpBin, OP_FUNC),
8453 #endif
8455 #undef OPRINIT
8456 #undef OPRINIT_ATTR
8458 #define JIM_EXPR_OPERATORS_NUM \
8459 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
8461 static int JimParseExpression(struct JimParserCtx *pc)
8463 /* Discard spaces and quoted newline */
8464 while (isspace(UCHAR(*pc->p)) || (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) {
8465 if (*pc->p == '\n') {
8466 pc->linenr++;
8468 pc->p++;
8469 pc->len--;
8472 /* Common case */
8473 pc->tline = pc->linenr;
8474 pc->tstart = pc->p;
8476 if (pc->len == 0) {
8477 pc->tend = pc->p;
8478 pc->tt = JIM_TT_EOL;
8479 pc->eof = 1;
8480 return JIM_OK;
8482 switch (*(pc->p)) {
8483 case '(':
8484 pc->tt = JIM_TT_SUBEXPR_START;
8485 goto singlechar;
8486 case ')':
8487 pc->tt = JIM_TT_SUBEXPR_END;
8488 goto singlechar;
8489 case ',':
8490 pc->tt = JIM_TT_SUBEXPR_COMMA;
8491 singlechar:
8492 pc->tend = pc->p;
8493 pc->p++;
8494 pc->len--;
8495 break;
8496 case '[':
8497 return JimParseCmd(pc);
8498 case '$':
8499 if (JimParseVar(pc) == JIM_ERR)
8500 return JimParseExprOperator(pc);
8501 else {
8502 /* Don't allow expr sugar in expressions */
8503 if (pc->tt == JIM_TT_EXPRSUGAR) {
8504 return JIM_ERR;
8506 return JIM_OK;
8508 break;
8509 case '0':
8510 case '1':
8511 case '2':
8512 case '3':
8513 case '4':
8514 case '5':
8515 case '6':
8516 case '7':
8517 case '8':
8518 case '9':
8519 case '.':
8520 return JimParseExprNumber(pc);
8521 case '"':
8522 return JimParseQuote(pc);
8523 case '{':
8524 return JimParseBrace(pc);
8526 case 'N':
8527 case 'I':
8528 case 'n':
8529 case 'i':
8530 if (JimParseExprIrrational(pc) == JIM_ERR)
8531 if (JimParseExprBoolean(pc) == JIM_ERR)
8532 return JimParseExprOperator(pc);
8533 break;
8534 case 't':
8535 case 'f':
8536 case 'o':
8537 case 'y':
8538 if (JimParseExprBoolean(pc) == JIM_ERR)
8539 return JimParseExprOperator(pc);
8540 break;
8541 default:
8542 return JimParseExprOperator(pc);
8543 break;
8545 return JIM_OK;
8548 static int JimParseExprNumber(struct JimParserCtx *pc)
8550 char *end;
8552 /* Assume an integer for now */
8553 pc->tt = JIM_TT_EXPR_INT;
8555 jim_strtoull(pc->p, (char **)&pc->p);
8556 /* Tried as an integer, but perhaps it parses as a double */
8557 if (strchr("eENnIi.", *pc->p) || pc->p == pc->tstart) {
8558 /* Some stupid compilers insist they are cleverer that
8559 * we are. Even a (void) cast doesn't prevent this warning!
8561 if (strtod(pc->tstart, &end)) { /* nothing */ }
8562 if (end == pc->tstart)
8563 return JIM_ERR;
8564 if (end > pc->p) {
8565 /* Yes, double captured more chars */
8566 pc->tt = JIM_TT_EXPR_DOUBLE;
8567 pc->p = end;
8570 pc->tend = pc->p - 1;
8571 pc->len -= (pc->p - pc->tstart);
8572 return JIM_OK;
8575 static int JimParseExprIrrational(struct JimParserCtx *pc)
8577 const char *irrationals[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL };
8578 int i;
8580 for (i = 0; irrationals[i]; i++) {
8581 const char *irr = irrationals[i];
8583 if (strncmp(irr, pc->p, 3) == 0) {
8584 pc->p += 3;
8585 pc->len -= 3;
8586 pc->tend = pc->p - 1;
8587 pc->tt = JIM_TT_EXPR_DOUBLE;
8588 return JIM_OK;
8591 return JIM_ERR;
8594 static int JimParseExprBoolean(struct JimParserCtx *pc)
8596 const char *booleans[] = { "false", "no", "off", "true", "yes", "on", NULL };
8597 const int lengths[] = { 5, 2, 3, 4, 3, 2, 0 };
8598 int i;
8600 for (i = 0; booleans[i]; i++) {
8601 const char *boolean = booleans[i];
8602 int length = lengths[i];
8604 if (strncmp(boolean, pc->p, length) == 0) {
8605 pc->p += length;
8606 pc->len -= length;
8607 pc->tend = pc->p - 1;
8608 pc->tt = JIM_TT_EXPR_BOOLEAN;
8609 return JIM_OK;
8612 return JIM_ERR;
8615 static const struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
8617 static Jim_ExprOperator dummy_op;
8618 if (opcode < JIM_TT_EXPR_OP) {
8619 return &dummy_op;
8621 return &Jim_ExprOperators[opcode - JIM_TT_EXPR_OP];
8624 static int JimParseExprOperator(struct JimParserCtx *pc)
8626 int i;
8627 const struct Jim_ExprOperator *bestOp = NULL;
8628 int bestLen = 0;
8630 /* Try to get the longest match. */
8631 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
8632 const struct Jim_ExprOperator *op = &Jim_ExprOperators[i];
8634 if (op->name[0] != pc->p[0]) {
8635 continue;
8638 if (op->namelen > bestLen && strncmp(op->name, pc->p, op->namelen) == 0) {
8639 bestOp = op;
8640 bestLen = op->namelen;
8643 if (bestOp == NULL) {
8644 return JIM_ERR;
8647 /* Validate paretheses around function arguments */
8648 if (bestOp->attr & OP_FUNC) {
8649 const char *p = pc->p + bestLen;
8650 int len = pc->len - bestLen;
8652 while (len && isspace(UCHAR(*p))) {
8653 len--;
8654 p++;
8656 if (*p != '(') {
8657 return JIM_ERR;
8660 pc->tend = pc->p + bestLen - 1;
8661 pc->p += bestLen;
8662 pc->len -= bestLen;
8664 pc->tt = (bestOp - Jim_ExprOperators) + JIM_TT_EXPR_OP;
8665 return JIM_OK;
8668 const char *jim_tt_name(int type)
8670 static const char * const tt_names[JIM_TT_EXPR_OP] =
8671 { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "LIN", "WRD", "(((", ")))", ",,,", "INT",
8672 "DBL", "BOO", "$()" };
8673 if (type < JIM_TT_EXPR_OP) {
8674 return tt_names[type];
8676 else if (type == JIM_EXPROP_UNARYMINUS) {
8677 return "-VE";
8679 else if (type == JIM_EXPROP_UNARYPLUS) {
8680 return "+VE";
8682 else {
8683 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(type);
8684 static char buf[20];
8686 if (op->name) {
8687 return op->name;
8689 sprintf(buf, "(%d)", type);
8690 return buf;
8694 /* -----------------------------------------------------------------------------
8695 * Expression Object
8696 * ---------------------------------------------------------------------------*/
8697 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
8698 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
8699 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
8701 static const Jim_ObjType exprObjType = {
8702 "expression",
8703 FreeExprInternalRep,
8704 DupExprInternalRep,
8705 NULL,
8706 JIM_TYPE_REFERENCES,
8709 /* expr tree structure */
8710 struct ExprTree
8712 struct JimExprNode *expr; /* The first operator or term */
8713 struct JimExprNode *nodes; /* Storage of all nodes in the tree */
8714 int len; /* Number of nodes in use */
8715 int inUse; /* Used for sharing. */
8718 static void ExprTreeFreeNodes(Jim_Interp *interp, struct JimExprNode *nodes, int num)
8720 int i;
8721 for (i = 0; i < num; i++) {
8722 if (nodes[i].objPtr) {
8723 Jim_DecrRefCount(interp, nodes[i].objPtr);
8726 Jim_Free(nodes);
8729 static void ExprTreeFree(Jim_Interp *interp, struct ExprTree *expr)
8731 ExprTreeFreeNodes(interp, expr->nodes, expr->len);
8732 Jim_Free(expr);
8735 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
8737 struct ExprTree *expr = (void *)objPtr->internalRep.ptr;
8739 if (expr) {
8740 if (--expr->inUse != 0) {
8741 return;
8744 ExprTreeFree(interp, expr);
8748 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
8750 JIM_NOTUSED(interp);
8751 JIM_NOTUSED(srcPtr);
8753 /* Just returns an simple string. */
8754 dupPtr->typePtr = NULL;
8757 struct ExprBuilder {
8758 int parencount; /* count of outstanding parentheses */
8759 int level; /* recursion depth */
8760 ParseToken *token; /* The current token */
8761 ParseToken *first_token; /* The first token */
8762 Jim_Stack stack; /* stack of pending terms */
8763 Jim_Obj *exprObjPtr; /* the original expression */
8764 Jim_Obj *fileNameObj; /* filename of the original expression */
8765 struct JimExprNode *nodes; /* storage for all nodes */
8766 struct JimExprNode *next; /* storage for the next node */
8769 #ifdef DEBUG_SHOW_EXPR
8770 static void JimShowExprNode(struct JimExprNode *node, int level)
8772 int i;
8773 for (i = 0; i < level; i++) {
8774 printf(" ");
8776 if (TOKEN_IS_EXPR_OP(node->type)) {
8777 printf("%s\n", jim_tt_name(node->type));
8778 if (node->left) {
8779 JimShowExprNode(node->left, level + 1);
8781 if (node->right) {
8782 JimShowExprNode(node->right, level + 1);
8784 if (node->ternary) {
8785 JimShowExprNode(node->ternary, level + 1);
8788 else {
8789 printf("[%s] %s\n", jim_tt_name(node->type), Jim_String(node->objPtr));
8792 #endif
8794 #define EXPR_UNTIL_CLOSE 0x0001
8795 #define EXPR_FUNC_ARGS 0x0002
8796 #define EXPR_TERNARY 0x0004
8799 * Parse the subexpression at builder->token and return with the node on the stack.
8800 * builder->token is advanced to the next unconsumed token.
8801 * Returns JIM_OK if OK or JIM_ERR on error and leaves a message in the interpreter result.
8803 * 'precedence' is the precedence of the current operator. Tokens are consumed until an operator
8804 * with an equal or lower precedence is reached (or strictly lower if right associative).
8806 * If EXPR_UNTIL_CLOSE is set, the subexpression extends up to and including the next close parenthesis.
8807 * If EXPR_FUNC_ARGS is set, multiple subexpressions (terms) are expected separated by comma
8808 * If EXPR_TERNARY is set, two subexpressions (terms) are expected separated by colon
8810 * 'exp_numterms' indicates how many terms are expected. Normally this is 1, but may be more for EXPR_FUNC_ARGS and EXPR_TERNARY.
8812 static int ExprTreeBuildTree(Jim_Interp *interp, struct ExprBuilder *builder, int precedence, int flags, int exp_numterms)
8814 int rc;
8815 struct JimExprNode *node;
8816 /* Calculate the stack length expected after pushing the number of expected terms */
8817 int exp_stacklen = builder->stack.len + exp_numterms;
8819 if (builder->level++ > 200) {
8820 Jim_SetResultString(interp, "Expression too complex", -1);
8821 return JIM_ERR;
8824 while (builder->token->type != JIM_TT_EOL) {
8825 ParseToken *t = builder->token++;
8826 int prevtt;
8828 if (t == builder->first_token) {
8829 prevtt = JIM_TT_NONE;
8831 else {
8832 prevtt = t[-1].type;
8835 if (t->type == JIM_TT_SUBEXPR_START) {
8836 if (builder->stack.len == exp_stacklen) {
8837 Jim_SetResultFormatted(interp, "unexpected open parenthesis in expression: \"%#s\"", builder->exprObjPtr);
8838 return JIM_ERR;
8840 builder->parencount++;
8841 rc = ExprTreeBuildTree(interp, builder, 0, EXPR_UNTIL_CLOSE, 1);
8842 if (rc != JIM_OK) {
8843 return rc;
8845 /* A complete subexpression is on the stack */
8847 else if (t->type == JIM_TT_SUBEXPR_END) {
8848 if (!(flags & EXPR_UNTIL_CLOSE)) {
8849 if (builder->stack.len == exp_stacklen && builder->level > 1) {
8850 builder->token--;
8851 builder->level--;
8852 return JIM_OK;
8854 Jim_SetResultFormatted(interp, "unexpected closing parenthesis in expression: \"%#s\"", builder->exprObjPtr);
8855 return JIM_ERR;
8857 builder->parencount--;
8858 if (builder->stack.len == exp_stacklen) {
8859 /* Return with the expected number of subexpressions on the stack */
8860 break;
8863 else if (t->type == JIM_TT_SUBEXPR_COMMA) {
8864 if (!(flags & EXPR_FUNC_ARGS)) {
8865 if (builder->stack.len == exp_stacklen) {
8866 /* handle the comma back at the parent level */
8867 builder->token--;
8868 builder->level--;
8869 return JIM_OK;
8871 Jim_SetResultFormatted(interp, "unexpected comma in expression: \"%#s\"", builder->exprObjPtr);
8872 return JIM_ERR;
8874 else {
8875 /* If we see more terms than expected, it is an error */
8876 if (builder->stack.len > exp_stacklen) {
8877 Jim_SetResultFormatted(interp, "too many arguments to math function");
8878 return JIM_ERR;
8881 /* just go onto the next arg */
8883 else if (t->type == JIM_EXPROP_COLON) {
8884 if (!(flags & EXPR_TERNARY)) {
8885 if (builder->level != 1) {
8886 /* handle the comma back at the parent level */
8887 builder->token--;
8888 builder->level--;
8889 return JIM_OK;
8891 Jim_SetResultFormatted(interp, ": without ? in expression: \"%#s\"", builder->exprObjPtr);
8892 return JIM_ERR;
8894 if (builder->stack.len == exp_stacklen) {
8895 /* handle the comma back at the parent level */
8896 builder->token--;
8897 builder->level--;
8898 return JIM_OK;
8900 /* just go onto the next term */
8902 else if (TOKEN_IS_EXPR_OP(t->type)) {
8903 const struct Jim_ExprOperator *op;
8905 /* Convert -/+ to unary minus or unary plus if necessary */
8906 if (TOKEN_IS_EXPR_OP(prevtt) || TOKEN_IS_EXPR_START(prevtt)) {
8907 if (t->type == JIM_EXPROP_SUB) {
8908 t->type = JIM_EXPROP_UNARYMINUS;
8910 else if (t->type == JIM_EXPROP_ADD) {
8911 t->type = JIM_EXPROP_UNARYPLUS;
8915 op = JimExprOperatorInfoByOpcode(t->type);
8917 if (op->precedence < precedence || (!(op->attr & OP_RIGHT_ASSOC) && op->precedence == precedence)) {
8918 /* next op is lower precedence, or equal and left associative, so done here */
8919 builder->token--;
8920 break;
8923 if (op->attr & OP_FUNC) {
8924 if (builder->token->type != JIM_TT_SUBEXPR_START) {
8925 Jim_SetResultString(interp, "missing arguments for math function", -1);
8926 return JIM_ERR;
8928 builder->token++;
8929 if (op->arity == 0) {
8930 if (builder->token->type != JIM_TT_SUBEXPR_END) {
8931 Jim_SetResultString(interp, "too many arguments for math function", -1);
8932 return JIM_ERR;
8934 builder->token++;
8935 goto noargs;
8937 builder->parencount++;
8939 /* This will push left and return right */
8940 rc = ExprTreeBuildTree(interp, builder, 0, EXPR_FUNC_ARGS | EXPR_UNTIL_CLOSE, op->arity);
8942 else if (t->type == JIM_EXPROP_TERNARY) {
8943 /* Collect the two arguments to the ternary operator */
8944 rc = ExprTreeBuildTree(interp, builder, op->precedence, EXPR_TERNARY, 2);
8946 else {
8947 /* Recursively handle everything on the right until we see a precendence <= op->precedence or == and right associative
8948 * and push that on the term stack
8950 rc = ExprTreeBuildTree(interp, builder, op->precedence, 0, 1);
8953 if (rc != JIM_OK) {
8954 return rc;
8957 noargs:
8958 node = builder->next++;
8959 node->type = t->type;
8961 if (op->arity >= 3) {
8962 node->ternary = Jim_StackPop(&builder->stack);
8963 if (node->ternary == NULL) {
8964 goto missingoperand;
8967 if (op->arity >= 2) {
8968 node->right = Jim_StackPop(&builder->stack);
8969 if (node->right == NULL) {
8970 goto missingoperand;
8973 if (op->arity >= 1) {
8974 node->left = Jim_StackPop(&builder->stack);
8975 if (node->left == NULL) {
8976 missingoperand:
8977 Jim_SetResultFormatted(interp, "missing operand to %s in expression: \"%#s\"", op->name, builder->exprObjPtr);
8978 builder->next--;
8979 return JIM_ERR;
8984 /* Now push the node */
8985 Jim_StackPush(&builder->stack, node);
8987 else {
8988 Jim_Obj *objPtr = NULL;
8990 /* This is a simple non-operator term, so create and push the appropriate object */
8992 /* Two consecutive terms without an operator is invalid */
8993 if (!TOKEN_IS_EXPR_START(prevtt) && !TOKEN_IS_EXPR_OP(prevtt)) {
8994 Jim_SetResultFormatted(interp, "missing operator in expression: \"%#s\"", builder->exprObjPtr);
8995 return JIM_ERR;
8998 /* Immediately create a double or int object? */
8999 if (t->type == JIM_TT_EXPR_INT || t->type == JIM_TT_EXPR_DOUBLE) {
9000 char *endptr;
9001 if (t->type == JIM_TT_EXPR_INT) {
9002 objPtr = Jim_NewIntObj(interp, jim_strtoull(t->token, &endptr));
9004 else {
9005 objPtr = Jim_NewDoubleObj(interp, strtod(t->token, &endptr));
9007 if (endptr != t->token + t->len) {
9008 /* Conversion failed, so just store it as a string */
9009 Jim_FreeNewObj(interp, objPtr);
9010 objPtr = NULL;
9014 if (!objPtr) {
9015 /* Everything else is stored a simple string term */
9016 objPtr = Jim_NewStringObj(interp, t->token, t->len);
9017 if (t->type == JIM_TT_CMD) {
9018 /* Only commands need source info */
9019 JimSetSourceInfo(interp, objPtr, builder->fileNameObj, t->line);
9023 /* Now push a term node */
9024 node = builder->next++;
9025 node->objPtr = objPtr;
9026 Jim_IncrRefCount(node->objPtr);
9027 node->type = t->type;
9028 Jim_StackPush(&builder->stack, node);
9032 if (builder->stack.len == exp_stacklen) {
9033 builder->level--;
9034 return JIM_OK;
9037 if ((flags & EXPR_FUNC_ARGS)) {
9038 Jim_SetResultFormatted(interp, "too %s arguments for math function", (builder->stack.len < exp_stacklen) ? "few" : "many");
9040 else {
9041 if (builder->stack.len < exp_stacklen) {
9042 if (builder->level == 0) {
9043 Jim_SetResultFormatted(interp, "empty expression");
9045 else {
9046 Jim_SetResultFormatted(interp, "syntax error in expression \"%#s\": premature end of expression", builder->exprObjPtr);
9049 else {
9050 Jim_SetResultFormatted(interp, "extra terms after expression");
9054 return JIM_ERR;
9057 static struct ExprTree *ExprTreeCreateTree(Jim_Interp *interp, const ParseTokenList *tokenlist, Jim_Obj *exprObjPtr, Jim_Obj *fileNameObj)
9059 struct ExprTree *expr;
9060 struct ExprBuilder builder;
9061 int rc;
9062 struct JimExprNode *top = NULL;
9064 builder.parencount = 0;
9065 builder.level = 0;
9066 builder.token = builder.first_token = tokenlist->list;
9067 builder.exprObjPtr = exprObjPtr;
9068 builder.fileNameObj = fileNameObj;
9069 /* The bytecode will never produce more nodes than there are tokens - 1 (for EOL)*/
9070 builder.nodes = malloc(sizeof(struct JimExprNode) * (tokenlist->count - 1));
9071 memset(builder.nodes, 0, sizeof(struct JimExprNode) * (tokenlist->count - 1));
9072 builder.next = builder.nodes;
9073 Jim_InitStack(&builder.stack);
9075 rc = ExprTreeBuildTree(interp, &builder, 0, 0, 1);
9077 if (rc == JIM_OK) {
9078 top = Jim_StackPop(&builder.stack);
9080 if (builder.parencount) {
9081 Jim_SetResultString(interp, "missing close parenthesis", -1);
9082 rc = JIM_ERR;
9086 /* Free the stack used for the compilation. */
9087 Jim_FreeStack(&builder.stack);
9089 if (rc != JIM_OK) {
9090 ExprTreeFreeNodes(interp, builder.nodes, builder.next - builder.nodes);
9091 return NULL;
9094 expr = Jim_Alloc(sizeof(*expr));
9095 expr->inUse = 1;
9096 expr->expr = top;
9097 expr->nodes = builder.nodes;
9098 expr->len = builder.next - builder.nodes;
9100 assert(expr->len <= tokenlist->count - 1);
9102 return expr;
9105 /* This method takes the string representation of an expression
9106 * and generates a program for the expr engine */
9107 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
9109 int exprTextLen;
9110 const char *exprText;
9111 struct JimParserCtx parser;
9112 struct ExprTree *expr;
9113 ParseTokenList tokenlist;
9114 int line;
9115 Jim_Obj *fileNameObj;
9116 int rc = JIM_ERR;
9118 /* Try to get information about filename / line number */
9119 if (objPtr->typePtr == &sourceObjType) {
9120 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
9121 line = objPtr->internalRep.sourceValue.lineNumber;
9123 else {
9124 fileNameObj = interp->emptyObj;
9125 line = 1;
9127 Jim_IncrRefCount(fileNameObj);
9129 exprText = Jim_GetString(objPtr, &exprTextLen);
9131 /* Initially tokenise the expression into tokenlist */
9132 ScriptTokenListInit(&tokenlist);
9134 JimParserInit(&parser, exprText, exprTextLen, line);
9135 while (!parser.eof) {
9136 if (JimParseExpression(&parser) != JIM_OK) {
9137 ScriptTokenListFree(&tokenlist);
9138 Jim_SetResultFormatted(interp, "syntax error in expression: \"%#s\"", objPtr);
9139 expr = NULL;
9140 goto err;
9143 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
9144 parser.tline);
9147 #ifdef DEBUG_SHOW_EXPR_TOKENS
9149 int i;
9150 printf("==== Expr Tokens (%s) ====\n", Jim_String(fileNameObj));
9151 for (i = 0; i < tokenlist.count; i++) {
9152 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist.list[i].line, jim_tt_name(tokenlist.list[i].type),
9153 tokenlist.list[i].len, tokenlist.list[i].token);
9156 #endif
9158 if (JimParseCheckMissing(interp, parser.missing.ch) == JIM_ERR) {
9159 ScriptTokenListFree(&tokenlist);
9160 Jim_DecrRefCount(interp, fileNameObj);
9161 return JIM_ERR;
9164 /* Now create the expression bytecode from the tokenlist */
9165 expr = ExprTreeCreateTree(interp, &tokenlist, objPtr, fileNameObj);
9167 /* No longer need the token list */
9168 ScriptTokenListFree(&tokenlist);
9170 if (!expr) {
9171 goto err;
9174 #ifdef DEBUG_SHOW_EXPR
9175 printf("==== Expr ====\n");
9176 JimShowExprNode(expr->expr, 0);
9177 #endif
9179 rc = JIM_OK;
9181 err:
9182 /* Free the old internal rep and set the new one. */
9183 Jim_DecrRefCount(interp, fileNameObj);
9184 Jim_FreeIntRep(interp, objPtr);
9185 Jim_SetIntRepPtr(objPtr, expr);
9186 objPtr->typePtr = &exprObjType;
9187 return rc;
9190 static struct ExprTree *JimGetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
9192 if (objPtr->typePtr != &exprObjType) {
9193 if (SetExprFromAny(interp, objPtr) != JIM_OK) {
9194 return NULL;
9197 return (struct ExprTree *) Jim_GetIntRepPtr(objPtr);
9200 #ifdef JIM_OPTIMIZATION
9201 static Jim_Obj *JimExprIntValOrVar(Jim_Interp *interp, struct JimExprNode *node)
9203 if (node->type == JIM_TT_EXPR_INT)
9204 return node->objPtr;
9205 else if (node->type == JIM_TT_VAR)
9206 return Jim_GetVariable(interp, node->objPtr, JIM_NONE);
9207 else if (node->type == JIM_TT_DICTSUGAR)
9208 return JimExpandDictSugar(interp, node->objPtr);
9209 else
9210 return NULL;
9212 #endif
9214 /* -----------------------------------------------------------------------------
9215 * Expressions evaluation.
9216 * Jim uses a recursive evaluation engine for expressions,
9217 * that takes advantage of the fact that expr's operators
9218 * can't be redefined.
9220 * Jim_EvalExpression() uses the expression tree compiled by
9221 * SetExprFromAny() method of the "expression" object.
9223 * On success a Tcl Object containing the result of the evaluation
9224 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
9225 * returned.
9226 * On error the function returns a retcode != to JIM_OK and set a suitable
9227 * error on the interp.
9228 * ---------------------------------------------------------------------------*/
9230 static int JimExprEvalTermNode(Jim_Interp *interp, struct JimExprNode *node)
9232 if (TOKEN_IS_EXPR_OP(node->type)) {
9233 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(node->type);
9234 return op->funcop(interp, node);
9236 else {
9237 Jim_Obj *objPtr;
9239 /* A term */
9240 switch (node->type) {
9241 case JIM_TT_EXPR_INT:
9242 case JIM_TT_EXPR_DOUBLE:
9243 case JIM_TT_EXPR_BOOLEAN:
9244 case JIM_TT_STR:
9245 Jim_SetResult(interp, node->objPtr);
9246 return JIM_OK;
9248 case JIM_TT_VAR:
9249 objPtr = Jim_GetVariable(interp, node->objPtr, JIM_ERRMSG);
9250 if (objPtr) {
9251 Jim_SetResult(interp, objPtr);
9252 return JIM_OK;
9254 return JIM_ERR;
9256 case JIM_TT_DICTSUGAR:
9257 objPtr = JimExpandDictSugar(interp, node->objPtr);
9258 if (objPtr) {
9259 Jim_SetResult(interp, objPtr);
9260 return JIM_OK;
9262 return JIM_ERR;
9264 case JIM_TT_ESC:
9265 if (Jim_SubstObj(interp, node->objPtr, &objPtr, JIM_NONE) == JIM_OK) {
9266 Jim_SetResult(interp, objPtr);
9267 return JIM_OK;
9269 return JIM_ERR;
9271 case JIM_TT_CMD:
9272 return Jim_EvalObj(interp, node->objPtr);
9274 default:
9275 /* Should never get here */
9276 return JIM_ERR;
9281 static int JimExprGetTerm(Jim_Interp *interp, struct JimExprNode *node, Jim_Obj **objPtrPtr)
9283 int rc = JimExprEvalTermNode(interp, node);
9284 if (rc == JIM_OK) {
9285 *objPtrPtr = Jim_GetResult(interp);
9286 Jim_IncrRefCount(*objPtrPtr);
9288 return rc;
9291 static int JimExprGetTermBoolean(Jim_Interp *interp, struct JimExprNode *node)
9293 if (JimExprEvalTermNode(interp, node) == JIM_OK) {
9294 return ExprBool(interp, Jim_GetResult(interp));
9296 return -1;
9299 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr)
9301 struct ExprTree *expr;
9302 int retcode = JIM_OK;
9304 expr = JimGetExpression(interp, exprObjPtr);
9305 if (!expr) {
9306 return JIM_ERR; /* error in expression. */
9309 #ifdef JIM_OPTIMIZATION
9310 /* Check for one of the following common expressions used by while/for
9312 * CONST
9313 * $a
9314 * !$a
9315 * $a < CONST, $a < $b
9316 * $a <= CONST, $a <= $b
9317 * $a > CONST, $a > $b
9318 * $a >= CONST, $a >= $b
9319 * $a != CONST, $a != $b
9320 * $a == CONST, $a == $b
9323 Jim_Obj *objPtr;
9325 /* STEP 1 -- Check if there are the conditions to run the specialized
9326 * version of while */
9328 switch (expr->len) {
9329 case 1:
9330 objPtr = JimExprIntValOrVar(interp, expr->expr);
9331 if (objPtr) {
9332 Jim_SetResult(interp, objPtr);
9333 return JIM_OK;
9335 break;
9337 case 2:
9338 if (expr->expr->type == JIM_EXPROP_NOT) {
9339 objPtr = JimExprIntValOrVar(interp, expr->expr->left);
9341 if (objPtr && JimIsWide(objPtr)) {
9342 Jim_SetResult(interp, JimWideValue(objPtr) ? interp->falseObj : interp->trueObj);
9343 return JIM_OK;
9346 break;
9348 case 3:
9349 objPtr = JimExprIntValOrVar(interp, expr->expr->left);
9350 if (objPtr && JimIsWide(objPtr)) {
9351 Jim_Obj *objPtr2 = JimExprIntValOrVar(interp, expr->expr->right);
9352 if (objPtr2 && JimIsWide(objPtr2)) {
9353 jim_wide wideValueA = JimWideValue(objPtr);
9354 jim_wide wideValueB = JimWideValue(objPtr2);
9355 int cmpRes;
9356 switch (expr->expr->type) {
9357 case JIM_EXPROP_LT:
9358 cmpRes = wideValueA < wideValueB;
9359 break;
9360 case JIM_EXPROP_LTE:
9361 cmpRes = wideValueA <= wideValueB;
9362 break;
9363 case JIM_EXPROP_GT:
9364 cmpRes = wideValueA > wideValueB;
9365 break;
9366 case JIM_EXPROP_GTE:
9367 cmpRes = wideValueA >= wideValueB;
9368 break;
9369 case JIM_EXPROP_NUMEQ:
9370 cmpRes = wideValueA == wideValueB;
9371 break;
9372 case JIM_EXPROP_NUMNE:
9373 cmpRes = wideValueA != wideValueB;
9374 break;
9375 default:
9376 goto noopt;
9378 Jim_SetResult(interp, cmpRes ? interp->trueObj : interp->falseObj);
9379 return JIM_OK;
9382 break;
9385 noopt:
9386 #endif
9388 /* In order to avoid the internal repr being freed due to
9389 * shimmering of the exprObjPtr's object, we make the internal rep
9390 * shared. */
9391 expr->inUse++;
9393 /* Evaluate with the recursive expr engine */
9394 retcode = JimExprEvalTermNode(interp, expr->expr);
9396 expr->inUse--;
9398 return retcode;
9401 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
9403 int retcode = Jim_EvalExpression(interp, exprObjPtr);
9405 if (retcode == JIM_OK) {
9406 switch (ExprBool(interp, Jim_GetResult(interp))) {
9407 case 0:
9408 *boolPtr = 0;
9409 break;
9411 case 1:
9412 *boolPtr = 1;
9413 break;
9415 case -1:
9416 retcode = JIM_ERR;
9417 break;
9420 return retcode;
9423 /* -----------------------------------------------------------------------------
9424 * ScanFormat String Object
9425 * ---------------------------------------------------------------------------*/
9427 /* This Jim_Obj will held a parsed representation of a format string passed to
9428 * the Jim_ScanString command. For error diagnostics, the scanformat string has
9429 * to be parsed in its entirely first and then, if correct, can be used for
9430 * scanning. To avoid endless re-parsing, the parsed representation will be
9431 * stored in an internal representation and re-used for performance reason. */
9433 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
9434 * scanformat string. This part will later be used to extract information
9435 * out from the string to be parsed by Jim_ScanString */
9437 typedef struct ScanFmtPartDescr
9439 const char *arg; /* Specification of a CHARSET conversion */
9440 const char *prefix; /* Prefix to be scanned literally before conversion */
9441 size_t width; /* Maximal width of input to be converted */
9442 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
9443 char type; /* Type of conversion (e.g. c, d, f) */
9444 char modifier; /* Modify type (e.g. l - long, h - short */
9445 } ScanFmtPartDescr;
9447 /* The ScanFmtStringObj will hold the internal representation of a scanformat
9448 * string parsed and separated in part descriptions. Furthermore it contains
9449 * the original string representation of the scanformat string to allow for
9450 * fast update of the Jim_Obj's string representation part.
9452 * As an add-on the internal object representation adds some scratch pad area
9453 * for usage by Jim_ScanString to avoid endless allocating and freeing of
9454 * memory for purpose of string scanning.
9456 * The error member points to a static allocated string in case of a mal-
9457 * formed scanformat string or it contains '0' (NULL) in case of a valid
9458 * parse representation.
9460 * The whole memory of the internal representation is allocated as a single
9461 * area of memory that will be internally separated. So freeing and duplicating
9462 * of such an object is cheap */
9464 typedef struct ScanFmtStringObj
9466 jim_wide size; /* Size of internal repr in bytes */
9467 char *stringRep; /* Original string representation */
9468 size_t count; /* Number of ScanFmtPartDescr contained */
9469 size_t convCount; /* Number of conversions that will assign */
9470 size_t maxPos; /* Max position index if XPG3 is used */
9471 const char *error; /* Ptr to error text (NULL if no error */
9472 char *scratch; /* Some scratch pad used by Jim_ScanString */
9473 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
9474 } ScanFmtStringObj;
9477 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
9478 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
9479 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
9481 static const Jim_ObjType scanFmtStringObjType = {
9482 "scanformatstring",
9483 FreeScanFmtInternalRep,
9484 DupScanFmtInternalRep,
9485 UpdateStringOfScanFmt,
9486 JIM_TYPE_NONE,
9489 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
9491 JIM_NOTUSED(interp);
9492 Jim_Free((char *)objPtr->internalRep.ptr);
9493 objPtr->internalRep.ptr = 0;
9496 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
9498 size_t size = (size_t) ((ScanFmtStringObj *) srcPtr->internalRep.ptr)->size;
9499 ScanFmtStringObj *newVec = (ScanFmtStringObj *) Jim_Alloc(size);
9501 JIM_NOTUSED(interp);
9502 memcpy(newVec, srcPtr->internalRep.ptr, size);
9503 dupPtr->internalRep.ptr = newVec;
9504 dupPtr->typePtr = &scanFmtStringObjType;
9507 static void UpdateStringOfScanFmt(Jim_Obj *objPtr)
9509 JimSetStringBytes(objPtr, ((ScanFmtStringObj *) objPtr->internalRep.ptr)->stringRep);
9512 /* SetScanFmtFromAny will parse a given string and create the internal
9513 * representation of the format specification. In case of an error
9514 * the error data member of the internal representation will be set
9515 * to an descriptive error text and the function will be left with
9516 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
9517 * specification */
9519 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
9521 ScanFmtStringObj *fmtObj;
9522 char *buffer;
9523 int maxCount, i, approxSize, lastPos = -1;
9524 const char *fmt = Jim_String(objPtr);
9525 int maxFmtLen = Jim_Length(objPtr);
9526 const char *fmtEnd = fmt + maxFmtLen;
9527 int curr;
9529 Jim_FreeIntRep(interp, objPtr);
9530 /* Count how many conversions could take place maximally */
9531 for (i = 0, maxCount = 0; i < maxFmtLen; ++i)
9532 if (fmt[i] == '%')
9533 ++maxCount;
9534 /* Calculate an approximation of the memory necessary */
9535 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
9536 +(maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
9537 +maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
9538 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
9539 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
9540 +(maxCount + 1) * sizeof(char) /* '\0' for every partial */
9541 +1; /* safety byte */
9542 fmtObj = (ScanFmtStringObj *) Jim_Alloc(approxSize);
9543 memset(fmtObj, 0, approxSize);
9544 fmtObj->size = approxSize;
9545 fmtObj->maxPos = 0;
9546 fmtObj->scratch = (char *)&fmtObj->descr[maxCount + 1];
9547 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
9548 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
9549 buffer = fmtObj->stringRep + maxFmtLen + 1;
9550 objPtr->internalRep.ptr = fmtObj;
9551 objPtr->typePtr = &scanFmtStringObjType;
9552 for (i = 0, curr = 0; fmt < fmtEnd; ++fmt) {
9553 int width = 0, skip;
9554 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
9556 fmtObj->count++;
9557 descr->width = 0; /* Assume width unspecified */
9558 /* Overread and store any "literal" prefix */
9559 if (*fmt != '%' || fmt[1] == '%') {
9560 descr->type = 0;
9561 descr->prefix = &buffer[i];
9562 for (; fmt < fmtEnd; ++fmt) {
9563 if (*fmt == '%') {
9564 if (fmt[1] != '%')
9565 break;
9566 ++fmt;
9568 buffer[i++] = *fmt;
9570 buffer[i++] = 0;
9572 /* Skip the conversion introducing '%' sign */
9573 ++fmt;
9574 /* End reached due to non-conversion literal only? */
9575 if (fmt >= fmtEnd)
9576 goto done;
9577 descr->pos = 0; /* Assume "natural" positioning */
9578 if (*fmt == '*') {
9579 descr->pos = -1; /* Okay, conversion will not be assigned */
9580 ++fmt;
9582 else
9583 fmtObj->convCount++; /* Otherwise count as assign-conversion */
9584 /* Check if next token is a number (could be width or pos */
9585 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9586 fmt += skip;
9587 /* Was the number a XPG3 position specifier? */
9588 if (descr->pos != -1 && *fmt == '$') {
9589 int prev;
9591 ++fmt;
9592 descr->pos = width;
9593 width = 0;
9594 /* Look if "natural" postioning and XPG3 one was mixed */
9595 if ((lastPos == 0 && descr->pos > 0)
9596 || (lastPos > 0 && descr->pos == 0)) {
9597 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
9598 return JIM_ERR;
9600 /* Look if this position was already used */
9601 for (prev = 0; prev < curr; ++prev) {
9602 if (fmtObj->descr[prev].pos == -1)
9603 continue;
9604 if (fmtObj->descr[prev].pos == descr->pos) {
9605 fmtObj->error =
9606 "variable is assigned by multiple \"%n$\" conversion specifiers";
9607 return JIM_ERR;
9610 if (descr->pos < 0) {
9611 fmtObj->error =
9612 "\"%n$\" conversion specifier is negative";
9613 return JIM_ERR;
9615 /* Try to find a width after the XPG3 specifier */
9616 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9617 descr->width = width;
9618 fmt += skip;
9620 if (descr->pos > 0 && (size_t) descr->pos > fmtObj->maxPos)
9621 fmtObj->maxPos = descr->pos;
9623 else {
9624 /* Number was not a XPG3, so it has to be a width */
9625 descr->width = width;
9628 /* If positioning mode was undetermined yet, fix this */
9629 if (lastPos == -1)
9630 lastPos = descr->pos;
9631 /* Handle CHARSET conversion type ... */
9632 if (*fmt == '[') {
9633 int swapped = 1, beg = i, end, j;
9635 descr->type = '[';
9636 descr->arg = &buffer[i];
9637 ++fmt;
9638 if (*fmt == '^')
9639 buffer[i++] = *fmt++;
9640 if (*fmt == ']')
9641 buffer[i++] = *fmt++;
9642 while (*fmt && *fmt != ']')
9643 buffer[i++] = *fmt++;
9644 if (*fmt != ']') {
9645 fmtObj->error = "unmatched [ in format string";
9646 return JIM_ERR;
9648 end = i;
9649 buffer[i++] = 0;
9650 /* In case a range fence was given "backwards", swap it */
9651 while (swapped) {
9652 swapped = 0;
9653 for (j = beg + 1; j < end - 1; ++j) {
9654 if (buffer[j] == '-' && buffer[j - 1] > buffer[j + 1]) {
9655 char tmp = buffer[j - 1];
9657 buffer[j - 1] = buffer[j + 1];
9658 buffer[j + 1] = tmp;
9659 swapped = 1;
9664 else {
9665 /* Remember any valid modifier if given */
9666 if (fmt < fmtEnd && strchr("hlL", *fmt))
9667 descr->modifier = tolower((int)*fmt++);
9669 if (fmt >= fmtEnd) {
9670 fmtObj->error = "missing scan conversion character";
9671 return JIM_ERR;
9674 descr->type = *fmt;
9675 if (strchr("efgcsndoxui", *fmt) == 0) {
9676 fmtObj->error = "bad scan conversion character";
9677 return JIM_ERR;
9679 else if (*fmt == 'c' && descr->width != 0) {
9680 fmtObj->error = "field width may not be specified in %c " "conversion";
9681 return JIM_ERR;
9683 else if (*fmt == 'u' && descr->modifier == 'l') {
9684 fmtObj->error = "unsigned wide not supported";
9685 return JIM_ERR;
9688 curr++;
9690 done:
9691 return JIM_OK;
9694 /* Some accessor macros to allow lowlevel access to fields of internal repr */
9696 #define FormatGetCnvCount(_fo_) \
9697 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
9698 #define FormatGetMaxPos(_fo_) \
9699 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
9700 #define FormatGetError(_fo_) \
9701 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
9703 /* JimScanAString is used to scan an unspecified string that ends with
9704 * next WS, or a string that is specified via a charset.
9707 static Jim_Obj *JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
9709 char *buffer = Jim_StrDup(str);
9710 char *p = buffer;
9712 while (*str) {
9713 int c;
9714 int n;
9716 if (!sdescr && isspace(UCHAR(*str)))
9717 break; /* EOS via WS if unspecified */
9719 n = utf8_tounicode(str, &c);
9720 if (sdescr && !JimCharsetMatch(sdescr, c, JIM_CHARSET_SCAN))
9721 break;
9722 while (n--)
9723 *p++ = *str++;
9725 *p = 0;
9726 return Jim_NewStringObjNoAlloc(interp, buffer, p - buffer);
9729 /* ScanOneEntry will scan one entry out of the string passed as argument.
9730 * It use the sscanf() function for this task. After extracting and
9731 * converting of the value, the count of scanned characters will be
9732 * returned of -1 in case of no conversion tool place and string was
9733 * already scanned thru */
9735 static int ScanOneEntry(Jim_Interp *interp, const char *str, int pos, int strLen,
9736 ScanFmtStringObj * fmtObj, long idx, Jim_Obj **valObjPtr)
9738 const char *tok;
9739 const ScanFmtPartDescr *descr = &fmtObj->descr[idx];
9740 size_t scanned = 0;
9741 size_t anchor = pos;
9742 int i;
9743 Jim_Obj *tmpObj = NULL;
9745 /* First pessimistically assume, we will not scan anything :-) */
9746 *valObjPtr = 0;
9747 if (descr->prefix) {
9748 /* There was a prefix given before the conversion, skip it and adjust
9749 * the string-to-be-parsed accordingly */
9750 for (i = 0; pos < strLen && descr->prefix[i]; ++i) {
9751 /* If prefix require, skip WS */
9752 if (isspace(UCHAR(descr->prefix[i])))
9753 while (pos < strLen && isspace(UCHAR(str[pos])))
9754 ++pos;
9755 else if (descr->prefix[i] != str[pos])
9756 break; /* Prefix do not match here, leave the loop */
9757 else
9758 ++pos; /* Prefix matched so far, next round */
9760 if (pos >= strLen) {
9761 return -1; /* All of str consumed: EOF condition */
9763 else if (descr->prefix[i] != 0)
9764 return 0; /* Not whole prefix consumed, no conversion possible */
9766 /* For all but following conversion, skip leading WS */
9767 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
9768 while (isspace(UCHAR(str[pos])))
9769 ++pos;
9770 /* Determine how much skipped/scanned so far */
9771 scanned = pos - anchor;
9773 /* %c is a special, simple case. no width */
9774 if (descr->type == 'n') {
9775 /* Return pseudo conversion means: how much scanned so far? */
9776 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
9778 else if (pos >= strLen) {
9779 /* Cannot scan anything, as str is totally consumed */
9780 return -1;
9782 else if (descr->type == 'c') {
9783 int c;
9784 scanned += utf8_tounicode(&str[pos], &c);
9785 *valObjPtr = Jim_NewIntObj(interp, c);
9786 return scanned;
9788 else {
9789 /* Processing of conversions follows ... */
9790 if (descr->width > 0) {
9791 /* Do not try to scan as fas as possible but only the given width.
9792 * To ensure this, we copy the part that should be scanned. */
9793 size_t sLen = utf8_strlen(&str[pos], strLen - pos);
9794 size_t tLen = descr->width > sLen ? sLen : descr->width;
9796 tmpObj = Jim_NewStringObjUtf8(interp, str + pos, tLen);
9797 tok = tmpObj->bytes;
9799 else {
9800 /* As no width was given, simply refer to the original string */
9801 tok = &str[pos];
9803 switch (descr->type) {
9804 case 'd':
9805 case 'o':
9806 case 'x':
9807 case 'u':
9808 case 'i':{
9809 char *endp; /* Position where the number finished */
9810 jim_wide w;
9812 int base = descr->type == 'o' ? 8
9813 : descr->type == 'x' ? 16 : descr->type == 'i' ? 0 : 10;
9815 /* Try to scan a number with the given base */
9816 if (base == 0) {
9817 w = jim_strtoull(tok, &endp);
9819 else {
9820 w = strtoull(tok, &endp, base);
9823 if (endp != tok) {
9824 /* There was some number sucessfully scanned! */
9825 *valObjPtr = Jim_NewIntObj(interp, w);
9827 /* Adjust the number-of-chars scanned so far */
9828 scanned += endp - tok;
9830 else {
9831 /* Nothing was scanned. We have to determine if this
9832 * happened due to e.g. prefix mismatch or input str
9833 * exhausted */
9834 scanned = *tok ? 0 : -1;
9836 break;
9838 case 's':
9839 case '[':{
9840 *valObjPtr = JimScanAString(interp, descr->arg, tok);
9841 scanned += Jim_Length(*valObjPtr);
9842 break;
9844 case 'e':
9845 case 'f':
9846 case 'g':{
9847 char *endp;
9848 double value = strtod(tok, &endp);
9850 if (endp != tok) {
9851 /* There was some number sucessfully scanned! */
9852 *valObjPtr = Jim_NewDoubleObj(interp, value);
9853 /* Adjust the number-of-chars scanned so far */
9854 scanned += endp - tok;
9856 else {
9857 /* Nothing was scanned. We have to determine if this
9858 * happened due to e.g. prefix mismatch or input str
9859 * exhausted */
9860 scanned = *tok ? 0 : -1;
9862 break;
9865 /* If a substring was allocated (due to pre-defined width) do not
9866 * forget to free it */
9867 if (tmpObj) {
9868 Jim_FreeNewObj(interp, tmpObj);
9871 return scanned;
9874 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
9875 * string and returns all converted (and not ignored) values in a list back
9876 * to the caller. If an error occured, a NULL pointer will be returned */
9878 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *fmtObjPtr, int flags)
9880 size_t i, pos;
9881 int scanned = 1;
9882 const char *str = Jim_String(strObjPtr);
9883 int strLen = Jim_Utf8Length(interp, strObjPtr);
9884 Jim_Obj *resultList = 0;
9885 Jim_Obj **resultVec = 0;
9886 int resultc;
9887 Jim_Obj *emptyStr = 0;
9888 ScanFmtStringObj *fmtObj;
9890 /* This should never happen. The format object should already be of the correct type */
9891 JimPanic((fmtObjPtr->typePtr != &scanFmtStringObjType, "Jim_ScanString() for non-scan format"));
9893 fmtObj = (ScanFmtStringObj *) fmtObjPtr->internalRep.ptr;
9894 /* Check if format specification was valid */
9895 if (fmtObj->error != 0) {
9896 if (flags & JIM_ERRMSG)
9897 Jim_SetResultString(interp, fmtObj->error, -1);
9898 return 0;
9900 /* Allocate a new "shared" empty string for all unassigned conversions */
9901 emptyStr = Jim_NewEmptyStringObj(interp);
9902 Jim_IncrRefCount(emptyStr);
9903 /* Create a list and fill it with empty strings up to max specified XPG3 */
9904 resultList = Jim_NewListObj(interp, NULL, 0);
9905 if (fmtObj->maxPos > 0) {
9906 for (i = 0; i < fmtObj->maxPos; ++i)
9907 Jim_ListAppendElement(interp, resultList, emptyStr);
9908 JimListGetElements(interp, resultList, &resultc, &resultVec);
9910 /* Now handle every partial format description */
9911 for (i = 0, pos = 0; i < fmtObj->count; ++i) {
9912 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
9913 Jim_Obj *value = 0;
9915 /* Only last type may be "literal" w/o conversion - skip it! */
9916 if (descr->type == 0)
9917 continue;
9918 /* As long as any conversion could be done, we will proceed */
9919 if (scanned > 0)
9920 scanned = ScanOneEntry(interp, str, pos, strLen, fmtObj, i, &value);
9921 /* In case our first try results in EOF, we will leave */
9922 if (scanned == -1 && i == 0)
9923 goto eof;
9924 /* Advance next pos-to-be-scanned for the amount scanned already */
9925 pos += scanned;
9927 /* value == 0 means no conversion took place so take empty string */
9928 if (value == 0)
9929 value = Jim_NewEmptyStringObj(interp);
9930 /* If value is a non-assignable one, skip it */
9931 if (descr->pos == -1) {
9932 Jim_FreeNewObj(interp, value);
9934 else if (descr->pos == 0)
9935 /* Otherwise append it to the result list if no XPG3 was given */
9936 Jim_ListAppendElement(interp, resultList, value);
9937 else if (resultVec[descr->pos - 1] == emptyStr) {
9938 /* But due to given XPG3, put the value into the corr. slot */
9939 Jim_DecrRefCount(interp, resultVec[descr->pos - 1]);
9940 Jim_IncrRefCount(value);
9941 resultVec[descr->pos - 1] = value;
9943 else {
9944 /* Otherwise, the slot was already used - free obj and ERROR */
9945 Jim_FreeNewObj(interp, value);
9946 goto err;
9949 Jim_DecrRefCount(interp, emptyStr);
9950 return resultList;
9951 eof:
9952 Jim_DecrRefCount(interp, emptyStr);
9953 Jim_FreeNewObj(interp, resultList);
9954 return (Jim_Obj *)EOF;
9955 err:
9956 Jim_DecrRefCount(interp, emptyStr);
9957 Jim_FreeNewObj(interp, resultList);
9958 return 0;
9961 /* -----------------------------------------------------------------------------
9962 * Pseudo Random Number Generation
9963 * ---------------------------------------------------------------------------*/
9964 /* Initialize the sbox with the numbers from 0 to 255 */
9965 static void JimPrngInit(Jim_Interp *interp)
9967 #define PRNG_SEED_SIZE 256
9968 int i;
9969 unsigned int *seed;
9970 time_t t = time(NULL);
9972 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
9974 seed = Jim_Alloc(PRNG_SEED_SIZE * sizeof(*seed));
9975 for (i = 0; i < PRNG_SEED_SIZE; i++) {
9976 seed[i] = (rand() ^ t ^ clock());
9978 JimPrngSeed(interp, (unsigned char *)seed, PRNG_SEED_SIZE * sizeof(*seed));
9979 Jim_Free(seed);
9982 /* Generates N bytes of random data */
9983 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
9985 Jim_PrngState *prng;
9986 unsigned char *destByte = (unsigned char *)dest;
9987 unsigned int si, sj, x;
9989 /* initialization, only needed the first time */
9990 if (interp->prngState == NULL)
9991 JimPrngInit(interp);
9992 prng = interp->prngState;
9993 /* generates 'len' bytes of pseudo-random numbers */
9994 for (x = 0; x < len; x++) {
9995 prng->i = (prng->i + 1) & 0xff;
9996 si = prng->sbox[prng->i];
9997 prng->j = (prng->j + si) & 0xff;
9998 sj = prng->sbox[prng->j];
9999 prng->sbox[prng->i] = sj;
10000 prng->sbox[prng->j] = si;
10001 *destByte++ = prng->sbox[(si + sj) & 0xff];
10005 /* Re-seed the generator with user-provided bytes */
10006 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen)
10008 int i;
10009 Jim_PrngState *prng;
10011 /* initialization, only needed the first time */
10012 if (interp->prngState == NULL)
10013 JimPrngInit(interp);
10014 prng = interp->prngState;
10016 /* Set the sbox[i] with i */
10017 for (i = 0; i < 256; i++)
10018 prng->sbox[i] = i;
10019 /* Now use the seed to perform a random permutation of the sbox */
10020 for (i = 0; i < seedLen; i++) {
10021 unsigned char t;
10023 t = prng->sbox[i & 0xFF];
10024 prng->sbox[i & 0xFF] = prng->sbox[seed[i]];
10025 prng->sbox[seed[i]] = t;
10027 prng->i = prng->j = 0;
10029 /* discard at least the first 256 bytes of stream.
10030 * borrow the seed buffer for this
10032 for (i = 0; i < 256; i += seedLen) {
10033 JimRandomBytes(interp, seed, seedLen);
10037 /* [incr] */
10038 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10040 jim_wide wideValue, increment = 1;
10041 Jim_Obj *intObjPtr;
10043 if (argc != 2 && argc != 3) {
10044 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
10045 return JIM_ERR;
10047 if (argc == 3) {
10048 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
10049 return JIM_ERR;
10051 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
10052 if (!intObjPtr) {
10053 /* Set missing variable to 0 */
10054 wideValue = 0;
10056 else if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK) {
10057 return JIM_ERR;
10059 if (!intObjPtr || Jim_IsShared(intObjPtr)) {
10060 intObjPtr = Jim_NewIntObj(interp, wideValue + increment);
10061 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
10062 Jim_FreeNewObj(interp, intObjPtr);
10063 return JIM_ERR;
10066 else {
10067 /* Can do it the quick way */
10068 Jim_InvalidateStringRep(intObjPtr);
10069 JimWideValue(intObjPtr) = wideValue + increment;
10071 /* The following step is required in order to invalidate the
10072 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
10073 if (argv[1]->typePtr != &variableObjType) {
10074 /* Note that this can't fail since GetVariable already succeeded */
10075 Jim_SetVariable(interp, argv[1], intObjPtr);
10078 Jim_SetResult(interp, intObjPtr);
10079 return JIM_OK;
10083 /* -----------------------------------------------------------------------------
10084 * Eval
10085 * ---------------------------------------------------------------------------*/
10086 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
10087 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
10089 /* Handle calls to the [unknown] command */
10090 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10092 int retcode;
10094 /* If JimUnknown() is recursively called too many times...
10095 * done here
10097 if (interp->unknown_called > 50) {
10098 return JIM_ERR;
10101 /* The object interp->unknown just contains
10102 * the "unknown" string, it is used in order to
10103 * avoid to lookup the unknown command every time
10104 * but instead to cache the result. */
10106 /* If the [unknown] command does not exist ... */
10107 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
10108 return JIM_ERR;
10110 interp->unknown_called++;
10111 /* XXX: Are we losing fileNameObj and linenr? */
10112 retcode = Jim_EvalObjPrefix(interp, interp->unknown, argc, argv);
10113 interp->unknown_called--;
10115 return retcode;
10118 static int JimInvokeCommand(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10120 int retcode;
10121 Jim_Cmd *cmdPtr;
10122 void *prevPrivData;
10124 #if 0
10125 printf("invoke");
10126 int j;
10127 for (j = 0; j < objc; j++) {
10128 printf(" '%s'", Jim_String(objv[j]));
10130 printf("\n");
10131 #endif
10133 if (interp->framePtr->tailcallCmd) {
10134 /* Special tailcall command was pre-resolved */
10135 cmdPtr = interp->framePtr->tailcallCmd;
10136 interp->framePtr->tailcallCmd = NULL;
10138 else {
10139 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
10140 if (cmdPtr == NULL) {
10141 return JimUnknown(interp, objc, objv);
10143 JimIncrCmdRefCount(cmdPtr);
10146 if (interp->evalDepth == interp->maxEvalDepth) {
10147 Jim_SetResultString(interp, "Infinite eval recursion", -1);
10148 retcode = JIM_ERR;
10149 goto out;
10151 interp->evalDepth++;
10152 prevPrivData = interp->cmdPrivData;
10154 /* Call it -- Make sure result is an empty object. */
10155 Jim_SetEmptyResult(interp);
10156 if (cmdPtr->isproc) {
10157 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
10159 else {
10160 interp->cmdPrivData = cmdPtr->u.native.privData;
10161 retcode = cmdPtr->u.native.cmdProc(interp, objc, objv);
10163 interp->cmdPrivData = prevPrivData;
10164 interp->evalDepth--;
10166 out:
10167 JimDecrCmdRefCount(interp, cmdPtr);
10169 return retcode;
10172 /* Eval the object vector 'objv' composed of 'objc' elements.
10173 * Every element is used as single argument.
10174 * Jim_EvalObj() will call this function every time its object
10175 * argument is of "list" type, with no string representation.
10177 * This is possible because the string representation of a
10178 * list object generated by the UpdateStringOfList is made
10179 * in a way that ensures that every list element is a different
10180 * command argument. */
10181 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10183 int i, retcode;
10185 /* Incr refcount of arguments. */
10186 for (i = 0; i < objc; i++)
10187 Jim_IncrRefCount(objv[i]);
10189 retcode = JimInvokeCommand(interp, objc, objv);
10191 /* Decr refcount of arguments and return the retcode */
10192 for (i = 0; i < objc; i++)
10193 Jim_DecrRefCount(interp, objv[i]);
10195 return retcode;
10199 * Invokes 'prefix' as a command with the objv array as arguments.
10201 int Jim_EvalObjPrefix(Jim_Interp *interp, Jim_Obj *prefix, int objc, Jim_Obj *const *objv)
10203 int ret;
10204 Jim_Obj **nargv = Jim_Alloc((objc + 1) * sizeof(*nargv));
10206 nargv[0] = prefix;
10207 memcpy(&nargv[1], &objv[0], sizeof(nargv[0]) * objc);
10208 ret = Jim_EvalObjVector(interp, objc + 1, nargv);
10209 Jim_Free(nargv);
10210 return ret;
10213 static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script)
10215 if (!interp->errorFlag) {
10216 /* This is the first error, so save the file/line information and reset the stack */
10217 interp->errorFlag = 1;
10218 Jim_IncrRefCount(script->fileNameObj);
10219 Jim_DecrRefCount(interp, interp->errorFileNameObj);
10220 interp->errorFileNameObj = script->fileNameObj;
10221 interp->errorLine = script->linenr;
10223 JimResetStackTrace(interp);
10224 /* Always add a level where the error first occurs */
10225 interp->addStackTrace++;
10228 /* Now if this is an "interesting" level, add it to the stack trace */
10229 if (interp->addStackTrace > 0) {
10230 /* Add the stack info for the current level */
10232 JimAppendStackTrace(interp, Jim_String(interp->errorProc), script->fileNameObj, script->linenr);
10234 /* Note: if we didn't have a filename for this level,
10235 * don't clear the addStackTrace flag
10236 * so we can pick it up at the next level
10238 if (Jim_Length(script->fileNameObj)) {
10239 interp->addStackTrace = 0;
10242 Jim_DecrRefCount(interp, interp->errorProc);
10243 interp->errorProc = interp->emptyObj;
10244 Jim_IncrRefCount(interp->errorProc);
10248 static int JimSubstOneToken(Jim_Interp *interp, const ScriptToken *token, Jim_Obj **objPtrPtr)
10250 Jim_Obj *objPtr;
10252 switch (token->type) {
10253 case JIM_TT_STR:
10254 case JIM_TT_ESC:
10255 objPtr = token->objPtr;
10256 break;
10257 case JIM_TT_VAR:
10258 objPtr = Jim_GetVariable(interp, token->objPtr, JIM_ERRMSG);
10259 break;
10260 case JIM_TT_DICTSUGAR:
10261 objPtr = JimExpandDictSugar(interp, token->objPtr);
10262 break;
10263 case JIM_TT_EXPRSUGAR:
10264 objPtr = JimExpandExprSugar(interp, token->objPtr);
10265 break;
10266 case JIM_TT_CMD:
10267 switch (Jim_EvalObj(interp, token->objPtr)) {
10268 case JIM_OK:
10269 case JIM_RETURN:
10270 objPtr = interp->result;
10271 break;
10272 case JIM_BREAK:
10273 /* Stop substituting */
10274 return JIM_BREAK;
10275 case JIM_CONTINUE:
10276 /* just skip this one */
10277 return JIM_CONTINUE;
10278 default:
10279 return JIM_ERR;
10281 break;
10282 default:
10283 JimPanic((1,
10284 "default token type (%d) reached " "in Jim_SubstObj().", token->type));
10285 objPtr = NULL;
10286 break;
10288 if (objPtr) {
10289 *objPtrPtr = objPtr;
10290 return JIM_OK;
10292 return JIM_ERR;
10295 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
10296 * via *objPtrPtr. This function is only called by Jim_EvalObj() and Jim_SubstObj()
10297 * The returned object has refcount = 0.
10299 static Jim_Obj *JimInterpolateTokens(Jim_Interp *interp, const ScriptToken * token, int tokens, int flags)
10301 int totlen = 0, i;
10302 Jim_Obj **intv;
10303 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
10304 Jim_Obj *objPtr;
10305 char *s;
10307 if (tokens <= JIM_EVAL_SINTV_LEN)
10308 intv = sintv;
10309 else
10310 intv = Jim_Alloc(sizeof(Jim_Obj *) * tokens);
10312 /* Compute every token forming the argument
10313 * in the intv objects vector. */
10314 for (i = 0; i < tokens; i++) {
10315 switch (JimSubstOneToken(interp, &token[i], &intv[i])) {
10316 case JIM_OK:
10317 case JIM_RETURN:
10318 break;
10319 case JIM_BREAK:
10320 if (flags & JIM_SUBST_FLAG) {
10321 /* Stop here */
10322 tokens = i;
10323 continue;
10325 /* XXX: Should probably set an error about break outside loop */
10326 /* fall through to error */
10327 case JIM_CONTINUE:
10328 if (flags & JIM_SUBST_FLAG) {
10329 intv[i] = NULL;
10330 continue;
10332 /* XXX: Ditto continue outside loop */
10333 /* fall through to error */
10334 default:
10335 while (i--) {
10336 Jim_DecrRefCount(interp, intv[i]);
10338 if (intv != sintv) {
10339 Jim_Free(intv);
10341 return NULL;
10343 Jim_IncrRefCount(intv[i]);
10344 Jim_String(intv[i]);
10345 totlen += intv[i]->length;
10348 /* Fast path return for a single token */
10349 if (tokens == 1 && intv[0] && intv == sintv) {
10350 /* Reverse the Jim_IncrRefCount() above, but don't free the object */
10351 intv[0]->refCount--;
10352 return intv[0];
10355 /* Concatenate every token in an unique
10356 * object. */
10357 objPtr = Jim_NewStringObjNoAlloc(interp, NULL, 0);
10359 if (tokens == 4 && token[0].type == JIM_TT_ESC && token[1].type == JIM_TT_ESC
10360 && token[2].type == JIM_TT_VAR) {
10361 /* May be able to do fast interpolated object -> dictSubst */
10362 objPtr->typePtr = &interpolatedObjType;
10363 objPtr->internalRep.dictSubstValue.varNameObjPtr = token[0].objPtr;
10364 objPtr->internalRep.dictSubstValue.indexObjPtr = intv[2];
10365 Jim_IncrRefCount(intv[2]);
10367 else if (tokens && intv[0] && intv[0]->typePtr == &sourceObjType) {
10368 /* The first interpolated token is source, so preserve the source info */
10369 JimSetSourceInfo(interp, objPtr, intv[0]->internalRep.sourceValue.fileNameObj, intv[0]->internalRep.sourceValue.lineNumber);
10373 s = objPtr->bytes = Jim_Alloc(totlen + 1);
10374 objPtr->length = totlen;
10375 for (i = 0; i < tokens; i++) {
10376 if (intv[i]) {
10377 memcpy(s, intv[i]->bytes, intv[i]->length);
10378 s += intv[i]->length;
10379 Jim_DecrRefCount(interp, intv[i]);
10382 objPtr->bytes[totlen] = '\0';
10383 /* Free the intv vector if not static. */
10384 if (intv != sintv) {
10385 Jim_Free(intv);
10388 return objPtr;
10392 /* listPtr *must* be a list.
10393 * The contents of the list is evaluated with the first element as the command and
10394 * the remaining elements as the arguments.
10396 static int JimEvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10398 int retcode = JIM_OK;
10400 JimPanic((Jim_IsList(listPtr) == 0, "JimEvalObjList() invoked on non-list."));
10402 if (listPtr->internalRep.listValue.len) {
10403 Jim_IncrRefCount(listPtr);
10404 retcode = JimInvokeCommand(interp,
10405 listPtr->internalRep.listValue.len,
10406 listPtr->internalRep.listValue.ele);
10407 Jim_DecrRefCount(interp, listPtr);
10409 return retcode;
10412 int Jim_EvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10414 SetListFromAny(interp, listPtr);
10415 return JimEvalObjList(interp, listPtr);
10418 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
10420 int i;
10421 ScriptObj *script;
10422 ScriptToken *token;
10423 int retcode = JIM_OK;
10424 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL;
10425 Jim_Obj *prevScriptObj;
10427 /* If the object is of type "list", with no string rep we can call
10428 * a specialized version of Jim_EvalObj() */
10429 if (Jim_IsList(scriptObjPtr) && scriptObjPtr->bytes == NULL) {
10430 return JimEvalObjList(interp, scriptObjPtr);
10433 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
10434 script = JimGetScript(interp, scriptObjPtr);
10435 if (!JimScriptValid(interp, script)) {
10436 Jim_DecrRefCount(interp, scriptObjPtr);
10437 return JIM_ERR;
10440 /* Reset the interpreter result. This is useful to
10441 * return the empty result in the case of empty program. */
10442 Jim_SetEmptyResult(interp);
10444 token = script->token;
10446 #ifdef JIM_OPTIMIZATION
10447 /* Check for one of the following common scripts used by for, while
10449 * {}
10450 * incr a
10452 if (script->len == 0) {
10453 Jim_DecrRefCount(interp, scriptObjPtr);
10454 return JIM_OK;
10456 if (script->len == 3
10457 && token[1].objPtr->typePtr == &commandObjType
10458 && token[1].objPtr->internalRep.cmdValue.cmdPtr->isproc == 0
10459 && token[1].objPtr->internalRep.cmdValue.cmdPtr->u.native.cmdProc == Jim_IncrCoreCommand
10460 && token[2].objPtr->typePtr == &variableObjType) {
10462 Jim_Obj *objPtr = Jim_GetVariable(interp, token[2].objPtr, JIM_NONE);
10464 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
10465 JimWideValue(objPtr)++;
10466 Jim_InvalidateStringRep(objPtr);
10467 Jim_DecrRefCount(interp, scriptObjPtr);
10468 Jim_SetResult(interp, objPtr);
10469 return JIM_OK;
10472 #endif
10474 /* Now we have to make sure the internal repr will not be
10475 * freed on shimmering.
10477 * Think for example to this:
10479 * set x {llength $x; ... some more code ...}; eval $x
10481 * In order to preserve the internal rep, we increment the
10482 * inUse field of the script internal rep structure. */
10483 script->inUse++;
10485 /* Stash the current script */
10486 prevScriptObj = interp->currentScriptObj;
10487 interp->currentScriptObj = scriptObjPtr;
10489 interp->errorFlag = 0;
10490 argv = sargv;
10492 /* Execute every command sequentially until the end of the script
10493 * or an error occurs.
10495 for (i = 0; i < script->len && retcode == JIM_OK; ) {
10496 int argc;
10497 int j;
10499 /* First token of the line is always JIM_TT_LINE */
10500 argc = token[i].objPtr->internalRep.scriptLineValue.argc;
10501 script->linenr = token[i].objPtr->internalRep.scriptLineValue.line;
10503 /* Allocate the arguments vector if required */
10504 if (argc > JIM_EVAL_SARGV_LEN)
10505 argv = Jim_Alloc(sizeof(Jim_Obj *) * argc);
10507 /* Skip the JIM_TT_LINE token */
10508 i++;
10510 /* Populate the arguments objects.
10511 * If an error occurs, retcode will be set and
10512 * 'j' will be set to the number of args expanded
10514 for (j = 0; j < argc; j++) {
10515 long wordtokens = 1;
10516 int expand = 0;
10517 Jim_Obj *wordObjPtr = NULL;
10519 if (token[i].type == JIM_TT_WORD) {
10520 wordtokens = JimWideValue(token[i++].objPtr);
10521 if (wordtokens < 0) {
10522 expand = 1;
10523 wordtokens = -wordtokens;
10527 if (wordtokens == 1) {
10528 /* Fast path if the token does not
10529 * need interpolation */
10531 switch (token[i].type) {
10532 case JIM_TT_ESC:
10533 case JIM_TT_STR:
10534 wordObjPtr = token[i].objPtr;
10535 break;
10536 case JIM_TT_VAR:
10537 wordObjPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
10538 break;
10539 case JIM_TT_EXPRSUGAR:
10540 wordObjPtr = JimExpandExprSugar(interp, token[i].objPtr);
10541 break;
10542 case JIM_TT_DICTSUGAR:
10543 wordObjPtr = JimExpandDictSugar(interp, token[i].objPtr);
10544 break;
10545 case JIM_TT_CMD:
10546 retcode = Jim_EvalObj(interp, token[i].objPtr);
10547 if (retcode == JIM_OK) {
10548 wordObjPtr = Jim_GetResult(interp);
10550 break;
10551 default:
10552 JimPanic((1, "default token type reached " "in Jim_EvalObj()."));
10555 else {
10556 /* For interpolation we call a helper
10557 * function to do the work for us. */
10558 wordObjPtr = JimInterpolateTokens(interp, token + i, wordtokens, JIM_NONE);
10561 if (!wordObjPtr) {
10562 if (retcode == JIM_OK) {
10563 retcode = JIM_ERR;
10565 break;
10568 Jim_IncrRefCount(wordObjPtr);
10569 i += wordtokens;
10571 if (!expand) {
10572 argv[j] = wordObjPtr;
10574 else {
10575 /* Need to expand wordObjPtr into multiple args from argv[j] ... */
10576 int len = Jim_ListLength(interp, wordObjPtr);
10577 int newargc = argc + len - 1;
10578 int k;
10580 if (len > 1) {
10581 if (argv == sargv) {
10582 if (newargc > JIM_EVAL_SARGV_LEN) {
10583 argv = Jim_Alloc(sizeof(*argv) * newargc);
10584 memcpy(argv, sargv, sizeof(*argv) * j);
10587 else {
10588 /* Need to realloc to make room for (len - 1) more entries */
10589 argv = Jim_Realloc(argv, sizeof(*argv) * newargc);
10593 /* Now copy in the expanded version */
10594 for (k = 0; k < len; k++) {
10595 argv[j++] = wordObjPtr->internalRep.listValue.ele[k];
10596 Jim_IncrRefCount(wordObjPtr->internalRep.listValue.ele[k]);
10599 /* The original object reference is no longer needed,
10600 * after the expansion it is no longer present on
10601 * the argument vector, but the single elements are
10602 * in its place. */
10603 Jim_DecrRefCount(interp, wordObjPtr);
10605 /* And update the indexes */
10606 j--;
10607 argc += len - 1;
10611 if (retcode == JIM_OK && argc) {
10612 /* Invoke the command */
10613 retcode = JimInvokeCommand(interp, argc, argv);
10614 /* Check for a signal after each command */
10615 if (Jim_CheckSignal(interp)) {
10616 retcode = JIM_SIGNAL;
10620 /* Finished with the command, so decrement ref counts of each argument */
10621 while (j-- > 0) {
10622 Jim_DecrRefCount(interp, argv[j]);
10625 if (argv != sargv) {
10626 Jim_Free(argv);
10627 argv = sargv;
10631 /* Possibly add to the error stack trace */
10632 if (retcode == JIM_ERR) {
10633 JimAddErrorToStack(interp, script);
10635 /* Propagate the addStackTrace value through 'return -code error' */
10636 else if (retcode != JIM_RETURN || interp->returnCode != JIM_ERR) {
10637 /* No need to add stack trace */
10638 interp->addStackTrace = 0;
10641 /* Restore the current script */
10642 interp->currentScriptObj = prevScriptObj;
10644 /* Note that we don't have to decrement inUse, because the
10645 * following code transfers our use of the reference again to
10646 * the script object. */
10647 Jim_FreeIntRep(interp, scriptObjPtr);
10648 scriptObjPtr->typePtr = &scriptObjType;
10649 Jim_SetIntRepPtr(scriptObjPtr, script);
10650 Jim_DecrRefCount(interp, scriptObjPtr);
10652 return retcode;
10655 static int JimSetProcArg(Jim_Interp *interp, Jim_Obj *argNameObj, Jim_Obj *argValObj)
10657 int retcode;
10658 /* If argObjPtr begins with '&', do an automatic upvar */
10659 const char *varname = Jim_String(argNameObj);
10660 if (*varname == '&') {
10661 /* First check that the target variable exists */
10662 Jim_Obj *objPtr;
10663 Jim_CallFrame *savedCallFrame = interp->framePtr;
10665 interp->framePtr = interp->framePtr->parent;
10666 objPtr = Jim_GetVariable(interp, argValObj, JIM_ERRMSG);
10667 interp->framePtr = savedCallFrame;
10668 if (!objPtr) {
10669 return JIM_ERR;
10672 /* It exists, so perform the binding. */
10673 objPtr = Jim_NewStringObj(interp, varname + 1, -1);
10674 Jim_IncrRefCount(objPtr);
10675 retcode = Jim_SetVariableLink(interp, objPtr, argValObj, interp->framePtr->parent);
10676 Jim_DecrRefCount(interp, objPtr);
10678 else {
10679 retcode = Jim_SetVariable(interp, argNameObj, argValObj);
10681 return retcode;
10685 * Sets the interp result to be an error message indicating the required proc args.
10687 static void JimSetProcWrongArgs(Jim_Interp *interp, Jim_Obj *procNameObj, Jim_Cmd *cmd)
10689 /* Create a nice error message, consistent with Tcl 8.5 */
10690 Jim_Obj *argmsg = Jim_NewStringObj(interp, "", 0);
10691 int i;
10693 for (i = 0; i < cmd->u.proc.argListLen; i++) {
10694 Jim_AppendString(interp, argmsg, " ", 1);
10696 if (i == cmd->u.proc.argsPos) {
10697 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10698 /* Renamed args */
10699 Jim_AppendString(interp, argmsg, "?", 1);
10700 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].defaultObjPtr);
10701 Jim_AppendString(interp, argmsg, " ...?", -1);
10703 else {
10704 /* We have plain args */
10705 Jim_AppendString(interp, argmsg, "?arg...?", -1);
10708 else {
10709 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10710 Jim_AppendString(interp, argmsg, "?", 1);
10711 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].nameObjPtr);
10712 Jim_AppendString(interp, argmsg, "?", 1);
10714 else {
10715 const char *arg = Jim_String(cmd->u.proc.arglist[i].nameObjPtr);
10716 if (*arg == '&') {
10717 arg++;
10719 Jim_AppendString(interp, argmsg, arg, -1);
10723 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s%#s\"", procNameObj, argmsg);
10726 #ifdef jim_ext_namespace
10728 * [namespace eval]
10730 int Jim_EvalNamespace(Jim_Interp *interp, Jim_Obj *scriptObj, Jim_Obj *nsObj)
10732 Jim_CallFrame *callFramePtr;
10733 int retcode;
10735 /* Create a new callframe */
10736 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, nsObj);
10737 callFramePtr->argv = &interp->emptyObj;
10738 callFramePtr->argc = 0;
10739 callFramePtr->procArgsObjPtr = NULL;
10740 callFramePtr->procBodyObjPtr = scriptObj;
10741 callFramePtr->staticVars = NULL;
10742 callFramePtr->fileNameObj = interp->emptyObj;
10743 callFramePtr->line = 0;
10744 Jim_IncrRefCount(scriptObj);
10745 interp->framePtr = callFramePtr;
10747 /* Check if there are too nested calls */
10748 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10749 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10750 retcode = JIM_ERR;
10752 else {
10753 /* Eval the body */
10754 retcode = Jim_EvalObj(interp, scriptObj);
10757 /* Destroy the callframe */
10758 interp->framePtr = interp->framePtr->parent;
10759 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10761 return retcode;
10763 #endif
10765 /* Call a procedure implemented in Tcl.
10766 * It's possible to speed-up a lot this function, currently
10767 * the callframes are not cached, but allocated and
10768 * destroied every time. What is expecially costly is
10769 * to create/destroy the local vars hash table every time.
10771 * This can be fixed just implementing callframes caching
10772 * in JimCreateCallFrame() and JimFreeCallFrame(). */
10773 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv)
10775 Jim_CallFrame *callFramePtr;
10776 int i, d, retcode, optargs;
10777 ScriptObj *script;
10779 /* Check arity */
10780 if (argc - 1 < cmd->u.proc.reqArity ||
10781 (cmd->u.proc.argsPos < 0 && argc - 1 > cmd->u.proc.reqArity + cmd->u.proc.optArity)) {
10782 JimSetProcWrongArgs(interp, argv[0], cmd);
10783 return JIM_ERR;
10786 if (Jim_Length(cmd->u.proc.bodyObjPtr) == 0) {
10787 /* Optimise for procedure with no body - useful for optional debugging */
10788 return JIM_OK;
10791 /* Check if there are too nested calls */
10792 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10793 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10794 return JIM_ERR;
10797 /* Create a new callframe */
10798 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, cmd->u.proc.nsObj);
10799 callFramePtr->argv = argv;
10800 callFramePtr->argc = argc;
10801 callFramePtr->procArgsObjPtr = cmd->u.proc.argListObjPtr;
10802 callFramePtr->procBodyObjPtr = cmd->u.proc.bodyObjPtr;
10803 callFramePtr->staticVars = cmd->u.proc.staticVars;
10805 /* Remember where we were called from. */
10806 script = JimGetScript(interp, interp->currentScriptObj);
10807 callFramePtr->fileNameObj = script->fileNameObj;
10808 callFramePtr->line = script->linenr;
10810 Jim_IncrRefCount(cmd->u.proc.argListObjPtr);
10811 Jim_IncrRefCount(cmd->u.proc.bodyObjPtr);
10812 interp->framePtr = callFramePtr;
10814 /* How many optional args are available */
10815 optargs = (argc - 1 - cmd->u.proc.reqArity);
10817 /* Step 'i' along the actual args, and step 'd' along the formal args */
10818 i = 1;
10819 for (d = 0; d < cmd->u.proc.argListLen; d++) {
10820 Jim_Obj *nameObjPtr = cmd->u.proc.arglist[d].nameObjPtr;
10821 if (d == cmd->u.proc.argsPos) {
10822 /* assign $args */
10823 Jim_Obj *listObjPtr;
10824 int argsLen = 0;
10825 if (cmd->u.proc.reqArity + cmd->u.proc.optArity < argc - 1) {
10826 argsLen = argc - 1 - (cmd->u.proc.reqArity + cmd->u.proc.optArity);
10828 listObjPtr = Jim_NewListObj(interp, &argv[i], argsLen);
10830 /* It is possible to rename args. */
10831 if (cmd->u.proc.arglist[d].defaultObjPtr) {
10832 nameObjPtr =cmd->u.proc.arglist[d].defaultObjPtr;
10834 retcode = Jim_SetVariable(interp, nameObjPtr, listObjPtr);
10835 if (retcode != JIM_OK) {
10836 goto badargset;
10839 i += argsLen;
10840 continue;
10843 /* Optional or required? */
10844 if (cmd->u.proc.arglist[d].defaultObjPtr == NULL || optargs-- > 0) {
10845 retcode = JimSetProcArg(interp, nameObjPtr, argv[i++]);
10847 else {
10848 /* Ran out, so use the default */
10849 retcode = Jim_SetVariable(interp, nameObjPtr, cmd->u.proc.arglist[d].defaultObjPtr);
10851 if (retcode != JIM_OK) {
10852 goto badargset;
10856 /* Eval the body */
10857 retcode = Jim_EvalObj(interp, cmd->u.proc.bodyObjPtr);
10859 badargset:
10861 /* Invoke $jim::defer then destroy the callframe */
10862 retcode = JimInvokeDefer(interp, retcode);
10863 interp->framePtr = interp->framePtr->parent;
10864 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10866 /* Now chain any tailcalls in the parent frame */
10867 if (interp->framePtr->tailcallObj) {
10868 do {
10869 Jim_Obj *tailcallObj = interp->framePtr->tailcallObj;
10871 interp->framePtr->tailcallObj = NULL;
10873 if (retcode == JIM_EVAL) {
10874 retcode = Jim_EvalObjList(interp, tailcallObj);
10875 if (retcode == JIM_RETURN) {
10876 /* If the result of the tailcall is 'return', push
10877 * it up to the caller
10879 interp->returnLevel++;
10882 Jim_DecrRefCount(interp, tailcallObj);
10883 } while (interp->framePtr->tailcallObj);
10885 /* If the tailcall chain finished early, may need to manually discard the command */
10886 if (interp->framePtr->tailcallCmd) {
10887 JimDecrCmdRefCount(interp, interp->framePtr->tailcallCmd);
10888 interp->framePtr->tailcallCmd = NULL;
10892 /* Handle the JIM_RETURN return code */
10893 if (retcode == JIM_RETURN) {
10894 if (--interp->returnLevel <= 0) {
10895 retcode = interp->returnCode;
10896 interp->returnCode = JIM_OK;
10897 interp->returnLevel = 0;
10900 else if (retcode == JIM_ERR) {
10901 interp->addStackTrace++;
10902 Jim_DecrRefCount(interp, interp->errorProc);
10903 interp->errorProc = argv[0];
10904 Jim_IncrRefCount(interp->errorProc);
10907 return retcode;
10910 int Jim_EvalSource(Jim_Interp *interp, const char *filename, int lineno, const char *script)
10912 int retval;
10913 Jim_Obj *scriptObjPtr;
10915 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
10916 Jim_IncrRefCount(scriptObjPtr);
10918 if (filename) {
10919 Jim_Obj *prevScriptObj;
10921 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), lineno);
10923 prevScriptObj = interp->currentScriptObj;
10924 interp->currentScriptObj = scriptObjPtr;
10926 retval = Jim_EvalObj(interp, scriptObjPtr);
10928 interp->currentScriptObj = prevScriptObj;
10930 else {
10931 retval = Jim_EvalObj(interp, scriptObjPtr);
10933 Jim_DecrRefCount(interp, scriptObjPtr);
10934 return retval;
10937 int Jim_Eval(Jim_Interp *interp, const char *script)
10939 return Jim_EvalObj(interp, Jim_NewStringObj(interp, script, -1));
10942 /* Execute script in the scope of the global level */
10943 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
10945 int retval;
10946 Jim_CallFrame *savedFramePtr = interp->framePtr;
10948 interp->framePtr = interp->topFramePtr;
10949 retval = Jim_Eval(interp, script);
10950 interp->framePtr = savedFramePtr;
10952 return retval;
10955 int Jim_EvalFileGlobal(Jim_Interp *interp, const char *filename)
10957 int retval;
10958 Jim_CallFrame *savedFramePtr = interp->framePtr;
10960 interp->framePtr = interp->topFramePtr;
10961 retval = Jim_EvalFile(interp, filename);
10962 interp->framePtr = savedFramePtr;
10964 return retval;
10967 #include <sys/stat.h>
10969 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
10971 FILE *fp;
10972 char *buf;
10973 Jim_Obj *scriptObjPtr;
10974 Jim_Obj *prevScriptObj;
10975 struct stat sb;
10976 int retcode;
10977 int readlen;
10979 if (stat(filename, &sb) != 0 || (fp = fopen(filename, "rt")) == NULL) {
10980 Jim_SetResultFormatted(interp, "couldn't read file \"%s\": %s", filename, strerror(errno));
10981 return JIM_ERR;
10983 if (sb.st_size == 0) {
10984 fclose(fp);
10985 return JIM_OK;
10988 buf = Jim_Alloc(sb.st_size + 1);
10989 readlen = fread(buf, 1, sb.st_size, fp);
10990 if (ferror(fp)) {
10991 fclose(fp);
10992 Jim_Free(buf);
10993 Jim_SetResultFormatted(interp, "failed to load file \"%s\": %s", filename, strerror(errno));
10994 return JIM_ERR;
10996 fclose(fp);
10997 buf[readlen] = 0;
10999 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, buf, readlen);
11000 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), 1);
11001 Jim_IncrRefCount(scriptObjPtr);
11003 prevScriptObj = interp->currentScriptObj;
11004 interp->currentScriptObj = scriptObjPtr;
11006 retcode = Jim_EvalObj(interp, scriptObjPtr);
11008 /* Handle the JIM_RETURN return code */
11009 if (retcode == JIM_RETURN) {
11010 if (--interp->returnLevel <= 0) {
11011 retcode = interp->returnCode;
11012 interp->returnCode = JIM_OK;
11013 interp->returnLevel = 0;
11016 if (retcode == JIM_ERR) {
11017 /* EvalFile changes context, so add a stack frame here */
11018 interp->addStackTrace++;
11021 interp->currentScriptObj = prevScriptObj;
11023 Jim_DecrRefCount(interp, scriptObjPtr);
11025 return retcode;
11028 /* -----------------------------------------------------------------------------
11029 * Subst
11030 * ---------------------------------------------------------------------------*/
11031 static void JimParseSubst(struct JimParserCtx *pc, int flags)
11033 pc->tstart = pc->p;
11034 pc->tline = pc->linenr;
11036 if (pc->len == 0) {
11037 pc->tend = pc->p;
11038 pc->tt = JIM_TT_EOL;
11039 pc->eof = 1;
11040 return;
11042 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11043 JimParseCmd(pc);
11044 return;
11046 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11047 if (JimParseVar(pc) == JIM_OK) {
11048 return;
11050 /* Not a var, so treat as a string */
11051 pc->tstart = pc->p;
11052 flags |= JIM_SUBST_NOVAR;
11054 while (pc->len) {
11055 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11056 break;
11058 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11059 break;
11061 if (*pc->p == '\\' && pc->len > 1) {
11062 pc->p++;
11063 pc->len--;
11065 pc->p++;
11066 pc->len--;
11068 pc->tend = pc->p - 1;
11069 pc->tt = (flags & JIM_SUBST_NOESC) ? JIM_TT_STR : JIM_TT_ESC;
11072 /* The subst object type reuses most of the data structures and functions
11073 * of the script object. Script's data structures are a bit more complex
11074 * for what is needed for [subst]itution tasks, but the reuse helps to
11075 * deal with a single data structure at the cost of some more memory
11076 * usage for substitutions. */
11078 /* This method takes the string representation of an object
11079 * as a Tcl string where to perform [subst]itution, and generates
11080 * the pre-parsed internal representation. */
11081 static int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
11083 int scriptTextLen;
11084 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
11085 struct JimParserCtx parser;
11086 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
11087 ParseTokenList tokenlist;
11089 /* Initially parse the subst into tokens (in tokenlist) */
11090 ScriptTokenListInit(&tokenlist);
11092 JimParserInit(&parser, scriptText, scriptTextLen, 1);
11093 while (1) {
11094 JimParseSubst(&parser, flags);
11095 if (parser.eof) {
11096 /* Note that subst doesn't need the EOL token */
11097 break;
11099 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
11100 parser.tline);
11103 /* Create the "real" subst/script tokens from the initial token list */
11104 script->inUse = 1;
11105 script->substFlags = flags;
11106 script->fileNameObj = interp->emptyObj;
11107 Jim_IncrRefCount(script->fileNameObj);
11108 SubstObjAddTokens(interp, script, &tokenlist);
11110 /* No longer need the token list */
11111 ScriptTokenListFree(&tokenlist);
11113 #ifdef DEBUG_SHOW_SUBST
11115 int i;
11117 printf("==== Subst ====\n");
11118 for (i = 0; i < script->len; i++) {
11119 printf("[%2d] %s '%s'\n", i, jim_tt_name(script->token[i].type),
11120 Jim_String(script->token[i].objPtr));
11123 #endif
11125 /* Free the old internal rep and set the new one. */
11126 Jim_FreeIntRep(interp, objPtr);
11127 Jim_SetIntRepPtr(objPtr, script);
11128 objPtr->typePtr = &scriptObjType;
11129 return JIM_OK;
11132 static ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
11134 if (objPtr->typePtr != &scriptObjType || ((ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags != flags)
11135 SetSubstFromAny(interp, objPtr, flags);
11136 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
11139 /* Performs commands,variables,blackslashes substitution,
11140 * storing the result object (with refcount 0) into
11141 * resObjPtrPtr. */
11142 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr, Jim_Obj **resObjPtrPtr, int flags)
11144 ScriptObj *script;
11146 JimPanic((substObjPtr->refCount == 0, "Jim_SubstObj() called with zero refcount object"));
11148 script = Jim_GetSubst(interp, substObjPtr, flags);
11150 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
11151 /* In order to preserve the internal rep, we increment the
11152 * inUse field of the script internal rep structure. */
11153 script->inUse++;
11155 *resObjPtrPtr = JimInterpolateTokens(interp, script->token, script->len, flags);
11157 script->inUse--;
11158 Jim_DecrRefCount(interp, substObjPtr);
11159 if (*resObjPtrPtr == NULL) {
11160 return JIM_ERR;
11162 return JIM_OK;
11165 /* -----------------------------------------------------------------------------
11166 * Core commands utility functions
11167 * ---------------------------------------------------------------------------*/
11168 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv, const char *msg)
11170 Jim_Obj *objPtr;
11171 Jim_Obj *listObjPtr;
11173 JimPanic((argc == 0, "Jim_WrongNumArgs() called with argc=0"));
11175 listObjPtr = Jim_NewListObj(interp, argv, argc);
11177 if (msg && *msg) {
11178 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, msg, -1));
11180 Jim_IncrRefCount(listObjPtr);
11181 objPtr = Jim_ListJoin(interp, listObjPtr, " ", 1);
11182 Jim_DecrRefCount(interp, listObjPtr);
11184 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s\"", objPtr);
11188 * May add the key and/or value to the list.
11190 typedef void JimHashtableIteratorCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr,
11191 Jim_HashEntry *he, int type);
11193 #define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL)
11196 * For each key of the hash table 'ht' (with string keys) which matches the glob pattern (all if NULL),
11197 * invoke the callback to add entries to a list.
11198 * Returns the list.
11200 static Jim_Obj *JimHashtablePatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
11201 JimHashtableIteratorCallbackType *callback, int type)
11203 Jim_HashEntry *he;
11204 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
11206 /* Check for the non-pattern case. We can do this much more efficiently. */
11207 if (patternObjPtr && JimTrivialMatch(Jim_String(patternObjPtr))) {
11208 he = Jim_FindHashEntry(ht, Jim_String(patternObjPtr));
11209 if (he) {
11210 callback(interp, listObjPtr, he, type);
11213 else {
11214 Jim_HashTableIterator htiter;
11215 JimInitHashTableIterator(ht, &htiter);
11216 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
11217 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), he->key, 0)) {
11218 callback(interp, listObjPtr, he, type);
11222 return listObjPtr;
11225 /* Keep these in order */
11226 #define JIM_CMDLIST_COMMANDS 0
11227 #define JIM_CMDLIST_PROCS 1
11228 #define JIM_CMDLIST_CHANNELS 2
11231 * Adds matching command names (procs, channels) to the list.
11233 static void JimCommandMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11234 Jim_HashEntry *he, int type)
11236 Jim_Cmd *cmdPtr = Jim_GetHashEntryVal(he);
11237 Jim_Obj *objPtr;
11239 if (type == JIM_CMDLIST_PROCS && !cmdPtr->isproc) {
11240 /* not a proc */
11241 return;
11244 objPtr = Jim_NewStringObj(interp, he->key, -1);
11245 Jim_IncrRefCount(objPtr);
11247 if (type != JIM_CMDLIST_CHANNELS || Jim_AioFilehandle(interp, objPtr)) {
11248 Jim_ListAppendElement(interp, listObjPtr, objPtr);
11250 Jim_DecrRefCount(interp, objPtr);
11253 /* type is JIM_CMDLIST_xxx */
11254 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int type)
11256 return JimHashtablePatternMatch(interp, &interp->commands, patternObjPtr, JimCommandMatch, type);
11259 /* Keep these in order */
11260 #define JIM_VARLIST_GLOBALS 0
11261 #define JIM_VARLIST_LOCALS 1
11262 #define JIM_VARLIST_VARS 2
11264 #define JIM_VARLIST_VALUES 0x1000
11267 * Adds matching variable names to the list.
11269 static void JimVariablesMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11270 Jim_HashEntry *he, int type)
11272 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
11274 if (type != JIM_VARLIST_LOCALS || varPtr->linkFramePtr == NULL) {
11275 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, he->key, -1));
11276 if (type & JIM_VARLIST_VALUES) {
11277 Jim_ListAppendElement(interp, listObjPtr, varPtr->objPtr);
11282 /* mode is JIM_VARLIST_xxx */
11283 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int mode)
11285 if (mode == JIM_VARLIST_LOCALS && interp->framePtr == interp->topFramePtr) {
11286 /* For [info locals], if we are at top level an emtpy list
11287 * is returned. I don't agree, but we aim at compatibility (SS) */
11288 return interp->emptyObj;
11290 else {
11291 Jim_CallFrame *framePtr = (mode == JIM_VARLIST_GLOBALS) ? interp->topFramePtr : interp->framePtr;
11292 return JimHashtablePatternMatch(interp, &framePtr->vars, patternObjPtr, JimVariablesMatch, mode);
11296 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
11297 Jim_Obj **objPtrPtr, int info_level_cmd)
11299 Jim_CallFrame *targetCallFrame;
11301 targetCallFrame = JimGetCallFrameByInteger(interp, levelObjPtr);
11302 if (targetCallFrame == NULL) {
11303 return JIM_ERR;
11305 /* No proc call at toplevel callframe */
11306 if (targetCallFrame == interp->topFramePtr) {
11307 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
11308 return JIM_ERR;
11310 if (info_level_cmd) {
11311 *objPtrPtr = Jim_NewListObj(interp, targetCallFrame->argv, targetCallFrame->argc);
11313 else {
11314 Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0);
11316 Jim_ListAppendElement(interp, listObj, targetCallFrame->argv[0]);
11317 Jim_ListAppendElement(interp, listObj, targetCallFrame->fileNameObj);
11318 Jim_ListAppendElement(interp, listObj, Jim_NewIntObj(interp, targetCallFrame->line));
11319 *objPtrPtr = listObj;
11321 return JIM_OK;
11324 /* -----------------------------------------------------------------------------
11325 * Core commands
11326 * ---------------------------------------------------------------------------*/
11328 /* fake [puts] -- not the real puts, just for debugging. */
11329 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11331 if (argc != 2 && argc != 3) {
11332 Jim_WrongNumArgs(interp, 1, argv, "?-nonewline? string");
11333 return JIM_ERR;
11335 if (argc == 3) {
11336 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline")) {
11337 Jim_SetResultString(interp, "The second argument must " "be -nonewline", -1);
11338 return JIM_ERR;
11340 else {
11341 fputs(Jim_String(argv[2]), stdout);
11344 else {
11345 puts(Jim_String(argv[1]));
11347 return JIM_OK;
11350 /* Helper for [+] and [*] */
11351 static int JimAddMulHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11353 jim_wide wideValue, res;
11354 double doubleValue, doubleRes;
11355 int i;
11357 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
11359 for (i = 1; i < argc; i++) {
11360 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
11361 goto trydouble;
11362 if (op == JIM_EXPROP_ADD)
11363 res += wideValue;
11364 else
11365 res *= wideValue;
11367 Jim_SetResultInt(interp, res);
11368 return JIM_OK;
11369 trydouble:
11370 doubleRes = (double)res;
11371 for (; i < argc; i++) {
11372 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11373 return JIM_ERR;
11374 if (op == JIM_EXPROP_ADD)
11375 doubleRes += doubleValue;
11376 else
11377 doubleRes *= doubleValue;
11379 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11380 return JIM_OK;
11383 /* Helper for [-] and [/] */
11384 static int JimSubDivHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11386 jim_wide wideValue, res = 0;
11387 double doubleValue, doubleRes = 0;
11388 int i = 2;
11390 if (argc < 2) {
11391 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
11392 return JIM_ERR;
11394 else if (argc == 2) {
11395 /* The arity = 2 case is different. For [- x] returns -x,
11396 * while [/ x] returns 1/x. */
11397 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
11398 if (Jim_GetDouble(interp, argv[1], &doubleValue) != JIM_OK) {
11399 return JIM_ERR;
11401 else {
11402 if (op == JIM_EXPROP_SUB)
11403 doubleRes = -doubleValue;
11404 else
11405 doubleRes = 1.0 / doubleValue;
11406 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11407 return JIM_OK;
11410 if (op == JIM_EXPROP_SUB) {
11411 res = -wideValue;
11412 Jim_SetResultInt(interp, res);
11414 else {
11415 doubleRes = 1.0 / wideValue;
11416 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11418 return JIM_OK;
11420 else {
11421 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
11422 if (Jim_GetDouble(interp, argv[1], &doubleRes)
11423 != JIM_OK) {
11424 return JIM_ERR;
11426 else {
11427 goto trydouble;
11431 for (i = 2; i < argc; i++) {
11432 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
11433 doubleRes = (double)res;
11434 goto trydouble;
11436 if (op == JIM_EXPROP_SUB)
11437 res -= wideValue;
11438 else {
11439 if (wideValue == 0) {
11440 Jim_SetResultString(interp, "Division by zero", -1);
11441 return JIM_ERR;
11443 res /= wideValue;
11446 Jim_SetResultInt(interp, res);
11447 return JIM_OK;
11448 trydouble:
11449 for (; i < argc; i++) {
11450 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11451 return JIM_ERR;
11452 if (op == JIM_EXPROP_SUB)
11453 doubleRes -= doubleValue;
11454 else
11455 doubleRes /= doubleValue;
11457 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11458 return JIM_OK;
11462 /* [+] */
11463 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11465 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
11468 /* [*] */
11469 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11471 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
11474 /* [-] */
11475 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11477 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
11480 /* [/] */
11481 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11483 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
11486 /* [set] */
11487 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11489 if (argc != 2 && argc != 3) {
11490 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
11491 return JIM_ERR;
11493 if (argc == 2) {
11494 Jim_Obj *objPtr;
11496 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11497 if (!objPtr)
11498 return JIM_ERR;
11499 Jim_SetResult(interp, objPtr);
11500 return JIM_OK;
11502 /* argc == 3 case. */
11503 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
11504 return JIM_ERR;
11505 Jim_SetResult(interp, argv[2]);
11506 return JIM_OK;
11509 /* [unset]
11511 * unset ?-nocomplain? ?--? ?varName ...?
11513 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11515 int i = 1;
11516 int complain = 1;
11518 while (i < argc) {
11519 if (Jim_CompareStringImmediate(interp, argv[i], "--")) {
11520 i++;
11521 break;
11523 if (Jim_CompareStringImmediate(interp, argv[i], "-nocomplain")) {
11524 complain = 0;
11525 i++;
11526 continue;
11528 break;
11531 while (i < argc) {
11532 if (Jim_UnsetVariable(interp, argv[i], complain ? JIM_ERRMSG : JIM_NONE) != JIM_OK
11533 && complain) {
11534 return JIM_ERR;
11536 i++;
11538 return JIM_OK;
11541 /* [while] */
11542 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11544 if (argc != 3) {
11545 Jim_WrongNumArgs(interp, 1, argv, "condition body");
11546 return JIM_ERR;
11549 /* The general purpose implementation of while starts here */
11550 while (1) {
11551 int boolean, retval;
11553 if ((retval = Jim_GetBoolFromExpr(interp, argv[1], &boolean)) != JIM_OK)
11554 return retval;
11555 if (!boolean)
11556 break;
11558 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
11559 switch (retval) {
11560 case JIM_BREAK:
11561 goto out;
11562 break;
11563 case JIM_CONTINUE:
11564 continue;
11565 break;
11566 default:
11567 return retval;
11571 out:
11572 Jim_SetEmptyResult(interp);
11573 return JIM_OK;
11576 /* [for] */
11577 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11579 int retval;
11580 int boolean = 1;
11581 Jim_Obj *varNamePtr = NULL;
11582 Jim_Obj *stopVarNamePtr = NULL;
11584 if (argc != 5) {
11585 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
11586 return JIM_ERR;
11589 /* Do the initialisation */
11590 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK) {
11591 return retval;
11594 /* And do the first test now. Better for optimisation
11595 * if we can do next/test at the bottom of the loop
11597 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11599 /* Ready to do the body as follows:
11600 * while (1) {
11601 * body // check retcode
11602 * next // check retcode
11603 * test // check retcode/test bool
11607 #ifdef JIM_OPTIMIZATION
11608 /* Check if the for is on the form:
11609 * for ... {$i < CONST} {incr i}
11610 * for ... {$i < $j} {incr i}
11612 if (retval == JIM_OK && boolean) {
11613 ScriptObj *incrScript;
11614 struct ExprTree *expr;
11615 jim_wide stop, currentVal;
11616 Jim_Obj *objPtr;
11617 int cmpOffset;
11619 /* Do it only if there aren't shared arguments */
11620 expr = JimGetExpression(interp, argv[2]);
11621 incrScript = JimGetScript(interp, argv[3]);
11623 /* Ensure proper lengths to start */
11624 if (incrScript == NULL || incrScript->len != 3 || !expr || expr->len != 3) {
11625 goto evalstart;
11627 /* Ensure proper token types. */
11628 if (incrScript->token[1].type != JIM_TT_ESC) {
11629 goto evalstart;
11632 if (expr->expr->type == JIM_EXPROP_LT) {
11633 cmpOffset = 0;
11635 else if (expr->expr->type == JIM_EXPROP_LTE) {
11636 cmpOffset = 1;
11638 else {
11639 goto evalstart;
11642 if (expr->expr->left->type != JIM_TT_VAR) {
11643 goto evalstart;
11646 if (expr->expr->right->type != JIM_TT_VAR && expr->expr->right->type != JIM_TT_EXPR_INT) {
11647 goto evalstart;
11650 /* Update command must be incr */
11651 if (!Jim_CompareStringImmediate(interp, incrScript->token[1].objPtr, "incr")) {
11652 goto evalstart;
11655 /* incr, expression must be about the same variable */
11656 if (!Jim_StringEqObj(incrScript->token[2].objPtr, expr->expr->left->objPtr)) {
11657 goto evalstart;
11660 /* Get the stop condition (must be a variable or integer) */
11661 if (expr->expr->right->type == JIM_TT_EXPR_INT) {
11662 if (Jim_GetWide(interp, expr->expr->right->objPtr, &stop) == JIM_ERR) {
11663 goto evalstart;
11666 else {
11667 stopVarNamePtr = expr->expr->right->objPtr;
11668 Jim_IncrRefCount(stopVarNamePtr);
11669 /* Keep the compiler happy */
11670 stop = 0;
11673 /* Initialization */
11674 varNamePtr = expr->expr->left->objPtr;
11675 Jim_IncrRefCount(varNamePtr);
11677 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
11678 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK) {
11679 goto testcond;
11682 /* --- OPTIMIZED FOR --- */
11683 while (retval == JIM_OK) {
11684 /* === Check condition === */
11685 /* Note that currentVal is already set here */
11687 /* Immediate or Variable? get the 'stop' value if the latter. */
11688 if (stopVarNamePtr) {
11689 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
11690 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &stop) != JIM_OK) {
11691 goto testcond;
11695 if (currentVal >= stop + cmpOffset) {
11696 break;
11699 /* Eval body */
11700 retval = Jim_EvalObj(interp, argv[4]);
11701 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11702 retval = JIM_OK;
11704 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
11706 /* Increment */
11707 if (objPtr == NULL) {
11708 retval = JIM_ERR;
11709 goto out;
11711 if (!Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11712 currentVal = ++JimWideValue(objPtr);
11713 Jim_InvalidateStringRep(objPtr);
11715 else {
11716 if (Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK ||
11717 Jim_SetVariable(interp, varNamePtr, Jim_NewIntObj(interp,
11718 ++currentVal)) != JIM_OK) {
11719 goto evalnext;
11724 goto out;
11726 evalstart:
11727 #endif
11729 while (boolean && (retval == JIM_OK || retval == JIM_CONTINUE)) {
11730 /* Body */
11731 retval = Jim_EvalObj(interp, argv[4]);
11733 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11734 /* increment */
11735 JIM_IF_OPTIM(evalnext:)
11736 retval = Jim_EvalObj(interp, argv[3]);
11737 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11738 /* test */
11739 JIM_IF_OPTIM(testcond:)
11740 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11744 JIM_IF_OPTIM(out:)
11745 if (stopVarNamePtr) {
11746 Jim_DecrRefCount(interp, stopVarNamePtr);
11748 if (varNamePtr) {
11749 Jim_DecrRefCount(interp, varNamePtr);
11752 if (retval == JIM_CONTINUE || retval == JIM_BREAK || retval == JIM_OK) {
11753 Jim_SetEmptyResult(interp);
11754 return JIM_OK;
11757 return retval;
11760 /* [loop] */
11761 static int Jim_LoopCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11763 int retval;
11764 jim_wide i;
11765 jim_wide limit;
11766 jim_wide incr = 1;
11767 Jim_Obj *bodyObjPtr;
11769 if (argc != 5 && argc != 6) {
11770 Jim_WrongNumArgs(interp, 1, argv, "var first limit ?incr? body");
11771 return JIM_ERR;
11774 if (Jim_GetWide(interp, argv[2], &i) != JIM_OK ||
11775 Jim_GetWide(interp, argv[3], &limit) != JIM_OK ||
11776 (argc == 6 && Jim_GetWide(interp, argv[4], &incr) != JIM_OK)) {
11777 return JIM_ERR;
11779 bodyObjPtr = (argc == 5) ? argv[4] : argv[5];
11781 retval = Jim_SetVariable(interp, argv[1], argv[2]);
11783 while (((i < limit && incr > 0) || (i > limit && incr < 0)) && retval == JIM_OK) {
11784 retval = Jim_EvalObj(interp, bodyObjPtr);
11785 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11786 Jim_Obj *objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11788 retval = JIM_OK;
11790 /* Increment */
11791 i += incr;
11793 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11794 if (argv[1]->typePtr != &variableObjType) {
11795 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11796 return JIM_ERR;
11799 JimWideValue(objPtr) = i;
11800 Jim_InvalidateStringRep(objPtr);
11802 /* The following step is required in order to invalidate the
11803 * string repr of "FOO" if the var name is of the form of "FOO(IDX)" */
11804 if (argv[1]->typePtr != &variableObjType) {
11805 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11806 retval = JIM_ERR;
11807 break;
11811 else {
11812 objPtr = Jim_NewIntObj(interp, i);
11813 retval = Jim_SetVariable(interp, argv[1], objPtr);
11814 if (retval != JIM_OK) {
11815 Jim_FreeNewObj(interp, objPtr);
11821 if (retval == JIM_OK || retval == JIM_CONTINUE || retval == JIM_BREAK) {
11822 Jim_SetEmptyResult(interp);
11823 return JIM_OK;
11825 return retval;
11828 /* List iterators make it easy to iterate over a list.
11829 * At some point iterators will be expanded to support generators.
11831 typedef struct {
11832 Jim_Obj *objPtr;
11833 int idx;
11834 } Jim_ListIter;
11837 * Initialise the iterator at the start of the list.
11839 static void JimListIterInit(Jim_ListIter *iter, Jim_Obj *objPtr)
11841 iter->objPtr = objPtr;
11842 iter->idx = 0;
11846 * Returns the next object from the list, or NULL on end-of-list.
11848 static Jim_Obj *JimListIterNext(Jim_Interp *interp, Jim_ListIter *iter)
11850 if (iter->idx >= Jim_ListLength(interp, iter->objPtr)) {
11851 return NULL;
11853 return iter->objPtr->internalRep.listValue.ele[iter->idx++];
11857 * Returns 1 if end-of-list has been reached.
11859 static int JimListIterDone(Jim_Interp *interp, Jim_ListIter *iter)
11861 return iter->idx >= Jim_ListLength(interp, iter->objPtr);
11864 /* foreach + lmap implementation. */
11865 static int JimForeachMapHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int doMap)
11867 int result = JIM_OK;
11868 int i, numargs;
11869 Jim_ListIter twoiters[2]; /* Avoid allocation for a single list */
11870 Jim_ListIter *iters;
11871 Jim_Obj *script;
11872 Jim_Obj *resultObj;
11874 if (argc < 4 || argc % 2 != 0) {
11875 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
11876 return JIM_ERR;
11878 script = argv[argc - 1]; /* Last argument is a script */
11879 numargs = (argc - 1 - 1); /* argc - 'foreach' - script */
11881 if (numargs == 2) {
11882 iters = twoiters;
11884 else {
11885 iters = Jim_Alloc(numargs * sizeof(*iters));
11887 for (i = 0; i < numargs; i++) {
11888 JimListIterInit(&iters[i], argv[i + 1]);
11889 if (i % 2 == 0 && JimListIterDone(interp, &iters[i])) {
11890 result = JIM_ERR;
11893 if (result != JIM_OK) {
11894 Jim_SetResultString(interp, "foreach varlist is empty", -1);
11895 goto empty_varlist;
11898 if (doMap) {
11899 resultObj = Jim_NewListObj(interp, NULL, 0);
11901 else {
11902 resultObj = interp->emptyObj;
11904 Jim_IncrRefCount(resultObj);
11906 while (1) {
11907 /* Have we expired all lists? */
11908 for (i = 0; i < numargs; i += 2) {
11909 if (!JimListIterDone(interp, &iters[i + 1])) {
11910 break;
11913 if (i == numargs) {
11914 /* All done */
11915 break;
11918 /* For each list */
11919 for (i = 0; i < numargs; i += 2) {
11920 Jim_Obj *varName;
11922 /* foreach var */
11923 JimListIterInit(&iters[i], argv[i + 1]);
11924 while ((varName = JimListIterNext(interp, &iters[i])) != NULL) {
11925 Jim_Obj *valObj = JimListIterNext(interp, &iters[i + 1]);
11926 if (!valObj) {
11927 /* Ran out, so store the empty string */
11928 valObj = interp->emptyObj;
11930 /* Avoid shimmering */
11931 Jim_IncrRefCount(valObj);
11932 result = Jim_SetVariable(interp, varName, valObj);
11933 Jim_DecrRefCount(interp, valObj);
11934 if (result != JIM_OK) {
11935 goto err;
11939 switch (result = Jim_EvalObj(interp, script)) {
11940 case JIM_OK:
11941 if (doMap) {
11942 Jim_ListAppendElement(interp, resultObj, interp->result);
11944 break;
11945 case JIM_CONTINUE:
11946 break;
11947 case JIM_BREAK:
11948 goto out;
11949 default:
11950 goto err;
11953 out:
11954 result = JIM_OK;
11955 Jim_SetResult(interp, resultObj);
11956 err:
11957 Jim_DecrRefCount(interp, resultObj);
11958 empty_varlist:
11959 if (numargs > 2) {
11960 Jim_Free(iters);
11962 return result;
11965 /* [foreach] */
11966 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11968 return JimForeachMapHelper(interp, argc, argv, 0);
11971 /* [lmap] */
11972 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11974 return JimForeachMapHelper(interp, argc, argv, 1);
11977 /* [lassign] */
11978 static int Jim_LassignCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11980 int result = JIM_ERR;
11981 int i;
11982 Jim_ListIter iter;
11983 Jim_Obj *resultObj;
11985 if (argc < 2) {
11986 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varName ...?");
11987 return JIM_ERR;
11990 JimListIterInit(&iter, argv[1]);
11992 for (i = 2; i < argc; i++) {
11993 Jim_Obj *valObj = JimListIterNext(interp, &iter);
11994 result = Jim_SetVariable(interp, argv[i], valObj ? valObj : interp->emptyObj);
11995 if (result != JIM_OK) {
11996 return result;
12000 resultObj = Jim_NewListObj(interp, NULL, 0);
12001 while (!JimListIterDone(interp, &iter)) {
12002 Jim_ListAppendElement(interp, resultObj, JimListIterNext(interp, &iter));
12005 Jim_SetResult(interp, resultObj);
12007 return JIM_OK;
12010 /* [if] */
12011 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12013 int boolean, retval, current = 1, falsebody = 0;
12015 if (argc >= 3) {
12016 while (1) {
12017 /* Far not enough arguments given! */
12018 if (current >= argc)
12019 goto err;
12020 if ((retval = Jim_GetBoolFromExpr(interp, argv[current++], &boolean))
12021 != JIM_OK)
12022 return retval;
12023 /* There lacks something, isn't it? */
12024 if (current >= argc)
12025 goto err;
12026 if (Jim_CompareStringImmediate(interp, argv[current], "then"))
12027 current++;
12028 /* Tsk tsk, no then-clause? */
12029 if (current >= argc)
12030 goto err;
12031 if (boolean)
12032 return Jim_EvalObj(interp, argv[current]);
12033 /* Ok: no else-clause follows */
12034 if (++current >= argc) {
12035 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
12036 return JIM_OK;
12038 falsebody = current++;
12039 if (Jim_CompareStringImmediate(interp, argv[falsebody], "else")) {
12040 /* IIICKS - else-clause isn't last cmd? */
12041 if (current != argc - 1)
12042 goto err;
12043 return Jim_EvalObj(interp, argv[current]);
12045 else if (Jim_CompareStringImmediate(interp, argv[falsebody], "elseif"))
12046 /* Ok: elseif follows meaning all the stuff
12047 * again (how boring...) */
12048 continue;
12049 /* OOPS - else-clause is not last cmd? */
12050 else if (falsebody != argc - 1)
12051 goto err;
12052 return Jim_EvalObj(interp, argv[falsebody]);
12054 return JIM_OK;
12056 err:
12057 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
12058 return JIM_ERR;
12062 /* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)*/
12063 int Jim_CommandMatchObj(Jim_Interp *interp, Jim_Obj *commandObj, Jim_Obj *patternObj,
12064 Jim_Obj *stringObj, int nocase)
12066 Jim_Obj *parms[4];
12067 int argc = 0;
12068 long eq;
12069 int rc;
12071 parms[argc++] = commandObj;
12072 if (nocase) {
12073 parms[argc++] = Jim_NewStringObj(interp, "-nocase", -1);
12075 parms[argc++] = patternObj;
12076 parms[argc++] = stringObj;
12078 rc = Jim_EvalObjVector(interp, argc, parms);
12080 if (rc != JIM_OK || Jim_GetLong(interp, Jim_GetResult(interp), &eq) != JIM_OK) {
12081 eq = -rc;
12084 return eq;
12087 /* [switch] */
12088 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12090 enum { SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD };
12091 int matchOpt = SWITCH_EXACT, opt = 1, patCount, i;
12092 Jim_Obj *command = NULL, *scriptObj = NULL, *strObj;
12093 Jim_Obj **caseList;
12095 if (argc < 3) {
12096 wrongnumargs:
12097 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
12098 "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}");
12099 return JIM_ERR;
12101 for (opt = 1; opt < argc; ++opt) {
12102 const char *option = Jim_String(argv[opt]);
12104 if (*option != '-')
12105 break;
12106 else if (strncmp(option, "--", 2) == 0) {
12107 ++opt;
12108 break;
12110 else if (strncmp(option, "-exact", 2) == 0)
12111 matchOpt = SWITCH_EXACT;
12112 else if (strncmp(option, "-glob", 2) == 0)
12113 matchOpt = SWITCH_GLOB;
12114 else if (strncmp(option, "-regexp", 2) == 0)
12115 matchOpt = SWITCH_RE;
12116 else if (strncmp(option, "-command", 2) == 0) {
12117 matchOpt = SWITCH_CMD;
12118 if ((argc - opt) < 2)
12119 goto wrongnumargs;
12120 command = argv[++opt];
12122 else {
12123 Jim_SetResultFormatted(interp,
12124 "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --",
12125 argv[opt]);
12126 return JIM_ERR;
12128 if ((argc - opt) < 2)
12129 goto wrongnumargs;
12131 strObj = argv[opt++];
12132 patCount = argc - opt;
12133 if (patCount == 1) {
12134 JimListGetElements(interp, argv[opt], &patCount, &caseList);
12136 else
12137 caseList = (Jim_Obj **)&argv[opt];
12138 if (patCount == 0 || patCount % 2 != 0)
12139 goto wrongnumargs;
12140 for (i = 0; scriptObj == NULL && i < patCount; i += 2) {
12141 Jim_Obj *patObj = caseList[i];
12143 if (!Jim_CompareStringImmediate(interp, patObj, "default")
12144 || i < (patCount - 2)) {
12145 switch (matchOpt) {
12146 case SWITCH_EXACT:
12147 if (Jim_StringEqObj(strObj, patObj))
12148 scriptObj = caseList[i + 1];
12149 break;
12150 case SWITCH_GLOB:
12151 if (Jim_StringMatchObj(interp, patObj, strObj, 0))
12152 scriptObj = caseList[i + 1];
12153 break;
12154 case SWITCH_RE:
12155 command = Jim_NewStringObj(interp, "regexp", -1);
12156 /* Fall thru intentionally */
12157 case SWITCH_CMD:{
12158 int rc = Jim_CommandMatchObj(interp, command, patObj, strObj, 0);
12160 /* After the execution of a command we need to
12161 * make sure to reconvert the object into a list
12162 * again. Only for the single-list style [switch]. */
12163 if (argc - opt == 1) {
12164 JimListGetElements(interp, argv[opt], &patCount, &caseList);
12166 /* command is here already decref'd */
12167 if (rc < 0) {
12168 return -rc;
12170 if (rc)
12171 scriptObj = caseList[i + 1];
12172 break;
12176 else {
12177 scriptObj = caseList[i + 1];
12180 for (; i < patCount && Jim_CompareStringImmediate(interp, scriptObj, "-"); i += 2)
12181 scriptObj = caseList[i + 1];
12182 if (scriptObj && Jim_CompareStringImmediate(interp, scriptObj, "-")) {
12183 Jim_SetResultFormatted(interp, "no body specified for pattern \"%#s\"", caseList[i - 2]);
12184 return JIM_ERR;
12186 Jim_SetEmptyResult(interp);
12187 if (scriptObj) {
12188 return Jim_EvalObj(interp, scriptObj);
12190 return JIM_OK;
12193 /* [list] */
12194 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12196 Jim_Obj *listObjPtr;
12198 listObjPtr = Jim_NewListObj(interp, argv + 1, argc - 1);
12199 Jim_SetResult(interp, listObjPtr);
12200 return JIM_OK;
12203 /* [lindex] */
12204 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12206 Jim_Obj *objPtr, *listObjPtr;
12207 int i;
12208 int idx;
12210 if (argc < 2) {
12211 Jim_WrongNumArgs(interp, 1, argv, "list ?index ...?");
12212 return JIM_ERR;
12214 objPtr = argv[1];
12215 Jim_IncrRefCount(objPtr);
12216 for (i = 2; i < argc; i++) {
12217 listObjPtr = objPtr;
12218 if (Jim_GetIndex(interp, argv[i], &idx) != JIM_OK) {
12219 Jim_DecrRefCount(interp, listObjPtr);
12220 return JIM_ERR;
12222 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_NONE) != JIM_OK) {
12223 /* Returns an empty object if the index
12224 * is out of range. */
12225 Jim_DecrRefCount(interp, listObjPtr);
12226 Jim_SetEmptyResult(interp);
12227 return JIM_OK;
12229 Jim_IncrRefCount(objPtr);
12230 Jim_DecrRefCount(interp, listObjPtr);
12232 Jim_SetResult(interp, objPtr);
12233 Jim_DecrRefCount(interp, objPtr);
12234 return JIM_OK;
12237 /* [llength] */
12238 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12240 if (argc != 2) {
12241 Jim_WrongNumArgs(interp, 1, argv, "list");
12242 return JIM_ERR;
12244 Jim_SetResultInt(interp, Jim_ListLength(interp, argv[1]));
12245 return JIM_OK;
12248 /* [lsearch] */
12249 static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12251 static const char * const options[] = {
12252 "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
12253 NULL
12255 enum
12256 { OPT_BOOL, OPT_NOT, OPT_NOCASE, OPT_EXACT, OPT_GLOB, OPT_REGEXP, OPT_ALL, OPT_INLINE,
12257 OPT_COMMAND };
12258 int i;
12259 int opt_bool = 0;
12260 int opt_not = 0;
12261 int opt_nocase = 0;
12262 int opt_all = 0;
12263 int opt_inline = 0;
12264 int opt_match = OPT_EXACT;
12265 int listlen;
12266 int rc = JIM_OK;
12267 Jim_Obj *listObjPtr = NULL;
12268 Jim_Obj *commandObj = NULL;
12270 if (argc < 3) {
12271 wrongargs:
12272 Jim_WrongNumArgs(interp, 1, argv,
12273 "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
12274 return JIM_ERR;
12277 for (i = 1; i < argc - 2; i++) {
12278 int option;
12280 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG) != JIM_OK) {
12281 return JIM_ERR;
12283 switch (option) {
12284 case OPT_BOOL:
12285 opt_bool = 1;
12286 opt_inline = 0;
12287 break;
12288 case OPT_NOT:
12289 opt_not = 1;
12290 break;
12291 case OPT_NOCASE:
12292 opt_nocase = 1;
12293 break;
12294 case OPT_INLINE:
12295 opt_inline = 1;
12296 opt_bool = 0;
12297 break;
12298 case OPT_ALL:
12299 opt_all = 1;
12300 break;
12301 case OPT_COMMAND:
12302 if (i >= argc - 2) {
12303 goto wrongargs;
12305 commandObj = argv[++i];
12306 /* fallthru */
12307 case OPT_EXACT:
12308 case OPT_GLOB:
12309 case OPT_REGEXP:
12310 opt_match = option;
12311 break;
12315 argv += i;
12317 if (opt_all) {
12318 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12320 if (opt_match == OPT_REGEXP) {
12321 commandObj = Jim_NewStringObj(interp, "regexp", -1);
12323 if (commandObj) {
12324 Jim_IncrRefCount(commandObj);
12327 listlen = Jim_ListLength(interp, argv[0]);
12328 for (i = 0; i < listlen; i++) {
12329 int eq = 0;
12330 Jim_Obj *objPtr = Jim_ListGetIndex(interp, argv[0], i);
12332 switch (opt_match) {
12333 case OPT_EXACT:
12334 eq = Jim_StringCompareObj(interp, argv[1], objPtr, opt_nocase) == 0;
12335 break;
12337 case OPT_GLOB:
12338 eq = Jim_StringMatchObj(interp, argv[1], objPtr, opt_nocase);
12339 break;
12341 case OPT_REGEXP:
12342 case OPT_COMMAND:
12343 eq = Jim_CommandMatchObj(interp, commandObj, argv[1], objPtr, opt_nocase);
12344 if (eq < 0) {
12345 if (listObjPtr) {
12346 Jim_FreeNewObj(interp, listObjPtr);
12348 rc = JIM_ERR;
12349 goto done;
12351 break;
12354 /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
12355 if (!eq && opt_bool && opt_not && !opt_all) {
12356 continue;
12359 if ((!opt_bool && eq == !opt_not) || (opt_bool && (eq || opt_all))) {
12360 /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
12361 Jim_Obj *resultObj;
12363 if (opt_bool) {
12364 resultObj = Jim_NewIntObj(interp, eq ^ opt_not);
12366 else if (!opt_inline) {
12367 resultObj = Jim_NewIntObj(interp, i);
12369 else {
12370 resultObj = objPtr;
12373 if (opt_all) {
12374 Jim_ListAppendElement(interp, listObjPtr, resultObj);
12376 else {
12377 Jim_SetResult(interp, resultObj);
12378 goto done;
12383 if (opt_all) {
12384 Jim_SetResult(interp, listObjPtr);
12386 else {
12387 /* No match */
12388 if (opt_bool) {
12389 Jim_SetResultBool(interp, opt_not);
12391 else if (!opt_inline) {
12392 Jim_SetResultInt(interp, -1);
12396 done:
12397 if (commandObj) {
12398 Jim_DecrRefCount(interp, commandObj);
12400 return rc;
12403 /* [lappend] */
12404 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12406 Jim_Obj *listObjPtr;
12407 int new_obj = 0;
12408 int i;
12410 if (argc < 2) {
12411 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
12412 return JIM_ERR;
12414 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12415 if (!listObjPtr) {
12416 /* Create the list if it does not exist */
12417 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12418 new_obj = 1;
12420 else if (Jim_IsShared(listObjPtr)) {
12421 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
12422 new_obj = 1;
12424 for (i = 2; i < argc; i++)
12425 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
12426 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
12427 if (new_obj)
12428 Jim_FreeNewObj(interp, listObjPtr);
12429 return JIM_ERR;
12431 Jim_SetResult(interp, listObjPtr);
12432 return JIM_OK;
12435 /* [linsert] */
12436 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12438 int idx, len;
12439 Jim_Obj *listPtr;
12441 if (argc < 3) {
12442 Jim_WrongNumArgs(interp, 1, argv, "list index ?element ...?");
12443 return JIM_ERR;
12445 listPtr = argv[1];
12446 if (Jim_IsShared(listPtr))
12447 listPtr = Jim_DuplicateObj(interp, listPtr);
12448 if (Jim_GetIndex(interp, argv[2], &idx) != JIM_OK)
12449 goto err;
12450 len = Jim_ListLength(interp, listPtr);
12451 if (idx >= len)
12452 idx = len;
12453 else if (idx < 0)
12454 idx = len + idx + 1;
12455 Jim_ListInsertElements(interp, listPtr, idx, argc - 3, &argv[3]);
12456 Jim_SetResult(interp, listPtr);
12457 return JIM_OK;
12458 err:
12459 if (listPtr != argv[1]) {
12460 Jim_FreeNewObj(interp, listPtr);
12462 return JIM_ERR;
12465 /* [lreplace] */
12466 static int Jim_LreplaceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12468 int first, last, len, rangeLen;
12469 Jim_Obj *listObj;
12470 Jim_Obj *newListObj;
12472 if (argc < 4) {
12473 Jim_WrongNumArgs(interp, 1, argv, "list first last ?element ...?");
12474 return JIM_ERR;
12476 if (Jim_GetIndex(interp, argv[2], &first) != JIM_OK ||
12477 Jim_GetIndex(interp, argv[3], &last) != JIM_OK) {
12478 return JIM_ERR;
12481 listObj = argv[1];
12482 len = Jim_ListLength(interp, listObj);
12484 first = JimRelToAbsIndex(len, first);
12485 last = JimRelToAbsIndex(len, last);
12486 JimRelToAbsRange(len, &first, &last, &rangeLen);
12488 /* Now construct a new list which consists of:
12489 * <elements before first> <supplied elements> <elements after last>
12492 /* Trying to replace past the end of the list means end of list
12493 * See TIP #505
12495 if (first > len) {
12496 first = len;
12499 /* Add the first set of elements */
12500 newListObj = Jim_NewListObj(interp, listObj->internalRep.listValue.ele, first);
12502 /* Add supplied elements */
12503 ListInsertElements(newListObj, -1, argc - 4, argv + 4);
12505 /* Add the remaining elements */
12506 ListInsertElements(newListObj, -1, len - first - rangeLen, listObj->internalRep.listValue.ele + first + rangeLen);
12508 Jim_SetResult(interp, newListObj);
12509 return JIM_OK;
12512 /* [lset] */
12513 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12515 if (argc < 3) {
12516 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
12517 return JIM_ERR;
12519 else if (argc == 3) {
12520 /* With no indexes, simply implements [set] */
12521 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
12522 return JIM_ERR;
12523 Jim_SetResult(interp, argv[2]);
12524 return JIM_OK;
12526 return Jim_ListSetIndex(interp, argv[1], argv + 2, argc - 3, argv[argc - 1]);
12529 /* [lsort] */
12530 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
12532 static const char * const options[] = {
12533 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", NULL
12535 enum
12536 { OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_REAL, OPT_INDEX, OPT_UNIQUE };
12537 Jim_Obj *resObj;
12538 int i;
12539 int retCode;
12540 int shared;
12542 struct lsort_info info;
12544 if (argc < 2) {
12545 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
12546 return JIM_ERR;
12549 info.type = JIM_LSORT_ASCII;
12550 info.order = 1;
12551 info.indexed = 0;
12552 info.unique = 0;
12553 info.command = NULL;
12554 info.interp = interp;
12556 for (i = 1; i < (argc - 1); i++) {
12557 int option;
12559 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ENUM_ABBREV | JIM_ERRMSG)
12560 != JIM_OK)
12561 return JIM_ERR;
12562 switch (option) {
12563 case OPT_ASCII:
12564 info.type = JIM_LSORT_ASCII;
12565 break;
12566 case OPT_NOCASE:
12567 info.type = JIM_LSORT_NOCASE;
12568 break;
12569 case OPT_INTEGER:
12570 info.type = JIM_LSORT_INTEGER;
12571 break;
12572 case OPT_REAL:
12573 info.type = JIM_LSORT_REAL;
12574 break;
12575 case OPT_INCREASING:
12576 info.order = 1;
12577 break;
12578 case OPT_DECREASING:
12579 info.order = -1;
12580 break;
12581 case OPT_UNIQUE:
12582 info.unique = 1;
12583 break;
12584 case OPT_COMMAND:
12585 if (i >= (argc - 2)) {
12586 Jim_SetResultString(interp, "\"-command\" option must be followed by comparison command", -1);
12587 return JIM_ERR;
12589 info.type = JIM_LSORT_COMMAND;
12590 info.command = argv[i + 1];
12591 i++;
12592 break;
12593 case OPT_INDEX:
12594 if (i >= (argc - 2)) {
12595 Jim_SetResultString(interp, "\"-index\" option must be followed by list index", -1);
12596 return JIM_ERR;
12598 if (Jim_GetIndex(interp, argv[i + 1], &info.index) != JIM_OK) {
12599 return JIM_ERR;
12601 info.indexed = 1;
12602 i++;
12603 break;
12606 resObj = argv[argc - 1];
12607 if ((shared = Jim_IsShared(resObj)))
12608 resObj = Jim_DuplicateObj(interp, resObj);
12609 retCode = ListSortElements(interp, resObj, &info);
12610 if (retCode == JIM_OK) {
12611 Jim_SetResult(interp, resObj);
12613 else if (shared) {
12614 Jim_FreeNewObj(interp, resObj);
12616 return retCode;
12619 /* [append] */
12620 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12622 Jim_Obj *stringObjPtr;
12623 int i;
12625 if (argc < 2) {
12626 Jim_WrongNumArgs(interp, 1, argv, "varName ?value ...?");
12627 return JIM_ERR;
12629 if (argc == 2) {
12630 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
12631 if (!stringObjPtr)
12632 return JIM_ERR;
12634 else {
12635 int new_obj = 0;
12636 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12637 if (!stringObjPtr) {
12638 /* Create the string if it doesn't exist */
12639 stringObjPtr = Jim_NewEmptyStringObj(interp);
12640 new_obj = 1;
12642 else if (Jim_IsShared(stringObjPtr)) {
12643 new_obj = 1;
12644 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
12646 for (i = 2; i < argc; i++) {
12647 Jim_AppendObj(interp, stringObjPtr, argv[i]);
12649 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
12650 if (new_obj) {
12651 Jim_FreeNewObj(interp, stringObjPtr);
12653 return JIM_ERR;
12656 Jim_SetResult(interp, stringObjPtr);
12657 return JIM_OK;
12660 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12662 * Returns a zero-refcount list describing the expression at 'node'
12664 static Jim_Obj *JimGetExprAsList(Jim_Interp *interp, struct JimExprNode *node)
12666 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
12668 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, jim_tt_name(node->type), -1));
12669 if (TOKEN_IS_EXPR_OP(node->type)) {
12670 if (node->left) {
12671 Jim_ListAppendElement(interp, listObjPtr, JimGetExprAsList(interp, node->left));
12673 if (node->right) {
12674 Jim_ListAppendElement(interp, listObjPtr, JimGetExprAsList(interp, node->right));
12676 if (node->ternary) {
12677 Jim_ListAppendElement(interp, listObjPtr, JimGetExprAsList(interp, node->ternary));
12680 else {
12681 Jim_ListAppendElement(interp, listObjPtr, node->objPtr);
12683 return listObjPtr;
12685 #endif /* JIM_DEBUG_COMMAND && !JIM_BOOTSTRAP */
12687 /* [debug] */
12688 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12690 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12691 static const char * const options[] = {
12692 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
12693 "exprbc", "show",
12694 NULL
12696 enum
12698 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
12699 OPT_EXPRLEN, OPT_EXPRBC, OPT_SHOW,
12701 int option;
12703 if (argc < 2) {
12704 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?...?");
12705 return JIM_ERR;
12707 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK)
12708 return Jim_CheckShowCommands(interp, argv[1], options);
12709 if (option == OPT_REFCOUNT) {
12710 if (argc != 3) {
12711 Jim_WrongNumArgs(interp, 2, argv, "object");
12712 return JIM_ERR;
12714 Jim_SetResultInt(interp, argv[2]->refCount);
12715 return JIM_OK;
12717 else if (option == OPT_OBJCOUNT) {
12718 int freeobj = 0, liveobj = 0;
12719 char buf[256];
12720 Jim_Obj *objPtr;
12722 if (argc != 2) {
12723 Jim_WrongNumArgs(interp, 2, argv, "");
12724 return JIM_ERR;
12726 /* Count the number of free objects. */
12727 objPtr = interp->freeList;
12728 while (objPtr) {
12729 freeobj++;
12730 objPtr = objPtr->nextObjPtr;
12732 /* Count the number of live objects. */
12733 objPtr = interp->liveList;
12734 while (objPtr) {
12735 liveobj++;
12736 objPtr = objPtr->nextObjPtr;
12738 /* Set the result string and return. */
12739 sprintf(buf, "free %d used %d", freeobj, liveobj);
12740 Jim_SetResultString(interp, buf, -1);
12741 return JIM_OK;
12743 else if (option == OPT_OBJECTS) {
12744 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
12746 /* Count the number of live objects. */
12747 objPtr = interp->liveList;
12748 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12749 while (objPtr) {
12750 char buf[128];
12751 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "";
12753 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
12754 sprintf(buf, "%p", objPtr);
12755 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, buf, -1));
12756 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, type, -1));
12757 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewIntObj(interp, objPtr->refCount));
12758 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
12759 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
12760 objPtr = objPtr->nextObjPtr;
12762 Jim_SetResult(interp, listObjPtr);
12763 return JIM_OK;
12765 else if (option == OPT_INVSTR) {
12766 Jim_Obj *objPtr;
12768 if (argc != 3) {
12769 Jim_WrongNumArgs(interp, 2, argv, "object");
12770 return JIM_ERR;
12772 objPtr = argv[2];
12773 if (objPtr->typePtr != NULL)
12774 Jim_InvalidateStringRep(objPtr);
12775 Jim_SetEmptyResult(interp);
12776 return JIM_OK;
12778 else if (option == OPT_SHOW) {
12779 const char *s;
12780 int len, charlen;
12782 if (argc != 3) {
12783 Jim_WrongNumArgs(interp, 2, argv, "object");
12784 return JIM_ERR;
12786 s = Jim_GetString(argv[2], &len);
12787 #ifdef JIM_UTF8
12788 charlen = utf8_strlen(s, len);
12789 #else
12790 charlen = len;
12791 #endif
12792 printf("refcount: %d, type: %s\n", argv[2]->refCount, JimObjTypeName(argv[2]));
12793 printf("chars (%d): <<%s>>\n", charlen, s);
12794 printf("bytes (%d):", len);
12795 while (len--) {
12796 printf(" %02x", (unsigned char)*s++);
12798 printf("\n");
12799 return JIM_OK;
12801 else if (option == OPT_SCRIPTLEN) {
12802 ScriptObj *script;
12804 if (argc != 3) {
12805 Jim_WrongNumArgs(interp, 2, argv, "script");
12806 return JIM_ERR;
12808 script = JimGetScript(interp, argv[2]);
12809 if (script == NULL)
12810 return JIM_ERR;
12811 Jim_SetResultInt(interp, script->len);
12812 return JIM_OK;
12814 else if (option == OPT_EXPRLEN) {
12815 struct ExprTree *expr;
12817 if (argc != 3) {
12818 Jim_WrongNumArgs(interp, 2, argv, "expression");
12819 return JIM_ERR;
12821 expr = JimGetExpression(interp, argv[2]);
12822 if (expr == NULL)
12823 return JIM_ERR;
12824 Jim_SetResultInt(interp, expr->len);
12825 return JIM_OK;
12827 else if (option == OPT_EXPRBC) {
12828 struct ExprTree *expr;
12830 if (argc != 3) {
12831 Jim_WrongNumArgs(interp, 2, argv, "expression");
12832 return JIM_ERR;
12834 expr = JimGetExpression(interp, argv[2]);
12835 if (expr == NULL)
12836 return JIM_ERR;
12837 Jim_SetResult(interp, JimGetExprAsList(interp, expr->expr));
12838 return JIM_OK;
12840 else {
12841 Jim_SetResultString(interp,
12842 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
12843 return JIM_ERR;
12845 /* unreached */
12846 #endif /* JIM_DEBUG_COMMAND && !JIM_BOOTSTRAP */
12847 #if !defined(JIM_DEBUG_COMMAND)
12848 Jim_SetResultString(interp, "unsupported", -1);
12849 return JIM_ERR;
12850 #endif
12853 /* [eval] */
12854 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12856 int rc;
12858 if (argc < 2) {
12859 Jim_WrongNumArgs(interp, 1, argv, "arg ?arg ...?");
12860 return JIM_ERR;
12863 if (argc == 2) {
12864 rc = Jim_EvalObj(interp, argv[1]);
12866 else {
12867 rc = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12870 if (rc == JIM_ERR) {
12871 /* eval is "interesting", so add a stack frame here */
12872 interp->addStackTrace++;
12874 return rc;
12877 /* [uplevel] */
12878 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12880 if (argc >= 2) {
12881 int retcode;
12882 Jim_CallFrame *savedCallFrame, *targetCallFrame;
12883 const char *str;
12885 /* Save the old callframe pointer */
12886 savedCallFrame = interp->framePtr;
12888 /* Lookup the target frame pointer */
12889 str = Jim_String(argv[1]);
12890 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#') {
12891 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
12892 argc--;
12893 argv++;
12895 else {
12896 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
12898 if (targetCallFrame == NULL) {
12899 return JIM_ERR;
12901 if (argc < 2) {
12902 Jim_WrongNumArgs(interp, 1, argv - 1, "?level? command ?arg ...?");
12903 return JIM_ERR;
12905 /* Eval the code in the target callframe. */
12906 interp->framePtr = targetCallFrame;
12907 if (argc == 2) {
12908 retcode = Jim_EvalObj(interp, argv[1]);
12910 else {
12911 retcode = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12913 interp->framePtr = savedCallFrame;
12914 return retcode;
12916 else {
12917 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
12918 return JIM_ERR;
12922 /* [expr] */
12923 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12925 int retcode;
12927 if (argc == 2) {
12928 retcode = Jim_EvalExpression(interp, argv[1]);
12930 else if (argc > 2) {
12931 Jim_Obj *objPtr;
12933 objPtr = Jim_ConcatObj(interp, argc - 1, argv + 1);
12934 Jim_IncrRefCount(objPtr);
12935 retcode = Jim_EvalExpression(interp, objPtr);
12936 Jim_DecrRefCount(interp, objPtr);
12938 else {
12939 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
12940 return JIM_ERR;
12942 if (retcode != JIM_OK)
12943 return retcode;
12944 return JIM_OK;
12947 /* [break] */
12948 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12950 if (argc != 1) {
12951 Jim_WrongNumArgs(interp, 1, argv, "");
12952 return JIM_ERR;
12954 return JIM_BREAK;
12957 /* [continue] */
12958 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12960 if (argc != 1) {
12961 Jim_WrongNumArgs(interp, 1, argv, "");
12962 return JIM_ERR;
12964 return JIM_CONTINUE;
12967 /* [return] */
12968 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12970 int i;
12971 Jim_Obj *stackTraceObj = NULL;
12972 Jim_Obj *errorCodeObj = NULL;
12973 int returnCode = JIM_OK;
12974 long level = 1;
12976 for (i = 1; i < argc - 1; i += 2) {
12977 if (Jim_CompareStringImmediate(interp, argv[i], "-code")) {
12978 if (Jim_GetReturnCode(interp, argv[i + 1], &returnCode) == JIM_ERR) {
12979 return JIM_ERR;
12982 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorinfo")) {
12983 stackTraceObj = argv[i + 1];
12985 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorcode")) {
12986 errorCodeObj = argv[i + 1];
12988 else if (Jim_CompareStringImmediate(interp, argv[i], "-level")) {
12989 if (Jim_GetLong(interp, argv[i + 1], &level) != JIM_OK || level < 0) {
12990 Jim_SetResultFormatted(interp, "bad level \"%#s\"", argv[i + 1]);
12991 return JIM_ERR;
12994 else {
12995 break;
12999 if (i != argc - 1 && i != argc) {
13000 Jim_WrongNumArgs(interp, 1, argv,
13001 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
13004 /* If a stack trace is supplied and code is error, set the stack trace */
13005 if (stackTraceObj && returnCode == JIM_ERR) {
13006 JimSetStackTrace(interp, stackTraceObj);
13008 /* If an error code list is supplied, set the global $errorCode */
13009 if (errorCodeObj && returnCode == JIM_ERR) {
13010 Jim_SetGlobalVariableStr(interp, "errorCode", errorCodeObj);
13012 interp->returnCode = returnCode;
13013 interp->returnLevel = level;
13015 if (i == argc - 1) {
13016 Jim_SetResult(interp, argv[i]);
13018 return JIM_RETURN;
13021 /* [tailcall] */
13022 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13024 if (interp->framePtr->level == 0) {
13025 Jim_SetResultString(interp, "tailcall can only be called from a proc or lambda", -1);
13026 return JIM_ERR;
13028 else if (argc >= 2) {
13029 /* Need to resolve the tailcall command in the current context */
13030 Jim_CallFrame *cf = interp->framePtr->parent;
13032 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13033 if (cmdPtr == NULL) {
13034 return JIM_ERR;
13037 JimPanic((cf->tailcallCmd != NULL, "Already have a tailcallCmd"));
13039 /* And stash this pre-resolved command */
13040 JimIncrCmdRefCount(cmdPtr);
13041 cf->tailcallCmd = cmdPtr;
13043 /* And stash the command list */
13044 JimPanic((cf->tailcallObj != NULL, "Already have a tailcallobj"));
13046 cf->tailcallObj = Jim_NewListObj(interp, argv + 1, argc - 1);
13047 Jim_IncrRefCount(cf->tailcallObj);
13049 /* When the stack unwinds to the previous proc, the stashed command will be evaluated */
13050 return JIM_EVAL;
13052 return JIM_OK;
13055 static int JimAliasCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13057 Jim_Obj *cmdList;
13058 Jim_Obj *prefixListObj = Jim_CmdPrivData(interp);
13060 /* prefixListObj is a list to which the args need to be appended */
13061 cmdList = Jim_DuplicateObj(interp, prefixListObj);
13062 Jim_ListInsertElements(interp, cmdList, Jim_ListLength(interp, cmdList), argc - 1, argv + 1);
13064 return JimEvalObjList(interp, cmdList);
13067 static void JimAliasCmdDelete(Jim_Interp *interp, void *privData)
13069 Jim_Obj *prefixListObj = privData;
13070 Jim_DecrRefCount(interp, prefixListObj);
13073 static int Jim_AliasCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13075 Jim_Obj *prefixListObj;
13076 const char *newname;
13078 if (argc < 3) {
13079 Jim_WrongNumArgs(interp, 1, argv, "newname command ?args ...?");
13080 return JIM_ERR;
13083 prefixListObj = Jim_NewListObj(interp, argv + 2, argc - 2);
13084 Jim_IncrRefCount(prefixListObj);
13085 newname = Jim_String(argv[1]);
13086 if (newname[0] == ':' && newname[1] == ':') {
13087 while (*++newname == ':') {
13091 Jim_SetResult(interp, argv[1]);
13093 return Jim_CreateCommand(interp, newname, JimAliasCmd, prefixListObj, JimAliasCmdDelete);
13096 /* [proc] */
13097 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13099 Jim_Cmd *cmd;
13101 if (argc != 4 && argc != 5) {
13102 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
13103 return JIM_ERR;
13106 if (JimValidName(interp, "procedure", argv[1]) != JIM_OK) {
13107 return JIM_ERR;
13110 if (argc == 4) {
13111 cmd = JimCreateProcedureCmd(interp, argv[2], NULL, argv[3], NULL);
13113 else {
13114 cmd = JimCreateProcedureCmd(interp, argv[2], argv[3], argv[4], NULL);
13117 if (cmd) {
13118 /* Add the new command */
13119 Jim_Obj *qualifiedCmdNameObj;
13120 const char *cmdname = JimQualifyName(interp, Jim_String(argv[1]), &qualifiedCmdNameObj);
13122 JimCreateCommand(interp, cmdname, cmd);
13124 /* Calculate and set the namespace for this proc */
13125 JimUpdateProcNamespace(interp, cmd, cmdname);
13127 JimFreeQualifiedName(interp, qualifiedCmdNameObj);
13129 /* Unlike Tcl, set the name of the proc as the result */
13130 Jim_SetResult(interp, argv[1]);
13131 return JIM_OK;
13133 return JIM_ERR;
13136 /* [local] */
13137 static int Jim_LocalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13139 int retcode;
13141 if (argc < 2) {
13142 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13143 return JIM_ERR;
13146 /* Evaluate the arguments with 'local' in force */
13147 interp->local++;
13148 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13149 interp->local--;
13152 /* If OK, and the result is a proc, add it to the list of local procs */
13153 if (retcode == 0) {
13154 Jim_Obj *cmdNameObj = Jim_GetResult(interp);
13156 if (Jim_GetCommand(interp, cmdNameObj, JIM_ERRMSG) == NULL) {
13157 return JIM_ERR;
13159 if (interp->framePtr->localCommands == NULL) {
13160 interp->framePtr->localCommands = Jim_Alloc(sizeof(*interp->framePtr->localCommands));
13161 Jim_InitStack(interp->framePtr->localCommands);
13163 Jim_IncrRefCount(cmdNameObj);
13164 Jim_StackPush(interp->framePtr->localCommands, cmdNameObj);
13167 return retcode;
13170 /* [upcall] */
13171 static int Jim_UpcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13173 if (argc < 2) {
13174 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13175 return JIM_ERR;
13177 else {
13178 int retcode;
13180 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13181 if (cmdPtr == NULL || !cmdPtr->isproc || !cmdPtr->prevCmd) {
13182 Jim_SetResultFormatted(interp, "no previous command: \"%#s\"", argv[1]);
13183 return JIM_ERR;
13185 /* OK. Mark this command as being in an upcall */
13186 cmdPtr->u.proc.upcall++;
13187 JimIncrCmdRefCount(cmdPtr);
13189 /* Invoke the command as normal */
13190 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13192 /* No longer in an upcall */
13193 cmdPtr->u.proc.upcall--;
13194 JimDecrCmdRefCount(interp, cmdPtr);
13196 return retcode;
13200 /* [apply] */
13201 static int Jim_ApplyCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13203 if (argc < 2) {
13204 Jim_WrongNumArgs(interp, 1, argv, "lambdaExpr ?arg ...?");
13205 return JIM_ERR;
13207 else {
13208 int ret;
13209 Jim_Cmd *cmd;
13210 Jim_Obj *argListObjPtr;
13211 Jim_Obj *bodyObjPtr;
13212 Jim_Obj *nsObj = NULL;
13213 Jim_Obj **nargv;
13215 int len = Jim_ListLength(interp, argv[1]);
13216 if (len != 2 && len != 3) {
13217 Jim_SetResultFormatted(interp, "can't interpret \"%#s\" as a lambda expression", argv[1]);
13218 return JIM_ERR;
13221 if (len == 3) {
13222 #ifdef jim_ext_namespace
13223 /* Need to canonicalise the given namespace. */
13224 nsObj = JimQualifyNameObj(interp, Jim_ListGetIndex(interp, argv[1], 2));
13225 #else
13226 Jim_SetResultString(interp, "namespaces not enabled", -1);
13227 return JIM_ERR;
13228 #endif
13230 argListObjPtr = Jim_ListGetIndex(interp, argv[1], 0);
13231 bodyObjPtr = Jim_ListGetIndex(interp, argv[1], 1);
13233 cmd = JimCreateProcedureCmd(interp, argListObjPtr, NULL, bodyObjPtr, nsObj);
13235 if (cmd) {
13236 /* Create a new argv array with a dummy argv[0], for error messages */
13237 nargv = Jim_Alloc((argc - 2 + 1) * sizeof(*nargv));
13238 nargv[0] = Jim_NewStringObj(interp, "apply lambdaExpr", -1);
13239 Jim_IncrRefCount(nargv[0]);
13240 memcpy(&nargv[1], argv + 2, (argc - 2) * sizeof(*nargv));
13241 ret = JimCallProcedure(interp, cmd, argc - 2 + 1, nargv);
13242 Jim_DecrRefCount(interp, nargv[0]);
13243 Jim_Free(nargv);
13245 JimDecrCmdRefCount(interp, cmd);
13246 return ret;
13248 return JIM_ERR;
13253 /* [concat] */
13254 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13256 Jim_SetResult(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13257 return JIM_OK;
13260 /* [upvar] */
13261 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13263 int i;
13264 Jim_CallFrame *targetCallFrame;
13266 /* Lookup the target frame pointer */
13267 if (argc > 3 && (argc % 2 == 0)) {
13268 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
13269 argc--;
13270 argv++;
13272 else {
13273 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
13275 if (targetCallFrame == NULL) {
13276 return JIM_ERR;
13279 /* Check for arity */
13280 if (argc < 3) {
13281 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
13282 return JIM_ERR;
13285 /* Now... for every other/local couple: */
13286 for (i = 1; i < argc; i += 2) {
13287 if (Jim_SetVariableLink(interp, argv[i + 1], argv[i], targetCallFrame) != JIM_OK)
13288 return JIM_ERR;
13290 return JIM_OK;
13293 /* [global] */
13294 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13296 int i;
13298 if (argc < 2) {
13299 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
13300 return JIM_ERR;
13302 /* Link every var to the toplevel having the same name */
13303 if (interp->framePtr->level == 0)
13304 return JIM_OK; /* global at toplevel... */
13305 for (i = 1; i < argc; i++) {
13306 /* global ::blah does nothing */
13307 const char *name = Jim_String(argv[i]);
13308 if (name[0] != ':' || name[1] != ':') {
13309 if (Jim_SetVariableLink(interp, argv[i], argv[i], interp->topFramePtr) != JIM_OK)
13310 return JIM_ERR;
13313 return JIM_OK;
13316 /* does the [string map] operation. On error NULL is returned,
13317 * otherwise a new string object with the result, having refcount = 0,
13318 * is returned. */
13319 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
13320 Jim_Obj *objPtr, int nocase)
13322 int numMaps;
13323 const char *str, *noMatchStart = NULL;
13324 int strLen, i;
13325 Jim_Obj *resultObjPtr;
13327 numMaps = Jim_ListLength(interp, mapListObjPtr);
13328 if (numMaps % 2) {
13329 Jim_SetResultString(interp, "list must contain an even number of elements", -1);
13330 return NULL;
13333 str = Jim_String(objPtr);
13334 strLen = Jim_Utf8Length(interp, objPtr);
13336 /* Map it */
13337 resultObjPtr = Jim_NewStringObj(interp, "", 0);
13338 while (strLen) {
13339 for (i = 0; i < numMaps; i += 2) {
13340 Jim_Obj *eachObjPtr;
13341 const char *k;
13342 int kl;
13344 eachObjPtr = Jim_ListGetIndex(interp, mapListObjPtr, i);
13345 k = Jim_String(eachObjPtr);
13346 kl = Jim_Utf8Length(interp, eachObjPtr);
13348 if (strLen >= kl && kl) {
13349 int rc;
13350 rc = JimStringCompareLen(str, k, kl, nocase);
13351 if (rc == 0) {
13352 if (noMatchStart) {
13353 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13354 noMatchStart = NULL;
13356 Jim_AppendObj(interp, resultObjPtr, Jim_ListGetIndex(interp, mapListObjPtr, i + 1));
13357 str += utf8_index(str, kl);
13358 strLen -= kl;
13359 break;
13363 if (i == numMaps) { /* no match */
13364 int c;
13365 if (noMatchStart == NULL)
13366 noMatchStart = str;
13367 str += utf8_tounicode(str, &c);
13368 strLen--;
13371 if (noMatchStart) {
13372 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13374 return resultObjPtr;
13377 /* [string] */
13378 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13380 int len;
13381 int opt_case = 1;
13382 int option;
13383 static const char * const options[] = {
13384 "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "replace",
13385 "map", "repeat", "reverse", "index", "first", "last", "cat",
13386 "trim", "trimleft", "trimright", "tolower", "toupper", "totitle", NULL
13388 enum
13390 OPT_BYTELENGTH, OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_IS, OPT_BYTERANGE, OPT_RANGE, OPT_REPLACE,
13391 OPT_MAP, OPT_REPEAT, OPT_REVERSE, OPT_INDEX, OPT_FIRST, OPT_LAST, OPT_CAT,
13392 OPT_TRIM, OPT_TRIMLEFT, OPT_TRIMRIGHT, OPT_TOLOWER, OPT_TOUPPER, OPT_TOTITLE
13394 static const char * const nocase_options[] = {
13395 "-nocase", NULL
13397 static const char * const nocase_length_options[] = {
13398 "-nocase", "-length", NULL
13401 if (argc < 2) {
13402 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
13403 return JIM_ERR;
13405 if (Jim_GetEnum(interp, argv[1], options, &option, NULL,
13406 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK)
13407 return Jim_CheckShowCommands(interp, argv[1], options);
13409 switch (option) {
13410 case OPT_LENGTH:
13411 case OPT_BYTELENGTH:
13412 if (argc != 3) {
13413 Jim_WrongNumArgs(interp, 2, argv, "string");
13414 return JIM_ERR;
13416 if (option == OPT_LENGTH) {
13417 len = Jim_Utf8Length(interp, argv[2]);
13419 else {
13420 len = Jim_Length(argv[2]);
13422 Jim_SetResultInt(interp, len);
13423 return JIM_OK;
13425 case OPT_CAT:{
13426 Jim_Obj *objPtr;
13427 if (argc == 3) {
13428 /* optimise the one-arg case */
13429 objPtr = argv[2];
13431 else {
13432 int i;
13434 objPtr = Jim_NewStringObj(interp, "", 0);
13436 for (i = 2; i < argc; i++) {
13437 Jim_AppendObj(interp, objPtr, argv[i]);
13440 Jim_SetResult(interp, objPtr);
13441 return JIM_OK;
13444 case OPT_COMPARE:
13445 case OPT_EQUAL:
13447 /* n is the number of remaining option args */
13448 long opt_length = -1;
13449 int n = argc - 4;
13450 int i = 2;
13451 while (n > 0) {
13452 int subopt;
13453 if (Jim_GetEnum(interp, argv[i++], nocase_length_options, &subopt, NULL,
13454 JIM_ENUM_ABBREV) != JIM_OK) {
13455 badcompareargs:
13456 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? ?-length int? string1 string2");
13457 return JIM_ERR;
13459 if (subopt == 0) {
13460 /* -nocase */
13461 opt_case = 0;
13462 n--;
13464 else {
13465 /* -length */
13466 if (n < 2) {
13467 goto badcompareargs;
13469 if (Jim_GetLong(interp, argv[i++], &opt_length) != JIM_OK) {
13470 return JIM_ERR;
13472 n -= 2;
13475 if (n) {
13476 goto badcompareargs;
13478 argv += argc - 2;
13479 if (opt_length < 0 && option != OPT_COMPARE && opt_case) {
13480 /* Fast version - [string equal], case sensitive, no length */
13481 Jim_SetResultBool(interp, Jim_StringEqObj(argv[0], argv[1]));
13483 else {
13484 if (opt_length >= 0) {
13485 n = JimStringCompareLen(Jim_String(argv[0]), Jim_String(argv[1]), opt_length, !opt_case);
13487 else {
13488 n = Jim_StringCompareObj(interp, argv[0], argv[1], !opt_case);
13490 Jim_SetResultInt(interp, option == OPT_COMPARE ? n : n == 0);
13492 return JIM_OK;
13495 case OPT_MATCH:
13496 if (argc != 4 &&
13497 (argc != 5 ||
13498 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13499 JIM_ENUM_ABBREV) != JIM_OK)) {
13500 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern string");
13501 return JIM_ERR;
13503 if (opt_case == 0) {
13504 argv++;
13506 Jim_SetResultBool(interp, Jim_StringMatchObj(interp, argv[2], argv[3], !opt_case));
13507 return JIM_OK;
13509 case OPT_MAP:{
13510 Jim_Obj *objPtr;
13512 if (argc != 4 &&
13513 (argc != 5 ||
13514 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13515 JIM_ENUM_ABBREV) != JIM_OK)) {
13516 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList string");
13517 return JIM_ERR;
13520 if (opt_case == 0) {
13521 argv++;
13523 objPtr = JimStringMap(interp, argv[2], argv[3], !opt_case);
13524 if (objPtr == NULL) {
13525 return JIM_ERR;
13527 Jim_SetResult(interp, objPtr);
13528 return JIM_OK;
13531 case OPT_RANGE:
13532 case OPT_BYTERANGE:{
13533 Jim_Obj *objPtr;
13535 if (argc != 5) {
13536 Jim_WrongNumArgs(interp, 2, argv, "string first last");
13537 return JIM_ERR;
13539 if (option == OPT_RANGE) {
13540 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
13542 else
13544 objPtr = Jim_StringByteRangeObj(interp, argv[2], argv[3], argv[4]);
13547 if (objPtr == NULL) {
13548 return JIM_ERR;
13550 Jim_SetResult(interp, objPtr);
13551 return JIM_OK;
13554 case OPT_REPLACE:{
13555 Jim_Obj *objPtr;
13557 if (argc != 5 && argc != 6) {
13558 Jim_WrongNumArgs(interp, 2, argv, "string first last ?string?");
13559 return JIM_ERR;
13561 objPtr = JimStringReplaceObj(interp, argv[2], argv[3], argv[4], argc == 6 ? argv[5] : NULL);
13562 if (objPtr == NULL) {
13563 return JIM_ERR;
13565 Jim_SetResult(interp, objPtr);
13566 return JIM_OK;
13570 case OPT_REPEAT:{
13571 Jim_Obj *objPtr;
13572 jim_wide count;
13574 if (argc != 4) {
13575 Jim_WrongNumArgs(interp, 2, argv, "string count");
13576 return JIM_ERR;
13578 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK) {
13579 return JIM_ERR;
13581 objPtr = Jim_NewStringObj(interp, "", 0);
13582 if (count > 0) {
13583 while (count--) {
13584 Jim_AppendObj(interp, objPtr, argv[2]);
13587 Jim_SetResult(interp, objPtr);
13588 return JIM_OK;
13591 case OPT_REVERSE:{
13592 char *buf, *p;
13593 const char *str;
13594 int i;
13596 if (argc != 3) {
13597 Jim_WrongNumArgs(interp, 2, argv, "string");
13598 return JIM_ERR;
13601 str = Jim_GetString(argv[2], &len);
13602 buf = Jim_Alloc(len + 1);
13603 p = buf + len;
13604 *p = 0;
13605 for (i = 0; i < len; ) {
13606 int c;
13607 int l = utf8_tounicode(str, &c);
13608 memcpy(p - l, str, l);
13609 p -= l;
13610 i += l;
13611 str += l;
13613 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
13614 return JIM_OK;
13617 case OPT_INDEX:{
13618 int idx;
13619 const char *str;
13621 if (argc != 4) {
13622 Jim_WrongNumArgs(interp, 2, argv, "string index");
13623 return JIM_ERR;
13625 if (Jim_GetIndex(interp, argv[3], &idx) != JIM_OK) {
13626 return JIM_ERR;
13628 str = Jim_String(argv[2]);
13629 len = Jim_Utf8Length(interp, argv[2]);
13630 if (idx != INT_MIN && idx != INT_MAX) {
13631 idx = JimRelToAbsIndex(len, idx);
13633 if (idx < 0 || idx >= len || str == NULL) {
13634 Jim_SetResultString(interp, "", 0);
13636 else if (len == Jim_Length(argv[2])) {
13637 /* ASCII optimisation */
13638 Jim_SetResultString(interp, str + idx, 1);
13640 else {
13641 int c;
13642 int i = utf8_index(str, idx);
13643 Jim_SetResultString(interp, str + i, utf8_tounicode(str + i, &c));
13645 return JIM_OK;
13648 case OPT_FIRST:
13649 case OPT_LAST:{
13650 int idx = 0, l1, l2;
13651 const char *s1, *s2;
13653 if (argc != 4 && argc != 5) {
13654 Jim_WrongNumArgs(interp, 2, argv, "subString string ?index?");
13655 return JIM_ERR;
13657 s1 = Jim_String(argv[2]);
13658 s2 = Jim_String(argv[3]);
13659 l1 = Jim_Utf8Length(interp, argv[2]);
13660 l2 = Jim_Utf8Length(interp, argv[3]);
13661 if (argc == 5) {
13662 if (Jim_GetIndex(interp, argv[4], &idx) != JIM_OK) {
13663 return JIM_ERR;
13665 idx = JimRelToAbsIndex(l2, idx);
13667 else if (option == OPT_LAST) {
13668 idx = l2;
13670 if (option == OPT_FIRST) {
13671 Jim_SetResultInt(interp, JimStringFirst(s1, l1, s2, l2, idx));
13673 else {
13674 #ifdef JIM_UTF8
13675 Jim_SetResultInt(interp, JimStringLastUtf8(s1, l1, s2, idx));
13676 #else
13677 Jim_SetResultInt(interp, JimStringLast(s1, l1, s2, idx));
13678 #endif
13680 return JIM_OK;
13683 case OPT_TRIM:
13684 case OPT_TRIMLEFT:
13685 case OPT_TRIMRIGHT:{
13686 Jim_Obj *trimchars;
13688 if (argc != 3 && argc != 4) {
13689 Jim_WrongNumArgs(interp, 2, argv, "string ?trimchars?");
13690 return JIM_ERR;
13692 trimchars = (argc == 4 ? argv[3] : NULL);
13693 if (option == OPT_TRIM) {
13694 Jim_SetResult(interp, JimStringTrim(interp, argv[2], trimchars));
13696 else if (option == OPT_TRIMLEFT) {
13697 Jim_SetResult(interp, JimStringTrimLeft(interp, argv[2], trimchars));
13699 else if (option == OPT_TRIMRIGHT) {
13700 Jim_SetResult(interp, JimStringTrimRight(interp, argv[2], trimchars));
13702 return JIM_OK;
13705 case OPT_TOLOWER:
13706 case OPT_TOUPPER:
13707 case OPT_TOTITLE:
13708 if (argc != 3) {
13709 Jim_WrongNumArgs(interp, 2, argv, "string");
13710 return JIM_ERR;
13712 if (option == OPT_TOLOWER) {
13713 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
13715 else if (option == OPT_TOUPPER) {
13716 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
13718 else {
13719 Jim_SetResult(interp, JimStringToTitle(interp, argv[2]));
13721 return JIM_OK;
13723 case OPT_IS:
13724 if (argc == 4 || (argc == 5 && Jim_CompareStringImmediate(interp, argv[3], "-strict"))) {
13725 return JimStringIs(interp, argv[argc - 1], argv[2], argc == 5);
13727 Jim_WrongNumArgs(interp, 2, argv, "class ?-strict? str");
13728 return JIM_ERR;
13730 return JIM_OK;
13733 /* [time] */
13734 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13736 long i, count = 1;
13737 jim_wide start, elapsed;
13738 char buf[60];
13739 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
13741 if (argc < 2) {
13742 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
13743 return JIM_ERR;
13745 if (argc == 3) {
13746 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
13747 return JIM_ERR;
13749 if (count < 0)
13750 return JIM_OK;
13751 i = count;
13752 start = JimClock();
13753 while (i-- > 0) {
13754 int retval;
13756 retval = Jim_EvalObj(interp, argv[1]);
13757 if (retval != JIM_OK) {
13758 return retval;
13761 elapsed = JimClock() - start;
13762 sprintf(buf, fmt, count == 0 ? 0 : elapsed / count);
13763 Jim_SetResultString(interp, buf, -1);
13764 return JIM_OK;
13767 /* [exit] */
13768 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13770 long exitCode = 0;
13772 if (argc > 2) {
13773 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
13774 return JIM_ERR;
13776 if (argc == 2) {
13777 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
13778 return JIM_ERR;
13780 interp->exitCode = exitCode;
13781 return JIM_EXIT;
13784 /* [catch] */
13785 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13787 int exitCode = 0;
13788 int i;
13789 int sig = 0;
13791 /* Which return codes are ignored (passed through)? By default, only exit, eval and signal */
13792 jim_wide ignore_mask = (1 << JIM_EXIT) | (1 << JIM_EVAL) | (1 << JIM_SIGNAL);
13793 static const int max_ignore_code = sizeof(ignore_mask) * 8;
13795 /* Reset the error code before catch.
13796 * Note that this is not strictly correct.
13798 Jim_SetGlobalVariableStr(interp, "errorCode", Jim_NewStringObj(interp, "NONE", -1));
13800 for (i = 1; i < argc - 1; i++) {
13801 const char *arg = Jim_String(argv[i]);
13802 jim_wide option;
13803 int ignore;
13805 /* It's a pity we can't use Jim_GetEnum here :-( */
13806 if (strcmp(arg, "--") == 0) {
13807 i++;
13808 break;
13810 if (*arg != '-') {
13811 break;
13814 if (strncmp(arg, "-no", 3) == 0) {
13815 arg += 3;
13816 ignore = 1;
13818 else {
13819 arg++;
13820 ignore = 0;
13823 if (Jim_StringToWide(arg, &option, 10) != JIM_OK) {
13824 option = -1;
13826 if (option < 0) {
13827 option = Jim_FindByName(arg, jimReturnCodes, jimReturnCodesSize);
13829 if (option < 0) {
13830 goto wrongargs;
13833 if (ignore) {
13834 ignore_mask |= ((jim_wide)1 << option);
13836 else {
13837 ignore_mask &= (~((jim_wide)1 << option));
13841 argc -= i;
13842 if (argc < 1 || argc > 3) {
13843 wrongargs:
13844 Jim_WrongNumArgs(interp, 1, argv,
13845 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
13846 return JIM_ERR;
13848 argv += i;
13850 if ((ignore_mask & (1 << JIM_SIGNAL)) == 0) {
13851 sig++;
13854 interp->signal_level += sig;
13855 if (Jim_CheckSignal(interp)) {
13856 /* If a signal is set, don't even try to execute the body */
13857 exitCode = JIM_SIGNAL;
13859 else {
13860 exitCode = Jim_EvalObj(interp, argv[0]);
13861 /* Don't want any caught error included in a later stack trace */
13862 interp->errorFlag = 0;
13864 interp->signal_level -= sig;
13866 /* Catch or pass through? Only the first 32/64 codes can be passed through */
13867 if (exitCode >= 0 && exitCode < max_ignore_code && (((unsigned jim_wide)1 << exitCode) & ignore_mask)) {
13868 /* Not caught, pass it up */
13869 return exitCode;
13872 if (sig && exitCode == JIM_SIGNAL) {
13873 /* Catch the signal at this level */
13874 if (interp->signal_set_result) {
13875 interp->signal_set_result(interp, interp->sigmask);
13877 else {
13878 Jim_SetResultInt(interp, interp->sigmask);
13880 interp->sigmask = 0;
13883 if (argc >= 2) {
13884 if (Jim_SetVariable(interp, argv[1], Jim_GetResult(interp)) != JIM_OK) {
13885 return JIM_ERR;
13887 if (argc == 3) {
13888 Jim_Obj *optListObj = Jim_NewListObj(interp, NULL, 0);
13890 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-code", -1));
13891 Jim_ListAppendElement(interp, optListObj,
13892 Jim_NewIntObj(interp, exitCode == JIM_RETURN ? interp->returnCode : exitCode));
13893 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-level", -1));
13894 Jim_ListAppendElement(interp, optListObj, Jim_NewIntObj(interp, interp->returnLevel));
13895 if (exitCode == JIM_ERR) {
13896 Jim_Obj *errorCode;
13897 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorinfo",
13898 -1));
13899 Jim_ListAppendElement(interp, optListObj, interp->stackTrace);
13901 errorCode = Jim_GetGlobalVariableStr(interp, "errorCode", JIM_NONE);
13902 if (errorCode) {
13903 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorcode", -1));
13904 Jim_ListAppendElement(interp, optListObj, errorCode);
13907 if (Jim_SetVariable(interp, argv[2], optListObj) != JIM_OK) {
13908 return JIM_ERR;
13912 Jim_SetResultInt(interp, exitCode);
13913 return JIM_OK;
13916 #if defined(JIM_REFERENCES) && !defined(JIM_BOOTSTRAP)
13918 /* [ref] */
13919 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13921 if (argc != 3 && argc != 4) {
13922 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
13923 return JIM_ERR;
13925 if (argc == 3) {
13926 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
13928 else {
13929 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], argv[3]));
13931 return JIM_OK;
13934 /* [getref] */
13935 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13937 Jim_Reference *refPtr;
13939 if (argc != 2) {
13940 Jim_WrongNumArgs(interp, 1, argv, "reference");
13941 return JIM_ERR;
13943 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
13944 return JIM_ERR;
13945 Jim_SetResult(interp, refPtr->objPtr);
13946 return JIM_OK;
13949 /* [setref] */
13950 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13952 Jim_Reference *refPtr;
13954 if (argc != 3) {
13955 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
13956 return JIM_ERR;
13958 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
13959 return JIM_ERR;
13960 Jim_IncrRefCount(argv[2]);
13961 Jim_DecrRefCount(interp, refPtr->objPtr);
13962 refPtr->objPtr = argv[2];
13963 Jim_SetResult(interp, argv[2]);
13964 return JIM_OK;
13967 /* [collect] */
13968 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13970 if (argc != 1) {
13971 Jim_WrongNumArgs(interp, 1, argv, "");
13972 return JIM_ERR;
13974 Jim_SetResultInt(interp, Jim_Collect(interp));
13976 /* Free all the freed objects. */
13977 while (interp->freeList) {
13978 Jim_Obj *nextObjPtr = interp->freeList->nextObjPtr;
13979 Jim_Free(interp->freeList);
13980 interp->freeList = nextObjPtr;
13983 return JIM_OK;
13986 /* [finalize] reference ?newValue? */
13987 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13989 if (argc != 2 && argc != 3) {
13990 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
13991 return JIM_ERR;
13993 if (argc == 2) {
13994 Jim_Obj *cmdNamePtr;
13996 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
13997 return JIM_ERR;
13998 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
13999 Jim_SetResult(interp, cmdNamePtr);
14001 else {
14002 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
14003 return JIM_ERR;
14004 Jim_SetResult(interp, argv[2]);
14006 return JIM_OK;
14009 /* [info references] */
14010 static int JimInfoReferences(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14012 Jim_Obj *listObjPtr;
14013 Jim_HashTableIterator htiter;
14014 Jim_HashEntry *he;
14016 listObjPtr = Jim_NewListObj(interp, NULL, 0);
14018 JimInitHashTableIterator(&interp->references, &htiter);
14019 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14020 char buf[JIM_REFERENCE_SPACE + 1];
14021 Jim_Reference *refPtr = Jim_GetHashEntryVal(he);
14022 const unsigned long *refId = he->key;
14024 JimFormatReference(buf, refPtr, *refId);
14025 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, buf, -1));
14027 Jim_SetResult(interp, listObjPtr);
14028 return JIM_OK;
14030 #endif /* JIM_REFERENCES && !JIM_BOOTSTRAP */
14032 /* [rename] */
14033 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14035 if (argc != 3) {
14036 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
14037 return JIM_ERR;
14040 if (JimValidName(interp, "new procedure", argv[2])) {
14041 return JIM_ERR;
14044 return Jim_RenameCommand(interp, Jim_String(argv[1]), Jim_String(argv[2]));
14047 #define JIM_DICTMATCH_KEYS 0x0001
14048 #define JIM_DICTMATCH_VALUES 0x002
14051 * match_type must be one of JIM_DICTMATCH_KEYS or JIM_DICTMATCH_VALUES
14052 * return_types should be either or both
14054 int Jim_DictMatchTypes(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObj, int match_type, int return_types)
14056 Jim_HashEntry *he;
14057 Jim_Obj *listObjPtr;
14058 Jim_HashTableIterator htiter;
14060 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14061 return JIM_ERR;
14064 listObjPtr = Jim_NewListObj(interp, NULL, 0);
14066 JimInitHashTableIterator(objPtr->internalRep.ptr, &htiter);
14067 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14068 if (patternObj) {
14069 Jim_Obj *matchObj = (match_type == JIM_DICTMATCH_KEYS) ? (Jim_Obj *)he->key : Jim_GetHashEntryVal(he);
14070 if (!JimGlobMatch(Jim_String(patternObj), Jim_String(matchObj), 0)) {
14071 /* no match */
14072 continue;
14075 if (return_types & JIM_DICTMATCH_KEYS) {
14076 Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->key);
14078 if (return_types & JIM_DICTMATCH_VALUES) {
14079 Jim_ListAppendElement(interp, listObjPtr, Jim_GetHashEntryVal(he));
14083 Jim_SetResult(interp, listObjPtr);
14084 return JIM_OK;
14087 int Jim_DictSize(Jim_Interp *interp, Jim_Obj *objPtr)
14089 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14090 return -1;
14092 return ((Jim_HashTable *)objPtr->internalRep.ptr)->used;
14096 * Must be called with at least one object.
14097 * Returns the new dictionary, or NULL on error.
14099 Jim_Obj *Jim_DictMerge(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
14101 Jim_Obj *objPtr = Jim_NewDictObj(interp, NULL, 0);
14102 int i;
14104 JimPanic((objc == 0, "Jim_DictMerge called with objc=0"));
14106 /* Note that we don't optimise the trivial case of a single argument */
14108 for (i = 0; i < objc; i++) {
14109 Jim_HashTable *ht;
14110 Jim_HashTableIterator htiter;
14111 Jim_HashEntry *he;
14113 if (SetDictFromAny(interp, objv[i]) != JIM_OK) {
14114 Jim_FreeNewObj(interp, objPtr);
14115 return NULL;
14117 ht = objv[i]->internalRep.ptr;
14118 JimInitHashTableIterator(ht, &htiter);
14119 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14120 Jim_ReplaceHashEntry(objPtr->internalRep.ptr, Jim_GetHashEntryKey(he), Jim_GetHashEntryVal(he));
14123 return objPtr;
14126 int Jim_DictInfo(Jim_Interp *interp, Jim_Obj *objPtr)
14128 Jim_HashTable *ht;
14129 unsigned int i;
14130 char buffer[100];
14131 int sum = 0;
14132 int nonzero_count = 0;
14133 Jim_Obj *output;
14134 int bucket_counts[11] = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 };
14136 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14137 return JIM_ERR;
14140 ht = (Jim_HashTable *)objPtr->internalRep.ptr;
14142 /* Note that this uses internal knowledge of the hash table */
14143 snprintf(buffer, sizeof(buffer), "%d entries in table, %d buckets\n", ht->used, ht->size);
14144 output = Jim_NewStringObj(interp, buffer, -1);
14146 for (i = 0; i < ht->size; i++) {
14147 Jim_HashEntry *he = ht->table[i];
14148 int entries = 0;
14149 while (he) {
14150 entries++;
14151 he = he->next;
14153 if (entries > 9) {
14154 bucket_counts[10]++;
14156 else {
14157 bucket_counts[entries]++;
14159 if (entries) {
14160 sum += entries;
14161 nonzero_count++;
14164 for (i = 0; i < 10; i++) {
14165 snprintf(buffer, sizeof(buffer), "number of buckets with %d entries: %d\n", i, bucket_counts[i]);
14166 Jim_AppendString(interp, output, buffer, -1);
14168 snprintf(buffer, sizeof(buffer), "number of buckets with 10 or more entries: %d\n", bucket_counts[10]);
14169 Jim_AppendString(interp, output, buffer, -1);
14170 snprintf(buffer, sizeof(buffer), "average search distance for entry: %.1f", nonzero_count ? (double)sum / nonzero_count : 0.0);
14171 Jim_AppendString(interp, output, buffer, -1);
14172 Jim_SetResult(interp, output);
14173 return JIM_OK;
14176 static int Jim_EvalEnsemble(Jim_Interp *interp, const char *basecmd, const char *subcmd, int argc, Jim_Obj *const *argv)
14178 Jim_Obj *prefixObj = Jim_NewStringObj(interp, basecmd, -1);
14180 Jim_AppendString(interp, prefixObj, " ", 1);
14181 Jim_AppendString(interp, prefixObj, subcmd, -1);
14183 return Jim_EvalObjPrefix(interp, prefixObj, argc, argv);
14187 * Implements the [dict with] command
14189 static int JimDictWith(Jim_Interp *interp, Jim_Obj *dictVarName, Jim_Obj *const *keyv, int keyc, Jim_Obj *scriptObj)
14191 int i;
14192 Jim_Obj *objPtr;
14193 Jim_Obj *dictObj;
14194 Jim_Obj **dictValues;
14195 int len;
14196 int ret = JIM_OK;
14198 /* Open up the appropriate level of the dictionary */
14199 dictObj = Jim_GetVariable(interp, dictVarName, JIM_ERRMSG);
14200 if (dictObj == NULL || Jim_DictKeysVector(interp, dictObj, keyv, keyc, &objPtr, JIM_ERRMSG) != JIM_OK) {
14201 return JIM_ERR;
14203 /* Set the local variables */
14204 if (Jim_DictPairs(interp, objPtr, &dictValues, &len) == JIM_ERR) {
14205 return JIM_ERR;
14207 for (i = 0; i < len; i += 2) {
14208 if (Jim_SetVariable(interp, dictValues[i], dictValues[i + 1]) == JIM_ERR) {
14209 Jim_Free(dictValues);
14210 return JIM_ERR;
14214 /* As an optimisation, if the script is empty, no need to evaluate it or update the dict */
14215 if (Jim_Length(scriptObj)) {
14216 ret = Jim_EvalObj(interp, scriptObj);
14218 /* Now if the dictionary still exists, update it based on the local variables */
14219 if (ret == JIM_OK && Jim_GetVariable(interp, dictVarName, 0) != NULL) {
14220 /* We need a copy of keyv with one extra element at the end for Jim_SetDictKeysVector() */
14221 Jim_Obj **newkeyv = Jim_Alloc(sizeof(*newkeyv) * (keyc + 1));
14222 for (i = 0; i < keyc; i++) {
14223 newkeyv[i] = keyv[i];
14226 for (i = 0; i < len; i += 2) {
14227 /* This will be NULL if the variable no longer exists, thus deleting the variable */
14228 objPtr = Jim_GetVariable(interp, dictValues[i], 0);
14229 newkeyv[keyc] = dictValues[i];
14230 Jim_SetDictKeysVector(interp, dictVarName, newkeyv, keyc + 1, objPtr, 0);
14232 Jim_Free(newkeyv);
14236 Jim_Free(dictValues);
14238 return ret;
14241 /* [dict] */
14242 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14244 Jim_Obj *objPtr;
14245 int types = JIM_DICTMATCH_KEYS;
14246 int option;
14247 static const char * const options[] = {
14248 "create", "get", "set", "unset", "exists", "keys", "size", "info",
14249 "merge", "with", "append", "lappend", "incr", "remove", "values", "for",
14250 "replace", "update", NULL
14252 enum
14254 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXISTS, OPT_KEYS, OPT_SIZE, OPT_INFO,
14255 OPT_MERGE, OPT_WITH, OPT_APPEND, OPT_LAPPEND, OPT_INCR, OPT_REMOVE, OPT_VALUES, OPT_FOR,
14256 OPT_REPLACE, OPT_UPDATE,
14259 if (argc < 2) {
14260 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?arguments ...?");
14261 return JIM_ERR;
14264 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK) {
14265 return Jim_CheckShowCommands(interp, argv[1], options);
14268 switch (option) {
14269 case OPT_GET:
14270 if (argc < 3) {
14271 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?key ...?");
14272 return JIM_ERR;
14274 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr,
14275 JIM_ERRMSG) != JIM_OK) {
14276 return JIM_ERR;
14278 Jim_SetResult(interp, objPtr);
14279 return JIM_OK;
14281 case OPT_SET:
14282 if (argc < 5) {
14283 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
14284 return JIM_ERR;
14286 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 4, argv[argc - 1], JIM_ERRMSG);
14288 case OPT_EXISTS:
14289 if (argc < 4) {
14290 Jim_WrongNumArgs(interp, 2, argv, "dictionary key ?key ...?");
14291 return JIM_ERR;
14293 else {
14294 int rc = Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr, JIM_ERRMSG);
14295 if (rc < 0) {
14296 return JIM_ERR;
14298 Jim_SetResultBool(interp, rc == JIM_OK);
14299 return JIM_OK;
14302 case OPT_UNSET:
14303 if (argc < 4) {
14304 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
14305 return JIM_ERR;
14307 if (Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 3, NULL, 0) != JIM_OK) {
14308 return JIM_ERR;
14310 return JIM_OK;
14312 case OPT_VALUES:
14313 types = JIM_DICTMATCH_VALUES;
14314 /* fallthru */
14315 case OPT_KEYS:
14316 if (argc != 3 && argc != 4) {
14317 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?pattern?");
14318 return JIM_ERR;
14320 return Jim_DictMatchTypes(interp, argv[2], argc == 4 ? argv[3] : NULL, types, types);
14322 case OPT_SIZE:
14323 if (argc != 3) {
14324 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14325 return JIM_ERR;
14327 else if (Jim_DictSize(interp, argv[2]) < 0) {
14328 return JIM_ERR;
14330 Jim_SetResultInt(interp, Jim_DictSize(interp, argv[2]));
14331 return JIM_OK;
14333 case OPT_MERGE:
14334 if (argc == 2) {
14335 return JIM_OK;
14337 objPtr = Jim_DictMerge(interp, argc - 2, argv + 2);
14338 if (objPtr == NULL) {
14339 return JIM_ERR;
14341 Jim_SetResult(interp, objPtr);
14342 return JIM_OK;
14344 case OPT_UPDATE:
14345 if (argc < 6 || argc % 2) {
14346 /* Better error message */
14347 argc = 2;
14349 break;
14351 case OPT_CREATE:
14352 if (argc % 2) {
14353 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
14354 return JIM_ERR;
14356 objPtr = Jim_NewDictObj(interp, argv + 2, argc - 2);
14357 Jim_SetResult(interp, objPtr);
14358 return JIM_OK;
14360 case OPT_INFO:
14361 if (argc != 3) {
14362 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14363 return JIM_ERR;
14365 return Jim_DictInfo(interp, argv[2]);
14367 case OPT_WITH:
14368 if (argc < 4) {
14369 Jim_WrongNumArgs(interp, 2, argv, "dictVar ?key ...? script");
14370 return JIM_ERR;
14372 return JimDictWith(interp, argv[2], argv + 3, argc - 4, argv[argc - 1]);
14374 /* Handle command as an ensemble */
14375 return Jim_EvalEnsemble(interp, "dict", options[option], argc - 2, argv + 2);
14378 /* [subst] */
14379 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14381 static const char * const options[] = {
14382 "-nobackslashes", "-nocommands", "-novariables", NULL
14384 enum
14385 { OPT_NOBACKSLASHES, OPT_NOCOMMANDS, OPT_NOVARIABLES };
14386 int i;
14387 int flags = JIM_SUBST_FLAG;
14388 Jim_Obj *objPtr;
14390 if (argc < 2) {
14391 Jim_WrongNumArgs(interp, 1, argv, "?options? string");
14392 return JIM_ERR;
14394 for (i = 1; i < (argc - 1); i++) {
14395 int option;
14397 if (Jim_GetEnum(interp, argv[i], options, &option, NULL,
14398 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14399 return JIM_ERR;
14401 switch (option) {
14402 case OPT_NOBACKSLASHES:
14403 flags |= JIM_SUBST_NOESC;
14404 break;
14405 case OPT_NOCOMMANDS:
14406 flags |= JIM_SUBST_NOCMD;
14407 break;
14408 case OPT_NOVARIABLES:
14409 flags |= JIM_SUBST_NOVAR;
14410 break;
14413 if (Jim_SubstObj(interp, argv[argc - 1], &objPtr, flags) != JIM_OK) {
14414 return JIM_ERR;
14416 Jim_SetResult(interp, objPtr);
14417 return JIM_OK;
14420 /* [info] */
14421 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14423 int cmd;
14424 Jim_Obj *objPtr;
14425 int mode = 0;
14427 static const char * const commands[] = {
14428 "body", "statics", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
14429 "vars", "version", "patchlevel", "complete", "args", "hostname",
14430 "script", "source", "stacktrace", "nameofexecutable", "returncodes",
14431 "references", "alias", NULL
14433 enum
14434 { INFO_BODY, INFO_STATICS, INFO_COMMANDS, INFO_PROCS, INFO_CHANNELS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
14435 INFO_FRAME, INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_PATCHLEVEL, INFO_COMPLETE, INFO_ARGS,
14436 INFO_HOSTNAME, INFO_SCRIPT, INFO_SOURCE, INFO_STACKTRACE, INFO_NAMEOFEXECUTABLE,
14437 INFO_RETURNCODES, INFO_REFERENCES, INFO_ALIAS,
14440 #ifdef jim_ext_namespace
14441 int nons = 0;
14443 if (argc > 2 && Jim_CompareStringImmediate(interp, argv[1], "-nons")) {
14444 /* This is for internal use only */
14445 argc--;
14446 argv++;
14447 nons = 1;
14449 #endif
14451 if (argc < 2) {
14452 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?args ...?");
14453 return JIM_ERR;
14455 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "subcommand", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14456 return Jim_CheckShowCommands(interp, argv[1], commands);
14459 /* Test for the most common commands first, just in case it makes a difference */
14460 switch (cmd) {
14461 case INFO_EXISTS:
14462 if (argc != 3) {
14463 Jim_WrongNumArgs(interp, 2, argv, "varName");
14464 return JIM_ERR;
14466 Jim_SetResultBool(interp, Jim_GetVariable(interp, argv[2], 0) != NULL);
14467 break;
14469 case INFO_ALIAS:{
14470 Jim_Cmd *cmdPtr;
14472 if (argc != 3) {
14473 Jim_WrongNumArgs(interp, 2, argv, "command");
14474 return JIM_ERR;
14476 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14477 return JIM_ERR;
14479 if (cmdPtr->isproc || cmdPtr->u.native.cmdProc != JimAliasCmd) {
14480 Jim_SetResultFormatted(interp, "command \"%#s\" is not an alias", argv[2]);
14481 return JIM_ERR;
14483 Jim_SetResult(interp, (Jim_Obj *)cmdPtr->u.native.privData);
14484 return JIM_OK;
14487 case INFO_CHANNELS:
14488 mode++; /* JIM_CMDLIST_CHANNELS */
14489 #ifndef jim_ext_aio
14490 Jim_SetResultString(interp, "aio not enabled", -1);
14491 return JIM_ERR;
14492 #endif
14493 /* fall through */
14494 case INFO_PROCS:
14495 mode++; /* JIM_CMDLIST_PROCS */
14496 /* fall through */
14497 case INFO_COMMANDS:
14498 /* mode 0 => JIM_CMDLIST_COMMANDS */
14499 if (argc != 2 && argc != 3) {
14500 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14501 return JIM_ERR;
14503 #ifdef jim_ext_namespace
14504 if (!nons) {
14505 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14506 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14509 #endif
14510 Jim_SetResult(interp, JimCommandsList(interp, (argc == 3) ? argv[2] : NULL, mode));
14511 break;
14513 case INFO_VARS:
14514 mode++; /* JIM_VARLIST_VARS */
14515 /* fall through */
14516 case INFO_LOCALS:
14517 mode++; /* JIM_VARLIST_LOCALS */
14518 /* fall through */
14519 case INFO_GLOBALS:
14520 /* mode 0 => JIM_VARLIST_GLOBALS */
14521 if (argc != 2 && argc != 3) {
14522 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14523 return JIM_ERR;
14525 #ifdef jim_ext_namespace
14526 if (!nons) {
14527 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14528 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14531 #endif
14532 Jim_SetResult(interp, JimVariablesList(interp, argc == 3 ? argv[2] : NULL, mode));
14533 break;
14535 case INFO_SCRIPT:
14536 if (argc != 2) {
14537 Jim_WrongNumArgs(interp, 2, argv, "");
14538 return JIM_ERR;
14540 Jim_SetResult(interp, JimGetScript(interp, interp->currentScriptObj)->fileNameObj);
14541 break;
14543 case INFO_SOURCE:{
14544 jim_wide line;
14545 Jim_Obj *resObjPtr;
14546 Jim_Obj *fileNameObj;
14548 if (argc != 3 && argc != 5) {
14549 Jim_WrongNumArgs(interp, 2, argv, "source ?filename line?");
14550 return JIM_ERR;
14552 if (argc == 5) {
14553 if (Jim_GetWide(interp, argv[4], &line) != JIM_OK) {
14554 return JIM_ERR;
14556 resObjPtr = Jim_NewStringObj(interp, Jim_String(argv[2]), Jim_Length(argv[2]));
14557 JimSetSourceInfo(interp, resObjPtr, argv[3], line);
14559 else {
14560 if (argv[2]->typePtr == &sourceObjType) {
14561 fileNameObj = argv[2]->internalRep.sourceValue.fileNameObj;
14562 line = argv[2]->internalRep.sourceValue.lineNumber;
14564 else if (argv[2]->typePtr == &scriptObjType) {
14565 ScriptObj *script = JimGetScript(interp, argv[2]);
14566 fileNameObj = script->fileNameObj;
14567 line = script->firstline;
14569 else {
14570 fileNameObj = interp->emptyObj;
14571 line = 1;
14573 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14574 Jim_ListAppendElement(interp, resObjPtr, fileNameObj);
14575 Jim_ListAppendElement(interp, resObjPtr, Jim_NewIntObj(interp, line));
14577 Jim_SetResult(interp, resObjPtr);
14578 break;
14581 case INFO_STACKTRACE:
14582 Jim_SetResult(interp, interp->stackTrace);
14583 break;
14585 case INFO_LEVEL:
14586 case INFO_FRAME:
14587 switch (argc) {
14588 case 2:
14589 Jim_SetResultInt(interp, interp->framePtr->level);
14590 break;
14592 case 3:
14593 if (JimInfoLevel(interp, argv[2], &objPtr, cmd == INFO_LEVEL) != JIM_OK) {
14594 return JIM_ERR;
14596 Jim_SetResult(interp, objPtr);
14597 break;
14599 default:
14600 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
14601 return JIM_ERR;
14603 break;
14605 case INFO_BODY:
14606 case INFO_STATICS:
14607 case INFO_ARGS:{
14608 Jim_Cmd *cmdPtr;
14610 if (argc != 3) {
14611 Jim_WrongNumArgs(interp, 2, argv, "procname");
14612 return JIM_ERR;
14614 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14615 return JIM_ERR;
14617 if (!cmdPtr->isproc) {
14618 Jim_SetResultFormatted(interp, "command \"%#s\" is not a procedure", argv[2]);
14619 return JIM_ERR;
14621 switch (cmd) {
14622 case INFO_BODY:
14623 Jim_SetResult(interp, cmdPtr->u.proc.bodyObjPtr);
14624 break;
14625 case INFO_ARGS:
14626 Jim_SetResult(interp, cmdPtr->u.proc.argListObjPtr);
14627 break;
14628 case INFO_STATICS:
14629 if (cmdPtr->u.proc.staticVars) {
14630 Jim_SetResult(interp, JimHashtablePatternMatch(interp, cmdPtr->u.proc.staticVars,
14631 NULL, JimVariablesMatch, JIM_VARLIST_LOCALS | JIM_VARLIST_VALUES));
14633 break;
14635 break;
14638 case INFO_VERSION:
14639 case INFO_PATCHLEVEL:{
14640 char buf[(JIM_INTEGER_SPACE * 2) + 1];
14642 sprintf(buf, "%d.%d", JIM_VERSION / 100, JIM_VERSION % 100);
14643 Jim_SetResultString(interp, buf, -1);
14644 break;
14647 case INFO_COMPLETE:
14648 if (argc != 3 && argc != 4) {
14649 Jim_WrongNumArgs(interp, 2, argv, "script ?missing?");
14650 return JIM_ERR;
14652 else {
14653 char missing;
14655 Jim_SetResultBool(interp, Jim_ScriptIsComplete(interp, argv[2], &missing));
14656 if (missing != ' ' && argc == 4) {
14657 Jim_SetVariable(interp, argv[3], Jim_NewStringObj(interp, &missing, 1));
14660 break;
14662 case INFO_HOSTNAME:
14663 /* Redirect to os.gethostname if it exists */
14664 return Jim_Eval(interp, "os.gethostname");
14666 case INFO_NAMEOFEXECUTABLE:
14667 /* Redirect to Tcl proc */
14668 return Jim_Eval(interp, "{info nameofexecutable}");
14670 case INFO_RETURNCODES:
14671 if (argc == 2) {
14672 int i;
14673 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14675 for (i = 0; jimReturnCodes[i]; i++) {
14676 Jim_ListAppendElement(interp, listObjPtr, Jim_NewIntObj(interp, i));
14677 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp,
14678 jimReturnCodes[i], -1));
14681 Jim_SetResult(interp, listObjPtr);
14683 else if (argc == 3) {
14684 long code;
14685 const char *name;
14687 if (Jim_GetLong(interp, argv[2], &code) != JIM_OK) {
14688 return JIM_ERR;
14690 name = Jim_ReturnCode(code);
14691 if (*name == '?') {
14692 Jim_SetResultInt(interp, code);
14694 else {
14695 Jim_SetResultString(interp, name, -1);
14698 else {
14699 Jim_WrongNumArgs(interp, 2, argv, "?code?");
14700 return JIM_ERR;
14702 break;
14703 case INFO_REFERENCES:
14704 #ifdef JIM_REFERENCES
14705 return JimInfoReferences(interp, argc, argv);
14706 #else
14707 Jim_SetResultString(interp, "not supported", -1);
14708 return JIM_ERR;
14709 #endif
14711 return JIM_OK;
14714 /* [exists] */
14715 static int Jim_ExistsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14717 Jim_Obj *objPtr;
14718 int result = 0;
14720 static const char * const options[] = {
14721 "-command", "-proc", "-alias", "-var", NULL
14723 enum
14725 OPT_COMMAND, OPT_PROC, OPT_ALIAS, OPT_VAR
14727 int option;
14729 if (argc == 2) {
14730 option = OPT_VAR;
14731 objPtr = argv[1];
14733 else if (argc == 3) {
14734 if (Jim_GetEnum(interp, argv[1], options, &option, NULL, JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14735 return JIM_ERR;
14737 objPtr = argv[2];
14739 else {
14740 Jim_WrongNumArgs(interp, 1, argv, "?option? name");
14741 return JIM_ERR;
14744 if (option == OPT_VAR) {
14745 result = Jim_GetVariable(interp, objPtr, 0) != NULL;
14747 else {
14748 /* Now different kinds of commands */
14749 Jim_Cmd *cmd = Jim_GetCommand(interp, objPtr, JIM_NONE);
14751 if (cmd) {
14752 switch (option) {
14753 case OPT_COMMAND:
14754 result = 1;
14755 break;
14757 case OPT_ALIAS:
14758 result = cmd->isproc == 0 && cmd->u.native.cmdProc == JimAliasCmd;
14759 break;
14761 case OPT_PROC:
14762 result = cmd->isproc;
14763 break;
14767 Jim_SetResultBool(interp, result);
14768 return JIM_OK;
14771 /* [split] */
14772 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14774 const char *str, *splitChars, *noMatchStart;
14775 int splitLen, strLen;
14776 Jim_Obj *resObjPtr;
14777 int c;
14778 int len;
14780 if (argc != 2 && argc != 3) {
14781 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
14782 return JIM_ERR;
14785 str = Jim_GetString(argv[1], &len);
14786 if (len == 0) {
14787 return JIM_OK;
14789 strLen = Jim_Utf8Length(interp, argv[1]);
14791 /* Init */
14792 if (argc == 2) {
14793 splitChars = " \n\t\r";
14794 splitLen = 4;
14796 else {
14797 splitChars = Jim_String(argv[2]);
14798 splitLen = Jim_Utf8Length(interp, argv[2]);
14801 noMatchStart = str;
14802 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14804 /* Split */
14805 if (splitLen) {
14806 Jim_Obj *objPtr;
14807 while (strLen--) {
14808 const char *sc = splitChars;
14809 int scLen = splitLen;
14810 int sl = utf8_tounicode(str, &c);
14811 while (scLen--) {
14812 int pc;
14813 sc += utf8_tounicode(sc, &pc);
14814 if (c == pc) {
14815 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14816 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14817 noMatchStart = str + sl;
14818 break;
14821 str += sl;
14823 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14824 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14826 else {
14827 /* This handles the special case of splitchars eq {}
14828 * Optimise by sharing common (ASCII) characters
14830 Jim_Obj **commonObj = NULL;
14831 #define NUM_COMMON (128 - 9)
14832 while (strLen--) {
14833 int n = utf8_tounicode(str, &c);
14834 #ifdef JIM_OPTIMIZATION
14835 if (c >= 9 && c < 128) {
14836 /* Common ASCII char. Note that 9 is the tab character */
14837 c -= 9;
14838 if (!commonObj) {
14839 commonObj = Jim_Alloc(sizeof(*commonObj) * NUM_COMMON);
14840 memset(commonObj, 0, sizeof(*commonObj) * NUM_COMMON);
14842 if (!commonObj[c]) {
14843 commonObj[c] = Jim_NewStringObj(interp, str, 1);
14845 Jim_ListAppendElement(interp, resObjPtr, commonObj[c]);
14846 str++;
14847 continue;
14849 #endif
14850 Jim_ListAppendElement(interp, resObjPtr, Jim_NewStringObjUtf8(interp, str, 1));
14851 str += n;
14853 Jim_Free(commonObj);
14856 Jim_SetResult(interp, resObjPtr);
14857 return JIM_OK;
14860 /* [join] */
14861 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14863 const char *joinStr;
14864 int joinStrLen;
14866 if (argc != 2 && argc != 3) {
14867 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
14868 return JIM_ERR;
14870 /* Init */
14871 if (argc == 2) {
14872 joinStr = " ";
14873 joinStrLen = 1;
14875 else {
14876 joinStr = Jim_GetString(argv[2], &joinStrLen);
14878 Jim_SetResult(interp, Jim_ListJoin(interp, argv[1], joinStr, joinStrLen));
14879 return JIM_OK;
14882 /* [format] */
14883 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14885 Jim_Obj *objPtr;
14887 if (argc < 2) {
14888 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
14889 return JIM_ERR;
14891 objPtr = Jim_FormatString(interp, argv[1], argc - 2, argv + 2);
14892 if (objPtr == NULL)
14893 return JIM_ERR;
14894 Jim_SetResult(interp, objPtr);
14895 return JIM_OK;
14898 /* [scan] */
14899 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14901 Jim_Obj *listPtr, **outVec;
14902 int outc, i;
14904 if (argc < 3) {
14905 Jim_WrongNumArgs(interp, 1, argv, "string format ?varName varName ...?");
14906 return JIM_ERR;
14908 if (argv[2]->typePtr != &scanFmtStringObjType)
14909 SetScanFmtFromAny(interp, argv[2]);
14910 if (FormatGetError(argv[2]) != 0) {
14911 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
14912 return JIM_ERR;
14914 if (argc > 3) {
14915 int maxPos = FormatGetMaxPos(argv[2]);
14916 int count = FormatGetCnvCount(argv[2]);
14918 if (maxPos > argc - 3) {
14919 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
14920 return JIM_ERR;
14922 else if (count > argc - 3) {
14923 Jim_SetResultString(interp, "different numbers of variable names and "
14924 "field specifiers", -1);
14925 return JIM_ERR;
14927 else if (count < argc - 3) {
14928 Jim_SetResultString(interp, "variable is not assigned by any "
14929 "conversion specifiers", -1);
14930 return JIM_ERR;
14933 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
14934 if (listPtr == 0)
14935 return JIM_ERR;
14936 if (argc > 3) {
14937 int rc = JIM_OK;
14938 int count = 0;
14940 if (listPtr != 0 && listPtr != (Jim_Obj *)EOF) {
14941 int len = Jim_ListLength(interp, listPtr);
14943 if (len != 0) {
14944 JimListGetElements(interp, listPtr, &outc, &outVec);
14945 for (i = 0; i < outc; ++i) {
14946 if (Jim_Length(outVec[i]) > 0) {
14947 ++count;
14948 if (Jim_SetVariable(interp, argv[3 + i], outVec[i]) != JIM_OK) {
14949 rc = JIM_ERR;
14954 Jim_FreeNewObj(interp, listPtr);
14956 else {
14957 count = -1;
14959 if (rc == JIM_OK) {
14960 Jim_SetResultInt(interp, count);
14962 return rc;
14964 else {
14965 if (listPtr == (Jim_Obj *)EOF) {
14966 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
14967 return JIM_OK;
14969 Jim_SetResult(interp, listPtr);
14971 return JIM_OK;
14974 /* [error] */
14975 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14977 if (argc != 2 && argc != 3) {
14978 Jim_WrongNumArgs(interp, 1, argv, "message ?stacktrace?");
14979 return JIM_ERR;
14981 Jim_SetResult(interp, argv[1]);
14982 if (argc == 3) {
14983 JimSetStackTrace(interp, argv[2]);
14984 return JIM_ERR;
14986 interp->addStackTrace++;
14987 return JIM_ERR;
14990 /* [lrange] */
14991 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14993 Jim_Obj *objPtr;
14995 if (argc != 4) {
14996 Jim_WrongNumArgs(interp, 1, argv, "list first last");
14997 return JIM_ERR;
14999 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
15000 return JIM_ERR;
15001 Jim_SetResult(interp, objPtr);
15002 return JIM_OK;
15005 /* [lrepeat] */
15006 static int Jim_LrepeatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15008 Jim_Obj *objPtr;
15009 long count;
15011 if (argc < 2 || Jim_GetLong(interp, argv[1], &count) != JIM_OK || count < 0) {
15012 Jim_WrongNumArgs(interp, 1, argv, "count ?value ...?");
15013 return JIM_ERR;
15016 if (count == 0 || argc == 2) {
15017 return JIM_OK;
15020 argc -= 2;
15021 argv += 2;
15023 objPtr = Jim_NewListObj(interp, argv, argc);
15024 while (--count) {
15025 ListInsertElements(objPtr, -1, argc, argv);
15028 Jim_SetResult(interp, objPtr);
15029 return JIM_OK;
15032 char **Jim_GetEnviron(void)
15034 #if defined(HAVE__NSGETENVIRON)
15035 return *_NSGetEnviron();
15036 #else
15037 #if !defined(NO_ENVIRON_EXTERN)
15038 extern char **environ;
15039 #endif
15041 return environ;
15042 #endif
15045 void Jim_SetEnviron(char **env)
15047 #if defined(HAVE__NSGETENVIRON)
15048 *_NSGetEnviron() = env;
15049 #else
15050 #if !defined(NO_ENVIRON_EXTERN)
15051 extern char **environ;
15052 #endif
15054 environ = env;
15055 #endif
15058 /* [env] */
15059 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15061 const char *key;
15062 const char *val;
15064 if (argc == 1) {
15065 char **e = Jim_GetEnviron();
15067 int i;
15068 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
15070 for (i = 0; e[i]; i++) {
15071 const char *equals = strchr(e[i], '=');
15073 if (equals) {
15074 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, e[i],
15075 equals - e[i]));
15076 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
15080 Jim_SetResult(interp, listObjPtr);
15081 return JIM_OK;
15084 if (argc < 2) {
15085 Jim_WrongNumArgs(interp, 1, argv, "varName ?default?");
15086 return JIM_ERR;
15088 key = Jim_String(argv[1]);
15089 val = getenv(key);
15090 if (val == NULL) {
15091 if (argc < 3) {
15092 Jim_SetResultFormatted(interp, "environment variable \"%#s\" does not exist", argv[1]);
15093 return JIM_ERR;
15095 val = Jim_String(argv[2]);
15097 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
15098 return JIM_OK;
15101 /* [source] */
15102 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15104 int retval;
15106 if (argc != 2) {
15107 Jim_WrongNumArgs(interp, 1, argv, "fileName");
15108 return JIM_ERR;
15110 retval = Jim_EvalFile(interp, Jim_String(argv[1]));
15111 if (retval == JIM_RETURN)
15112 return JIM_OK;
15113 return retval;
15116 /* [lreverse] */
15117 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15119 Jim_Obj *revObjPtr, **ele;
15120 int len;
15122 if (argc != 2) {
15123 Jim_WrongNumArgs(interp, 1, argv, "list");
15124 return JIM_ERR;
15126 JimListGetElements(interp, argv[1], &len, &ele);
15127 len--;
15128 revObjPtr = Jim_NewListObj(interp, NULL, 0);
15129 while (len >= 0)
15130 ListAppendElement(revObjPtr, ele[len--]);
15131 Jim_SetResult(interp, revObjPtr);
15132 return JIM_OK;
15135 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
15137 jim_wide len;
15139 if (step == 0)
15140 return -1;
15141 if (start == end)
15142 return 0;
15143 else if (step > 0 && start > end)
15144 return -1;
15145 else if (step < 0 && end > start)
15146 return -1;
15147 len = end - start;
15148 if (len < 0)
15149 len = -len; /* abs(len) */
15150 if (step < 0)
15151 step = -step; /* abs(step) */
15152 len = 1 + ((len - 1) / step);
15153 /* We can truncate safely to INT_MAX, the range command
15154 * will always return an error for a such long range
15155 * because Tcl lists can't be so long. */
15156 if (len > INT_MAX)
15157 len = INT_MAX;
15158 return (int)((len < 0) ? -1 : len);
15161 /* [range] */
15162 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15164 jim_wide start = 0, end, step = 1;
15165 int len, i;
15166 Jim_Obj *objPtr;
15168 if (argc < 2 || argc > 4) {
15169 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
15170 return JIM_ERR;
15172 if (argc == 2) {
15173 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
15174 return JIM_ERR;
15176 else {
15177 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
15178 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
15179 return JIM_ERR;
15180 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
15181 return JIM_ERR;
15183 if ((len = JimRangeLen(start, end, step)) == -1) {
15184 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
15185 return JIM_ERR;
15187 objPtr = Jim_NewListObj(interp, NULL, 0);
15188 for (i = 0; i < len; i++)
15189 ListAppendElement(objPtr, Jim_NewIntObj(interp, start + i * step));
15190 Jim_SetResult(interp, objPtr);
15191 return JIM_OK;
15194 /* [rand] */
15195 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15197 jim_wide min = 0, max = 0, len, maxMul;
15199 if (argc < 1 || argc > 3) {
15200 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
15201 return JIM_ERR;
15203 if (argc == 1) {
15204 max = JIM_WIDE_MAX;
15205 } else if (argc == 2) {
15206 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
15207 return JIM_ERR;
15208 } else if (argc == 3) {
15209 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
15210 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
15211 return JIM_ERR;
15213 len = max-min;
15214 if (len < 0) {
15215 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
15216 return JIM_ERR;
15218 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
15219 while (1) {
15220 jim_wide r;
15222 JimRandomBytes(interp, &r, sizeof(jim_wide));
15223 if (r < 0 || r >= maxMul) continue;
15224 r = (len == 0) ? 0 : r%len;
15225 Jim_SetResultInt(interp, min+r);
15226 return JIM_OK;
15230 static const struct {
15231 const char *name;
15232 Jim_CmdProc *cmdProc;
15233 } Jim_CoreCommandsTable[] = {
15234 {"alias", Jim_AliasCoreCommand},
15235 {"set", Jim_SetCoreCommand},
15236 {"unset", Jim_UnsetCoreCommand},
15237 {"puts", Jim_PutsCoreCommand},
15238 {"+", Jim_AddCoreCommand},
15239 {"*", Jim_MulCoreCommand},
15240 {"-", Jim_SubCoreCommand},
15241 {"/", Jim_DivCoreCommand},
15242 {"incr", Jim_IncrCoreCommand},
15243 {"while", Jim_WhileCoreCommand},
15244 {"loop", Jim_LoopCoreCommand},
15245 {"for", Jim_ForCoreCommand},
15246 {"foreach", Jim_ForeachCoreCommand},
15247 {"lmap", Jim_LmapCoreCommand},
15248 {"lassign", Jim_LassignCoreCommand},
15249 {"if", Jim_IfCoreCommand},
15250 {"switch", Jim_SwitchCoreCommand},
15251 {"list", Jim_ListCoreCommand},
15252 {"lindex", Jim_LindexCoreCommand},
15253 {"lset", Jim_LsetCoreCommand},
15254 {"lsearch", Jim_LsearchCoreCommand},
15255 {"llength", Jim_LlengthCoreCommand},
15256 {"lappend", Jim_LappendCoreCommand},
15257 {"linsert", Jim_LinsertCoreCommand},
15258 {"lreplace", Jim_LreplaceCoreCommand},
15259 {"lsort", Jim_LsortCoreCommand},
15260 {"append", Jim_AppendCoreCommand},
15261 {"debug", Jim_DebugCoreCommand},
15262 {"eval", Jim_EvalCoreCommand},
15263 {"uplevel", Jim_UplevelCoreCommand},
15264 {"expr", Jim_ExprCoreCommand},
15265 {"break", Jim_BreakCoreCommand},
15266 {"continue", Jim_ContinueCoreCommand},
15267 {"proc", Jim_ProcCoreCommand},
15268 {"concat", Jim_ConcatCoreCommand},
15269 {"return", Jim_ReturnCoreCommand},
15270 {"upvar", Jim_UpvarCoreCommand},
15271 {"global", Jim_GlobalCoreCommand},
15272 {"string", Jim_StringCoreCommand},
15273 {"time", Jim_TimeCoreCommand},
15274 {"exit", Jim_ExitCoreCommand},
15275 {"catch", Jim_CatchCoreCommand},
15276 #ifdef JIM_REFERENCES
15277 {"ref", Jim_RefCoreCommand},
15278 {"getref", Jim_GetrefCoreCommand},
15279 {"setref", Jim_SetrefCoreCommand},
15280 {"finalize", Jim_FinalizeCoreCommand},
15281 {"collect", Jim_CollectCoreCommand},
15282 #endif
15283 {"rename", Jim_RenameCoreCommand},
15284 {"dict", Jim_DictCoreCommand},
15285 {"subst", Jim_SubstCoreCommand},
15286 {"info", Jim_InfoCoreCommand},
15287 {"exists", Jim_ExistsCoreCommand},
15288 {"split", Jim_SplitCoreCommand},
15289 {"join", Jim_JoinCoreCommand},
15290 {"format", Jim_FormatCoreCommand},
15291 {"scan", Jim_ScanCoreCommand},
15292 {"error", Jim_ErrorCoreCommand},
15293 {"lrange", Jim_LrangeCoreCommand},
15294 {"lrepeat", Jim_LrepeatCoreCommand},
15295 {"env", Jim_EnvCoreCommand},
15296 {"source", Jim_SourceCoreCommand},
15297 {"lreverse", Jim_LreverseCoreCommand},
15298 {"range", Jim_RangeCoreCommand},
15299 {"rand", Jim_RandCoreCommand},
15300 {"tailcall", Jim_TailcallCoreCommand},
15301 {"local", Jim_LocalCoreCommand},
15302 {"upcall", Jim_UpcallCoreCommand},
15303 {"apply", Jim_ApplyCoreCommand},
15304 {NULL, NULL},
15307 void Jim_RegisterCoreCommands(Jim_Interp *interp)
15309 int i = 0;
15311 while (Jim_CoreCommandsTable[i].name != NULL) {
15312 Jim_CreateCommand(interp,
15313 Jim_CoreCommandsTable[i].name, Jim_CoreCommandsTable[i].cmdProc, NULL, NULL);
15314 i++;
15318 /* -----------------------------------------------------------------------------
15319 * Interactive prompt
15320 * ---------------------------------------------------------------------------*/
15321 void Jim_MakeErrorMessage(Jim_Interp *interp)
15323 Jim_Obj *argv[2];
15325 argv[0] = Jim_NewStringObj(interp, "errorInfo", -1);
15326 argv[1] = interp->result;
15328 Jim_EvalObjVector(interp, 2, argv);
15332 * Given a null terminated array of strings, returns an allocated, sorted
15333 * copy of the array.
15335 static char **JimSortStringTable(const char *const *tablePtr)
15337 int count;
15338 char **tablePtrSorted;
15340 /* Find the size of the table */
15341 for (count = 0; tablePtr[count]; count++) {
15344 /* Allocate one extra for the terminating NULL pointer */
15345 tablePtrSorted = Jim_Alloc(sizeof(char *) * (count + 1));
15346 memcpy(tablePtrSorted, tablePtr, sizeof(char *) * count);
15347 qsort(tablePtrSorted, count, sizeof(char *), qsortCompareStringPointers);
15348 tablePtrSorted[count] = NULL;
15350 return tablePtrSorted;
15353 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
15354 const char *prefix, const char *const *tablePtr, const char *name)
15356 char **tablePtrSorted;
15357 int i;
15359 if (name == NULL) {
15360 name = "option";
15363 Jim_SetResultFormatted(interp, "%s%s \"%s\": must be ", badtype, name, arg);
15364 tablePtrSorted = JimSortStringTable(tablePtr);
15365 for (i = 0; tablePtrSorted[i]; i++) {
15366 if (tablePtrSorted[i + 1] == NULL && i > 0) {
15367 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
15369 Jim_AppendStrings(interp, Jim_GetResult(interp), prefix, tablePtrSorted[i], NULL);
15370 if (tablePtrSorted[i + 1]) {
15371 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
15374 Jim_Free(tablePtrSorted);
15379 * If objPtr is "-commands" sets the Jim result as a sorted list of options in the table
15380 * and returns JIM_OK.
15382 * Otherwise returns JIM_ERR.
15384 int Jim_CheckShowCommands(Jim_Interp *interp, Jim_Obj *objPtr, const char *const *tablePtr)
15386 if (Jim_CompareStringImmediate(interp, objPtr, "-commands")) {
15387 int i;
15388 char **tablePtrSorted = JimSortStringTable(tablePtr);
15389 Jim_SetResult(interp, Jim_NewListObj(interp, NULL, 0));
15390 for (i = 0; tablePtrSorted[i]; i++) {
15391 Jim_ListAppendElement(interp, Jim_GetResult(interp), Jim_NewStringObj(interp, tablePtrSorted[i], -1));
15393 Jim_Free(tablePtrSorted);
15394 return JIM_OK;
15396 return JIM_ERR;
15399 /* internal rep is stored in ptrIntvalue
15400 * ptr = tablePtr
15401 * int1 = flags
15402 * int2 = index
15404 static const Jim_ObjType getEnumObjType = {
15405 "get-enum",
15406 NULL,
15407 NULL,
15408 NULL,
15409 JIM_TYPE_REFERENCES
15412 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
15413 const char *const *tablePtr, int *indexPtr, const char *name, int flags)
15415 const char *bad = "bad ";
15416 const char *const *entryPtr = NULL;
15417 int i;
15418 int match = -1;
15419 int arglen;
15420 const char *arg;
15422 if (objPtr->typePtr == &getEnumObjType) {
15423 if (objPtr->internalRep.ptrIntValue.ptr == tablePtr && objPtr->internalRep.ptrIntValue.int1 == flags) {
15424 *indexPtr = objPtr->internalRep.ptrIntValue.int2;
15425 return JIM_OK;
15429 arg = Jim_GetString(objPtr, &arglen);
15431 *indexPtr = -1;
15433 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
15434 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
15435 /* Found an exact match */
15436 match = i;
15437 goto found;
15439 if (flags & JIM_ENUM_ABBREV) {
15440 /* Accept an unambiguous abbreviation.
15441 * Note that '-' doesnt' consitute a valid abbreviation
15443 if (strncmp(arg, *entryPtr, arglen) == 0) {
15444 if (*arg == '-' && arglen == 1) {
15445 break;
15447 if (match >= 0) {
15448 bad = "ambiguous ";
15449 goto ambiguous;
15451 match = i;
15456 /* If we had an unambiguous partial match */
15457 if (match >= 0) {
15458 found:
15459 /* Record the match in the object */
15460 Jim_FreeIntRep(interp, objPtr);
15461 objPtr->typePtr = &getEnumObjType;
15462 objPtr->internalRep.ptrIntValue.ptr = (void *)tablePtr;
15463 objPtr->internalRep.ptrIntValue.int1 = flags;
15464 objPtr->internalRep.ptrIntValue.int2 = match;
15465 /* Return the result */
15466 *indexPtr = match;
15467 return JIM_OK;
15470 ambiguous:
15471 if (flags & JIM_ERRMSG) {
15472 JimSetFailedEnumResult(interp, arg, bad, "", tablePtr, name);
15474 return JIM_ERR;
15477 int Jim_FindByName(const char *name, const char * const array[], size_t len)
15479 int i;
15481 for (i = 0; i < (int)len; i++) {
15482 if (array[i] && strcmp(array[i], name) == 0) {
15483 return i;
15486 return -1;
15489 int Jim_IsDict(Jim_Obj *objPtr)
15491 return objPtr->typePtr == &dictObjType;
15494 int Jim_IsList(Jim_Obj *objPtr)
15496 return objPtr->typePtr == &listObjType;
15500 * Very simple printf-like formatting, designed for error messages.
15502 * The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
15503 * The resulting string is created and set as the result.
15505 * Each '%s' should correspond to a regular string parameter.
15506 * Each '%#s' should correspond to a (Jim_Obj *) parameter.
15507 * Any other printf specifier is not allowed (but %% is allowed for the % character).
15509 * e.g. Jim_SetResultFormatted(interp, "Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
15511 * Note: We take advantage of the fact that printf has the same behaviour for both %s and %#s
15513 * Note that any Jim_Obj parameters with zero ref count will be freed as a result of this call.
15515 void Jim_SetResultFormatted(Jim_Interp *interp, const char *format, ...)
15517 /* Initial space needed */
15518 int len = strlen(format);
15519 int extra = 0;
15520 int n = 0;
15521 const char *params[5];
15522 int nobjparam = 0;
15523 Jim_Obj *objparam[5];
15524 char *buf;
15525 va_list args;
15526 int i;
15528 va_start(args, format);
15530 for (i = 0; i < len && n < 5; i++) {
15531 int l;
15533 if (strncmp(format + i, "%s", 2) == 0) {
15534 params[n] = va_arg(args, char *);
15536 l = strlen(params[n]);
15538 else if (strncmp(format + i, "%#s", 3) == 0) {
15539 Jim_Obj *objPtr = va_arg(args, Jim_Obj *);
15541 params[n] = Jim_GetString(objPtr, &l);
15542 objparam[nobjparam++] = objPtr;
15543 Jim_IncrRefCount(objPtr);
15545 else {
15546 if (format[i] == '%') {
15547 i++;
15549 continue;
15551 n++;
15552 extra += l;
15555 len += extra;
15556 buf = Jim_Alloc(len + 1);
15557 len = snprintf(buf, len + 1, format, params[0], params[1], params[2], params[3], params[4]);
15559 va_end(args);
15561 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
15563 for (i = 0; i < nobjparam; i++) {
15564 Jim_DecrRefCount(interp, objparam[i]);
15568 /* stubs */
15569 #ifndef jim_ext_package
15570 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver, int flags)
15572 return JIM_OK;
15574 #endif
15575 #ifndef jim_ext_aio
15576 FILE *Jim_AioFilehandle(Jim_Interp *interp, Jim_Obj *fhObj)
15578 Jim_SetResultString(interp, "aio not enabled", -1);
15579 return NULL;
15581 #endif
15585 * Local Variables: ***
15586 * c-basic-offset: 4 ***
15587 * tab-width: 4 ***
15588 * End: ***