file: Add microsecond resolution for mtime: mtimeus
[jimtcl.git] / jim.c
blob00b42421f904aa2d7bf74ae1d0e04b11a560bfb7
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 /* Resize the table to the minimal size that contains all the elements,
766 * but with the invariant of a USER/BUCKETS ration near to <= 1 */
767 void Jim_ResizeHashTable(Jim_HashTable *ht)
769 int minimal = ht->used;
771 if (minimal < JIM_HT_INITIAL_SIZE)
772 minimal = JIM_HT_INITIAL_SIZE;
773 Jim_ExpandHashTable(ht, minimal);
776 /* Expand or create the hashtable */
777 void Jim_ExpandHashTable(Jim_HashTable *ht, unsigned int size)
779 Jim_HashTable n; /* the new hashtable */
780 unsigned int realsize = JimHashTableNextPower(size), i;
782 /* the size is invalid if it is smaller than the number of
783 * elements already inside the hashtable */
784 if (size <= ht->used)
785 return;
787 Jim_InitHashTable(&n, ht->type, ht->privdata);
788 n.size = realsize;
789 n.sizemask = realsize - 1;
790 n.table = Jim_Alloc(realsize * sizeof(Jim_HashEntry *));
791 /* Keep the same 'uniq' as the original */
792 n.uniq = ht->uniq;
794 /* Initialize all the pointers to NULL */
795 memset(n.table, 0, realsize * sizeof(Jim_HashEntry *));
797 /* Copy all the elements from the old to the new table:
798 * note that if the old hash table is empty ht->used is zero,
799 * so Jim_ExpandHashTable just creates an empty hash table. */
800 n.used = ht->used;
801 for (i = 0; ht->used > 0; i++) {
802 Jim_HashEntry *he, *nextHe;
804 if (ht->table[i] == NULL)
805 continue;
807 /* For each hash entry on this slot... */
808 he = ht->table[i];
809 while (he) {
810 unsigned int h;
812 nextHe = he->next;
813 /* Get the new element index */
814 h = Jim_HashKey(ht, he->key) & n.sizemask;
815 he->next = n.table[h];
816 n.table[h] = he;
817 ht->used--;
818 /* Pass to the next element */
819 he = nextHe;
822 assert(ht->used == 0);
823 Jim_Free(ht->table);
825 /* Remap the new hashtable in the old */
826 *ht = n;
829 /* Add an element to the target hash table */
830 int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val)
832 Jim_HashEntry *entry;
834 /* Get the index of the new element, or -1 if
835 * the element already exists. */
836 entry = JimInsertHashEntry(ht, key, 0);
837 if (entry == NULL)
838 return JIM_ERR;
840 /* Set the hash entry fields. */
841 Jim_SetHashKey(ht, entry, key);
842 Jim_SetHashVal(ht, entry, val);
843 return JIM_OK;
846 /* Add an element, discarding the old if the key already exists */
847 int Jim_ReplaceHashEntry(Jim_HashTable *ht, const void *key, void *val)
849 int existed;
850 Jim_HashEntry *entry;
852 /* Get the index of the new element, or -1 if
853 * the element already exists. */
854 entry = JimInsertHashEntry(ht, key, 1);
855 if (entry->key) {
856 /* It already exists, so only replace the value.
857 * Note if both a destructor and a duplicate function exist,
858 * need to dup before destroy. perhaps they are the same
859 * reference counted object
861 if (ht->type->valDestructor && ht->type->valDup) {
862 void *newval = ht->type->valDup(ht->privdata, val);
863 ht->type->valDestructor(ht->privdata, entry->u.val);
864 entry->u.val = newval;
866 else {
867 Jim_FreeEntryVal(ht, entry);
868 Jim_SetHashVal(ht, entry, val);
870 existed = 1;
872 else {
873 /* Doesn't exist, so set the key */
874 Jim_SetHashKey(ht, entry, key);
875 Jim_SetHashVal(ht, entry, val);
876 existed = 0;
879 return existed;
882 /* Search and remove an element */
883 int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key)
885 unsigned int h;
886 Jim_HashEntry *he, *prevHe;
888 if (ht->used == 0)
889 return JIM_ERR;
890 h = Jim_HashKey(ht, key) & ht->sizemask;
891 he = ht->table[h];
893 prevHe = NULL;
894 while (he) {
895 if (Jim_CompareHashKeys(ht, key, he->key)) {
896 /* Unlink the element from the list */
897 if (prevHe)
898 prevHe->next = he->next;
899 else
900 ht->table[h] = he->next;
901 Jim_FreeEntryKey(ht, he);
902 Jim_FreeEntryVal(ht, he);
903 Jim_Free(he);
904 ht->used--;
905 return JIM_OK;
907 prevHe = he;
908 he = he->next;
910 return JIM_ERR; /* not found */
913 /* Destroy an entire hash table and leave it ready for reuse */
914 int Jim_FreeHashTable(Jim_HashTable *ht)
916 unsigned int i;
918 /* Free all the elements */
919 for (i = 0; ht->used > 0; i++) {
920 Jim_HashEntry *he, *nextHe;
922 if ((he = ht->table[i]) == NULL)
923 continue;
924 while (he) {
925 nextHe = he->next;
926 Jim_FreeEntryKey(ht, he);
927 Jim_FreeEntryVal(ht, he);
928 Jim_Free(he);
929 ht->used--;
930 he = nextHe;
933 /* Free the table and the allocated cache structure */
934 Jim_Free(ht->table);
935 /* Re-initialize the table */
936 JimResetHashTable(ht);
937 return JIM_OK; /* never fails */
940 Jim_HashEntry *Jim_FindHashEntry(Jim_HashTable *ht, const void *key)
942 Jim_HashEntry *he;
943 unsigned int h;
945 if (ht->used == 0)
946 return NULL;
947 h = Jim_HashKey(ht, key) & ht->sizemask;
948 he = ht->table[h];
949 while (he) {
950 if (Jim_CompareHashKeys(ht, key, he->key))
951 return he;
952 he = he->next;
954 return NULL;
957 Jim_HashTableIterator *Jim_GetHashTableIterator(Jim_HashTable *ht)
959 Jim_HashTableIterator *iter = Jim_Alloc(sizeof(*iter));
960 JimInitHashTableIterator(ht, iter);
961 return iter;
964 Jim_HashEntry *Jim_NextHashEntry(Jim_HashTableIterator *iter)
966 while (1) {
967 if (iter->entry == NULL) {
968 iter->index++;
969 if (iter->index >= (signed)iter->ht->size)
970 break;
971 iter->entry = iter->ht->table[iter->index];
973 else {
974 iter->entry = iter->nextEntry;
976 if (iter->entry) {
977 /* We need to save the 'next' here, the iterator user
978 * may delete the entry we are returning. */
979 iter->nextEntry = iter->entry->next;
980 return iter->entry;
983 return NULL;
986 /* ------------------------- private functions ------------------------------ */
988 /* Expand the hash table if needed */
989 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht)
991 /* If the hash table is empty expand it to the intial size,
992 * if the table is "full" double its size. */
993 if (ht->size == 0)
994 Jim_ExpandHashTable(ht, JIM_HT_INITIAL_SIZE);
995 if (ht->size == ht->used)
996 Jim_ExpandHashTable(ht, ht->size * 2);
999 /* Our hash table capability is a power of two */
1000 static unsigned int JimHashTableNextPower(unsigned int size)
1002 unsigned int i = JIM_HT_INITIAL_SIZE;
1004 if (size >= 2147483648U)
1005 return 2147483648U;
1006 while (1) {
1007 if (i >= size)
1008 return i;
1009 i *= 2;
1013 /* Returns the index of a free slot that can be populated with
1014 * a hash entry for the given 'key'.
1015 * If the key already exists, -1 is returned. */
1016 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace)
1018 unsigned int h;
1019 Jim_HashEntry *he;
1021 /* Expand the hashtable if needed */
1022 JimExpandHashTableIfNeeded(ht);
1024 /* Compute the key hash value */
1025 h = Jim_HashKey(ht, key) & ht->sizemask;
1026 /* Search if this slot does not already contain the given key */
1027 he = ht->table[h];
1028 while (he) {
1029 if (Jim_CompareHashKeys(ht, key, he->key))
1030 return replace ? he : NULL;
1031 he = he->next;
1034 /* Allocates the memory and stores key */
1035 he = Jim_Alloc(sizeof(*he));
1036 he->next = ht->table[h];
1037 ht->table[h] = he;
1038 ht->used++;
1039 he->key = NULL;
1041 return he;
1044 /* ----------------------- StringCopy Hash Table Type ------------------------*/
1046 static unsigned int JimStringCopyHTHashFunction(const void *key)
1048 return Jim_GenHashFunction(key, strlen(key));
1051 static void *JimStringCopyHTDup(void *privdata, const void *key)
1053 return Jim_StrDup(key);
1056 static int JimStringCopyHTKeyCompare(void *privdata, const void *key1, const void *key2)
1058 return strcmp(key1, key2) == 0;
1061 static void JimStringCopyHTKeyDestructor(void *privdata, void *key)
1063 Jim_Free(key);
1066 static const Jim_HashTableType JimPackageHashTableType = {
1067 JimStringCopyHTHashFunction, /* hash function */
1068 JimStringCopyHTDup, /* key dup */
1069 NULL, /* val dup */
1070 JimStringCopyHTKeyCompare, /* key compare */
1071 JimStringCopyHTKeyDestructor, /* key destructor */
1072 NULL /* val destructor */
1075 typedef struct AssocDataValue
1077 Jim_InterpDeleteProc *delProc;
1078 void *data;
1079 } AssocDataValue;
1081 static void JimAssocDataHashTableValueDestructor(void *privdata, void *data)
1083 AssocDataValue *assocPtr = (AssocDataValue *) data;
1085 if (assocPtr->delProc != NULL)
1086 assocPtr->delProc((Jim_Interp *)privdata, assocPtr->data);
1087 Jim_Free(data);
1090 static const Jim_HashTableType JimAssocDataHashTableType = {
1091 JimStringCopyHTHashFunction, /* hash function */
1092 JimStringCopyHTDup, /* key dup */
1093 NULL, /* val dup */
1094 JimStringCopyHTKeyCompare, /* key compare */
1095 JimStringCopyHTKeyDestructor, /* key destructor */
1096 JimAssocDataHashTableValueDestructor /* val destructor */
1099 /* -----------------------------------------------------------------------------
1100 * Stack - This is a simple generic stack implementation. It is used for
1101 * example in the 'expr' expression compiler.
1102 * ---------------------------------------------------------------------------*/
1103 void Jim_InitStack(Jim_Stack *stack)
1105 stack->len = 0;
1106 stack->maxlen = 0;
1107 stack->vector = NULL;
1110 void Jim_FreeStack(Jim_Stack *stack)
1112 Jim_Free(stack->vector);
1115 int Jim_StackLen(Jim_Stack *stack)
1117 return stack->len;
1120 void Jim_StackPush(Jim_Stack *stack, void *element)
1122 int neededLen = stack->len + 1;
1124 if (neededLen > stack->maxlen) {
1125 stack->maxlen = neededLen < 20 ? 20 : neededLen * 2;
1126 stack->vector = Jim_Realloc(stack->vector, sizeof(void *) * stack->maxlen);
1128 stack->vector[stack->len] = element;
1129 stack->len++;
1132 void *Jim_StackPop(Jim_Stack *stack)
1134 if (stack->len == 0)
1135 return NULL;
1136 stack->len--;
1137 return stack->vector[stack->len];
1140 void *Jim_StackPeek(Jim_Stack *stack)
1142 if (stack->len == 0)
1143 return NULL;
1144 return stack->vector[stack->len - 1];
1147 void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc) (void *ptr))
1149 int i;
1151 for (i = 0; i < stack->len; i++)
1152 freeFunc(stack->vector[i]);
1155 /* -----------------------------------------------------------------------------
1156 * Tcl Parser
1157 * ---------------------------------------------------------------------------*/
1159 /* Token types */
1160 #define JIM_TT_NONE 0 /* No token returned */
1161 #define JIM_TT_STR 1 /* simple string */
1162 #define JIM_TT_ESC 2 /* string that needs escape chars conversion */
1163 #define JIM_TT_VAR 3 /* var substitution */
1164 #define JIM_TT_DICTSUGAR 4 /* Syntax sugar for [dict get], $foo(bar) */
1165 #define JIM_TT_CMD 5 /* command substitution */
1166 /* Note: Keep these three together for TOKEN_IS_SEP() */
1167 #define JIM_TT_SEP 6 /* word separator (white space) */
1168 #define JIM_TT_EOL 7 /* line separator */
1169 #define JIM_TT_EOF 8 /* end of script */
1171 #define JIM_TT_LINE 9 /* special 'start-of-line' token. arg is # of arguments to the command. -ve if {*} */
1172 #define JIM_TT_WORD 10 /* special 'start-of-word' token. arg is # of tokens to combine. -ve if {*} */
1174 /* Additional token types needed for expressions */
1175 #define JIM_TT_SUBEXPR_START 11
1176 #define JIM_TT_SUBEXPR_END 12
1177 #define JIM_TT_SUBEXPR_COMMA 13
1178 #define JIM_TT_EXPR_INT 14
1179 #define JIM_TT_EXPR_DOUBLE 15
1180 #define JIM_TT_EXPR_BOOLEAN 16
1182 #define JIM_TT_EXPRSUGAR 17 /* $(expression) */
1184 /* Operator token types start here */
1185 #define JIM_TT_EXPR_OP 20
1187 #define TOKEN_IS_SEP(type) (type >= JIM_TT_SEP && type <= JIM_TT_EOF)
1188 /* Can this token start an expression? */
1189 #define TOKEN_IS_EXPR_START(type) (type == JIM_TT_NONE || type == JIM_TT_SUBEXPR_START || type == JIM_TT_SUBEXPR_COMMA)
1190 /* Is this token an expression operator? */
1191 #define TOKEN_IS_EXPR_OP(type) (type >= JIM_TT_EXPR_OP)
1194 * Results of missing quotes, braces, etc. from parsing.
1196 struct JimParseMissing {
1197 int ch; /* At end of parse, ' ' if complete or '{', '[', '"', '\\', '}' if incomplete */
1198 int line; /* Line number starting the missing token */
1201 /* Parser context structure. The same context is used to parse
1202 * Tcl scripts, expressions and lists. */
1203 struct JimParserCtx
1205 const char *p; /* Pointer to the point of the program we are parsing */
1206 int len; /* Remaining length */
1207 int linenr; /* Current line number */
1208 const char *tstart;
1209 const char *tend; /* Returned token is at tstart-tend in 'prg'. */
1210 int tline; /* Line number of the returned token */
1211 int tt; /* Token type */
1212 int eof; /* Non zero if EOF condition is true. */
1213 int inquote; /* Parsing a quoted string */
1214 int comment; /* Non zero if the next chars may be a comment. */
1215 struct JimParseMissing missing; /* Details of any missing quotes, etc. */
1218 static int JimParseScript(struct JimParserCtx *pc);
1219 static int JimParseSep(struct JimParserCtx *pc);
1220 static int JimParseEol(struct JimParserCtx *pc);
1221 static int JimParseCmd(struct JimParserCtx *pc);
1222 static int JimParseQuote(struct JimParserCtx *pc);
1223 static int JimParseVar(struct JimParserCtx *pc);
1224 static int JimParseBrace(struct JimParserCtx *pc);
1225 static int JimParseStr(struct JimParserCtx *pc);
1226 static int JimParseComment(struct JimParserCtx *pc);
1227 static void JimParseSubCmd(struct JimParserCtx *pc);
1228 static int JimParseSubQuote(struct JimParserCtx *pc);
1229 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc);
1231 /* Initialize a parser context.
1232 * 'prg' is a pointer to the program text, linenr is the line
1233 * number of the first line contained in the program. */
1234 static void JimParserInit(struct JimParserCtx *pc, const char *prg, int len, int linenr)
1236 pc->p = prg;
1237 pc->len = len;
1238 pc->tstart = NULL;
1239 pc->tend = NULL;
1240 pc->tline = 0;
1241 pc->tt = JIM_TT_NONE;
1242 pc->eof = 0;
1243 pc->inquote = 0;
1244 pc->linenr = linenr;
1245 pc->comment = 1;
1246 pc->missing.ch = ' ';
1247 pc->missing.line = linenr;
1250 static int JimParseScript(struct JimParserCtx *pc)
1252 while (1) { /* the while is used to reiterate with continue if needed */
1253 if (!pc->len) {
1254 pc->tstart = pc->p;
1255 pc->tend = pc->p - 1;
1256 pc->tline = pc->linenr;
1257 pc->tt = JIM_TT_EOL;
1258 pc->eof = 1;
1259 return JIM_OK;
1261 switch (*(pc->p)) {
1262 case '\\':
1263 if (*(pc->p + 1) == '\n' && !pc->inquote) {
1264 return JimParseSep(pc);
1266 pc->comment = 0;
1267 return JimParseStr(pc);
1268 case ' ':
1269 case '\t':
1270 case '\r':
1271 case '\f':
1272 if (!pc->inquote)
1273 return JimParseSep(pc);
1274 pc->comment = 0;
1275 return JimParseStr(pc);
1276 case '\n':
1277 case ';':
1278 pc->comment = 1;
1279 if (!pc->inquote)
1280 return JimParseEol(pc);
1281 return JimParseStr(pc);
1282 case '[':
1283 pc->comment = 0;
1284 return JimParseCmd(pc);
1285 case '$':
1286 pc->comment = 0;
1287 if (JimParseVar(pc) == JIM_ERR) {
1288 /* An orphan $. Create as a separate token */
1289 pc->tstart = pc->tend = pc->p++;
1290 pc->len--;
1291 pc->tt = JIM_TT_ESC;
1293 return JIM_OK;
1294 case '#':
1295 if (pc->comment) {
1296 JimParseComment(pc);
1297 continue;
1299 return JimParseStr(pc);
1300 default:
1301 pc->comment = 0;
1302 return JimParseStr(pc);
1304 return JIM_OK;
1308 static int JimParseSep(struct JimParserCtx *pc)
1310 pc->tstart = pc->p;
1311 pc->tline = pc->linenr;
1312 while (isspace(UCHAR(*pc->p)) || (*pc->p == '\\' && *(pc->p + 1) == '\n')) {
1313 if (*pc->p == '\n') {
1314 break;
1316 if (*pc->p == '\\') {
1317 pc->p++;
1318 pc->len--;
1319 pc->linenr++;
1321 pc->p++;
1322 pc->len--;
1324 pc->tend = pc->p - 1;
1325 pc->tt = JIM_TT_SEP;
1326 return JIM_OK;
1329 static int JimParseEol(struct JimParserCtx *pc)
1331 pc->tstart = pc->p;
1332 pc->tline = pc->linenr;
1333 while (isspace(UCHAR(*pc->p)) || *pc->p == ';') {
1334 if (*pc->p == '\n')
1335 pc->linenr++;
1336 pc->p++;
1337 pc->len--;
1339 pc->tend = pc->p - 1;
1340 pc->tt = JIM_TT_EOL;
1341 return JIM_OK;
1345 ** Here are the rules for parsing:
1346 ** {braced expression}
1347 ** - Count open and closing braces
1348 ** - Backslash escapes meaning of braces but doesn't remove the backslash
1350 ** "quoted expression"
1351 ** - Unescaped double quote terminates the expression
1352 ** - Backslash escapes next char
1353 ** - [commands brackets] are counted/nested
1354 ** - command rules apply within [brackets], not quoting rules (i.e. brackets have their own rules)
1356 ** [command expression]
1357 ** - Count open and closing brackets
1358 ** - Backslash escapes next char
1359 ** - [commands brackets] are counted/nested
1360 ** - "quoted expressions" are parsed according to quoting rules
1361 ** - {braced expressions} are parsed according to brace rules
1363 ** For everything, backslash escapes the next char, newline increments current line
1367 * Parses a braced expression starting at pc->p.
1369 * Positions the parser at the end of the braced expression,
1370 * sets pc->tend and possibly pc->missing.
1372 static void JimParseSubBrace(struct JimParserCtx *pc)
1374 int level = 1;
1376 /* Skip the brace */
1377 pc->p++;
1378 pc->len--;
1379 while (pc->len) {
1380 switch (*pc->p) {
1381 case '\\':
1382 if (pc->len > 1) {
1383 if (*++pc->p == '\n') {
1384 pc->linenr++;
1386 pc->len--;
1388 break;
1390 case '{':
1391 level++;
1392 break;
1394 case '}':
1395 if (--level == 0) {
1396 pc->tend = pc->p - 1;
1397 pc->p++;
1398 pc->len--;
1399 return;
1401 break;
1403 case '\n':
1404 pc->linenr++;
1405 break;
1407 pc->p++;
1408 pc->len--;
1410 pc->missing.ch = '{';
1411 pc->missing.line = pc->tline;
1412 pc->tend = pc->p - 1;
1416 * Parses a quoted expression starting at pc->p.
1418 * Positions the parser at the end of the quoted expression,
1419 * sets pc->tend and possibly pc->missing.
1421 * Returns the type of the token of the string,
1422 * either JIM_TT_ESC (if it contains values which need to be [subst]ed)
1423 * or JIM_TT_STR.
1425 static int JimParseSubQuote(struct JimParserCtx *pc)
1427 int tt = JIM_TT_STR;
1428 int line = pc->tline;
1430 /* Skip the quote */
1431 pc->p++;
1432 pc->len--;
1433 while (pc->len) {
1434 switch (*pc->p) {
1435 case '\\':
1436 if (pc->len > 1) {
1437 if (*++pc->p == '\n') {
1438 pc->linenr++;
1440 pc->len--;
1441 tt = JIM_TT_ESC;
1443 break;
1445 case '"':
1446 pc->tend = pc->p - 1;
1447 pc->p++;
1448 pc->len--;
1449 return tt;
1451 case '[':
1452 JimParseSubCmd(pc);
1453 tt = JIM_TT_ESC;
1454 continue;
1456 case '\n':
1457 pc->linenr++;
1458 break;
1460 case '$':
1461 tt = JIM_TT_ESC;
1462 break;
1464 pc->p++;
1465 pc->len--;
1467 pc->missing.ch = '"';
1468 pc->missing.line = line;
1469 pc->tend = pc->p - 1;
1470 return tt;
1474 * Parses a [command] expression starting at pc->p.
1476 * Positions the parser at the end of the command expression,
1477 * sets pc->tend and possibly pc->missing.
1479 static void JimParseSubCmd(struct JimParserCtx *pc)
1481 int level = 1;
1482 int startofword = 1;
1483 int line = pc->tline;
1485 /* Skip the bracket */
1486 pc->p++;
1487 pc->len--;
1488 while (pc->len) {
1489 switch (*pc->p) {
1490 case '\\':
1491 if (pc->len > 1) {
1492 if (*++pc->p == '\n') {
1493 pc->linenr++;
1495 pc->len--;
1497 break;
1499 case '[':
1500 level++;
1501 break;
1503 case ']':
1504 if (--level == 0) {
1505 pc->tend = pc->p - 1;
1506 pc->p++;
1507 pc->len--;
1508 return;
1510 break;
1512 case '"':
1513 if (startofword) {
1514 JimParseSubQuote(pc);
1515 continue;
1517 break;
1519 case '{':
1520 JimParseSubBrace(pc);
1521 startofword = 0;
1522 continue;
1524 case '\n':
1525 pc->linenr++;
1526 break;
1528 startofword = isspace(UCHAR(*pc->p));
1529 pc->p++;
1530 pc->len--;
1532 pc->missing.ch = '[';
1533 pc->missing.line = line;
1534 pc->tend = pc->p - 1;
1537 static int JimParseBrace(struct JimParserCtx *pc)
1539 pc->tstart = pc->p + 1;
1540 pc->tline = pc->linenr;
1541 pc->tt = JIM_TT_STR;
1542 JimParseSubBrace(pc);
1543 return JIM_OK;
1546 static int JimParseCmd(struct JimParserCtx *pc)
1548 pc->tstart = pc->p + 1;
1549 pc->tline = pc->linenr;
1550 pc->tt = JIM_TT_CMD;
1551 JimParseSubCmd(pc);
1552 return JIM_OK;
1555 static int JimParseQuote(struct JimParserCtx *pc)
1557 pc->tstart = pc->p + 1;
1558 pc->tline = pc->linenr;
1559 pc->tt = JimParseSubQuote(pc);
1560 return JIM_OK;
1563 static int JimParseVar(struct JimParserCtx *pc)
1565 /* skip the $ */
1566 pc->p++;
1567 pc->len--;
1569 #ifdef EXPRSUGAR_BRACKET
1570 if (*pc->p == '[') {
1571 /* Parse $[...] expr shorthand syntax */
1572 JimParseCmd(pc);
1573 pc->tt = JIM_TT_EXPRSUGAR;
1574 return JIM_OK;
1576 #endif
1578 pc->tstart = pc->p;
1579 pc->tt = JIM_TT_VAR;
1580 pc->tline = pc->linenr;
1582 if (*pc->p == '{') {
1583 pc->tstart = ++pc->p;
1584 pc->len--;
1586 while (pc->len && *pc->p != '}') {
1587 if (*pc->p == '\n') {
1588 pc->linenr++;
1590 pc->p++;
1591 pc->len--;
1593 pc->tend = pc->p - 1;
1594 if (pc->len) {
1595 pc->p++;
1596 pc->len--;
1599 else {
1600 while (1) {
1601 /* Skip double colon, but not single colon! */
1602 if (pc->p[0] == ':' && pc->p[1] == ':') {
1603 while (*pc->p == ':') {
1604 pc->p++;
1605 pc->len--;
1607 continue;
1609 /* Note that any char >= 0x80 must be part of a utf-8 char.
1610 * We consider all unicode points outside of ASCII as letters
1612 if (isalnum(UCHAR(*pc->p)) || *pc->p == '_' || UCHAR(*pc->p) >= 0x80) {
1613 pc->p++;
1614 pc->len--;
1615 continue;
1617 break;
1619 /* Parse [dict get] syntax sugar. */
1620 if (*pc->p == '(') {
1621 int count = 1;
1622 const char *paren = NULL;
1624 pc->tt = JIM_TT_DICTSUGAR;
1626 while (count && pc->len) {
1627 pc->p++;
1628 pc->len--;
1629 if (*pc->p == '\\' && pc->len >= 1) {
1630 pc->p++;
1631 pc->len--;
1633 else if (*pc->p == '(') {
1634 count++;
1636 else if (*pc->p == ')') {
1637 paren = pc->p;
1638 count--;
1641 if (count == 0) {
1642 pc->p++;
1643 pc->len--;
1645 else if (paren) {
1646 /* Did not find a matching paren. Back up */
1647 paren++;
1648 pc->len += (pc->p - paren);
1649 pc->p = paren;
1651 #ifndef EXPRSUGAR_BRACKET
1652 if (*pc->tstart == '(') {
1653 pc->tt = JIM_TT_EXPRSUGAR;
1655 #endif
1657 pc->tend = pc->p - 1;
1659 /* Check if we parsed just the '$' character.
1660 * That's not a variable so an error is returned
1661 * to tell the state machine to consider this '$' just
1662 * a string. */
1663 if (pc->tstart == pc->p) {
1664 pc->p--;
1665 pc->len++;
1666 return JIM_ERR;
1668 return JIM_OK;
1671 static int JimParseStr(struct JimParserCtx *pc)
1673 if (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1674 pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR) {
1675 /* Starting a new word */
1676 if (*pc->p == '{') {
1677 return JimParseBrace(pc);
1679 if (*pc->p == '"') {
1680 pc->inquote = 1;
1681 pc->p++;
1682 pc->len--;
1683 /* In case the end quote is missing */
1684 pc->missing.line = pc->tline;
1687 pc->tstart = pc->p;
1688 pc->tline = pc->linenr;
1689 while (1) {
1690 if (pc->len == 0) {
1691 if (pc->inquote) {
1692 pc->missing.ch = '"';
1694 pc->tend = pc->p - 1;
1695 pc->tt = JIM_TT_ESC;
1696 return JIM_OK;
1698 switch (*pc->p) {
1699 case '\\':
1700 if (!pc->inquote && *(pc->p + 1) == '\n') {
1701 pc->tend = pc->p - 1;
1702 pc->tt = JIM_TT_ESC;
1703 return JIM_OK;
1705 if (pc->len >= 2) {
1706 if (*(pc->p + 1) == '\n') {
1707 pc->linenr++;
1709 pc->p++;
1710 pc->len--;
1712 else if (pc->len == 1) {
1713 /* End of script with trailing backslash */
1714 pc->missing.ch = '\\';
1716 break;
1717 case '(':
1718 /* If the following token is not '$' just keep going */
1719 if (pc->len > 1 && pc->p[1] != '$') {
1720 break;
1722 /* fall through */
1723 case ')':
1724 /* Only need a separate ')' token if the previous was a var */
1725 if (*pc->p == '(' || pc->tt == JIM_TT_VAR) {
1726 if (pc->p == pc->tstart) {
1727 /* At the start of the token, so just return this char */
1728 pc->p++;
1729 pc->len--;
1731 pc->tend = pc->p - 1;
1732 pc->tt = JIM_TT_ESC;
1733 return JIM_OK;
1735 break;
1737 case '$':
1738 case '[':
1739 pc->tend = pc->p - 1;
1740 pc->tt = JIM_TT_ESC;
1741 return JIM_OK;
1742 case ' ':
1743 case '\t':
1744 case '\n':
1745 case '\r':
1746 case '\f':
1747 case ';':
1748 if (!pc->inquote) {
1749 pc->tend = pc->p - 1;
1750 pc->tt = JIM_TT_ESC;
1751 return JIM_OK;
1753 else if (*pc->p == '\n') {
1754 pc->linenr++;
1756 break;
1757 case '"':
1758 if (pc->inquote) {
1759 pc->tend = pc->p - 1;
1760 pc->tt = JIM_TT_ESC;
1761 pc->p++;
1762 pc->len--;
1763 pc->inquote = 0;
1764 return JIM_OK;
1766 break;
1768 pc->p++;
1769 pc->len--;
1771 return JIM_OK; /* unreached */
1774 static int JimParseComment(struct JimParserCtx *pc)
1776 while (*pc->p) {
1777 if (*pc->p == '\\') {
1778 pc->p++;
1779 pc->len--;
1780 if (pc->len == 0) {
1781 pc->missing.ch = '\\';
1782 return JIM_OK;
1784 if (*pc->p == '\n') {
1785 pc->linenr++;
1788 else if (*pc->p == '\n') {
1789 pc->p++;
1790 pc->len--;
1791 pc->linenr++;
1792 break;
1794 pc->p++;
1795 pc->len--;
1797 return JIM_OK;
1800 /* xdigitval and odigitval are helper functions for JimEscape() */
1801 static int xdigitval(int c)
1803 if (c >= '0' && c <= '9')
1804 return c - '0';
1805 if (c >= 'a' && c <= 'f')
1806 return c - 'a' + 10;
1807 if (c >= 'A' && c <= 'F')
1808 return c - 'A' + 10;
1809 return -1;
1812 static int odigitval(int c)
1814 if (c >= '0' && c <= '7')
1815 return c - '0';
1816 return -1;
1819 /* Perform Tcl escape substitution of 's', storing the result
1820 * string into 'dest'. The escaped string is guaranteed to
1821 * be the same length or shorter than the source string.
1822 * slen is the length of the string at 's'.
1824 * The function returns the length of the resulting string. */
1825 static int JimEscape(char *dest, const char *s, int slen)
1827 char *p = dest;
1828 int i, len;
1830 for (i = 0; i < slen; i++) {
1831 switch (s[i]) {
1832 case '\\':
1833 switch (s[i + 1]) {
1834 case 'a':
1835 *p++ = 0x7;
1836 i++;
1837 break;
1838 case 'b':
1839 *p++ = 0x8;
1840 i++;
1841 break;
1842 case 'f':
1843 *p++ = 0xc;
1844 i++;
1845 break;
1846 case 'n':
1847 *p++ = 0xa;
1848 i++;
1849 break;
1850 case 'r':
1851 *p++ = 0xd;
1852 i++;
1853 break;
1854 case 't':
1855 *p++ = 0x9;
1856 i++;
1857 break;
1858 case 'u':
1859 case 'U':
1860 case 'x':
1861 /* A unicode or hex sequence.
1862 * \x Expect 1-2 hex chars and convert to hex.
1863 * \u Expect 1-4 hex chars and convert to utf-8.
1864 * \U Expect 1-8 hex chars and convert to utf-8.
1865 * \u{NNN} supports 1-6 hex chars and convert to utf-8.
1866 * An invalid sequence means simply the escaped char.
1869 unsigned val = 0;
1870 int k;
1871 int maxchars = 2;
1873 i++;
1875 if (s[i] == 'U') {
1876 maxchars = 8;
1878 else if (s[i] == 'u') {
1879 if (s[i + 1] == '{') {
1880 maxchars = 6;
1881 i++;
1883 else {
1884 maxchars = 4;
1888 for (k = 0; k < maxchars; k++) {
1889 int c = xdigitval(s[i + k + 1]);
1890 if (c == -1) {
1891 break;
1893 val = (val << 4) | c;
1895 /* The \u{nnn} syntax supports up to 21 bit codepoints. */
1896 if (s[i] == '{') {
1897 if (k == 0 || val > 0x1fffff || s[i + k + 1] != '}') {
1898 /* Back up */
1899 i--;
1900 k = 0;
1902 else {
1903 /* Skip the closing brace */
1904 k++;
1907 if (k) {
1908 /* Got a valid sequence, so convert */
1909 if (s[i] == 'x') {
1910 *p++ = val;
1912 else {
1913 p += utf8_fromunicode(p, val);
1915 i += k;
1916 break;
1918 /* Not a valid codepoint, just an escaped char */
1919 *p++ = s[i];
1921 break;
1922 case 'v':
1923 *p++ = 0xb;
1924 i++;
1925 break;
1926 case '\0':
1927 *p++ = '\\';
1928 i++;
1929 break;
1930 case '\n':
1931 /* Replace all spaces and tabs after backslash newline with a single space*/
1932 *p++ = ' ';
1933 do {
1934 i++;
1935 } while (s[i + 1] == ' ' || s[i + 1] == '\t');
1936 break;
1937 case '0':
1938 case '1':
1939 case '2':
1940 case '3':
1941 case '4':
1942 case '5':
1943 case '6':
1944 case '7':
1945 /* octal escape */
1947 int val = 0;
1948 int c = odigitval(s[i + 1]);
1950 val = c;
1951 c = odigitval(s[i + 2]);
1952 if (c == -1) {
1953 *p++ = val;
1954 i++;
1955 break;
1957 val = (val * 8) + c;
1958 c = odigitval(s[i + 3]);
1959 if (c == -1) {
1960 *p++ = val;
1961 i += 2;
1962 break;
1964 val = (val * 8) + c;
1965 *p++ = val;
1966 i += 3;
1968 break;
1969 default:
1970 *p++ = s[i + 1];
1971 i++;
1972 break;
1974 break;
1975 default:
1976 *p++ = s[i];
1977 break;
1980 len = p - dest;
1981 *p = '\0';
1982 return len;
1985 /* Returns a dynamically allocated copy of the current token in the
1986 * parser context. The function performs conversion of escapes if
1987 * the token is of type JIM_TT_ESC.
1989 * Note that after the conversion, tokens that are grouped with
1990 * braces in the source code, are always recognizable from the
1991 * identical string obtained in a different way from the type.
1993 * For example the string:
1995 * {*}$a
1997 * will return as first token "*", of type JIM_TT_STR
1999 * While the string:
2001 * *$a
2003 * will return as first token "*", of type JIM_TT_ESC
2005 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc)
2007 const char *start, *end;
2008 char *token;
2009 int len;
2011 start = pc->tstart;
2012 end = pc->tend;
2013 len = (end - start) + 1;
2014 if (len < 0) {
2015 len = 0;
2017 token = Jim_Alloc(len + 1);
2018 if (pc->tt != JIM_TT_ESC) {
2019 /* No escape conversion needed? Just copy it. */
2020 memcpy(token, start, len);
2021 token[len] = '\0';
2023 else {
2024 /* Else convert the escape chars. */
2025 len = JimEscape(token, start, len);
2028 return Jim_NewStringObjNoAlloc(interp, token, len);
2031 /* -----------------------------------------------------------------------------
2032 * Tcl Lists parsing
2033 * ---------------------------------------------------------------------------*/
2034 static int JimParseListSep(struct JimParserCtx *pc);
2035 static int JimParseListStr(struct JimParserCtx *pc);
2036 static int JimParseListQuote(struct JimParserCtx *pc);
2038 static int JimParseList(struct JimParserCtx *pc)
2040 if (isspace(UCHAR(*pc->p))) {
2041 return JimParseListSep(pc);
2043 switch (*pc->p) {
2044 case '"':
2045 return JimParseListQuote(pc);
2047 case '{':
2048 return JimParseBrace(pc);
2050 default:
2051 if (pc->len) {
2052 return JimParseListStr(pc);
2054 break;
2057 pc->tstart = pc->tend = pc->p;
2058 pc->tline = pc->linenr;
2059 pc->tt = JIM_TT_EOL;
2060 pc->eof = 1;
2061 return JIM_OK;
2064 static int JimParseListSep(struct JimParserCtx *pc)
2066 pc->tstart = pc->p;
2067 pc->tline = pc->linenr;
2068 while (isspace(UCHAR(*pc->p))) {
2069 if (*pc->p == '\n') {
2070 pc->linenr++;
2072 pc->p++;
2073 pc->len--;
2075 pc->tend = pc->p - 1;
2076 pc->tt = JIM_TT_SEP;
2077 return JIM_OK;
2080 static int JimParseListQuote(struct JimParserCtx *pc)
2082 pc->p++;
2083 pc->len--;
2085 pc->tstart = pc->p;
2086 pc->tline = pc->linenr;
2087 pc->tt = JIM_TT_STR;
2089 while (pc->len) {
2090 switch (*pc->p) {
2091 case '\\':
2092 pc->tt = JIM_TT_ESC;
2093 if (--pc->len == 0) {
2094 /* Trailing backslash */
2095 pc->tend = pc->p;
2096 return JIM_OK;
2098 pc->p++;
2099 break;
2100 case '\n':
2101 pc->linenr++;
2102 break;
2103 case '"':
2104 pc->tend = pc->p - 1;
2105 pc->p++;
2106 pc->len--;
2107 return JIM_OK;
2109 pc->p++;
2110 pc->len--;
2113 pc->tend = pc->p - 1;
2114 return JIM_OK;
2117 static int JimParseListStr(struct JimParserCtx *pc)
2119 pc->tstart = pc->p;
2120 pc->tline = pc->linenr;
2121 pc->tt = JIM_TT_STR;
2123 while (pc->len) {
2124 if (isspace(UCHAR(*pc->p))) {
2125 pc->tend = pc->p - 1;
2126 return JIM_OK;
2128 if (*pc->p == '\\') {
2129 if (--pc->len == 0) {
2130 /* Trailing backslash */
2131 pc->tend = pc->p;
2132 return JIM_OK;
2134 pc->tt = JIM_TT_ESC;
2135 pc->p++;
2137 pc->p++;
2138 pc->len--;
2140 pc->tend = pc->p - 1;
2141 return JIM_OK;
2144 /* -----------------------------------------------------------------------------
2145 * Jim_Obj related functions
2146 * ---------------------------------------------------------------------------*/
2148 /* Return a new initialized object. */
2149 Jim_Obj *Jim_NewObj(Jim_Interp *interp)
2151 Jim_Obj *objPtr;
2153 /* -- Check if there are objects in the free list -- */
2154 if (interp->freeList != NULL) {
2155 /* -- Unlink the object from the free list -- */
2156 objPtr = interp->freeList;
2157 interp->freeList = objPtr->nextObjPtr;
2159 else {
2160 /* -- No ready to use objects: allocate a new one -- */
2161 objPtr = Jim_Alloc(sizeof(*objPtr));
2164 /* Object is returned with refCount of 0. Every
2165 * kind of GC implemented should take care to avoid
2166 * scanning objects with refCount == 0. */
2167 objPtr->refCount = 0;
2168 /* All the other fields are left uninitialized to save time.
2169 * The caller will probably want to set them to the right
2170 * value anyway. */
2172 /* -- Put the object into the live list -- */
2173 objPtr->prevObjPtr = NULL;
2174 objPtr->nextObjPtr = interp->liveList;
2175 if (interp->liveList)
2176 interp->liveList->prevObjPtr = objPtr;
2177 interp->liveList = objPtr;
2179 return objPtr;
2182 /* Free an object. Actually objects are never freed, but
2183 * just moved to the free objects list, where they will be
2184 * reused by Jim_NewObj(). */
2185 void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr)
2187 /* Check if the object was already freed, panic. */
2188 JimPanic((objPtr->refCount != 0, "!!!Object %p freed with bad refcount %d, type=%s", objPtr,
2189 objPtr->refCount, objPtr->typePtr ? objPtr->typePtr->name : "<none>"));
2191 /* Free the internal representation */
2192 Jim_FreeIntRep(interp, objPtr);
2193 /* Free the string representation */
2194 if (objPtr->bytes != NULL) {
2195 if (objPtr->bytes != JimEmptyStringRep)
2196 Jim_Free(objPtr->bytes);
2198 /* Unlink the object from the live objects list */
2199 if (objPtr->prevObjPtr)
2200 objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr;
2201 if (objPtr->nextObjPtr)
2202 objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr;
2203 if (interp->liveList == objPtr)
2204 interp->liveList = objPtr->nextObjPtr;
2205 #ifdef JIM_DISABLE_OBJECT_POOL
2206 Jim_Free(objPtr);
2207 #else
2208 /* Link the object into the free objects list */
2209 objPtr->prevObjPtr = NULL;
2210 objPtr->nextObjPtr = interp->freeList;
2211 if (interp->freeList)
2212 interp->freeList->prevObjPtr = objPtr;
2213 interp->freeList = objPtr;
2214 objPtr->refCount = -1;
2215 #endif
2218 /* Invalidate the string representation of an object. */
2219 void Jim_InvalidateStringRep(Jim_Obj *objPtr)
2221 if (objPtr->bytes != NULL) {
2222 if (objPtr->bytes != JimEmptyStringRep)
2223 Jim_Free(objPtr->bytes);
2225 objPtr->bytes = NULL;
2228 /* Duplicate an object. The returned object has refcount = 0. */
2229 Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
2231 Jim_Obj *dupPtr;
2233 dupPtr = Jim_NewObj(interp);
2234 if (objPtr->bytes == NULL) {
2235 /* Object does not have a valid string representation. */
2236 dupPtr->bytes = NULL;
2238 else if (objPtr->length == 0) {
2239 /* Zero length, so don't even bother with the type-specific dup,
2240 * since all zero length objects look the same
2242 dupPtr->bytes = JimEmptyStringRep;
2243 dupPtr->length = 0;
2244 dupPtr->typePtr = NULL;
2245 return dupPtr;
2247 else {
2248 dupPtr->bytes = Jim_Alloc(objPtr->length + 1);
2249 dupPtr->length = objPtr->length;
2250 /* Copy the null byte too */
2251 memcpy(dupPtr->bytes, objPtr->bytes, objPtr->length + 1);
2254 /* By default, the new object has the same type as the old object */
2255 dupPtr->typePtr = objPtr->typePtr;
2256 if (objPtr->typePtr != NULL) {
2257 if (objPtr->typePtr->dupIntRepProc == NULL) {
2258 dupPtr->internalRep = objPtr->internalRep;
2260 else {
2261 /* The dup proc may set a different type, e.g. NULL */
2262 objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr);
2265 return dupPtr;
2268 /* Return the string representation for objPtr. If the object's
2269 * string representation is invalid, calls the updateStringProc method to create
2270 * a new one from the internal representation of the object.
2272 const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr)
2274 if (objPtr->bytes == NULL) {
2275 /* Invalid string repr. Generate it. */
2276 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2277 objPtr->typePtr->updateStringProc(objPtr);
2279 if (lenPtr)
2280 *lenPtr = objPtr->length;
2281 return objPtr->bytes;
2284 /* Just returns the length (in bytes) of the object's string rep */
2285 int Jim_Length(Jim_Obj *objPtr)
2287 if (objPtr->bytes == NULL) {
2288 /* Invalid string repr. Generate it. */
2289 Jim_GetString(objPtr, NULL);
2291 return objPtr->length;
2294 /* Just returns object's string rep */
2295 const char *Jim_String(Jim_Obj *objPtr)
2297 if (objPtr->bytes == NULL) {
2298 /* Invalid string repr. Generate it. */
2299 Jim_GetString(objPtr, NULL);
2301 return objPtr->bytes;
2304 static void JimSetStringBytes(Jim_Obj *objPtr, const char *str)
2306 objPtr->bytes = Jim_StrDup(str);
2307 objPtr->length = strlen(str);
2310 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2311 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2313 static const Jim_ObjType dictSubstObjType = {
2314 "dict-substitution",
2315 FreeDictSubstInternalRep,
2316 DupDictSubstInternalRep,
2317 NULL,
2318 JIM_TYPE_NONE,
2321 static void FreeInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2322 static void DupInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2324 static const Jim_ObjType interpolatedObjType = {
2325 "interpolated",
2326 FreeInterpolatedInternalRep,
2327 DupInterpolatedInternalRep,
2328 NULL,
2329 JIM_TYPE_NONE,
2332 static void FreeInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2334 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
2337 static void DupInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2339 /* Copy the interal rep */
2340 dupPtr->internalRep = srcPtr->internalRep;
2341 /* Need to increment the key ref count */
2342 Jim_IncrRefCount(dupPtr->internalRep.dictSubstValue.indexObjPtr);
2345 /* -----------------------------------------------------------------------------
2346 * String Object
2347 * ---------------------------------------------------------------------------*/
2348 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2349 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2351 static const Jim_ObjType stringObjType = {
2352 "string",
2353 NULL,
2354 DupStringInternalRep,
2355 NULL,
2356 JIM_TYPE_REFERENCES,
2359 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2361 JIM_NOTUSED(interp);
2363 /* This is a bit subtle: the only caller of this function
2364 * should be Jim_DuplicateObj(), that will copy the
2365 * string representaion. After the copy, the duplicated
2366 * object will not have more room in the buffer than
2367 * srcPtr->length bytes. So we just set it to length. */
2368 dupPtr->internalRep.strValue.maxLength = srcPtr->length;
2369 dupPtr->internalRep.strValue.charLength = srcPtr->internalRep.strValue.charLength;
2372 static int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
2374 if (objPtr->typePtr != &stringObjType) {
2375 /* Get a fresh string representation. */
2376 if (objPtr->bytes == NULL) {
2377 /* Invalid string repr. Generate it. */
2378 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2379 objPtr->typePtr->updateStringProc(objPtr);
2381 /* Free any other internal representation. */
2382 Jim_FreeIntRep(interp, objPtr);
2383 /* Set it as string, i.e. just set the maxLength field. */
2384 objPtr->typePtr = &stringObjType;
2385 objPtr->internalRep.strValue.maxLength = objPtr->length;
2386 /* Don't know the utf-8 length yet */
2387 objPtr->internalRep.strValue.charLength = -1;
2389 return JIM_OK;
2393 * Returns the length of the object string in chars, not bytes.
2395 * These may be different for a utf-8 string.
2397 int Jim_Utf8Length(Jim_Interp *interp, Jim_Obj *objPtr)
2399 #ifdef JIM_UTF8
2400 SetStringFromAny(interp, objPtr);
2402 if (objPtr->internalRep.strValue.charLength < 0) {
2403 objPtr->internalRep.strValue.charLength = utf8_strlen(objPtr->bytes, objPtr->length);
2405 return objPtr->internalRep.strValue.charLength;
2406 #else
2407 return Jim_Length(objPtr);
2408 #endif
2411 /* len is in bytes -- see also Jim_NewStringObjUtf8() */
2412 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
2414 Jim_Obj *objPtr = Jim_NewObj(interp);
2416 /* Need to find out how many bytes the string requires */
2417 if (len == -1)
2418 len = strlen(s);
2419 /* Alloc/Set the string rep. */
2420 if (len == 0) {
2421 objPtr->bytes = JimEmptyStringRep;
2423 else {
2424 objPtr->bytes = Jim_StrDupLen(s, len);
2426 objPtr->length = len;
2428 /* No typePtr field for the vanilla string object. */
2429 objPtr->typePtr = NULL;
2430 return objPtr;
2433 /* charlen is in characters -- see also Jim_NewStringObj() */
2434 Jim_Obj *Jim_NewStringObjUtf8(Jim_Interp *interp, const char *s, int charlen)
2436 #ifdef JIM_UTF8
2437 /* Need to find out how many bytes the string requires */
2438 int bytelen = utf8_index(s, charlen);
2440 Jim_Obj *objPtr = Jim_NewStringObj(interp, s, bytelen);
2442 /* Remember the utf8 length, so set the type */
2443 objPtr->typePtr = &stringObjType;
2444 objPtr->internalRep.strValue.maxLength = bytelen;
2445 objPtr->internalRep.strValue.charLength = charlen;
2447 return objPtr;
2448 #else
2449 return Jim_NewStringObj(interp, s, charlen);
2450 #endif
2453 /* This version does not try to duplicate the 's' pointer, but
2454 * use it directly. */
2455 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
2457 Jim_Obj *objPtr = Jim_NewObj(interp);
2459 objPtr->bytes = s;
2460 objPtr->length = (len == -1) ? strlen(s) : len;
2461 objPtr->typePtr = NULL;
2462 return objPtr;
2465 /* Low-level string append. Use it only against unshared objects
2466 * of type "string". */
2467 static void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
2469 int needlen;
2471 if (len == -1)
2472 len = strlen(str);
2473 needlen = objPtr->length + len;
2474 if (objPtr->internalRep.strValue.maxLength < needlen ||
2475 objPtr->internalRep.strValue.maxLength == 0) {
2476 needlen *= 2;
2477 /* Inefficient to malloc() for less than 8 bytes */
2478 if (needlen < 7) {
2479 needlen = 7;
2481 if (objPtr->bytes == JimEmptyStringRep) {
2482 objPtr->bytes = Jim_Alloc(needlen + 1);
2484 else {
2485 objPtr->bytes = Jim_Realloc(objPtr->bytes, needlen + 1);
2487 objPtr->internalRep.strValue.maxLength = needlen;
2489 memcpy(objPtr->bytes + objPtr->length, str, len);
2490 objPtr->bytes[objPtr->length + len] = '\0';
2492 if (objPtr->internalRep.strValue.charLength >= 0) {
2493 /* Update the utf-8 char length */
2494 objPtr->internalRep.strValue.charLength += utf8_strlen(objPtr->bytes + objPtr->length, len);
2496 objPtr->length += len;
2499 /* Higher level API to append strings to objects.
2500 * Object must not be unshared for each of these.
2502 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str, int len)
2504 JimPanic((Jim_IsShared(objPtr), "Jim_AppendString called with shared object"));
2505 SetStringFromAny(interp, objPtr);
2506 StringAppendString(objPtr, str, len);
2509 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *appendObjPtr)
2511 int len;
2512 const char *str = Jim_GetString(appendObjPtr, &len);
2513 Jim_AppendString(interp, objPtr, str, len);
2516 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2518 va_list ap;
2520 SetStringFromAny(interp, objPtr);
2521 va_start(ap, objPtr);
2522 while (1) {
2523 const char *s = va_arg(ap, const char *);
2525 if (s == NULL)
2526 break;
2527 Jim_AppendString(interp, objPtr, s, -1);
2529 va_end(ap);
2532 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr)
2534 if (aObjPtr == bObjPtr) {
2535 return 1;
2537 else {
2538 int Alen, Blen;
2539 const char *sA = Jim_GetString(aObjPtr, &Alen);
2540 const char *sB = Jim_GetString(bObjPtr, &Blen);
2542 return Alen == Blen && memcmp(sA, sB, Alen) == 0;
2547 * Note. Does not support embedded nulls in either the pattern or the object.
2549 int Jim_StringMatchObj(Jim_Interp *interp, Jim_Obj *patternObjPtr, Jim_Obj *objPtr, int nocase)
2551 return JimGlobMatch(Jim_String(patternObjPtr), Jim_String(objPtr), nocase);
2555 * Note: does not support embedded nulls for the nocase option.
2557 int Jim_StringCompareObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2559 int l1, l2;
2560 const char *s1 = Jim_GetString(firstObjPtr, &l1);
2561 const char *s2 = Jim_GetString(secondObjPtr, &l2);
2563 if (nocase) {
2564 /* Do a character compare for nocase */
2565 return JimStringCompareLen(s1, s2, -1, nocase);
2567 return JimStringCompare(s1, l1, s2, l2);
2571 * Like Jim_StringCompareObj() except compares to a maximum of the length of firstObjPtr.
2573 * Note: does not support embedded nulls
2575 int Jim_StringCompareLenObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2577 const char *s1 = Jim_String(firstObjPtr);
2578 const char *s2 = Jim_String(secondObjPtr);
2580 return JimStringCompareLen(s1, s2, Jim_Utf8Length(interp, firstObjPtr), nocase);
2583 /* Convert a range, as returned by Jim_GetRange(), into
2584 * an absolute index into an object of the specified length.
2585 * This function may return negative values, or values
2586 * greater than or equal to the length of the list if the index
2587 * is out of range. */
2588 static int JimRelToAbsIndex(int len, int idx)
2590 if (idx < 0)
2591 return len + idx;
2592 return idx;
2595 /* Convert a pair of indexes (*firstPtr, *lastPtr) as normalized by JimRelToAbsIndex(),
2596 * into a form suitable for implementation of commands like [string range] and [lrange].
2598 * The resulting range is guaranteed to address valid elements of
2599 * the structure.
2601 static void JimRelToAbsRange(int len, int *firstPtr, int *lastPtr, int *rangeLenPtr)
2603 int rangeLen;
2605 if (*firstPtr > *lastPtr) {
2606 rangeLen = 0;
2608 else {
2609 rangeLen = *lastPtr - *firstPtr + 1;
2610 if (rangeLen) {
2611 if (*firstPtr < 0) {
2612 rangeLen += *firstPtr;
2613 *firstPtr = 0;
2615 if (*lastPtr >= len) {
2616 rangeLen -= (*lastPtr - (len - 1));
2617 *lastPtr = len - 1;
2621 if (rangeLen < 0)
2622 rangeLen = 0;
2624 *rangeLenPtr = rangeLen;
2627 static int JimStringGetRange(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr,
2628 int len, int *first, int *last, int *range)
2630 if (Jim_GetIndex(interp, firstObjPtr, first) != JIM_OK) {
2631 return JIM_ERR;
2633 if (Jim_GetIndex(interp, lastObjPtr, last) != JIM_OK) {
2634 return JIM_ERR;
2636 *first = JimRelToAbsIndex(len, *first);
2637 *last = JimRelToAbsIndex(len, *last);
2638 JimRelToAbsRange(len, first, last, range);
2639 return JIM_OK;
2642 Jim_Obj *Jim_StringByteRangeObj(Jim_Interp *interp,
2643 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2645 int first, last;
2646 const char *str;
2647 int rangeLen;
2648 int bytelen;
2650 str = Jim_GetString(strObjPtr, &bytelen);
2652 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, bytelen, &first, &last, &rangeLen) != JIM_OK) {
2653 return NULL;
2656 if (first == 0 && rangeLen == bytelen) {
2657 return strObjPtr;
2659 return Jim_NewStringObj(interp, str + first, rangeLen);
2662 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2663 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2665 #ifdef JIM_UTF8
2666 int first, last;
2667 const char *str;
2668 int len, rangeLen;
2669 int bytelen;
2671 str = Jim_GetString(strObjPtr, &bytelen);
2672 len = Jim_Utf8Length(interp, strObjPtr);
2674 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2675 return NULL;
2678 if (first == 0 && rangeLen == len) {
2679 return strObjPtr;
2681 if (len == bytelen) {
2682 /* ASCII optimisation */
2683 return Jim_NewStringObj(interp, str + first, rangeLen);
2685 return Jim_NewStringObjUtf8(interp, str + utf8_index(str, first), rangeLen);
2686 #else
2687 return Jim_StringByteRangeObj(interp, strObjPtr, firstObjPtr, lastObjPtr);
2688 #endif
2691 Jim_Obj *JimStringReplaceObj(Jim_Interp *interp,
2692 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr, Jim_Obj *newStrObj)
2694 int first, last;
2695 const char *str;
2696 int len, rangeLen;
2697 Jim_Obj *objPtr;
2699 len = Jim_Utf8Length(interp, strObjPtr);
2701 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2702 return NULL;
2705 if (last < first) {
2706 return strObjPtr;
2709 str = Jim_String(strObjPtr);
2711 /* Before part */
2712 objPtr = Jim_NewStringObjUtf8(interp, str, first);
2714 /* Replacement */
2715 if (newStrObj) {
2716 Jim_AppendObj(interp, objPtr, newStrObj);
2719 /* After part */
2720 Jim_AppendString(interp, objPtr, str + utf8_index(str, last + 1), len - last - 1);
2722 return objPtr;
2726 * Note: does not support embedded nulls.
2728 static void JimStrCopyUpperLower(char *dest, const char *str, int uc)
2730 while (*str) {
2731 int c;
2732 str += utf8_tounicode(str, &c);
2733 dest += utf8_getchars(dest, uc ? utf8_upper(c) : utf8_lower(c));
2735 *dest = 0;
2739 * Note: does not support embedded nulls.
2741 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2743 char *buf;
2744 int len;
2745 const char *str;
2747 str = Jim_GetString(strObjPtr, &len);
2749 #ifdef JIM_UTF8
2750 /* Case mapping can change the utf-8 length of the string.
2751 * But at worst it will be by one extra byte per char
2753 len *= 2;
2754 #endif
2755 buf = Jim_Alloc(len + 1);
2756 JimStrCopyUpperLower(buf, str, 0);
2757 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2761 * Note: does not support embedded nulls.
2763 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2765 char *buf;
2766 const char *str;
2767 int len;
2769 str = Jim_GetString(strObjPtr, &len);
2771 #ifdef JIM_UTF8
2772 /* Case mapping can change the utf-8 length of the string.
2773 * But at worst it will be by one extra byte per char
2775 len *= 2;
2776 #endif
2777 buf = Jim_Alloc(len + 1);
2778 JimStrCopyUpperLower(buf, str, 1);
2779 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2783 * Note: does not support embedded nulls.
2785 static Jim_Obj *JimStringToTitle(Jim_Interp *interp, Jim_Obj *strObjPtr)
2787 char *buf, *p;
2788 int len;
2789 int c;
2790 const char *str;
2792 str = Jim_GetString(strObjPtr, &len);
2794 #ifdef JIM_UTF8
2795 /* Case mapping can change the utf-8 length of the string.
2796 * But at worst it will be by one extra byte per char
2798 len *= 2;
2799 #endif
2800 buf = p = Jim_Alloc(len + 1);
2802 str += utf8_tounicode(str, &c);
2803 p += utf8_getchars(p, utf8_title(c));
2805 JimStrCopyUpperLower(p, str, 0);
2807 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2810 /* Similar to memchr() except searches a UTF-8 string 'str' of byte length 'len'
2811 * for unicode character 'c'.
2812 * Returns the position if found or NULL if not
2814 static const char *utf8_memchr(const char *str, int len, int c)
2816 #ifdef JIM_UTF8
2817 while (len) {
2818 int sc;
2819 int n = utf8_tounicode(str, &sc);
2820 if (sc == c) {
2821 return str;
2823 str += n;
2824 len -= n;
2826 return NULL;
2827 #else
2828 return memchr(str, c, len);
2829 #endif
2833 * Searches for the first non-trim char in string (str, len)
2835 * If none is found, returns just past the last char.
2837 * Lengths are in bytes.
2839 static const char *JimFindTrimLeft(const char *str, int len, const char *trimchars, int trimlen)
2841 while (len) {
2842 int c;
2843 int n = utf8_tounicode(str, &c);
2845 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2846 /* Not a trim char, so stop */
2847 break;
2849 str += n;
2850 len -= n;
2852 return str;
2856 * Searches backwards for a non-trim char in string (str, len).
2858 * Returns a pointer to just after the non-trim char, or NULL if not found.
2860 * Lengths are in bytes.
2862 static const char *JimFindTrimRight(const char *str, int len, const char *trimchars, int trimlen)
2864 str += len;
2866 while (len) {
2867 int c;
2868 int n = utf8_prev_len(str, len);
2870 len -= n;
2871 str -= n;
2873 n = utf8_tounicode(str, &c);
2875 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2876 return str + n;
2880 return NULL;
2883 static const char default_trim_chars[] = " \t\n\r";
2884 /* sizeof() here includes the null byte */
2885 static int default_trim_chars_len = sizeof(default_trim_chars);
2887 static Jim_Obj *JimStringTrimLeft(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2889 int len;
2890 const char *str = Jim_GetString(strObjPtr, &len);
2891 const char *trimchars = default_trim_chars;
2892 int trimcharslen = default_trim_chars_len;
2893 const char *newstr;
2895 if (trimcharsObjPtr) {
2896 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2899 newstr = JimFindTrimLeft(str, len, trimchars, trimcharslen);
2900 if (newstr == str) {
2901 return strObjPtr;
2904 return Jim_NewStringObj(interp, newstr, len - (newstr - str));
2907 static Jim_Obj *JimStringTrimRight(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2909 int len;
2910 const char *trimchars = default_trim_chars;
2911 int trimcharslen = default_trim_chars_len;
2912 const char *nontrim;
2914 if (trimcharsObjPtr) {
2915 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2918 SetStringFromAny(interp, strObjPtr);
2920 len = Jim_Length(strObjPtr);
2921 nontrim = JimFindTrimRight(strObjPtr->bytes, len, trimchars, trimcharslen);
2923 if (nontrim == NULL) {
2924 /* All trim, so return a zero-length string */
2925 return Jim_NewEmptyStringObj(interp);
2927 if (nontrim == strObjPtr->bytes + len) {
2928 /* All non-trim, so return the original object */
2929 return strObjPtr;
2932 if (Jim_IsShared(strObjPtr)) {
2933 strObjPtr = Jim_NewStringObj(interp, strObjPtr->bytes, (nontrim - strObjPtr->bytes));
2935 else {
2936 /* Can modify this string in place */
2937 strObjPtr->bytes[nontrim - strObjPtr->bytes] = 0;
2938 strObjPtr->length = (nontrim - strObjPtr->bytes);
2941 return strObjPtr;
2944 static Jim_Obj *JimStringTrim(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2946 /* First trim left. */
2947 Jim_Obj *objPtr = JimStringTrimLeft(interp, strObjPtr, trimcharsObjPtr);
2949 /* Now trim right */
2950 strObjPtr = JimStringTrimRight(interp, objPtr, trimcharsObjPtr);
2952 /* Note: refCount check is needed since objPtr may be emptyObj */
2953 if (objPtr != strObjPtr && objPtr->refCount == 0) {
2954 /* We don't want this object to be leaked */
2955 Jim_FreeNewObj(interp, objPtr);
2958 return strObjPtr;
2961 /* Some platforms don't have isascii - need a non-macro version */
2962 #ifdef HAVE_ISASCII
2963 #define jim_isascii isascii
2964 #else
2965 static int jim_isascii(int c)
2967 return !(c & ~0x7f);
2969 #endif
2971 static int JimStringIs(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *strClass, int strict)
2973 static const char * const strclassnames[] = {
2974 "integer", "alpha", "alnum", "ascii", "digit",
2975 "double", "lower", "upper", "space", "xdigit",
2976 "control", "print", "graph", "punct", "boolean",
2977 NULL
2979 enum {
2980 STR_IS_INTEGER, STR_IS_ALPHA, STR_IS_ALNUM, STR_IS_ASCII, STR_IS_DIGIT,
2981 STR_IS_DOUBLE, STR_IS_LOWER, STR_IS_UPPER, STR_IS_SPACE, STR_IS_XDIGIT,
2982 STR_IS_CONTROL, STR_IS_PRINT, STR_IS_GRAPH, STR_IS_PUNCT, STR_IS_BOOLEAN,
2984 int strclass;
2985 int len;
2986 int i;
2987 const char *str;
2988 int (*isclassfunc)(int c) = NULL;
2990 if (Jim_GetEnum(interp, strClass, strclassnames, &strclass, "class", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
2991 return JIM_ERR;
2994 str = Jim_GetString(strObjPtr, &len);
2995 if (len == 0) {
2996 Jim_SetResultBool(interp, !strict);
2997 return JIM_OK;
3000 switch (strclass) {
3001 case STR_IS_INTEGER:
3003 jim_wide w;
3004 Jim_SetResultBool(interp, JimGetWideNoErr(interp, strObjPtr, &w) == JIM_OK);
3005 return JIM_OK;
3008 case STR_IS_DOUBLE:
3010 double d;
3011 Jim_SetResultBool(interp, Jim_GetDouble(interp, strObjPtr, &d) == JIM_OK && errno != ERANGE);
3012 return JIM_OK;
3015 case STR_IS_BOOLEAN:
3017 int b;
3018 Jim_SetResultBool(interp, Jim_GetBoolean(interp, strObjPtr, &b) == JIM_OK);
3019 return JIM_OK;
3022 case STR_IS_ALPHA: isclassfunc = isalpha; break;
3023 case STR_IS_ALNUM: isclassfunc = isalnum; break;
3024 case STR_IS_ASCII: isclassfunc = jim_isascii; break;
3025 case STR_IS_DIGIT: isclassfunc = isdigit; break;
3026 case STR_IS_LOWER: isclassfunc = islower; break;
3027 case STR_IS_UPPER: isclassfunc = isupper; break;
3028 case STR_IS_SPACE: isclassfunc = isspace; break;
3029 case STR_IS_XDIGIT: isclassfunc = isxdigit; break;
3030 case STR_IS_CONTROL: isclassfunc = iscntrl; break;
3031 case STR_IS_PRINT: isclassfunc = isprint; break;
3032 case STR_IS_GRAPH: isclassfunc = isgraph; break;
3033 case STR_IS_PUNCT: isclassfunc = ispunct; break;
3034 default:
3035 return JIM_ERR;
3038 for (i = 0; i < len; i++) {
3039 if (!isclassfunc(UCHAR(str[i]))) {
3040 Jim_SetResultBool(interp, 0);
3041 return JIM_OK;
3044 Jim_SetResultBool(interp, 1);
3045 return JIM_OK;
3048 /* -----------------------------------------------------------------------------
3049 * Compared String Object
3050 * ---------------------------------------------------------------------------*/
3052 /* This is strange object that allows comparison of a C literal string
3053 * with a Jim object in a very short time if the same comparison is done
3054 * multiple times. For example every time the [if] command is executed,
3055 * Jim has to check if a given argument is "else".
3056 * If the code has no errors, this comparison is true most of the time,
3057 * so we can cache the pointer of the string of the last matching
3058 * comparison inside the object. Because most C compilers perform literal sharing,
3059 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
3060 * this works pretty well even if comparisons are at different places
3061 * inside the C code. */
3063 static const Jim_ObjType comparedStringObjType = {
3064 "compared-string",
3065 NULL,
3066 NULL,
3067 NULL,
3068 JIM_TYPE_REFERENCES,
3071 /* The only way this object is exposed to the API is via the following
3072 * function. Returns true if the string and the object string repr.
3073 * are the same, otherwise zero is returned.
3075 * Note: this isn't binary safe, but it hardly needs to be.*/
3076 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr, const char *str)
3078 if (objPtr->typePtr == &comparedStringObjType && objPtr->internalRep.ptr == str) {
3079 return 1;
3081 else {
3082 if (strcmp(str, Jim_String(objPtr)) != 0)
3083 return 0;
3085 if (objPtr->typePtr != &comparedStringObjType) {
3086 Jim_FreeIntRep(interp, objPtr);
3087 objPtr->typePtr = &comparedStringObjType;
3089 objPtr->internalRep.ptr = (char *)str; /*ATTENTION: const cast */
3090 return 1;
3094 static int qsortCompareStringPointers(const void *a, const void *b)
3096 char *const *sa = (char *const *)a;
3097 char *const *sb = (char *const *)b;
3099 return strcmp(*sa, *sb);
3103 /* -----------------------------------------------------------------------------
3104 * Source Object
3106 * This object is just a string from the language point of view, but
3107 * the internal representation contains the filename and line number
3108 * where this token was read. This information is used by
3109 * Jim_EvalObj() if the object passed happens to be of type "source".
3111 * This allows propagation of the information about line numbers and file
3112 * names and gives error messages with absolute line numbers.
3114 * Note that this object uses the internal representation of the Jim_Object,
3115 * so there is almost no memory overhead. (One Jim_Obj for each filename).
3117 * Also the object will be converted to something else if the given
3118 * token it represents in the source file is not something to be
3119 * evaluated (not a script), and will be specialized in some other way,
3120 * so the time overhead is also almost zero.
3121 * ---------------------------------------------------------------------------*/
3123 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3124 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3126 static const Jim_ObjType sourceObjType = {
3127 "source",
3128 FreeSourceInternalRep,
3129 DupSourceInternalRep,
3130 NULL,
3131 JIM_TYPE_REFERENCES,
3134 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3136 Jim_DecrRefCount(interp, objPtr->internalRep.sourceValue.fileNameObj);
3139 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3141 dupPtr->internalRep.sourceValue = srcPtr->internalRep.sourceValue;
3142 Jim_IncrRefCount(dupPtr->internalRep.sourceValue.fileNameObj);
3145 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
3146 Jim_Obj *fileNameObj, int lineNumber)
3148 JimPanic((Jim_IsShared(objPtr), "JimSetSourceInfo called with shared object"));
3149 JimPanic((objPtr->typePtr != NULL, "JimSetSourceInfo called with typed object"));
3150 Jim_IncrRefCount(fileNameObj);
3151 objPtr->internalRep.sourceValue.fileNameObj = fileNameObj;
3152 objPtr->internalRep.sourceValue.lineNumber = lineNumber;
3153 objPtr->typePtr = &sourceObjType;
3156 /* -----------------------------------------------------------------------------
3157 * ScriptLine Object
3159 * This object is used only in the Script internal represenation.
3160 * For each line of the script, it holds the number of tokens on the line
3161 * and the source line number.
3163 static const Jim_ObjType scriptLineObjType = {
3164 "scriptline",
3165 NULL,
3166 NULL,
3167 NULL,
3168 JIM_NONE,
3171 static Jim_Obj *JimNewScriptLineObj(Jim_Interp *interp, int argc, int line)
3173 Jim_Obj *objPtr;
3175 #ifdef DEBUG_SHOW_SCRIPT
3176 char buf[100];
3177 snprintf(buf, sizeof(buf), "line=%d, argc=%d", line, argc);
3178 objPtr = Jim_NewStringObj(interp, buf, -1);
3179 #else
3180 objPtr = Jim_NewEmptyStringObj(interp);
3181 #endif
3182 objPtr->typePtr = &scriptLineObjType;
3183 objPtr->internalRep.scriptLineValue.argc = argc;
3184 objPtr->internalRep.scriptLineValue.line = line;
3186 return objPtr;
3189 /* -----------------------------------------------------------------------------
3190 * Script Object
3192 * This object holds the parsed internal representation of a script.
3193 * This representation is help within an allocated ScriptObj (see below)
3195 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3196 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3198 static const Jim_ObjType scriptObjType = {
3199 "script",
3200 FreeScriptInternalRep,
3201 DupScriptInternalRep,
3202 NULL,
3203 JIM_TYPE_REFERENCES,
3206 /* Each token of a script is represented by a ScriptToken.
3207 * The ScriptToken contains a type and a Jim_Obj. The Jim_Obj
3208 * can be specialized by commands operating on it.
3210 typedef struct ScriptToken
3212 Jim_Obj *objPtr;
3213 int type;
3214 } ScriptToken;
3216 /* This is the script object internal representation. An array of
3217 * ScriptToken structures, including a pre-computed representation of the
3218 * command length and arguments.
3220 * For example the script:
3222 * puts hello
3223 * set $i $x$y [foo]BAR
3225 * will produce a ScriptObj with the following ScriptToken's:
3227 * LIN 2
3228 * ESC puts
3229 * ESC hello
3230 * LIN 4
3231 * ESC set
3232 * VAR i
3233 * WRD 2
3234 * VAR x
3235 * VAR y
3236 * WRD 2
3237 * CMD foo
3238 * ESC BAR
3240 * "puts hello" has two args (LIN 2), composed of single tokens.
3241 * (Note that the WRD token is omitted for the common case of a single token.)
3243 * "set $i $x$y [foo]BAR" has four (LIN 4) args, the first word
3244 * has 1 token (ESC SET), and the last has two tokens (WRD 2 CMD foo ESC BAR)
3246 * The precomputation of the command structure makes Jim_Eval() faster,
3247 * and simpler because there aren't dynamic lengths / allocations.
3249 * -- {expand}/{*} handling --
3251 * Expand is handled in a special way.
3253 * If a "word" begins with {*}, the word token count is -ve.
3255 * For example the command:
3257 * list {*}{a b}
3259 * Will produce the following cmdstruct array:
3261 * LIN 2
3262 * ESC list
3263 * WRD -1
3264 * STR a b
3266 * Note that the 'LIN' token also contains the source information for the
3267 * first word of the line for error reporting purposes
3269 * -- the substFlags field of the structure --
3271 * The scriptObj structure is used to represent both "script" objects
3272 * and "subst" objects. In the second case, there are no LIN and WRD
3273 * tokens. Instead SEP and EOL tokens are added as-is.
3274 * In addition, the field 'substFlags' is used to represent the flags used to turn
3275 * the string into the internal representation.
3276 * If these flags do not match what the application requires,
3277 * the scriptObj is created again. For example the script:
3279 * subst -nocommands $string
3280 * subst -novariables $string
3282 * Will (re)create the internal representation of the $string object
3283 * two times.
3285 typedef struct ScriptObj
3287 ScriptToken *token; /* Tokens array. */
3288 Jim_Obj *fileNameObj; /* Filename */
3289 int len; /* Length of token[] */
3290 int substFlags; /* flags used for the compilation of "subst" objects */
3291 int inUse; /* Used to share a ScriptObj. Currently
3292 only used by Jim_EvalObj() as protection against
3293 shimmering of the currently evaluated object. */
3294 int firstline; /* Line number of the first line */
3295 int linenr; /* Error line number, if any */
3296 int missing; /* Missing char if script failed to parse, (or space or backslash if OK) */
3297 } ScriptObj;
3299 static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3300 static int JimParseCheckMissing(Jim_Interp *interp, int ch);
3301 static ScriptObj *JimGetScript(Jim_Interp *interp, Jim_Obj *objPtr);
3303 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3305 int i;
3306 struct ScriptObj *script = (void *)objPtr->internalRep.ptr;
3308 if (--script->inUse != 0)
3309 return;
3310 for (i = 0; i < script->len; i++) {
3311 Jim_DecrRefCount(interp, script->token[i].objPtr);
3313 Jim_Free(script->token);
3314 Jim_DecrRefCount(interp, script->fileNameObj);
3315 Jim_Free(script);
3318 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3320 JIM_NOTUSED(interp);
3321 JIM_NOTUSED(srcPtr);
3323 /* Just return a simple string. We don't try to preserve the source info
3324 * since in practice scripts are never duplicated
3326 dupPtr->typePtr = NULL;
3329 /* A simple parse token.
3330 * As the script is parsed, the created tokens point into the script string rep.
3332 typedef struct
3334 const char *token; /* Pointer to the start of the token */
3335 int len; /* Length of this token */
3336 int type; /* Token type */
3337 int line; /* Line number */
3338 } ParseToken;
3340 /* A list of parsed tokens representing a script.
3341 * Tokens are added to this list as the script is parsed.
3342 * It grows as needed.
3344 typedef struct
3346 /* Start with a statically allocated list of tokens which will be expanded with realloc if needed */
3347 ParseToken *list; /* Array of tokens */
3348 int size; /* Current size of the list */
3349 int count; /* Number of entries used */
3350 ParseToken static_list[20]; /* Small initial token space to avoid allocation */
3351 } ParseTokenList;
3353 static void ScriptTokenListInit(ParseTokenList *tokenlist)
3355 tokenlist->list = tokenlist->static_list;
3356 tokenlist->size = sizeof(tokenlist->static_list) / sizeof(ParseToken);
3357 tokenlist->count = 0;
3360 static void ScriptTokenListFree(ParseTokenList *tokenlist)
3362 if (tokenlist->list != tokenlist->static_list) {
3363 Jim_Free(tokenlist->list);
3368 * Adds the new token to the tokenlist.
3369 * The token has the given length, type and line number.
3370 * The token list is resized as necessary.
3372 static void ScriptAddToken(ParseTokenList *tokenlist, const char *token, int len, int type,
3373 int line)
3375 ParseToken *t;
3377 if (tokenlist->count == tokenlist->size) {
3378 /* Resize the list */
3379 tokenlist->size *= 2;
3380 if (tokenlist->list != tokenlist->static_list) {
3381 tokenlist->list =
3382 Jim_Realloc(tokenlist->list, tokenlist->size * sizeof(*tokenlist->list));
3384 else {
3385 /* The list needs to become allocated */
3386 tokenlist->list = Jim_Alloc(tokenlist->size * sizeof(*tokenlist->list));
3387 memcpy(tokenlist->list, tokenlist->static_list,
3388 tokenlist->count * sizeof(*tokenlist->list));
3391 t = &tokenlist->list[tokenlist->count++];
3392 t->token = token;
3393 t->len = len;
3394 t->type = type;
3395 t->line = line;
3398 /* Counts the number of adjoining non-separator tokens.
3400 * Returns -ve if the first token is the expansion
3401 * operator (in which case the count doesn't include
3402 * that token).
3404 static int JimCountWordTokens(struct ScriptObj *script, ParseToken *t)
3406 int expand = 1;
3407 int count = 0;
3409 /* Is the first word {*} or {expand}? */
3410 if (t->type == JIM_TT_STR && !TOKEN_IS_SEP(t[1].type)) {
3411 if ((t->len == 1 && *t->token == '*') || (t->len == 6 && strncmp(t->token, "expand", 6) == 0)) {
3412 /* Create an expand token */
3413 expand = -1;
3414 t++;
3416 else {
3417 if (script->missing == ' ') {
3418 /* This is a "extra characters after close-brace" error. Report the first error */
3419 script->missing = '}';
3420 script->linenr = t[1].line;
3425 /* Now count non-separator words */
3426 while (!TOKEN_IS_SEP(t->type)) {
3427 t++;
3428 count++;
3431 return count * expand;
3435 * Create a script/subst object from the given token.
3437 static Jim_Obj *JimMakeScriptObj(Jim_Interp *interp, const ParseToken *t)
3439 Jim_Obj *objPtr;
3441 if (t->type == JIM_TT_ESC && memchr(t->token, '\\', t->len) != NULL) {
3442 /* Convert backlash escapes. The result will never be longer than the original */
3443 int len = t->len;
3444 char *str = Jim_Alloc(len + 1);
3445 len = JimEscape(str, t->token, len);
3446 objPtr = Jim_NewStringObjNoAlloc(interp, str, len);
3448 else {
3449 /* XXX: For strict Tcl compatibility, JIM_TT_STR should replace <backslash><newline><whitespace>
3450 * with a single space.
3452 objPtr = Jim_NewStringObj(interp, t->token, t->len);
3454 return objPtr;
3458 * Takes a tokenlist and creates the allocated list of script tokens
3459 * in script->token, of length script->len.
3461 * Unnecessary tokens are discarded, and LINE and WORD tokens are inserted
3462 * as required.
3464 * Also sets script->line to the line number of the first token
3466 static void ScriptObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3467 ParseTokenList *tokenlist)
3469 int i;
3470 struct ScriptToken *token;
3471 /* Number of tokens so far for the current command */
3472 int lineargs = 0;
3473 /* This is the first token for the current command */
3474 ScriptToken *linefirst;
3475 int count;
3476 int linenr;
3478 #ifdef DEBUG_SHOW_SCRIPT_TOKENS
3479 printf("==== Tokens ====\n");
3480 for (i = 0; i < tokenlist->count; i++) {
3481 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist->list[i].line, jim_tt_name(tokenlist->list[i].type),
3482 tokenlist->list[i].len, tokenlist->list[i].token);
3484 #endif
3486 /* May need up to one extra script token for each EOL in the worst case */
3487 count = tokenlist->count;
3488 for (i = 0; i < tokenlist->count; i++) {
3489 if (tokenlist->list[i].type == JIM_TT_EOL) {
3490 count++;
3493 linenr = script->firstline = tokenlist->list[0].line;
3495 token = script->token = Jim_Alloc(sizeof(ScriptToken) * count);
3497 /* This is the first token for the current command */
3498 linefirst = token++;
3500 for (i = 0; i < tokenlist->count; ) {
3501 /* Look ahead to find out how many tokens make up the next word */
3502 int wordtokens;
3504 /* Skip any leading separators */
3505 while (tokenlist->list[i].type == JIM_TT_SEP) {
3506 i++;
3509 wordtokens = JimCountWordTokens(script, tokenlist->list + i);
3511 if (wordtokens == 0) {
3512 /* None, so at end of line */
3513 if (lineargs) {
3514 linefirst->type = JIM_TT_LINE;
3515 linefirst->objPtr = JimNewScriptLineObj(interp, lineargs, linenr);
3516 Jim_IncrRefCount(linefirst->objPtr);
3518 /* Reset for new line */
3519 lineargs = 0;
3520 linefirst = token++;
3522 i++;
3523 continue;
3525 else if (wordtokens != 1) {
3526 /* More than 1, or {*}, so insert a WORD token */
3527 token->type = JIM_TT_WORD;
3528 token->objPtr = Jim_NewIntObj(interp, wordtokens);
3529 Jim_IncrRefCount(token->objPtr);
3530 token++;
3531 if (wordtokens < 0) {
3532 /* Skip the expand token */
3533 i++;
3534 wordtokens = -wordtokens - 1;
3535 lineargs--;
3539 if (lineargs == 0) {
3540 /* First real token on the line, so record the line number */
3541 linenr = tokenlist->list[i].line;
3543 lineargs++;
3545 /* Add each non-separator word token to the line */
3546 while (wordtokens--) {
3547 const ParseToken *t = &tokenlist->list[i++];
3549 token->type = t->type;
3550 token->objPtr = JimMakeScriptObj(interp, t);
3551 Jim_IncrRefCount(token->objPtr);
3553 /* Every object is initially a string of type 'source', but the
3554 * internal type may be specialized during execution of the
3555 * script. */
3556 JimSetSourceInfo(interp, token->objPtr, script->fileNameObj, t->line);
3557 token++;
3561 if (lineargs == 0) {
3562 token--;
3565 script->len = token - script->token;
3567 JimPanic((script->len >= count, "allocated script array is too short"));
3569 #ifdef DEBUG_SHOW_SCRIPT
3570 printf("==== Script (%s) ====\n", Jim_String(script->fileNameObj));
3571 for (i = 0; i < script->len; i++) {
3572 const ScriptToken *t = &script->token[i];
3573 printf("[%2d] %s %s\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
3575 #endif
3579 /* Parses the given string object to determine if it represents a complete script.
3581 * This is useful for interactive shells implementation, for [info complete].
3583 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
3584 * '{' on scripts incomplete missing one or more '}' to be balanced.
3585 * '[' on scripts incomplete missing one or more ']' to be balanced.
3586 * '"' on scripts incomplete missing a '"' char.
3587 * '\\' on scripts with a trailing backslash.
3589 * If the script is complete, 1 is returned, otherwise 0.
3591 * If the script has extra characters after a close brace, this still returns 1,
3592 * but sets *stateCharPtr to '}'
3593 * Evaluating the script will give the error "extra characters after close-brace".
3595 int Jim_ScriptIsComplete(Jim_Interp *interp, Jim_Obj *scriptObj, char *stateCharPtr)
3597 ScriptObj *script = JimGetScript(interp, scriptObj);
3598 if (stateCharPtr) {
3599 *stateCharPtr = script->missing;
3601 return script->missing == ' ' || script->missing == '}';
3605 * Sets an appropriate error message for a missing script/expression terminator.
3607 * Returns JIM_ERR if 'ch' represents an unmatched/missing character.
3609 * Note that a trailing backslash is not considered to be an error.
3611 static int JimParseCheckMissing(Jim_Interp *interp, int ch)
3613 const char *msg;
3615 switch (ch) {
3616 case '\\':
3617 case ' ':
3618 return JIM_OK;
3620 case '[':
3621 msg = "unmatched \"[\"";
3622 break;
3623 case '{':
3624 msg = "missing close-brace";
3625 break;
3626 case '}':
3627 msg = "extra characters after close-brace";
3628 break;
3629 case '"':
3630 default:
3631 msg = "missing quote";
3632 break;
3635 Jim_SetResultString(interp, msg, -1);
3636 return JIM_ERR;
3640 * Similar to ScriptObjAddTokens(), but for subst objects.
3642 static void SubstObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3643 ParseTokenList *tokenlist)
3645 int i;
3646 struct ScriptToken *token;
3648 token = script->token = Jim_Alloc(sizeof(ScriptToken) * tokenlist->count);
3650 for (i = 0; i < tokenlist->count; i++) {
3651 const ParseToken *t = &tokenlist->list[i];
3653 /* Create a token for 't' */
3654 token->type = t->type;
3655 token->objPtr = JimMakeScriptObj(interp, t);
3656 Jim_IncrRefCount(token->objPtr);
3657 token++;
3660 script->len = i;
3663 /* This method takes the string representation of an object
3664 * as a Tcl script, and generates the pre-parsed internal representation
3665 * of the script.
3667 * On parse error, sets an error message and returns JIM_ERR
3668 * (Note: the object is still converted to a script, even if an error occurs)
3670 static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3672 int scriptTextLen;
3673 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
3674 struct JimParserCtx parser;
3675 struct ScriptObj *script;
3676 ParseTokenList tokenlist;
3677 int line = 1;
3679 /* Try to get information about filename / line number */
3680 if (objPtr->typePtr == &sourceObjType) {
3681 line = objPtr->internalRep.sourceValue.lineNumber;
3684 /* Initially parse the script into tokens (in tokenlist) */
3685 ScriptTokenListInit(&tokenlist);
3687 JimParserInit(&parser, scriptText, scriptTextLen, line);
3688 while (!parser.eof) {
3689 JimParseScript(&parser);
3690 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
3691 parser.tline);
3694 /* Add a final EOF token */
3695 ScriptAddToken(&tokenlist, scriptText + scriptTextLen, 0, JIM_TT_EOF, 0);
3697 /* Create the "real" script tokens from the parsed tokens */
3698 script = Jim_Alloc(sizeof(*script));
3699 memset(script, 0, sizeof(*script));
3700 script->inUse = 1;
3701 if (objPtr->typePtr == &sourceObjType) {
3702 script->fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
3704 else {
3705 script->fileNameObj = interp->emptyObj;
3707 Jim_IncrRefCount(script->fileNameObj);
3708 script->missing = parser.missing.ch;
3709 script->linenr = parser.missing.line;
3711 ScriptObjAddTokens(interp, script, &tokenlist);
3713 /* No longer need the token list */
3714 ScriptTokenListFree(&tokenlist);
3716 /* Free the old internal rep and set the new one. */
3717 Jim_FreeIntRep(interp, objPtr);
3718 Jim_SetIntRepPtr(objPtr, script);
3719 objPtr->typePtr = &scriptObjType;
3722 static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script);
3725 * Returns the parsed script.
3726 * Note that if there is any possibility that the script is not valid,
3727 * call JimScriptValid() to check
3729 static ScriptObj *JimGetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3731 if (objPtr == interp->emptyObj) {
3732 /* Avoid converting emptyObj to a script. use nullScriptObj instead. */
3733 objPtr = interp->nullScriptObj;
3736 if (objPtr->typePtr != &scriptObjType || ((struct ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags) {
3737 JimSetScriptFromAny(interp, objPtr);
3740 return (ScriptObj *)Jim_GetIntRepPtr(objPtr);
3744 * Returns 1 if the script is valid (parsed ok), otherwise returns 0
3745 * and leaves an error message in the interp result.
3748 static int JimScriptValid(Jim_Interp *interp, ScriptObj *script)
3750 if (JimParseCheckMissing(interp, script->missing) == JIM_ERR) {
3751 JimAddErrorToStack(interp, script);
3752 return 0;
3754 return 1;
3758 /* -----------------------------------------------------------------------------
3759 * Commands
3760 * ---------------------------------------------------------------------------*/
3761 static void JimIncrCmdRefCount(Jim_Cmd *cmdPtr)
3763 cmdPtr->inUse++;
3766 static void JimDecrCmdRefCount(Jim_Interp *interp, Jim_Cmd *cmdPtr)
3768 if (--cmdPtr->inUse == 0) {
3769 if (cmdPtr->isproc) {
3770 Jim_DecrRefCount(interp, cmdPtr->u.proc.argListObjPtr);
3771 Jim_DecrRefCount(interp, cmdPtr->u.proc.bodyObjPtr);
3772 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
3773 if (cmdPtr->u.proc.staticVars) {
3774 Jim_FreeHashTable(cmdPtr->u.proc.staticVars);
3775 Jim_Free(cmdPtr->u.proc.staticVars);
3778 else {
3779 /* native (C) */
3780 if (cmdPtr->u.native.delProc) {
3781 cmdPtr->u.native.delProc(interp, cmdPtr->u.native.privData);
3784 if (cmdPtr->prevCmd) {
3785 /* Delete any pushed command too */
3786 JimDecrCmdRefCount(interp, cmdPtr->prevCmd);
3788 Jim_Free(cmdPtr);
3792 /* Variables HashTable Type.
3794 * Keys are dynamically allocated strings, Values are Jim_Var structures.
3796 static void JimVariablesHTValDestructor(void *interp, void *val)
3798 Jim_DecrRefCount(interp, ((Jim_Var *)val)->objPtr);
3799 Jim_Free(val);
3802 static const Jim_HashTableType JimVariablesHashTableType = {
3803 JimStringCopyHTHashFunction, /* hash function */
3804 JimStringCopyHTDup, /* key dup */
3805 NULL, /* val dup */
3806 JimStringCopyHTKeyCompare, /* key compare */
3807 JimStringCopyHTKeyDestructor, /* key destructor */
3808 JimVariablesHTValDestructor /* val destructor */
3811 /* Commands HashTable Type.
3813 * Keys are dynamic allocated strings, Values are Jim_Cmd structures.
3815 static void JimCommandsHT_ValDestructor(void *interp, void *val)
3817 JimDecrCmdRefCount(interp, val);
3820 static const Jim_HashTableType JimCommandsHashTableType = {
3821 JimStringCopyHTHashFunction, /* hash function */
3822 JimStringCopyHTDup, /* key dup */
3823 NULL, /* val dup */
3824 JimStringCopyHTKeyCompare, /* key compare */
3825 JimStringCopyHTKeyDestructor, /* key destructor */
3826 JimCommandsHT_ValDestructor /* val destructor */
3829 /* ------------------------- Commands related functions --------------------- */
3831 #ifdef jim_ext_namespace
3833 * Returns the "unscoped" version of the given namespace.
3834 * That is, the fully qualified name without the leading ::
3835 * The returned value is either nsObj, or an object with a zero ref count.
3837 static Jim_Obj *JimQualifyNameObj(Jim_Interp *interp, Jim_Obj *nsObj)
3839 const char *name = Jim_String(nsObj);
3840 if (name[0] == ':' && name[1] == ':') {
3841 /* This command is being defined in the global namespace */
3842 while (*++name == ':') {
3844 nsObj = Jim_NewStringObj(interp, name, -1);
3846 else if (Jim_Length(interp->framePtr->nsObj)) {
3847 /* This command is being defined in a non-global namespace */
3848 nsObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3849 Jim_AppendStrings(interp, nsObj, "::", name, NULL);
3851 return nsObj;
3855 * If nameObjPtr starts with "::", returns it.
3856 * Otherwise returns a new object with nameObjPtr prefixed with "::".
3857 * In this case, decrements the ref count of nameObjPtr.
3859 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3861 Jim_Obj *resultObj;
3863 const char *name = Jim_String(nameObjPtr);
3864 if (name[0] == ':' && name[1] == ':') {
3865 return nameObjPtr;
3867 Jim_IncrRefCount(nameObjPtr);
3868 resultObj = Jim_NewStringObj(interp, "::", -1);
3869 Jim_AppendObj(interp, resultObj, nameObjPtr);
3870 Jim_DecrRefCount(interp, nameObjPtr);
3872 return resultObj;
3876 * An efficient version of JimQualifyNameObj() where the name is
3877 * available (and needed) as a 'const char *'.
3878 * Avoids creating an object if not necessary.
3879 * The object stored in *objPtrPtr should be disposed of with JimFreeQualifiedName() after use.
3881 static const char *JimQualifyName(Jim_Interp *interp, const char *name, Jim_Obj **objPtrPtr)
3883 Jim_Obj *objPtr = interp->emptyObj;
3885 if (name[0] == ':' && name[1] == ':') {
3886 /* This command is being defined in the global namespace */
3887 while (*++name == ':') {
3890 else if (Jim_Length(interp->framePtr->nsObj)) {
3891 /* This command is being defined in a non-global namespace */
3892 objPtr = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3893 Jim_AppendStrings(interp, objPtr, "::", name, NULL);
3894 name = Jim_String(objPtr);
3896 Jim_IncrRefCount(objPtr);
3897 *objPtrPtr = objPtr;
3898 return name;
3901 #define JimFreeQualifiedName(INTERP, OBJ) Jim_DecrRefCount((INTERP), (OBJ))
3903 #else
3904 /* We can be more efficient in the no-namespace case */
3905 #define JimQualifyName(INTERP, NAME, DUMMY) (((NAME)[0] == ':' && (NAME)[1] == ':') ? (NAME) + 2 : (NAME))
3906 #define JimFreeQualifiedName(INTERP, DUMMY) (void)(DUMMY)
3908 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3910 return nameObjPtr;
3912 #endif
3914 static int JimCreateCommand(Jim_Interp *interp, const char *name, Jim_Cmd *cmd)
3916 /* It may already exist, so we try to delete the old one.
3917 * Note that reference count means that it won't be deleted yet if
3918 * it exists in the call stack.
3920 * BUT, if 'local' is in force, instead of deleting the existing
3921 * proc, we stash a reference to the old proc here.
3923 Jim_HashEntry *he = Jim_FindHashEntry(&interp->commands, name);
3924 if (he) {
3925 /* There was an old cmd with the same name,
3926 * so this requires a 'proc epoch' update. */
3928 /* If a procedure with the same name didn't exist there is no need
3929 * to increment the 'proc epoch' because creation of a new procedure
3930 * can never affect existing cached commands. We don't do
3931 * negative caching. */
3932 Jim_InterpIncrProcEpoch(interp);
3935 if (he && interp->local) {
3936 /* Push this command over the top of the previous one */
3937 cmd->prevCmd = Jim_GetHashEntryVal(he);
3938 Jim_SetHashVal(&interp->commands, he, cmd);
3940 else {
3941 if (he) {
3942 /* Replace the existing command */
3943 Jim_DeleteHashEntry(&interp->commands, name);
3946 Jim_AddHashEntry(&interp->commands, name, cmd);
3948 return JIM_OK;
3952 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdNameStr,
3953 Jim_CmdProc *cmdProc, void *privData, Jim_DelCmdProc *delProc)
3955 Jim_Cmd *cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3957 /* Store the new details for this command */
3958 memset(cmdPtr, 0, sizeof(*cmdPtr));
3959 cmdPtr->inUse = 1;
3960 cmdPtr->u.native.delProc = delProc;
3961 cmdPtr->u.native.cmdProc = cmdProc;
3962 cmdPtr->u.native.privData = privData;
3964 JimCreateCommand(interp, cmdNameStr, cmdPtr);
3966 return JIM_OK;
3969 static int JimCreateProcedureStatics(Jim_Interp *interp, Jim_Cmd *cmdPtr, Jim_Obj *staticsListObjPtr)
3971 int len, i;
3973 len = Jim_ListLength(interp, staticsListObjPtr);
3974 if (len == 0) {
3975 return JIM_OK;
3978 cmdPtr->u.proc.staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3979 Jim_InitHashTable(cmdPtr->u.proc.staticVars, &JimVariablesHashTableType, interp);
3980 for (i = 0; i < len; i++) {
3981 Jim_Obj *objPtr, *initObjPtr, *nameObjPtr;
3982 Jim_Var *varPtr;
3983 int subLen;
3985 objPtr = Jim_ListGetIndex(interp, staticsListObjPtr, i);
3986 /* Check if it's composed of two elements. */
3987 subLen = Jim_ListLength(interp, objPtr);
3988 if (subLen == 1 || subLen == 2) {
3989 /* Try to get the variable value from the current
3990 * environment. */
3991 nameObjPtr = Jim_ListGetIndex(interp, objPtr, 0);
3992 if (subLen == 1) {
3993 initObjPtr = Jim_GetVariable(interp, nameObjPtr, JIM_NONE);
3994 if (initObjPtr == NULL) {
3995 Jim_SetResultFormatted(interp,
3996 "variable for initialization of static \"%#s\" not found in the local context",
3997 nameObjPtr);
3998 return JIM_ERR;
4001 else {
4002 initObjPtr = Jim_ListGetIndex(interp, objPtr, 1);
4004 if (JimValidName(interp, "static variable", nameObjPtr) != JIM_OK) {
4005 return JIM_ERR;
4008 varPtr = Jim_Alloc(sizeof(*varPtr));
4009 varPtr->objPtr = initObjPtr;
4010 Jim_IncrRefCount(initObjPtr);
4011 varPtr->linkFramePtr = NULL;
4012 if (Jim_AddHashEntry(cmdPtr->u.proc.staticVars,
4013 Jim_String(nameObjPtr), varPtr) != JIM_OK) {
4014 Jim_SetResultFormatted(interp,
4015 "static variable name \"%#s\" duplicated in statics list", nameObjPtr);
4016 Jim_DecrRefCount(interp, initObjPtr);
4017 Jim_Free(varPtr);
4018 return JIM_ERR;
4021 else {
4022 Jim_SetResultFormatted(interp, "too many fields in static specifier \"%#s\"",
4023 objPtr);
4024 return JIM_ERR;
4027 return JIM_OK;
4031 * If the command is a proc, sets/updates the cached namespace (nsObj)
4032 * based on the command name.
4034 static void JimUpdateProcNamespace(Jim_Interp *interp, Jim_Cmd *cmdPtr, const char *cmdname)
4036 #ifdef jim_ext_namespace
4037 if (cmdPtr->isproc) {
4038 /* XXX: Really need JimNamespaceSplit() */
4039 const char *pt = strrchr(cmdname, ':');
4040 if (pt && pt != cmdname && pt[-1] == ':') {
4041 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
4042 cmdPtr->u.proc.nsObj = Jim_NewStringObj(interp, cmdname, pt - cmdname - 1);
4043 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
4045 if (Jim_FindHashEntry(&interp->commands, pt + 1)) {
4046 /* This command shadows a global command, so a proc epoch update is required */
4047 Jim_InterpIncrProcEpoch(interp);
4051 #endif
4054 static Jim_Cmd *JimCreateProcedureCmd(Jim_Interp *interp, Jim_Obj *argListObjPtr,
4055 Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr, Jim_Obj *nsObj)
4057 Jim_Cmd *cmdPtr;
4058 int argListLen;
4059 int i;
4061 argListLen = Jim_ListLength(interp, argListObjPtr);
4063 /* Allocate space for both the command pointer and the arg list */
4064 cmdPtr = Jim_Alloc(sizeof(*cmdPtr) + sizeof(struct Jim_ProcArg) * argListLen);
4065 memset(cmdPtr, 0, sizeof(*cmdPtr));
4066 cmdPtr->inUse = 1;
4067 cmdPtr->isproc = 1;
4068 cmdPtr->u.proc.argListObjPtr = argListObjPtr;
4069 cmdPtr->u.proc.argListLen = argListLen;
4070 cmdPtr->u.proc.bodyObjPtr = bodyObjPtr;
4071 cmdPtr->u.proc.argsPos = -1;
4072 cmdPtr->u.proc.arglist = (struct Jim_ProcArg *)(cmdPtr + 1);
4073 cmdPtr->u.proc.nsObj = nsObj ? nsObj : interp->emptyObj;
4074 Jim_IncrRefCount(argListObjPtr);
4075 Jim_IncrRefCount(bodyObjPtr);
4076 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
4078 /* Create the statics hash table. */
4079 if (staticsListObjPtr && JimCreateProcedureStatics(interp, cmdPtr, staticsListObjPtr) != JIM_OK) {
4080 goto err;
4083 /* Parse the args out into arglist, validating as we go */
4084 /* Examine the argument list for default parameters and 'args' */
4085 for (i = 0; i < argListLen; i++) {
4086 Jim_Obj *argPtr;
4087 Jim_Obj *nameObjPtr;
4088 Jim_Obj *defaultObjPtr;
4089 int len;
4091 /* Examine a parameter */
4092 argPtr = Jim_ListGetIndex(interp, argListObjPtr, i);
4093 len = Jim_ListLength(interp, argPtr);
4094 if (len == 0) {
4095 Jim_SetResultString(interp, "argument with no name", -1);
4096 err:
4097 JimDecrCmdRefCount(interp, cmdPtr);
4098 return NULL;
4100 if (len > 2) {
4101 Jim_SetResultFormatted(interp, "too many fields in argument specifier \"%#s\"", argPtr);
4102 goto err;
4105 if (len == 2) {
4106 /* Optional parameter */
4107 nameObjPtr = Jim_ListGetIndex(interp, argPtr, 0);
4108 defaultObjPtr = Jim_ListGetIndex(interp, argPtr, 1);
4110 else {
4111 /* Required parameter */
4112 nameObjPtr = argPtr;
4113 defaultObjPtr = NULL;
4117 if (Jim_CompareStringImmediate(interp, nameObjPtr, "args")) {
4118 if (cmdPtr->u.proc.argsPos >= 0) {
4119 Jim_SetResultString(interp, "'args' specified more than once", -1);
4120 goto err;
4122 cmdPtr->u.proc.argsPos = i;
4124 else {
4125 if (len == 2) {
4126 cmdPtr->u.proc.optArity++;
4128 else {
4129 cmdPtr->u.proc.reqArity++;
4133 cmdPtr->u.proc.arglist[i].nameObjPtr = nameObjPtr;
4134 cmdPtr->u.proc.arglist[i].defaultObjPtr = defaultObjPtr;
4137 return cmdPtr;
4140 int Jim_DeleteCommand(Jim_Interp *interp, const char *name)
4142 int ret = JIM_OK;
4143 Jim_Obj *qualifiedNameObj;
4144 const char *qualname = JimQualifyName(interp, name, &qualifiedNameObj);
4146 if (Jim_DeleteHashEntry(&interp->commands, qualname) == JIM_ERR) {
4147 Jim_SetResultFormatted(interp, "can't delete \"%s\": command doesn't exist", name);
4148 ret = JIM_ERR;
4150 else {
4151 Jim_InterpIncrProcEpoch(interp);
4154 JimFreeQualifiedName(interp, qualifiedNameObj);
4156 return ret;
4159 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName, const char *newName)
4161 int ret = JIM_ERR;
4162 Jim_HashEntry *he;
4163 Jim_Cmd *cmdPtr;
4164 Jim_Obj *qualifiedOldNameObj;
4165 Jim_Obj *qualifiedNewNameObj;
4166 const char *fqold;
4167 const char *fqnew;
4169 if (newName[0] == 0) {
4170 return Jim_DeleteCommand(interp, oldName);
4173 fqold = JimQualifyName(interp, oldName, &qualifiedOldNameObj);
4174 fqnew = JimQualifyName(interp, newName, &qualifiedNewNameObj);
4176 /* Does it exist? */
4177 he = Jim_FindHashEntry(&interp->commands, fqold);
4178 if (he == NULL) {
4179 Jim_SetResultFormatted(interp, "can't rename \"%s\": command doesn't exist", oldName);
4181 else if (Jim_FindHashEntry(&interp->commands, fqnew)) {
4182 Jim_SetResultFormatted(interp, "can't rename to \"%s\": command already exists", newName);
4184 else {
4185 /* Add the new name first */
4186 cmdPtr = Jim_GetHashEntryVal(he);
4187 JimIncrCmdRefCount(cmdPtr);
4188 JimUpdateProcNamespace(interp, cmdPtr, fqnew);
4189 Jim_AddHashEntry(&interp->commands, fqnew, cmdPtr);
4191 /* Now remove the old name */
4192 Jim_DeleteHashEntry(&interp->commands, fqold);
4194 /* Increment the epoch */
4195 Jim_InterpIncrProcEpoch(interp);
4197 ret = JIM_OK;
4200 JimFreeQualifiedName(interp, qualifiedOldNameObj);
4201 JimFreeQualifiedName(interp, qualifiedNewNameObj);
4203 return ret;
4206 /* -----------------------------------------------------------------------------
4207 * Command object
4208 * ---------------------------------------------------------------------------*/
4210 static void FreeCommandInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4212 Jim_DecrRefCount(interp, objPtr->internalRep.cmdValue.nsObj);
4215 static void DupCommandInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4217 dupPtr->internalRep.cmdValue = srcPtr->internalRep.cmdValue;
4218 dupPtr->typePtr = srcPtr->typePtr;
4219 Jim_IncrRefCount(dupPtr->internalRep.cmdValue.nsObj);
4222 static const Jim_ObjType commandObjType = {
4223 "command",
4224 FreeCommandInternalRep,
4225 DupCommandInternalRep,
4226 NULL,
4227 JIM_TYPE_REFERENCES,
4230 /* This function returns the command structure for the command name
4231 * stored in objPtr. It specializes the objPtr to contain
4232 * cached info instead of performing the lookup into the hash table
4233 * every time. The information cached may not be up-to-date, in this
4234 * case the lookup is performed and the cache updated.
4236 * Respects the 'upcall' setting.
4238 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4240 Jim_Cmd *cmd;
4242 /* In order to be valid, the proc epoch must match and
4243 * the lookup must have occurred in the same namespace
4245 if (objPtr->typePtr != &commandObjType ||
4246 objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch
4247 #ifdef jim_ext_namespace
4248 || !Jim_StringEqObj(objPtr->internalRep.cmdValue.nsObj, interp->framePtr->nsObj)
4249 #endif
4251 /* Not cached or out of date, so lookup */
4253 /* Do we need to try the local namespace? */
4254 const char *name = Jim_String(objPtr);
4255 Jim_HashEntry *he;
4257 if (name[0] == ':' && name[1] == ':') {
4258 while (*++name == ':') {
4261 #ifdef jim_ext_namespace
4262 else if (Jim_Length(interp->framePtr->nsObj)) {
4263 /* This command is being defined in a non-global namespace */
4264 Jim_Obj *nameObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
4265 Jim_AppendStrings(interp, nameObj, "::", name, NULL);
4266 he = Jim_FindHashEntry(&interp->commands, Jim_String(nameObj));
4267 Jim_FreeNewObj(interp, nameObj);
4268 if (he) {
4269 goto found;
4272 #endif
4274 /* Lookup in the global namespace */
4275 he = Jim_FindHashEntry(&interp->commands, name);
4276 if (he == NULL) {
4277 if (flags & JIM_ERRMSG) {
4278 Jim_SetResultFormatted(interp, "invalid command name \"%#s\"", objPtr);
4280 return NULL;
4282 #ifdef jim_ext_namespace
4283 found:
4284 #endif
4285 cmd = Jim_GetHashEntryVal(he);
4287 /* Free the old internal rep and set the new one. */
4288 Jim_FreeIntRep(interp, objPtr);
4289 objPtr->typePtr = &commandObjType;
4290 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
4291 objPtr->internalRep.cmdValue.cmdPtr = cmd;
4292 objPtr->internalRep.cmdValue.nsObj = interp->framePtr->nsObj;
4293 Jim_IncrRefCount(interp->framePtr->nsObj);
4295 else {
4296 cmd = objPtr->internalRep.cmdValue.cmdPtr;
4298 while (cmd->u.proc.upcall) {
4299 cmd = cmd->prevCmd;
4301 return cmd;
4304 /* -----------------------------------------------------------------------------
4305 * Variables
4306 * ---------------------------------------------------------------------------*/
4308 /* -----------------------------------------------------------------------------
4309 * Variable object
4310 * ---------------------------------------------------------------------------*/
4312 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
4314 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4316 static const Jim_ObjType variableObjType = {
4317 "variable",
4318 NULL,
4319 NULL,
4320 NULL,
4321 JIM_TYPE_REFERENCES,
4325 * Check that the name does not contain embedded nulls.
4327 * Variable and procedure names are manipulated as null terminated strings, so
4328 * don't allow names with embedded nulls.
4330 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr)
4332 /* Variable names and proc names can't contain embedded nulls */
4333 if (nameObjPtr->typePtr != &variableObjType) {
4334 int len;
4335 const char *str = Jim_GetString(nameObjPtr, &len);
4336 if (memchr(str, '\0', len)) {
4337 Jim_SetResultFormatted(interp, "%s name contains embedded null", type);
4338 return JIM_ERR;
4341 return JIM_OK;
4344 /* This method should be called only by the variable API.
4345 * It returns JIM_OK on success (variable already exists),
4346 * JIM_ERR if it does not exist, JIM_DICT_SUGAR if it's not
4347 * a variable name, but syntax glue for [dict] i.e. the last
4348 * character is ')' */
4349 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
4351 const char *varName;
4352 Jim_CallFrame *framePtr;
4353 Jim_HashEntry *he;
4354 int global;
4355 int len;
4357 /* Check if the object is already an uptodate variable */
4358 if (objPtr->typePtr == &variableObjType) {
4359 framePtr = objPtr->internalRep.varValue.global ? interp->topFramePtr : interp->framePtr;
4360 if (objPtr->internalRep.varValue.callFrameId == framePtr->id) {
4361 /* nothing to do */
4362 return JIM_OK;
4364 /* Need to re-resolve the variable in the updated callframe */
4366 else if (objPtr->typePtr == &dictSubstObjType) {
4367 return JIM_DICT_SUGAR;
4369 else if (JimValidName(interp, "variable", objPtr) != JIM_OK) {
4370 return JIM_ERR;
4374 varName = Jim_GetString(objPtr, &len);
4376 /* Make sure it's not syntax glue to get/set dict. */
4377 if (len && varName[len - 1] == ')' && strchr(varName, '(') != NULL) {
4378 return JIM_DICT_SUGAR;
4381 if (varName[0] == ':' && varName[1] == ':') {
4382 while (*++varName == ':') {
4384 global = 1;
4385 framePtr = interp->topFramePtr;
4387 else {
4388 global = 0;
4389 framePtr = interp->framePtr;
4392 /* Resolve this name in the variables hash table */
4393 he = Jim_FindHashEntry(&framePtr->vars, varName);
4394 if (he == NULL) {
4395 if (!global && framePtr->staticVars) {
4396 /* Try with static vars. */
4397 he = Jim_FindHashEntry(framePtr->staticVars, varName);
4399 if (he == NULL) {
4400 return JIM_ERR;
4404 /* Free the old internal repr and set the new one. */
4405 Jim_FreeIntRep(interp, objPtr);
4406 objPtr->typePtr = &variableObjType;
4407 objPtr->internalRep.varValue.callFrameId = framePtr->id;
4408 objPtr->internalRep.varValue.varPtr = Jim_GetHashEntryVal(he);
4409 objPtr->internalRep.varValue.global = global;
4410 return JIM_OK;
4413 /* -------------------- Variables related functions ------------------------- */
4414 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr, Jim_Obj *valObjPtr);
4415 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr, int flags);
4417 static Jim_Var *JimCreateVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4419 const char *name;
4420 Jim_CallFrame *framePtr;
4421 int global;
4423 /* New variable to create */
4424 Jim_Var *var = Jim_Alloc(sizeof(*var));
4426 var->objPtr = valObjPtr;
4427 Jim_IncrRefCount(valObjPtr);
4428 var->linkFramePtr = NULL;
4430 name = Jim_String(nameObjPtr);
4431 if (name[0] == ':' && name[1] == ':') {
4432 while (*++name == ':') {
4434 framePtr = interp->topFramePtr;
4435 global = 1;
4437 else {
4438 framePtr = interp->framePtr;
4439 global = 0;
4442 /* Insert the new variable */
4443 Jim_AddHashEntry(&framePtr->vars, name, var);
4445 /* Make the object int rep a variable */
4446 Jim_FreeIntRep(interp, nameObjPtr);
4447 nameObjPtr->typePtr = &variableObjType;
4448 nameObjPtr->internalRep.varValue.callFrameId = framePtr->id;
4449 nameObjPtr->internalRep.varValue.varPtr = var;
4450 nameObjPtr->internalRep.varValue.global = global;
4452 return var;
4455 /* For now that's dummy. Variables lookup should be optimized
4456 * in many ways, with caching of lookups, and possibly with
4457 * a table of pre-allocated vars in every CallFrame for local vars.
4458 * All the caching should also have an 'epoch' mechanism similar
4459 * to the one used by Tcl for procedures lookup caching. */
4462 * Set the variable nameObjPtr to value valObjptr.
4464 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4466 int err;
4467 Jim_Var *var;
4469 switch (SetVariableFromAny(interp, nameObjPtr)) {
4470 case JIM_DICT_SUGAR:
4471 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
4473 case JIM_ERR:
4474 if (JimValidName(interp, "variable", nameObjPtr) != JIM_OK) {
4475 return JIM_ERR;
4477 JimCreateVariable(interp, nameObjPtr, valObjPtr);
4478 break;
4480 case JIM_OK:
4481 var = nameObjPtr->internalRep.varValue.varPtr;
4482 if (var->linkFramePtr == NULL) {
4483 Jim_IncrRefCount(valObjPtr);
4484 Jim_DecrRefCount(interp, var->objPtr);
4485 var->objPtr = valObjPtr;
4487 else { /* Else handle the link */
4488 Jim_CallFrame *savedCallFrame;
4490 savedCallFrame = interp->framePtr;
4491 interp->framePtr = var->linkFramePtr;
4492 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
4493 interp->framePtr = savedCallFrame;
4494 if (err != JIM_OK)
4495 return err;
4498 return JIM_OK;
4501 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4503 Jim_Obj *nameObjPtr;
4504 int result;
4506 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4507 Jim_IncrRefCount(nameObjPtr);
4508 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
4509 Jim_DecrRefCount(interp, nameObjPtr);
4510 return result;
4513 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4515 Jim_CallFrame *savedFramePtr;
4516 int result;
4518 savedFramePtr = interp->framePtr;
4519 interp->framePtr = interp->topFramePtr;
4520 result = Jim_SetVariableStr(interp, name, objPtr);
4521 interp->framePtr = savedFramePtr;
4522 return result;
4525 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
4527 Jim_Obj *valObjPtr;
4528 int result;
4530 valObjPtr = Jim_NewStringObj(interp, val, -1);
4531 Jim_IncrRefCount(valObjPtr);
4532 result = Jim_SetVariableStr(interp, name, valObjPtr);
4533 Jim_DecrRefCount(interp, valObjPtr);
4534 return result;
4537 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
4538 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
4540 const char *varName;
4541 const char *targetName;
4542 Jim_CallFrame *framePtr;
4543 Jim_Var *varPtr;
4545 /* Check for an existing variable or link */
4546 switch (SetVariableFromAny(interp, nameObjPtr)) {
4547 case JIM_DICT_SUGAR:
4548 /* XXX: This message seem unnecessarily verbose, but it matches Tcl */
4549 Jim_SetResultFormatted(interp, "bad variable name \"%#s\": upvar won't create a scalar variable that looks like an array element", nameObjPtr);
4550 return JIM_ERR;
4552 case JIM_OK:
4553 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4555 if (varPtr->linkFramePtr == NULL) {
4556 Jim_SetResultFormatted(interp, "variable \"%#s\" already exists", nameObjPtr);
4557 return JIM_ERR;
4560 /* It exists, but is a link, so first delete the link */
4561 varPtr->linkFramePtr = NULL;
4562 break;
4565 /* Resolve the call frames for both variables */
4566 /* XXX: SetVariableFromAny() already did this! */
4567 varName = Jim_String(nameObjPtr);
4569 if (varName[0] == ':' && varName[1] == ':') {
4570 while (*++varName == ':') {
4572 /* Linking a global var does nothing */
4573 framePtr = interp->topFramePtr;
4575 else {
4576 framePtr = interp->framePtr;
4579 targetName = Jim_String(targetNameObjPtr);
4580 if (targetName[0] == ':' && targetName[1] == ':') {
4581 while (*++targetName == ':') {
4583 targetNameObjPtr = Jim_NewStringObj(interp, targetName, -1);
4584 targetCallFrame = interp->topFramePtr;
4586 Jim_IncrRefCount(targetNameObjPtr);
4588 if (framePtr->level < targetCallFrame->level) {
4589 Jim_SetResultFormatted(interp,
4590 "bad variable name \"%#s\": upvar won't create namespace variable that refers to procedure variable",
4591 nameObjPtr);
4592 Jim_DecrRefCount(interp, targetNameObjPtr);
4593 return JIM_ERR;
4596 /* Check for cycles. */
4597 if (framePtr == targetCallFrame) {
4598 Jim_Obj *objPtr = targetNameObjPtr;
4600 /* Cycles are only possible with 'uplevel 0' */
4601 while (1) {
4602 if (strcmp(Jim_String(objPtr), varName) == 0) {
4603 Jim_SetResultString(interp, "can't upvar from variable to itself", -1);
4604 Jim_DecrRefCount(interp, targetNameObjPtr);
4605 return JIM_ERR;
4607 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
4608 break;
4609 varPtr = objPtr->internalRep.varValue.varPtr;
4610 if (varPtr->linkFramePtr != targetCallFrame)
4611 break;
4612 objPtr = varPtr->objPtr;
4616 /* Perform the binding */
4617 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
4618 /* We are now sure 'nameObjPtr' type is variableObjType */
4619 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
4620 Jim_DecrRefCount(interp, targetNameObjPtr);
4621 return JIM_OK;
4624 /* Return the Jim_Obj pointer associated with a variable name,
4625 * or NULL if the variable was not found in the current context.
4626 * The same optimization discussed in the comment to the
4627 * 'SetVariable' function should apply here.
4629 * If JIM_UNSHARED is set and the variable is an array element (dict sugar)
4630 * in a dictionary which is shared, the array variable value is duplicated first.
4631 * This allows the array element to be updated (e.g. append, lappend) without
4632 * affecting other references to the dictionary.
4634 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4636 switch (SetVariableFromAny(interp, nameObjPtr)) {
4637 case JIM_OK:{
4638 Jim_Var *varPtr = nameObjPtr->internalRep.varValue.varPtr;
4640 if (varPtr->linkFramePtr == NULL) {
4641 return varPtr->objPtr;
4643 else {
4644 Jim_Obj *objPtr;
4646 /* The variable is a link? Resolve it. */
4647 Jim_CallFrame *savedCallFrame = interp->framePtr;
4649 interp->framePtr = varPtr->linkFramePtr;
4650 objPtr = Jim_GetVariable(interp, varPtr->objPtr, flags);
4651 interp->framePtr = savedCallFrame;
4652 if (objPtr) {
4653 return objPtr;
4655 /* Error, so fall through to the error message */
4658 break;
4660 case JIM_DICT_SUGAR:
4661 /* [dict] syntax sugar. */
4662 return JimDictSugarGet(interp, nameObjPtr, flags);
4664 if (flags & JIM_ERRMSG) {
4665 Jim_SetResultFormatted(interp, "can't read \"%#s\": no such variable", nameObjPtr);
4667 return NULL;
4670 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4672 Jim_CallFrame *savedFramePtr;
4673 Jim_Obj *objPtr;
4675 savedFramePtr = interp->framePtr;
4676 interp->framePtr = interp->topFramePtr;
4677 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4678 interp->framePtr = savedFramePtr;
4680 return objPtr;
4683 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
4685 Jim_Obj *nameObjPtr, *varObjPtr;
4687 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4688 Jim_IncrRefCount(nameObjPtr);
4689 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4690 Jim_DecrRefCount(interp, nameObjPtr);
4691 return varObjPtr;
4694 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name, int flags)
4696 Jim_CallFrame *savedFramePtr;
4697 Jim_Obj *objPtr;
4699 savedFramePtr = interp->framePtr;
4700 interp->framePtr = interp->topFramePtr;
4701 objPtr = Jim_GetVariableStr(interp, name, flags);
4702 interp->framePtr = savedFramePtr;
4704 return objPtr;
4707 /* Unset a variable.
4708 * Note: On success unset invalidates all the (cached) variable objects
4709 * by incrementing callFrameEpoch
4711 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4713 Jim_Var *varPtr;
4714 int retval;
4715 Jim_CallFrame *framePtr;
4717 retval = SetVariableFromAny(interp, nameObjPtr);
4718 if (retval == JIM_DICT_SUGAR) {
4719 /* [dict] syntax sugar. */
4720 return JimDictSugarSet(interp, nameObjPtr, NULL);
4722 else if (retval == JIM_OK) {
4723 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4725 /* If it's a link call UnsetVariable recursively */
4726 if (varPtr->linkFramePtr) {
4727 framePtr = interp->framePtr;
4728 interp->framePtr = varPtr->linkFramePtr;
4729 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
4730 interp->framePtr = framePtr;
4732 else {
4733 const char *name = Jim_String(nameObjPtr);
4734 if (nameObjPtr->internalRep.varValue.global) {
4735 name += 2;
4736 framePtr = interp->topFramePtr;
4738 else {
4739 framePtr = interp->framePtr;
4742 retval = Jim_DeleteHashEntry(&framePtr->vars, name);
4743 if (retval == JIM_OK) {
4744 /* Change the callframe id, invalidating var lookup caching */
4745 framePtr->id = interp->callFrameEpoch++;
4749 if (retval != JIM_OK && (flags & JIM_ERRMSG)) {
4750 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such variable", nameObjPtr);
4752 return retval;
4755 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
4757 /* Given a variable name for [dict] operation syntax sugar,
4758 * this function returns two objects, the first with the name
4759 * of the variable to set, and the second with the respective key.
4760 * For example "foo(bar)" will return objects with string repr. of
4761 * "foo" and "bar".
4763 * The returned objects have refcount = 1. The function can't fail. */
4764 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
4765 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
4767 const char *str, *p;
4768 int len, keyLen;
4769 Jim_Obj *varObjPtr, *keyObjPtr;
4771 str = Jim_GetString(objPtr, &len);
4773 p = strchr(str, '(');
4774 JimPanic((p == NULL, "JimDictSugarParseVarKey() called for non-dict-sugar (%s)", str));
4776 varObjPtr = Jim_NewStringObj(interp, str, p - str);
4778 p++;
4779 keyLen = (str + len) - p;
4780 if (str[len - 1] == ')') {
4781 keyLen--;
4784 /* Create the objects with the variable name and key. */
4785 keyObjPtr = Jim_NewStringObj(interp, p, keyLen);
4787 Jim_IncrRefCount(varObjPtr);
4788 Jim_IncrRefCount(keyObjPtr);
4789 *varPtrPtr = varObjPtr;
4790 *keyPtrPtr = keyObjPtr;
4793 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
4794 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
4795 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *valObjPtr)
4797 int err;
4799 SetDictSubstFromAny(interp, objPtr);
4801 err = Jim_SetDictKeysVector(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4802 &objPtr->internalRep.dictSubstValue.indexObjPtr, 1, valObjPtr, JIM_MUSTEXIST);
4804 if (err == JIM_OK) {
4805 /* Don't keep an extra ref to the result */
4806 Jim_SetEmptyResult(interp);
4808 else {
4809 if (!valObjPtr) {
4810 /* Better error message for unset a(2) where a exists but a(2) doesn't */
4811 if (Jim_GetVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_NONE)) {
4812 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such element in array",
4813 objPtr);
4814 return err;
4817 /* Make the error more informative and Tcl-compatible */
4818 Jim_SetResultFormatted(interp, "can't %s \"%#s\": variable isn't array",
4819 (valObjPtr ? "set" : "unset"), objPtr);
4821 return err;
4825 * Expands the array variable (dict sugar) and returns the result, or NULL on error.
4827 * If JIM_UNSHARED is set and the dictionary is shared, it will be duplicated
4828 * and stored back to the variable before expansion.
4830 static Jim_Obj *JimDictExpandArrayVariable(Jim_Interp *interp, Jim_Obj *varObjPtr,
4831 Jim_Obj *keyObjPtr, int flags)
4833 Jim_Obj *dictObjPtr;
4834 Jim_Obj *resObjPtr = NULL;
4835 int ret;
4837 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
4838 if (!dictObjPtr) {
4839 return NULL;
4842 ret = Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_NONE);
4843 if (ret != JIM_OK) {
4844 Jim_SetResultFormatted(interp,
4845 "can't read \"%#s(%#s)\": %s array", varObjPtr, keyObjPtr,
4846 ret < 0 ? "variable isn't" : "no such element in");
4848 else if ((flags & JIM_UNSHARED) && Jim_IsShared(dictObjPtr)) {
4849 /* Update the variable to have an unshared copy */
4850 Jim_SetVariable(interp, varObjPtr, Jim_DuplicateObj(interp, dictObjPtr));
4853 return resObjPtr;
4856 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
4857 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4859 SetDictSubstFromAny(interp, objPtr);
4861 return JimDictExpandArrayVariable(interp,
4862 objPtr->internalRep.dictSubstValue.varNameObjPtr,
4863 objPtr->internalRep.dictSubstValue.indexObjPtr, flags);
4866 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
4868 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4870 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
4871 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
4874 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4876 /* Copy the internal rep */
4877 dupPtr->internalRep = srcPtr->internalRep;
4878 /* Need to increment the ref counts */
4879 Jim_IncrRefCount(dupPtr->internalRep.dictSubstValue.varNameObjPtr);
4880 Jim_IncrRefCount(dupPtr->internalRep.dictSubstValue.indexObjPtr);
4883 /* Note: The object *must* be in dict-sugar format */
4884 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4886 if (objPtr->typePtr != &dictSubstObjType) {
4887 Jim_Obj *varObjPtr, *keyObjPtr;
4889 if (objPtr->typePtr == &interpolatedObjType) {
4890 /* An interpolated object in dict-sugar form */
4892 varObjPtr = objPtr->internalRep.dictSubstValue.varNameObjPtr;
4893 keyObjPtr = objPtr->internalRep.dictSubstValue.indexObjPtr;
4895 Jim_IncrRefCount(varObjPtr);
4896 Jim_IncrRefCount(keyObjPtr);
4898 else {
4899 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
4902 Jim_FreeIntRep(interp, objPtr);
4903 objPtr->typePtr = &dictSubstObjType;
4904 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
4905 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
4909 /* This function is used to expand [dict get] sugar in the form
4910 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
4911 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
4912 * object that is *guaranteed* to be in the form VARNAME(INDEX).
4913 * The 'index' part is [subst]ituted, and is used to lookup a key inside
4914 * the [dict]ionary contained in variable VARNAME. */
4915 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4917 Jim_Obj *resObjPtr = NULL;
4918 Jim_Obj *substKeyObjPtr = NULL;
4920 SetDictSubstFromAny(interp, objPtr);
4922 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
4923 &substKeyObjPtr, JIM_NONE)
4924 != JIM_OK) {
4925 return NULL;
4927 Jim_IncrRefCount(substKeyObjPtr);
4928 resObjPtr =
4929 JimDictExpandArrayVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4930 substKeyObjPtr, 0);
4931 Jim_DecrRefCount(interp, substKeyObjPtr);
4933 return resObjPtr;
4936 static Jim_Obj *JimExpandExprSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4938 if (Jim_EvalExpression(interp, objPtr) == JIM_OK) {
4939 return Jim_GetResult(interp);
4941 return NULL;
4944 /* -----------------------------------------------------------------------------
4945 * CallFrame
4946 * ---------------------------------------------------------------------------*/
4948 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp, Jim_CallFrame *parent, Jim_Obj *nsObj)
4950 Jim_CallFrame *cf;
4952 if (interp->freeFramesList) {
4953 cf = interp->freeFramesList;
4954 interp->freeFramesList = cf->next;
4956 cf->argv = NULL;
4957 cf->argc = 0;
4958 cf->procArgsObjPtr = NULL;
4959 cf->procBodyObjPtr = NULL;
4960 cf->next = NULL;
4961 cf->staticVars = NULL;
4962 cf->localCommands = NULL;
4963 cf->tailcallObj = NULL;
4964 cf->tailcallCmd = NULL;
4966 else {
4967 cf = Jim_Alloc(sizeof(*cf));
4968 memset(cf, 0, sizeof(*cf));
4970 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
4973 cf->id = interp->callFrameEpoch++;
4974 cf->parent = parent;
4975 cf->level = parent ? parent->level + 1 : 0;
4976 cf->nsObj = nsObj;
4977 Jim_IncrRefCount(nsObj);
4979 return cf;
4982 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands)
4984 /* Delete any local procs */
4985 if (localCommands) {
4986 Jim_Obj *cmdNameObj;
4988 while ((cmdNameObj = Jim_StackPop(localCommands)) != NULL) {
4989 Jim_HashEntry *he;
4990 Jim_Obj *fqObjName;
4991 Jim_HashTable *ht = &interp->commands;
4993 const char *fqname = JimQualifyName(interp, Jim_String(cmdNameObj), &fqObjName);
4995 he = Jim_FindHashEntry(ht, fqname);
4997 if (he) {
4998 Jim_Cmd *cmd = Jim_GetHashEntryVal(he);
4999 if (cmd->prevCmd) {
5000 Jim_Cmd *prevCmd = cmd->prevCmd;
5001 cmd->prevCmd = NULL;
5003 /* Delete the old command */
5004 JimDecrCmdRefCount(interp, cmd);
5006 /* And restore the original */
5007 Jim_SetHashVal(ht, he, prevCmd);
5009 else {
5010 Jim_DeleteHashEntry(ht, fqname);
5012 Jim_InterpIncrProcEpoch(interp);
5014 Jim_DecrRefCount(interp, cmdNameObj);
5015 JimFreeQualifiedName(interp, fqObjName);
5017 Jim_FreeStack(localCommands);
5018 Jim_Free(localCommands);
5020 return JIM_OK;
5024 * Run any $jim::defer scripts for the current call frame.
5026 * retcode is the return code from the current proc.
5028 * Returns the new return code.
5030 static int JimInvokeDefer(Jim_Interp *interp, int retcode)
5032 Jim_Obj *objPtr;
5034 /* Fast check for the likely case that the variable doesn't exist */
5035 if (Jim_FindHashEntry(&interp->framePtr->vars, "jim::defer") == NULL) {
5036 return retcode;
5039 objPtr = Jim_GetVariableStr(interp, "jim::defer", JIM_NONE);
5041 if (objPtr) {
5042 int ret = JIM_OK;
5043 int i;
5044 int listLen = Jim_ListLength(interp, objPtr);
5045 Jim_Obj *resultObjPtr;
5047 Jim_IncrRefCount(objPtr);
5049 /* Need to save away the current interp result and
5050 * restore it if appropriate
5052 resultObjPtr = Jim_GetResult(interp);
5053 Jim_IncrRefCount(resultObjPtr);
5054 Jim_SetEmptyResult(interp);
5056 /* Invoke in reverse order */
5057 for (i = listLen; i > 0; i--) {
5058 /* If a defer script returns an error, don't evaluate remaining scripts */
5059 Jim_Obj *scriptObjPtr = Jim_ListGetIndex(interp, objPtr, i - 1);
5060 ret = Jim_EvalObj(interp, scriptObjPtr);
5061 if (ret != JIM_OK) {
5062 break;
5066 if (ret == JIM_OK || retcode == JIM_ERR) {
5067 /* defer script had no error, or proc had an error so restore proc result */
5068 Jim_SetResult(interp, resultObjPtr);
5070 else {
5071 retcode = ret;
5074 Jim_DecrRefCount(interp, resultObjPtr);
5075 Jim_DecrRefCount(interp, objPtr);
5077 return retcode;
5080 #define JIM_FCF_FULL 0 /* Always free the vars hash table */
5081 #define JIM_FCF_REUSE 1 /* Reuse the vars hash table if possible */
5082 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action)
5084 JimDeleteLocalProcs(interp, cf->localCommands);
5086 if (cf->procArgsObjPtr)
5087 Jim_DecrRefCount(interp, cf->procArgsObjPtr);
5088 if (cf->procBodyObjPtr)
5089 Jim_DecrRefCount(interp, cf->procBodyObjPtr);
5090 Jim_DecrRefCount(interp, cf->nsObj);
5091 if (action == JIM_FCF_FULL || cf->vars.size != JIM_HT_INITIAL_SIZE)
5092 Jim_FreeHashTable(&cf->vars);
5093 else {
5094 int i;
5095 Jim_HashEntry **table = cf->vars.table, *he;
5097 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
5098 he = table[i];
5099 while (he != NULL) {
5100 Jim_HashEntry *nextEntry = he->next;
5101 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
5103 Jim_DecrRefCount(interp, varPtr->objPtr);
5104 Jim_Free(Jim_GetHashEntryKey(he));
5105 Jim_Free(varPtr);
5106 Jim_Free(he);
5107 table[i] = NULL;
5108 he = nextEntry;
5111 cf->vars.used = 0;
5113 cf->next = interp->freeFramesList;
5114 interp->freeFramesList = cf;
5118 /* -----------------------------------------------------------------------------
5119 * References
5120 * ---------------------------------------------------------------------------*/
5121 #if defined(JIM_REFERENCES) && !defined(JIM_BOOTSTRAP)
5123 /* References HashTable Type.
5125 * Keys are unsigned long integers, dynamically allocated for now but in the
5126 * future it's worth to cache this 4 bytes objects. Values are pointers
5127 * to Jim_References. */
5128 static void JimReferencesHTValDestructor(void *interp, void *val)
5130 Jim_Reference *refPtr = (void *)val;
5132 Jim_DecrRefCount(interp, refPtr->objPtr);
5133 if (refPtr->finalizerCmdNamePtr != NULL) {
5134 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5136 Jim_Free(val);
5139 static unsigned int JimReferencesHTHashFunction(const void *key)
5141 /* Only the least significant bits are used. */
5142 const unsigned long *widePtr = key;
5143 unsigned int intValue = (unsigned int)*widePtr;
5145 return Jim_IntHashFunction(intValue);
5148 static void *JimReferencesHTKeyDup(void *privdata, const void *key)
5150 void *copy = Jim_Alloc(sizeof(unsigned long));
5152 JIM_NOTUSED(privdata);
5154 memcpy(copy, key, sizeof(unsigned long));
5155 return copy;
5158 static int JimReferencesHTKeyCompare(void *privdata, const void *key1, const void *key2)
5160 JIM_NOTUSED(privdata);
5162 return memcmp(key1, key2, sizeof(unsigned long)) == 0;
5165 static void JimReferencesHTKeyDestructor(void *privdata, void *key)
5167 JIM_NOTUSED(privdata);
5169 Jim_Free(key);
5172 static const Jim_HashTableType JimReferencesHashTableType = {
5173 JimReferencesHTHashFunction, /* hash function */
5174 JimReferencesHTKeyDup, /* key dup */
5175 NULL, /* val dup */
5176 JimReferencesHTKeyCompare, /* key compare */
5177 JimReferencesHTKeyDestructor, /* key destructor */
5178 JimReferencesHTValDestructor /* val destructor */
5181 /* -----------------------------------------------------------------------------
5182 * Reference object type and References API
5183 * ---------------------------------------------------------------------------*/
5185 /* The string representation of references has two features in order
5186 * to make the GC faster. The first is that every reference starts
5187 * with a non common character '<', in order to make the string matching
5188 * faster. The second is that the reference string rep is 42 characters
5189 * in length, this means that it is not necessary to check any object with a string
5190 * repr < 42, and usually there aren't many of these objects. */
5192 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
5194 static int JimFormatReference(char *buf, Jim_Reference *refPtr, unsigned long id)
5196 const char *fmt = "<reference.<%s>.%020lu>";
5198 sprintf(buf, fmt, refPtr->tag, id);
5199 return JIM_REFERENCE_SPACE;
5202 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
5204 static const Jim_ObjType referenceObjType = {
5205 "reference",
5206 NULL,
5207 NULL,
5208 UpdateStringOfReference,
5209 JIM_TYPE_REFERENCES,
5212 static void UpdateStringOfReference(struct Jim_Obj *objPtr)
5214 char buf[JIM_REFERENCE_SPACE + 1];
5216 JimFormatReference(buf, objPtr->internalRep.refValue.refPtr, objPtr->internalRep.refValue.id);
5217 JimSetStringBytes(objPtr, buf);
5220 /* returns true if 'c' is a valid reference tag character.
5221 * i.e. inside the range [_a-zA-Z0-9] */
5222 static int isrefchar(int c)
5224 return (c == '_' || isalnum(c));
5227 static int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5229 unsigned long value;
5230 int i, len;
5231 const char *str, *start, *end;
5232 char refId[21];
5233 Jim_Reference *refPtr;
5234 Jim_HashEntry *he;
5235 char *endptr;
5237 /* Get the string representation */
5238 str = Jim_GetString(objPtr, &len);
5239 /* Check if it looks like a reference */
5240 if (len < JIM_REFERENCE_SPACE)
5241 goto badformat;
5242 /* Trim spaces */
5243 start = str;
5244 end = str + len - 1;
5245 while (*start == ' ')
5246 start++;
5247 while (*end == ' ' && end > start)
5248 end--;
5249 if (end - start + 1 != JIM_REFERENCE_SPACE)
5250 goto badformat;
5251 /* <reference.<1234567>.%020> */
5252 if (memcmp(start, "<reference.<", 12) != 0)
5253 goto badformat;
5254 if (start[12 + JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>')
5255 goto badformat;
5256 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
5257 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5258 if (!isrefchar(start[12 + i]))
5259 goto badformat;
5261 /* Extract info from the reference. */
5262 memcpy(refId, start + 14 + JIM_REFERENCE_TAGLEN, 20);
5263 refId[20] = '\0';
5264 /* Try to convert the ID into an unsigned long */
5265 value = strtoul(refId, &endptr, 10);
5266 if (JimCheckConversion(refId, endptr) != JIM_OK)
5267 goto badformat;
5268 /* Check if the reference really exists! */
5269 he = Jim_FindHashEntry(&interp->references, &value);
5270 if (he == NULL) {
5271 Jim_SetResultFormatted(interp, "invalid reference id \"%#s\"", objPtr);
5272 return JIM_ERR;
5274 refPtr = Jim_GetHashEntryVal(he);
5275 /* Free the old internal repr and set the new one. */
5276 Jim_FreeIntRep(interp, objPtr);
5277 objPtr->typePtr = &referenceObjType;
5278 objPtr->internalRep.refValue.id = value;
5279 objPtr->internalRep.refValue.refPtr = refPtr;
5280 return JIM_OK;
5282 badformat:
5283 Jim_SetResultFormatted(interp, "expected reference but got \"%#s\"", objPtr);
5284 return JIM_ERR;
5287 /* Returns a new reference pointing to objPtr, having cmdNamePtr
5288 * as finalizer command (or NULL if there is no finalizer).
5289 * The returned reference object has refcount = 0. */
5290 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr, Jim_Obj *cmdNamePtr)
5292 struct Jim_Reference *refPtr;
5293 unsigned long id;
5294 Jim_Obj *refObjPtr;
5295 const char *tag;
5296 int tagLen, i;
5298 /* Perform the Garbage Collection if needed. */
5299 Jim_CollectIfNeeded(interp);
5301 refPtr = Jim_Alloc(sizeof(*refPtr));
5302 refPtr->objPtr = objPtr;
5303 Jim_IncrRefCount(objPtr);
5304 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5305 if (cmdNamePtr)
5306 Jim_IncrRefCount(cmdNamePtr);
5307 id = interp->referenceNextId++;
5308 Jim_AddHashEntry(&interp->references, &id, refPtr);
5309 refObjPtr = Jim_NewObj(interp);
5310 refObjPtr->typePtr = &referenceObjType;
5311 refObjPtr->bytes = NULL;
5312 refObjPtr->internalRep.refValue.id = id;
5313 refObjPtr->internalRep.refValue.refPtr = refPtr;
5314 interp->referenceNextId++;
5315 /* Set the tag. Trimmed at JIM_REFERENCE_TAGLEN. Everything
5316 * that does not pass the 'isrefchar' test is replaced with '_' */
5317 tag = Jim_GetString(tagPtr, &tagLen);
5318 if (tagLen > JIM_REFERENCE_TAGLEN)
5319 tagLen = JIM_REFERENCE_TAGLEN;
5320 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5321 if (i < tagLen && isrefchar(tag[i]))
5322 refPtr->tag[i] = tag[i];
5323 else
5324 refPtr->tag[i] = '_';
5326 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
5327 return refObjPtr;
5330 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
5332 if (objPtr->typePtr != &referenceObjType && SetReferenceFromAny(interp, objPtr) == JIM_ERR)
5333 return NULL;
5334 return objPtr->internalRep.refValue.refPtr;
5337 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
5339 Jim_Reference *refPtr;
5341 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5342 return JIM_ERR;
5343 Jim_IncrRefCount(cmdNamePtr);
5344 if (refPtr->finalizerCmdNamePtr)
5345 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5346 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5347 return JIM_OK;
5350 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
5352 Jim_Reference *refPtr;
5354 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5355 return JIM_ERR;
5356 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
5357 return JIM_OK;
5360 /* -----------------------------------------------------------------------------
5361 * References Garbage Collection
5362 * ---------------------------------------------------------------------------*/
5364 /* This the hash table type for the "MARK" phase of the GC */
5365 static const Jim_HashTableType JimRefMarkHashTableType = {
5366 JimReferencesHTHashFunction, /* hash function */
5367 JimReferencesHTKeyDup, /* key dup */
5368 NULL, /* val dup */
5369 JimReferencesHTKeyCompare, /* key compare */
5370 JimReferencesHTKeyDestructor, /* key destructor */
5371 NULL /* val destructor */
5374 /* Performs the garbage collection. */
5375 int Jim_Collect(Jim_Interp *interp)
5377 int collected = 0;
5378 Jim_HashTable marks;
5379 Jim_HashTableIterator htiter;
5380 Jim_HashEntry *he;
5381 Jim_Obj *objPtr;
5383 /* Avoid recursive calls */
5384 if (interp->lastCollectId == (unsigned long)~0) {
5385 /* Jim_Collect() already running. Return just now. */
5386 return 0;
5388 interp->lastCollectId = ~0;
5390 /* Mark all the references found into the 'mark' hash table.
5391 * The references are searched in every live object that
5392 * is of a type that can contain references. */
5393 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
5394 objPtr = interp->liveList;
5395 while (objPtr) {
5396 if (objPtr->typePtr == NULL || objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
5397 const char *str, *p;
5398 int len;
5400 /* If the object is of type reference, to get the
5401 * Id is simple... */
5402 if (objPtr->typePtr == &referenceObjType) {
5403 Jim_AddHashEntry(&marks, &objPtr->internalRep.refValue.id, NULL);
5404 #ifdef JIM_DEBUG_GC
5405 printf("MARK (reference): %d refcount: %d\n",
5406 (int)objPtr->internalRep.refValue.id, objPtr->refCount);
5407 #endif
5408 objPtr = objPtr->nextObjPtr;
5409 continue;
5411 /* Get the string repr of the object we want
5412 * to scan for references. */
5413 p = str = Jim_GetString(objPtr, &len);
5414 /* Skip objects too little to contain references. */
5415 if (len < JIM_REFERENCE_SPACE) {
5416 objPtr = objPtr->nextObjPtr;
5417 continue;
5419 /* Extract references from the object string repr. */
5420 while (1) {
5421 int i;
5422 unsigned long id;
5424 if ((p = strstr(p, "<reference.<")) == NULL)
5425 break;
5426 /* Check if it's a valid reference. */
5427 if (len - (p - str) < JIM_REFERENCE_SPACE)
5428 break;
5429 if (p[41] != '>' || p[19] != '>' || p[20] != '.')
5430 break;
5431 for (i = 21; i <= 40; i++)
5432 if (!isdigit(UCHAR(p[i])))
5433 break;
5434 /* Get the ID */
5435 id = strtoul(p + 21, NULL, 10);
5437 /* Ok, a reference for the given ID
5438 * was found. Mark it. */
5439 Jim_AddHashEntry(&marks, &id, NULL);
5440 #ifdef JIM_DEBUG_GC
5441 printf("MARK: %d\n", (int)id);
5442 #endif
5443 p += JIM_REFERENCE_SPACE;
5446 objPtr = objPtr->nextObjPtr;
5449 /* Run the references hash table to destroy every reference that
5450 * is not referenced outside (not present in the mark HT). */
5451 JimInitHashTableIterator(&interp->references, &htiter);
5452 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
5453 const unsigned long *refId;
5454 Jim_Reference *refPtr;
5456 refId = he->key;
5457 /* Check if in the mark phase we encountered
5458 * this reference. */
5459 if (Jim_FindHashEntry(&marks, refId) == NULL) {
5460 #ifdef JIM_DEBUG_GC
5461 printf("COLLECTING %d\n", (int)*refId);
5462 #endif
5463 collected++;
5464 /* Drop the reference, but call the
5465 * finalizer first if registered. */
5466 refPtr = Jim_GetHashEntryVal(he);
5467 if (refPtr->finalizerCmdNamePtr) {
5468 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE + 1);
5469 Jim_Obj *objv[3], *oldResult;
5471 JimFormatReference(refstr, refPtr, *refId);
5473 objv[0] = refPtr->finalizerCmdNamePtr;
5474 objv[1] = Jim_NewStringObjNoAlloc(interp, refstr, JIM_REFERENCE_SPACE);
5475 objv[2] = refPtr->objPtr;
5477 /* Drop the reference itself */
5478 /* Avoid the finaliser being freed here */
5479 Jim_IncrRefCount(objv[0]);
5480 /* Don't remove the reference from the hash table just yet
5481 * since that will free refPtr, and hence refPtr->objPtr
5484 /* Call the finalizer. Errors ignored. (should we use bgerror?) */
5485 oldResult = interp->result;
5486 Jim_IncrRefCount(oldResult);
5487 Jim_EvalObjVector(interp, 3, objv);
5488 Jim_SetResult(interp, oldResult);
5489 Jim_DecrRefCount(interp, oldResult);
5491 Jim_DecrRefCount(interp, objv[0]);
5493 Jim_DeleteHashEntry(&interp->references, refId);
5496 Jim_FreeHashTable(&marks);
5497 interp->lastCollectId = interp->referenceNextId;
5498 interp->lastCollectTime = time(NULL);
5499 return collected;
5502 #define JIM_COLLECT_ID_PERIOD 5000
5503 #define JIM_COLLECT_TIME_PERIOD 300
5505 void Jim_CollectIfNeeded(Jim_Interp *interp)
5507 unsigned long elapsedId;
5508 int elapsedTime;
5510 elapsedId = interp->referenceNextId - interp->lastCollectId;
5511 elapsedTime = time(NULL) - interp->lastCollectTime;
5514 if (elapsedId > JIM_COLLECT_ID_PERIOD || elapsedTime > JIM_COLLECT_TIME_PERIOD) {
5515 Jim_Collect(interp);
5518 #endif /* JIM_REFERENCES && !JIM_BOOTSTRAP */
5520 int Jim_IsBigEndian(void)
5522 union {
5523 unsigned short s;
5524 unsigned char c[2];
5525 } uval = {0x0102};
5527 return uval.c[0] == 1;
5530 /* -----------------------------------------------------------------------------
5531 * Interpreter related functions
5532 * ---------------------------------------------------------------------------*/
5534 Jim_Interp *Jim_CreateInterp(void)
5536 Jim_Interp *i = Jim_Alloc(sizeof(*i));
5538 memset(i, 0, sizeof(*i));
5540 i->maxCallFrameDepth = JIM_MAX_CALLFRAME_DEPTH;
5541 i->maxEvalDepth = JIM_MAX_EVAL_DEPTH;
5542 i->lastCollectTime = time(NULL);
5544 /* Note that we can create objects only after the
5545 * interpreter liveList and freeList pointers are
5546 * initialized to NULL. */
5547 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
5548 #ifdef JIM_REFERENCES
5549 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
5550 #endif
5551 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
5552 Jim_InitHashTable(&i->packages, &JimPackageHashTableType, NULL);
5553 i->emptyObj = Jim_NewEmptyStringObj(i);
5554 i->trueObj = Jim_NewIntObj(i, 1);
5555 i->falseObj = Jim_NewIntObj(i, 0);
5556 i->framePtr = i->topFramePtr = JimCreateCallFrame(i, NULL, i->emptyObj);
5557 i->errorFileNameObj = i->emptyObj;
5558 i->result = i->emptyObj;
5559 i->stackTrace = Jim_NewListObj(i, NULL, 0);
5560 i->unknown = Jim_NewStringObj(i, "unknown", -1);
5561 i->errorProc = i->emptyObj;
5562 i->currentScriptObj = Jim_NewEmptyStringObj(i);
5563 i->nullScriptObj = Jim_NewEmptyStringObj(i);
5564 Jim_IncrRefCount(i->emptyObj);
5565 Jim_IncrRefCount(i->errorFileNameObj);
5566 Jim_IncrRefCount(i->result);
5567 Jim_IncrRefCount(i->stackTrace);
5568 Jim_IncrRefCount(i->unknown);
5569 Jim_IncrRefCount(i->currentScriptObj);
5570 Jim_IncrRefCount(i->nullScriptObj);
5571 Jim_IncrRefCount(i->errorProc);
5572 Jim_IncrRefCount(i->trueObj);
5573 Jim_IncrRefCount(i->falseObj);
5575 /* Initialize key variables every interpreter should contain */
5576 Jim_SetVariableStrWithStr(i, JIM_LIBPATH, TCL_LIBRARY);
5577 Jim_SetVariableStrWithStr(i, JIM_INTERACTIVE, "0");
5579 Jim_SetVariableStrWithStr(i, "tcl_platform(engine)", "Jim");
5580 Jim_SetVariableStrWithStr(i, "tcl_platform(os)", TCL_PLATFORM_OS);
5581 Jim_SetVariableStrWithStr(i, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM);
5582 Jim_SetVariableStrWithStr(i, "tcl_platform(pathSeparator)", TCL_PLATFORM_PATH_SEPARATOR);
5583 Jim_SetVariableStrWithStr(i, "tcl_platform(byteOrder)", Jim_IsBigEndian() ? "bigEndian" : "littleEndian");
5584 Jim_SetVariableStrWithStr(i, "tcl_platform(threaded)", "0");
5585 Jim_SetVariableStr(i, "tcl_platform(pointerSize)", Jim_NewIntObj(i, sizeof(void *)));
5586 Jim_SetVariableStr(i, "tcl_platform(wordSize)", Jim_NewIntObj(i, sizeof(jim_wide)));
5588 return i;
5591 void Jim_FreeInterp(Jim_Interp *i)
5593 Jim_CallFrame *cf, *cfx;
5595 Jim_Obj *objPtr, *nextObjPtr;
5597 /* Free the active call frames list - must be done before i->commands is destroyed */
5598 for (cf = i->framePtr; cf; cf = cfx) {
5599 /* Note that we ignore any errors */
5600 JimInvokeDefer(i, JIM_OK);
5601 cfx = cf->parent;
5602 JimFreeCallFrame(i, cf, JIM_FCF_FULL);
5605 Jim_DecrRefCount(i, i->emptyObj);
5606 Jim_DecrRefCount(i, i->trueObj);
5607 Jim_DecrRefCount(i, i->falseObj);
5608 Jim_DecrRefCount(i, i->result);
5609 Jim_DecrRefCount(i, i->stackTrace);
5610 Jim_DecrRefCount(i, i->errorProc);
5611 Jim_DecrRefCount(i, i->unknown);
5612 Jim_DecrRefCount(i, i->errorFileNameObj);
5613 Jim_DecrRefCount(i, i->currentScriptObj);
5614 Jim_DecrRefCount(i, i->nullScriptObj);
5615 Jim_FreeHashTable(&i->commands);
5616 #ifdef JIM_REFERENCES
5617 Jim_FreeHashTable(&i->references);
5618 #endif
5619 Jim_FreeHashTable(&i->packages);
5620 Jim_Free(i->prngState);
5621 Jim_FreeHashTable(&i->assocData);
5623 /* Check that the live object list is empty, otherwise
5624 * there is a memory leak. */
5625 #ifdef JIM_MAINTAINER
5626 if (i->liveList != NULL) {
5627 objPtr = i->liveList;
5629 printf("\n-------------------------------------\n");
5630 printf("Objects still in the free list:\n");
5631 while (objPtr) {
5632 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "string";
5633 Jim_String(objPtr);
5635 if (objPtr->bytes && strlen(objPtr->bytes) > 20) {
5636 printf("%p (%d) %-10s: '%.20s...'\n",
5637 (void *)objPtr, objPtr->refCount, type, objPtr->bytes);
5639 else {
5640 printf("%p (%d) %-10s: '%s'\n",
5641 (void *)objPtr, objPtr->refCount, type, objPtr->bytes ? objPtr->bytes : "(null)");
5643 if (objPtr->typePtr == &sourceObjType) {
5644 printf("FILE %s LINE %d\n",
5645 Jim_String(objPtr->internalRep.sourceValue.fileNameObj),
5646 objPtr->internalRep.sourceValue.lineNumber);
5648 objPtr = objPtr->nextObjPtr;
5650 printf("-------------------------------------\n\n");
5651 JimPanic((1, "Live list non empty freeing the interpreter! Leak?"));
5653 #endif
5655 /* Free all the freed objects. */
5656 objPtr = i->freeList;
5657 while (objPtr) {
5658 nextObjPtr = objPtr->nextObjPtr;
5659 Jim_Free(objPtr);
5660 objPtr = nextObjPtr;
5663 /* Free the free call frames list */
5664 for (cf = i->freeFramesList; cf; cf = cfx) {
5665 cfx = cf->next;
5666 if (cf->vars.table)
5667 Jim_FreeHashTable(&cf->vars);
5668 Jim_Free(cf);
5671 /* Free the interpreter structure. */
5672 Jim_Free(i);
5675 /* Returns the call frame relative to the level represented by
5676 * levelObjPtr. If levelObjPtr == NULL, the level is assumed to be '1'.
5678 * This function accepts the 'level' argument in the form
5679 * of the commands [uplevel] and [upvar].
5681 * Returns NULL on error.
5683 * Note: for a function accepting a relative integer as level suitable
5684 * for implementation of [info level ?level?], see JimGetCallFrameByInteger()
5686 Jim_CallFrame *Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5688 long level;
5689 const char *str;
5690 Jim_CallFrame *framePtr;
5692 if (levelObjPtr) {
5693 str = Jim_String(levelObjPtr);
5694 if (str[0] == '#') {
5695 char *endptr;
5697 level = jim_strtol(str + 1, &endptr);
5698 if (str[1] == '\0' || endptr[0] != '\0') {
5699 level = -1;
5702 else {
5703 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0) {
5704 level = -1;
5706 else {
5707 /* Convert from a relative to an absolute level */
5708 level = interp->framePtr->level - level;
5712 else {
5713 str = "1"; /* Needed to format the error message. */
5714 level = interp->framePtr->level - 1;
5717 if (level == 0) {
5718 return interp->topFramePtr;
5720 if (level > 0) {
5721 /* Lookup */
5722 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5723 if (framePtr->level == level) {
5724 return framePtr;
5729 Jim_SetResultFormatted(interp, "bad level \"%s\"", str);
5730 return NULL;
5733 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
5734 * as a relative integer like in the [info level ?level?] command.
5736 static Jim_CallFrame *JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5738 long level;
5739 Jim_CallFrame *framePtr;
5741 if (Jim_GetLong(interp, levelObjPtr, &level) == JIM_OK) {
5742 if (level <= 0) {
5743 /* Convert from a relative to an absolute level */
5744 level = interp->framePtr->level + level;
5747 if (level == 0) {
5748 return interp->topFramePtr;
5751 /* Lookup */
5752 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5753 if (framePtr->level == level) {
5754 return framePtr;
5759 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
5760 return NULL;
5763 static void JimResetStackTrace(Jim_Interp *interp)
5765 Jim_DecrRefCount(interp, interp->stackTrace);
5766 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
5767 Jim_IncrRefCount(interp->stackTrace);
5770 static void JimSetStackTrace(Jim_Interp *interp, Jim_Obj *stackTraceObj)
5772 int len;
5774 /* Increment reference first in case these are the same object */
5775 Jim_IncrRefCount(stackTraceObj);
5776 Jim_DecrRefCount(interp, interp->stackTrace);
5777 interp->stackTrace = stackTraceObj;
5778 interp->errorFlag = 1;
5780 /* This is a bit ugly.
5781 * If the filename of the last entry of the stack trace is empty,
5782 * the next stack level should be added.
5784 len = Jim_ListLength(interp, interp->stackTrace);
5785 if (len >= 3) {
5786 if (Jim_Length(Jim_ListGetIndex(interp, interp->stackTrace, len - 2)) == 0) {
5787 interp->addStackTrace = 1;
5792 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
5793 Jim_Obj *fileNameObj, int linenr)
5795 if (strcmp(procname, "unknown") == 0) {
5796 procname = "";
5798 if (!*procname && !Jim_Length(fileNameObj)) {
5799 /* No useful info here */
5800 return;
5803 if (Jim_IsShared(interp->stackTrace)) {
5804 Jim_DecrRefCount(interp, interp->stackTrace);
5805 interp->stackTrace = Jim_DuplicateObj(interp, interp->stackTrace);
5806 Jim_IncrRefCount(interp->stackTrace);
5809 /* If we have no procname but the previous element did, merge with that frame */
5810 if (!*procname && Jim_Length(fileNameObj)) {
5811 /* Just a filename. Check the previous entry */
5812 int len = Jim_ListLength(interp, interp->stackTrace);
5814 if (len >= 3) {
5815 Jim_Obj *objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 3);
5816 if (Jim_Length(objPtr)) {
5817 /* Yes, the previous level had procname */
5818 objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 2);
5819 if (Jim_Length(objPtr) == 0) {
5820 /* But no filename, so merge the new info with that frame */
5821 ListSetIndex(interp, interp->stackTrace, len - 2, fileNameObj, 0);
5822 ListSetIndex(interp, interp->stackTrace, len - 1, Jim_NewIntObj(interp, linenr), 0);
5823 return;
5829 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewStringObj(interp, procname, -1));
5830 Jim_ListAppendElement(interp, interp->stackTrace, fileNameObj);
5831 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewIntObj(interp, linenr));
5834 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc * delProc,
5835 void *data)
5837 AssocDataValue *assocEntryPtr = (AssocDataValue *) Jim_Alloc(sizeof(AssocDataValue));
5839 assocEntryPtr->delProc = delProc;
5840 assocEntryPtr->data = data;
5841 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
5844 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
5846 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
5848 if (entryPtr != NULL) {
5849 AssocDataValue *assocEntryPtr = Jim_GetHashEntryVal(entryPtr);
5850 return assocEntryPtr->data;
5852 return NULL;
5855 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
5857 return Jim_DeleteHashEntry(&interp->assocData, key);
5860 int Jim_GetExitCode(Jim_Interp *interp)
5862 return interp->exitCode;
5865 /* -----------------------------------------------------------------------------
5866 * Integer object
5867 * ---------------------------------------------------------------------------*/
5868 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
5869 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
5871 static const Jim_ObjType intObjType = {
5872 "int",
5873 NULL,
5874 NULL,
5875 UpdateStringOfInt,
5876 JIM_TYPE_NONE,
5879 /* A coerced double is closer to an int than a double.
5880 * It is an int value temporarily masquerading as a double value.
5881 * i.e. it has the same string value as an int and Jim_GetWide()
5882 * succeeds, but also Jim_GetDouble() returns the value directly.
5884 static const Jim_ObjType coercedDoubleObjType = {
5885 "coerced-double",
5886 NULL,
5887 NULL,
5888 UpdateStringOfInt,
5889 JIM_TYPE_NONE,
5893 static void UpdateStringOfInt(struct Jim_Obj *objPtr)
5895 char buf[JIM_INTEGER_SPACE + 1];
5896 jim_wide wideValue = JimWideValue(objPtr);
5897 int pos = 0;
5899 if (wideValue == 0) {
5900 buf[pos++] = '0';
5902 else {
5903 char tmp[JIM_INTEGER_SPACE];
5904 int num = 0;
5905 int i;
5907 if (wideValue < 0) {
5908 buf[pos++] = '-';
5909 i = wideValue % 10;
5910 /* C89 is implementation defined as to whether (-106 % 10) is -6 or 4,
5911 * whereas C99 is always -6
5912 * coverity[dead_error_line]
5914 tmp[num++] = (i > 0) ? (10 - i) : -i;
5915 wideValue /= -10;
5918 while (wideValue) {
5919 tmp[num++] = wideValue % 10;
5920 wideValue /= 10;
5923 for (i = 0; i < num; i++) {
5924 buf[pos++] = '0' + tmp[num - i - 1];
5927 buf[pos] = 0;
5929 JimSetStringBytes(objPtr, buf);
5932 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
5934 jim_wide wideValue;
5935 const char *str;
5937 if (objPtr->typePtr == &coercedDoubleObjType) {
5938 /* Simple switch */
5939 objPtr->typePtr = &intObjType;
5940 return JIM_OK;
5943 /* Get the string representation */
5944 str = Jim_String(objPtr);
5945 /* Try to convert into a jim_wide */
5946 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
5947 if (flags & JIM_ERRMSG) {
5948 Jim_SetResultFormatted(interp, "expected integer but got \"%#s\"", objPtr);
5950 return JIM_ERR;
5952 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) && errno == ERANGE) {
5953 Jim_SetResultString(interp, "Integer value too big to be represented", -1);
5954 return JIM_ERR;
5956 /* Free the old internal repr and set the new one. */
5957 Jim_FreeIntRep(interp, objPtr);
5958 objPtr->typePtr = &intObjType;
5959 objPtr->internalRep.wideValue = wideValue;
5960 return JIM_OK;
5963 #ifdef JIM_OPTIMIZATION
5964 static int JimIsWide(Jim_Obj *objPtr)
5966 return objPtr->typePtr == &intObjType;
5968 #endif
5970 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5972 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
5973 return JIM_ERR;
5974 *widePtr = JimWideValue(objPtr);
5975 return JIM_OK;
5978 /* Get a wide but does not set an error if the format is bad. */
5979 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5981 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
5982 return JIM_ERR;
5983 *widePtr = JimWideValue(objPtr);
5984 return JIM_OK;
5987 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
5989 jim_wide wideValue;
5990 int retval;
5992 retval = Jim_GetWide(interp, objPtr, &wideValue);
5993 if (retval == JIM_OK) {
5994 *longPtr = (long)wideValue;
5995 return JIM_OK;
5997 return JIM_ERR;
6000 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
6002 Jim_Obj *objPtr;
6004 objPtr = Jim_NewObj(interp);
6005 objPtr->typePtr = &intObjType;
6006 objPtr->bytes = NULL;
6007 objPtr->internalRep.wideValue = wideValue;
6008 return objPtr;
6011 /* -----------------------------------------------------------------------------
6012 * Double object
6013 * ---------------------------------------------------------------------------*/
6014 #define JIM_DOUBLE_SPACE 30
6016 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
6017 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
6019 static const Jim_ObjType doubleObjType = {
6020 "double",
6021 NULL,
6022 NULL,
6023 UpdateStringOfDouble,
6024 JIM_TYPE_NONE,
6027 #ifndef HAVE_ISNAN
6028 #undef isnan
6029 #define isnan(X) ((X) != (X))
6030 #endif
6031 #ifndef HAVE_ISINF
6032 #undef isinf
6033 #define isinf(X) (1.0 / (X) == 0.0)
6034 #endif
6036 static void UpdateStringOfDouble(struct Jim_Obj *objPtr)
6038 double value = objPtr->internalRep.doubleValue;
6040 if (isnan(value)) {
6041 JimSetStringBytes(objPtr, "NaN");
6042 return;
6044 if (isinf(value)) {
6045 if (value < 0) {
6046 JimSetStringBytes(objPtr, "-Inf");
6048 else {
6049 JimSetStringBytes(objPtr, "Inf");
6051 return;
6054 char buf[JIM_DOUBLE_SPACE + 1];
6055 int i;
6056 int len = sprintf(buf, "%.12g", value);
6058 /* Add a final ".0" if necessary */
6059 for (i = 0; i < len; i++) {
6060 if (buf[i] == '.' || buf[i] == 'e') {
6061 #if defined(JIM_SPRINTF_DOUBLE_NEEDS_FIX)
6062 /* If 'buf' ends in e-0nn or e+0nn, remove
6063 * the 0 after the + or - and reduce the length by 1
6065 char *e = strchr(buf, 'e');
6066 if (e && (e[1] == '-' || e[1] == '+') && e[2] == '0') {
6067 /* Move it up */
6068 e += 2;
6069 memmove(e, e + 1, len - (e - buf));
6071 #endif
6072 break;
6075 if (buf[i] == '\0') {
6076 buf[i++] = '.';
6077 buf[i++] = '0';
6078 buf[i] = '\0';
6080 JimSetStringBytes(objPtr, buf);
6084 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6086 double doubleValue;
6087 jim_wide wideValue;
6088 const char *str;
6090 #ifdef HAVE_LONG_LONG
6091 /* Assume a 53 bit mantissa */
6092 #define MIN_INT_IN_DOUBLE -(1LL << 53)
6093 #define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1)
6095 if (objPtr->typePtr == &intObjType
6096 && JimWideValue(objPtr) >= MIN_INT_IN_DOUBLE
6097 && JimWideValue(objPtr) <= MAX_INT_IN_DOUBLE) {
6099 /* Direct conversion to coerced double */
6100 objPtr->typePtr = &coercedDoubleObjType;
6101 return JIM_OK;
6103 #endif
6104 /* Preserve the string representation.
6105 * Needed so we can convert back to int without loss
6107 str = Jim_String(objPtr);
6109 if (Jim_StringToWide(str, &wideValue, 10) == JIM_OK) {
6110 /* Managed to convert to an int, so we can use this as a cooerced double */
6111 Jim_FreeIntRep(interp, objPtr);
6112 objPtr->typePtr = &coercedDoubleObjType;
6113 objPtr->internalRep.wideValue = wideValue;
6114 return JIM_OK;
6116 else {
6117 /* Try to convert into a double */
6118 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
6119 Jim_SetResultFormatted(interp, "expected floating-point number but got \"%#s\"", objPtr);
6120 return JIM_ERR;
6122 /* Free the old internal repr and set the new one. */
6123 Jim_FreeIntRep(interp, objPtr);
6125 objPtr->typePtr = &doubleObjType;
6126 objPtr->internalRep.doubleValue = doubleValue;
6127 return JIM_OK;
6130 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
6132 if (objPtr->typePtr == &coercedDoubleObjType) {
6133 *doublePtr = JimWideValue(objPtr);
6134 return JIM_OK;
6136 if (objPtr->typePtr != &doubleObjType && SetDoubleFromAny(interp, objPtr) == JIM_ERR)
6137 return JIM_ERR;
6139 if (objPtr->typePtr == &coercedDoubleObjType) {
6140 *doublePtr = JimWideValue(objPtr);
6142 else {
6143 *doublePtr = objPtr->internalRep.doubleValue;
6145 return JIM_OK;
6148 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
6150 Jim_Obj *objPtr;
6152 objPtr = Jim_NewObj(interp);
6153 objPtr->typePtr = &doubleObjType;
6154 objPtr->bytes = NULL;
6155 objPtr->internalRep.doubleValue = doubleValue;
6156 return objPtr;
6159 /* -----------------------------------------------------------------------------
6160 * Boolean conversion
6161 * ---------------------------------------------------------------------------*/
6162 static int SetBooleanFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
6164 int Jim_GetBoolean(Jim_Interp *interp, Jim_Obj *objPtr, int * booleanPtr)
6166 if (objPtr->typePtr != &intObjType && SetBooleanFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
6167 return JIM_ERR;
6168 *booleanPtr = (int) JimWideValue(objPtr);
6169 return JIM_OK;
6172 static int SetBooleanFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
6174 static const char * const falses[] = {
6175 "0", "false", "no", "off", NULL
6177 static const char * const trues[] = {
6178 "1", "true", "yes", "on", NULL
6181 int boolean;
6183 int index;
6184 if (Jim_GetEnum(interp, objPtr, falses, &index, NULL, 0) == JIM_OK) {
6185 boolean = 0;
6186 } else if (Jim_GetEnum(interp, objPtr, trues, &index, NULL, 0) == JIM_OK) {
6187 boolean = 1;
6188 } else {
6189 if (flags & JIM_ERRMSG) {
6190 Jim_SetResultFormatted(interp, "expected boolean but got \"%#s\"", objPtr);
6192 return JIM_ERR;
6195 /* Free the old internal repr and set the new one. */
6196 Jim_FreeIntRep(interp, objPtr);
6197 objPtr->typePtr = &intObjType;
6198 objPtr->internalRep.wideValue = boolean;
6199 return JIM_OK;
6202 /* -----------------------------------------------------------------------------
6203 * List object
6204 * ---------------------------------------------------------------------------*/
6205 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec);
6206 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
6207 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6208 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6209 static void UpdateStringOfList(struct Jim_Obj *objPtr);
6210 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6212 /* Note that while the elements of the list may contain references,
6213 * the list object itself can't. This basically means that the
6214 * list object string representation as a whole can't contain references
6215 * that are not presents in the single elements. */
6216 static const Jim_ObjType listObjType = {
6217 "list",
6218 FreeListInternalRep,
6219 DupListInternalRep,
6220 UpdateStringOfList,
6221 JIM_TYPE_NONE,
6224 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6226 int i;
6228 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
6229 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
6231 Jim_Free(objPtr->internalRep.listValue.ele);
6234 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6236 int i;
6238 JIM_NOTUSED(interp);
6240 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
6241 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
6242 dupPtr->internalRep.listValue.ele =
6243 Jim_Alloc(sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.maxLen);
6244 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
6245 sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.len);
6246 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
6247 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
6249 dupPtr->typePtr = &listObjType;
6252 /* The following function checks if a given string can be encoded
6253 * into a list element without any kind of quoting, surrounded by braces,
6254 * or using escapes to quote. */
6255 #define JIM_ELESTR_SIMPLE 0
6256 #define JIM_ELESTR_BRACE 1
6257 #define JIM_ELESTR_QUOTE 2
6258 static unsigned char ListElementQuotingType(const char *s, int len)
6260 int i, level, blevel, trySimple = 1;
6262 /* Try with the SIMPLE case */
6263 if (len == 0)
6264 return JIM_ELESTR_BRACE;
6265 if (s[0] == '"' || s[0] == '{') {
6266 trySimple = 0;
6267 goto testbrace;
6269 for (i = 0; i < len; i++) {
6270 switch (s[i]) {
6271 case ' ':
6272 case '$':
6273 case '"':
6274 case '[':
6275 case ']':
6276 case ';':
6277 case '\\':
6278 case '\r':
6279 case '\n':
6280 case '\t':
6281 case '\f':
6282 case '\v':
6283 trySimple = 0;
6284 /* fall through */
6285 case '{':
6286 case '}':
6287 goto testbrace;
6290 return JIM_ELESTR_SIMPLE;
6292 testbrace:
6293 /* Test if it's possible to do with braces */
6294 if (s[len - 1] == '\\')
6295 return JIM_ELESTR_QUOTE;
6296 level = 0;
6297 blevel = 0;
6298 for (i = 0; i < len; i++) {
6299 switch (s[i]) {
6300 case '{':
6301 level++;
6302 break;
6303 case '}':
6304 level--;
6305 if (level < 0)
6306 return JIM_ELESTR_QUOTE;
6307 break;
6308 case '[':
6309 blevel++;
6310 break;
6311 case ']':
6312 blevel--;
6313 break;
6314 case '\\':
6315 if (s[i + 1] == '\n')
6316 return JIM_ELESTR_QUOTE;
6317 else if (s[i + 1] != '\0')
6318 i++;
6319 break;
6322 if (blevel < 0) {
6323 return JIM_ELESTR_QUOTE;
6326 if (level == 0) {
6327 if (!trySimple)
6328 return JIM_ELESTR_BRACE;
6329 for (i = 0; i < len; i++) {
6330 switch (s[i]) {
6331 case ' ':
6332 case '$':
6333 case '"':
6334 case '[':
6335 case ']':
6336 case ';':
6337 case '\\':
6338 case '\r':
6339 case '\n':
6340 case '\t':
6341 case '\f':
6342 case '\v':
6343 return JIM_ELESTR_BRACE;
6344 break;
6347 return JIM_ELESTR_SIMPLE;
6349 return JIM_ELESTR_QUOTE;
6352 /* Backslashes-escapes the null-terminated string 's' into the buffer at 'q'
6353 * The buffer must be at least strlen(s) * 2 + 1 bytes long for the worst-case
6354 * scenario.
6355 * Returns the length of the result.
6357 static int BackslashQuoteString(const char *s, int len, char *q)
6359 char *p = q;
6361 while (len--) {
6362 switch (*s) {
6363 case ' ':
6364 case '$':
6365 case '"':
6366 case '[':
6367 case ']':
6368 case '{':
6369 case '}':
6370 case ';':
6371 case '\\':
6372 *p++ = '\\';
6373 *p++ = *s++;
6374 break;
6375 case '\n':
6376 *p++ = '\\';
6377 *p++ = 'n';
6378 s++;
6379 break;
6380 case '\r':
6381 *p++ = '\\';
6382 *p++ = 'r';
6383 s++;
6384 break;
6385 case '\t':
6386 *p++ = '\\';
6387 *p++ = 't';
6388 s++;
6389 break;
6390 case '\f':
6391 *p++ = '\\';
6392 *p++ = 'f';
6393 s++;
6394 break;
6395 case '\v':
6396 *p++ = '\\';
6397 *p++ = 'v';
6398 s++;
6399 break;
6400 default:
6401 *p++ = *s++;
6402 break;
6405 *p = '\0';
6407 return p - q;
6410 static void JimMakeListStringRep(Jim_Obj *objPtr, Jim_Obj **objv, int objc)
6412 #define STATIC_QUOTING_LEN 32
6413 int i, bufLen, realLength;
6414 const char *strRep;
6415 char *p;
6416 unsigned char *quotingType, staticQuoting[STATIC_QUOTING_LEN];
6418 /* Estimate the space needed. */
6419 if (objc > STATIC_QUOTING_LEN) {
6420 quotingType = Jim_Alloc(objc);
6422 else {
6423 quotingType = staticQuoting;
6425 bufLen = 0;
6426 for (i = 0; i < objc; i++) {
6427 int len;
6429 strRep = Jim_GetString(objv[i], &len);
6430 quotingType[i] = ListElementQuotingType(strRep, len);
6431 switch (quotingType[i]) {
6432 case JIM_ELESTR_SIMPLE:
6433 if (i != 0 || strRep[0] != '#') {
6434 bufLen += len;
6435 break;
6437 /* Special case '#' on first element needs braces */
6438 quotingType[i] = JIM_ELESTR_BRACE;
6439 /* fall through */
6440 case JIM_ELESTR_BRACE:
6441 bufLen += len + 2;
6442 break;
6443 case JIM_ELESTR_QUOTE:
6444 bufLen += len * 2;
6445 break;
6447 bufLen++; /* elements separator. */
6449 bufLen++;
6451 /* Generate the string rep. */
6452 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
6453 realLength = 0;
6454 for (i = 0; i < objc; i++) {
6455 int len, qlen;
6457 strRep = Jim_GetString(objv[i], &len);
6459 switch (quotingType[i]) {
6460 case JIM_ELESTR_SIMPLE:
6461 memcpy(p, strRep, len);
6462 p += len;
6463 realLength += len;
6464 break;
6465 case JIM_ELESTR_BRACE:
6466 *p++ = '{';
6467 memcpy(p, strRep, len);
6468 p += len;
6469 *p++ = '}';
6470 realLength += len + 2;
6471 break;
6472 case JIM_ELESTR_QUOTE:
6473 if (i == 0 && strRep[0] == '#') {
6474 *p++ = '\\';
6475 realLength++;
6477 qlen = BackslashQuoteString(strRep, len, p);
6478 p += qlen;
6479 realLength += qlen;
6480 break;
6482 /* Add a separating space */
6483 if (i + 1 != objc) {
6484 *p++ = ' ';
6485 realLength++;
6488 *p = '\0'; /* nul term. */
6489 objPtr->length = realLength;
6491 if (quotingType != staticQuoting) {
6492 Jim_Free(quotingType);
6496 static void UpdateStringOfList(struct Jim_Obj *objPtr)
6498 JimMakeListStringRep(objPtr, objPtr->internalRep.listValue.ele, objPtr->internalRep.listValue.len);
6501 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6503 struct JimParserCtx parser;
6504 const char *str;
6505 int strLen;
6506 Jim_Obj *fileNameObj;
6507 int linenr;
6509 if (objPtr->typePtr == &listObjType) {
6510 return JIM_OK;
6513 /* Optimise dict -> list for object with no string rep. Note that this may only save a little time, but
6514 * it also preserves any source location of the dict elements
6515 * which can be very useful
6517 if (Jim_IsDict(objPtr) && objPtr->bytes == NULL) {
6518 Jim_Obj **listObjPtrPtr;
6519 int len;
6520 int i;
6522 listObjPtrPtr = JimDictPairs(objPtr, &len);
6523 for (i = 0; i < len; i++) {
6524 Jim_IncrRefCount(listObjPtrPtr[i]);
6527 /* Now just switch the internal rep */
6528 Jim_FreeIntRep(interp, objPtr);
6529 objPtr->typePtr = &listObjType;
6530 objPtr->internalRep.listValue.len = len;
6531 objPtr->internalRep.listValue.maxLen = len;
6532 objPtr->internalRep.listValue.ele = listObjPtrPtr;
6534 return JIM_OK;
6537 /* Try to preserve information about filename / line number */
6538 if (objPtr->typePtr == &sourceObjType) {
6539 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
6540 linenr = objPtr->internalRep.sourceValue.lineNumber;
6542 else {
6543 fileNameObj = interp->emptyObj;
6544 linenr = 1;
6546 Jim_IncrRefCount(fileNameObj);
6548 /* Get the string representation */
6549 str = Jim_GetString(objPtr, &strLen);
6551 /* Free the old internal repr just now and initialize the
6552 * new one just now. The string->list conversion can't fail. */
6553 Jim_FreeIntRep(interp, objPtr);
6554 objPtr->typePtr = &listObjType;
6555 objPtr->internalRep.listValue.len = 0;
6556 objPtr->internalRep.listValue.maxLen = 0;
6557 objPtr->internalRep.listValue.ele = NULL;
6559 /* Convert into a list */
6560 if (strLen) {
6561 JimParserInit(&parser, str, strLen, linenr);
6562 while (!parser.eof) {
6563 Jim_Obj *elementPtr;
6565 JimParseList(&parser);
6566 if (parser.tt != JIM_TT_STR && parser.tt != JIM_TT_ESC)
6567 continue;
6568 elementPtr = JimParserGetTokenObj(interp, &parser);
6569 JimSetSourceInfo(interp, elementPtr, fileNameObj, parser.tline);
6570 ListAppendElement(objPtr, elementPtr);
6573 Jim_DecrRefCount(interp, fileNameObj);
6574 return JIM_OK;
6577 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
6579 Jim_Obj *objPtr;
6581 objPtr = Jim_NewObj(interp);
6582 objPtr->typePtr = &listObjType;
6583 objPtr->bytes = NULL;
6584 objPtr->internalRep.listValue.ele = NULL;
6585 objPtr->internalRep.listValue.len = 0;
6586 objPtr->internalRep.listValue.maxLen = 0;
6588 if (len) {
6589 ListInsertElements(objPtr, 0, len, elements);
6592 return objPtr;
6595 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
6596 * length of the vector. Note that the user of this function should make
6597 * sure that the list object can't shimmer while the vector returned
6598 * is in use, this vector is the one stored inside the internal representation
6599 * of the list object. This function is not exported, extensions should
6600 * always access to the List object elements using Jim_ListIndex(). */
6601 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *listLen,
6602 Jim_Obj ***listVec)
6604 *listLen = Jim_ListLength(interp, listObj);
6605 *listVec = listObj->internalRep.listValue.ele;
6608 /* Sorting uses ints, but commands may return wide */
6609 static int JimSign(jim_wide w)
6611 if (w == 0) {
6612 return 0;
6614 else if (w < 0) {
6615 return -1;
6617 return 1;
6620 /* ListSortElements type values */
6621 struct lsort_info {
6622 jmp_buf jmpbuf;
6623 Jim_Obj *command;
6624 Jim_Interp *interp;
6625 enum {
6626 JIM_LSORT_ASCII,
6627 JIM_LSORT_NOCASE,
6628 JIM_LSORT_INTEGER,
6629 JIM_LSORT_REAL,
6630 JIM_LSORT_COMMAND
6631 } type;
6632 int order;
6633 int index;
6634 int indexed;
6635 int unique;
6636 int (*subfn)(Jim_Obj **, Jim_Obj **);
6639 static struct lsort_info *sort_info;
6641 static int ListSortIndexHelper(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6643 Jim_Obj *lObj, *rObj;
6645 if (Jim_ListIndex(sort_info->interp, *lhsObj, sort_info->index, &lObj, JIM_ERRMSG) != JIM_OK ||
6646 Jim_ListIndex(sort_info->interp, *rhsObj, sort_info->index, &rObj, JIM_ERRMSG) != JIM_OK) {
6647 longjmp(sort_info->jmpbuf, JIM_ERR);
6649 return sort_info->subfn(&lObj, &rObj);
6652 /* Sort the internal rep of a list. */
6653 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6655 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 0) * sort_info->order;
6658 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6660 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 1) * sort_info->order;
6663 static int ListSortInteger(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6665 jim_wide lhs = 0, rhs = 0;
6667 if (Jim_GetWide(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6668 Jim_GetWide(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6669 longjmp(sort_info->jmpbuf, JIM_ERR);
6672 return JimSign(lhs - rhs) * sort_info->order;
6675 static int ListSortReal(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6677 double lhs = 0, rhs = 0;
6679 if (Jim_GetDouble(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6680 Jim_GetDouble(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6681 longjmp(sort_info->jmpbuf, JIM_ERR);
6683 if (lhs == rhs) {
6684 return 0;
6686 if (lhs > rhs) {
6687 return sort_info->order;
6689 return -sort_info->order;
6692 static int ListSortCommand(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6694 Jim_Obj *compare_script;
6695 int rc;
6697 jim_wide ret = 0;
6699 /* This must be a valid list */
6700 compare_script = Jim_DuplicateObj(sort_info->interp, sort_info->command);
6701 Jim_ListAppendElement(sort_info->interp, compare_script, *lhsObj);
6702 Jim_ListAppendElement(sort_info->interp, compare_script, *rhsObj);
6704 rc = Jim_EvalObj(sort_info->interp, compare_script);
6706 if (rc != JIM_OK || Jim_GetWide(sort_info->interp, Jim_GetResult(sort_info->interp), &ret) != JIM_OK) {
6707 longjmp(sort_info->jmpbuf, rc);
6710 return JimSign(ret) * sort_info->order;
6713 /* Remove duplicate elements from the (sorted) list in-place, according to the
6714 * comparison function, comp.
6716 * Note that the last unique value is kept, not the first
6718 static void ListRemoveDuplicates(Jim_Obj *listObjPtr, int (*comp)(Jim_Obj **lhs, Jim_Obj **rhs))
6720 int src;
6721 int dst = 0;
6722 Jim_Obj **ele = listObjPtr->internalRep.listValue.ele;
6724 for (src = 1; src < listObjPtr->internalRep.listValue.len; src++) {
6725 if (comp(&ele[dst], &ele[src]) == 0) {
6726 /* Match, so replace the dest with the current source */
6727 Jim_DecrRefCount(sort_info->interp, ele[dst]);
6729 else {
6730 /* No match, so keep the current source and move to the next destination */
6731 dst++;
6733 ele[dst] = ele[src];
6736 /* At end of list, keep the final element unless all elements were kept */
6737 dst++;
6738 if (dst < listObjPtr->internalRep.listValue.len) {
6739 ele[dst] = ele[src];
6742 /* Set the new length */
6743 listObjPtr->internalRep.listValue.len = dst;
6746 /* Sort a list *in place*. MUST be called with a non-shared list. */
6747 static int ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, struct lsort_info *info)
6749 struct lsort_info *prev_info;
6751 typedef int (qsort_comparator) (const void *, const void *);
6752 int (*fn) (Jim_Obj **, Jim_Obj **);
6753 Jim_Obj **vector;
6754 int len;
6755 int rc;
6757 JimPanic((Jim_IsShared(listObjPtr), "ListSortElements called with shared object"));
6758 SetListFromAny(interp, listObjPtr);
6760 /* Allow lsort to be called reentrantly */
6761 prev_info = sort_info;
6762 sort_info = info;
6764 vector = listObjPtr->internalRep.listValue.ele;
6765 len = listObjPtr->internalRep.listValue.len;
6766 switch (info->type) {
6767 case JIM_LSORT_ASCII:
6768 fn = ListSortString;
6769 break;
6770 case JIM_LSORT_NOCASE:
6771 fn = ListSortStringNoCase;
6772 break;
6773 case JIM_LSORT_INTEGER:
6774 fn = ListSortInteger;
6775 break;
6776 case JIM_LSORT_REAL:
6777 fn = ListSortReal;
6778 break;
6779 case JIM_LSORT_COMMAND:
6780 fn = ListSortCommand;
6781 break;
6782 default:
6783 fn = NULL; /* avoid warning */
6784 JimPanic((1, "ListSort called with invalid sort type"));
6785 return -1; /* Should not be run but keeps static analysers happy */
6788 if (info->indexed) {
6789 /* Need to interpose a "list index" function */
6790 info->subfn = fn;
6791 fn = ListSortIndexHelper;
6794 if ((rc = setjmp(info->jmpbuf)) == 0) {
6795 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *) fn);
6797 if (info->unique && len > 1) {
6798 ListRemoveDuplicates(listObjPtr, fn);
6801 Jim_InvalidateStringRep(listObjPtr);
6803 sort_info = prev_info;
6805 return rc;
6808 /* This is the low-level function to insert elements into a list.
6809 * The higher-level Jim_ListInsertElements() performs shared object
6810 * check and invalidates the string repr. This version is used
6811 * in the internals of the List Object and is not exported.
6813 * NOTE: this function can be called only against objects
6814 * with internal type of List.
6816 * An insertion point (idx) of -1 means end-of-list.
6818 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec)
6820 int currentLen = listPtr->internalRep.listValue.len;
6821 int requiredLen = currentLen + elemc;
6822 int i;
6823 Jim_Obj **point;
6825 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
6826 if (requiredLen < 2) {
6827 /* Don't do allocations of under 4 pointers. */
6828 requiredLen = 4;
6830 else {
6831 requiredLen *= 2;
6834 listPtr->internalRep.listValue.ele = Jim_Realloc(listPtr->internalRep.listValue.ele,
6835 sizeof(Jim_Obj *) * requiredLen);
6837 listPtr->internalRep.listValue.maxLen = requiredLen;
6839 if (idx < 0) {
6840 idx = currentLen;
6842 point = listPtr->internalRep.listValue.ele + idx;
6843 memmove(point + elemc, point, (currentLen - idx) * sizeof(Jim_Obj *));
6844 for (i = 0; i < elemc; ++i) {
6845 point[i] = elemVec[i];
6846 Jim_IncrRefCount(point[i]);
6848 listPtr->internalRep.listValue.len += elemc;
6851 /* Convenience call to ListInsertElements() to append a single element.
6853 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
6855 ListInsertElements(listPtr, -1, 1, &objPtr);
6858 /* Appends every element of appendListPtr into listPtr.
6859 * Both have to be of the list type.
6860 * Convenience call to ListInsertElements()
6862 static void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6864 ListInsertElements(listPtr, -1,
6865 appendListPtr->internalRep.listValue.len, appendListPtr->internalRep.listValue.ele);
6868 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
6870 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendElement called with shared object"));
6871 SetListFromAny(interp, listPtr);
6872 Jim_InvalidateStringRep(listPtr);
6873 ListAppendElement(listPtr, objPtr);
6876 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6878 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendList called with shared object"));
6879 SetListFromAny(interp, listPtr);
6880 SetListFromAny(interp, appendListPtr);
6881 Jim_InvalidateStringRep(listPtr);
6882 ListAppendList(listPtr, appendListPtr);
6885 int Jim_ListLength(Jim_Interp *interp, Jim_Obj *objPtr)
6887 SetListFromAny(interp, objPtr);
6888 return objPtr->internalRep.listValue.len;
6891 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6892 int objc, Jim_Obj *const *objVec)
6894 JimPanic((Jim_IsShared(listPtr), "Jim_ListInsertElement called with shared object"));
6895 SetListFromAny(interp, listPtr);
6896 if (idx >= 0 && idx > listPtr->internalRep.listValue.len)
6897 idx = listPtr->internalRep.listValue.len;
6898 else if (idx < 0)
6899 idx = 0;
6900 Jim_InvalidateStringRep(listPtr);
6901 ListInsertElements(listPtr, idx, objc, objVec);
6904 Jim_Obj *Jim_ListGetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx)
6906 SetListFromAny(interp, listPtr);
6907 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6908 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6909 return NULL;
6911 if (idx < 0)
6912 idx = listPtr->internalRep.listValue.len + idx;
6913 return listPtr->internalRep.listValue.ele[idx];
6916 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx, Jim_Obj **objPtrPtr, int flags)
6918 *objPtrPtr = Jim_ListGetIndex(interp, listPtr, idx);
6919 if (*objPtrPtr == NULL) {
6920 if (flags & JIM_ERRMSG) {
6921 Jim_SetResultString(interp, "list index out of range", -1);
6923 return JIM_ERR;
6925 return JIM_OK;
6928 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6929 Jim_Obj *newObjPtr, int flags)
6931 SetListFromAny(interp, listPtr);
6932 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6933 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6934 if (flags & JIM_ERRMSG) {
6935 Jim_SetResultString(interp, "list index out of range", -1);
6937 return JIM_ERR;
6939 if (idx < 0)
6940 idx = listPtr->internalRep.listValue.len + idx;
6941 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[idx]);
6942 listPtr->internalRep.listValue.ele[idx] = newObjPtr;
6943 Jim_IncrRefCount(newObjPtr);
6944 return JIM_OK;
6947 /* Modify the list stored in the variable named 'varNamePtr'
6948 * setting the element specified by the 'indexc' indexes objects in 'indexv',
6949 * with the new element 'newObjptr'. (implements the [lset] command) */
6950 int Jim_ListSetIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
6951 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
6953 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
6954 int shared, i, idx;
6956 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG | JIM_UNSHARED);
6957 if (objPtr == NULL)
6958 return JIM_ERR;
6959 if ((shared = Jim_IsShared(objPtr)))
6960 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
6961 for (i = 0; i < indexc - 1; i++) {
6962 listObjPtr = objPtr;
6963 if (Jim_GetIndex(interp, indexv[i], &idx) != JIM_OK)
6964 goto err;
6965 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_ERRMSG) != JIM_OK) {
6966 goto err;
6968 if (Jim_IsShared(objPtr)) {
6969 objPtr = Jim_DuplicateObj(interp, objPtr);
6970 ListSetIndex(interp, listObjPtr, idx, objPtr, JIM_NONE);
6972 Jim_InvalidateStringRep(listObjPtr);
6974 if (Jim_GetIndex(interp, indexv[indexc - 1], &idx) != JIM_OK)
6975 goto err;
6976 if (ListSetIndex(interp, objPtr, idx, newObjPtr, JIM_ERRMSG) == JIM_ERR)
6977 goto err;
6978 Jim_InvalidateStringRep(objPtr);
6979 Jim_InvalidateStringRep(varObjPtr);
6980 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
6981 goto err;
6982 Jim_SetResult(interp, varObjPtr);
6983 return JIM_OK;
6984 err:
6985 if (shared) {
6986 Jim_FreeNewObj(interp, varObjPtr);
6988 return JIM_ERR;
6991 Jim_Obj *Jim_ListJoin(Jim_Interp *interp, Jim_Obj *listObjPtr, const char *joinStr, int joinStrLen)
6993 int i;
6994 int listLen = Jim_ListLength(interp, listObjPtr);
6995 Jim_Obj *resObjPtr = Jim_NewEmptyStringObj(interp);
6997 for (i = 0; i < listLen; ) {
6998 Jim_AppendObj(interp, resObjPtr, Jim_ListGetIndex(interp, listObjPtr, i));
6999 if (++i != listLen) {
7000 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
7003 return resObjPtr;
7006 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
7008 int i;
7010 /* If all the objects in objv are lists,
7011 * it's possible to return a list as result, that's the
7012 * concatenation of all the lists. */
7013 for (i = 0; i < objc; i++) {
7014 if (!Jim_IsList(objv[i]))
7015 break;
7017 if (i == objc) {
7018 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
7020 for (i = 0; i < objc; i++)
7021 ListAppendList(objPtr, objv[i]);
7022 return objPtr;
7024 else {
7025 /* Else... we have to glue strings together */
7026 int len = 0, objLen;
7027 char *bytes, *p;
7029 /* Compute the length */
7030 for (i = 0; i < objc; i++) {
7031 len += Jim_Length(objv[i]);
7033 if (objc)
7034 len += objc - 1;
7035 /* Create the string rep, and a string object holding it. */
7036 p = bytes = Jim_Alloc(len + 1);
7037 for (i = 0; i < objc; i++) {
7038 const char *s = Jim_GetString(objv[i], &objLen);
7040 /* Remove leading space */
7041 while (objLen && isspace(UCHAR(*s))) {
7042 s++;
7043 objLen--;
7044 len--;
7046 /* And trailing space */
7047 while (objLen && isspace(UCHAR(s[objLen - 1]))) {
7048 /* Handle trailing backslash-space case */
7049 if (objLen > 1 && s[objLen - 2] == '\\') {
7050 break;
7052 objLen--;
7053 len--;
7055 memcpy(p, s, objLen);
7056 p += objLen;
7057 if (i + 1 != objc) {
7058 if (objLen)
7059 *p++ = ' ';
7060 else {
7061 /* Drop the space calculated for this
7062 * element that is instead null. */
7063 len--;
7067 *p = '\0';
7068 return Jim_NewStringObjNoAlloc(interp, bytes, len);
7072 /* Returns a list composed of the elements in the specified range.
7073 * first and start are directly accepted as Jim_Objects and
7074 * processed for the end?-index? case. */
7075 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr,
7076 Jim_Obj *lastObjPtr)
7078 int first, last;
7079 int len, rangeLen;
7081 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
7082 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
7083 return NULL;
7084 len = Jim_ListLength(interp, listObjPtr); /* will convert into list */
7085 first = JimRelToAbsIndex(len, first);
7086 last = JimRelToAbsIndex(len, last);
7087 JimRelToAbsRange(len, &first, &last, &rangeLen);
7088 if (first == 0 && last == len) {
7089 return listObjPtr;
7091 return Jim_NewListObj(interp, listObjPtr->internalRep.listValue.ele + first, rangeLen);
7094 /* -----------------------------------------------------------------------------
7095 * Dict object
7096 * ---------------------------------------------------------------------------*/
7097 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
7098 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
7099 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
7100 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7102 /* Dict HashTable Type.
7104 * Keys and Values are Jim objects. */
7106 static unsigned int JimObjectHTHashFunction(const void *key)
7108 int len;
7109 const char *str = Jim_GetString((Jim_Obj *)key, &len);
7110 return Jim_GenHashFunction((const unsigned char *)str, len);
7113 static int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
7115 return Jim_StringEqObj((Jim_Obj *)key1, (Jim_Obj *)key2);
7118 static void *JimObjectHTKeyValDup(void *privdata, const void *val)
7120 Jim_IncrRefCount((Jim_Obj *)val);
7121 return (void *)val;
7124 static void JimObjectHTKeyValDestructor(void *interp, void *val)
7126 Jim_DecrRefCount(interp, (Jim_Obj *)val);
7129 static const Jim_HashTableType JimDictHashTableType = {
7130 JimObjectHTHashFunction, /* hash function */
7131 JimObjectHTKeyValDup, /* key dup */
7132 JimObjectHTKeyValDup, /* val dup */
7133 JimObjectHTKeyCompare, /* key compare */
7134 JimObjectHTKeyValDestructor, /* key destructor */
7135 JimObjectHTKeyValDestructor /* val destructor */
7138 /* Note that while the elements of the dict may contain references,
7139 * the list object itself can't. This basically means that the
7140 * dict object string representation as a whole can't contain references
7141 * that are not presents in the single elements. */
7142 static const Jim_ObjType dictObjType = {
7143 "dict",
7144 FreeDictInternalRep,
7145 DupDictInternalRep,
7146 UpdateStringOfDict,
7147 JIM_TYPE_NONE,
7150 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
7152 JIM_NOTUSED(interp);
7154 Jim_FreeHashTable(objPtr->internalRep.ptr);
7155 Jim_Free(objPtr->internalRep.ptr);
7158 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
7160 Jim_HashTable *ht, *dupHt;
7161 Jim_HashTableIterator htiter;
7162 Jim_HashEntry *he;
7164 /* Create a new hash table */
7165 ht = srcPtr->internalRep.ptr;
7166 dupHt = Jim_Alloc(sizeof(*dupHt));
7167 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
7168 if (ht->size != 0)
7169 Jim_ExpandHashTable(dupHt, ht->size);
7170 /* Copy every element from the source to the dup hash table */
7171 JimInitHashTableIterator(ht, &htiter);
7172 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7173 Jim_AddHashEntry(dupHt, he->key, he->u.val);
7176 dupPtr->internalRep.ptr = dupHt;
7177 dupPtr->typePtr = &dictObjType;
7180 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len)
7182 Jim_HashTable *ht;
7183 Jim_HashTableIterator htiter;
7184 Jim_HashEntry *he;
7185 Jim_Obj **objv;
7186 int i;
7188 ht = dictPtr->internalRep.ptr;
7190 /* Turn the hash table into a flat vector of Jim_Objects. */
7191 objv = Jim_Alloc((ht->used * 2) * sizeof(Jim_Obj *));
7192 JimInitHashTableIterator(ht, &htiter);
7193 i = 0;
7194 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7195 objv[i++] = Jim_GetHashEntryKey(he);
7196 objv[i++] = Jim_GetHashEntryVal(he);
7198 *len = i;
7199 return objv;
7202 static void UpdateStringOfDict(struct Jim_Obj *objPtr)
7204 /* Turn the hash table into a flat vector of Jim_Objects. */
7205 int len;
7206 Jim_Obj **objv = JimDictPairs(objPtr, &len);
7208 /* And now generate the string rep as a list */
7209 JimMakeListStringRep(objPtr, objv, len);
7211 Jim_Free(objv);
7214 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
7216 int listlen;
7218 if (objPtr->typePtr == &dictObjType) {
7219 return JIM_OK;
7222 if (Jim_IsList(objPtr) && Jim_IsShared(objPtr)) {
7223 /* A shared list, so get the string representation now to avoid
7224 * changing the order in case of fast conversion to dict.
7226 Jim_String(objPtr);
7229 /* For simplicity, convert a non-list object to a list and then to a dict */
7230 listlen = Jim_ListLength(interp, objPtr);
7231 if (listlen % 2) {
7232 Jim_SetResultString(interp, "missing value to go with key", -1);
7233 return JIM_ERR;
7235 else {
7236 /* Converting from a list to a dict can't fail */
7237 Jim_HashTable *ht;
7238 int i;
7240 ht = Jim_Alloc(sizeof(*ht));
7241 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
7243 for (i = 0; i < listlen; i += 2) {
7244 Jim_Obj *keyObjPtr = Jim_ListGetIndex(interp, objPtr, i);
7245 Jim_Obj *valObjPtr = Jim_ListGetIndex(interp, objPtr, i + 1);
7247 Jim_ReplaceHashEntry(ht, keyObjPtr, valObjPtr);
7250 Jim_FreeIntRep(interp, objPtr);
7251 objPtr->typePtr = &dictObjType;
7252 objPtr->internalRep.ptr = ht;
7254 return JIM_OK;
7258 /* Dict object API */
7260 /* Add an element to a dict. objPtr must be of the "dict" type.
7261 * The higher-level exported function is Jim_DictAddElement().
7262 * If an element with the specified key already exists, the value
7263 * associated is replaced with the new one.
7265 * if valueObjPtr == NULL, the key is instead removed if it exists. */
7266 static int DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7267 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7269 Jim_HashTable *ht = objPtr->internalRep.ptr;
7271 if (valueObjPtr == NULL) { /* unset */
7272 return Jim_DeleteHashEntry(ht, keyObjPtr);
7274 Jim_ReplaceHashEntry(ht, keyObjPtr, valueObjPtr);
7275 return JIM_OK;
7278 /* Add an element, higher-level interface for DictAddElement().
7279 * If valueObjPtr == NULL, the key is removed if it exists. */
7280 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7281 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7283 JimPanic((Jim_IsShared(objPtr), "Jim_DictAddElement called with shared object"));
7284 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
7285 return JIM_ERR;
7287 Jim_InvalidateStringRep(objPtr);
7288 return DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
7291 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
7293 Jim_Obj *objPtr;
7294 int i;
7296 JimPanic((len % 2, "Jim_NewDictObj() 'len' argument must be even"));
7298 objPtr = Jim_NewObj(interp);
7299 objPtr->typePtr = &dictObjType;
7300 objPtr->bytes = NULL;
7301 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
7302 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
7303 for (i = 0; i < len; i += 2)
7304 DictAddElement(interp, objPtr, elements[i], elements[i + 1]);
7305 return objPtr;
7308 /* Return the value associated to the specified dict key
7309 * Returns JIM_OK if OK, JIM_ERR if entry not found or -1 if can't create dict value
7311 * Sets *objPtrPtr to non-NULL only upon success.
7313 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
7314 Jim_Obj **objPtrPtr, int flags)
7316 Jim_HashEntry *he;
7317 Jim_HashTable *ht;
7319 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7320 return -1;
7322 ht = dictPtr->internalRep.ptr;
7323 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
7324 if (flags & JIM_ERRMSG) {
7325 Jim_SetResultFormatted(interp, "key \"%#s\" not known in dictionary", keyPtr);
7327 return JIM_ERR;
7329 else {
7330 *objPtrPtr = Jim_GetHashEntryVal(he);
7331 return JIM_OK;
7335 /* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */
7336 int Jim_DictPairs(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj ***objPtrPtr, int *len)
7338 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7339 return JIM_ERR;
7341 *objPtrPtr = JimDictPairs(dictPtr, len);
7343 return JIM_OK;
7347 /* Return the value associated to the specified dict keys */
7348 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
7349 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
7351 int i;
7353 if (keyc == 0) {
7354 *objPtrPtr = dictPtr;
7355 return JIM_OK;
7358 for (i = 0; i < keyc; i++) {
7359 Jim_Obj *objPtr;
7361 int rc = Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags);
7362 if (rc != JIM_OK) {
7363 return rc;
7365 dictPtr = objPtr;
7367 *objPtrPtr = dictPtr;
7368 return JIM_OK;
7371 /* Modify the dict stored into the variable named 'varNamePtr'
7372 * setting the element specified by the 'keyc' keys objects in 'keyv',
7373 * with the new value of the element 'newObjPtr'.
7375 * If newObjPtr == NULL the operation is to remove the given key
7376 * from the dictionary.
7378 * If flags & JIM_ERRMSG, then failure to remove the key is considered an error
7379 * and JIM_ERR is returned. Otherwise it is ignored and JIM_OK is returned.
7381 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
7382 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr, int flags)
7384 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
7385 int shared, i;
7387 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, flags);
7388 if (objPtr == NULL) {
7389 if (newObjPtr == NULL && (flags & JIM_MUSTEXIST)) {
7390 /* Cannot remove a key from non existing var */
7391 return JIM_ERR;
7393 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
7394 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
7395 Jim_FreeNewObj(interp, varObjPtr);
7396 return JIM_ERR;
7399 if ((shared = Jim_IsShared(objPtr)))
7400 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
7401 for (i = 0; i < keyc; i++) {
7402 dictObjPtr = objPtr;
7404 /* Check if it's a valid dictionary */
7405 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK) {
7406 goto err;
7409 if (i == keyc - 1) {
7410 /* Last key: Note that error on unset with missing last key is OK */
7411 if (Jim_DictAddElement(interp, objPtr, keyv[keyc - 1], newObjPtr) != JIM_OK) {
7412 if (newObjPtr || (flags & JIM_MUSTEXIST)) {
7413 goto err;
7416 break;
7419 /* Check if the given key exists. */
7420 Jim_InvalidateStringRep(dictObjPtr);
7421 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
7422 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK) {
7423 /* This key exists at the current level.
7424 * Make sure it's not shared!. */
7425 if (Jim_IsShared(objPtr)) {
7426 objPtr = Jim_DuplicateObj(interp, objPtr);
7427 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7430 else {
7431 /* Key not found. If it's an [unset] operation
7432 * this is an error. Only the last key may not
7433 * exist. */
7434 if (newObjPtr == NULL) {
7435 goto err;
7437 /* Otherwise set an empty dictionary
7438 * as key's value. */
7439 objPtr = Jim_NewDictObj(interp, NULL, 0);
7440 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7443 /* XXX: Is this necessary? */
7444 Jim_InvalidateStringRep(objPtr);
7445 Jim_InvalidateStringRep(varObjPtr);
7446 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK) {
7447 goto err;
7449 Jim_SetResult(interp, varObjPtr);
7450 return JIM_OK;
7451 err:
7452 if (shared) {
7453 Jim_FreeNewObj(interp, varObjPtr);
7455 return JIM_ERR;
7458 /* -----------------------------------------------------------------------------
7459 * Index object
7460 * ---------------------------------------------------------------------------*/
7461 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
7462 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7464 static const Jim_ObjType indexObjType = {
7465 "index",
7466 NULL,
7467 NULL,
7468 UpdateStringOfIndex,
7469 JIM_TYPE_NONE,
7472 static void UpdateStringOfIndex(struct Jim_Obj *objPtr)
7474 if (objPtr->internalRep.intValue == -1) {
7475 JimSetStringBytes(objPtr, "end");
7477 else {
7478 char buf[JIM_INTEGER_SPACE + 1];
7479 if (objPtr->internalRep.intValue >= 0) {
7480 sprintf(buf, "%d", objPtr->internalRep.intValue);
7482 else {
7483 /* Must be <= -2 */
7484 sprintf(buf, "end%d", objPtr->internalRep.intValue + 1);
7486 JimSetStringBytes(objPtr, buf);
7490 static int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7492 int idx, end = 0;
7493 const char *str;
7494 char *endptr;
7496 /* Get the string representation */
7497 str = Jim_String(objPtr);
7499 /* Try to convert into an index */
7500 if (strncmp(str, "end", 3) == 0) {
7501 end = 1;
7502 str += 3;
7503 idx = 0;
7505 else {
7506 idx = jim_strtol(str, &endptr);
7508 if (endptr == str) {
7509 goto badindex;
7511 str = endptr;
7514 /* Now str may include or +<num> or -<num> */
7515 if (*str == '+' || *str == '-') {
7516 int sign = (*str == '+' ? 1 : -1);
7518 idx += sign * jim_strtol(++str, &endptr);
7519 if (str == endptr || *endptr) {
7520 goto badindex;
7522 str = endptr;
7524 /* The only thing left should be spaces */
7525 while (isspace(UCHAR(*str))) {
7526 str++;
7528 if (*str) {
7529 goto badindex;
7531 if (end) {
7532 if (idx > 0) {
7533 idx = INT_MAX;
7535 else {
7536 /* end-1 is repesented as -2 */
7537 idx--;
7540 else if (idx < 0) {
7541 idx = -INT_MAX;
7544 /* Free the old internal repr and set the new one. */
7545 Jim_FreeIntRep(interp, objPtr);
7546 objPtr->typePtr = &indexObjType;
7547 objPtr->internalRep.intValue = idx;
7548 return JIM_OK;
7550 badindex:
7551 Jim_SetResultFormatted(interp,
7552 "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr);
7553 return JIM_ERR;
7556 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
7558 /* Avoid shimmering if the object is an integer. */
7559 if (objPtr->typePtr == &intObjType) {
7560 jim_wide val = JimWideValue(objPtr);
7562 if (val < 0)
7563 *indexPtr = -INT_MAX;
7564 else if (val > INT_MAX)
7565 *indexPtr = INT_MAX;
7566 else
7567 *indexPtr = (int)val;
7568 return JIM_OK;
7570 if (objPtr->typePtr != &indexObjType && SetIndexFromAny(interp, objPtr) == JIM_ERR)
7571 return JIM_ERR;
7572 *indexPtr = objPtr->internalRep.intValue;
7573 return JIM_OK;
7576 /* -----------------------------------------------------------------------------
7577 * Return Code Object.
7578 * ---------------------------------------------------------------------------*/
7580 /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
7581 static const char * const jimReturnCodes[] = {
7582 "ok",
7583 "error",
7584 "return",
7585 "break",
7586 "continue",
7587 "signal",
7588 "exit",
7589 "eval",
7590 NULL
7593 #define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes) - 1)
7595 static const Jim_ObjType returnCodeObjType = {
7596 "return-code",
7597 NULL,
7598 NULL,
7599 NULL,
7600 JIM_TYPE_NONE,
7603 /* Converts a (standard) return code to a string. Returns "?" for
7604 * non-standard return codes.
7606 const char *Jim_ReturnCode(int code)
7608 if (code < 0 || code >= (int)jimReturnCodesSize) {
7609 return "?";
7611 else {
7612 return jimReturnCodes[code];
7616 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7618 int returnCode;
7619 jim_wide wideValue;
7621 /* Try to convert into an integer */
7622 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
7623 returnCode = (int)wideValue;
7624 else if (Jim_GetEnum(interp, objPtr, jimReturnCodes, &returnCode, NULL, JIM_NONE) != JIM_OK) {
7625 Jim_SetResultFormatted(interp, "expected return code but got \"%#s\"", objPtr);
7626 return JIM_ERR;
7628 /* Free the old internal repr and set the new one. */
7629 Jim_FreeIntRep(interp, objPtr);
7630 objPtr->typePtr = &returnCodeObjType;
7631 objPtr->internalRep.intValue = returnCode;
7632 return JIM_OK;
7635 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
7637 if (objPtr->typePtr != &returnCodeObjType && SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
7638 return JIM_ERR;
7639 *intPtr = objPtr->internalRep.intValue;
7640 return JIM_OK;
7643 /* -----------------------------------------------------------------------------
7644 * Expression Parsing
7645 * ---------------------------------------------------------------------------*/
7646 static int JimParseExprOperator(struct JimParserCtx *pc);
7647 static int JimParseExprNumber(struct JimParserCtx *pc);
7648 static int JimParseExprIrrational(struct JimParserCtx *pc);
7649 static int JimParseExprBoolean(struct JimParserCtx *pc);
7651 /* expr operator opcodes. */
7652 enum
7654 /* Continues on from the JIM_TT_ space */
7656 /* Binary operators (numbers) */
7657 JIM_EXPROP_MUL = JIM_TT_EXPR_OP, /* 20 */
7658 JIM_EXPROP_DIV,
7659 JIM_EXPROP_MOD,
7660 JIM_EXPROP_SUB,
7661 JIM_EXPROP_ADD,
7662 JIM_EXPROP_LSHIFT,
7663 JIM_EXPROP_RSHIFT,
7664 JIM_EXPROP_ROTL,
7665 JIM_EXPROP_ROTR,
7666 JIM_EXPROP_LT,
7667 JIM_EXPROP_GT,
7668 JIM_EXPROP_LTE,
7669 JIM_EXPROP_GTE,
7670 JIM_EXPROP_NUMEQ,
7671 JIM_EXPROP_NUMNE,
7672 JIM_EXPROP_BITAND, /* 35 */
7673 JIM_EXPROP_BITXOR,
7674 JIM_EXPROP_BITOR,
7675 JIM_EXPROP_LOGICAND, /* 38 */
7676 JIM_EXPROP_LOGICOR, /* 39 */
7677 JIM_EXPROP_TERNARY, /* 40 */
7678 JIM_EXPROP_COLON, /* 41 */
7679 JIM_EXPROP_POW, /* 42 */
7681 /* Binary operators (strings) */
7682 JIM_EXPROP_STREQ, /* 43 */
7683 JIM_EXPROP_STRNE,
7684 JIM_EXPROP_STRIN,
7685 JIM_EXPROP_STRNI,
7687 /* Unary operators (numbers) */
7688 JIM_EXPROP_NOT, /* 47 */
7689 JIM_EXPROP_BITNOT,
7690 JIM_EXPROP_UNARYMINUS,
7691 JIM_EXPROP_UNARYPLUS,
7693 /* Functions */
7694 JIM_EXPROP_FUNC_INT, /* 51 */
7695 JIM_EXPROP_FUNC_WIDE,
7696 JIM_EXPROP_FUNC_ABS,
7697 JIM_EXPROP_FUNC_DOUBLE,
7698 JIM_EXPROP_FUNC_ROUND,
7699 JIM_EXPROP_FUNC_RAND,
7700 JIM_EXPROP_FUNC_SRAND,
7702 /* math functions from libm */
7703 JIM_EXPROP_FUNC_SIN, /* 65 */
7704 JIM_EXPROP_FUNC_COS,
7705 JIM_EXPROP_FUNC_TAN,
7706 JIM_EXPROP_FUNC_ASIN,
7707 JIM_EXPROP_FUNC_ACOS,
7708 JIM_EXPROP_FUNC_ATAN,
7709 JIM_EXPROP_FUNC_ATAN2,
7710 JIM_EXPROP_FUNC_SINH,
7711 JIM_EXPROP_FUNC_COSH,
7712 JIM_EXPROP_FUNC_TANH,
7713 JIM_EXPROP_FUNC_CEIL,
7714 JIM_EXPROP_FUNC_FLOOR,
7715 JIM_EXPROP_FUNC_EXP,
7716 JIM_EXPROP_FUNC_LOG,
7717 JIM_EXPROP_FUNC_LOG10,
7718 JIM_EXPROP_FUNC_SQRT,
7719 JIM_EXPROP_FUNC_POW,
7720 JIM_EXPROP_FUNC_HYPOT,
7721 JIM_EXPROP_FUNC_FMOD,
7724 /* A expression node is either a term or an operator
7725 * If a node is an operator, 'op' points to the details of the operator and it's terms.
7727 struct JimExprNode {
7728 int type; /* JIM_TT_xxx */
7729 struct Jim_Obj *objPtr; /* The object for a term, or NULL for an operator */
7731 struct JimExprNode *left; /* For all operators */
7732 struct JimExprNode *right; /* For binary operators */
7733 struct JimExprNode *ternary; /* For ternary operator only */
7736 /* Operators table */
7737 typedef struct Jim_ExprOperator
7739 const char *name;
7740 int (*funcop) (Jim_Interp *interp, struct JimExprNode *opnode);
7741 unsigned char precedence;
7742 unsigned char arity;
7743 unsigned char attr;
7744 unsigned char namelen;
7745 } Jim_ExprOperator;
7747 static int JimExprGetTerm(Jim_Interp *interp, struct JimExprNode *node, Jim_Obj **objPtrPtr);
7748 static int JimExprGetTermBoolean(Jim_Interp *interp, struct JimExprNode *node);
7749 static int JimExprEvalTermNode(Jim_Interp *interp, struct JimExprNode *node);
7751 static int JimExprOpNumUnary(Jim_Interp *interp, struct JimExprNode *node)
7753 int intresult = 1;
7754 int rc;
7755 double dA, dC = 0;
7756 jim_wide wA, wC = 0;
7757 Jim_Obj *A;
7759 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7760 return rc;
7763 if ((A->typePtr != &doubleObjType || A->bytes) && JimGetWideNoErr(interp, A, &wA) == JIM_OK) {
7764 switch (node->type) {
7765 case JIM_EXPROP_FUNC_INT:
7766 case JIM_EXPROP_FUNC_WIDE:
7767 case JIM_EXPROP_FUNC_ROUND:
7768 case JIM_EXPROP_UNARYPLUS:
7769 wC = wA;
7770 break;
7771 case JIM_EXPROP_FUNC_DOUBLE:
7772 dC = wA;
7773 intresult = 0;
7774 break;
7775 case JIM_EXPROP_FUNC_ABS:
7776 wC = wA >= 0 ? wA : -wA;
7777 break;
7778 case JIM_EXPROP_UNARYMINUS:
7779 wC = -wA;
7780 break;
7781 case JIM_EXPROP_NOT:
7782 wC = !wA;
7783 break;
7784 default:
7785 abort();
7788 else if ((rc = Jim_GetDouble(interp, A, &dA)) == JIM_OK) {
7789 switch (node->type) {
7790 case JIM_EXPROP_FUNC_INT:
7791 case JIM_EXPROP_FUNC_WIDE:
7792 wC = dA;
7793 break;
7794 case JIM_EXPROP_FUNC_ROUND:
7795 wC = dA < 0 ? (dA - 0.5) : (dA + 0.5);
7796 break;
7797 case JIM_EXPROP_FUNC_DOUBLE:
7798 case JIM_EXPROP_UNARYPLUS:
7799 dC = dA;
7800 intresult = 0;
7801 break;
7802 case JIM_EXPROP_FUNC_ABS:
7803 #ifdef JIM_MATH_FUNCTIONS
7804 dC = fabs(dA);
7805 #else
7806 dC = dA >= 0 ? dA : -dA;
7807 #endif
7808 intresult = 0;
7809 break;
7810 case JIM_EXPROP_UNARYMINUS:
7811 dC = -dA;
7812 intresult = 0;
7813 break;
7814 case JIM_EXPROP_NOT:
7815 wC = !dA;
7816 break;
7817 default:
7818 abort();
7822 if (rc == JIM_OK) {
7823 if (intresult) {
7824 Jim_SetResultInt(interp, wC);
7826 else {
7827 Jim_SetResult(interp, Jim_NewDoubleObj(interp, dC));
7831 Jim_DecrRefCount(interp, A);
7833 return rc;
7836 static double JimRandDouble(Jim_Interp *interp)
7838 unsigned long x;
7839 JimRandomBytes(interp, &x, sizeof(x));
7841 return (double)x / (unsigned long)~0;
7844 static int JimExprOpIntUnary(Jim_Interp *interp, struct JimExprNode *node)
7846 jim_wide wA;
7847 Jim_Obj *A;
7848 int rc;
7850 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7851 return rc;
7854 rc = Jim_GetWide(interp, A, &wA);
7855 if (rc == JIM_OK) {
7856 switch (node->type) {
7857 case JIM_EXPROP_BITNOT:
7858 Jim_SetResultInt(interp, ~wA);
7859 break;
7860 case JIM_EXPROP_FUNC_SRAND:
7861 JimPrngSeed(interp, (unsigned char *)&wA, sizeof(wA));
7862 Jim_SetResult(interp, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7863 break;
7864 default:
7865 abort();
7869 Jim_DecrRefCount(interp, A);
7871 return rc;
7874 static int JimExprOpNone(Jim_Interp *interp, struct JimExprNode *node)
7876 JimPanic((node->type != JIM_EXPROP_FUNC_RAND, "JimExprOpNone only support rand()"));
7878 Jim_SetResult(interp, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7880 return JIM_OK;
7883 #ifdef JIM_MATH_FUNCTIONS
7884 static int JimExprOpDoubleUnary(Jim_Interp *interp, struct JimExprNode *node)
7886 int rc;
7887 double dA, dC;
7888 Jim_Obj *A;
7890 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7891 return rc;
7894 rc = Jim_GetDouble(interp, A, &dA);
7895 if (rc == JIM_OK) {
7896 switch (node->type) {
7897 case JIM_EXPROP_FUNC_SIN:
7898 dC = sin(dA);
7899 break;
7900 case JIM_EXPROP_FUNC_COS:
7901 dC = cos(dA);
7902 break;
7903 case JIM_EXPROP_FUNC_TAN:
7904 dC = tan(dA);
7905 break;
7906 case JIM_EXPROP_FUNC_ASIN:
7907 dC = asin(dA);
7908 break;
7909 case JIM_EXPROP_FUNC_ACOS:
7910 dC = acos(dA);
7911 break;
7912 case JIM_EXPROP_FUNC_ATAN:
7913 dC = atan(dA);
7914 break;
7915 case JIM_EXPROP_FUNC_SINH:
7916 dC = sinh(dA);
7917 break;
7918 case JIM_EXPROP_FUNC_COSH:
7919 dC = cosh(dA);
7920 break;
7921 case JIM_EXPROP_FUNC_TANH:
7922 dC = tanh(dA);
7923 break;
7924 case JIM_EXPROP_FUNC_CEIL:
7925 dC = ceil(dA);
7926 break;
7927 case JIM_EXPROP_FUNC_FLOOR:
7928 dC = floor(dA);
7929 break;
7930 case JIM_EXPROP_FUNC_EXP:
7931 dC = exp(dA);
7932 break;
7933 case JIM_EXPROP_FUNC_LOG:
7934 dC = log(dA);
7935 break;
7936 case JIM_EXPROP_FUNC_LOG10:
7937 dC = log10(dA);
7938 break;
7939 case JIM_EXPROP_FUNC_SQRT:
7940 dC = sqrt(dA);
7941 break;
7942 default:
7943 abort();
7945 Jim_SetResult(interp, Jim_NewDoubleObj(interp, dC));
7948 Jim_DecrRefCount(interp, A);
7950 return rc;
7952 #endif
7954 /* A binary operation on two ints */
7955 static int JimExprOpIntBin(Jim_Interp *interp, struct JimExprNode *node)
7957 jim_wide wA, wB;
7958 int rc;
7959 Jim_Obj *A, *B;
7961 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7962 return rc;
7964 if ((rc = JimExprGetTerm(interp, node->right, &B)) != JIM_OK) {
7965 Jim_DecrRefCount(interp, A);
7966 return rc;
7969 rc = JIM_ERR;
7971 if (Jim_GetWide(interp, A, &wA) == JIM_OK && Jim_GetWide(interp, B, &wB) == JIM_OK) {
7972 jim_wide wC;
7974 rc = JIM_OK;
7976 switch (node->type) {
7977 case JIM_EXPROP_LSHIFT:
7978 wC = wA << wB;
7979 break;
7980 case JIM_EXPROP_RSHIFT:
7981 wC = wA >> wB;
7982 break;
7983 case JIM_EXPROP_BITAND:
7984 wC = wA & wB;
7985 break;
7986 case JIM_EXPROP_BITXOR:
7987 wC = wA ^ wB;
7988 break;
7989 case JIM_EXPROP_BITOR:
7990 wC = wA | wB;
7991 break;
7992 case JIM_EXPROP_MOD:
7993 if (wB == 0) {
7994 wC = 0;
7995 Jim_SetResultString(interp, "Division by zero", -1);
7996 rc = JIM_ERR;
7998 else {
8000 * From Tcl 8.x
8002 * This code is tricky: C doesn't guarantee much
8003 * about the quotient or remainder, but Tcl does.
8004 * The remainder always has the same sign as the
8005 * divisor and a smaller absolute value.
8007 int negative = 0;
8009 if (wB < 0) {
8010 wB = -wB;
8011 wA = -wA;
8012 negative = 1;
8014 wC = wA % wB;
8015 if (wC < 0) {
8016 wC += wB;
8018 if (negative) {
8019 wC = -wC;
8022 break;
8023 case JIM_EXPROP_ROTL:
8024 case JIM_EXPROP_ROTR:{
8025 /* uint32_t would be better. But not everyone has inttypes.h? */
8026 unsigned long uA = (unsigned long)wA;
8027 unsigned long uB = (unsigned long)wB;
8028 const unsigned int S = sizeof(unsigned long) * 8;
8030 /* Shift left by the word size or more is undefined. */
8031 uB %= S;
8033 if (node->type == JIM_EXPROP_ROTR) {
8034 uB = S - uB;
8036 wC = (unsigned long)(uA << uB) | (uA >> (S - uB));
8037 break;
8039 default:
8040 abort();
8042 Jim_SetResultInt(interp, wC);
8045 Jim_DecrRefCount(interp, A);
8046 Jim_DecrRefCount(interp, B);
8048 return rc;
8052 /* A binary operation on two ints or two doubles (or two strings for some ops) */
8053 static int JimExprOpBin(Jim_Interp *interp, struct JimExprNode *node)
8055 int rc = JIM_OK;
8056 double dA, dB, dC = 0;
8057 jim_wide wA, wB, wC = 0;
8058 Jim_Obj *A, *B;
8060 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
8061 return rc;
8063 if ((rc = JimExprGetTerm(interp, node->right, &B)) != JIM_OK) {
8064 Jim_DecrRefCount(interp, A);
8065 return rc;
8068 if ((A->typePtr != &doubleObjType || A->bytes) &&
8069 (B->typePtr != &doubleObjType || B->bytes) &&
8070 JimGetWideNoErr(interp, A, &wA) == JIM_OK && JimGetWideNoErr(interp, B, &wB) == JIM_OK) {
8072 /* Both are ints */
8074 switch (node->type) {
8075 case JIM_EXPROP_POW:
8076 case JIM_EXPROP_FUNC_POW:
8077 if (wA == 0 && wB < 0) {
8078 Jim_SetResultString(interp, "exponentiation of zero by negative power", -1);
8079 rc = JIM_ERR;
8080 goto done;
8082 wC = JimPowWide(wA, wB);
8083 goto intresult;
8084 case JIM_EXPROP_ADD:
8085 wC = wA + wB;
8086 goto intresult;
8087 case JIM_EXPROP_SUB:
8088 wC = wA - wB;
8089 goto intresult;
8090 case JIM_EXPROP_MUL:
8091 wC = wA * wB;
8092 goto intresult;
8093 case JIM_EXPROP_DIV:
8094 if (wB == 0) {
8095 Jim_SetResultString(interp, "Division by zero", -1);
8096 rc = JIM_ERR;
8097 goto done;
8099 else {
8101 * From Tcl 8.x
8103 * This code is tricky: C doesn't guarantee much
8104 * about the quotient or remainder, but Tcl does.
8105 * The remainder always has the same sign as the
8106 * divisor and a smaller absolute value.
8108 if (wB < 0) {
8109 wB = -wB;
8110 wA = -wA;
8112 wC = wA / wB;
8113 if (wA % wB < 0) {
8114 wC--;
8116 goto intresult;
8118 case JIM_EXPROP_LT:
8119 wC = wA < wB;
8120 goto intresult;
8121 case JIM_EXPROP_GT:
8122 wC = wA > wB;
8123 goto intresult;
8124 case JIM_EXPROP_LTE:
8125 wC = wA <= wB;
8126 goto intresult;
8127 case JIM_EXPROP_GTE:
8128 wC = wA >= wB;
8129 goto intresult;
8130 case JIM_EXPROP_NUMEQ:
8131 wC = wA == wB;
8132 goto intresult;
8133 case JIM_EXPROP_NUMNE:
8134 wC = wA != wB;
8135 goto intresult;
8138 if (Jim_GetDouble(interp, A, &dA) == JIM_OK && Jim_GetDouble(interp, B, &dB) == JIM_OK) {
8139 switch (node->type) {
8140 #ifndef JIM_MATH_FUNCTIONS
8141 case JIM_EXPROP_POW:
8142 case JIM_EXPROP_FUNC_POW:
8143 case JIM_EXPROP_FUNC_ATAN2:
8144 case JIM_EXPROP_FUNC_HYPOT:
8145 case JIM_EXPROP_FUNC_FMOD:
8146 Jim_SetResultString(interp, "unsupported", -1);
8147 rc = JIM_ERR;
8148 goto done;
8149 #else
8150 case JIM_EXPROP_POW:
8151 case JIM_EXPROP_FUNC_POW:
8152 dC = pow(dA, dB);
8153 goto doubleresult;
8154 case JIM_EXPROP_FUNC_ATAN2:
8155 dC = atan2(dA, dB);
8156 goto doubleresult;
8157 case JIM_EXPROP_FUNC_HYPOT:
8158 dC = hypot(dA, dB);
8159 goto doubleresult;
8160 case JIM_EXPROP_FUNC_FMOD:
8161 dC = fmod(dA, dB);
8162 goto doubleresult;
8163 #endif
8164 case JIM_EXPROP_ADD:
8165 dC = dA + dB;
8166 goto doubleresult;
8167 case JIM_EXPROP_SUB:
8168 dC = dA - dB;
8169 goto doubleresult;
8170 case JIM_EXPROP_MUL:
8171 dC = dA * dB;
8172 goto doubleresult;
8173 case JIM_EXPROP_DIV:
8174 if (dB == 0) {
8175 #ifdef INFINITY
8176 dC = dA < 0 ? -INFINITY : INFINITY;
8177 #else
8178 dC = (dA < 0 ? -1.0 : 1.0) * strtod("Inf", NULL);
8179 #endif
8181 else {
8182 dC = dA / dB;
8184 goto doubleresult;
8185 case JIM_EXPROP_LT:
8186 wC = dA < dB;
8187 goto intresult;
8188 case JIM_EXPROP_GT:
8189 wC = dA > dB;
8190 goto intresult;
8191 case JIM_EXPROP_LTE:
8192 wC = dA <= dB;
8193 goto intresult;
8194 case JIM_EXPROP_GTE:
8195 wC = dA >= dB;
8196 goto intresult;
8197 case JIM_EXPROP_NUMEQ:
8198 wC = dA == dB;
8199 goto intresult;
8200 case JIM_EXPROP_NUMNE:
8201 wC = dA != dB;
8202 goto intresult;
8205 else {
8206 /* Handle the string case */
8208 /* XXX: Could optimise the eq/ne case by checking lengths */
8209 int i = Jim_StringCompareObj(interp, A, B, 0);
8211 switch (node->type) {
8212 case JIM_EXPROP_LT:
8213 wC = i < 0;
8214 goto intresult;
8215 case JIM_EXPROP_GT:
8216 wC = i > 0;
8217 goto intresult;
8218 case JIM_EXPROP_LTE:
8219 wC = i <= 0;
8220 goto intresult;
8221 case JIM_EXPROP_GTE:
8222 wC = i >= 0;
8223 goto intresult;
8224 case JIM_EXPROP_NUMEQ:
8225 wC = i == 0;
8226 goto intresult;
8227 case JIM_EXPROP_NUMNE:
8228 wC = i != 0;
8229 goto intresult;
8232 /* If we get here, it is an error */
8233 rc = JIM_ERR;
8234 done:
8235 Jim_DecrRefCount(interp, A);
8236 Jim_DecrRefCount(interp, B);
8237 return rc;
8238 intresult:
8239 Jim_SetResultInt(interp, wC);
8240 goto done;
8241 doubleresult:
8242 Jim_SetResult(interp, Jim_NewDoubleObj(interp, dC));
8243 goto done;
8246 static int JimSearchList(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *valObj)
8248 int listlen;
8249 int i;
8251 listlen = Jim_ListLength(interp, listObjPtr);
8252 for (i = 0; i < listlen; i++) {
8253 if (Jim_StringEqObj(Jim_ListGetIndex(interp, listObjPtr, i), valObj)) {
8254 return 1;
8257 return 0;
8262 static int JimExprOpStrBin(Jim_Interp *interp, struct JimExprNode *node)
8264 Jim_Obj *A, *B;
8265 jim_wide wC;
8266 int rc;
8268 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
8269 return rc;
8271 if ((rc = JimExprGetTerm(interp, node->right, &B)) != JIM_OK) {
8272 Jim_DecrRefCount(interp, A);
8273 return rc;
8276 switch (node->type) {
8277 case JIM_EXPROP_STREQ:
8278 case JIM_EXPROP_STRNE:
8279 wC = Jim_StringEqObj(A, B);
8280 if (node->type == JIM_EXPROP_STRNE) {
8281 wC = !wC;
8283 break;
8284 case JIM_EXPROP_STRIN:
8285 wC = JimSearchList(interp, B, A);
8286 break;
8287 case JIM_EXPROP_STRNI:
8288 wC = !JimSearchList(interp, B, A);
8289 break;
8290 default:
8291 abort();
8293 Jim_SetResultInt(interp, wC);
8295 Jim_DecrRefCount(interp, A);
8296 Jim_DecrRefCount(interp, B);
8298 return rc;
8301 static int ExprBool(Jim_Interp *interp, Jim_Obj *obj)
8303 long l;
8304 double d;
8305 int b;
8306 int ret = -1;
8308 /* In case the object is interp->result with refcount 1*/
8309 Jim_IncrRefCount(obj);
8311 if (Jim_GetLong(interp, obj, &l) == JIM_OK) {
8312 ret = (l != 0);
8314 else if (Jim_GetDouble(interp, obj, &d) == JIM_OK) {
8315 ret = (d != 0);
8317 else if (Jim_GetBoolean(interp, obj, &b) == JIM_OK) {
8318 ret = (b != 0);
8321 Jim_DecrRefCount(interp, obj);
8322 return ret;
8325 static int JimExprOpAnd(Jim_Interp *interp, struct JimExprNode *node)
8327 /* evaluate left */
8328 int result = JimExprGetTermBoolean(interp, node->left);
8330 if (result == 1) {
8331 /* true so evaluate right */
8332 result = JimExprGetTermBoolean(interp, node->right);
8334 if (result == -1) {
8335 return JIM_ERR;
8337 Jim_SetResultInt(interp, result);
8338 return JIM_OK;
8341 static int JimExprOpOr(Jim_Interp *interp, struct JimExprNode *node)
8343 /* evaluate left */
8344 int result = JimExprGetTermBoolean(interp, node->left);
8346 if (result == 0) {
8347 /* false so evaluate right */
8348 result = JimExprGetTermBoolean(interp, node->right);
8350 if (result == -1) {
8351 return JIM_ERR;
8353 Jim_SetResultInt(interp, result);
8354 return JIM_OK;
8357 static int JimExprOpTernary(Jim_Interp *interp, struct JimExprNode *node)
8359 /* evaluate left */
8360 int result = JimExprGetTermBoolean(interp, node->left);
8362 if (result == 1) {
8363 /* true so select right */
8364 return JimExprEvalTermNode(interp, node->right);
8366 else if (result == 0) {
8367 /* false so select ternary */
8368 return JimExprEvalTermNode(interp, node->ternary);
8370 /* error */
8371 return JIM_ERR;
8374 enum
8376 OP_FUNC = 0x0001, /* function syntax */
8377 OP_RIGHT_ASSOC = 0x0002, /* right associative */
8380 /* name - precedence - arity - opcode
8382 * This array *must* be kept in sync with the JIM_EXPROP enum.
8384 * The following macros pre-compute the string length at compile time.
8386 #define OPRINIT_ATTR(N, P, ARITY, F, ATTR) {N, F, P, ARITY, ATTR, sizeof(N) - 1}
8387 #define OPRINIT(N, P, ARITY, F) OPRINIT_ATTR(N, P, ARITY, F, 0)
8389 static const struct Jim_ExprOperator Jim_ExprOperators[] = {
8390 OPRINIT("*", 110, 2, JimExprOpBin),
8391 OPRINIT("/", 110, 2, JimExprOpBin),
8392 OPRINIT("%", 110, 2, JimExprOpIntBin),
8394 OPRINIT("-", 100, 2, JimExprOpBin),
8395 OPRINIT("+", 100, 2, JimExprOpBin),
8397 OPRINIT("<<", 90, 2, JimExprOpIntBin),
8398 OPRINIT(">>", 90, 2, JimExprOpIntBin),
8400 OPRINIT("<<<", 90, 2, JimExprOpIntBin),
8401 OPRINIT(">>>", 90, 2, JimExprOpIntBin),
8403 OPRINIT("<", 80, 2, JimExprOpBin),
8404 OPRINIT(">", 80, 2, JimExprOpBin),
8405 OPRINIT("<=", 80, 2, JimExprOpBin),
8406 OPRINIT(">=", 80, 2, JimExprOpBin),
8408 OPRINIT("==", 70, 2, JimExprOpBin),
8409 OPRINIT("!=", 70, 2, JimExprOpBin),
8411 OPRINIT("&", 50, 2, JimExprOpIntBin),
8412 OPRINIT("^", 49, 2, JimExprOpIntBin),
8413 OPRINIT("|", 48, 2, JimExprOpIntBin),
8415 OPRINIT("&&", 10, 2, JimExprOpAnd),
8416 OPRINIT("||", 9, 2, JimExprOpOr),
8417 OPRINIT_ATTR("?", 5, 3, JimExprOpTernary, OP_RIGHT_ASSOC),
8418 OPRINIT_ATTR(":", 5, 3, NULL, OP_RIGHT_ASSOC),
8420 /* Precedence is higher than * and / but lower than ! and ~, and right-associative */
8421 OPRINIT_ATTR("**", 120, 2, JimExprOpBin, OP_RIGHT_ASSOC),
8423 OPRINIT("eq", 60, 2, JimExprOpStrBin),
8424 OPRINIT("ne", 60, 2, JimExprOpStrBin),
8426 OPRINIT("in", 55, 2, JimExprOpStrBin),
8427 OPRINIT("ni", 55, 2, JimExprOpStrBin),
8429 OPRINIT_ATTR("!", 150, 1, JimExprOpNumUnary, OP_RIGHT_ASSOC),
8430 OPRINIT_ATTR("~", 150, 1, JimExprOpIntUnary, OP_RIGHT_ASSOC),
8431 OPRINIT_ATTR(" -", 150, 1, JimExprOpNumUnary, OP_RIGHT_ASSOC),
8432 OPRINIT_ATTR(" +", 150, 1, JimExprOpNumUnary, OP_RIGHT_ASSOC),
8436 OPRINIT_ATTR("int", 200, 1, JimExprOpNumUnary, OP_FUNC),
8437 OPRINIT_ATTR("wide", 200, 1, JimExprOpNumUnary, OP_FUNC),
8438 OPRINIT_ATTR("abs", 200, 1, JimExprOpNumUnary, OP_FUNC),
8439 OPRINIT_ATTR("double", 200, 1, JimExprOpNumUnary, OP_FUNC),
8440 OPRINIT_ATTR("round", 200, 1, JimExprOpNumUnary, OP_FUNC),
8441 OPRINIT_ATTR("rand", 200, 0, JimExprOpNone, OP_FUNC),
8442 OPRINIT_ATTR("srand", 200, 1, JimExprOpIntUnary, OP_FUNC),
8444 #ifdef JIM_MATH_FUNCTIONS
8445 OPRINIT_ATTR("sin", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8446 OPRINIT_ATTR("cos", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8447 OPRINIT_ATTR("tan", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8448 OPRINIT_ATTR("asin", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8449 OPRINIT_ATTR("acos", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8450 OPRINIT_ATTR("atan", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8451 OPRINIT_ATTR("atan2", 200, 2, JimExprOpBin, OP_FUNC),
8452 OPRINIT_ATTR("sinh", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8453 OPRINIT_ATTR("cosh", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8454 OPRINIT_ATTR("tanh", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8455 OPRINIT_ATTR("ceil", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8456 OPRINIT_ATTR("floor", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8457 OPRINIT_ATTR("exp", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8458 OPRINIT_ATTR("log", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8459 OPRINIT_ATTR("log10", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8460 OPRINIT_ATTR("sqrt", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8461 OPRINIT_ATTR("pow", 200, 2, JimExprOpBin, OP_FUNC),
8462 OPRINIT_ATTR("hypot", 200, 2, JimExprOpBin, OP_FUNC),
8463 OPRINIT_ATTR("fmod", 200, 2, JimExprOpBin, OP_FUNC),
8464 #endif
8466 #undef OPRINIT
8467 #undef OPRINIT_ATTR
8469 #define JIM_EXPR_OPERATORS_NUM \
8470 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
8472 static int JimParseExpression(struct JimParserCtx *pc)
8474 /* Discard spaces and quoted newline */
8475 while (isspace(UCHAR(*pc->p)) || (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) {
8476 if (*pc->p == '\n') {
8477 pc->linenr++;
8479 pc->p++;
8480 pc->len--;
8483 /* Common case */
8484 pc->tline = pc->linenr;
8485 pc->tstart = pc->p;
8487 if (pc->len == 0) {
8488 pc->tend = pc->p;
8489 pc->tt = JIM_TT_EOL;
8490 pc->eof = 1;
8491 return JIM_OK;
8493 switch (*(pc->p)) {
8494 case '(':
8495 pc->tt = JIM_TT_SUBEXPR_START;
8496 goto singlechar;
8497 case ')':
8498 pc->tt = JIM_TT_SUBEXPR_END;
8499 goto singlechar;
8500 case ',':
8501 pc->tt = JIM_TT_SUBEXPR_COMMA;
8502 singlechar:
8503 pc->tend = pc->p;
8504 pc->p++;
8505 pc->len--;
8506 break;
8507 case '[':
8508 return JimParseCmd(pc);
8509 case '$':
8510 if (JimParseVar(pc) == JIM_ERR)
8511 return JimParseExprOperator(pc);
8512 else {
8513 /* Don't allow expr sugar in expressions */
8514 if (pc->tt == JIM_TT_EXPRSUGAR) {
8515 return JIM_ERR;
8517 return JIM_OK;
8519 break;
8520 case '0':
8521 case '1':
8522 case '2':
8523 case '3':
8524 case '4':
8525 case '5':
8526 case '6':
8527 case '7':
8528 case '8':
8529 case '9':
8530 case '.':
8531 return JimParseExprNumber(pc);
8532 case '"':
8533 return JimParseQuote(pc);
8534 case '{':
8535 return JimParseBrace(pc);
8537 case 'N':
8538 case 'I':
8539 case 'n':
8540 case 'i':
8541 if (JimParseExprIrrational(pc) == JIM_ERR)
8542 if (JimParseExprBoolean(pc) == JIM_ERR)
8543 return JimParseExprOperator(pc);
8544 break;
8545 case 't':
8546 case 'f':
8547 case 'o':
8548 case 'y':
8549 if (JimParseExprBoolean(pc) == JIM_ERR)
8550 return JimParseExprOperator(pc);
8551 break;
8552 default:
8553 return JimParseExprOperator(pc);
8554 break;
8556 return JIM_OK;
8559 static int JimParseExprNumber(struct JimParserCtx *pc)
8561 char *end;
8563 /* Assume an integer for now */
8564 pc->tt = JIM_TT_EXPR_INT;
8566 jim_strtoull(pc->p, (char **)&pc->p);
8567 /* Tried as an integer, but perhaps it parses as a double */
8568 if (strchr("eENnIi.", *pc->p) || pc->p == pc->tstart) {
8569 /* Some stupid compilers insist they are cleverer that
8570 * we are. Even a (void) cast doesn't prevent this warning!
8572 if (strtod(pc->tstart, &end)) { /* nothing */ }
8573 if (end == pc->tstart)
8574 return JIM_ERR;
8575 if (end > pc->p) {
8576 /* Yes, double captured more chars */
8577 pc->tt = JIM_TT_EXPR_DOUBLE;
8578 pc->p = end;
8581 pc->tend = pc->p - 1;
8582 pc->len -= (pc->p - pc->tstart);
8583 return JIM_OK;
8586 static int JimParseExprIrrational(struct JimParserCtx *pc)
8588 const char *irrationals[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL };
8589 int i;
8591 for (i = 0; irrationals[i]; i++) {
8592 const char *irr = irrationals[i];
8594 if (strncmp(irr, pc->p, 3) == 0) {
8595 pc->p += 3;
8596 pc->len -= 3;
8597 pc->tend = pc->p - 1;
8598 pc->tt = JIM_TT_EXPR_DOUBLE;
8599 return JIM_OK;
8602 return JIM_ERR;
8605 static int JimParseExprBoolean(struct JimParserCtx *pc)
8607 const char *booleans[] = { "false", "no", "off", "true", "yes", "on", NULL };
8608 const int lengths[] = { 5, 2, 3, 4, 3, 2, 0 };
8609 int i;
8611 for (i = 0; booleans[i]; i++) {
8612 const char *boolean = booleans[i];
8613 int length = lengths[i];
8615 if (strncmp(boolean, pc->p, length) == 0) {
8616 pc->p += length;
8617 pc->len -= length;
8618 pc->tend = pc->p - 1;
8619 pc->tt = JIM_TT_EXPR_BOOLEAN;
8620 return JIM_OK;
8623 return JIM_ERR;
8626 static const struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
8628 static Jim_ExprOperator dummy_op;
8629 if (opcode < JIM_TT_EXPR_OP) {
8630 return &dummy_op;
8632 return &Jim_ExprOperators[opcode - JIM_TT_EXPR_OP];
8635 static int JimParseExprOperator(struct JimParserCtx *pc)
8637 int i;
8638 const struct Jim_ExprOperator *bestOp = NULL;
8639 int bestLen = 0;
8641 /* Try to get the longest match. */
8642 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
8643 const struct Jim_ExprOperator *op = &Jim_ExprOperators[i];
8645 if (op->name[0] != pc->p[0]) {
8646 continue;
8649 if (op->namelen > bestLen && strncmp(op->name, pc->p, op->namelen) == 0) {
8650 bestOp = op;
8651 bestLen = op->namelen;
8654 if (bestOp == NULL) {
8655 return JIM_ERR;
8658 /* Validate paretheses around function arguments */
8659 if (bestOp->attr & OP_FUNC) {
8660 const char *p = pc->p + bestLen;
8661 int len = pc->len - bestLen;
8663 while (len && isspace(UCHAR(*p))) {
8664 len--;
8665 p++;
8667 if (*p != '(') {
8668 return JIM_ERR;
8671 pc->tend = pc->p + bestLen - 1;
8672 pc->p += bestLen;
8673 pc->len -= bestLen;
8675 pc->tt = (bestOp - Jim_ExprOperators) + JIM_TT_EXPR_OP;
8676 return JIM_OK;
8679 const char *jim_tt_name(int type)
8681 static const char * const tt_names[JIM_TT_EXPR_OP] =
8682 { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "LIN", "WRD", "(((", ")))", ",,,", "INT",
8683 "DBL", "BOO", "$()" };
8684 if (type < JIM_TT_EXPR_OP) {
8685 return tt_names[type];
8687 else if (type == JIM_EXPROP_UNARYMINUS) {
8688 return "-VE";
8690 else if (type == JIM_EXPROP_UNARYPLUS) {
8691 return "+VE";
8693 else {
8694 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(type);
8695 static char buf[20];
8697 if (op->name) {
8698 return op->name;
8700 sprintf(buf, "(%d)", type);
8701 return buf;
8705 /* -----------------------------------------------------------------------------
8706 * Expression Object
8707 * ---------------------------------------------------------------------------*/
8708 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
8709 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
8710 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
8712 static const Jim_ObjType exprObjType = {
8713 "expression",
8714 FreeExprInternalRep,
8715 DupExprInternalRep,
8716 NULL,
8717 JIM_TYPE_REFERENCES,
8720 /* expr tree structure */
8721 struct ExprTree
8723 struct JimExprNode *expr; /* The first operator or term */
8724 struct JimExprNode *nodes; /* Storage of all nodes in the tree */
8725 int len; /* Number of nodes in use */
8726 int inUse; /* Used for sharing. */
8729 static void ExprTreeFreeNodes(Jim_Interp *interp, struct JimExprNode *nodes, int num)
8731 int i;
8732 for (i = 0; i < num; i++) {
8733 if (nodes[i].objPtr) {
8734 Jim_DecrRefCount(interp, nodes[i].objPtr);
8737 Jim_Free(nodes);
8740 static void ExprTreeFree(Jim_Interp *interp, struct ExprTree *expr)
8742 ExprTreeFreeNodes(interp, expr->nodes, expr->len);
8743 Jim_Free(expr);
8746 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
8748 struct ExprTree *expr = (void *)objPtr->internalRep.ptr;
8750 if (expr) {
8751 if (--expr->inUse != 0) {
8752 return;
8755 ExprTreeFree(interp, expr);
8759 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
8761 JIM_NOTUSED(interp);
8762 JIM_NOTUSED(srcPtr);
8764 /* Just returns an simple string. */
8765 dupPtr->typePtr = NULL;
8768 struct ExprBuilder {
8769 int parencount; /* count of outstanding parentheses */
8770 int level; /* recursion depth */
8771 ParseToken *token; /* The current token */
8772 ParseToken *first_token; /* The first token */
8773 Jim_Stack stack; /* stack of pending terms */
8774 Jim_Obj *exprObjPtr; /* the original expression */
8775 Jim_Obj *fileNameObj; /* filename of the original expression */
8776 struct JimExprNode *nodes; /* storage for all nodes */
8777 struct JimExprNode *next; /* storage for the next node */
8780 #ifdef DEBUG_SHOW_EXPR
8781 static void JimShowExprNode(struct JimExprNode *node, int level)
8783 int i;
8784 for (i = 0; i < level; i++) {
8785 printf(" ");
8787 if (TOKEN_IS_EXPR_OP(node->type)) {
8788 printf("%s\n", jim_tt_name(node->type));
8789 if (node->left) {
8790 JimShowExprNode(node->left, level + 1);
8792 if (node->right) {
8793 JimShowExprNode(node->right, level + 1);
8795 if (node->ternary) {
8796 JimShowExprNode(node->ternary, level + 1);
8799 else {
8800 printf("[%s] %s\n", jim_tt_name(node->type), Jim_String(node->objPtr));
8803 #endif
8805 #define EXPR_UNTIL_CLOSE 0x0001
8806 #define EXPR_FUNC_ARGS 0x0002
8807 #define EXPR_TERNARY 0x0004
8810 * Parse the subexpression at builder->token and return with the node on the stack.
8811 * builder->token is advanced to the next unconsumed token.
8812 * Returns JIM_OK if OK or JIM_ERR on error and leaves a message in the interpreter result.
8814 * 'precedence' is the precedence of the current operator. Tokens are consumed until an operator
8815 * with an equal or lower precedence is reached (or strictly lower if right associative).
8817 * If EXPR_UNTIL_CLOSE is set, the subexpression extends up to and including the next close parenthesis.
8818 * If EXPR_FUNC_ARGS is set, multiple subexpressions (terms) are expected separated by comma
8819 * If EXPR_TERNARY is set, two subexpressions (terms) are expected separated by colon
8821 * 'exp_numterms' indicates how many terms are expected. Normally this is 1, but may be more for EXPR_FUNC_ARGS and EXPR_TERNARY.
8823 static int ExprTreeBuildTree(Jim_Interp *interp, struct ExprBuilder *builder, int precedence, int flags, int exp_numterms)
8825 int rc;
8826 struct JimExprNode *node;
8827 /* Calculate the stack length expected after pushing the number of expected terms */
8828 int exp_stacklen = builder->stack.len + exp_numterms;
8830 if (builder->level++ > 200) {
8831 Jim_SetResultString(interp, "Expression too complex", -1);
8832 return JIM_ERR;
8835 while (builder->token->type != JIM_TT_EOL) {
8836 ParseToken *t = builder->token++;
8837 int prevtt;
8839 if (t == builder->first_token) {
8840 prevtt = JIM_TT_NONE;
8842 else {
8843 prevtt = t[-1].type;
8846 if (t->type == JIM_TT_SUBEXPR_START) {
8847 if (builder->stack.len == exp_stacklen) {
8848 Jim_SetResultFormatted(interp, "unexpected open parenthesis in expression: \"%#s\"", builder->exprObjPtr);
8849 return JIM_ERR;
8851 builder->parencount++;
8852 rc = ExprTreeBuildTree(interp, builder, 0, EXPR_UNTIL_CLOSE, 1);
8853 if (rc != JIM_OK) {
8854 return rc;
8856 /* A complete subexpression is on the stack */
8858 else if (t->type == JIM_TT_SUBEXPR_END) {
8859 if (!(flags & EXPR_UNTIL_CLOSE)) {
8860 if (builder->stack.len == exp_stacklen && builder->level > 1) {
8861 builder->token--;
8862 builder->level--;
8863 return JIM_OK;
8865 Jim_SetResultFormatted(interp, "unexpected closing parenthesis in expression: \"%#s\"", builder->exprObjPtr);
8866 return JIM_ERR;
8868 builder->parencount--;
8869 if (builder->stack.len == exp_stacklen) {
8870 /* Return with the expected number of subexpressions on the stack */
8871 break;
8874 else if (t->type == JIM_TT_SUBEXPR_COMMA) {
8875 if (!(flags & EXPR_FUNC_ARGS)) {
8876 if (builder->stack.len == exp_stacklen) {
8877 /* handle the comma back at the parent level */
8878 builder->token--;
8879 builder->level--;
8880 return JIM_OK;
8882 Jim_SetResultFormatted(interp, "unexpected comma in expression: \"%#s\"", builder->exprObjPtr);
8883 return JIM_ERR;
8885 else {
8886 /* If we see more terms than expected, it is an error */
8887 if (builder->stack.len > exp_stacklen) {
8888 Jim_SetResultFormatted(interp, "too many arguments to math function");
8889 return JIM_ERR;
8892 /* just go onto the next arg */
8894 else if (t->type == JIM_EXPROP_COLON) {
8895 if (!(flags & EXPR_TERNARY)) {
8896 if (builder->level != 1) {
8897 /* handle the comma back at the parent level */
8898 builder->token--;
8899 builder->level--;
8900 return JIM_OK;
8902 Jim_SetResultFormatted(interp, ": without ? in expression: \"%#s\"", builder->exprObjPtr);
8903 return JIM_ERR;
8905 if (builder->stack.len == exp_stacklen) {
8906 /* handle the comma back at the parent level */
8907 builder->token--;
8908 builder->level--;
8909 return JIM_OK;
8911 /* just go onto the next term */
8913 else if (TOKEN_IS_EXPR_OP(t->type)) {
8914 const struct Jim_ExprOperator *op;
8916 /* Convert -/+ to unary minus or unary plus if necessary */
8917 if (TOKEN_IS_EXPR_OP(prevtt) || TOKEN_IS_EXPR_START(prevtt)) {
8918 if (t->type == JIM_EXPROP_SUB) {
8919 t->type = JIM_EXPROP_UNARYMINUS;
8921 else if (t->type == JIM_EXPROP_ADD) {
8922 t->type = JIM_EXPROP_UNARYPLUS;
8926 op = JimExprOperatorInfoByOpcode(t->type);
8928 if (op->precedence < precedence || (!(op->attr & OP_RIGHT_ASSOC) && op->precedence == precedence)) {
8929 /* next op is lower precedence, or equal and left associative, so done here */
8930 builder->token--;
8931 break;
8934 if (op->attr & OP_FUNC) {
8935 if (builder->token->type != JIM_TT_SUBEXPR_START) {
8936 Jim_SetResultString(interp, "missing arguments for math function", -1);
8937 return JIM_ERR;
8939 builder->token++;
8940 if (op->arity == 0) {
8941 if (builder->token->type != JIM_TT_SUBEXPR_END) {
8942 Jim_SetResultString(interp, "too many arguments for math function", -1);
8943 return JIM_ERR;
8945 builder->token++;
8946 goto noargs;
8948 builder->parencount++;
8950 /* This will push left and return right */
8951 rc = ExprTreeBuildTree(interp, builder, 0, EXPR_FUNC_ARGS | EXPR_UNTIL_CLOSE, op->arity);
8953 else if (t->type == JIM_EXPROP_TERNARY) {
8954 /* Collect the two arguments to the ternary operator */
8955 rc = ExprTreeBuildTree(interp, builder, op->precedence, EXPR_TERNARY, 2);
8957 else {
8958 /* Recursively handle everything on the right until we see a precendence <= op->precedence or == and right associative
8959 * and push that on the term stack
8961 rc = ExprTreeBuildTree(interp, builder, op->precedence, 0, 1);
8964 if (rc != JIM_OK) {
8965 return rc;
8968 noargs:
8969 node = builder->next++;
8970 node->type = t->type;
8972 if (op->arity >= 3) {
8973 node->ternary = Jim_StackPop(&builder->stack);
8974 if (node->ternary == NULL) {
8975 goto missingoperand;
8978 if (op->arity >= 2) {
8979 node->right = Jim_StackPop(&builder->stack);
8980 if (node->right == NULL) {
8981 goto missingoperand;
8984 if (op->arity >= 1) {
8985 node->left = Jim_StackPop(&builder->stack);
8986 if (node->left == NULL) {
8987 missingoperand:
8988 Jim_SetResultFormatted(interp, "missing operand to %s in expression: \"%#s\"", op->name, builder->exprObjPtr);
8989 builder->next--;
8990 return JIM_ERR;
8995 /* Now push the node */
8996 Jim_StackPush(&builder->stack, node);
8998 else {
8999 Jim_Obj *objPtr = NULL;
9001 /* This is a simple non-operator term, so create and push the appropriate object */
9003 /* Two consecutive terms without an operator is invalid */
9004 if (!TOKEN_IS_EXPR_START(prevtt) && !TOKEN_IS_EXPR_OP(prevtt)) {
9005 Jim_SetResultFormatted(interp, "missing operator in expression: \"%#s\"", builder->exprObjPtr);
9006 return JIM_ERR;
9009 /* Immediately create a double or int object? */
9010 if (t->type == JIM_TT_EXPR_INT || t->type == JIM_TT_EXPR_DOUBLE) {
9011 char *endptr;
9012 if (t->type == JIM_TT_EXPR_INT) {
9013 objPtr = Jim_NewIntObj(interp, jim_strtoull(t->token, &endptr));
9015 else {
9016 objPtr = Jim_NewDoubleObj(interp, strtod(t->token, &endptr));
9018 if (endptr != t->token + t->len) {
9019 /* Conversion failed, so just store it as a string */
9020 Jim_FreeNewObj(interp, objPtr);
9021 objPtr = NULL;
9025 if (!objPtr) {
9026 /* Everything else is stored a simple string term */
9027 objPtr = Jim_NewStringObj(interp, t->token, t->len);
9028 if (t->type == JIM_TT_CMD) {
9029 /* Only commands need source info */
9030 JimSetSourceInfo(interp, objPtr, builder->fileNameObj, t->line);
9034 /* Now push a term node */
9035 node = builder->next++;
9036 node->objPtr = objPtr;
9037 Jim_IncrRefCount(node->objPtr);
9038 node->type = t->type;
9039 Jim_StackPush(&builder->stack, node);
9043 if (builder->stack.len == exp_stacklen) {
9044 builder->level--;
9045 return JIM_OK;
9048 if ((flags & EXPR_FUNC_ARGS)) {
9049 Jim_SetResultFormatted(interp, "too %s arguments for math function", (builder->stack.len < exp_stacklen) ? "few" : "many");
9051 else {
9052 if (builder->stack.len < exp_stacklen) {
9053 if (builder->level == 0) {
9054 Jim_SetResultFormatted(interp, "empty expression");
9056 else {
9057 Jim_SetResultFormatted(interp, "syntax error in expression \"%#s\": premature end of expression", builder->exprObjPtr);
9060 else {
9061 Jim_SetResultFormatted(interp, "extra terms after expression");
9065 return JIM_ERR;
9068 static struct ExprTree *ExprTreeCreateTree(Jim_Interp *interp, const ParseTokenList *tokenlist, Jim_Obj *exprObjPtr, Jim_Obj *fileNameObj)
9070 struct ExprTree *expr;
9071 struct ExprBuilder builder;
9072 int rc;
9073 struct JimExprNode *top = NULL;
9075 builder.parencount = 0;
9076 builder.level = 0;
9077 builder.token = builder.first_token = tokenlist->list;
9078 builder.exprObjPtr = exprObjPtr;
9079 builder.fileNameObj = fileNameObj;
9080 /* The bytecode will never produce more nodes than there are tokens - 1 (for EOL)*/
9081 builder.nodes = malloc(sizeof(struct JimExprNode) * (tokenlist->count - 1));
9082 memset(builder.nodes, 0, sizeof(struct JimExprNode) * (tokenlist->count - 1));
9083 builder.next = builder.nodes;
9084 Jim_InitStack(&builder.stack);
9086 rc = ExprTreeBuildTree(interp, &builder, 0, 0, 1);
9088 if (rc == JIM_OK) {
9089 top = Jim_StackPop(&builder.stack);
9091 if (builder.parencount) {
9092 Jim_SetResultString(interp, "missing close parenthesis", -1);
9093 rc = JIM_ERR;
9097 /* Free the stack used for the compilation. */
9098 Jim_FreeStack(&builder.stack);
9100 if (rc != JIM_OK) {
9101 ExprTreeFreeNodes(interp, builder.nodes, builder.next - builder.nodes);
9102 return NULL;
9105 expr = Jim_Alloc(sizeof(*expr));
9106 expr->inUse = 1;
9107 expr->expr = top;
9108 expr->nodes = builder.nodes;
9109 expr->len = builder.next - builder.nodes;
9111 assert(expr->len <= tokenlist->count - 1);
9113 return expr;
9116 /* This method takes the string representation of an expression
9117 * and generates a program for the expr engine */
9118 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
9120 int exprTextLen;
9121 const char *exprText;
9122 struct JimParserCtx parser;
9123 struct ExprTree *expr;
9124 ParseTokenList tokenlist;
9125 int line;
9126 Jim_Obj *fileNameObj;
9127 int rc = JIM_ERR;
9129 /* Try to get information about filename / line number */
9130 if (objPtr->typePtr == &sourceObjType) {
9131 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
9132 line = objPtr->internalRep.sourceValue.lineNumber;
9134 else {
9135 fileNameObj = interp->emptyObj;
9136 line = 1;
9138 Jim_IncrRefCount(fileNameObj);
9140 exprText = Jim_GetString(objPtr, &exprTextLen);
9142 /* Initially tokenise the expression into tokenlist */
9143 ScriptTokenListInit(&tokenlist);
9145 JimParserInit(&parser, exprText, exprTextLen, line);
9146 while (!parser.eof) {
9147 if (JimParseExpression(&parser) != JIM_OK) {
9148 ScriptTokenListFree(&tokenlist);
9149 Jim_SetResultFormatted(interp, "syntax error in expression: \"%#s\"", objPtr);
9150 expr = NULL;
9151 goto err;
9154 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
9155 parser.tline);
9158 #ifdef DEBUG_SHOW_EXPR_TOKENS
9160 int i;
9161 printf("==== Expr Tokens (%s) ====\n", Jim_String(fileNameObj));
9162 for (i = 0; i < tokenlist.count; i++) {
9163 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist.list[i].line, jim_tt_name(tokenlist.list[i].type),
9164 tokenlist.list[i].len, tokenlist.list[i].token);
9167 #endif
9169 if (JimParseCheckMissing(interp, parser.missing.ch) == JIM_ERR) {
9170 ScriptTokenListFree(&tokenlist);
9171 Jim_DecrRefCount(interp, fileNameObj);
9172 return JIM_ERR;
9175 /* Now create the expression bytecode from the tokenlist */
9176 expr = ExprTreeCreateTree(interp, &tokenlist, objPtr, fileNameObj);
9178 /* No longer need the token list */
9179 ScriptTokenListFree(&tokenlist);
9181 if (!expr) {
9182 goto err;
9185 #ifdef DEBUG_SHOW_EXPR
9186 printf("==== Expr ====\n");
9187 JimShowExprNode(expr->expr, 0);
9188 #endif
9190 rc = JIM_OK;
9192 err:
9193 /* Free the old internal rep and set the new one. */
9194 Jim_DecrRefCount(interp, fileNameObj);
9195 Jim_FreeIntRep(interp, objPtr);
9196 Jim_SetIntRepPtr(objPtr, expr);
9197 objPtr->typePtr = &exprObjType;
9198 return rc;
9201 static struct ExprTree *JimGetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
9203 if (objPtr->typePtr != &exprObjType) {
9204 if (SetExprFromAny(interp, objPtr) != JIM_OK) {
9205 return NULL;
9208 return (struct ExprTree *) Jim_GetIntRepPtr(objPtr);
9211 #ifdef JIM_OPTIMIZATION
9212 static Jim_Obj *JimExprIntValOrVar(Jim_Interp *interp, struct JimExprNode *node)
9214 if (node->type == JIM_TT_EXPR_INT)
9215 return node->objPtr;
9216 else if (node->type == JIM_TT_VAR)
9217 return Jim_GetVariable(interp, node->objPtr, JIM_NONE);
9218 else if (node->type == JIM_TT_DICTSUGAR)
9219 return JimExpandDictSugar(interp, node->objPtr);
9220 else
9221 return NULL;
9223 #endif
9225 /* -----------------------------------------------------------------------------
9226 * Expressions evaluation.
9227 * Jim uses a recursive evaluation engine for expressions,
9228 * that takes advantage of the fact that expr's operators
9229 * can't be redefined.
9231 * Jim_EvalExpression() uses the expression tree compiled by
9232 * SetExprFromAny() method of the "expression" object.
9234 * On success a Tcl Object containing the result of the evaluation
9235 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
9236 * returned.
9237 * On error the function returns a retcode != to JIM_OK and set a suitable
9238 * error on the interp.
9239 * ---------------------------------------------------------------------------*/
9241 static int JimExprEvalTermNode(Jim_Interp *interp, struct JimExprNode *node)
9243 if (TOKEN_IS_EXPR_OP(node->type)) {
9244 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(node->type);
9245 return op->funcop(interp, node);
9247 else {
9248 Jim_Obj *objPtr;
9250 /* A term */
9251 switch (node->type) {
9252 case JIM_TT_EXPR_INT:
9253 case JIM_TT_EXPR_DOUBLE:
9254 case JIM_TT_EXPR_BOOLEAN:
9255 case JIM_TT_STR:
9256 Jim_SetResult(interp, node->objPtr);
9257 return JIM_OK;
9259 case JIM_TT_VAR:
9260 objPtr = Jim_GetVariable(interp, node->objPtr, JIM_ERRMSG);
9261 if (objPtr) {
9262 Jim_SetResult(interp, objPtr);
9263 return JIM_OK;
9265 return JIM_ERR;
9267 case JIM_TT_DICTSUGAR:
9268 objPtr = JimExpandDictSugar(interp, node->objPtr);
9269 if (objPtr) {
9270 Jim_SetResult(interp, objPtr);
9271 return JIM_OK;
9273 return JIM_ERR;
9275 case JIM_TT_ESC:
9276 if (Jim_SubstObj(interp, node->objPtr, &objPtr, JIM_NONE) == JIM_OK) {
9277 Jim_SetResult(interp, objPtr);
9278 return JIM_OK;
9280 return JIM_ERR;
9282 case JIM_TT_CMD:
9283 return Jim_EvalObj(interp, node->objPtr);
9285 default:
9286 /* Should never get here */
9287 return JIM_ERR;
9292 static int JimExprGetTerm(Jim_Interp *interp, struct JimExprNode *node, Jim_Obj **objPtrPtr)
9294 int rc = JimExprEvalTermNode(interp, node);
9295 if (rc == JIM_OK) {
9296 *objPtrPtr = Jim_GetResult(interp);
9297 Jim_IncrRefCount(*objPtrPtr);
9299 return rc;
9302 static int JimExprGetTermBoolean(Jim_Interp *interp, struct JimExprNode *node)
9304 if (JimExprEvalTermNode(interp, node) == JIM_OK) {
9305 return ExprBool(interp, Jim_GetResult(interp));
9307 return -1;
9310 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr)
9312 struct ExprTree *expr;
9313 int retcode = JIM_OK;
9315 expr = JimGetExpression(interp, exprObjPtr);
9316 if (!expr) {
9317 return JIM_ERR; /* error in expression. */
9320 #ifdef JIM_OPTIMIZATION
9321 /* Check for one of the following common expressions used by while/for
9323 * CONST
9324 * $a
9325 * !$a
9326 * $a < CONST, $a < $b
9327 * $a <= CONST, $a <= $b
9328 * $a > CONST, $a > $b
9329 * $a >= CONST, $a >= $b
9330 * $a != CONST, $a != $b
9331 * $a == CONST, $a == $b
9334 Jim_Obj *objPtr;
9336 /* STEP 1 -- Check if there are the conditions to run the specialized
9337 * version of while */
9339 switch (expr->len) {
9340 case 1:
9341 objPtr = JimExprIntValOrVar(interp, expr->expr);
9342 if (objPtr) {
9343 Jim_SetResult(interp, objPtr);
9344 return JIM_OK;
9346 break;
9348 case 2:
9349 if (expr->expr->type == JIM_EXPROP_NOT) {
9350 objPtr = JimExprIntValOrVar(interp, expr->expr->left);
9352 if (objPtr && JimIsWide(objPtr)) {
9353 Jim_SetResult(interp, JimWideValue(objPtr) ? interp->falseObj : interp->trueObj);
9354 return JIM_OK;
9357 break;
9359 case 3:
9360 objPtr = JimExprIntValOrVar(interp, expr->expr->left);
9361 if (objPtr && JimIsWide(objPtr)) {
9362 Jim_Obj *objPtr2 = JimExprIntValOrVar(interp, expr->expr->right);
9363 if (objPtr2 && JimIsWide(objPtr2)) {
9364 jim_wide wideValueA = JimWideValue(objPtr);
9365 jim_wide wideValueB = JimWideValue(objPtr2);
9366 int cmpRes;
9367 switch (expr->expr->type) {
9368 case JIM_EXPROP_LT:
9369 cmpRes = wideValueA < wideValueB;
9370 break;
9371 case JIM_EXPROP_LTE:
9372 cmpRes = wideValueA <= wideValueB;
9373 break;
9374 case JIM_EXPROP_GT:
9375 cmpRes = wideValueA > wideValueB;
9376 break;
9377 case JIM_EXPROP_GTE:
9378 cmpRes = wideValueA >= wideValueB;
9379 break;
9380 case JIM_EXPROP_NUMEQ:
9381 cmpRes = wideValueA == wideValueB;
9382 break;
9383 case JIM_EXPROP_NUMNE:
9384 cmpRes = wideValueA != wideValueB;
9385 break;
9386 default:
9387 goto noopt;
9389 Jim_SetResult(interp, cmpRes ? interp->trueObj : interp->falseObj);
9390 return JIM_OK;
9393 break;
9396 noopt:
9397 #endif
9399 /* In order to avoid the internal repr being freed due to
9400 * shimmering of the exprObjPtr's object, we make the internal rep
9401 * shared. */
9402 expr->inUse++;
9404 /* Evaluate with the recursive expr engine */
9405 retcode = JimExprEvalTermNode(interp, expr->expr);
9407 expr->inUse--;
9409 return retcode;
9412 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
9414 int retcode = Jim_EvalExpression(interp, exprObjPtr);
9416 if (retcode == JIM_OK) {
9417 switch (ExprBool(interp, Jim_GetResult(interp))) {
9418 case 0:
9419 *boolPtr = 0;
9420 break;
9422 case 1:
9423 *boolPtr = 1;
9424 break;
9426 case -1:
9427 retcode = JIM_ERR;
9428 break;
9431 return retcode;
9434 /* -----------------------------------------------------------------------------
9435 * ScanFormat String Object
9436 * ---------------------------------------------------------------------------*/
9438 /* This Jim_Obj will held a parsed representation of a format string passed to
9439 * the Jim_ScanString command. For error diagnostics, the scanformat string has
9440 * to be parsed in its entirely first and then, if correct, can be used for
9441 * scanning. To avoid endless re-parsing, the parsed representation will be
9442 * stored in an internal representation and re-used for performance reason. */
9444 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
9445 * scanformat string. This part will later be used to extract information
9446 * out from the string to be parsed by Jim_ScanString */
9448 typedef struct ScanFmtPartDescr
9450 const char *arg; /* Specification of a CHARSET conversion */
9451 const char *prefix; /* Prefix to be scanned literally before conversion */
9452 size_t width; /* Maximal width of input to be converted */
9453 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
9454 char type; /* Type of conversion (e.g. c, d, f) */
9455 char modifier; /* Modify type (e.g. l - long, h - short */
9456 } ScanFmtPartDescr;
9458 /* The ScanFmtStringObj will hold the internal representation of a scanformat
9459 * string parsed and separated in part descriptions. Furthermore it contains
9460 * the original string representation of the scanformat string to allow for
9461 * fast update of the Jim_Obj's string representation part.
9463 * As an add-on the internal object representation adds some scratch pad area
9464 * for usage by Jim_ScanString to avoid endless allocating and freeing of
9465 * memory for purpose of string scanning.
9467 * The error member points to a static allocated string in case of a mal-
9468 * formed scanformat string or it contains '0' (NULL) in case of a valid
9469 * parse representation.
9471 * The whole memory of the internal representation is allocated as a single
9472 * area of memory that will be internally separated. So freeing and duplicating
9473 * of such an object is cheap */
9475 typedef struct ScanFmtStringObj
9477 jim_wide size; /* Size of internal repr in bytes */
9478 char *stringRep; /* Original string representation */
9479 size_t count; /* Number of ScanFmtPartDescr contained */
9480 size_t convCount; /* Number of conversions that will assign */
9481 size_t maxPos; /* Max position index if XPG3 is used */
9482 const char *error; /* Ptr to error text (NULL if no error */
9483 char *scratch; /* Some scratch pad used by Jim_ScanString */
9484 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
9485 } ScanFmtStringObj;
9488 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
9489 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
9490 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
9492 static const Jim_ObjType scanFmtStringObjType = {
9493 "scanformatstring",
9494 FreeScanFmtInternalRep,
9495 DupScanFmtInternalRep,
9496 UpdateStringOfScanFmt,
9497 JIM_TYPE_NONE,
9500 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
9502 JIM_NOTUSED(interp);
9503 Jim_Free((char *)objPtr->internalRep.ptr);
9504 objPtr->internalRep.ptr = 0;
9507 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
9509 size_t size = (size_t) ((ScanFmtStringObj *) srcPtr->internalRep.ptr)->size;
9510 ScanFmtStringObj *newVec = (ScanFmtStringObj *) Jim_Alloc(size);
9512 JIM_NOTUSED(interp);
9513 memcpy(newVec, srcPtr->internalRep.ptr, size);
9514 dupPtr->internalRep.ptr = newVec;
9515 dupPtr->typePtr = &scanFmtStringObjType;
9518 static void UpdateStringOfScanFmt(Jim_Obj *objPtr)
9520 JimSetStringBytes(objPtr, ((ScanFmtStringObj *) objPtr->internalRep.ptr)->stringRep);
9523 /* SetScanFmtFromAny will parse a given string and create the internal
9524 * representation of the format specification. In case of an error
9525 * the error data member of the internal representation will be set
9526 * to an descriptive error text and the function will be left with
9527 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
9528 * specification */
9530 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
9532 ScanFmtStringObj *fmtObj;
9533 char *buffer;
9534 int maxCount, i, approxSize, lastPos = -1;
9535 const char *fmt = Jim_String(objPtr);
9536 int maxFmtLen = Jim_Length(objPtr);
9537 const char *fmtEnd = fmt + maxFmtLen;
9538 int curr;
9540 Jim_FreeIntRep(interp, objPtr);
9541 /* Count how many conversions could take place maximally */
9542 for (i = 0, maxCount = 0; i < maxFmtLen; ++i)
9543 if (fmt[i] == '%')
9544 ++maxCount;
9545 /* Calculate an approximation of the memory necessary */
9546 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
9547 +(maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
9548 +maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
9549 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
9550 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
9551 +(maxCount + 1) * sizeof(char) /* '\0' for every partial */
9552 +1; /* safety byte */
9553 fmtObj = (ScanFmtStringObj *) Jim_Alloc(approxSize);
9554 memset(fmtObj, 0, approxSize);
9555 fmtObj->size = approxSize;
9556 fmtObj->maxPos = 0;
9557 fmtObj->scratch = (char *)&fmtObj->descr[maxCount + 1];
9558 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
9559 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
9560 buffer = fmtObj->stringRep + maxFmtLen + 1;
9561 objPtr->internalRep.ptr = fmtObj;
9562 objPtr->typePtr = &scanFmtStringObjType;
9563 for (i = 0, curr = 0; fmt < fmtEnd; ++fmt) {
9564 int width = 0, skip;
9565 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
9567 fmtObj->count++;
9568 descr->width = 0; /* Assume width unspecified */
9569 /* Overread and store any "literal" prefix */
9570 if (*fmt != '%' || fmt[1] == '%') {
9571 descr->type = 0;
9572 descr->prefix = &buffer[i];
9573 for (; fmt < fmtEnd; ++fmt) {
9574 if (*fmt == '%') {
9575 if (fmt[1] != '%')
9576 break;
9577 ++fmt;
9579 buffer[i++] = *fmt;
9581 buffer[i++] = 0;
9583 /* Skip the conversion introducing '%' sign */
9584 ++fmt;
9585 /* End reached due to non-conversion literal only? */
9586 if (fmt >= fmtEnd)
9587 goto done;
9588 descr->pos = 0; /* Assume "natural" positioning */
9589 if (*fmt == '*') {
9590 descr->pos = -1; /* Okay, conversion will not be assigned */
9591 ++fmt;
9593 else
9594 fmtObj->convCount++; /* Otherwise count as assign-conversion */
9595 /* Check if next token is a number (could be width or pos */
9596 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9597 fmt += skip;
9598 /* Was the number a XPG3 position specifier? */
9599 if (descr->pos != -1 && *fmt == '$') {
9600 int prev;
9602 ++fmt;
9603 descr->pos = width;
9604 width = 0;
9605 /* Look if "natural" postioning and XPG3 one was mixed */
9606 if ((lastPos == 0 && descr->pos > 0)
9607 || (lastPos > 0 && descr->pos == 0)) {
9608 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
9609 return JIM_ERR;
9611 /* Look if this position was already used */
9612 for (prev = 0; prev < curr; ++prev) {
9613 if (fmtObj->descr[prev].pos == -1)
9614 continue;
9615 if (fmtObj->descr[prev].pos == descr->pos) {
9616 fmtObj->error =
9617 "variable is assigned by multiple \"%n$\" conversion specifiers";
9618 return JIM_ERR;
9621 if (descr->pos < 0) {
9622 fmtObj->error =
9623 "\"%n$\" conversion specifier is negative";
9624 return JIM_ERR;
9626 /* Try to find a width after the XPG3 specifier */
9627 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9628 descr->width = width;
9629 fmt += skip;
9631 if (descr->pos > 0 && (size_t) descr->pos > fmtObj->maxPos)
9632 fmtObj->maxPos = descr->pos;
9634 else {
9635 /* Number was not a XPG3, so it has to be a width */
9636 descr->width = width;
9639 /* If positioning mode was undetermined yet, fix this */
9640 if (lastPos == -1)
9641 lastPos = descr->pos;
9642 /* Handle CHARSET conversion type ... */
9643 if (*fmt == '[') {
9644 int swapped = 1, beg = i, end, j;
9646 descr->type = '[';
9647 descr->arg = &buffer[i];
9648 ++fmt;
9649 if (*fmt == '^')
9650 buffer[i++] = *fmt++;
9651 if (*fmt == ']')
9652 buffer[i++] = *fmt++;
9653 while (*fmt && *fmt != ']')
9654 buffer[i++] = *fmt++;
9655 if (*fmt != ']') {
9656 fmtObj->error = "unmatched [ in format string";
9657 return JIM_ERR;
9659 end = i;
9660 buffer[i++] = 0;
9661 /* In case a range fence was given "backwards", swap it */
9662 while (swapped) {
9663 swapped = 0;
9664 for (j = beg + 1; j < end - 1; ++j) {
9665 if (buffer[j] == '-' && buffer[j - 1] > buffer[j + 1]) {
9666 char tmp = buffer[j - 1];
9668 buffer[j - 1] = buffer[j + 1];
9669 buffer[j + 1] = tmp;
9670 swapped = 1;
9675 else {
9676 /* Remember any valid modifier if given */
9677 if (fmt < fmtEnd && strchr("hlL", *fmt))
9678 descr->modifier = tolower((int)*fmt++);
9680 if (fmt >= fmtEnd) {
9681 fmtObj->error = "missing scan conversion character";
9682 return JIM_ERR;
9685 descr->type = *fmt;
9686 if (strchr("efgcsndoxui", *fmt) == 0) {
9687 fmtObj->error = "bad scan conversion character";
9688 return JIM_ERR;
9690 else if (*fmt == 'c' && descr->width != 0) {
9691 fmtObj->error = "field width may not be specified in %c " "conversion";
9692 return JIM_ERR;
9694 else if (*fmt == 'u' && descr->modifier == 'l') {
9695 fmtObj->error = "unsigned wide not supported";
9696 return JIM_ERR;
9699 curr++;
9701 done:
9702 return JIM_OK;
9705 /* Some accessor macros to allow lowlevel access to fields of internal repr */
9707 #define FormatGetCnvCount(_fo_) \
9708 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
9709 #define FormatGetMaxPos(_fo_) \
9710 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
9711 #define FormatGetError(_fo_) \
9712 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
9714 /* JimScanAString is used to scan an unspecified string that ends with
9715 * next WS, or a string that is specified via a charset.
9718 static Jim_Obj *JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
9720 char *buffer = Jim_StrDup(str);
9721 char *p = buffer;
9723 while (*str) {
9724 int c;
9725 int n;
9727 if (!sdescr && isspace(UCHAR(*str)))
9728 break; /* EOS via WS if unspecified */
9730 n = utf8_tounicode(str, &c);
9731 if (sdescr && !JimCharsetMatch(sdescr, c, JIM_CHARSET_SCAN))
9732 break;
9733 while (n--)
9734 *p++ = *str++;
9736 *p = 0;
9737 return Jim_NewStringObjNoAlloc(interp, buffer, p - buffer);
9740 /* ScanOneEntry will scan one entry out of the string passed as argument.
9741 * It use the sscanf() function for this task. After extracting and
9742 * converting of the value, the count of scanned characters will be
9743 * returned of -1 in case of no conversion tool place and string was
9744 * already scanned thru */
9746 static int ScanOneEntry(Jim_Interp *interp, const char *str, int pos, int strLen,
9747 ScanFmtStringObj * fmtObj, long idx, Jim_Obj **valObjPtr)
9749 const char *tok;
9750 const ScanFmtPartDescr *descr = &fmtObj->descr[idx];
9751 size_t scanned = 0;
9752 size_t anchor = pos;
9753 int i;
9754 Jim_Obj *tmpObj = NULL;
9756 /* First pessimistically assume, we will not scan anything :-) */
9757 *valObjPtr = 0;
9758 if (descr->prefix) {
9759 /* There was a prefix given before the conversion, skip it and adjust
9760 * the string-to-be-parsed accordingly */
9761 for (i = 0; pos < strLen && descr->prefix[i]; ++i) {
9762 /* If prefix require, skip WS */
9763 if (isspace(UCHAR(descr->prefix[i])))
9764 while (pos < strLen && isspace(UCHAR(str[pos])))
9765 ++pos;
9766 else if (descr->prefix[i] != str[pos])
9767 break; /* Prefix do not match here, leave the loop */
9768 else
9769 ++pos; /* Prefix matched so far, next round */
9771 if (pos >= strLen) {
9772 return -1; /* All of str consumed: EOF condition */
9774 else if (descr->prefix[i] != 0)
9775 return 0; /* Not whole prefix consumed, no conversion possible */
9777 /* For all but following conversion, skip leading WS */
9778 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
9779 while (isspace(UCHAR(str[pos])))
9780 ++pos;
9781 /* Determine how much skipped/scanned so far */
9782 scanned = pos - anchor;
9784 /* %c is a special, simple case. no width */
9785 if (descr->type == 'n') {
9786 /* Return pseudo conversion means: how much scanned so far? */
9787 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
9789 else if (pos >= strLen) {
9790 /* Cannot scan anything, as str is totally consumed */
9791 return -1;
9793 else if (descr->type == 'c') {
9794 int c;
9795 scanned += utf8_tounicode(&str[pos], &c);
9796 *valObjPtr = Jim_NewIntObj(interp, c);
9797 return scanned;
9799 else {
9800 /* Processing of conversions follows ... */
9801 if (descr->width > 0) {
9802 /* Do not try to scan as fas as possible but only the given width.
9803 * To ensure this, we copy the part that should be scanned. */
9804 size_t sLen = utf8_strlen(&str[pos], strLen - pos);
9805 size_t tLen = descr->width > sLen ? sLen : descr->width;
9807 tmpObj = Jim_NewStringObjUtf8(interp, str + pos, tLen);
9808 tok = tmpObj->bytes;
9810 else {
9811 /* As no width was given, simply refer to the original string */
9812 tok = &str[pos];
9814 switch (descr->type) {
9815 case 'd':
9816 case 'o':
9817 case 'x':
9818 case 'u':
9819 case 'i':{
9820 char *endp; /* Position where the number finished */
9821 jim_wide w;
9823 int base = descr->type == 'o' ? 8
9824 : descr->type == 'x' ? 16 : descr->type == 'i' ? 0 : 10;
9826 /* Try to scan a number with the given base */
9827 if (base == 0) {
9828 w = jim_strtoull(tok, &endp);
9830 else {
9831 w = strtoull(tok, &endp, base);
9834 if (endp != tok) {
9835 /* There was some number sucessfully scanned! */
9836 *valObjPtr = Jim_NewIntObj(interp, w);
9838 /* Adjust the number-of-chars scanned so far */
9839 scanned += endp - tok;
9841 else {
9842 /* Nothing was scanned. We have to determine if this
9843 * happened due to e.g. prefix mismatch or input str
9844 * exhausted */
9845 scanned = *tok ? 0 : -1;
9847 break;
9849 case 's':
9850 case '[':{
9851 *valObjPtr = JimScanAString(interp, descr->arg, tok);
9852 scanned += Jim_Length(*valObjPtr);
9853 break;
9855 case 'e':
9856 case 'f':
9857 case 'g':{
9858 char *endp;
9859 double value = strtod(tok, &endp);
9861 if (endp != tok) {
9862 /* There was some number sucessfully scanned! */
9863 *valObjPtr = Jim_NewDoubleObj(interp, value);
9864 /* Adjust the number-of-chars scanned so far */
9865 scanned += endp - tok;
9867 else {
9868 /* Nothing was scanned. We have to determine if this
9869 * happened due to e.g. prefix mismatch or input str
9870 * exhausted */
9871 scanned = *tok ? 0 : -1;
9873 break;
9876 /* If a substring was allocated (due to pre-defined width) do not
9877 * forget to free it */
9878 if (tmpObj) {
9879 Jim_FreeNewObj(interp, tmpObj);
9882 return scanned;
9885 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
9886 * string and returns all converted (and not ignored) values in a list back
9887 * to the caller. If an error occured, a NULL pointer will be returned */
9889 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *fmtObjPtr, int flags)
9891 size_t i, pos;
9892 int scanned = 1;
9893 const char *str = Jim_String(strObjPtr);
9894 int strLen = Jim_Utf8Length(interp, strObjPtr);
9895 Jim_Obj *resultList = 0;
9896 Jim_Obj **resultVec = 0;
9897 int resultc;
9898 Jim_Obj *emptyStr = 0;
9899 ScanFmtStringObj *fmtObj;
9901 /* This should never happen. The format object should already be of the correct type */
9902 JimPanic((fmtObjPtr->typePtr != &scanFmtStringObjType, "Jim_ScanString() for non-scan format"));
9904 fmtObj = (ScanFmtStringObj *) fmtObjPtr->internalRep.ptr;
9905 /* Check if format specification was valid */
9906 if (fmtObj->error != 0) {
9907 if (flags & JIM_ERRMSG)
9908 Jim_SetResultString(interp, fmtObj->error, -1);
9909 return 0;
9911 /* Allocate a new "shared" empty string for all unassigned conversions */
9912 emptyStr = Jim_NewEmptyStringObj(interp);
9913 Jim_IncrRefCount(emptyStr);
9914 /* Create a list and fill it with empty strings up to max specified XPG3 */
9915 resultList = Jim_NewListObj(interp, NULL, 0);
9916 if (fmtObj->maxPos > 0) {
9917 for (i = 0; i < fmtObj->maxPos; ++i)
9918 Jim_ListAppendElement(interp, resultList, emptyStr);
9919 JimListGetElements(interp, resultList, &resultc, &resultVec);
9921 /* Now handle every partial format description */
9922 for (i = 0, pos = 0; i < fmtObj->count; ++i) {
9923 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
9924 Jim_Obj *value = 0;
9926 /* Only last type may be "literal" w/o conversion - skip it! */
9927 if (descr->type == 0)
9928 continue;
9929 /* As long as any conversion could be done, we will proceed */
9930 if (scanned > 0)
9931 scanned = ScanOneEntry(interp, str, pos, strLen, fmtObj, i, &value);
9932 /* In case our first try results in EOF, we will leave */
9933 if (scanned == -1 && i == 0)
9934 goto eof;
9935 /* Advance next pos-to-be-scanned for the amount scanned already */
9936 pos += scanned;
9938 /* value == 0 means no conversion took place so take empty string */
9939 if (value == 0)
9940 value = Jim_NewEmptyStringObj(interp);
9941 /* If value is a non-assignable one, skip it */
9942 if (descr->pos == -1) {
9943 Jim_FreeNewObj(interp, value);
9945 else if (descr->pos == 0)
9946 /* Otherwise append it to the result list if no XPG3 was given */
9947 Jim_ListAppendElement(interp, resultList, value);
9948 else if (resultVec[descr->pos - 1] == emptyStr) {
9949 /* But due to given XPG3, put the value into the corr. slot */
9950 Jim_DecrRefCount(interp, resultVec[descr->pos - 1]);
9951 Jim_IncrRefCount(value);
9952 resultVec[descr->pos - 1] = value;
9954 else {
9955 /* Otherwise, the slot was already used - free obj and ERROR */
9956 Jim_FreeNewObj(interp, value);
9957 goto err;
9960 Jim_DecrRefCount(interp, emptyStr);
9961 return resultList;
9962 eof:
9963 Jim_DecrRefCount(interp, emptyStr);
9964 Jim_FreeNewObj(interp, resultList);
9965 return (Jim_Obj *)EOF;
9966 err:
9967 Jim_DecrRefCount(interp, emptyStr);
9968 Jim_FreeNewObj(interp, resultList);
9969 return 0;
9972 /* -----------------------------------------------------------------------------
9973 * Pseudo Random Number Generation
9974 * ---------------------------------------------------------------------------*/
9975 /* Initialize the sbox with the numbers from 0 to 255 */
9976 static void JimPrngInit(Jim_Interp *interp)
9978 #define PRNG_SEED_SIZE 256
9979 int i;
9980 unsigned int *seed;
9981 time_t t = time(NULL);
9983 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
9985 seed = Jim_Alloc(PRNG_SEED_SIZE * sizeof(*seed));
9986 for (i = 0; i < PRNG_SEED_SIZE; i++) {
9987 seed[i] = (rand() ^ t ^ clock());
9989 JimPrngSeed(interp, (unsigned char *)seed, PRNG_SEED_SIZE * sizeof(*seed));
9990 Jim_Free(seed);
9993 /* Generates N bytes of random data */
9994 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
9996 Jim_PrngState *prng;
9997 unsigned char *destByte = (unsigned char *)dest;
9998 unsigned int si, sj, x;
10000 /* initialization, only needed the first time */
10001 if (interp->prngState == NULL)
10002 JimPrngInit(interp);
10003 prng = interp->prngState;
10004 /* generates 'len' bytes of pseudo-random numbers */
10005 for (x = 0; x < len; x++) {
10006 prng->i = (prng->i + 1) & 0xff;
10007 si = prng->sbox[prng->i];
10008 prng->j = (prng->j + si) & 0xff;
10009 sj = prng->sbox[prng->j];
10010 prng->sbox[prng->i] = sj;
10011 prng->sbox[prng->j] = si;
10012 *destByte++ = prng->sbox[(si + sj) & 0xff];
10016 /* Re-seed the generator with user-provided bytes */
10017 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen)
10019 int i;
10020 Jim_PrngState *prng;
10022 /* initialization, only needed the first time */
10023 if (interp->prngState == NULL)
10024 JimPrngInit(interp);
10025 prng = interp->prngState;
10027 /* Set the sbox[i] with i */
10028 for (i = 0; i < 256; i++)
10029 prng->sbox[i] = i;
10030 /* Now use the seed to perform a random permutation of the sbox */
10031 for (i = 0; i < seedLen; i++) {
10032 unsigned char t;
10034 t = prng->sbox[i & 0xFF];
10035 prng->sbox[i & 0xFF] = prng->sbox[seed[i]];
10036 prng->sbox[seed[i]] = t;
10038 prng->i = prng->j = 0;
10040 /* discard at least the first 256 bytes of stream.
10041 * borrow the seed buffer for this
10043 for (i = 0; i < 256; i += seedLen) {
10044 JimRandomBytes(interp, seed, seedLen);
10048 /* [incr] */
10049 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10051 jim_wide wideValue, increment = 1;
10052 Jim_Obj *intObjPtr;
10054 if (argc != 2 && argc != 3) {
10055 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
10056 return JIM_ERR;
10058 if (argc == 3) {
10059 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
10060 return JIM_ERR;
10062 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
10063 if (!intObjPtr) {
10064 /* Set missing variable to 0 */
10065 wideValue = 0;
10067 else if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK) {
10068 return JIM_ERR;
10070 if (!intObjPtr || Jim_IsShared(intObjPtr)) {
10071 intObjPtr = Jim_NewIntObj(interp, wideValue + increment);
10072 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
10073 Jim_FreeNewObj(interp, intObjPtr);
10074 return JIM_ERR;
10077 else {
10078 /* Can do it the quick way */
10079 Jim_InvalidateStringRep(intObjPtr);
10080 JimWideValue(intObjPtr) = wideValue + increment;
10082 /* The following step is required in order to invalidate the
10083 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
10084 if (argv[1]->typePtr != &variableObjType) {
10085 /* Note that this can't fail since GetVariable already succeeded */
10086 Jim_SetVariable(interp, argv[1], intObjPtr);
10089 Jim_SetResult(interp, intObjPtr);
10090 return JIM_OK;
10094 /* -----------------------------------------------------------------------------
10095 * Eval
10096 * ---------------------------------------------------------------------------*/
10097 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
10098 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
10100 /* Handle calls to the [unknown] command */
10101 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10103 int retcode;
10105 /* If JimUnknown() is recursively called too many times...
10106 * done here
10108 if (interp->unknown_called > 50) {
10109 return JIM_ERR;
10112 /* The object interp->unknown just contains
10113 * the "unknown" string, it is used in order to
10114 * avoid to lookup the unknown command every time
10115 * but instead to cache the result. */
10117 /* If the [unknown] command does not exist ... */
10118 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
10119 return JIM_ERR;
10121 interp->unknown_called++;
10122 /* XXX: Are we losing fileNameObj and linenr? */
10123 retcode = Jim_EvalObjPrefix(interp, interp->unknown, argc, argv);
10124 interp->unknown_called--;
10126 return retcode;
10129 static int JimInvokeCommand(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10131 int retcode;
10132 Jim_Cmd *cmdPtr;
10133 void *prevPrivData;
10135 #if 0
10136 printf("invoke");
10137 int j;
10138 for (j = 0; j < objc; j++) {
10139 printf(" '%s'", Jim_String(objv[j]));
10141 printf("\n");
10142 #endif
10144 if (interp->framePtr->tailcallCmd) {
10145 /* Special tailcall command was pre-resolved */
10146 cmdPtr = interp->framePtr->tailcallCmd;
10147 interp->framePtr->tailcallCmd = NULL;
10149 else {
10150 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
10151 if (cmdPtr == NULL) {
10152 return JimUnknown(interp, objc, objv);
10154 JimIncrCmdRefCount(cmdPtr);
10157 if (interp->evalDepth == interp->maxEvalDepth) {
10158 Jim_SetResultString(interp, "Infinite eval recursion", -1);
10159 retcode = JIM_ERR;
10160 goto out;
10162 interp->evalDepth++;
10163 prevPrivData = interp->cmdPrivData;
10165 /* Call it -- Make sure result is an empty object. */
10166 Jim_SetEmptyResult(interp);
10167 if (cmdPtr->isproc) {
10168 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
10170 else {
10171 interp->cmdPrivData = cmdPtr->u.native.privData;
10172 retcode = cmdPtr->u.native.cmdProc(interp, objc, objv);
10174 interp->cmdPrivData = prevPrivData;
10175 interp->evalDepth--;
10177 out:
10178 JimDecrCmdRefCount(interp, cmdPtr);
10180 return retcode;
10183 /* Eval the object vector 'objv' composed of 'objc' elements.
10184 * Every element is used as single argument.
10185 * Jim_EvalObj() will call this function every time its object
10186 * argument is of "list" type, with no string representation.
10188 * This is possible because the string representation of a
10189 * list object generated by the UpdateStringOfList is made
10190 * in a way that ensures that every list element is a different
10191 * command argument. */
10192 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10194 int i, retcode;
10196 /* Incr refcount of arguments. */
10197 for (i = 0; i < objc; i++)
10198 Jim_IncrRefCount(objv[i]);
10200 retcode = JimInvokeCommand(interp, objc, objv);
10202 /* Decr refcount of arguments and return the retcode */
10203 for (i = 0; i < objc; i++)
10204 Jim_DecrRefCount(interp, objv[i]);
10206 return retcode;
10210 * Invokes 'prefix' as a command with the objv array as arguments.
10212 int Jim_EvalObjPrefix(Jim_Interp *interp, Jim_Obj *prefix, int objc, Jim_Obj *const *objv)
10214 int ret;
10215 Jim_Obj **nargv = Jim_Alloc((objc + 1) * sizeof(*nargv));
10217 nargv[0] = prefix;
10218 memcpy(&nargv[1], &objv[0], sizeof(nargv[0]) * objc);
10219 ret = Jim_EvalObjVector(interp, objc + 1, nargv);
10220 Jim_Free(nargv);
10221 return ret;
10224 static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script)
10226 if (!interp->errorFlag) {
10227 /* This is the first error, so save the file/line information and reset the stack */
10228 interp->errorFlag = 1;
10229 Jim_IncrRefCount(script->fileNameObj);
10230 Jim_DecrRefCount(interp, interp->errorFileNameObj);
10231 interp->errorFileNameObj = script->fileNameObj;
10232 interp->errorLine = script->linenr;
10234 JimResetStackTrace(interp);
10235 /* Always add a level where the error first occurs */
10236 interp->addStackTrace++;
10239 /* Now if this is an "interesting" level, add it to the stack trace */
10240 if (interp->addStackTrace > 0) {
10241 /* Add the stack info for the current level */
10243 JimAppendStackTrace(interp, Jim_String(interp->errorProc), script->fileNameObj, script->linenr);
10245 /* Note: if we didn't have a filename for this level,
10246 * don't clear the addStackTrace flag
10247 * so we can pick it up at the next level
10249 if (Jim_Length(script->fileNameObj)) {
10250 interp->addStackTrace = 0;
10253 Jim_DecrRefCount(interp, interp->errorProc);
10254 interp->errorProc = interp->emptyObj;
10255 Jim_IncrRefCount(interp->errorProc);
10259 static int JimSubstOneToken(Jim_Interp *interp, const ScriptToken *token, Jim_Obj **objPtrPtr)
10261 Jim_Obj *objPtr;
10263 switch (token->type) {
10264 case JIM_TT_STR:
10265 case JIM_TT_ESC:
10266 objPtr = token->objPtr;
10267 break;
10268 case JIM_TT_VAR:
10269 objPtr = Jim_GetVariable(interp, token->objPtr, JIM_ERRMSG);
10270 break;
10271 case JIM_TT_DICTSUGAR:
10272 objPtr = JimExpandDictSugar(interp, token->objPtr);
10273 break;
10274 case JIM_TT_EXPRSUGAR:
10275 objPtr = JimExpandExprSugar(interp, token->objPtr);
10276 break;
10277 case JIM_TT_CMD:
10278 switch (Jim_EvalObj(interp, token->objPtr)) {
10279 case JIM_OK:
10280 case JIM_RETURN:
10281 objPtr = interp->result;
10282 break;
10283 case JIM_BREAK:
10284 /* Stop substituting */
10285 return JIM_BREAK;
10286 case JIM_CONTINUE:
10287 /* just skip this one */
10288 return JIM_CONTINUE;
10289 default:
10290 return JIM_ERR;
10292 break;
10293 default:
10294 JimPanic((1,
10295 "default token type (%d) reached " "in Jim_SubstObj().", token->type));
10296 objPtr = NULL;
10297 break;
10299 if (objPtr) {
10300 *objPtrPtr = objPtr;
10301 return JIM_OK;
10303 return JIM_ERR;
10306 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
10307 * via *objPtrPtr. This function is only called by Jim_EvalObj() and Jim_SubstObj()
10308 * The returned object has refcount = 0.
10310 static Jim_Obj *JimInterpolateTokens(Jim_Interp *interp, const ScriptToken * token, int tokens, int flags)
10312 int totlen = 0, i;
10313 Jim_Obj **intv;
10314 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
10315 Jim_Obj *objPtr;
10316 char *s;
10318 if (tokens <= JIM_EVAL_SINTV_LEN)
10319 intv = sintv;
10320 else
10321 intv = Jim_Alloc(sizeof(Jim_Obj *) * tokens);
10323 /* Compute every token forming the argument
10324 * in the intv objects vector. */
10325 for (i = 0; i < tokens; i++) {
10326 switch (JimSubstOneToken(interp, &token[i], &intv[i])) {
10327 case JIM_OK:
10328 case JIM_RETURN:
10329 break;
10330 case JIM_BREAK:
10331 if (flags & JIM_SUBST_FLAG) {
10332 /* Stop here */
10333 tokens = i;
10334 continue;
10336 /* XXX: Should probably set an error about break outside loop */
10337 /* fall through to error */
10338 case JIM_CONTINUE:
10339 if (flags & JIM_SUBST_FLAG) {
10340 intv[i] = NULL;
10341 continue;
10343 /* XXX: Ditto continue outside loop */
10344 /* fall through to error */
10345 default:
10346 while (i--) {
10347 Jim_DecrRefCount(interp, intv[i]);
10349 if (intv != sintv) {
10350 Jim_Free(intv);
10352 return NULL;
10354 Jim_IncrRefCount(intv[i]);
10355 Jim_String(intv[i]);
10356 totlen += intv[i]->length;
10359 /* Fast path return for a single token */
10360 if (tokens == 1 && intv[0] && intv == sintv) {
10361 /* Reverse the Jim_IncrRefCount() above, but don't free the object */
10362 intv[0]->refCount--;
10363 return intv[0];
10366 /* Concatenate every token in an unique
10367 * object. */
10368 objPtr = Jim_NewStringObjNoAlloc(interp, NULL, 0);
10370 if (tokens == 4 && token[0].type == JIM_TT_ESC && token[1].type == JIM_TT_ESC
10371 && token[2].type == JIM_TT_VAR) {
10372 /* May be able to do fast interpolated object -> dictSubst */
10373 objPtr->typePtr = &interpolatedObjType;
10374 objPtr->internalRep.dictSubstValue.varNameObjPtr = token[0].objPtr;
10375 objPtr->internalRep.dictSubstValue.indexObjPtr = intv[2];
10376 Jim_IncrRefCount(intv[2]);
10378 else if (tokens && intv[0] && intv[0]->typePtr == &sourceObjType) {
10379 /* The first interpolated token is source, so preserve the source info */
10380 JimSetSourceInfo(interp, objPtr, intv[0]->internalRep.sourceValue.fileNameObj, intv[0]->internalRep.sourceValue.lineNumber);
10384 s = objPtr->bytes = Jim_Alloc(totlen + 1);
10385 objPtr->length = totlen;
10386 for (i = 0; i < tokens; i++) {
10387 if (intv[i]) {
10388 memcpy(s, intv[i]->bytes, intv[i]->length);
10389 s += intv[i]->length;
10390 Jim_DecrRefCount(interp, intv[i]);
10393 objPtr->bytes[totlen] = '\0';
10394 /* Free the intv vector if not static. */
10395 if (intv != sintv) {
10396 Jim_Free(intv);
10399 return objPtr;
10403 /* listPtr *must* be a list.
10404 * The contents of the list is evaluated with the first element as the command and
10405 * the remaining elements as the arguments.
10407 static int JimEvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10409 int retcode = JIM_OK;
10411 JimPanic((Jim_IsList(listPtr) == 0, "JimEvalObjList() invoked on non-list."));
10413 if (listPtr->internalRep.listValue.len) {
10414 Jim_IncrRefCount(listPtr);
10415 retcode = JimInvokeCommand(interp,
10416 listPtr->internalRep.listValue.len,
10417 listPtr->internalRep.listValue.ele);
10418 Jim_DecrRefCount(interp, listPtr);
10420 return retcode;
10423 int Jim_EvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10425 SetListFromAny(interp, listPtr);
10426 return JimEvalObjList(interp, listPtr);
10429 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
10431 int i;
10432 ScriptObj *script;
10433 ScriptToken *token;
10434 int retcode = JIM_OK;
10435 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL;
10436 Jim_Obj *prevScriptObj;
10438 /* If the object is of type "list", with no string rep we can call
10439 * a specialized version of Jim_EvalObj() */
10440 if (Jim_IsList(scriptObjPtr) && scriptObjPtr->bytes == NULL) {
10441 return JimEvalObjList(interp, scriptObjPtr);
10444 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
10445 script = JimGetScript(interp, scriptObjPtr);
10446 if (!JimScriptValid(interp, script)) {
10447 Jim_DecrRefCount(interp, scriptObjPtr);
10448 return JIM_ERR;
10451 /* Reset the interpreter result. This is useful to
10452 * return the empty result in the case of empty program. */
10453 Jim_SetEmptyResult(interp);
10455 token = script->token;
10457 #ifdef JIM_OPTIMIZATION
10458 /* Check for one of the following common scripts used by for, while
10460 * {}
10461 * incr a
10463 if (script->len == 0) {
10464 Jim_DecrRefCount(interp, scriptObjPtr);
10465 return JIM_OK;
10467 if (script->len == 3
10468 && token[1].objPtr->typePtr == &commandObjType
10469 && token[1].objPtr->internalRep.cmdValue.cmdPtr->isproc == 0
10470 && token[1].objPtr->internalRep.cmdValue.cmdPtr->u.native.cmdProc == Jim_IncrCoreCommand
10471 && token[2].objPtr->typePtr == &variableObjType) {
10473 Jim_Obj *objPtr = Jim_GetVariable(interp, token[2].objPtr, JIM_NONE);
10475 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
10476 JimWideValue(objPtr)++;
10477 Jim_InvalidateStringRep(objPtr);
10478 Jim_DecrRefCount(interp, scriptObjPtr);
10479 Jim_SetResult(interp, objPtr);
10480 return JIM_OK;
10483 #endif
10485 /* Now we have to make sure the internal repr will not be
10486 * freed on shimmering.
10488 * Think for example to this:
10490 * set x {llength $x; ... some more code ...}; eval $x
10492 * In order to preserve the internal rep, we increment the
10493 * inUse field of the script internal rep structure. */
10494 script->inUse++;
10496 /* Stash the current script */
10497 prevScriptObj = interp->currentScriptObj;
10498 interp->currentScriptObj = scriptObjPtr;
10500 interp->errorFlag = 0;
10501 argv = sargv;
10503 /* Execute every command sequentially until the end of the script
10504 * or an error occurs.
10506 for (i = 0; i < script->len && retcode == JIM_OK; ) {
10507 int argc;
10508 int j;
10510 /* First token of the line is always JIM_TT_LINE */
10511 argc = token[i].objPtr->internalRep.scriptLineValue.argc;
10512 script->linenr = token[i].objPtr->internalRep.scriptLineValue.line;
10514 /* Allocate the arguments vector if required */
10515 if (argc > JIM_EVAL_SARGV_LEN)
10516 argv = Jim_Alloc(sizeof(Jim_Obj *) * argc);
10518 /* Skip the JIM_TT_LINE token */
10519 i++;
10521 /* Populate the arguments objects.
10522 * If an error occurs, retcode will be set and
10523 * 'j' will be set to the number of args expanded
10525 for (j = 0; j < argc; j++) {
10526 long wordtokens = 1;
10527 int expand = 0;
10528 Jim_Obj *wordObjPtr = NULL;
10530 if (token[i].type == JIM_TT_WORD) {
10531 wordtokens = JimWideValue(token[i++].objPtr);
10532 if (wordtokens < 0) {
10533 expand = 1;
10534 wordtokens = -wordtokens;
10538 if (wordtokens == 1) {
10539 /* Fast path if the token does not
10540 * need interpolation */
10542 switch (token[i].type) {
10543 case JIM_TT_ESC:
10544 case JIM_TT_STR:
10545 wordObjPtr = token[i].objPtr;
10546 break;
10547 case JIM_TT_VAR:
10548 wordObjPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
10549 break;
10550 case JIM_TT_EXPRSUGAR:
10551 wordObjPtr = JimExpandExprSugar(interp, token[i].objPtr);
10552 break;
10553 case JIM_TT_DICTSUGAR:
10554 wordObjPtr = JimExpandDictSugar(interp, token[i].objPtr);
10555 break;
10556 case JIM_TT_CMD:
10557 retcode = Jim_EvalObj(interp, token[i].objPtr);
10558 if (retcode == JIM_OK) {
10559 wordObjPtr = Jim_GetResult(interp);
10561 break;
10562 default:
10563 JimPanic((1, "default token type reached " "in Jim_EvalObj()."));
10566 else {
10567 /* For interpolation we call a helper
10568 * function to do the work for us. */
10569 wordObjPtr = JimInterpolateTokens(interp, token + i, wordtokens, JIM_NONE);
10572 if (!wordObjPtr) {
10573 if (retcode == JIM_OK) {
10574 retcode = JIM_ERR;
10576 break;
10579 Jim_IncrRefCount(wordObjPtr);
10580 i += wordtokens;
10582 if (!expand) {
10583 argv[j] = wordObjPtr;
10585 else {
10586 /* Need to expand wordObjPtr into multiple args from argv[j] ... */
10587 int len = Jim_ListLength(interp, wordObjPtr);
10588 int newargc = argc + len - 1;
10589 int k;
10591 if (len > 1) {
10592 if (argv == sargv) {
10593 if (newargc > JIM_EVAL_SARGV_LEN) {
10594 argv = Jim_Alloc(sizeof(*argv) * newargc);
10595 memcpy(argv, sargv, sizeof(*argv) * j);
10598 else {
10599 /* Need to realloc to make room for (len - 1) more entries */
10600 argv = Jim_Realloc(argv, sizeof(*argv) * newargc);
10604 /* Now copy in the expanded version */
10605 for (k = 0; k < len; k++) {
10606 argv[j++] = wordObjPtr->internalRep.listValue.ele[k];
10607 Jim_IncrRefCount(wordObjPtr->internalRep.listValue.ele[k]);
10610 /* The original object reference is no longer needed,
10611 * after the expansion it is no longer present on
10612 * the argument vector, but the single elements are
10613 * in its place. */
10614 Jim_DecrRefCount(interp, wordObjPtr);
10616 /* And update the indexes */
10617 j--;
10618 argc += len - 1;
10622 if (retcode == JIM_OK && argc) {
10623 /* Invoke the command */
10624 retcode = JimInvokeCommand(interp, argc, argv);
10625 /* Check for a signal after each command */
10626 if (Jim_CheckSignal(interp)) {
10627 retcode = JIM_SIGNAL;
10631 /* Finished with the command, so decrement ref counts of each argument */
10632 while (j-- > 0) {
10633 Jim_DecrRefCount(interp, argv[j]);
10636 if (argv != sargv) {
10637 Jim_Free(argv);
10638 argv = sargv;
10642 /* Possibly add to the error stack trace */
10643 if (retcode == JIM_ERR) {
10644 JimAddErrorToStack(interp, script);
10646 /* Propagate the addStackTrace value through 'return -code error' */
10647 else if (retcode != JIM_RETURN || interp->returnCode != JIM_ERR) {
10648 /* No need to add stack trace */
10649 interp->addStackTrace = 0;
10652 /* Restore the current script */
10653 interp->currentScriptObj = prevScriptObj;
10655 /* Note that we don't have to decrement inUse, because the
10656 * following code transfers our use of the reference again to
10657 * the script object. */
10658 Jim_FreeIntRep(interp, scriptObjPtr);
10659 scriptObjPtr->typePtr = &scriptObjType;
10660 Jim_SetIntRepPtr(scriptObjPtr, script);
10661 Jim_DecrRefCount(interp, scriptObjPtr);
10663 return retcode;
10666 static int JimSetProcArg(Jim_Interp *interp, Jim_Obj *argNameObj, Jim_Obj *argValObj)
10668 int retcode;
10669 /* If argObjPtr begins with '&', do an automatic upvar */
10670 const char *varname = Jim_String(argNameObj);
10671 if (*varname == '&') {
10672 /* First check that the target variable exists */
10673 Jim_Obj *objPtr;
10674 Jim_CallFrame *savedCallFrame = interp->framePtr;
10676 interp->framePtr = interp->framePtr->parent;
10677 objPtr = Jim_GetVariable(interp, argValObj, JIM_ERRMSG);
10678 interp->framePtr = savedCallFrame;
10679 if (!objPtr) {
10680 return JIM_ERR;
10683 /* It exists, so perform the binding. */
10684 objPtr = Jim_NewStringObj(interp, varname + 1, -1);
10685 Jim_IncrRefCount(objPtr);
10686 retcode = Jim_SetVariableLink(interp, objPtr, argValObj, interp->framePtr->parent);
10687 Jim_DecrRefCount(interp, objPtr);
10689 else {
10690 retcode = Jim_SetVariable(interp, argNameObj, argValObj);
10692 return retcode;
10696 * Sets the interp result to be an error message indicating the required proc args.
10698 static void JimSetProcWrongArgs(Jim_Interp *interp, Jim_Obj *procNameObj, Jim_Cmd *cmd)
10700 /* Create a nice error message, consistent with Tcl 8.5 */
10701 Jim_Obj *argmsg = Jim_NewStringObj(interp, "", 0);
10702 int i;
10704 for (i = 0; i < cmd->u.proc.argListLen; i++) {
10705 Jim_AppendString(interp, argmsg, " ", 1);
10707 if (i == cmd->u.proc.argsPos) {
10708 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10709 /* Renamed args */
10710 Jim_AppendString(interp, argmsg, "?", 1);
10711 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].defaultObjPtr);
10712 Jim_AppendString(interp, argmsg, " ...?", -1);
10714 else {
10715 /* We have plain args */
10716 Jim_AppendString(interp, argmsg, "?arg...?", -1);
10719 else {
10720 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10721 Jim_AppendString(interp, argmsg, "?", 1);
10722 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].nameObjPtr);
10723 Jim_AppendString(interp, argmsg, "?", 1);
10725 else {
10726 const char *arg = Jim_String(cmd->u.proc.arglist[i].nameObjPtr);
10727 if (*arg == '&') {
10728 arg++;
10730 Jim_AppendString(interp, argmsg, arg, -1);
10734 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s%#s\"", procNameObj, argmsg);
10737 #ifdef jim_ext_namespace
10739 * [namespace eval]
10741 int Jim_EvalNamespace(Jim_Interp *interp, Jim_Obj *scriptObj, Jim_Obj *nsObj)
10743 Jim_CallFrame *callFramePtr;
10744 int retcode;
10746 /* Create a new callframe */
10747 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, nsObj);
10748 callFramePtr->argv = &interp->emptyObj;
10749 callFramePtr->argc = 0;
10750 callFramePtr->procArgsObjPtr = NULL;
10751 callFramePtr->procBodyObjPtr = scriptObj;
10752 callFramePtr->staticVars = NULL;
10753 callFramePtr->fileNameObj = interp->emptyObj;
10754 callFramePtr->line = 0;
10755 Jim_IncrRefCount(scriptObj);
10756 interp->framePtr = callFramePtr;
10758 /* Check if there are too nested calls */
10759 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10760 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10761 retcode = JIM_ERR;
10763 else {
10764 /* Eval the body */
10765 retcode = Jim_EvalObj(interp, scriptObj);
10768 /* Destroy the callframe */
10769 interp->framePtr = interp->framePtr->parent;
10770 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10772 return retcode;
10774 #endif
10776 /* Call a procedure implemented in Tcl.
10777 * It's possible to speed-up a lot this function, currently
10778 * the callframes are not cached, but allocated and
10779 * destroied every time. What is expecially costly is
10780 * to create/destroy the local vars hash table every time.
10782 * This can be fixed just implementing callframes caching
10783 * in JimCreateCallFrame() and JimFreeCallFrame(). */
10784 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv)
10786 Jim_CallFrame *callFramePtr;
10787 int i, d, retcode, optargs;
10788 ScriptObj *script;
10790 /* Check arity */
10791 if (argc - 1 < cmd->u.proc.reqArity ||
10792 (cmd->u.proc.argsPos < 0 && argc - 1 > cmd->u.proc.reqArity + cmd->u.proc.optArity)) {
10793 JimSetProcWrongArgs(interp, argv[0], cmd);
10794 return JIM_ERR;
10797 if (Jim_Length(cmd->u.proc.bodyObjPtr) == 0) {
10798 /* Optimise for procedure with no body - useful for optional debugging */
10799 return JIM_OK;
10802 /* Check if there are too nested calls */
10803 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10804 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10805 return JIM_ERR;
10808 /* Create a new callframe */
10809 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, cmd->u.proc.nsObj);
10810 callFramePtr->argv = argv;
10811 callFramePtr->argc = argc;
10812 callFramePtr->procArgsObjPtr = cmd->u.proc.argListObjPtr;
10813 callFramePtr->procBodyObjPtr = cmd->u.proc.bodyObjPtr;
10814 callFramePtr->staticVars = cmd->u.proc.staticVars;
10816 /* Remember where we were called from. */
10817 script = JimGetScript(interp, interp->currentScriptObj);
10818 callFramePtr->fileNameObj = script->fileNameObj;
10819 callFramePtr->line = script->linenr;
10821 Jim_IncrRefCount(cmd->u.proc.argListObjPtr);
10822 Jim_IncrRefCount(cmd->u.proc.bodyObjPtr);
10823 interp->framePtr = callFramePtr;
10825 /* How many optional args are available */
10826 optargs = (argc - 1 - cmd->u.proc.reqArity);
10828 /* Step 'i' along the actual args, and step 'd' along the formal args */
10829 i = 1;
10830 for (d = 0; d < cmd->u.proc.argListLen; d++) {
10831 Jim_Obj *nameObjPtr = cmd->u.proc.arglist[d].nameObjPtr;
10832 if (d == cmd->u.proc.argsPos) {
10833 /* assign $args */
10834 Jim_Obj *listObjPtr;
10835 int argsLen = 0;
10836 if (cmd->u.proc.reqArity + cmd->u.proc.optArity < argc - 1) {
10837 argsLen = argc - 1 - (cmd->u.proc.reqArity + cmd->u.proc.optArity);
10839 listObjPtr = Jim_NewListObj(interp, &argv[i], argsLen);
10841 /* It is possible to rename args. */
10842 if (cmd->u.proc.arglist[d].defaultObjPtr) {
10843 nameObjPtr =cmd->u.proc.arglist[d].defaultObjPtr;
10845 retcode = Jim_SetVariable(interp, nameObjPtr, listObjPtr);
10846 if (retcode != JIM_OK) {
10847 goto badargset;
10850 i += argsLen;
10851 continue;
10854 /* Optional or required? */
10855 if (cmd->u.proc.arglist[d].defaultObjPtr == NULL || optargs-- > 0) {
10856 retcode = JimSetProcArg(interp, nameObjPtr, argv[i++]);
10858 else {
10859 /* Ran out, so use the default */
10860 retcode = Jim_SetVariable(interp, nameObjPtr, cmd->u.proc.arglist[d].defaultObjPtr);
10862 if (retcode != JIM_OK) {
10863 goto badargset;
10867 /* Eval the body */
10868 retcode = Jim_EvalObj(interp, cmd->u.proc.bodyObjPtr);
10870 badargset:
10872 /* Invoke $jim::defer then destroy the callframe */
10873 retcode = JimInvokeDefer(interp, retcode);
10874 interp->framePtr = interp->framePtr->parent;
10875 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10877 /* Now chain any tailcalls in the parent frame */
10878 if (interp->framePtr->tailcallObj) {
10879 do {
10880 Jim_Obj *tailcallObj = interp->framePtr->tailcallObj;
10882 interp->framePtr->tailcallObj = NULL;
10884 if (retcode == JIM_EVAL) {
10885 retcode = Jim_EvalObjList(interp, tailcallObj);
10886 if (retcode == JIM_RETURN) {
10887 /* If the result of the tailcall is 'return', push
10888 * it up to the caller
10890 interp->returnLevel++;
10893 Jim_DecrRefCount(interp, tailcallObj);
10894 } while (interp->framePtr->tailcallObj);
10896 /* If the tailcall chain finished early, may need to manually discard the command */
10897 if (interp->framePtr->tailcallCmd) {
10898 JimDecrCmdRefCount(interp, interp->framePtr->tailcallCmd);
10899 interp->framePtr->tailcallCmd = NULL;
10903 /* Handle the JIM_RETURN return code */
10904 if (retcode == JIM_RETURN) {
10905 if (--interp->returnLevel <= 0) {
10906 retcode = interp->returnCode;
10907 interp->returnCode = JIM_OK;
10908 interp->returnLevel = 0;
10911 else if (retcode == JIM_ERR) {
10912 interp->addStackTrace++;
10913 Jim_DecrRefCount(interp, interp->errorProc);
10914 interp->errorProc = argv[0];
10915 Jim_IncrRefCount(interp->errorProc);
10918 return retcode;
10921 int Jim_EvalSource(Jim_Interp *interp, const char *filename, int lineno, const char *script)
10923 int retval;
10924 Jim_Obj *scriptObjPtr;
10926 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
10927 Jim_IncrRefCount(scriptObjPtr);
10929 if (filename) {
10930 Jim_Obj *prevScriptObj;
10932 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), lineno);
10934 prevScriptObj = interp->currentScriptObj;
10935 interp->currentScriptObj = scriptObjPtr;
10937 retval = Jim_EvalObj(interp, scriptObjPtr);
10939 interp->currentScriptObj = prevScriptObj;
10941 else {
10942 retval = Jim_EvalObj(interp, scriptObjPtr);
10944 Jim_DecrRefCount(interp, scriptObjPtr);
10945 return retval;
10948 int Jim_Eval(Jim_Interp *interp, const char *script)
10950 return Jim_EvalObj(interp, Jim_NewStringObj(interp, script, -1));
10953 /* Execute script in the scope of the global level */
10954 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
10956 int retval;
10957 Jim_CallFrame *savedFramePtr = interp->framePtr;
10959 interp->framePtr = interp->topFramePtr;
10960 retval = Jim_Eval(interp, script);
10961 interp->framePtr = savedFramePtr;
10963 return retval;
10966 int Jim_EvalFileGlobal(Jim_Interp *interp, const char *filename)
10968 int retval;
10969 Jim_CallFrame *savedFramePtr = interp->framePtr;
10971 interp->framePtr = interp->topFramePtr;
10972 retval = Jim_EvalFile(interp, filename);
10973 interp->framePtr = savedFramePtr;
10975 return retval;
10978 #include <sys/stat.h>
10980 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
10982 FILE *fp;
10983 char *buf;
10984 Jim_Obj *scriptObjPtr;
10985 Jim_Obj *prevScriptObj;
10986 struct stat sb;
10987 int retcode;
10988 int readlen;
10990 if (stat(filename, &sb) != 0 || (fp = fopen(filename, "rt")) == NULL) {
10991 Jim_SetResultFormatted(interp, "couldn't read file \"%s\": %s", filename, strerror(errno));
10992 return JIM_ERR;
10994 if (sb.st_size == 0) {
10995 fclose(fp);
10996 return JIM_OK;
10999 buf = Jim_Alloc(sb.st_size + 1);
11000 readlen = fread(buf, 1, sb.st_size, fp);
11001 if (ferror(fp)) {
11002 fclose(fp);
11003 Jim_Free(buf);
11004 Jim_SetResultFormatted(interp, "failed to load file \"%s\": %s", filename, strerror(errno));
11005 return JIM_ERR;
11007 fclose(fp);
11008 buf[readlen] = 0;
11010 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, buf, readlen);
11011 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), 1);
11012 Jim_IncrRefCount(scriptObjPtr);
11014 prevScriptObj = interp->currentScriptObj;
11015 interp->currentScriptObj = scriptObjPtr;
11017 retcode = Jim_EvalObj(interp, scriptObjPtr);
11019 /* Handle the JIM_RETURN return code */
11020 if (retcode == JIM_RETURN) {
11021 if (--interp->returnLevel <= 0) {
11022 retcode = interp->returnCode;
11023 interp->returnCode = JIM_OK;
11024 interp->returnLevel = 0;
11027 if (retcode == JIM_ERR) {
11028 /* EvalFile changes context, so add a stack frame here */
11029 interp->addStackTrace++;
11032 interp->currentScriptObj = prevScriptObj;
11034 Jim_DecrRefCount(interp, scriptObjPtr);
11036 return retcode;
11039 /* -----------------------------------------------------------------------------
11040 * Subst
11041 * ---------------------------------------------------------------------------*/
11042 static void JimParseSubst(struct JimParserCtx *pc, int flags)
11044 pc->tstart = pc->p;
11045 pc->tline = pc->linenr;
11047 if (pc->len == 0) {
11048 pc->tend = pc->p;
11049 pc->tt = JIM_TT_EOL;
11050 pc->eof = 1;
11051 return;
11053 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11054 JimParseCmd(pc);
11055 return;
11057 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11058 if (JimParseVar(pc) == JIM_OK) {
11059 return;
11061 /* Not a var, so treat as a string */
11062 pc->tstart = pc->p;
11063 flags |= JIM_SUBST_NOVAR;
11065 while (pc->len) {
11066 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11067 break;
11069 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11070 break;
11072 if (*pc->p == '\\' && pc->len > 1) {
11073 pc->p++;
11074 pc->len--;
11076 pc->p++;
11077 pc->len--;
11079 pc->tend = pc->p - 1;
11080 pc->tt = (flags & JIM_SUBST_NOESC) ? JIM_TT_STR : JIM_TT_ESC;
11083 /* The subst object type reuses most of the data structures and functions
11084 * of the script object. Script's data structures are a bit more complex
11085 * for what is needed for [subst]itution tasks, but the reuse helps to
11086 * deal with a single data structure at the cost of some more memory
11087 * usage for substitutions. */
11089 /* This method takes the string representation of an object
11090 * as a Tcl string where to perform [subst]itution, and generates
11091 * the pre-parsed internal representation. */
11092 static int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
11094 int scriptTextLen;
11095 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
11096 struct JimParserCtx parser;
11097 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
11098 ParseTokenList tokenlist;
11100 /* Initially parse the subst into tokens (in tokenlist) */
11101 ScriptTokenListInit(&tokenlist);
11103 JimParserInit(&parser, scriptText, scriptTextLen, 1);
11104 while (1) {
11105 JimParseSubst(&parser, flags);
11106 if (parser.eof) {
11107 /* Note that subst doesn't need the EOL token */
11108 break;
11110 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
11111 parser.tline);
11114 /* Create the "real" subst/script tokens from the initial token list */
11115 script->inUse = 1;
11116 script->substFlags = flags;
11117 script->fileNameObj = interp->emptyObj;
11118 Jim_IncrRefCount(script->fileNameObj);
11119 SubstObjAddTokens(interp, script, &tokenlist);
11121 /* No longer need the token list */
11122 ScriptTokenListFree(&tokenlist);
11124 #ifdef DEBUG_SHOW_SUBST
11126 int i;
11128 printf("==== Subst ====\n");
11129 for (i = 0; i < script->len; i++) {
11130 printf("[%2d] %s '%s'\n", i, jim_tt_name(script->token[i].type),
11131 Jim_String(script->token[i].objPtr));
11134 #endif
11136 /* Free the old internal rep and set the new one. */
11137 Jim_FreeIntRep(interp, objPtr);
11138 Jim_SetIntRepPtr(objPtr, script);
11139 objPtr->typePtr = &scriptObjType;
11140 return JIM_OK;
11143 static ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
11145 if (objPtr->typePtr != &scriptObjType || ((ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags != flags)
11146 SetSubstFromAny(interp, objPtr, flags);
11147 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
11150 /* Performs commands,variables,blackslashes substitution,
11151 * storing the result object (with refcount 0) into
11152 * resObjPtrPtr. */
11153 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr, Jim_Obj **resObjPtrPtr, int flags)
11155 ScriptObj *script = Jim_GetSubst(interp, substObjPtr, flags);
11157 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
11158 /* In order to preserve the internal rep, we increment the
11159 * inUse field of the script internal rep structure. */
11160 script->inUse++;
11162 *resObjPtrPtr = JimInterpolateTokens(interp, script->token, script->len, flags);
11164 script->inUse--;
11165 Jim_DecrRefCount(interp, substObjPtr);
11166 if (*resObjPtrPtr == NULL) {
11167 return JIM_ERR;
11169 return JIM_OK;
11172 /* -----------------------------------------------------------------------------
11173 * Core commands utility functions
11174 * ---------------------------------------------------------------------------*/
11175 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv, const char *msg)
11177 Jim_Obj *objPtr;
11178 Jim_Obj *listObjPtr;
11180 JimPanic((argc == 0, "Jim_WrongNumArgs() called with argc=0"));
11182 listObjPtr = Jim_NewListObj(interp, argv, argc);
11184 if (msg && *msg) {
11185 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, msg, -1));
11187 Jim_IncrRefCount(listObjPtr);
11188 objPtr = Jim_ListJoin(interp, listObjPtr, " ", 1);
11189 Jim_DecrRefCount(interp, listObjPtr);
11191 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s\"", objPtr);
11195 * May add the key and/or value to the list.
11197 typedef void JimHashtableIteratorCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr,
11198 Jim_HashEntry *he, int type);
11200 #define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL)
11203 * For each key of the hash table 'ht' (with string keys) which matches the glob pattern (all if NULL),
11204 * invoke the callback to add entries to a list.
11205 * Returns the list.
11207 static Jim_Obj *JimHashtablePatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
11208 JimHashtableIteratorCallbackType *callback, int type)
11210 Jim_HashEntry *he;
11211 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
11213 /* Check for the non-pattern case. We can do this much more efficiently. */
11214 if (patternObjPtr && JimTrivialMatch(Jim_String(patternObjPtr))) {
11215 he = Jim_FindHashEntry(ht, Jim_String(patternObjPtr));
11216 if (he) {
11217 callback(interp, listObjPtr, he, type);
11220 else {
11221 Jim_HashTableIterator htiter;
11222 JimInitHashTableIterator(ht, &htiter);
11223 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
11224 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), he->key, 0)) {
11225 callback(interp, listObjPtr, he, type);
11229 return listObjPtr;
11232 /* Keep these in order */
11233 #define JIM_CMDLIST_COMMANDS 0
11234 #define JIM_CMDLIST_PROCS 1
11235 #define JIM_CMDLIST_CHANNELS 2
11238 * Adds matching command names (procs, channels) to the list.
11240 static void JimCommandMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11241 Jim_HashEntry *he, int type)
11243 Jim_Cmd *cmdPtr = Jim_GetHashEntryVal(he);
11244 Jim_Obj *objPtr;
11246 if (type == JIM_CMDLIST_PROCS && !cmdPtr->isproc) {
11247 /* not a proc */
11248 return;
11251 objPtr = Jim_NewStringObj(interp, he->key, -1);
11252 Jim_IncrRefCount(objPtr);
11254 if (type != JIM_CMDLIST_CHANNELS || Jim_AioFilehandle(interp, objPtr)) {
11255 Jim_ListAppendElement(interp, listObjPtr, objPtr);
11257 Jim_DecrRefCount(interp, objPtr);
11260 /* type is JIM_CMDLIST_xxx */
11261 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int type)
11263 return JimHashtablePatternMatch(interp, &interp->commands, patternObjPtr, JimCommandMatch, type);
11266 /* Keep these in order */
11267 #define JIM_VARLIST_GLOBALS 0
11268 #define JIM_VARLIST_LOCALS 1
11269 #define JIM_VARLIST_VARS 2
11271 #define JIM_VARLIST_VALUES 0x1000
11274 * Adds matching variable names to the list.
11276 static void JimVariablesMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11277 Jim_HashEntry *he, int type)
11279 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
11281 if (type != JIM_VARLIST_LOCALS || varPtr->linkFramePtr == NULL) {
11282 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, he->key, -1));
11283 if (type & JIM_VARLIST_VALUES) {
11284 Jim_ListAppendElement(interp, listObjPtr, varPtr->objPtr);
11289 /* mode is JIM_VARLIST_xxx */
11290 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int mode)
11292 if (mode == JIM_VARLIST_LOCALS && interp->framePtr == interp->topFramePtr) {
11293 /* For [info locals], if we are at top level an emtpy list
11294 * is returned. I don't agree, but we aim at compatibility (SS) */
11295 return interp->emptyObj;
11297 else {
11298 Jim_CallFrame *framePtr = (mode == JIM_VARLIST_GLOBALS) ? interp->topFramePtr : interp->framePtr;
11299 return JimHashtablePatternMatch(interp, &framePtr->vars, patternObjPtr, JimVariablesMatch, mode);
11303 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
11304 Jim_Obj **objPtrPtr, int info_level_cmd)
11306 Jim_CallFrame *targetCallFrame;
11308 targetCallFrame = JimGetCallFrameByInteger(interp, levelObjPtr);
11309 if (targetCallFrame == NULL) {
11310 return JIM_ERR;
11312 /* No proc call at toplevel callframe */
11313 if (targetCallFrame == interp->topFramePtr) {
11314 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
11315 return JIM_ERR;
11317 if (info_level_cmd) {
11318 *objPtrPtr = Jim_NewListObj(interp, targetCallFrame->argv, targetCallFrame->argc);
11320 else {
11321 Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0);
11323 Jim_ListAppendElement(interp, listObj, targetCallFrame->argv[0]);
11324 Jim_ListAppendElement(interp, listObj, targetCallFrame->fileNameObj);
11325 Jim_ListAppendElement(interp, listObj, Jim_NewIntObj(interp, targetCallFrame->line));
11326 *objPtrPtr = listObj;
11328 return JIM_OK;
11331 /* -----------------------------------------------------------------------------
11332 * Core commands
11333 * ---------------------------------------------------------------------------*/
11335 /* fake [puts] -- not the real puts, just for debugging. */
11336 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11338 if (argc != 2 && argc != 3) {
11339 Jim_WrongNumArgs(interp, 1, argv, "?-nonewline? string");
11340 return JIM_ERR;
11342 if (argc == 3) {
11343 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline")) {
11344 Jim_SetResultString(interp, "The second argument must " "be -nonewline", -1);
11345 return JIM_ERR;
11347 else {
11348 fputs(Jim_String(argv[2]), stdout);
11351 else {
11352 puts(Jim_String(argv[1]));
11354 return JIM_OK;
11357 /* Helper for [+] and [*] */
11358 static int JimAddMulHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11360 jim_wide wideValue, res;
11361 double doubleValue, doubleRes;
11362 int i;
11364 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
11366 for (i = 1; i < argc; i++) {
11367 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
11368 goto trydouble;
11369 if (op == JIM_EXPROP_ADD)
11370 res += wideValue;
11371 else
11372 res *= wideValue;
11374 Jim_SetResultInt(interp, res);
11375 return JIM_OK;
11376 trydouble:
11377 doubleRes = (double)res;
11378 for (; i < argc; i++) {
11379 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11380 return JIM_ERR;
11381 if (op == JIM_EXPROP_ADD)
11382 doubleRes += doubleValue;
11383 else
11384 doubleRes *= doubleValue;
11386 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11387 return JIM_OK;
11390 /* Helper for [-] and [/] */
11391 static int JimSubDivHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11393 jim_wide wideValue, res = 0;
11394 double doubleValue, doubleRes = 0;
11395 int i = 2;
11397 if (argc < 2) {
11398 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
11399 return JIM_ERR;
11401 else if (argc == 2) {
11402 /* The arity = 2 case is different. For [- x] returns -x,
11403 * while [/ x] returns 1/x. */
11404 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
11405 if (Jim_GetDouble(interp, argv[1], &doubleValue) != JIM_OK) {
11406 return JIM_ERR;
11408 else {
11409 if (op == JIM_EXPROP_SUB)
11410 doubleRes = -doubleValue;
11411 else
11412 doubleRes = 1.0 / doubleValue;
11413 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11414 return JIM_OK;
11417 if (op == JIM_EXPROP_SUB) {
11418 res = -wideValue;
11419 Jim_SetResultInt(interp, res);
11421 else {
11422 doubleRes = 1.0 / wideValue;
11423 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11425 return JIM_OK;
11427 else {
11428 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
11429 if (Jim_GetDouble(interp, argv[1], &doubleRes)
11430 != JIM_OK) {
11431 return JIM_ERR;
11433 else {
11434 goto trydouble;
11438 for (i = 2; i < argc; i++) {
11439 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
11440 doubleRes = (double)res;
11441 goto trydouble;
11443 if (op == JIM_EXPROP_SUB)
11444 res -= wideValue;
11445 else {
11446 if (wideValue == 0) {
11447 Jim_SetResultString(interp, "Division by zero", -1);
11448 return JIM_ERR;
11450 res /= wideValue;
11453 Jim_SetResultInt(interp, res);
11454 return JIM_OK;
11455 trydouble:
11456 for (; i < argc; i++) {
11457 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11458 return JIM_ERR;
11459 if (op == JIM_EXPROP_SUB)
11460 doubleRes -= doubleValue;
11461 else
11462 doubleRes /= doubleValue;
11464 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11465 return JIM_OK;
11469 /* [+] */
11470 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11472 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
11475 /* [*] */
11476 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11478 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
11481 /* [-] */
11482 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11484 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
11487 /* [/] */
11488 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11490 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
11493 /* [set] */
11494 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11496 if (argc != 2 && argc != 3) {
11497 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
11498 return JIM_ERR;
11500 if (argc == 2) {
11501 Jim_Obj *objPtr;
11503 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11504 if (!objPtr)
11505 return JIM_ERR;
11506 Jim_SetResult(interp, objPtr);
11507 return JIM_OK;
11509 /* argc == 3 case. */
11510 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
11511 return JIM_ERR;
11512 Jim_SetResult(interp, argv[2]);
11513 return JIM_OK;
11516 /* [unset]
11518 * unset ?-nocomplain? ?--? ?varName ...?
11520 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11522 int i = 1;
11523 int complain = 1;
11525 while (i < argc) {
11526 if (Jim_CompareStringImmediate(interp, argv[i], "--")) {
11527 i++;
11528 break;
11530 if (Jim_CompareStringImmediate(interp, argv[i], "-nocomplain")) {
11531 complain = 0;
11532 i++;
11533 continue;
11535 break;
11538 while (i < argc) {
11539 if (Jim_UnsetVariable(interp, argv[i], complain ? JIM_ERRMSG : JIM_NONE) != JIM_OK
11540 && complain) {
11541 return JIM_ERR;
11543 i++;
11545 return JIM_OK;
11548 /* [while] */
11549 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11551 if (argc != 3) {
11552 Jim_WrongNumArgs(interp, 1, argv, "condition body");
11553 return JIM_ERR;
11556 /* The general purpose implementation of while starts here */
11557 while (1) {
11558 int boolean, retval;
11560 if ((retval = Jim_GetBoolFromExpr(interp, argv[1], &boolean)) != JIM_OK)
11561 return retval;
11562 if (!boolean)
11563 break;
11565 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
11566 switch (retval) {
11567 case JIM_BREAK:
11568 goto out;
11569 break;
11570 case JIM_CONTINUE:
11571 continue;
11572 break;
11573 default:
11574 return retval;
11578 out:
11579 Jim_SetEmptyResult(interp);
11580 return JIM_OK;
11583 /* [for] */
11584 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11586 int retval;
11587 int boolean = 1;
11588 Jim_Obj *varNamePtr = NULL;
11589 Jim_Obj *stopVarNamePtr = NULL;
11591 if (argc != 5) {
11592 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
11593 return JIM_ERR;
11596 /* Do the initialisation */
11597 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK) {
11598 return retval;
11601 /* And do the first test now. Better for optimisation
11602 * if we can do next/test at the bottom of the loop
11604 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11606 /* Ready to do the body as follows:
11607 * while (1) {
11608 * body // check retcode
11609 * next // check retcode
11610 * test // check retcode/test bool
11614 #ifdef JIM_OPTIMIZATION
11615 /* Check if the for is on the form:
11616 * for ... {$i < CONST} {incr i}
11617 * for ... {$i < $j} {incr i}
11619 if (retval == JIM_OK && boolean) {
11620 ScriptObj *incrScript;
11621 struct ExprTree *expr;
11622 jim_wide stop, currentVal;
11623 Jim_Obj *objPtr;
11624 int cmpOffset;
11626 /* Do it only if there aren't shared arguments */
11627 expr = JimGetExpression(interp, argv[2]);
11628 incrScript = JimGetScript(interp, argv[3]);
11630 /* Ensure proper lengths to start */
11631 if (incrScript == NULL || incrScript->len != 3 || !expr || expr->len != 3) {
11632 goto evalstart;
11634 /* Ensure proper token types. */
11635 if (incrScript->token[1].type != JIM_TT_ESC) {
11636 goto evalstart;
11639 if (expr->expr->type == JIM_EXPROP_LT) {
11640 cmpOffset = 0;
11642 else if (expr->expr->type == JIM_EXPROP_LTE) {
11643 cmpOffset = 1;
11645 else {
11646 goto evalstart;
11649 if (expr->expr->left->type != JIM_TT_VAR) {
11650 goto evalstart;
11653 if (expr->expr->right->type != JIM_TT_VAR && expr->expr->right->type != JIM_TT_EXPR_INT) {
11654 goto evalstart;
11657 /* Update command must be incr */
11658 if (!Jim_CompareStringImmediate(interp, incrScript->token[1].objPtr, "incr")) {
11659 goto evalstart;
11662 /* incr, expression must be about the same variable */
11663 if (!Jim_StringEqObj(incrScript->token[2].objPtr, expr->expr->left->objPtr)) {
11664 goto evalstart;
11667 /* Get the stop condition (must be a variable or integer) */
11668 if (expr->expr->right->type == JIM_TT_EXPR_INT) {
11669 if (Jim_GetWide(interp, expr->expr->right->objPtr, &stop) == JIM_ERR) {
11670 goto evalstart;
11673 else {
11674 stopVarNamePtr = expr->expr->right->objPtr;
11675 Jim_IncrRefCount(stopVarNamePtr);
11676 /* Keep the compiler happy */
11677 stop = 0;
11680 /* Initialization */
11681 varNamePtr = expr->expr->left->objPtr;
11682 Jim_IncrRefCount(varNamePtr);
11684 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
11685 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK) {
11686 goto testcond;
11689 /* --- OPTIMIZED FOR --- */
11690 while (retval == JIM_OK) {
11691 /* === Check condition === */
11692 /* Note that currentVal is already set here */
11694 /* Immediate or Variable? get the 'stop' value if the latter. */
11695 if (stopVarNamePtr) {
11696 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
11697 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &stop) != JIM_OK) {
11698 goto testcond;
11702 if (currentVal >= stop + cmpOffset) {
11703 break;
11706 /* Eval body */
11707 retval = Jim_EvalObj(interp, argv[4]);
11708 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11709 retval = JIM_OK;
11711 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
11713 /* Increment */
11714 if (objPtr == NULL) {
11715 retval = JIM_ERR;
11716 goto out;
11718 if (!Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11719 currentVal = ++JimWideValue(objPtr);
11720 Jim_InvalidateStringRep(objPtr);
11722 else {
11723 if (Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK ||
11724 Jim_SetVariable(interp, varNamePtr, Jim_NewIntObj(interp,
11725 ++currentVal)) != JIM_OK) {
11726 goto evalnext;
11731 goto out;
11733 evalstart:
11734 #endif
11736 while (boolean && (retval == JIM_OK || retval == JIM_CONTINUE)) {
11737 /* Body */
11738 retval = Jim_EvalObj(interp, argv[4]);
11740 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11741 /* increment */
11742 JIM_IF_OPTIM(evalnext:)
11743 retval = Jim_EvalObj(interp, argv[3]);
11744 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11745 /* test */
11746 JIM_IF_OPTIM(testcond:)
11747 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11751 JIM_IF_OPTIM(out:)
11752 if (stopVarNamePtr) {
11753 Jim_DecrRefCount(interp, stopVarNamePtr);
11755 if (varNamePtr) {
11756 Jim_DecrRefCount(interp, varNamePtr);
11759 if (retval == JIM_CONTINUE || retval == JIM_BREAK || retval == JIM_OK) {
11760 Jim_SetEmptyResult(interp);
11761 return JIM_OK;
11764 return retval;
11767 /* [loop] */
11768 static int Jim_LoopCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11770 int retval;
11771 jim_wide i;
11772 jim_wide limit;
11773 jim_wide incr = 1;
11774 Jim_Obj *bodyObjPtr;
11776 if (argc != 5 && argc != 6) {
11777 Jim_WrongNumArgs(interp, 1, argv, "var first limit ?incr? body");
11778 return JIM_ERR;
11781 if (Jim_GetWide(interp, argv[2], &i) != JIM_OK ||
11782 Jim_GetWide(interp, argv[3], &limit) != JIM_OK ||
11783 (argc == 6 && Jim_GetWide(interp, argv[4], &incr) != JIM_OK)) {
11784 return JIM_ERR;
11786 bodyObjPtr = (argc == 5) ? argv[4] : argv[5];
11788 retval = Jim_SetVariable(interp, argv[1], argv[2]);
11790 while (((i < limit && incr > 0) || (i > limit && incr < 0)) && retval == JIM_OK) {
11791 retval = Jim_EvalObj(interp, bodyObjPtr);
11792 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11793 Jim_Obj *objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11795 retval = JIM_OK;
11797 /* Increment */
11798 i += incr;
11800 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11801 if (argv[1]->typePtr != &variableObjType) {
11802 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11803 return JIM_ERR;
11806 JimWideValue(objPtr) = i;
11807 Jim_InvalidateStringRep(objPtr);
11809 /* The following step is required in order to invalidate the
11810 * string repr of "FOO" if the var name is of the form of "FOO(IDX)" */
11811 if (argv[1]->typePtr != &variableObjType) {
11812 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11813 retval = JIM_ERR;
11814 break;
11818 else {
11819 objPtr = Jim_NewIntObj(interp, i);
11820 retval = Jim_SetVariable(interp, argv[1], objPtr);
11821 if (retval != JIM_OK) {
11822 Jim_FreeNewObj(interp, objPtr);
11828 if (retval == JIM_OK || retval == JIM_CONTINUE || retval == JIM_BREAK) {
11829 Jim_SetEmptyResult(interp);
11830 return JIM_OK;
11832 return retval;
11835 /* List iterators make it easy to iterate over a list.
11836 * At some point iterators will be expanded to support generators.
11838 typedef struct {
11839 Jim_Obj *objPtr;
11840 int idx;
11841 } Jim_ListIter;
11844 * Initialise the iterator at the start of the list.
11846 static void JimListIterInit(Jim_ListIter *iter, Jim_Obj *objPtr)
11848 iter->objPtr = objPtr;
11849 iter->idx = 0;
11853 * Returns the next object from the list, or NULL on end-of-list.
11855 static Jim_Obj *JimListIterNext(Jim_Interp *interp, Jim_ListIter *iter)
11857 if (iter->idx >= Jim_ListLength(interp, iter->objPtr)) {
11858 return NULL;
11860 return iter->objPtr->internalRep.listValue.ele[iter->idx++];
11864 * Returns 1 if end-of-list has been reached.
11866 static int JimListIterDone(Jim_Interp *interp, Jim_ListIter *iter)
11868 return iter->idx >= Jim_ListLength(interp, iter->objPtr);
11871 /* foreach + lmap implementation. */
11872 static int JimForeachMapHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int doMap)
11874 int result = JIM_OK;
11875 int i, numargs;
11876 Jim_ListIter twoiters[2]; /* Avoid allocation for a single list */
11877 Jim_ListIter *iters;
11878 Jim_Obj *script;
11879 Jim_Obj *resultObj;
11881 if (argc < 4 || argc % 2 != 0) {
11882 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
11883 return JIM_ERR;
11885 script = argv[argc - 1]; /* Last argument is a script */
11886 numargs = (argc - 1 - 1); /* argc - 'foreach' - script */
11888 if (numargs == 2) {
11889 iters = twoiters;
11891 else {
11892 iters = Jim_Alloc(numargs * sizeof(*iters));
11894 for (i = 0; i < numargs; i++) {
11895 JimListIterInit(&iters[i], argv[i + 1]);
11896 if (i % 2 == 0 && JimListIterDone(interp, &iters[i])) {
11897 result = JIM_ERR;
11900 if (result != JIM_OK) {
11901 Jim_SetResultString(interp, "foreach varlist is empty", -1);
11902 goto empty_varlist;
11905 if (doMap) {
11906 resultObj = Jim_NewListObj(interp, NULL, 0);
11908 else {
11909 resultObj = interp->emptyObj;
11911 Jim_IncrRefCount(resultObj);
11913 while (1) {
11914 /* Have we expired all lists? */
11915 for (i = 0; i < numargs; i += 2) {
11916 if (!JimListIterDone(interp, &iters[i + 1])) {
11917 break;
11920 if (i == numargs) {
11921 /* All done */
11922 break;
11925 /* For each list */
11926 for (i = 0; i < numargs; i += 2) {
11927 Jim_Obj *varName;
11929 /* foreach var */
11930 JimListIterInit(&iters[i], argv[i + 1]);
11931 while ((varName = JimListIterNext(interp, &iters[i])) != NULL) {
11932 Jim_Obj *valObj = JimListIterNext(interp, &iters[i + 1]);
11933 if (!valObj) {
11934 /* Ran out, so store the empty string */
11935 valObj = interp->emptyObj;
11937 /* Avoid shimmering */
11938 Jim_IncrRefCount(valObj);
11939 result = Jim_SetVariable(interp, varName, valObj);
11940 Jim_DecrRefCount(interp, valObj);
11941 if (result != JIM_OK) {
11942 goto err;
11946 switch (result = Jim_EvalObj(interp, script)) {
11947 case JIM_OK:
11948 if (doMap) {
11949 Jim_ListAppendElement(interp, resultObj, interp->result);
11951 break;
11952 case JIM_CONTINUE:
11953 break;
11954 case JIM_BREAK:
11955 goto out;
11956 default:
11957 goto err;
11960 out:
11961 result = JIM_OK;
11962 Jim_SetResult(interp, resultObj);
11963 err:
11964 Jim_DecrRefCount(interp, resultObj);
11965 empty_varlist:
11966 if (numargs > 2) {
11967 Jim_Free(iters);
11969 return result;
11972 /* [foreach] */
11973 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11975 return JimForeachMapHelper(interp, argc, argv, 0);
11978 /* [lmap] */
11979 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11981 return JimForeachMapHelper(interp, argc, argv, 1);
11984 /* [lassign] */
11985 static int Jim_LassignCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11987 int result = JIM_ERR;
11988 int i;
11989 Jim_ListIter iter;
11990 Jim_Obj *resultObj;
11992 if (argc < 2) {
11993 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varName ...?");
11994 return JIM_ERR;
11997 JimListIterInit(&iter, argv[1]);
11999 for (i = 2; i < argc; i++) {
12000 Jim_Obj *valObj = JimListIterNext(interp, &iter);
12001 result = Jim_SetVariable(interp, argv[i], valObj ? valObj : interp->emptyObj);
12002 if (result != JIM_OK) {
12003 return result;
12007 resultObj = Jim_NewListObj(interp, NULL, 0);
12008 while (!JimListIterDone(interp, &iter)) {
12009 Jim_ListAppendElement(interp, resultObj, JimListIterNext(interp, &iter));
12012 Jim_SetResult(interp, resultObj);
12014 return JIM_OK;
12017 /* [if] */
12018 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12020 int boolean, retval, current = 1, falsebody = 0;
12022 if (argc >= 3) {
12023 while (1) {
12024 /* Far not enough arguments given! */
12025 if (current >= argc)
12026 goto err;
12027 if ((retval = Jim_GetBoolFromExpr(interp, argv[current++], &boolean))
12028 != JIM_OK)
12029 return retval;
12030 /* There lacks something, isn't it? */
12031 if (current >= argc)
12032 goto err;
12033 if (Jim_CompareStringImmediate(interp, argv[current], "then"))
12034 current++;
12035 /* Tsk tsk, no then-clause? */
12036 if (current >= argc)
12037 goto err;
12038 if (boolean)
12039 return Jim_EvalObj(interp, argv[current]);
12040 /* Ok: no else-clause follows */
12041 if (++current >= argc) {
12042 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
12043 return JIM_OK;
12045 falsebody = current++;
12046 if (Jim_CompareStringImmediate(interp, argv[falsebody], "else")) {
12047 /* IIICKS - else-clause isn't last cmd? */
12048 if (current != argc - 1)
12049 goto err;
12050 return Jim_EvalObj(interp, argv[current]);
12052 else if (Jim_CompareStringImmediate(interp, argv[falsebody], "elseif"))
12053 /* Ok: elseif follows meaning all the stuff
12054 * again (how boring...) */
12055 continue;
12056 /* OOPS - else-clause is not last cmd? */
12057 else if (falsebody != argc - 1)
12058 goto err;
12059 return Jim_EvalObj(interp, argv[falsebody]);
12061 return JIM_OK;
12063 err:
12064 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
12065 return JIM_ERR;
12069 /* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)*/
12070 int Jim_CommandMatchObj(Jim_Interp *interp, Jim_Obj *commandObj, Jim_Obj *patternObj,
12071 Jim_Obj *stringObj, int nocase)
12073 Jim_Obj *parms[4];
12074 int argc = 0;
12075 long eq;
12076 int rc;
12078 parms[argc++] = commandObj;
12079 if (nocase) {
12080 parms[argc++] = Jim_NewStringObj(interp, "-nocase", -1);
12082 parms[argc++] = patternObj;
12083 parms[argc++] = stringObj;
12085 rc = Jim_EvalObjVector(interp, argc, parms);
12087 if (rc != JIM_OK || Jim_GetLong(interp, Jim_GetResult(interp), &eq) != JIM_OK) {
12088 eq = -rc;
12091 return eq;
12094 /* [switch] */
12095 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12097 enum { SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD };
12098 int matchOpt = SWITCH_EXACT, opt = 1, patCount, i;
12099 Jim_Obj *command = NULL, *scriptObj = NULL, *strObj;
12100 Jim_Obj **caseList;
12102 if (argc < 3) {
12103 wrongnumargs:
12104 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
12105 "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}");
12106 return JIM_ERR;
12108 for (opt = 1; opt < argc; ++opt) {
12109 const char *option = Jim_String(argv[opt]);
12111 if (*option != '-')
12112 break;
12113 else if (strncmp(option, "--", 2) == 0) {
12114 ++opt;
12115 break;
12117 else if (strncmp(option, "-exact", 2) == 0)
12118 matchOpt = SWITCH_EXACT;
12119 else if (strncmp(option, "-glob", 2) == 0)
12120 matchOpt = SWITCH_GLOB;
12121 else if (strncmp(option, "-regexp", 2) == 0)
12122 matchOpt = SWITCH_RE;
12123 else if (strncmp(option, "-command", 2) == 0) {
12124 matchOpt = SWITCH_CMD;
12125 if ((argc - opt) < 2)
12126 goto wrongnumargs;
12127 command = argv[++opt];
12129 else {
12130 Jim_SetResultFormatted(interp,
12131 "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --",
12132 argv[opt]);
12133 return JIM_ERR;
12135 if ((argc - opt) < 2)
12136 goto wrongnumargs;
12138 strObj = argv[opt++];
12139 patCount = argc - opt;
12140 if (patCount == 1) {
12141 JimListGetElements(interp, argv[opt], &patCount, &caseList);
12143 else
12144 caseList = (Jim_Obj **)&argv[opt];
12145 if (patCount == 0 || patCount % 2 != 0)
12146 goto wrongnumargs;
12147 for (i = 0; scriptObj == NULL && i < patCount; i += 2) {
12148 Jim_Obj *patObj = caseList[i];
12150 if (!Jim_CompareStringImmediate(interp, patObj, "default")
12151 || i < (patCount - 2)) {
12152 switch (matchOpt) {
12153 case SWITCH_EXACT:
12154 if (Jim_StringEqObj(strObj, patObj))
12155 scriptObj = caseList[i + 1];
12156 break;
12157 case SWITCH_GLOB:
12158 if (Jim_StringMatchObj(interp, patObj, strObj, 0))
12159 scriptObj = caseList[i + 1];
12160 break;
12161 case SWITCH_RE:
12162 command = Jim_NewStringObj(interp, "regexp", -1);
12163 /* Fall thru intentionally */
12164 case SWITCH_CMD:{
12165 int rc = Jim_CommandMatchObj(interp, command, patObj, strObj, 0);
12167 /* After the execution of a command we need to
12168 * make sure to reconvert the object into a list
12169 * again. Only for the single-list style [switch]. */
12170 if (argc - opt == 1) {
12171 JimListGetElements(interp, argv[opt], &patCount, &caseList);
12173 /* command is here already decref'd */
12174 if (rc < 0) {
12175 return -rc;
12177 if (rc)
12178 scriptObj = caseList[i + 1];
12179 break;
12183 else {
12184 scriptObj = caseList[i + 1];
12187 for (; i < patCount && Jim_CompareStringImmediate(interp, scriptObj, "-"); i += 2)
12188 scriptObj = caseList[i + 1];
12189 if (scriptObj && Jim_CompareStringImmediate(interp, scriptObj, "-")) {
12190 Jim_SetResultFormatted(interp, "no body specified for pattern \"%#s\"", caseList[i - 2]);
12191 return JIM_ERR;
12193 Jim_SetEmptyResult(interp);
12194 if (scriptObj) {
12195 return Jim_EvalObj(interp, scriptObj);
12197 return JIM_OK;
12200 /* [list] */
12201 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12203 Jim_Obj *listObjPtr;
12205 listObjPtr = Jim_NewListObj(interp, argv + 1, argc - 1);
12206 Jim_SetResult(interp, listObjPtr);
12207 return JIM_OK;
12210 /* [lindex] */
12211 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12213 Jim_Obj *objPtr, *listObjPtr;
12214 int i;
12215 int idx;
12217 if (argc < 2) {
12218 Jim_WrongNumArgs(interp, 1, argv, "list ?index ...?");
12219 return JIM_ERR;
12221 objPtr = argv[1];
12222 Jim_IncrRefCount(objPtr);
12223 for (i = 2; i < argc; i++) {
12224 listObjPtr = objPtr;
12225 if (Jim_GetIndex(interp, argv[i], &idx) != JIM_OK) {
12226 Jim_DecrRefCount(interp, listObjPtr);
12227 return JIM_ERR;
12229 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_NONE) != JIM_OK) {
12230 /* Returns an empty object if the index
12231 * is out of range. */
12232 Jim_DecrRefCount(interp, listObjPtr);
12233 Jim_SetEmptyResult(interp);
12234 return JIM_OK;
12236 Jim_IncrRefCount(objPtr);
12237 Jim_DecrRefCount(interp, listObjPtr);
12239 Jim_SetResult(interp, objPtr);
12240 Jim_DecrRefCount(interp, objPtr);
12241 return JIM_OK;
12244 /* [llength] */
12245 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12247 if (argc != 2) {
12248 Jim_WrongNumArgs(interp, 1, argv, "list");
12249 return JIM_ERR;
12251 Jim_SetResultInt(interp, Jim_ListLength(interp, argv[1]));
12252 return JIM_OK;
12255 /* [lsearch] */
12256 static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12258 static const char * const options[] = {
12259 "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
12260 NULL
12262 enum
12263 { OPT_BOOL, OPT_NOT, OPT_NOCASE, OPT_EXACT, OPT_GLOB, OPT_REGEXP, OPT_ALL, OPT_INLINE,
12264 OPT_COMMAND };
12265 int i;
12266 int opt_bool = 0;
12267 int opt_not = 0;
12268 int opt_nocase = 0;
12269 int opt_all = 0;
12270 int opt_inline = 0;
12271 int opt_match = OPT_EXACT;
12272 int listlen;
12273 int rc = JIM_OK;
12274 Jim_Obj *listObjPtr = NULL;
12275 Jim_Obj *commandObj = NULL;
12277 if (argc < 3) {
12278 wrongargs:
12279 Jim_WrongNumArgs(interp, 1, argv,
12280 "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
12281 return JIM_ERR;
12284 for (i = 1; i < argc - 2; i++) {
12285 int option;
12287 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG) != JIM_OK) {
12288 return JIM_ERR;
12290 switch (option) {
12291 case OPT_BOOL:
12292 opt_bool = 1;
12293 opt_inline = 0;
12294 break;
12295 case OPT_NOT:
12296 opt_not = 1;
12297 break;
12298 case OPT_NOCASE:
12299 opt_nocase = 1;
12300 break;
12301 case OPT_INLINE:
12302 opt_inline = 1;
12303 opt_bool = 0;
12304 break;
12305 case OPT_ALL:
12306 opt_all = 1;
12307 break;
12308 case OPT_COMMAND:
12309 if (i >= argc - 2) {
12310 goto wrongargs;
12312 commandObj = argv[++i];
12313 /* fallthru */
12314 case OPT_EXACT:
12315 case OPT_GLOB:
12316 case OPT_REGEXP:
12317 opt_match = option;
12318 break;
12322 argv += i;
12324 if (opt_all) {
12325 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12327 if (opt_match == OPT_REGEXP) {
12328 commandObj = Jim_NewStringObj(interp, "regexp", -1);
12330 if (commandObj) {
12331 Jim_IncrRefCount(commandObj);
12334 listlen = Jim_ListLength(interp, argv[0]);
12335 for (i = 0; i < listlen; i++) {
12336 int eq = 0;
12337 Jim_Obj *objPtr = Jim_ListGetIndex(interp, argv[0], i);
12339 switch (opt_match) {
12340 case OPT_EXACT:
12341 eq = Jim_StringCompareObj(interp, argv[1], objPtr, opt_nocase) == 0;
12342 break;
12344 case OPT_GLOB:
12345 eq = Jim_StringMatchObj(interp, argv[1], objPtr, opt_nocase);
12346 break;
12348 case OPT_REGEXP:
12349 case OPT_COMMAND:
12350 eq = Jim_CommandMatchObj(interp, commandObj, argv[1], objPtr, opt_nocase);
12351 if (eq < 0) {
12352 if (listObjPtr) {
12353 Jim_FreeNewObj(interp, listObjPtr);
12355 rc = JIM_ERR;
12356 goto done;
12358 break;
12361 /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
12362 if (!eq && opt_bool && opt_not && !opt_all) {
12363 continue;
12366 if ((!opt_bool && eq == !opt_not) || (opt_bool && (eq || opt_all))) {
12367 /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
12368 Jim_Obj *resultObj;
12370 if (opt_bool) {
12371 resultObj = Jim_NewIntObj(interp, eq ^ opt_not);
12373 else if (!opt_inline) {
12374 resultObj = Jim_NewIntObj(interp, i);
12376 else {
12377 resultObj = objPtr;
12380 if (opt_all) {
12381 Jim_ListAppendElement(interp, listObjPtr, resultObj);
12383 else {
12384 Jim_SetResult(interp, resultObj);
12385 goto done;
12390 if (opt_all) {
12391 Jim_SetResult(interp, listObjPtr);
12393 else {
12394 /* No match */
12395 if (opt_bool) {
12396 Jim_SetResultBool(interp, opt_not);
12398 else if (!opt_inline) {
12399 Jim_SetResultInt(interp, -1);
12403 done:
12404 if (commandObj) {
12405 Jim_DecrRefCount(interp, commandObj);
12407 return rc;
12410 /* [lappend] */
12411 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12413 Jim_Obj *listObjPtr;
12414 int new_obj = 0;
12415 int i;
12417 if (argc < 2) {
12418 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
12419 return JIM_ERR;
12421 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12422 if (!listObjPtr) {
12423 /* Create the list if it does not exist */
12424 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12425 new_obj = 1;
12427 else if (Jim_IsShared(listObjPtr)) {
12428 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
12429 new_obj = 1;
12431 for (i = 2; i < argc; i++)
12432 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
12433 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
12434 if (new_obj)
12435 Jim_FreeNewObj(interp, listObjPtr);
12436 return JIM_ERR;
12438 Jim_SetResult(interp, listObjPtr);
12439 return JIM_OK;
12442 /* [linsert] */
12443 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12445 int idx, len;
12446 Jim_Obj *listPtr;
12448 if (argc < 3) {
12449 Jim_WrongNumArgs(interp, 1, argv, "list index ?element ...?");
12450 return JIM_ERR;
12452 listPtr = argv[1];
12453 if (Jim_IsShared(listPtr))
12454 listPtr = Jim_DuplicateObj(interp, listPtr);
12455 if (Jim_GetIndex(interp, argv[2], &idx) != JIM_OK)
12456 goto err;
12457 len = Jim_ListLength(interp, listPtr);
12458 if (idx >= len)
12459 idx = len;
12460 else if (idx < 0)
12461 idx = len + idx + 1;
12462 Jim_ListInsertElements(interp, listPtr, idx, argc - 3, &argv[3]);
12463 Jim_SetResult(interp, listPtr);
12464 return JIM_OK;
12465 err:
12466 if (listPtr != argv[1]) {
12467 Jim_FreeNewObj(interp, listPtr);
12469 return JIM_ERR;
12472 /* [lreplace] */
12473 static int Jim_LreplaceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12475 int first, last, len, rangeLen;
12476 Jim_Obj *listObj;
12477 Jim_Obj *newListObj;
12479 if (argc < 4) {
12480 Jim_WrongNumArgs(interp, 1, argv, "list first last ?element ...?");
12481 return JIM_ERR;
12483 if (Jim_GetIndex(interp, argv[2], &first) != JIM_OK ||
12484 Jim_GetIndex(interp, argv[3], &last) != JIM_OK) {
12485 return JIM_ERR;
12488 listObj = argv[1];
12489 len = Jim_ListLength(interp, listObj);
12491 first = JimRelToAbsIndex(len, first);
12492 last = JimRelToAbsIndex(len, last);
12493 JimRelToAbsRange(len, &first, &last, &rangeLen);
12495 /* Now construct a new list which consists of:
12496 * <elements before first> <supplied elements> <elements after last>
12499 /* Check to see if trying to replace past the end of the list */
12500 if (first < len) {
12501 /* OK. Not past the end */
12503 else if (len == 0) {
12504 /* Special for empty list, adjust first to 0 */
12505 first = 0;
12507 else {
12508 Jim_SetResultString(interp, "list doesn't contain element ", -1);
12509 Jim_AppendObj(interp, Jim_GetResult(interp), argv[2]);
12510 return JIM_ERR;
12513 /* Add the first set of elements */
12514 newListObj = Jim_NewListObj(interp, listObj->internalRep.listValue.ele, first);
12516 /* Add supplied elements */
12517 ListInsertElements(newListObj, -1, argc - 4, argv + 4);
12519 /* Add the remaining elements */
12520 ListInsertElements(newListObj, -1, len - first - rangeLen, listObj->internalRep.listValue.ele + first + rangeLen);
12522 Jim_SetResult(interp, newListObj);
12523 return JIM_OK;
12526 /* [lset] */
12527 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12529 if (argc < 3) {
12530 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
12531 return JIM_ERR;
12533 else if (argc == 3) {
12534 /* With no indexes, simply implements [set] */
12535 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
12536 return JIM_ERR;
12537 Jim_SetResult(interp, argv[2]);
12538 return JIM_OK;
12540 return Jim_ListSetIndex(interp, argv[1], argv + 2, argc - 3, argv[argc - 1]);
12543 /* [lsort] */
12544 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
12546 static const char * const options[] = {
12547 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", NULL
12549 enum
12550 { OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_REAL, OPT_INDEX, OPT_UNIQUE };
12551 Jim_Obj *resObj;
12552 int i;
12553 int retCode;
12554 int shared;
12556 struct lsort_info info;
12558 if (argc < 2) {
12559 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
12560 return JIM_ERR;
12563 info.type = JIM_LSORT_ASCII;
12564 info.order = 1;
12565 info.indexed = 0;
12566 info.unique = 0;
12567 info.command = NULL;
12568 info.interp = interp;
12570 for (i = 1; i < (argc - 1); i++) {
12571 int option;
12573 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ENUM_ABBREV | JIM_ERRMSG)
12574 != JIM_OK)
12575 return JIM_ERR;
12576 switch (option) {
12577 case OPT_ASCII:
12578 info.type = JIM_LSORT_ASCII;
12579 break;
12580 case OPT_NOCASE:
12581 info.type = JIM_LSORT_NOCASE;
12582 break;
12583 case OPT_INTEGER:
12584 info.type = JIM_LSORT_INTEGER;
12585 break;
12586 case OPT_REAL:
12587 info.type = JIM_LSORT_REAL;
12588 break;
12589 case OPT_INCREASING:
12590 info.order = 1;
12591 break;
12592 case OPT_DECREASING:
12593 info.order = -1;
12594 break;
12595 case OPT_UNIQUE:
12596 info.unique = 1;
12597 break;
12598 case OPT_COMMAND:
12599 if (i >= (argc - 2)) {
12600 Jim_SetResultString(interp, "\"-command\" option must be followed by comparison command", -1);
12601 return JIM_ERR;
12603 info.type = JIM_LSORT_COMMAND;
12604 info.command = argv[i + 1];
12605 i++;
12606 break;
12607 case OPT_INDEX:
12608 if (i >= (argc - 2)) {
12609 Jim_SetResultString(interp, "\"-index\" option must be followed by list index", -1);
12610 return JIM_ERR;
12612 if (Jim_GetIndex(interp, argv[i + 1], &info.index) != JIM_OK) {
12613 return JIM_ERR;
12615 info.indexed = 1;
12616 i++;
12617 break;
12620 resObj = argv[argc - 1];
12621 if ((shared = Jim_IsShared(resObj)))
12622 resObj = Jim_DuplicateObj(interp, resObj);
12623 retCode = ListSortElements(interp, resObj, &info);
12624 if (retCode == JIM_OK) {
12625 Jim_SetResult(interp, resObj);
12627 else if (shared) {
12628 Jim_FreeNewObj(interp, resObj);
12630 return retCode;
12633 /* [append] */
12634 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12636 Jim_Obj *stringObjPtr;
12637 int i;
12639 if (argc < 2) {
12640 Jim_WrongNumArgs(interp, 1, argv, "varName ?value ...?");
12641 return JIM_ERR;
12643 if (argc == 2) {
12644 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
12645 if (!stringObjPtr)
12646 return JIM_ERR;
12648 else {
12649 int new_obj = 0;
12650 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12651 if (!stringObjPtr) {
12652 /* Create the string if it doesn't exist */
12653 stringObjPtr = Jim_NewEmptyStringObj(interp);
12654 new_obj = 1;
12656 else if (Jim_IsShared(stringObjPtr)) {
12657 new_obj = 1;
12658 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
12660 for (i = 2; i < argc; i++) {
12661 Jim_AppendObj(interp, stringObjPtr, argv[i]);
12663 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
12664 if (new_obj) {
12665 Jim_FreeNewObj(interp, stringObjPtr);
12667 return JIM_ERR;
12670 Jim_SetResult(interp, stringObjPtr);
12671 return JIM_OK;
12674 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12676 * Returns a zero-refcount list describing the expression at 'node'
12678 static Jim_Obj *JimGetExprAsList(Jim_Interp *interp, struct JimExprNode *node)
12680 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
12682 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, jim_tt_name(node->type), -1));
12683 if (TOKEN_IS_EXPR_OP(node->type)) {
12684 if (node->left) {
12685 Jim_ListAppendElement(interp, listObjPtr, JimGetExprAsList(interp, node->left));
12687 if (node->right) {
12688 Jim_ListAppendElement(interp, listObjPtr, JimGetExprAsList(interp, node->right));
12690 if (node->ternary) {
12691 Jim_ListAppendElement(interp, listObjPtr, JimGetExprAsList(interp, node->ternary));
12694 else {
12695 Jim_ListAppendElement(interp, listObjPtr, node->objPtr);
12697 return listObjPtr;
12699 #endif /* JIM_DEBUG_COMMAND && !JIM_BOOTSTRAP */
12701 /* [debug] */
12702 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12704 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12705 static const char * const options[] = {
12706 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
12707 "exprbc", "show",
12708 NULL
12710 enum
12712 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
12713 OPT_EXPRLEN, OPT_EXPRBC, OPT_SHOW,
12715 int option;
12717 if (argc < 2) {
12718 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?...?");
12719 return JIM_ERR;
12721 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK)
12722 return Jim_CheckShowCommands(interp, argv[1], options);
12723 if (option == OPT_REFCOUNT) {
12724 if (argc != 3) {
12725 Jim_WrongNumArgs(interp, 2, argv, "object");
12726 return JIM_ERR;
12728 Jim_SetResultInt(interp, argv[2]->refCount);
12729 return JIM_OK;
12731 else if (option == OPT_OBJCOUNT) {
12732 int freeobj = 0, liveobj = 0;
12733 char buf[256];
12734 Jim_Obj *objPtr;
12736 if (argc != 2) {
12737 Jim_WrongNumArgs(interp, 2, argv, "");
12738 return JIM_ERR;
12740 /* Count the number of free objects. */
12741 objPtr = interp->freeList;
12742 while (objPtr) {
12743 freeobj++;
12744 objPtr = objPtr->nextObjPtr;
12746 /* Count the number of live objects. */
12747 objPtr = interp->liveList;
12748 while (objPtr) {
12749 liveobj++;
12750 objPtr = objPtr->nextObjPtr;
12752 /* Set the result string and return. */
12753 sprintf(buf, "free %d used %d", freeobj, liveobj);
12754 Jim_SetResultString(interp, buf, -1);
12755 return JIM_OK;
12757 else if (option == OPT_OBJECTS) {
12758 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
12760 /* Count the number of live objects. */
12761 objPtr = interp->liveList;
12762 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12763 while (objPtr) {
12764 char buf[128];
12765 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "";
12767 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
12768 sprintf(buf, "%p", objPtr);
12769 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, buf, -1));
12770 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, type, -1));
12771 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewIntObj(interp, objPtr->refCount));
12772 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
12773 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
12774 objPtr = objPtr->nextObjPtr;
12776 Jim_SetResult(interp, listObjPtr);
12777 return JIM_OK;
12779 else if (option == OPT_INVSTR) {
12780 Jim_Obj *objPtr;
12782 if (argc != 3) {
12783 Jim_WrongNumArgs(interp, 2, argv, "object");
12784 return JIM_ERR;
12786 objPtr = argv[2];
12787 if (objPtr->typePtr != NULL)
12788 Jim_InvalidateStringRep(objPtr);
12789 Jim_SetEmptyResult(interp);
12790 return JIM_OK;
12792 else if (option == OPT_SHOW) {
12793 const char *s;
12794 int len, charlen;
12796 if (argc != 3) {
12797 Jim_WrongNumArgs(interp, 2, argv, "object");
12798 return JIM_ERR;
12800 s = Jim_GetString(argv[2], &len);
12801 #ifdef JIM_UTF8
12802 charlen = utf8_strlen(s, len);
12803 #else
12804 charlen = len;
12805 #endif
12806 printf("refcount: %d, type: %s\n", argv[2]->refCount, JimObjTypeName(argv[2]));
12807 printf("chars (%d): <<%s>>\n", charlen, s);
12808 printf("bytes (%d):", len);
12809 while (len--) {
12810 printf(" %02x", (unsigned char)*s++);
12812 printf("\n");
12813 return JIM_OK;
12815 else if (option == OPT_SCRIPTLEN) {
12816 ScriptObj *script;
12818 if (argc != 3) {
12819 Jim_WrongNumArgs(interp, 2, argv, "script");
12820 return JIM_ERR;
12822 script = JimGetScript(interp, argv[2]);
12823 if (script == NULL)
12824 return JIM_ERR;
12825 Jim_SetResultInt(interp, script->len);
12826 return JIM_OK;
12828 else if (option == OPT_EXPRLEN) {
12829 struct ExprTree *expr;
12831 if (argc != 3) {
12832 Jim_WrongNumArgs(interp, 2, argv, "expression");
12833 return JIM_ERR;
12835 expr = JimGetExpression(interp, argv[2]);
12836 if (expr == NULL)
12837 return JIM_ERR;
12838 Jim_SetResultInt(interp, expr->len);
12839 return JIM_OK;
12841 else if (option == OPT_EXPRBC) {
12842 struct ExprTree *expr;
12844 if (argc != 3) {
12845 Jim_WrongNumArgs(interp, 2, argv, "expression");
12846 return JIM_ERR;
12848 expr = JimGetExpression(interp, argv[2]);
12849 if (expr == NULL)
12850 return JIM_ERR;
12851 Jim_SetResult(interp, JimGetExprAsList(interp, expr->expr));
12852 return JIM_OK;
12854 else {
12855 Jim_SetResultString(interp,
12856 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
12857 return JIM_ERR;
12859 /* unreached */
12860 #endif /* JIM_DEBUG_COMMAND && !JIM_BOOTSTRAP */
12861 #if !defined(JIM_DEBUG_COMMAND)
12862 Jim_SetResultString(interp, "unsupported", -1);
12863 return JIM_ERR;
12864 #endif
12867 /* [eval] */
12868 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12870 int rc;
12872 if (argc < 2) {
12873 Jim_WrongNumArgs(interp, 1, argv, "arg ?arg ...?");
12874 return JIM_ERR;
12877 if (argc == 2) {
12878 rc = Jim_EvalObj(interp, argv[1]);
12880 else {
12881 rc = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12884 if (rc == JIM_ERR) {
12885 /* eval is "interesting", so add a stack frame here */
12886 interp->addStackTrace++;
12888 return rc;
12891 /* [uplevel] */
12892 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12894 if (argc >= 2) {
12895 int retcode;
12896 Jim_CallFrame *savedCallFrame, *targetCallFrame;
12897 const char *str;
12899 /* Save the old callframe pointer */
12900 savedCallFrame = interp->framePtr;
12902 /* Lookup the target frame pointer */
12903 str = Jim_String(argv[1]);
12904 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#') {
12905 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
12906 argc--;
12907 argv++;
12909 else {
12910 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
12912 if (targetCallFrame == NULL) {
12913 return JIM_ERR;
12915 if (argc < 2) {
12916 Jim_WrongNumArgs(interp, 1, argv - 1, "?level? command ?arg ...?");
12917 return JIM_ERR;
12919 /* Eval the code in the target callframe. */
12920 interp->framePtr = targetCallFrame;
12921 if (argc == 2) {
12922 retcode = Jim_EvalObj(interp, argv[1]);
12924 else {
12925 retcode = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12927 interp->framePtr = savedCallFrame;
12928 return retcode;
12930 else {
12931 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
12932 return JIM_ERR;
12936 /* [expr] */
12937 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12939 int retcode;
12941 if (argc == 2) {
12942 retcode = Jim_EvalExpression(interp, argv[1]);
12944 else if (argc > 2) {
12945 Jim_Obj *objPtr;
12947 objPtr = Jim_ConcatObj(interp, argc - 1, argv + 1);
12948 Jim_IncrRefCount(objPtr);
12949 retcode = Jim_EvalExpression(interp, objPtr);
12950 Jim_DecrRefCount(interp, objPtr);
12952 else {
12953 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
12954 return JIM_ERR;
12956 if (retcode != JIM_OK)
12957 return retcode;
12958 return JIM_OK;
12961 /* [break] */
12962 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12964 if (argc != 1) {
12965 Jim_WrongNumArgs(interp, 1, argv, "");
12966 return JIM_ERR;
12968 return JIM_BREAK;
12971 /* [continue] */
12972 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12974 if (argc != 1) {
12975 Jim_WrongNumArgs(interp, 1, argv, "");
12976 return JIM_ERR;
12978 return JIM_CONTINUE;
12981 /* [return] */
12982 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12984 int i;
12985 Jim_Obj *stackTraceObj = NULL;
12986 Jim_Obj *errorCodeObj = NULL;
12987 int returnCode = JIM_OK;
12988 long level = 1;
12990 for (i = 1; i < argc - 1; i += 2) {
12991 if (Jim_CompareStringImmediate(interp, argv[i], "-code")) {
12992 if (Jim_GetReturnCode(interp, argv[i + 1], &returnCode) == JIM_ERR) {
12993 return JIM_ERR;
12996 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorinfo")) {
12997 stackTraceObj = argv[i + 1];
12999 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorcode")) {
13000 errorCodeObj = argv[i + 1];
13002 else if (Jim_CompareStringImmediate(interp, argv[i], "-level")) {
13003 if (Jim_GetLong(interp, argv[i + 1], &level) != JIM_OK || level < 0) {
13004 Jim_SetResultFormatted(interp, "bad level \"%#s\"", argv[i + 1]);
13005 return JIM_ERR;
13008 else {
13009 break;
13013 if (i != argc - 1 && i != argc) {
13014 Jim_WrongNumArgs(interp, 1, argv,
13015 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
13018 /* If a stack trace is supplied and code is error, set the stack trace */
13019 if (stackTraceObj && returnCode == JIM_ERR) {
13020 JimSetStackTrace(interp, stackTraceObj);
13022 /* If an error code list is supplied, set the global $errorCode */
13023 if (errorCodeObj && returnCode == JIM_ERR) {
13024 Jim_SetGlobalVariableStr(interp, "errorCode", errorCodeObj);
13026 interp->returnCode = returnCode;
13027 interp->returnLevel = level;
13029 if (i == argc - 1) {
13030 Jim_SetResult(interp, argv[i]);
13032 return JIM_RETURN;
13035 /* [tailcall] */
13036 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13038 if (interp->framePtr->level == 0) {
13039 Jim_SetResultString(interp, "tailcall can only be called from a proc or lambda", -1);
13040 return JIM_ERR;
13042 else if (argc >= 2) {
13043 /* Need to resolve the tailcall command in the current context */
13044 Jim_CallFrame *cf = interp->framePtr->parent;
13046 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13047 if (cmdPtr == NULL) {
13048 return JIM_ERR;
13051 JimPanic((cf->tailcallCmd != NULL, "Already have a tailcallCmd"));
13053 /* And stash this pre-resolved command */
13054 JimIncrCmdRefCount(cmdPtr);
13055 cf->tailcallCmd = cmdPtr;
13057 /* And stash the command list */
13058 JimPanic((cf->tailcallObj != NULL, "Already have a tailcallobj"));
13060 cf->tailcallObj = Jim_NewListObj(interp, argv + 1, argc - 1);
13061 Jim_IncrRefCount(cf->tailcallObj);
13063 /* When the stack unwinds to the previous proc, the stashed command will be evaluated */
13064 return JIM_EVAL;
13066 return JIM_OK;
13069 static int JimAliasCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13071 Jim_Obj *cmdList;
13072 Jim_Obj *prefixListObj = Jim_CmdPrivData(interp);
13074 /* prefixListObj is a list to which the args need to be appended */
13075 cmdList = Jim_DuplicateObj(interp, prefixListObj);
13076 Jim_ListInsertElements(interp, cmdList, Jim_ListLength(interp, cmdList), argc - 1, argv + 1);
13078 return JimEvalObjList(interp, cmdList);
13081 static void JimAliasCmdDelete(Jim_Interp *interp, void *privData)
13083 Jim_Obj *prefixListObj = privData;
13084 Jim_DecrRefCount(interp, prefixListObj);
13087 static int Jim_AliasCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13089 Jim_Obj *prefixListObj;
13090 const char *newname;
13092 if (argc < 3) {
13093 Jim_WrongNumArgs(interp, 1, argv, "newname command ?args ...?");
13094 return JIM_ERR;
13097 prefixListObj = Jim_NewListObj(interp, argv + 2, argc - 2);
13098 Jim_IncrRefCount(prefixListObj);
13099 newname = Jim_String(argv[1]);
13100 if (newname[0] == ':' && newname[1] == ':') {
13101 while (*++newname == ':') {
13105 Jim_SetResult(interp, argv[1]);
13107 return Jim_CreateCommand(interp, newname, JimAliasCmd, prefixListObj, JimAliasCmdDelete);
13110 /* [proc] */
13111 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13113 Jim_Cmd *cmd;
13115 if (argc != 4 && argc != 5) {
13116 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
13117 return JIM_ERR;
13120 if (JimValidName(interp, "procedure", argv[1]) != JIM_OK) {
13121 return JIM_ERR;
13124 if (argc == 4) {
13125 cmd = JimCreateProcedureCmd(interp, argv[2], NULL, argv[3], NULL);
13127 else {
13128 cmd = JimCreateProcedureCmd(interp, argv[2], argv[3], argv[4], NULL);
13131 if (cmd) {
13132 /* Add the new command */
13133 Jim_Obj *qualifiedCmdNameObj;
13134 const char *cmdname = JimQualifyName(interp, Jim_String(argv[1]), &qualifiedCmdNameObj);
13136 JimCreateCommand(interp, cmdname, cmd);
13138 /* Calculate and set the namespace for this proc */
13139 JimUpdateProcNamespace(interp, cmd, cmdname);
13141 JimFreeQualifiedName(interp, qualifiedCmdNameObj);
13143 /* Unlike Tcl, set the name of the proc as the result */
13144 Jim_SetResult(interp, argv[1]);
13145 return JIM_OK;
13147 return JIM_ERR;
13150 /* [local] */
13151 static int Jim_LocalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13153 int retcode;
13155 if (argc < 2) {
13156 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13157 return JIM_ERR;
13160 /* Evaluate the arguments with 'local' in force */
13161 interp->local++;
13162 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13163 interp->local--;
13166 /* If OK, and the result is a proc, add it to the list of local procs */
13167 if (retcode == 0) {
13168 Jim_Obj *cmdNameObj = Jim_GetResult(interp);
13170 if (Jim_GetCommand(interp, cmdNameObj, JIM_ERRMSG) == NULL) {
13171 return JIM_ERR;
13173 if (interp->framePtr->localCommands == NULL) {
13174 interp->framePtr->localCommands = Jim_Alloc(sizeof(*interp->framePtr->localCommands));
13175 Jim_InitStack(interp->framePtr->localCommands);
13177 Jim_IncrRefCount(cmdNameObj);
13178 Jim_StackPush(interp->framePtr->localCommands, cmdNameObj);
13181 return retcode;
13184 /* [upcall] */
13185 static int Jim_UpcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13187 if (argc < 2) {
13188 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13189 return JIM_ERR;
13191 else {
13192 int retcode;
13194 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13195 if (cmdPtr == NULL || !cmdPtr->isproc || !cmdPtr->prevCmd) {
13196 Jim_SetResultFormatted(interp, "no previous command: \"%#s\"", argv[1]);
13197 return JIM_ERR;
13199 /* OK. Mark this command as being in an upcall */
13200 cmdPtr->u.proc.upcall++;
13201 JimIncrCmdRefCount(cmdPtr);
13203 /* Invoke the command as normal */
13204 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13206 /* No longer in an upcall */
13207 cmdPtr->u.proc.upcall--;
13208 JimDecrCmdRefCount(interp, cmdPtr);
13210 return retcode;
13214 /* [apply] */
13215 static int Jim_ApplyCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13217 if (argc < 2) {
13218 Jim_WrongNumArgs(interp, 1, argv, "lambdaExpr ?arg ...?");
13219 return JIM_ERR;
13221 else {
13222 int ret;
13223 Jim_Cmd *cmd;
13224 Jim_Obj *argListObjPtr;
13225 Jim_Obj *bodyObjPtr;
13226 Jim_Obj *nsObj = NULL;
13227 Jim_Obj **nargv;
13229 int len = Jim_ListLength(interp, argv[1]);
13230 if (len != 2 && len != 3) {
13231 Jim_SetResultFormatted(interp, "can't interpret \"%#s\" as a lambda expression", argv[1]);
13232 return JIM_ERR;
13235 if (len == 3) {
13236 #ifdef jim_ext_namespace
13237 /* Need to canonicalise the given namespace. */
13238 nsObj = JimQualifyNameObj(interp, Jim_ListGetIndex(interp, argv[1], 2));
13239 #else
13240 Jim_SetResultString(interp, "namespaces not enabled", -1);
13241 return JIM_ERR;
13242 #endif
13244 argListObjPtr = Jim_ListGetIndex(interp, argv[1], 0);
13245 bodyObjPtr = Jim_ListGetIndex(interp, argv[1], 1);
13247 cmd = JimCreateProcedureCmd(interp, argListObjPtr, NULL, bodyObjPtr, nsObj);
13249 if (cmd) {
13250 /* Create a new argv array with a dummy argv[0], for error messages */
13251 nargv = Jim_Alloc((argc - 2 + 1) * sizeof(*nargv));
13252 nargv[0] = Jim_NewStringObj(interp, "apply lambdaExpr", -1);
13253 Jim_IncrRefCount(nargv[0]);
13254 memcpy(&nargv[1], argv + 2, (argc - 2) * sizeof(*nargv));
13255 ret = JimCallProcedure(interp, cmd, argc - 2 + 1, nargv);
13256 Jim_DecrRefCount(interp, nargv[0]);
13257 Jim_Free(nargv);
13259 JimDecrCmdRefCount(interp, cmd);
13260 return ret;
13262 return JIM_ERR;
13267 /* [concat] */
13268 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13270 Jim_SetResult(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13271 return JIM_OK;
13274 /* [upvar] */
13275 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13277 int i;
13278 Jim_CallFrame *targetCallFrame;
13280 /* Lookup the target frame pointer */
13281 if (argc > 3 && (argc % 2 == 0)) {
13282 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
13283 argc--;
13284 argv++;
13286 else {
13287 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
13289 if (targetCallFrame == NULL) {
13290 return JIM_ERR;
13293 /* Check for arity */
13294 if (argc < 3) {
13295 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
13296 return JIM_ERR;
13299 /* Now... for every other/local couple: */
13300 for (i = 1; i < argc; i += 2) {
13301 if (Jim_SetVariableLink(interp, argv[i + 1], argv[i], targetCallFrame) != JIM_OK)
13302 return JIM_ERR;
13304 return JIM_OK;
13307 /* [global] */
13308 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13310 int i;
13312 if (argc < 2) {
13313 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
13314 return JIM_ERR;
13316 /* Link every var to the toplevel having the same name */
13317 if (interp->framePtr->level == 0)
13318 return JIM_OK; /* global at toplevel... */
13319 for (i = 1; i < argc; i++) {
13320 /* global ::blah does nothing */
13321 const char *name = Jim_String(argv[i]);
13322 if (name[0] != ':' || name[1] != ':') {
13323 if (Jim_SetVariableLink(interp, argv[i], argv[i], interp->topFramePtr) != JIM_OK)
13324 return JIM_ERR;
13327 return JIM_OK;
13330 /* does the [string map] operation. On error NULL is returned,
13331 * otherwise a new string object with the result, having refcount = 0,
13332 * is returned. */
13333 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
13334 Jim_Obj *objPtr, int nocase)
13336 int numMaps;
13337 const char *str, *noMatchStart = NULL;
13338 int strLen, i;
13339 Jim_Obj *resultObjPtr;
13341 numMaps = Jim_ListLength(interp, mapListObjPtr);
13342 if (numMaps % 2) {
13343 Jim_SetResultString(interp, "list must contain an even number of elements", -1);
13344 return NULL;
13347 str = Jim_String(objPtr);
13348 strLen = Jim_Utf8Length(interp, objPtr);
13350 /* Map it */
13351 resultObjPtr = Jim_NewStringObj(interp, "", 0);
13352 while (strLen) {
13353 for (i = 0; i < numMaps; i += 2) {
13354 Jim_Obj *eachObjPtr;
13355 const char *k;
13356 int kl;
13358 eachObjPtr = Jim_ListGetIndex(interp, mapListObjPtr, i);
13359 k = Jim_String(eachObjPtr);
13360 kl = Jim_Utf8Length(interp, eachObjPtr);
13362 if (strLen >= kl && kl) {
13363 int rc;
13364 rc = JimStringCompareLen(str, k, kl, nocase);
13365 if (rc == 0) {
13366 if (noMatchStart) {
13367 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13368 noMatchStart = NULL;
13370 Jim_AppendObj(interp, resultObjPtr, Jim_ListGetIndex(interp, mapListObjPtr, i + 1));
13371 str += utf8_index(str, kl);
13372 strLen -= kl;
13373 break;
13377 if (i == numMaps) { /* no match */
13378 int c;
13379 if (noMatchStart == NULL)
13380 noMatchStart = str;
13381 str += utf8_tounicode(str, &c);
13382 strLen--;
13385 if (noMatchStart) {
13386 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13388 return resultObjPtr;
13391 /* [string] */
13392 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13394 int len;
13395 int opt_case = 1;
13396 int option;
13397 static const char * const options[] = {
13398 "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "replace",
13399 "map", "repeat", "reverse", "index", "first", "last", "cat",
13400 "trim", "trimleft", "trimright", "tolower", "toupper", "totitle", NULL
13402 enum
13404 OPT_BYTELENGTH, OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_IS, OPT_BYTERANGE, OPT_RANGE, OPT_REPLACE,
13405 OPT_MAP, OPT_REPEAT, OPT_REVERSE, OPT_INDEX, OPT_FIRST, OPT_LAST, OPT_CAT,
13406 OPT_TRIM, OPT_TRIMLEFT, OPT_TRIMRIGHT, OPT_TOLOWER, OPT_TOUPPER, OPT_TOTITLE
13408 static const char * const nocase_options[] = {
13409 "-nocase", NULL
13411 static const char * const nocase_length_options[] = {
13412 "-nocase", "-length", NULL
13415 if (argc < 2) {
13416 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
13417 return JIM_ERR;
13419 if (Jim_GetEnum(interp, argv[1], options, &option, NULL,
13420 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK)
13421 return Jim_CheckShowCommands(interp, argv[1], options);
13423 switch (option) {
13424 case OPT_LENGTH:
13425 case OPT_BYTELENGTH:
13426 if (argc != 3) {
13427 Jim_WrongNumArgs(interp, 2, argv, "string");
13428 return JIM_ERR;
13430 if (option == OPT_LENGTH) {
13431 len = Jim_Utf8Length(interp, argv[2]);
13433 else {
13434 len = Jim_Length(argv[2]);
13436 Jim_SetResultInt(interp, len);
13437 return JIM_OK;
13439 case OPT_CAT:{
13440 Jim_Obj *objPtr;
13441 if (argc == 3) {
13442 /* optimise the one-arg case */
13443 objPtr = argv[2];
13445 else {
13446 int i;
13448 objPtr = Jim_NewStringObj(interp, "", 0);
13450 for (i = 2; i < argc; i++) {
13451 Jim_AppendObj(interp, objPtr, argv[i]);
13454 Jim_SetResult(interp, objPtr);
13455 return JIM_OK;
13458 case OPT_COMPARE:
13459 case OPT_EQUAL:
13461 /* n is the number of remaining option args */
13462 long opt_length = -1;
13463 int n = argc - 4;
13464 int i = 2;
13465 while (n > 0) {
13466 int subopt;
13467 if (Jim_GetEnum(interp, argv[i++], nocase_length_options, &subopt, NULL,
13468 JIM_ENUM_ABBREV) != JIM_OK) {
13469 badcompareargs:
13470 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? ?-length int? string1 string2");
13471 return JIM_ERR;
13473 if (subopt == 0) {
13474 /* -nocase */
13475 opt_case = 0;
13476 n--;
13478 else {
13479 /* -length */
13480 if (n < 2) {
13481 goto badcompareargs;
13483 if (Jim_GetLong(interp, argv[i++], &opt_length) != JIM_OK) {
13484 return JIM_ERR;
13486 n -= 2;
13489 if (n) {
13490 goto badcompareargs;
13492 argv += argc - 2;
13493 if (opt_length < 0 && option != OPT_COMPARE && opt_case) {
13494 /* Fast version - [string equal], case sensitive, no length */
13495 Jim_SetResultBool(interp, Jim_StringEqObj(argv[0], argv[1]));
13497 else {
13498 if (opt_length >= 0) {
13499 n = JimStringCompareLen(Jim_String(argv[0]), Jim_String(argv[1]), opt_length, !opt_case);
13501 else {
13502 n = Jim_StringCompareObj(interp, argv[0], argv[1], !opt_case);
13504 Jim_SetResultInt(interp, option == OPT_COMPARE ? n : n == 0);
13506 return JIM_OK;
13509 case OPT_MATCH:
13510 if (argc != 4 &&
13511 (argc != 5 ||
13512 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13513 JIM_ENUM_ABBREV) != JIM_OK)) {
13514 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern string");
13515 return JIM_ERR;
13517 if (opt_case == 0) {
13518 argv++;
13520 Jim_SetResultBool(interp, Jim_StringMatchObj(interp, argv[2], argv[3], !opt_case));
13521 return JIM_OK;
13523 case OPT_MAP:{
13524 Jim_Obj *objPtr;
13526 if (argc != 4 &&
13527 (argc != 5 ||
13528 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13529 JIM_ENUM_ABBREV) != JIM_OK)) {
13530 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList string");
13531 return JIM_ERR;
13534 if (opt_case == 0) {
13535 argv++;
13537 objPtr = JimStringMap(interp, argv[2], argv[3], !opt_case);
13538 if (objPtr == NULL) {
13539 return JIM_ERR;
13541 Jim_SetResult(interp, objPtr);
13542 return JIM_OK;
13545 case OPT_RANGE:
13546 case OPT_BYTERANGE:{
13547 Jim_Obj *objPtr;
13549 if (argc != 5) {
13550 Jim_WrongNumArgs(interp, 2, argv, "string first last");
13551 return JIM_ERR;
13553 if (option == OPT_RANGE) {
13554 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
13556 else
13558 objPtr = Jim_StringByteRangeObj(interp, argv[2], argv[3], argv[4]);
13561 if (objPtr == NULL) {
13562 return JIM_ERR;
13564 Jim_SetResult(interp, objPtr);
13565 return JIM_OK;
13568 case OPT_REPLACE:{
13569 Jim_Obj *objPtr;
13571 if (argc != 5 && argc != 6) {
13572 Jim_WrongNumArgs(interp, 2, argv, "string first last ?string?");
13573 return JIM_ERR;
13575 objPtr = JimStringReplaceObj(interp, argv[2], argv[3], argv[4], argc == 6 ? argv[5] : NULL);
13576 if (objPtr == NULL) {
13577 return JIM_ERR;
13579 Jim_SetResult(interp, objPtr);
13580 return JIM_OK;
13584 case OPT_REPEAT:{
13585 Jim_Obj *objPtr;
13586 jim_wide count;
13588 if (argc != 4) {
13589 Jim_WrongNumArgs(interp, 2, argv, "string count");
13590 return JIM_ERR;
13592 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK) {
13593 return JIM_ERR;
13595 objPtr = Jim_NewStringObj(interp, "", 0);
13596 if (count > 0) {
13597 while (count--) {
13598 Jim_AppendObj(interp, objPtr, argv[2]);
13601 Jim_SetResult(interp, objPtr);
13602 return JIM_OK;
13605 case OPT_REVERSE:{
13606 char *buf, *p;
13607 const char *str;
13608 int i;
13610 if (argc != 3) {
13611 Jim_WrongNumArgs(interp, 2, argv, "string");
13612 return JIM_ERR;
13615 str = Jim_GetString(argv[2], &len);
13616 buf = Jim_Alloc(len + 1);
13617 p = buf + len;
13618 *p = 0;
13619 for (i = 0; i < len; ) {
13620 int c;
13621 int l = utf8_tounicode(str, &c);
13622 memcpy(p - l, str, l);
13623 p -= l;
13624 i += l;
13625 str += l;
13627 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
13628 return JIM_OK;
13631 case OPT_INDEX:{
13632 int idx;
13633 const char *str;
13635 if (argc != 4) {
13636 Jim_WrongNumArgs(interp, 2, argv, "string index");
13637 return JIM_ERR;
13639 if (Jim_GetIndex(interp, argv[3], &idx) != JIM_OK) {
13640 return JIM_ERR;
13642 str = Jim_String(argv[2]);
13643 len = Jim_Utf8Length(interp, argv[2]);
13644 if (idx != INT_MIN && idx != INT_MAX) {
13645 idx = JimRelToAbsIndex(len, idx);
13647 if (idx < 0 || idx >= len || str == NULL) {
13648 Jim_SetResultString(interp, "", 0);
13650 else if (len == Jim_Length(argv[2])) {
13651 /* ASCII optimisation */
13652 Jim_SetResultString(interp, str + idx, 1);
13654 else {
13655 int c;
13656 int i = utf8_index(str, idx);
13657 Jim_SetResultString(interp, str + i, utf8_tounicode(str + i, &c));
13659 return JIM_OK;
13662 case OPT_FIRST:
13663 case OPT_LAST:{
13664 int idx = 0, l1, l2;
13665 const char *s1, *s2;
13667 if (argc != 4 && argc != 5) {
13668 Jim_WrongNumArgs(interp, 2, argv, "subString string ?index?");
13669 return JIM_ERR;
13671 s1 = Jim_String(argv[2]);
13672 s2 = Jim_String(argv[3]);
13673 l1 = Jim_Utf8Length(interp, argv[2]);
13674 l2 = Jim_Utf8Length(interp, argv[3]);
13675 if (argc == 5) {
13676 if (Jim_GetIndex(interp, argv[4], &idx) != JIM_OK) {
13677 return JIM_ERR;
13679 idx = JimRelToAbsIndex(l2, idx);
13681 else if (option == OPT_LAST) {
13682 idx = l2;
13684 if (option == OPT_FIRST) {
13685 Jim_SetResultInt(interp, JimStringFirst(s1, l1, s2, l2, idx));
13687 else {
13688 #ifdef JIM_UTF8
13689 Jim_SetResultInt(interp, JimStringLastUtf8(s1, l1, s2, idx));
13690 #else
13691 Jim_SetResultInt(interp, JimStringLast(s1, l1, s2, idx));
13692 #endif
13694 return JIM_OK;
13697 case OPT_TRIM:
13698 case OPT_TRIMLEFT:
13699 case OPT_TRIMRIGHT:{
13700 Jim_Obj *trimchars;
13702 if (argc != 3 && argc != 4) {
13703 Jim_WrongNumArgs(interp, 2, argv, "string ?trimchars?");
13704 return JIM_ERR;
13706 trimchars = (argc == 4 ? argv[3] : NULL);
13707 if (option == OPT_TRIM) {
13708 Jim_SetResult(interp, JimStringTrim(interp, argv[2], trimchars));
13710 else if (option == OPT_TRIMLEFT) {
13711 Jim_SetResult(interp, JimStringTrimLeft(interp, argv[2], trimchars));
13713 else if (option == OPT_TRIMRIGHT) {
13714 Jim_SetResult(interp, JimStringTrimRight(interp, argv[2], trimchars));
13716 return JIM_OK;
13719 case OPT_TOLOWER:
13720 case OPT_TOUPPER:
13721 case OPT_TOTITLE:
13722 if (argc != 3) {
13723 Jim_WrongNumArgs(interp, 2, argv, "string");
13724 return JIM_ERR;
13726 if (option == OPT_TOLOWER) {
13727 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
13729 else if (option == OPT_TOUPPER) {
13730 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
13732 else {
13733 Jim_SetResult(interp, JimStringToTitle(interp, argv[2]));
13735 return JIM_OK;
13737 case OPT_IS:
13738 if (argc == 4 || (argc == 5 && Jim_CompareStringImmediate(interp, argv[3], "-strict"))) {
13739 return JimStringIs(interp, argv[argc - 1], argv[2], argc == 5);
13741 Jim_WrongNumArgs(interp, 2, argv, "class ?-strict? str");
13742 return JIM_ERR;
13744 return JIM_OK;
13747 /* [time] */
13748 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13750 long i, count = 1;
13751 jim_wide start, elapsed;
13752 char buf[60];
13753 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
13755 if (argc < 2) {
13756 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
13757 return JIM_ERR;
13759 if (argc == 3) {
13760 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
13761 return JIM_ERR;
13763 if (count < 0)
13764 return JIM_OK;
13765 i = count;
13766 start = JimClock();
13767 while (i-- > 0) {
13768 int retval;
13770 retval = Jim_EvalObj(interp, argv[1]);
13771 if (retval != JIM_OK) {
13772 return retval;
13775 elapsed = JimClock() - start;
13776 sprintf(buf, fmt, count == 0 ? 0 : elapsed / count);
13777 Jim_SetResultString(interp, buf, -1);
13778 return JIM_OK;
13781 /* [exit] */
13782 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13784 long exitCode = 0;
13786 if (argc > 2) {
13787 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
13788 return JIM_ERR;
13790 if (argc == 2) {
13791 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
13792 return JIM_ERR;
13794 interp->exitCode = exitCode;
13795 return JIM_EXIT;
13798 /* [catch] */
13799 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13801 int exitCode = 0;
13802 int i;
13803 int sig = 0;
13805 /* Which return codes are ignored (passed through)? By default, only exit, eval and signal */
13806 jim_wide ignore_mask = (1 << JIM_EXIT) | (1 << JIM_EVAL) | (1 << JIM_SIGNAL);
13807 static const int max_ignore_code = sizeof(ignore_mask) * 8;
13809 /* Reset the error code before catch.
13810 * Note that this is not strictly correct.
13812 Jim_SetGlobalVariableStr(interp, "errorCode", Jim_NewStringObj(interp, "NONE", -1));
13814 for (i = 1; i < argc - 1; i++) {
13815 const char *arg = Jim_String(argv[i]);
13816 jim_wide option;
13817 int ignore;
13819 /* It's a pity we can't use Jim_GetEnum here :-( */
13820 if (strcmp(arg, "--") == 0) {
13821 i++;
13822 break;
13824 if (*arg != '-') {
13825 break;
13828 if (strncmp(arg, "-no", 3) == 0) {
13829 arg += 3;
13830 ignore = 1;
13832 else {
13833 arg++;
13834 ignore = 0;
13837 if (Jim_StringToWide(arg, &option, 10) != JIM_OK) {
13838 option = -1;
13840 if (option < 0) {
13841 option = Jim_FindByName(arg, jimReturnCodes, jimReturnCodesSize);
13843 if (option < 0) {
13844 goto wrongargs;
13847 if (ignore) {
13848 ignore_mask |= ((jim_wide)1 << option);
13850 else {
13851 ignore_mask &= (~((jim_wide)1 << option));
13855 argc -= i;
13856 if (argc < 1 || argc > 3) {
13857 wrongargs:
13858 Jim_WrongNumArgs(interp, 1, argv,
13859 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
13860 return JIM_ERR;
13862 argv += i;
13864 if ((ignore_mask & (1 << JIM_SIGNAL)) == 0) {
13865 sig++;
13868 interp->signal_level += sig;
13869 if (Jim_CheckSignal(interp)) {
13870 /* If a signal is set, don't even try to execute the body */
13871 exitCode = JIM_SIGNAL;
13873 else {
13874 exitCode = Jim_EvalObj(interp, argv[0]);
13875 /* Don't want any caught error included in a later stack trace */
13876 interp->errorFlag = 0;
13878 interp->signal_level -= sig;
13880 /* Catch or pass through? Only the first 32/64 codes can be passed through */
13881 if (exitCode >= 0 && exitCode < max_ignore_code && (((unsigned jim_wide)1 << exitCode) & ignore_mask)) {
13882 /* Not caught, pass it up */
13883 return exitCode;
13886 if (sig && exitCode == JIM_SIGNAL) {
13887 /* Catch the signal at this level */
13888 if (interp->signal_set_result) {
13889 interp->signal_set_result(interp, interp->sigmask);
13891 else {
13892 Jim_SetResultInt(interp, interp->sigmask);
13894 interp->sigmask = 0;
13897 if (argc >= 2) {
13898 if (Jim_SetVariable(interp, argv[1], Jim_GetResult(interp)) != JIM_OK) {
13899 return JIM_ERR;
13901 if (argc == 3) {
13902 Jim_Obj *optListObj = Jim_NewListObj(interp, NULL, 0);
13904 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-code", -1));
13905 Jim_ListAppendElement(interp, optListObj,
13906 Jim_NewIntObj(interp, exitCode == JIM_RETURN ? interp->returnCode : exitCode));
13907 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-level", -1));
13908 Jim_ListAppendElement(interp, optListObj, Jim_NewIntObj(interp, interp->returnLevel));
13909 if (exitCode == JIM_ERR) {
13910 Jim_Obj *errorCode;
13911 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorinfo",
13912 -1));
13913 Jim_ListAppendElement(interp, optListObj, interp->stackTrace);
13915 errorCode = Jim_GetGlobalVariableStr(interp, "errorCode", JIM_NONE);
13916 if (errorCode) {
13917 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorcode", -1));
13918 Jim_ListAppendElement(interp, optListObj, errorCode);
13921 if (Jim_SetVariable(interp, argv[2], optListObj) != JIM_OK) {
13922 return JIM_ERR;
13926 Jim_SetResultInt(interp, exitCode);
13927 return JIM_OK;
13930 #if defined(JIM_REFERENCES) && !defined(JIM_BOOTSTRAP)
13932 /* [ref] */
13933 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13935 if (argc != 3 && argc != 4) {
13936 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
13937 return JIM_ERR;
13939 if (argc == 3) {
13940 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
13942 else {
13943 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], argv[3]));
13945 return JIM_OK;
13948 /* [getref] */
13949 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13951 Jim_Reference *refPtr;
13953 if (argc != 2) {
13954 Jim_WrongNumArgs(interp, 1, argv, "reference");
13955 return JIM_ERR;
13957 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
13958 return JIM_ERR;
13959 Jim_SetResult(interp, refPtr->objPtr);
13960 return JIM_OK;
13963 /* [setref] */
13964 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13966 Jim_Reference *refPtr;
13968 if (argc != 3) {
13969 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
13970 return JIM_ERR;
13972 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
13973 return JIM_ERR;
13974 Jim_IncrRefCount(argv[2]);
13975 Jim_DecrRefCount(interp, refPtr->objPtr);
13976 refPtr->objPtr = argv[2];
13977 Jim_SetResult(interp, argv[2]);
13978 return JIM_OK;
13981 /* [collect] */
13982 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13984 if (argc != 1) {
13985 Jim_WrongNumArgs(interp, 1, argv, "");
13986 return JIM_ERR;
13988 Jim_SetResultInt(interp, Jim_Collect(interp));
13990 /* Free all the freed objects. */
13991 while (interp->freeList) {
13992 Jim_Obj *nextObjPtr = interp->freeList->nextObjPtr;
13993 Jim_Free(interp->freeList);
13994 interp->freeList = nextObjPtr;
13997 return JIM_OK;
14000 /* [finalize] reference ?newValue? */
14001 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14003 if (argc != 2 && argc != 3) {
14004 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
14005 return JIM_ERR;
14007 if (argc == 2) {
14008 Jim_Obj *cmdNamePtr;
14010 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
14011 return JIM_ERR;
14012 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
14013 Jim_SetResult(interp, cmdNamePtr);
14015 else {
14016 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
14017 return JIM_ERR;
14018 Jim_SetResult(interp, argv[2]);
14020 return JIM_OK;
14023 /* [info references] */
14024 static int JimInfoReferences(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14026 Jim_Obj *listObjPtr;
14027 Jim_HashTableIterator htiter;
14028 Jim_HashEntry *he;
14030 listObjPtr = Jim_NewListObj(interp, NULL, 0);
14032 JimInitHashTableIterator(&interp->references, &htiter);
14033 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14034 char buf[JIM_REFERENCE_SPACE + 1];
14035 Jim_Reference *refPtr = Jim_GetHashEntryVal(he);
14036 const unsigned long *refId = he->key;
14038 JimFormatReference(buf, refPtr, *refId);
14039 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, buf, -1));
14041 Jim_SetResult(interp, listObjPtr);
14042 return JIM_OK;
14044 #endif /* JIM_REFERENCES && !JIM_BOOTSTRAP */
14046 /* [rename] */
14047 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14049 if (argc != 3) {
14050 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
14051 return JIM_ERR;
14054 if (JimValidName(interp, "new procedure", argv[2])) {
14055 return JIM_ERR;
14058 return Jim_RenameCommand(interp, Jim_String(argv[1]), Jim_String(argv[2]));
14061 #define JIM_DICTMATCH_KEYS 0x0001
14062 #define JIM_DICTMATCH_VALUES 0x002
14065 * match_type must be one of JIM_DICTMATCH_KEYS or JIM_DICTMATCH_VALUES
14066 * return_types should be either or both
14068 int Jim_DictMatchTypes(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObj, int match_type, int return_types)
14070 Jim_HashEntry *he;
14071 Jim_Obj *listObjPtr;
14072 Jim_HashTableIterator htiter;
14074 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14075 return JIM_ERR;
14078 listObjPtr = Jim_NewListObj(interp, NULL, 0);
14080 JimInitHashTableIterator(objPtr->internalRep.ptr, &htiter);
14081 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14082 if (patternObj) {
14083 Jim_Obj *matchObj = (match_type == JIM_DICTMATCH_KEYS) ? (Jim_Obj *)he->key : Jim_GetHashEntryVal(he);
14084 if (!JimGlobMatch(Jim_String(patternObj), Jim_String(matchObj), 0)) {
14085 /* no match */
14086 continue;
14089 if (return_types & JIM_DICTMATCH_KEYS) {
14090 Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->key);
14092 if (return_types & JIM_DICTMATCH_VALUES) {
14093 Jim_ListAppendElement(interp, listObjPtr, Jim_GetHashEntryVal(he));
14097 Jim_SetResult(interp, listObjPtr);
14098 return JIM_OK;
14101 int Jim_DictSize(Jim_Interp *interp, Jim_Obj *objPtr)
14103 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14104 return -1;
14106 return ((Jim_HashTable *)objPtr->internalRep.ptr)->used;
14110 * Must be called with at least one object.
14111 * Returns the new dictionary, or NULL on error.
14113 Jim_Obj *Jim_DictMerge(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
14115 Jim_Obj *objPtr = Jim_NewDictObj(interp, NULL, 0);
14116 int i;
14118 JimPanic((objc == 0, "Jim_DictMerge called with objc=0"));
14120 /* Note that we don't optimise the trivial case of a single argument */
14122 for (i = 0; i < objc; i++) {
14123 Jim_HashTable *ht;
14124 Jim_HashTableIterator htiter;
14125 Jim_HashEntry *he;
14127 if (SetDictFromAny(interp, objv[i]) != JIM_OK) {
14128 Jim_FreeNewObj(interp, objPtr);
14129 return NULL;
14131 ht = objv[i]->internalRep.ptr;
14132 JimInitHashTableIterator(ht, &htiter);
14133 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14134 Jim_ReplaceHashEntry(objPtr->internalRep.ptr, Jim_GetHashEntryKey(he), Jim_GetHashEntryVal(he));
14137 return objPtr;
14140 int Jim_DictInfo(Jim_Interp *interp, Jim_Obj *objPtr)
14142 Jim_HashTable *ht;
14143 unsigned int i;
14144 char buffer[100];
14145 int sum = 0;
14146 int nonzero_count = 0;
14147 Jim_Obj *output;
14148 int bucket_counts[11] = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 };
14150 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14151 return JIM_ERR;
14154 ht = (Jim_HashTable *)objPtr->internalRep.ptr;
14156 /* Note that this uses internal knowledge of the hash table */
14157 snprintf(buffer, sizeof(buffer), "%d entries in table, %d buckets\n", ht->used, ht->size);
14158 output = Jim_NewStringObj(interp, buffer, -1);
14160 for (i = 0; i < ht->size; i++) {
14161 Jim_HashEntry *he = ht->table[i];
14162 int entries = 0;
14163 while (he) {
14164 entries++;
14165 he = he->next;
14167 if (entries > 9) {
14168 bucket_counts[10]++;
14170 else {
14171 bucket_counts[entries]++;
14173 if (entries) {
14174 sum += entries;
14175 nonzero_count++;
14178 for (i = 0; i < 10; i++) {
14179 snprintf(buffer, sizeof(buffer), "number of buckets with %d entries: %d\n", i, bucket_counts[i]);
14180 Jim_AppendString(interp, output, buffer, -1);
14182 snprintf(buffer, sizeof(buffer), "number of buckets with 10 or more entries: %d\n", bucket_counts[10]);
14183 Jim_AppendString(interp, output, buffer, -1);
14184 snprintf(buffer, sizeof(buffer), "average search distance for entry: %.1f", nonzero_count ? (double)sum / nonzero_count : 0.0);
14185 Jim_AppendString(interp, output, buffer, -1);
14186 Jim_SetResult(interp, output);
14187 return JIM_OK;
14190 static int Jim_EvalEnsemble(Jim_Interp *interp, const char *basecmd, const char *subcmd, int argc, Jim_Obj *const *argv)
14192 Jim_Obj *prefixObj = Jim_NewStringObj(interp, basecmd, -1);
14194 Jim_AppendString(interp, prefixObj, " ", 1);
14195 Jim_AppendString(interp, prefixObj, subcmd, -1);
14197 return Jim_EvalObjPrefix(interp, prefixObj, argc, argv);
14201 * Implements the [dict with] command
14203 static int JimDictWith(Jim_Interp *interp, Jim_Obj *dictVarName, Jim_Obj *const *keyv, int keyc, Jim_Obj *scriptObj)
14205 int i;
14206 Jim_Obj *objPtr;
14207 Jim_Obj *dictObj;
14208 Jim_Obj **dictValues;
14209 int len;
14210 int ret = JIM_OK;
14212 /* Open up the appropriate level of the dictionary */
14213 dictObj = Jim_GetVariable(interp, dictVarName, JIM_ERRMSG);
14214 if (dictObj == NULL || Jim_DictKeysVector(interp, dictObj, keyv, keyc, &objPtr, JIM_ERRMSG) != JIM_OK) {
14215 return JIM_ERR;
14217 /* Set the local variables */
14218 if (Jim_DictPairs(interp, objPtr, &dictValues, &len) == JIM_ERR) {
14219 return JIM_ERR;
14221 for (i = 0; i < len; i += 2) {
14222 if (Jim_SetVariable(interp, dictValues[i], dictValues[i + 1]) == JIM_ERR) {
14223 Jim_Free(dictValues);
14224 return JIM_ERR;
14228 /* As an optimisation, if the script is empty, no need to evaluate it or update the dict */
14229 if (Jim_Length(scriptObj)) {
14230 ret = Jim_EvalObj(interp, scriptObj);
14232 /* Now if the dictionary still exists, update it based on the local variables */
14233 if (ret == JIM_OK && Jim_GetVariable(interp, dictVarName, 0) != NULL) {
14234 /* We need a copy of keyv with one extra element at the end for Jim_SetDictKeysVector() */
14235 Jim_Obj **newkeyv = Jim_Alloc(sizeof(*newkeyv) * (keyc + 1));
14236 for (i = 0; i < keyc; i++) {
14237 newkeyv[i] = keyv[i];
14240 for (i = 0; i < len; i += 2) {
14241 /* This will be NULL if the variable no longer exists, thus deleting the variable */
14242 objPtr = Jim_GetVariable(interp, dictValues[i], 0);
14243 newkeyv[keyc] = dictValues[i];
14244 Jim_SetDictKeysVector(interp, dictVarName, newkeyv, keyc + 1, objPtr, 0);
14246 Jim_Free(newkeyv);
14250 Jim_Free(dictValues);
14252 return ret;
14255 /* [dict] */
14256 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14258 Jim_Obj *objPtr;
14259 int types = JIM_DICTMATCH_KEYS;
14260 int option;
14261 static const char * const options[] = {
14262 "create", "get", "set", "unset", "exists", "keys", "size", "info",
14263 "merge", "with", "append", "lappend", "incr", "remove", "values", "for",
14264 "replace", "update", NULL
14266 enum
14268 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXISTS, OPT_KEYS, OPT_SIZE, OPT_INFO,
14269 OPT_MERGE, OPT_WITH, OPT_APPEND, OPT_LAPPEND, OPT_INCR, OPT_REMOVE, OPT_VALUES, OPT_FOR,
14270 OPT_REPLACE, OPT_UPDATE,
14273 if (argc < 2) {
14274 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?arguments ...?");
14275 return JIM_ERR;
14278 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK) {
14279 return Jim_CheckShowCommands(interp, argv[1], options);
14282 switch (option) {
14283 case OPT_GET:
14284 if (argc < 3) {
14285 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?key ...?");
14286 return JIM_ERR;
14288 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr,
14289 JIM_ERRMSG) != JIM_OK) {
14290 return JIM_ERR;
14292 Jim_SetResult(interp, objPtr);
14293 return JIM_OK;
14295 case OPT_SET:
14296 if (argc < 5) {
14297 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
14298 return JIM_ERR;
14300 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 4, argv[argc - 1], JIM_ERRMSG);
14302 case OPT_EXISTS:
14303 if (argc < 4) {
14304 Jim_WrongNumArgs(interp, 2, argv, "dictionary key ?key ...?");
14305 return JIM_ERR;
14307 else {
14308 int rc = Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr, JIM_ERRMSG);
14309 if (rc < 0) {
14310 return JIM_ERR;
14312 Jim_SetResultBool(interp, rc == JIM_OK);
14313 return JIM_OK;
14316 case OPT_UNSET:
14317 if (argc < 4) {
14318 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
14319 return JIM_ERR;
14321 if (Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 3, NULL, 0) != JIM_OK) {
14322 return JIM_ERR;
14324 return JIM_OK;
14326 case OPT_VALUES:
14327 types = JIM_DICTMATCH_VALUES;
14328 /* fallthru */
14329 case OPT_KEYS:
14330 if (argc != 3 && argc != 4) {
14331 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?pattern?");
14332 return JIM_ERR;
14334 return Jim_DictMatchTypes(interp, argv[2], argc == 4 ? argv[3] : NULL, types, types);
14336 case OPT_SIZE:
14337 if (argc != 3) {
14338 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14339 return JIM_ERR;
14341 else if (Jim_DictSize(interp, argv[2]) < 0) {
14342 return JIM_ERR;
14344 Jim_SetResultInt(interp, Jim_DictSize(interp, argv[2]));
14345 return JIM_OK;
14347 case OPT_MERGE:
14348 if (argc == 2) {
14349 return JIM_OK;
14351 objPtr = Jim_DictMerge(interp, argc - 2, argv + 2);
14352 if (objPtr == NULL) {
14353 return JIM_ERR;
14355 Jim_SetResult(interp, objPtr);
14356 return JIM_OK;
14358 case OPT_UPDATE:
14359 if (argc < 6 || argc % 2) {
14360 /* Better error message */
14361 argc = 2;
14363 break;
14365 case OPT_CREATE:
14366 if (argc % 2) {
14367 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
14368 return JIM_ERR;
14370 objPtr = Jim_NewDictObj(interp, argv + 2, argc - 2);
14371 Jim_SetResult(interp, objPtr);
14372 return JIM_OK;
14374 case OPT_INFO:
14375 if (argc != 3) {
14376 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14377 return JIM_ERR;
14379 return Jim_DictInfo(interp, argv[2]);
14381 case OPT_WITH:
14382 if (argc < 4) {
14383 Jim_WrongNumArgs(interp, 2, argv, "dictVar ?key ...? script");
14384 return JIM_ERR;
14386 return JimDictWith(interp, argv[2], argv + 3, argc - 4, argv[argc - 1]);
14388 /* Handle command as an ensemble */
14389 return Jim_EvalEnsemble(interp, "dict", options[option], argc - 2, argv + 2);
14392 /* [subst] */
14393 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14395 static const char * const options[] = {
14396 "-nobackslashes", "-nocommands", "-novariables", NULL
14398 enum
14399 { OPT_NOBACKSLASHES, OPT_NOCOMMANDS, OPT_NOVARIABLES };
14400 int i;
14401 int flags = JIM_SUBST_FLAG;
14402 Jim_Obj *objPtr;
14404 if (argc < 2) {
14405 Jim_WrongNumArgs(interp, 1, argv, "?options? string");
14406 return JIM_ERR;
14408 for (i = 1; i < (argc - 1); i++) {
14409 int option;
14411 if (Jim_GetEnum(interp, argv[i], options, &option, NULL,
14412 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14413 return JIM_ERR;
14415 switch (option) {
14416 case OPT_NOBACKSLASHES:
14417 flags |= JIM_SUBST_NOESC;
14418 break;
14419 case OPT_NOCOMMANDS:
14420 flags |= JIM_SUBST_NOCMD;
14421 break;
14422 case OPT_NOVARIABLES:
14423 flags |= JIM_SUBST_NOVAR;
14424 break;
14427 if (Jim_SubstObj(interp, argv[argc - 1], &objPtr, flags) != JIM_OK) {
14428 return JIM_ERR;
14430 Jim_SetResult(interp, objPtr);
14431 return JIM_OK;
14434 /* [info] */
14435 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14437 int cmd;
14438 Jim_Obj *objPtr;
14439 int mode = 0;
14441 static const char * const commands[] = {
14442 "body", "statics", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
14443 "vars", "version", "patchlevel", "complete", "args", "hostname",
14444 "script", "source", "stacktrace", "nameofexecutable", "returncodes",
14445 "references", "alias", NULL
14447 enum
14448 { INFO_BODY, INFO_STATICS, INFO_COMMANDS, INFO_PROCS, INFO_CHANNELS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
14449 INFO_FRAME, INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_PATCHLEVEL, INFO_COMPLETE, INFO_ARGS,
14450 INFO_HOSTNAME, INFO_SCRIPT, INFO_SOURCE, INFO_STACKTRACE, INFO_NAMEOFEXECUTABLE,
14451 INFO_RETURNCODES, INFO_REFERENCES, INFO_ALIAS,
14454 #ifdef jim_ext_namespace
14455 int nons = 0;
14457 if (argc > 2 && Jim_CompareStringImmediate(interp, argv[1], "-nons")) {
14458 /* This is for internal use only */
14459 argc--;
14460 argv++;
14461 nons = 1;
14463 #endif
14465 if (argc < 2) {
14466 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?args ...?");
14467 return JIM_ERR;
14469 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "subcommand", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14470 return Jim_CheckShowCommands(interp, argv[1], commands);
14473 /* Test for the most common commands first, just in case it makes a difference */
14474 switch (cmd) {
14475 case INFO_EXISTS:
14476 if (argc != 3) {
14477 Jim_WrongNumArgs(interp, 2, argv, "varName");
14478 return JIM_ERR;
14480 Jim_SetResultBool(interp, Jim_GetVariable(interp, argv[2], 0) != NULL);
14481 break;
14483 case INFO_ALIAS:{
14484 Jim_Cmd *cmdPtr;
14486 if (argc != 3) {
14487 Jim_WrongNumArgs(interp, 2, argv, "command");
14488 return JIM_ERR;
14490 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14491 return JIM_ERR;
14493 if (cmdPtr->isproc || cmdPtr->u.native.cmdProc != JimAliasCmd) {
14494 Jim_SetResultFormatted(interp, "command \"%#s\" is not an alias", argv[2]);
14495 return JIM_ERR;
14497 Jim_SetResult(interp, (Jim_Obj *)cmdPtr->u.native.privData);
14498 return JIM_OK;
14501 case INFO_CHANNELS:
14502 mode++; /* JIM_CMDLIST_CHANNELS */
14503 #ifndef jim_ext_aio
14504 Jim_SetResultString(interp, "aio not enabled", -1);
14505 return JIM_ERR;
14506 #endif
14507 /* fall through */
14508 case INFO_PROCS:
14509 mode++; /* JIM_CMDLIST_PROCS */
14510 /* fall through */
14511 case INFO_COMMANDS:
14512 /* mode 0 => JIM_CMDLIST_COMMANDS */
14513 if (argc != 2 && argc != 3) {
14514 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14515 return JIM_ERR;
14517 #ifdef jim_ext_namespace
14518 if (!nons) {
14519 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14520 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14523 #endif
14524 Jim_SetResult(interp, JimCommandsList(interp, (argc == 3) ? argv[2] : NULL, mode));
14525 break;
14527 case INFO_VARS:
14528 mode++; /* JIM_VARLIST_VARS */
14529 /* fall through */
14530 case INFO_LOCALS:
14531 mode++; /* JIM_VARLIST_LOCALS */
14532 /* fall through */
14533 case INFO_GLOBALS:
14534 /* mode 0 => JIM_VARLIST_GLOBALS */
14535 if (argc != 2 && argc != 3) {
14536 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14537 return JIM_ERR;
14539 #ifdef jim_ext_namespace
14540 if (!nons) {
14541 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14542 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14545 #endif
14546 Jim_SetResult(interp, JimVariablesList(interp, argc == 3 ? argv[2] : NULL, mode));
14547 break;
14549 case INFO_SCRIPT:
14550 if (argc != 2) {
14551 Jim_WrongNumArgs(interp, 2, argv, "");
14552 return JIM_ERR;
14554 Jim_SetResult(interp, JimGetScript(interp, interp->currentScriptObj)->fileNameObj);
14555 break;
14557 case INFO_SOURCE:{
14558 jim_wide line;
14559 Jim_Obj *resObjPtr;
14560 Jim_Obj *fileNameObj;
14562 if (argc != 3 && argc != 5) {
14563 Jim_WrongNumArgs(interp, 2, argv, "source ?filename line?");
14564 return JIM_ERR;
14566 if (argc == 5) {
14567 if (Jim_GetWide(interp, argv[4], &line) != JIM_OK) {
14568 return JIM_ERR;
14570 resObjPtr = Jim_NewStringObj(interp, Jim_String(argv[2]), Jim_Length(argv[2]));
14571 JimSetSourceInfo(interp, resObjPtr, argv[3], line);
14573 else {
14574 if (argv[2]->typePtr == &sourceObjType) {
14575 fileNameObj = argv[2]->internalRep.sourceValue.fileNameObj;
14576 line = argv[2]->internalRep.sourceValue.lineNumber;
14578 else if (argv[2]->typePtr == &scriptObjType) {
14579 ScriptObj *script = JimGetScript(interp, argv[2]);
14580 fileNameObj = script->fileNameObj;
14581 line = script->firstline;
14583 else {
14584 fileNameObj = interp->emptyObj;
14585 line = 1;
14587 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14588 Jim_ListAppendElement(interp, resObjPtr, fileNameObj);
14589 Jim_ListAppendElement(interp, resObjPtr, Jim_NewIntObj(interp, line));
14591 Jim_SetResult(interp, resObjPtr);
14592 break;
14595 case INFO_STACKTRACE:
14596 Jim_SetResult(interp, interp->stackTrace);
14597 break;
14599 case INFO_LEVEL:
14600 case INFO_FRAME:
14601 switch (argc) {
14602 case 2:
14603 Jim_SetResultInt(interp, interp->framePtr->level);
14604 break;
14606 case 3:
14607 if (JimInfoLevel(interp, argv[2], &objPtr, cmd == INFO_LEVEL) != JIM_OK) {
14608 return JIM_ERR;
14610 Jim_SetResult(interp, objPtr);
14611 break;
14613 default:
14614 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
14615 return JIM_ERR;
14617 break;
14619 case INFO_BODY:
14620 case INFO_STATICS:
14621 case INFO_ARGS:{
14622 Jim_Cmd *cmdPtr;
14624 if (argc != 3) {
14625 Jim_WrongNumArgs(interp, 2, argv, "procname");
14626 return JIM_ERR;
14628 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14629 return JIM_ERR;
14631 if (!cmdPtr->isproc) {
14632 Jim_SetResultFormatted(interp, "command \"%#s\" is not a procedure", argv[2]);
14633 return JIM_ERR;
14635 switch (cmd) {
14636 case INFO_BODY:
14637 Jim_SetResult(interp, cmdPtr->u.proc.bodyObjPtr);
14638 break;
14639 case INFO_ARGS:
14640 Jim_SetResult(interp, cmdPtr->u.proc.argListObjPtr);
14641 break;
14642 case INFO_STATICS:
14643 if (cmdPtr->u.proc.staticVars) {
14644 Jim_SetResult(interp, JimHashtablePatternMatch(interp, cmdPtr->u.proc.staticVars,
14645 NULL, JimVariablesMatch, JIM_VARLIST_LOCALS | JIM_VARLIST_VALUES));
14647 break;
14649 break;
14652 case INFO_VERSION:
14653 case INFO_PATCHLEVEL:{
14654 char buf[(JIM_INTEGER_SPACE * 2) + 1];
14656 sprintf(buf, "%d.%d", JIM_VERSION / 100, JIM_VERSION % 100);
14657 Jim_SetResultString(interp, buf, -1);
14658 break;
14661 case INFO_COMPLETE:
14662 if (argc != 3 && argc != 4) {
14663 Jim_WrongNumArgs(interp, 2, argv, "script ?missing?");
14664 return JIM_ERR;
14666 else {
14667 char missing;
14669 Jim_SetResultBool(interp, Jim_ScriptIsComplete(interp, argv[2], &missing));
14670 if (missing != ' ' && argc == 4) {
14671 Jim_SetVariable(interp, argv[3], Jim_NewStringObj(interp, &missing, 1));
14674 break;
14676 case INFO_HOSTNAME:
14677 /* Redirect to os.gethostname if it exists */
14678 return Jim_Eval(interp, "os.gethostname");
14680 case INFO_NAMEOFEXECUTABLE:
14681 /* Redirect to Tcl proc */
14682 return Jim_Eval(interp, "{info nameofexecutable}");
14684 case INFO_RETURNCODES:
14685 if (argc == 2) {
14686 int i;
14687 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14689 for (i = 0; jimReturnCodes[i]; i++) {
14690 Jim_ListAppendElement(interp, listObjPtr, Jim_NewIntObj(interp, i));
14691 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp,
14692 jimReturnCodes[i], -1));
14695 Jim_SetResult(interp, listObjPtr);
14697 else if (argc == 3) {
14698 long code;
14699 const char *name;
14701 if (Jim_GetLong(interp, argv[2], &code) != JIM_OK) {
14702 return JIM_ERR;
14704 name = Jim_ReturnCode(code);
14705 if (*name == '?') {
14706 Jim_SetResultInt(interp, code);
14708 else {
14709 Jim_SetResultString(interp, name, -1);
14712 else {
14713 Jim_WrongNumArgs(interp, 2, argv, "?code?");
14714 return JIM_ERR;
14716 break;
14717 case INFO_REFERENCES:
14718 #ifdef JIM_REFERENCES
14719 return JimInfoReferences(interp, argc, argv);
14720 #else
14721 Jim_SetResultString(interp, "not supported", -1);
14722 return JIM_ERR;
14723 #endif
14725 return JIM_OK;
14728 /* [exists] */
14729 static int Jim_ExistsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14731 Jim_Obj *objPtr;
14732 int result = 0;
14734 static const char * const options[] = {
14735 "-command", "-proc", "-alias", "-var", NULL
14737 enum
14739 OPT_COMMAND, OPT_PROC, OPT_ALIAS, OPT_VAR
14741 int option;
14743 if (argc == 2) {
14744 option = OPT_VAR;
14745 objPtr = argv[1];
14747 else if (argc == 3) {
14748 if (Jim_GetEnum(interp, argv[1], options, &option, NULL, JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14749 return JIM_ERR;
14751 objPtr = argv[2];
14753 else {
14754 Jim_WrongNumArgs(interp, 1, argv, "?option? name");
14755 return JIM_ERR;
14758 if (option == OPT_VAR) {
14759 result = Jim_GetVariable(interp, objPtr, 0) != NULL;
14761 else {
14762 /* Now different kinds of commands */
14763 Jim_Cmd *cmd = Jim_GetCommand(interp, objPtr, JIM_NONE);
14765 if (cmd) {
14766 switch (option) {
14767 case OPT_COMMAND:
14768 result = 1;
14769 break;
14771 case OPT_ALIAS:
14772 result = cmd->isproc == 0 && cmd->u.native.cmdProc == JimAliasCmd;
14773 break;
14775 case OPT_PROC:
14776 result = cmd->isproc;
14777 break;
14781 Jim_SetResultBool(interp, result);
14782 return JIM_OK;
14785 /* [split] */
14786 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14788 const char *str, *splitChars, *noMatchStart;
14789 int splitLen, strLen;
14790 Jim_Obj *resObjPtr;
14791 int c;
14792 int len;
14794 if (argc != 2 && argc != 3) {
14795 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
14796 return JIM_ERR;
14799 str = Jim_GetString(argv[1], &len);
14800 if (len == 0) {
14801 return JIM_OK;
14803 strLen = Jim_Utf8Length(interp, argv[1]);
14805 /* Init */
14806 if (argc == 2) {
14807 splitChars = " \n\t\r";
14808 splitLen = 4;
14810 else {
14811 splitChars = Jim_String(argv[2]);
14812 splitLen = Jim_Utf8Length(interp, argv[2]);
14815 noMatchStart = str;
14816 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14818 /* Split */
14819 if (splitLen) {
14820 Jim_Obj *objPtr;
14821 while (strLen--) {
14822 const char *sc = splitChars;
14823 int scLen = splitLen;
14824 int sl = utf8_tounicode(str, &c);
14825 while (scLen--) {
14826 int pc;
14827 sc += utf8_tounicode(sc, &pc);
14828 if (c == pc) {
14829 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14830 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14831 noMatchStart = str + sl;
14832 break;
14835 str += sl;
14837 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14838 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14840 else {
14841 /* This handles the special case of splitchars eq {}
14842 * Optimise by sharing common (ASCII) characters
14844 Jim_Obj **commonObj = NULL;
14845 #define NUM_COMMON (128 - 9)
14846 while (strLen--) {
14847 int n = utf8_tounicode(str, &c);
14848 #ifdef JIM_OPTIMIZATION
14849 if (c >= 9 && c < 128) {
14850 /* Common ASCII char. Note that 9 is the tab character */
14851 c -= 9;
14852 if (!commonObj) {
14853 commonObj = Jim_Alloc(sizeof(*commonObj) * NUM_COMMON);
14854 memset(commonObj, 0, sizeof(*commonObj) * NUM_COMMON);
14856 if (!commonObj[c]) {
14857 commonObj[c] = Jim_NewStringObj(interp, str, 1);
14859 Jim_ListAppendElement(interp, resObjPtr, commonObj[c]);
14860 str++;
14861 continue;
14863 #endif
14864 Jim_ListAppendElement(interp, resObjPtr, Jim_NewStringObjUtf8(interp, str, 1));
14865 str += n;
14867 Jim_Free(commonObj);
14870 Jim_SetResult(interp, resObjPtr);
14871 return JIM_OK;
14874 /* [join] */
14875 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14877 const char *joinStr;
14878 int joinStrLen;
14880 if (argc != 2 && argc != 3) {
14881 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
14882 return JIM_ERR;
14884 /* Init */
14885 if (argc == 2) {
14886 joinStr = " ";
14887 joinStrLen = 1;
14889 else {
14890 joinStr = Jim_GetString(argv[2], &joinStrLen);
14892 Jim_SetResult(interp, Jim_ListJoin(interp, argv[1], joinStr, joinStrLen));
14893 return JIM_OK;
14896 /* [format] */
14897 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14899 Jim_Obj *objPtr;
14901 if (argc < 2) {
14902 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
14903 return JIM_ERR;
14905 objPtr = Jim_FormatString(interp, argv[1], argc - 2, argv + 2);
14906 if (objPtr == NULL)
14907 return JIM_ERR;
14908 Jim_SetResult(interp, objPtr);
14909 return JIM_OK;
14912 /* [scan] */
14913 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14915 Jim_Obj *listPtr, **outVec;
14916 int outc, i;
14918 if (argc < 3) {
14919 Jim_WrongNumArgs(interp, 1, argv, "string format ?varName varName ...?");
14920 return JIM_ERR;
14922 if (argv[2]->typePtr != &scanFmtStringObjType)
14923 SetScanFmtFromAny(interp, argv[2]);
14924 if (FormatGetError(argv[2]) != 0) {
14925 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
14926 return JIM_ERR;
14928 if (argc > 3) {
14929 int maxPos = FormatGetMaxPos(argv[2]);
14930 int count = FormatGetCnvCount(argv[2]);
14932 if (maxPos > argc - 3) {
14933 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
14934 return JIM_ERR;
14936 else if (count > argc - 3) {
14937 Jim_SetResultString(interp, "different numbers of variable names and "
14938 "field specifiers", -1);
14939 return JIM_ERR;
14941 else if (count < argc - 3) {
14942 Jim_SetResultString(interp, "variable is not assigned by any "
14943 "conversion specifiers", -1);
14944 return JIM_ERR;
14947 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
14948 if (listPtr == 0)
14949 return JIM_ERR;
14950 if (argc > 3) {
14951 int rc = JIM_OK;
14952 int count = 0;
14954 if (listPtr != 0 && listPtr != (Jim_Obj *)EOF) {
14955 int len = Jim_ListLength(interp, listPtr);
14957 if (len != 0) {
14958 JimListGetElements(interp, listPtr, &outc, &outVec);
14959 for (i = 0; i < outc; ++i) {
14960 if (Jim_Length(outVec[i]) > 0) {
14961 ++count;
14962 if (Jim_SetVariable(interp, argv[3 + i], outVec[i]) != JIM_OK) {
14963 rc = JIM_ERR;
14968 Jim_FreeNewObj(interp, listPtr);
14970 else {
14971 count = -1;
14973 if (rc == JIM_OK) {
14974 Jim_SetResultInt(interp, count);
14976 return rc;
14978 else {
14979 if (listPtr == (Jim_Obj *)EOF) {
14980 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
14981 return JIM_OK;
14983 Jim_SetResult(interp, listPtr);
14985 return JIM_OK;
14988 /* [error] */
14989 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14991 if (argc != 2 && argc != 3) {
14992 Jim_WrongNumArgs(interp, 1, argv, "message ?stacktrace?");
14993 return JIM_ERR;
14995 Jim_SetResult(interp, argv[1]);
14996 if (argc == 3) {
14997 JimSetStackTrace(interp, argv[2]);
14998 return JIM_ERR;
15000 interp->addStackTrace++;
15001 return JIM_ERR;
15004 /* [lrange] */
15005 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15007 Jim_Obj *objPtr;
15009 if (argc != 4) {
15010 Jim_WrongNumArgs(interp, 1, argv, "list first last");
15011 return JIM_ERR;
15013 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
15014 return JIM_ERR;
15015 Jim_SetResult(interp, objPtr);
15016 return JIM_OK;
15019 /* [lrepeat] */
15020 static int Jim_LrepeatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15022 Jim_Obj *objPtr;
15023 long count;
15025 if (argc < 2 || Jim_GetLong(interp, argv[1], &count) != JIM_OK || count < 0) {
15026 Jim_WrongNumArgs(interp, 1, argv, "count ?value ...?");
15027 return JIM_ERR;
15030 if (count == 0 || argc == 2) {
15031 return JIM_OK;
15034 argc -= 2;
15035 argv += 2;
15037 objPtr = Jim_NewListObj(interp, argv, argc);
15038 while (--count) {
15039 ListInsertElements(objPtr, -1, argc, argv);
15042 Jim_SetResult(interp, objPtr);
15043 return JIM_OK;
15046 char **Jim_GetEnviron(void)
15048 #if defined(HAVE__NSGETENVIRON)
15049 return *_NSGetEnviron();
15050 #else
15051 #if !defined(NO_ENVIRON_EXTERN)
15052 extern char **environ;
15053 #endif
15055 return environ;
15056 #endif
15059 void Jim_SetEnviron(char **env)
15061 #if defined(HAVE__NSGETENVIRON)
15062 *_NSGetEnviron() = env;
15063 #else
15064 #if !defined(NO_ENVIRON_EXTERN)
15065 extern char **environ;
15066 #endif
15068 environ = env;
15069 #endif
15072 /* [env] */
15073 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15075 const char *key;
15076 const char *val;
15078 if (argc == 1) {
15079 char **e = Jim_GetEnviron();
15081 int i;
15082 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
15084 for (i = 0; e[i]; i++) {
15085 const char *equals = strchr(e[i], '=');
15087 if (equals) {
15088 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, e[i],
15089 equals - e[i]));
15090 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
15094 Jim_SetResult(interp, listObjPtr);
15095 return JIM_OK;
15098 if (argc < 2) {
15099 Jim_WrongNumArgs(interp, 1, argv, "varName ?default?");
15100 return JIM_ERR;
15102 key = Jim_String(argv[1]);
15103 val = getenv(key);
15104 if (val == NULL) {
15105 if (argc < 3) {
15106 Jim_SetResultFormatted(interp, "environment variable \"%#s\" does not exist", argv[1]);
15107 return JIM_ERR;
15109 val = Jim_String(argv[2]);
15111 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
15112 return JIM_OK;
15115 /* [source] */
15116 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15118 int retval;
15120 if (argc != 2) {
15121 Jim_WrongNumArgs(interp, 1, argv, "fileName");
15122 return JIM_ERR;
15124 retval = Jim_EvalFile(interp, Jim_String(argv[1]));
15125 if (retval == JIM_RETURN)
15126 return JIM_OK;
15127 return retval;
15130 /* [lreverse] */
15131 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15133 Jim_Obj *revObjPtr, **ele;
15134 int len;
15136 if (argc != 2) {
15137 Jim_WrongNumArgs(interp, 1, argv, "list");
15138 return JIM_ERR;
15140 JimListGetElements(interp, argv[1], &len, &ele);
15141 len--;
15142 revObjPtr = Jim_NewListObj(interp, NULL, 0);
15143 while (len >= 0)
15144 ListAppendElement(revObjPtr, ele[len--]);
15145 Jim_SetResult(interp, revObjPtr);
15146 return JIM_OK;
15149 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
15151 jim_wide len;
15153 if (step == 0)
15154 return -1;
15155 if (start == end)
15156 return 0;
15157 else if (step > 0 && start > end)
15158 return -1;
15159 else if (step < 0 && end > start)
15160 return -1;
15161 len = end - start;
15162 if (len < 0)
15163 len = -len; /* abs(len) */
15164 if (step < 0)
15165 step = -step; /* abs(step) */
15166 len = 1 + ((len - 1) / step);
15167 /* We can truncate safely to INT_MAX, the range command
15168 * will always return an error for a such long range
15169 * because Tcl lists can't be so long. */
15170 if (len > INT_MAX)
15171 len = INT_MAX;
15172 return (int)((len < 0) ? -1 : len);
15175 /* [range] */
15176 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15178 jim_wide start = 0, end, step = 1;
15179 int len, i;
15180 Jim_Obj *objPtr;
15182 if (argc < 2 || argc > 4) {
15183 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
15184 return JIM_ERR;
15186 if (argc == 2) {
15187 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
15188 return JIM_ERR;
15190 else {
15191 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
15192 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
15193 return JIM_ERR;
15194 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
15195 return JIM_ERR;
15197 if ((len = JimRangeLen(start, end, step)) == -1) {
15198 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
15199 return JIM_ERR;
15201 objPtr = Jim_NewListObj(interp, NULL, 0);
15202 for (i = 0; i < len; i++)
15203 ListAppendElement(objPtr, Jim_NewIntObj(interp, start + i * step));
15204 Jim_SetResult(interp, objPtr);
15205 return JIM_OK;
15208 /* [rand] */
15209 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15211 jim_wide min = 0, max = 0, len, maxMul;
15213 if (argc < 1 || argc > 3) {
15214 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
15215 return JIM_ERR;
15217 if (argc == 1) {
15218 max = JIM_WIDE_MAX;
15219 } else if (argc == 2) {
15220 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
15221 return JIM_ERR;
15222 } else if (argc == 3) {
15223 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
15224 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
15225 return JIM_ERR;
15227 len = max-min;
15228 if (len < 0) {
15229 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
15230 return JIM_ERR;
15232 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
15233 while (1) {
15234 jim_wide r;
15236 JimRandomBytes(interp, &r, sizeof(jim_wide));
15237 if (r < 0 || r >= maxMul) continue;
15238 r = (len == 0) ? 0 : r%len;
15239 Jim_SetResultInt(interp, min+r);
15240 return JIM_OK;
15244 static const struct {
15245 const char *name;
15246 Jim_CmdProc *cmdProc;
15247 } Jim_CoreCommandsTable[] = {
15248 {"alias", Jim_AliasCoreCommand},
15249 {"set", Jim_SetCoreCommand},
15250 {"unset", Jim_UnsetCoreCommand},
15251 {"puts", Jim_PutsCoreCommand},
15252 {"+", Jim_AddCoreCommand},
15253 {"*", Jim_MulCoreCommand},
15254 {"-", Jim_SubCoreCommand},
15255 {"/", Jim_DivCoreCommand},
15256 {"incr", Jim_IncrCoreCommand},
15257 {"while", Jim_WhileCoreCommand},
15258 {"loop", Jim_LoopCoreCommand},
15259 {"for", Jim_ForCoreCommand},
15260 {"foreach", Jim_ForeachCoreCommand},
15261 {"lmap", Jim_LmapCoreCommand},
15262 {"lassign", Jim_LassignCoreCommand},
15263 {"if", Jim_IfCoreCommand},
15264 {"switch", Jim_SwitchCoreCommand},
15265 {"list", Jim_ListCoreCommand},
15266 {"lindex", Jim_LindexCoreCommand},
15267 {"lset", Jim_LsetCoreCommand},
15268 {"lsearch", Jim_LsearchCoreCommand},
15269 {"llength", Jim_LlengthCoreCommand},
15270 {"lappend", Jim_LappendCoreCommand},
15271 {"linsert", Jim_LinsertCoreCommand},
15272 {"lreplace", Jim_LreplaceCoreCommand},
15273 {"lsort", Jim_LsortCoreCommand},
15274 {"append", Jim_AppendCoreCommand},
15275 {"debug", Jim_DebugCoreCommand},
15276 {"eval", Jim_EvalCoreCommand},
15277 {"uplevel", Jim_UplevelCoreCommand},
15278 {"expr", Jim_ExprCoreCommand},
15279 {"break", Jim_BreakCoreCommand},
15280 {"continue", Jim_ContinueCoreCommand},
15281 {"proc", Jim_ProcCoreCommand},
15282 {"concat", Jim_ConcatCoreCommand},
15283 {"return", Jim_ReturnCoreCommand},
15284 {"upvar", Jim_UpvarCoreCommand},
15285 {"global", Jim_GlobalCoreCommand},
15286 {"string", Jim_StringCoreCommand},
15287 {"time", Jim_TimeCoreCommand},
15288 {"exit", Jim_ExitCoreCommand},
15289 {"catch", Jim_CatchCoreCommand},
15290 #ifdef JIM_REFERENCES
15291 {"ref", Jim_RefCoreCommand},
15292 {"getref", Jim_GetrefCoreCommand},
15293 {"setref", Jim_SetrefCoreCommand},
15294 {"finalize", Jim_FinalizeCoreCommand},
15295 {"collect", Jim_CollectCoreCommand},
15296 #endif
15297 {"rename", Jim_RenameCoreCommand},
15298 {"dict", Jim_DictCoreCommand},
15299 {"subst", Jim_SubstCoreCommand},
15300 {"info", Jim_InfoCoreCommand},
15301 {"exists", Jim_ExistsCoreCommand},
15302 {"split", Jim_SplitCoreCommand},
15303 {"join", Jim_JoinCoreCommand},
15304 {"format", Jim_FormatCoreCommand},
15305 {"scan", Jim_ScanCoreCommand},
15306 {"error", Jim_ErrorCoreCommand},
15307 {"lrange", Jim_LrangeCoreCommand},
15308 {"lrepeat", Jim_LrepeatCoreCommand},
15309 {"env", Jim_EnvCoreCommand},
15310 {"source", Jim_SourceCoreCommand},
15311 {"lreverse", Jim_LreverseCoreCommand},
15312 {"range", Jim_RangeCoreCommand},
15313 {"rand", Jim_RandCoreCommand},
15314 {"tailcall", Jim_TailcallCoreCommand},
15315 {"local", Jim_LocalCoreCommand},
15316 {"upcall", Jim_UpcallCoreCommand},
15317 {"apply", Jim_ApplyCoreCommand},
15318 {NULL, NULL},
15321 void Jim_RegisterCoreCommands(Jim_Interp *interp)
15323 int i = 0;
15325 while (Jim_CoreCommandsTable[i].name != NULL) {
15326 Jim_CreateCommand(interp,
15327 Jim_CoreCommandsTable[i].name, Jim_CoreCommandsTable[i].cmdProc, NULL, NULL);
15328 i++;
15332 /* -----------------------------------------------------------------------------
15333 * Interactive prompt
15334 * ---------------------------------------------------------------------------*/
15335 void Jim_MakeErrorMessage(Jim_Interp *interp)
15337 Jim_Obj *argv[2];
15339 argv[0] = Jim_NewStringObj(interp, "errorInfo", -1);
15340 argv[1] = interp->result;
15342 Jim_EvalObjVector(interp, 2, argv);
15346 * Given a null terminated array of strings, returns an allocated, sorted
15347 * copy of the array.
15349 static char **JimSortStringTable(const char *const *tablePtr)
15351 int count;
15352 char **tablePtrSorted;
15354 /* Find the size of the table */
15355 for (count = 0; tablePtr[count]; count++) {
15358 /* Allocate one extra for the terminating NULL pointer */
15359 tablePtrSorted = Jim_Alloc(sizeof(char *) * (count + 1));
15360 memcpy(tablePtrSorted, tablePtr, sizeof(char *) * count);
15361 qsort(tablePtrSorted, count, sizeof(char *), qsortCompareStringPointers);
15362 tablePtrSorted[count] = NULL;
15364 return tablePtrSorted;
15367 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
15368 const char *prefix, const char *const *tablePtr, const char *name)
15370 char **tablePtrSorted;
15371 int i;
15373 if (name == NULL) {
15374 name = "option";
15377 Jim_SetResultFormatted(interp, "%s%s \"%s\": must be ", badtype, name, arg);
15378 tablePtrSorted = JimSortStringTable(tablePtr);
15379 for (i = 0; tablePtrSorted[i]; i++) {
15380 if (tablePtrSorted[i + 1] == NULL && i > 0) {
15381 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
15383 Jim_AppendStrings(interp, Jim_GetResult(interp), prefix, tablePtrSorted[i], NULL);
15384 if (tablePtrSorted[i + 1]) {
15385 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
15388 Jim_Free(tablePtrSorted);
15393 * If objPtr is "-commands" sets the Jim result as a sorted list of options in the table
15394 * and returns JIM_OK.
15396 * Otherwise returns JIM_ERR.
15398 int Jim_CheckShowCommands(Jim_Interp *interp, Jim_Obj *objPtr, const char *const *tablePtr)
15400 if (Jim_CompareStringImmediate(interp, objPtr, "-commands")) {
15401 int i;
15402 char **tablePtrSorted = JimSortStringTable(tablePtr);
15403 Jim_SetResult(interp, Jim_NewListObj(interp, NULL, 0));
15404 for (i = 0; tablePtrSorted[i]; i++) {
15405 Jim_ListAppendElement(interp, Jim_GetResult(interp), Jim_NewStringObj(interp, tablePtrSorted[i], -1));
15407 Jim_Free(tablePtrSorted);
15408 return JIM_OK;
15410 return JIM_ERR;
15413 /* internal rep is stored in ptrIntvalue
15414 * ptr = tablePtr
15415 * int1 = flags
15416 * int2 = index
15418 static const Jim_ObjType getEnumObjType = {
15419 "get-enum",
15420 NULL,
15421 NULL,
15422 NULL,
15423 JIM_TYPE_REFERENCES
15426 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
15427 const char *const *tablePtr, int *indexPtr, const char *name, int flags)
15429 const char *bad = "bad ";
15430 const char *const *entryPtr = NULL;
15431 int i;
15432 int match = -1;
15433 int arglen;
15434 const char *arg;
15436 if (objPtr->typePtr == &getEnumObjType) {
15437 if (objPtr->internalRep.ptrIntValue.ptr == tablePtr && objPtr->internalRep.ptrIntValue.int1 == flags) {
15438 *indexPtr = objPtr->internalRep.ptrIntValue.int2;
15439 return JIM_OK;
15443 arg = Jim_GetString(objPtr, &arglen);
15445 *indexPtr = -1;
15447 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
15448 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
15449 /* Found an exact match */
15450 match = i;
15451 goto found;
15453 if (flags & JIM_ENUM_ABBREV) {
15454 /* Accept an unambiguous abbreviation.
15455 * Note that '-' doesnt' consitute a valid abbreviation
15457 if (strncmp(arg, *entryPtr, arglen) == 0) {
15458 if (*arg == '-' && arglen == 1) {
15459 break;
15461 if (match >= 0) {
15462 bad = "ambiguous ";
15463 goto ambiguous;
15465 match = i;
15470 /* If we had an unambiguous partial match */
15471 if (match >= 0) {
15472 found:
15473 /* Record the match in the object */
15474 Jim_FreeIntRep(interp, objPtr);
15475 objPtr->typePtr = &getEnumObjType;
15476 objPtr->internalRep.ptrIntValue.ptr = (void *)tablePtr;
15477 objPtr->internalRep.ptrIntValue.int1 = flags;
15478 objPtr->internalRep.ptrIntValue.int2 = match;
15479 /* Return the result */
15480 *indexPtr = match;
15481 return JIM_OK;
15484 ambiguous:
15485 if (flags & JIM_ERRMSG) {
15486 JimSetFailedEnumResult(interp, arg, bad, "", tablePtr, name);
15488 return JIM_ERR;
15491 int Jim_FindByName(const char *name, const char * const array[], size_t len)
15493 int i;
15495 for (i = 0; i < (int)len; i++) {
15496 if (array[i] && strcmp(array[i], name) == 0) {
15497 return i;
15500 return -1;
15503 int Jim_IsDict(Jim_Obj *objPtr)
15505 return objPtr->typePtr == &dictObjType;
15508 int Jim_IsList(Jim_Obj *objPtr)
15510 return objPtr->typePtr == &listObjType;
15514 * Very simple printf-like formatting, designed for error messages.
15516 * The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
15517 * The resulting string is created and set as the result.
15519 * Each '%s' should correspond to a regular string parameter.
15520 * Each '%#s' should correspond to a (Jim_Obj *) parameter.
15521 * Any other printf specifier is not allowed (but %% is allowed for the % character).
15523 * e.g. Jim_SetResultFormatted(interp, "Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
15525 * Note: We take advantage of the fact that printf has the same behaviour for both %s and %#s
15527 * Note that any Jim_Obj parameters with zero ref count will be freed as a result of this call.
15529 void Jim_SetResultFormatted(Jim_Interp *interp, const char *format, ...)
15531 /* Initial space needed */
15532 int len = strlen(format);
15533 int extra = 0;
15534 int n = 0;
15535 const char *params[5];
15536 int nobjparam = 0;
15537 Jim_Obj *objparam[5];
15538 char *buf;
15539 va_list args;
15540 int i;
15542 va_start(args, format);
15544 for (i = 0; i < len && n < 5; i++) {
15545 int l;
15547 if (strncmp(format + i, "%s", 2) == 0) {
15548 params[n] = va_arg(args, char *);
15550 l = strlen(params[n]);
15552 else if (strncmp(format + i, "%#s", 3) == 0) {
15553 Jim_Obj *objPtr = va_arg(args, Jim_Obj *);
15555 params[n] = Jim_GetString(objPtr, &l);
15556 objparam[nobjparam++] = objPtr;
15557 Jim_IncrRefCount(objPtr);
15559 else {
15560 if (format[i] == '%') {
15561 i++;
15563 continue;
15565 n++;
15566 extra += l;
15569 len += extra;
15570 buf = Jim_Alloc(len + 1);
15571 len = snprintf(buf, len + 1, format, params[0], params[1], params[2], params[3], params[4]);
15573 va_end(args);
15575 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
15577 for (i = 0; i < nobjparam; i++) {
15578 Jim_DecrRefCount(interp, objparam[i]);
15582 /* stubs */
15583 #ifndef jim_ext_package
15584 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver, int flags)
15586 return JIM_OK;
15588 #endif
15589 #ifndef jim_ext_aio
15590 FILE *Jim_AioFilehandle(Jim_Interp *interp, Jim_Obj *fhObj)
15592 Jim_SetResultString(interp, "aio not enabled", -1);
15593 return NULL;
15595 #endif
15599 * Local Variables: ***
15600 * c-basic-offset: 4 ***
15601 * tab-width: 4 ***
15602 * End: ***