appveyor.yml: fix build in forks
[jimtcl.git] / jim.c
blob499fa692e32bf6b63ec2934c1c9d6b92505fd484
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 ------------------------- */
731 * Reset a hashtable already initialized.
732 * The table data should already have been freed.
734 * Note that type and privdata are not initialised
735 * to allow the now-empty hashtable to be reused
737 static void JimResetHashTable(Jim_HashTable *ht)
739 ht->table = NULL;
740 ht->size = 0;
741 ht->sizemask = 0;
742 ht->used = 0;
743 ht->collisions = 0;
744 #ifdef JIM_RANDOMISE_HASH
745 /* This is initialised to a random value to avoid a hash collision attack.
746 * See: n.runs-SA-2011.004
748 ht->uniq = (rand() ^ time(NULL) ^ clock());
749 #else
750 ht->uniq = 0;
751 #endif
754 static void JimInitHashTableIterator(Jim_HashTable *ht, Jim_HashTableIterator *iter)
756 iter->ht = ht;
757 iter->index = -1;
758 iter->entry = NULL;
759 iter->nextEntry = NULL;
762 /* Initialize the hash table */
763 int Jim_InitHashTable(Jim_HashTable *ht, const Jim_HashTableType *type, void *privDataPtr)
765 JimResetHashTable(ht);
766 ht->type = type;
767 ht->privdata = privDataPtr;
768 return JIM_OK;
771 /* Expand or create the hashtable */
772 void Jim_ExpandHashTable(Jim_HashTable *ht, unsigned int size)
774 Jim_HashTable n; /* the new hashtable */
775 unsigned int realsize = JimHashTableNextPower(size), i;
777 /* the size is invalid if it is smaller than the number of
778 * elements already inside the hashtable */
779 if (size <= ht->used)
780 return;
782 Jim_InitHashTable(&n, ht->type, ht->privdata);
783 n.size = realsize;
784 n.sizemask = realsize - 1;
785 n.table = Jim_Alloc(realsize * sizeof(Jim_HashEntry *));
786 /* Keep the same 'uniq' as the original */
787 n.uniq = ht->uniq;
789 /* Initialize all the pointers to NULL */
790 memset(n.table, 0, realsize * sizeof(Jim_HashEntry *));
792 /* Copy all the elements from the old to the new table:
793 * note that if the old hash table is empty ht->used is zero,
794 * so Jim_ExpandHashTable just creates an empty hash table. */
795 n.used = ht->used;
796 for (i = 0; ht->used > 0; i++) {
797 Jim_HashEntry *he, *nextHe;
799 if (ht->table[i] == NULL)
800 continue;
802 /* For each hash entry on this slot... */
803 he = ht->table[i];
804 while (he) {
805 unsigned int h;
807 nextHe = he->next;
808 /* Get the new element index */
809 h = Jim_HashKey(ht, he->key) & n.sizemask;
810 he->next = n.table[h];
811 n.table[h] = he;
812 ht->used--;
813 /* Pass to the next element */
814 he = nextHe;
817 assert(ht->used == 0);
818 Jim_Free(ht->table);
820 /* Remap the new hashtable in the old */
821 *ht = n;
824 /* Add an element to the target hash table */
825 int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val)
827 Jim_HashEntry *entry;
829 /* Get the index of the new element, or -1 if
830 * the element already exists. */
831 entry = JimInsertHashEntry(ht, key, 0);
832 if (entry == NULL)
833 return JIM_ERR;
835 /* Set the hash entry fields. */
836 Jim_SetHashKey(ht, entry, key);
837 Jim_SetHashVal(ht, entry, val);
838 return JIM_OK;
841 /* Add an element, discarding the old if the key already exists */
842 int Jim_ReplaceHashEntry(Jim_HashTable *ht, const void *key, void *val)
844 int existed;
845 Jim_HashEntry *entry;
847 /* Get the index of the new element, or -1 if
848 * the element already exists. */
849 entry = JimInsertHashEntry(ht, key, 1);
850 if (entry->key) {
851 /* It already exists, so only replace the value.
852 * Note if both a destructor and a duplicate function exist,
853 * need to dup before destroy. perhaps they are the same
854 * reference counted object
856 if (ht->type->valDestructor && ht->type->valDup) {
857 void *newval = ht->type->valDup(ht->privdata, val);
858 ht->type->valDestructor(ht->privdata, entry->u.val);
859 entry->u.val = newval;
861 else {
862 Jim_FreeEntryVal(ht, entry);
863 Jim_SetHashVal(ht, entry, val);
865 existed = 1;
867 else {
868 /* Doesn't exist, so set the key */
869 Jim_SetHashKey(ht, entry, key);
870 Jim_SetHashVal(ht, entry, val);
871 existed = 0;
874 return existed;
877 /* Search and remove an element */
878 int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key)
880 unsigned int h;
881 Jim_HashEntry *he, *prevHe;
883 if (ht->used == 0)
884 return JIM_ERR;
885 h = Jim_HashKey(ht, key) & ht->sizemask;
886 he = ht->table[h];
888 prevHe = NULL;
889 while (he) {
890 if (Jim_CompareHashKeys(ht, key, he->key)) {
891 /* Unlink the element from the list */
892 if (prevHe)
893 prevHe->next = he->next;
894 else
895 ht->table[h] = he->next;
896 Jim_FreeEntryKey(ht, he);
897 Jim_FreeEntryVal(ht, he);
898 Jim_Free(he);
899 ht->used--;
900 return JIM_OK;
902 prevHe = he;
903 he = he->next;
905 return JIM_ERR; /* not found */
908 /* Remove all entries from the hash table
909 * and leave it empty for reuse
911 int Jim_FreeHashTable(Jim_HashTable *ht)
913 unsigned int i;
915 /* Free all the elements */
916 for (i = 0; ht->used > 0; i++) {
917 Jim_HashEntry *he, *nextHe;
919 if ((he = ht->table[i]) == NULL)
920 continue;
921 while (he) {
922 nextHe = he->next;
923 Jim_FreeEntryKey(ht, he);
924 Jim_FreeEntryVal(ht, he);
925 Jim_Free(he);
926 ht->used--;
927 he = nextHe;
930 /* Free the table and the allocated cache structure */
931 Jim_Free(ht->table);
932 /* Re-initialize the table */
933 JimResetHashTable(ht);
934 return JIM_OK; /* never fails */
937 Jim_HashEntry *Jim_FindHashEntry(Jim_HashTable *ht, const void *key)
939 Jim_HashEntry *he;
940 unsigned int h;
942 if (ht->used == 0)
943 return NULL;
944 h = Jim_HashKey(ht, key) & ht->sizemask;
945 he = ht->table[h];
946 while (he) {
947 if (Jim_CompareHashKeys(ht, key, he->key))
948 return he;
949 he = he->next;
951 return NULL;
954 Jim_HashTableIterator *Jim_GetHashTableIterator(Jim_HashTable *ht)
956 Jim_HashTableIterator *iter = Jim_Alloc(sizeof(*iter));
957 JimInitHashTableIterator(ht, iter);
958 return iter;
961 Jim_HashEntry *Jim_NextHashEntry(Jim_HashTableIterator *iter)
963 while (1) {
964 if (iter->entry == NULL) {
965 iter->index++;
966 if (iter->index >= (signed)iter->ht->size)
967 break;
968 iter->entry = iter->ht->table[iter->index];
970 else {
971 iter->entry = iter->nextEntry;
973 if (iter->entry) {
974 /* We need to save the 'next' here, the iterator user
975 * may delete the entry we are returning. */
976 iter->nextEntry = iter->entry->next;
977 return iter->entry;
980 return NULL;
983 /* ------------------------- private functions ------------------------------ */
985 /* Expand the hash table if needed */
986 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht)
988 /* If the hash table is empty expand it to the intial size,
989 * if the table is "full" double its size. */
990 if (ht->size == 0)
991 Jim_ExpandHashTable(ht, JIM_HT_INITIAL_SIZE);
992 if (ht->size == ht->used)
993 Jim_ExpandHashTable(ht, ht->size * 2);
996 /* Our hash table capability is a power of two */
997 static unsigned int JimHashTableNextPower(unsigned int size)
999 unsigned int i = JIM_HT_INITIAL_SIZE;
1001 if (size >= 2147483648U)
1002 return 2147483648U;
1003 while (1) {
1004 if (i >= size)
1005 return i;
1006 i *= 2;
1010 /* Returns the index of a free slot that can be populated with
1011 * a hash entry for the given 'key'.
1012 * If the key already exists, -1 is returned. */
1013 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace)
1015 unsigned int h;
1016 Jim_HashEntry *he;
1018 /* Expand the hashtable if needed */
1019 JimExpandHashTableIfNeeded(ht);
1021 /* Compute the key hash value */
1022 h = Jim_HashKey(ht, key) & ht->sizemask;
1023 /* Search if this slot does not already contain the given key */
1024 he = ht->table[h];
1025 while (he) {
1026 if (Jim_CompareHashKeys(ht, key, he->key))
1027 return replace ? he : NULL;
1028 he = he->next;
1031 /* Allocates the memory and stores key */
1032 he = Jim_Alloc(sizeof(*he));
1033 he->next = ht->table[h];
1034 ht->table[h] = he;
1035 ht->used++;
1036 he->key = NULL;
1038 return he;
1041 /* ----------------------- StringCopy Hash Table Type ------------------------*/
1043 static unsigned int JimStringCopyHTHashFunction(const void *key)
1045 return Jim_GenHashFunction(key, strlen(key));
1048 static void *JimStringCopyHTDup(void *privdata, const void *key)
1050 return Jim_StrDup(key);
1053 static int JimStringCopyHTKeyCompare(void *privdata, const void *key1, const void *key2)
1055 return strcmp(key1, key2) == 0;
1058 static void JimStringCopyHTKeyDestructor(void *privdata, void *key)
1060 Jim_Free(key);
1063 static const Jim_HashTableType JimPackageHashTableType = {
1064 JimStringCopyHTHashFunction, /* hash function */
1065 JimStringCopyHTDup, /* key dup */
1066 NULL, /* val dup */
1067 JimStringCopyHTKeyCompare, /* key compare */
1068 JimStringCopyHTKeyDestructor, /* key destructor */
1069 NULL /* val destructor */
1072 typedef struct AssocDataValue
1074 Jim_InterpDeleteProc *delProc;
1075 void *data;
1076 } AssocDataValue;
1078 static void JimAssocDataHashTableValueDestructor(void *privdata, void *data)
1080 AssocDataValue *assocPtr = (AssocDataValue *) data;
1082 if (assocPtr->delProc != NULL)
1083 assocPtr->delProc((Jim_Interp *)privdata, assocPtr->data);
1084 Jim_Free(data);
1087 static const Jim_HashTableType JimAssocDataHashTableType = {
1088 JimStringCopyHTHashFunction, /* hash function */
1089 JimStringCopyHTDup, /* key dup */
1090 NULL, /* val dup */
1091 JimStringCopyHTKeyCompare, /* key compare */
1092 JimStringCopyHTKeyDestructor, /* key destructor */
1093 JimAssocDataHashTableValueDestructor /* val destructor */
1096 /* -----------------------------------------------------------------------------
1097 * Stack - This is a simple generic stack implementation. It is used for
1098 * example in the 'expr' expression compiler.
1099 * ---------------------------------------------------------------------------*/
1100 void Jim_InitStack(Jim_Stack *stack)
1102 stack->len = 0;
1103 stack->maxlen = 0;
1104 stack->vector = NULL;
1107 void Jim_FreeStack(Jim_Stack *stack)
1109 Jim_Free(stack->vector);
1112 int Jim_StackLen(Jim_Stack *stack)
1114 return stack->len;
1117 void Jim_StackPush(Jim_Stack *stack, void *element)
1119 int neededLen = stack->len + 1;
1121 if (neededLen > stack->maxlen) {
1122 stack->maxlen = neededLen < 20 ? 20 : neededLen * 2;
1123 stack->vector = Jim_Realloc(stack->vector, sizeof(void *) * stack->maxlen);
1125 stack->vector[stack->len] = element;
1126 stack->len++;
1129 void *Jim_StackPop(Jim_Stack *stack)
1131 if (stack->len == 0)
1132 return NULL;
1133 stack->len--;
1134 return stack->vector[stack->len];
1137 void *Jim_StackPeek(Jim_Stack *stack)
1139 if (stack->len == 0)
1140 return NULL;
1141 return stack->vector[stack->len - 1];
1144 void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc) (void *ptr))
1146 int i;
1148 for (i = 0; i < stack->len; i++)
1149 freeFunc(stack->vector[i]);
1152 /* -----------------------------------------------------------------------------
1153 * Tcl Parser
1154 * ---------------------------------------------------------------------------*/
1156 /* Token types */
1157 #define JIM_TT_NONE 0 /* No token returned */
1158 #define JIM_TT_STR 1 /* simple string */
1159 #define JIM_TT_ESC 2 /* string that needs escape chars conversion */
1160 #define JIM_TT_VAR 3 /* var substitution */
1161 #define JIM_TT_DICTSUGAR 4 /* Syntax sugar for [dict get], $foo(bar) */
1162 #define JIM_TT_CMD 5 /* command substitution */
1163 /* Note: Keep these three together for TOKEN_IS_SEP() */
1164 #define JIM_TT_SEP 6 /* word separator (white space) */
1165 #define JIM_TT_EOL 7 /* line separator */
1166 #define JIM_TT_EOF 8 /* end of script */
1168 #define JIM_TT_LINE 9 /* special 'start-of-line' token. arg is # of arguments to the command. -ve if {*} */
1169 #define JIM_TT_WORD 10 /* special 'start-of-word' token. arg is # of tokens to combine. -ve if {*} */
1171 /* Additional token types needed for expressions */
1172 #define JIM_TT_SUBEXPR_START 11
1173 #define JIM_TT_SUBEXPR_END 12
1174 #define JIM_TT_SUBEXPR_COMMA 13
1175 #define JIM_TT_EXPR_INT 14
1176 #define JIM_TT_EXPR_DOUBLE 15
1177 #define JIM_TT_EXPR_BOOLEAN 16
1179 #define JIM_TT_EXPRSUGAR 17 /* $(expression) */
1181 /* Operator token types start here */
1182 #define JIM_TT_EXPR_OP 20
1184 #define TOKEN_IS_SEP(type) (type >= JIM_TT_SEP && type <= JIM_TT_EOF)
1185 /* Can this token start an expression? */
1186 #define TOKEN_IS_EXPR_START(type) (type == JIM_TT_NONE || type == JIM_TT_SUBEXPR_START || type == JIM_TT_SUBEXPR_COMMA)
1187 /* Is this token an expression operator? */
1188 #define TOKEN_IS_EXPR_OP(type) (type >= JIM_TT_EXPR_OP)
1191 * Results of missing quotes, braces, etc. from parsing.
1193 struct JimParseMissing {
1194 int ch; /* At end of parse, ' ' if complete or '{', '[', '"', '\\', '}' if incomplete */
1195 int line; /* Line number starting the missing token */
1198 /* Parser context structure. The same context is used to parse
1199 * Tcl scripts, expressions and lists. */
1200 struct JimParserCtx
1202 const char *p; /* Pointer to the point of the program we are parsing */
1203 int len; /* Remaining length */
1204 int linenr; /* Current line number */
1205 const char *tstart;
1206 const char *tend; /* Returned token is at tstart-tend in 'prg'. */
1207 int tline; /* Line number of the returned token */
1208 int tt; /* Token type */
1209 int eof; /* Non zero if EOF condition is true. */
1210 int inquote; /* Parsing a quoted string */
1211 int comment; /* Non zero if the next chars may be a comment. */
1212 struct JimParseMissing missing; /* Details of any missing quotes, etc. */
1215 static int JimParseScript(struct JimParserCtx *pc);
1216 static int JimParseSep(struct JimParserCtx *pc);
1217 static int JimParseEol(struct JimParserCtx *pc);
1218 static int JimParseCmd(struct JimParserCtx *pc);
1219 static int JimParseQuote(struct JimParserCtx *pc);
1220 static int JimParseVar(struct JimParserCtx *pc);
1221 static int JimParseBrace(struct JimParserCtx *pc);
1222 static int JimParseStr(struct JimParserCtx *pc);
1223 static int JimParseComment(struct JimParserCtx *pc);
1224 static void JimParseSubCmd(struct JimParserCtx *pc);
1225 static int JimParseSubQuote(struct JimParserCtx *pc);
1226 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc);
1228 /* Initialize a parser context.
1229 * 'prg' is a pointer to the program text, linenr is the line
1230 * number of the first line contained in the program. */
1231 static void JimParserInit(struct JimParserCtx *pc, const char *prg, int len, int linenr)
1233 pc->p = prg;
1234 pc->len = len;
1235 pc->tstart = NULL;
1236 pc->tend = NULL;
1237 pc->tline = 0;
1238 pc->tt = JIM_TT_NONE;
1239 pc->eof = 0;
1240 pc->inquote = 0;
1241 pc->linenr = linenr;
1242 pc->comment = 1;
1243 pc->missing.ch = ' ';
1244 pc->missing.line = linenr;
1247 static int JimParseScript(struct JimParserCtx *pc)
1249 while (1) { /* the while is used to reiterate with continue if needed */
1250 if (!pc->len) {
1251 pc->tstart = pc->p;
1252 pc->tend = pc->p - 1;
1253 pc->tline = pc->linenr;
1254 pc->tt = JIM_TT_EOL;
1255 pc->eof = 1;
1256 return JIM_OK;
1258 switch (*(pc->p)) {
1259 case '\\':
1260 if (*(pc->p + 1) == '\n' && !pc->inquote) {
1261 return JimParseSep(pc);
1263 pc->comment = 0;
1264 return JimParseStr(pc);
1265 case ' ':
1266 case '\t':
1267 case '\r':
1268 case '\f':
1269 if (!pc->inquote)
1270 return JimParseSep(pc);
1271 pc->comment = 0;
1272 return JimParseStr(pc);
1273 case '\n':
1274 case ';':
1275 pc->comment = 1;
1276 if (!pc->inquote)
1277 return JimParseEol(pc);
1278 return JimParseStr(pc);
1279 case '[':
1280 pc->comment = 0;
1281 return JimParseCmd(pc);
1282 case '$':
1283 pc->comment = 0;
1284 if (JimParseVar(pc) == JIM_ERR) {
1285 /* An orphan $. Create as a separate token */
1286 pc->tstart = pc->tend = pc->p++;
1287 pc->len--;
1288 pc->tt = JIM_TT_ESC;
1290 return JIM_OK;
1291 case '#':
1292 if (pc->comment) {
1293 JimParseComment(pc);
1294 continue;
1296 return JimParseStr(pc);
1297 default:
1298 pc->comment = 0;
1299 return JimParseStr(pc);
1301 return JIM_OK;
1305 static int JimParseSep(struct JimParserCtx *pc)
1307 pc->tstart = pc->p;
1308 pc->tline = pc->linenr;
1309 while (isspace(UCHAR(*pc->p)) || (*pc->p == '\\' && *(pc->p + 1) == '\n')) {
1310 if (*pc->p == '\n') {
1311 break;
1313 if (*pc->p == '\\') {
1314 pc->p++;
1315 pc->len--;
1316 pc->linenr++;
1318 pc->p++;
1319 pc->len--;
1321 pc->tend = pc->p - 1;
1322 pc->tt = JIM_TT_SEP;
1323 return JIM_OK;
1326 static int JimParseEol(struct JimParserCtx *pc)
1328 pc->tstart = pc->p;
1329 pc->tline = pc->linenr;
1330 while (isspace(UCHAR(*pc->p)) || *pc->p == ';') {
1331 if (*pc->p == '\n')
1332 pc->linenr++;
1333 pc->p++;
1334 pc->len--;
1336 pc->tend = pc->p - 1;
1337 pc->tt = JIM_TT_EOL;
1338 return JIM_OK;
1342 ** Here are the rules for parsing:
1343 ** {braced expression}
1344 ** - Count open and closing braces
1345 ** - Backslash escapes meaning of braces but doesn't remove the backslash
1347 ** "quoted expression"
1348 ** - Unescaped double quote terminates the expression
1349 ** - Backslash escapes next char
1350 ** - [commands brackets] are counted/nested
1351 ** - command rules apply within [brackets], not quoting rules (i.e. brackets have their own rules)
1353 ** [command expression]
1354 ** - Count open and closing brackets
1355 ** - Backslash escapes next char
1356 ** - [commands brackets] are counted/nested
1357 ** - "quoted expressions" are parsed according to quoting rules
1358 ** - {braced expressions} are parsed according to brace rules
1360 ** For everything, backslash escapes the next char, newline increments current line
1364 * Parses a braced expression starting at pc->p.
1366 * Positions the parser at the end of the braced expression,
1367 * sets pc->tend and possibly pc->missing.
1369 static void JimParseSubBrace(struct JimParserCtx *pc)
1371 int level = 1;
1373 /* Skip the brace */
1374 pc->p++;
1375 pc->len--;
1376 while (pc->len) {
1377 switch (*pc->p) {
1378 case '\\':
1379 if (pc->len > 1) {
1380 if (*++pc->p == '\n') {
1381 pc->linenr++;
1383 pc->len--;
1385 break;
1387 case '{':
1388 level++;
1389 break;
1391 case '}':
1392 if (--level == 0) {
1393 pc->tend = pc->p - 1;
1394 pc->p++;
1395 pc->len--;
1396 return;
1398 break;
1400 case '\n':
1401 pc->linenr++;
1402 break;
1404 pc->p++;
1405 pc->len--;
1407 pc->missing.ch = '{';
1408 pc->missing.line = pc->tline;
1409 pc->tend = pc->p - 1;
1413 * Parses a quoted expression starting at pc->p.
1415 * Positions the parser at the end of the quoted expression,
1416 * sets pc->tend and possibly pc->missing.
1418 * Returns the type of the token of the string,
1419 * either JIM_TT_ESC (if it contains values which need to be [subst]ed)
1420 * or JIM_TT_STR.
1422 static int JimParseSubQuote(struct JimParserCtx *pc)
1424 int tt = JIM_TT_STR;
1425 int line = pc->tline;
1427 /* Skip the quote */
1428 pc->p++;
1429 pc->len--;
1430 while (pc->len) {
1431 switch (*pc->p) {
1432 case '\\':
1433 if (pc->len > 1) {
1434 if (*++pc->p == '\n') {
1435 pc->linenr++;
1437 pc->len--;
1438 tt = JIM_TT_ESC;
1440 break;
1442 case '"':
1443 pc->tend = pc->p - 1;
1444 pc->p++;
1445 pc->len--;
1446 return tt;
1448 case '[':
1449 JimParseSubCmd(pc);
1450 tt = JIM_TT_ESC;
1451 continue;
1453 case '\n':
1454 pc->linenr++;
1455 break;
1457 case '$':
1458 tt = JIM_TT_ESC;
1459 break;
1461 pc->p++;
1462 pc->len--;
1464 pc->missing.ch = '"';
1465 pc->missing.line = line;
1466 pc->tend = pc->p - 1;
1467 return tt;
1471 * Parses a [command] expression starting at pc->p.
1473 * Positions the parser at the end of the command expression,
1474 * sets pc->tend and possibly pc->missing.
1476 static void JimParseSubCmd(struct JimParserCtx *pc)
1478 int level = 1;
1479 int startofword = 1;
1480 int line = pc->tline;
1482 /* Skip the bracket */
1483 pc->p++;
1484 pc->len--;
1485 while (pc->len) {
1486 switch (*pc->p) {
1487 case '\\':
1488 if (pc->len > 1) {
1489 if (*++pc->p == '\n') {
1490 pc->linenr++;
1492 pc->len--;
1494 break;
1496 case '[':
1497 level++;
1498 break;
1500 case ']':
1501 if (--level == 0) {
1502 pc->tend = pc->p - 1;
1503 pc->p++;
1504 pc->len--;
1505 return;
1507 break;
1509 case '"':
1510 if (startofword) {
1511 JimParseSubQuote(pc);
1512 continue;
1514 break;
1516 case '{':
1517 JimParseSubBrace(pc);
1518 startofword = 0;
1519 continue;
1521 case '\n':
1522 pc->linenr++;
1523 break;
1525 startofword = isspace(UCHAR(*pc->p));
1526 pc->p++;
1527 pc->len--;
1529 pc->missing.ch = '[';
1530 pc->missing.line = line;
1531 pc->tend = pc->p - 1;
1534 static int JimParseBrace(struct JimParserCtx *pc)
1536 pc->tstart = pc->p + 1;
1537 pc->tline = pc->linenr;
1538 pc->tt = JIM_TT_STR;
1539 JimParseSubBrace(pc);
1540 return JIM_OK;
1543 static int JimParseCmd(struct JimParserCtx *pc)
1545 pc->tstart = pc->p + 1;
1546 pc->tline = pc->linenr;
1547 pc->tt = JIM_TT_CMD;
1548 JimParseSubCmd(pc);
1549 return JIM_OK;
1552 static int JimParseQuote(struct JimParserCtx *pc)
1554 pc->tstart = pc->p + 1;
1555 pc->tline = pc->linenr;
1556 pc->tt = JimParseSubQuote(pc);
1557 return JIM_OK;
1560 static int JimParseVar(struct JimParserCtx *pc)
1562 /* skip the $ */
1563 pc->p++;
1564 pc->len--;
1566 #ifdef EXPRSUGAR_BRACKET
1567 if (*pc->p == '[') {
1568 /* Parse $[...] expr shorthand syntax */
1569 JimParseCmd(pc);
1570 pc->tt = JIM_TT_EXPRSUGAR;
1571 return JIM_OK;
1573 #endif
1575 pc->tstart = pc->p;
1576 pc->tt = JIM_TT_VAR;
1577 pc->tline = pc->linenr;
1579 if (*pc->p == '{') {
1580 pc->tstart = ++pc->p;
1581 pc->len--;
1583 while (pc->len && *pc->p != '}') {
1584 if (*pc->p == '\n') {
1585 pc->linenr++;
1587 pc->p++;
1588 pc->len--;
1590 pc->tend = pc->p - 1;
1591 if (pc->len) {
1592 pc->p++;
1593 pc->len--;
1596 else {
1597 while (1) {
1598 /* Skip double colon, but not single colon! */
1599 if (pc->p[0] == ':' && pc->p[1] == ':') {
1600 while (*pc->p == ':') {
1601 pc->p++;
1602 pc->len--;
1604 continue;
1606 /* Note that any char >= 0x80 must be part of a utf-8 char.
1607 * We consider all unicode points outside of ASCII as letters
1609 if (isalnum(UCHAR(*pc->p)) || *pc->p == '_' || UCHAR(*pc->p) >= 0x80) {
1610 pc->p++;
1611 pc->len--;
1612 continue;
1614 break;
1616 /* Parse [dict get] syntax sugar. */
1617 if (*pc->p == '(') {
1618 int count = 1;
1619 const char *paren = NULL;
1621 pc->tt = JIM_TT_DICTSUGAR;
1623 while (count && pc->len) {
1624 pc->p++;
1625 pc->len--;
1626 if (*pc->p == '\\' && pc->len >= 1) {
1627 pc->p++;
1628 pc->len--;
1630 else if (*pc->p == '(') {
1631 count++;
1633 else if (*pc->p == ')') {
1634 paren = pc->p;
1635 count--;
1638 if (count == 0) {
1639 pc->p++;
1640 pc->len--;
1642 else if (paren) {
1643 /* Did not find a matching paren. Back up */
1644 paren++;
1645 pc->len += (pc->p - paren);
1646 pc->p = paren;
1648 #ifndef EXPRSUGAR_BRACKET
1649 if (*pc->tstart == '(') {
1650 pc->tt = JIM_TT_EXPRSUGAR;
1652 #endif
1654 pc->tend = pc->p - 1;
1656 /* Check if we parsed just the '$' character.
1657 * That's not a variable so an error is returned
1658 * to tell the state machine to consider this '$' just
1659 * a string. */
1660 if (pc->tstart == pc->p) {
1661 pc->p--;
1662 pc->len++;
1663 return JIM_ERR;
1665 return JIM_OK;
1668 static int JimParseStr(struct JimParserCtx *pc)
1670 if (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1671 pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR) {
1672 /* Starting a new word */
1673 if (*pc->p == '{') {
1674 return JimParseBrace(pc);
1676 if (*pc->p == '"') {
1677 pc->inquote = 1;
1678 pc->p++;
1679 pc->len--;
1680 /* In case the end quote is missing */
1681 pc->missing.line = pc->tline;
1684 pc->tstart = pc->p;
1685 pc->tline = pc->linenr;
1686 while (1) {
1687 if (pc->len == 0) {
1688 if (pc->inquote) {
1689 pc->missing.ch = '"';
1691 pc->tend = pc->p - 1;
1692 pc->tt = JIM_TT_ESC;
1693 return JIM_OK;
1695 switch (*pc->p) {
1696 case '\\':
1697 if (!pc->inquote && *(pc->p + 1) == '\n') {
1698 pc->tend = pc->p - 1;
1699 pc->tt = JIM_TT_ESC;
1700 return JIM_OK;
1702 if (pc->len >= 2) {
1703 if (*(pc->p + 1) == '\n') {
1704 pc->linenr++;
1706 pc->p++;
1707 pc->len--;
1709 else if (pc->len == 1) {
1710 /* End of script with trailing backslash */
1711 pc->missing.ch = '\\';
1713 break;
1714 case '(':
1715 /* If the following token is not '$' just keep going */
1716 if (pc->len > 1 && pc->p[1] != '$') {
1717 break;
1719 /* fall through */
1720 case ')':
1721 /* Only need a separate ')' token if the previous was a var */
1722 if (*pc->p == '(' || pc->tt == JIM_TT_VAR) {
1723 if (pc->p == pc->tstart) {
1724 /* At the start of the token, so just return this char */
1725 pc->p++;
1726 pc->len--;
1728 pc->tend = pc->p - 1;
1729 pc->tt = JIM_TT_ESC;
1730 return JIM_OK;
1732 break;
1734 case '$':
1735 case '[':
1736 pc->tend = pc->p - 1;
1737 pc->tt = JIM_TT_ESC;
1738 return JIM_OK;
1739 case ' ':
1740 case '\t':
1741 case '\n':
1742 case '\r':
1743 case '\f':
1744 case ';':
1745 if (!pc->inquote) {
1746 pc->tend = pc->p - 1;
1747 pc->tt = JIM_TT_ESC;
1748 return JIM_OK;
1750 else if (*pc->p == '\n') {
1751 pc->linenr++;
1753 break;
1754 case '"':
1755 if (pc->inquote) {
1756 pc->tend = pc->p - 1;
1757 pc->tt = JIM_TT_ESC;
1758 pc->p++;
1759 pc->len--;
1760 pc->inquote = 0;
1761 return JIM_OK;
1763 break;
1765 pc->p++;
1766 pc->len--;
1768 return JIM_OK; /* unreached */
1771 static int JimParseComment(struct JimParserCtx *pc)
1773 while (*pc->p) {
1774 if (*pc->p == '\\') {
1775 pc->p++;
1776 pc->len--;
1777 if (pc->len == 0) {
1778 pc->missing.ch = '\\';
1779 return JIM_OK;
1781 if (*pc->p == '\n') {
1782 pc->linenr++;
1785 else if (*pc->p == '\n') {
1786 pc->p++;
1787 pc->len--;
1788 pc->linenr++;
1789 break;
1791 pc->p++;
1792 pc->len--;
1794 return JIM_OK;
1797 /* xdigitval and odigitval are helper functions for JimEscape() */
1798 static int xdigitval(int c)
1800 if (c >= '0' && c <= '9')
1801 return c - '0';
1802 if (c >= 'a' && c <= 'f')
1803 return c - 'a' + 10;
1804 if (c >= 'A' && c <= 'F')
1805 return c - 'A' + 10;
1806 return -1;
1809 static int odigitval(int c)
1811 if (c >= '0' && c <= '7')
1812 return c - '0';
1813 return -1;
1816 /* Perform Tcl escape substitution of 's', storing the result
1817 * string into 'dest'. The escaped string is guaranteed to
1818 * be the same length or shorter than the source string.
1819 * slen is the length of the string at 's'.
1821 * The function returns the length of the resulting string. */
1822 static int JimEscape(char *dest, const char *s, int slen)
1824 char *p = dest;
1825 int i, len;
1827 for (i = 0; i < slen; i++) {
1828 switch (s[i]) {
1829 case '\\':
1830 switch (s[i + 1]) {
1831 case 'a':
1832 *p++ = 0x7;
1833 i++;
1834 break;
1835 case 'b':
1836 *p++ = 0x8;
1837 i++;
1838 break;
1839 case 'f':
1840 *p++ = 0xc;
1841 i++;
1842 break;
1843 case 'n':
1844 *p++ = 0xa;
1845 i++;
1846 break;
1847 case 'r':
1848 *p++ = 0xd;
1849 i++;
1850 break;
1851 case 't':
1852 *p++ = 0x9;
1853 i++;
1854 break;
1855 case 'u':
1856 case 'U':
1857 case 'x':
1858 /* A unicode or hex sequence.
1859 * \x Expect 1-2 hex chars and convert to hex.
1860 * \u Expect 1-4 hex chars and convert to utf-8.
1861 * \U Expect 1-8 hex chars and convert to utf-8.
1862 * \u{NNN} supports 1-6 hex chars and convert to utf-8.
1863 * An invalid sequence means simply the escaped char.
1866 unsigned val = 0;
1867 int k;
1868 int maxchars = 2;
1870 i++;
1872 if (s[i] == 'U') {
1873 maxchars = 8;
1875 else if (s[i] == 'u') {
1876 if (s[i + 1] == '{') {
1877 maxchars = 6;
1878 i++;
1880 else {
1881 maxchars = 4;
1885 for (k = 0; k < maxchars; k++) {
1886 int c = xdigitval(s[i + k + 1]);
1887 if (c == -1) {
1888 break;
1890 val = (val << 4) | c;
1892 /* The \u{nnn} syntax supports up to 21 bit codepoints. */
1893 if (s[i] == '{') {
1894 if (k == 0 || val > 0x1fffff || s[i + k + 1] != '}') {
1895 /* Back up */
1896 i--;
1897 k = 0;
1899 else {
1900 /* Skip the closing brace */
1901 k++;
1904 if (k) {
1905 /* Got a valid sequence, so convert */
1906 if (s[i] == 'x') {
1907 *p++ = val;
1909 else {
1910 p += utf8_fromunicode(p, val);
1912 i += k;
1913 break;
1915 /* Not a valid codepoint, just an escaped char */
1916 *p++ = s[i];
1918 break;
1919 case 'v':
1920 *p++ = 0xb;
1921 i++;
1922 break;
1923 case '\0':
1924 *p++ = '\\';
1925 i++;
1926 break;
1927 case '\n':
1928 /* Replace all spaces and tabs after backslash newline with a single space*/
1929 *p++ = ' ';
1930 do {
1931 i++;
1932 } while (s[i + 1] == ' ' || s[i + 1] == '\t');
1933 break;
1934 case '0':
1935 case '1':
1936 case '2':
1937 case '3':
1938 case '4':
1939 case '5':
1940 case '6':
1941 case '7':
1942 /* octal escape */
1944 int val = 0;
1945 int c = odigitval(s[i + 1]);
1947 val = c;
1948 c = odigitval(s[i + 2]);
1949 if (c == -1) {
1950 *p++ = val;
1951 i++;
1952 break;
1954 val = (val * 8) + c;
1955 c = odigitval(s[i + 3]);
1956 if (c == -1) {
1957 *p++ = val;
1958 i += 2;
1959 break;
1961 val = (val * 8) + c;
1962 *p++ = val;
1963 i += 3;
1965 break;
1966 default:
1967 *p++ = s[i + 1];
1968 i++;
1969 break;
1971 break;
1972 default:
1973 *p++ = s[i];
1974 break;
1977 len = p - dest;
1978 *p = '\0';
1979 return len;
1982 /* Returns a dynamically allocated copy of the current token in the
1983 * parser context. The function performs conversion of escapes if
1984 * the token is of type JIM_TT_ESC.
1986 * Note that after the conversion, tokens that are grouped with
1987 * braces in the source code, are always recognizable from the
1988 * identical string obtained in a different way from the type.
1990 * For example the string:
1992 * {*}$a
1994 * will return as first token "*", of type JIM_TT_STR
1996 * While the string:
1998 * *$a
2000 * will return as first token "*", of type JIM_TT_ESC
2002 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc)
2004 const char *start, *end;
2005 char *token;
2006 int len;
2008 start = pc->tstart;
2009 end = pc->tend;
2010 len = (end - start) + 1;
2011 if (len < 0) {
2012 len = 0;
2014 token = Jim_Alloc(len + 1);
2015 if (pc->tt != JIM_TT_ESC) {
2016 /* No escape conversion needed? Just copy it. */
2017 memcpy(token, start, len);
2018 token[len] = '\0';
2020 else {
2021 /* Else convert the escape chars. */
2022 len = JimEscape(token, start, len);
2025 return Jim_NewStringObjNoAlloc(interp, token, len);
2028 /* -----------------------------------------------------------------------------
2029 * Tcl Lists parsing
2030 * ---------------------------------------------------------------------------*/
2031 static int JimParseListSep(struct JimParserCtx *pc);
2032 static int JimParseListStr(struct JimParserCtx *pc);
2033 static int JimParseListQuote(struct JimParserCtx *pc);
2035 static int JimParseList(struct JimParserCtx *pc)
2037 if (isspace(UCHAR(*pc->p))) {
2038 return JimParseListSep(pc);
2040 switch (*pc->p) {
2041 case '"':
2042 return JimParseListQuote(pc);
2044 case '{':
2045 return JimParseBrace(pc);
2047 default:
2048 if (pc->len) {
2049 return JimParseListStr(pc);
2051 break;
2054 pc->tstart = pc->tend = pc->p;
2055 pc->tline = pc->linenr;
2056 pc->tt = JIM_TT_EOL;
2057 pc->eof = 1;
2058 return JIM_OK;
2061 static int JimParseListSep(struct JimParserCtx *pc)
2063 pc->tstart = pc->p;
2064 pc->tline = pc->linenr;
2065 while (isspace(UCHAR(*pc->p))) {
2066 if (*pc->p == '\n') {
2067 pc->linenr++;
2069 pc->p++;
2070 pc->len--;
2072 pc->tend = pc->p - 1;
2073 pc->tt = JIM_TT_SEP;
2074 return JIM_OK;
2077 static int JimParseListQuote(struct JimParserCtx *pc)
2079 pc->p++;
2080 pc->len--;
2082 pc->tstart = pc->p;
2083 pc->tline = pc->linenr;
2084 pc->tt = JIM_TT_STR;
2086 while (pc->len) {
2087 switch (*pc->p) {
2088 case '\\':
2089 pc->tt = JIM_TT_ESC;
2090 if (--pc->len == 0) {
2091 /* Trailing backslash */
2092 pc->tend = pc->p;
2093 return JIM_OK;
2095 pc->p++;
2096 break;
2097 case '\n':
2098 pc->linenr++;
2099 break;
2100 case '"':
2101 pc->tend = pc->p - 1;
2102 pc->p++;
2103 pc->len--;
2104 return JIM_OK;
2106 pc->p++;
2107 pc->len--;
2110 pc->tend = pc->p - 1;
2111 return JIM_OK;
2114 static int JimParseListStr(struct JimParserCtx *pc)
2116 pc->tstart = pc->p;
2117 pc->tline = pc->linenr;
2118 pc->tt = JIM_TT_STR;
2120 while (pc->len) {
2121 if (isspace(UCHAR(*pc->p))) {
2122 pc->tend = pc->p - 1;
2123 return JIM_OK;
2125 if (*pc->p == '\\') {
2126 if (--pc->len == 0) {
2127 /* Trailing backslash */
2128 pc->tend = pc->p;
2129 return JIM_OK;
2131 pc->tt = JIM_TT_ESC;
2132 pc->p++;
2134 pc->p++;
2135 pc->len--;
2137 pc->tend = pc->p - 1;
2138 return JIM_OK;
2141 /* -----------------------------------------------------------------------------
2142 * Jim_Obj related functions
2143 * ---------------------------------------------------------------------------*/
2145 /* Return a new initialized object. */
2146 Jim_Obj *Jim_NewObj(Jim_Interp *interp)
2148 Jim_Obj *objPtr;
2150 /* -- Check if there are objects in the free list -- */
2151 if (interp->freeList != NULL) {
2152 /* -- Unlink the object from the free list -- */
2153 objPtr = interp->freeList;
2154 interp->freeList = objPtr->nextObjPtr;
2156 else {
2157 /* -- No ready to use objects: allocate a new one -- */
2158 objPtr = Jim_Alloc(sizeof(*objPtr));
2161 /* Object is returned with refCount of 0. Every
2162 * kind of GC implemented should take care to avoid
2163 * scanning objects with refCount == 0. */
2164 objPtr->refCount = 0;
2165 /* All the other fields are left uninitialized to save time.
2166 * The caller will probably want to set them to the right
2167 * value anyway. */
2169 /* -- Put the object into the live list -- */
2170 objPtr->prevObjPtr = NULL;
2171 objPtr->nextObjPtr = interp->liveList;
2172 if (interp->liveList)
2173 interp->liveList->prevObjPtr = objPtr;
2174 interp->liveList = objPtr;
2176 return objPtr;
2179 /* Free an object. Actually objects are never freed, but
2180 * just moved to the free objects list, where they will be
2181 * reused by Jim_NewObj(). */
2182 void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr)
2184 /* Check if the object was already freed, panic. */
2185 JimPanic((objPtr->refCount != 0, "!!!Object %p freed with bad refcount %d, type=%s", objPtr,
2186 objPtr->refCount, objPtr->typePtr ? objPtr->typePtr->name : "<none>"));
2188 /* Free the internal representation */
2189 Jim_FreeIntRep(interp, objPtr);
2190 /* Free the string representation */
2191 if (objPtr->bytes != NULL) {
2192 if (objPtr->bytes != JimEmptyStringRep)
2193 Jim_Free(objPtr->bytes);
2195 /* Unlink the object from the live objects list */
2196 if (objPtr->prevObjPtr)
2197 objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr;
2198 if (objPtr->nextObjPtr)
2199 objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr;
2200 if (interp->liveList == objPtr)
2201 interp->liveList = objPtr->nextObjPtr;
2202 #ifdef JIM_DISABLE_OBJECT_POOL
2203 Jim_Free(objPtr);
2204 #else
2205 /* Link the object into the free objects list */
2206 objPtr->prevObjPtr = NULL;
2207 objPtr->nextObjPtr = interp->freeList;
2208 if (interp->freeList)
2209 interp->freeList->prevObjPtr = objPtr;
2210 interp->freeList = objPtr;
2211 objPtr->refCount = -1;
2212 #endif
2215 /* Invalidate the string representation of an object. */
2216 void Jim_InvalidateStringRep(Jim_Obj *objPtr)
2218 if (objPtr->bytes != NULL) {
2219 if (objPtr->bytes != JimEmptyStringRep)
2220 Jim_Free(objPtr->bytes);
2222 objPtr->bytes = NULL;
2225 /* Duplicate an object. The returned object has refcount = 0. */
2226 Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
2228 Jim_Obj *dupPtr;
2230 dupPtr = Jim_NewObj(interp);
2231 if (objPtr->bytes == NULL) {
2232 /* Object does not have a valid string representation. */
2233 dupPtr->bytes = NULL;
2235 else if (objPtr->length == 0) {
2236 /* Zero length, so don't even bother with the type-specific dup,
2237 * since all zero length objects look the same
2239 dupPtr->bytes = JimEmptyStringRep;
2240 dupPtr->length = 0;
2241 dupPtr->typePtr = NULL;
2242 return dupPtr;
2244 else {
2245 dupPtr->bytes = Jim_Alloc(objPtr->length + 1);
2246 dupPtr->length = objPtr->length;
2247 /* Copy the null byte too */
2248 memcpy(dupPtr->bytes, objPtr->bytes, objPtr->length + 1);
2251 /* By default, the new object has the same type as the old object */
2252 dupPtr->typePtr = objPtr->typePtr;
2253 if (objPtr->typePtr != NULL) {
2254 if (objPtr->typePtr->dupIntRepProc == NULL) {
2255 dupPtr->internalRep = objPtr->internalRep;
2257 else {
2258 /* The dup proc may set a different type, e.g. NULL */
2259 objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr);
2262 return dupPtr;
2265 /* Return the string representation for objPtr. If the object's
2266 * string representation is invalid, calls the updateStringProc method to create
2267 * a new one from the internal representation of the object.
2269 const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr)
2271 if (objPtr->bytes == NULL) {
2272 /* Invalid string repr. Generate it. */
2273 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2274 objPtr->typePtr->updateStringProc(objPtr);
2276 if (lenPtr)
2277 *lenPtr = objPtr->length;
2278 return objPtr->bytes;
2281 /* Just returns the length (in bytes) of the object's string rep */
2282 int Jim_Length(Jim_Obj *objPtr)
2284 if (objPtr->bytes == NULL) {
2285 /* Invalid string repr. Generate it. */
2286 Jim_GetString(objPtr, NULL);
2288 return objPtr->length;
2291 /* Just returns object's string rep */
2292 const char *Jim_String(Jim_Obj *objPtr)
2294 if (objPtr->bytes == NULL) {
2295 /* Invalid string repr. Generate it. */
2296 Jim_GetString(objPtr, NULL);
2298 return objPtr->bytes;
2301 static void JimSetStringBytes(Jim_Obj *objPtr, const char *str)
2303 objPtr->bytes = Jim_StrDup(str);
2304 objPtr->length = strlen(str);
2307 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2308 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2310 static const Jim_ObjType dictSubstObjType = {
2311 "dict-substitution",
2312 FreeDictSubstInternalRep,
2313 DupDictSubstInternalRep,
2314 NULL,
2315 JIM_TYPE_NONE,
2318 static void FreeInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2319 static void DupInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2321 static const Jim_ObjType interpolatedObjType = {
2322 "interpolated",
2323 FreeInterpolatedInternalRep,
2324 DupInterpolatedInternalRep,
2325 NULL,
2326 JIM_TYPE_NONE,
2329 static void FreeInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2331 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
2334 static void DupInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2336 /* Copy the interal rep */
2337 dupPtr->internalRep = srcPtr->internalRep;
2338 /* Need to increment the key ref count */
2339 Jim_IncrRefCount(dupPtr->internalRep.dictSubstValue.indexObjPtr);
2342 /* -----------------------------------------------------------------------------
2343 * String Object
2344 * ---------------------------------------------------------------------------*/
2345 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2346 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2348 static const Jim_ObjType stringObjType = {
2349 "string",
2350 NULL,
2351 DupStringInternalRep,
2352 NULL,
2353 JIM_TYPE_REFERENCES,
2356 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2358 JIM_NOTUSED(interp);
2360 /* This is a bit subtle: the only caller of this function
2361 * should be Jim_DuplicateObj(), that will copy the
2362 * string representaion. After the copy, the duplicated
2363 * object will not have more room in the buffer than
2364 * srcPtr->length bytes. So we just set it to length. */
2365 dupPtr->internalRep.strValue.maxLength = srcPtr->length;
2366 dupPtr->internalRep.strValue.charLength = srcPtr->internalRep.strValue.charLength;
2369 static int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
2371 if (objPtr->typePtr != &stringObjType) {
2372 /* Get a fresh string representation. */
2373 if (objPtr->bytes == NULL) {
2374 /* Invalid string repr. Generate it. */
2375 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2376 objPtr->typePtr->updateStringProc(objPtr);
2378 /* Free any other internal representation. */
2379 Jim_FreeIntRep(interp, objPtr);
2380 /* Set it as string, i.e. just set the maxLength field. */
2381 objPtr->typePtr = &stringObjType;
2382 objPtr->internalRep.strValue.maxLength = objPtr->length;
2383 /* Don't know the utf-8 length yet */
2384 objPtr->internalRep.strValue.charLength = -1;
2386 return JIM_OK;
2390 * Returns the length of the object string in chars, not bytes.
2392 * These may be different for a utf-8 string.
2394 int Jim_Utf8Length(Jim_Interp *interp, Jim_Obj *objPtr)
2396 #ifdef JIM_UTF8
2397 SetStringFromAny(interp, objPtr);
2399 if (objPtr->internalRep.strValue.charLength < 0) {
2400 objPtr->internalRep.strValue.charLength = utf8_strlen(objPtr->bytes, objPtr->length);
2402 return objPtr->internalRep.strValue.charLength;
2403 #else
2404 return Jim_Length(objPtr);
2405 #endif
2408 /* len is in bytes -- see also Jim_NewStringObjUtf8() */
2409 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
2411 Jim_Obj *objPtr = Jim_NewObj(interp);
2413 /* Need to find out how many bytes the string requires */
2414 if (len == -1)
2415 len = strlen(s);
2416 /* Alloc/Set the string rep. */
2417 if (len == 0) {
2418 objPtr->bytes = JimEmptyStringRep;
2420 else {
2421 objPtr->bytes = Jim_StrDupLen(s, len);
2423 objPtr->length = len;
2425 /* No typePtr field for the vanilla string object. */
2426 objPtr->typePtr = NULL;
2427 return objPtr;
2430 /* charlen is in characters -- see also Jim_NewStringObj() */
2431 Jim_Obj *Jim_NewStringObjUtf8(Jim_Interp *interp, const char *s, int charlen)
2433 #ifdef JIM_UTF8
2434 /* Need to find out how many bytes the string requires */
2435 int bytelen = utf8_index(s, charlen);
2437 Jim_Obj *objPtr = Jim_NewStringObj(interp, s, bytelen);
2439 /* Remember the utf8 length, so set the type */
2440 objPtr->typePtr = &stringObjType;
2441 objPtr->internalRep.strValue.maxLength = bytelen;
2442 objPtr->internalRep.strValue.charLength = charlen;
2444 return objPtr;
2445 #else
2446 return Jim_NewStringObj(interp, s, charlen);
2447 #endif
2450 /* This version does not try to duplicate the 's' pointer, but
2451 * use it directly. */
2452 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
2454 Jim_Obj *objPtr = Jim_NewObj(interp);
2456 objPtr->bytes = s;
2457 objPtr->length = (len == -1) ? strlen(s) : len;
2458 objPtr->typePtr = NULL;
2459 return objPtr;
2462 /* Low-level string append. Use it only against unshared objects
2463 * of type "string". */
2464 static void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
2466 int needlen;
2468 if (len == -1)
2469 len = strlen(str);
2470 needlen = objPtr->length + len;
2471 if (objPtr->internalRep.strValue.maxLength < needlen ||
2472 objPtr->internalRep.strValue.maxLength == 0) {
2473 needlen *= 2;
2474 /* Inefficient to malloc() for less than 8 bytes */
2475 if (needlen < 7) {
2476 needlen = 7;
2478 if (objPtr->bytes == JimEmptyStringRep) {
2479 objPtr->bytes = Jim_Alloc(needlen + 1);
2481 else {
2482 objPtr->bytes = Jim_Realloc(objPtr->bytes, needlen + 1);
2484 objPtr->internalRep.strValue.maxLength = needlen;
2486 memcpy(objPtr->bytes + objPtr->length, str, len);
2487 objPtr->bytes[objPtr->length + len] = '\0';
2489 if (objPtr->internalRep.strValue.charLength >= 0) {
2490 /* Update the utf-8 char length */
2491 objPtr->internalRep.strValue.charLength += utf8_strlen(objPtr->bytes + objPtr->length, len);
2493 objPtr->length += len;
2496 /* Higher level API to append strings to objects.
2497 * Object must not be unshared for each of these.
2499 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str, int len)
2501 JimPanic((Jim_IsShared(objPtr), "Jim_AppendString called with shared object"));
2502 SetStringFromAny(interp, objPtr);
2503 StringAppendString(objPtr, str, len);
2506 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *appendObjPtr)
2508 int len;
2509 const char *str = Jim_GetString(appendObjPtr, &len);
2510 Jim_AppendString(interp, objPtr, str, len);
2513 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2515 va_list ap;
2517 SetStringFromAny(interp, objPtr);
2518 va_start(ap, objPtr);
2519 while (1) {
2520 const char *s = va_arg(ap, const char *);
2522 if (s == NULL)
2523 break;
2524 Jim_AppendString(interp, objPtr, s, -1);
2526 va_end(ap);
2529 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr)
2531 if (aObjPtr == bObjPtr) {
2532 return 1;
2534 else {
2535 int Alen, Blen;
2536 const char *sA = Jim_GetString(aObjPtr, &Alen);
2537 const char *sB = Jim_GetString(bObjPtr, &Blen);
2539 return Alen == Blen && memcmp(sA, sB, Alen) == 0;
2544 * Note. Does not support embedded nulls in either the pattern or the object.
2546 int Jim_StringMatchObj(Jim_Interp *interp, Jim_Obj *patternObjPtr, Jim_Obj *objPtr, int nocase)
2548 return JimGlobMatch(Jim_String(patternObjPtr), Jim_String(objPtr), nocase);
2552 * Note: does not support embedded nulls for the nocase option.
2554 int Jim_StringCompareObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2556 int l1, l2;
2557 const char *s1 = Jim_GetString(firstObjPtr, &l1);
2558 const char *s2 = Jim_GetString(secondObjPtr, &l2);
2560 if (nocase) {
2561 /* Do a character compare for nocase */
2562 return JimStringCompareLen(s1, s2, -1, nocase);
2564 return JimStringCompare(s1, l1, s2, l2);
2568 * Like Jim_StringCompareObj() except compares to a maximum of the length of firstObjPtr.
2570 * Note: does not support embedded nulls
2572 int Jim_StringCompareLenObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2574 const char *s1 = Jim_String(firstObjPtr);
2575 const char *s2 = Jim_String(secondObjPtr);
2577 return JimStringCompareLen(s1, s2, Jim_Utf8Length(interp, firstObjPtr), nocase);
2580 /* Convert a range, as returned by Jim_GetRange(), into
2581 * an absolute index into an object of the specified length.
2582 * This function may return negative values, or values
2583 * greater than or equal to the length of the list if the index
2584 * is out of range. */
2585 static int JimRelToAbsIndex(int len, int idx)
2587 if (idx < 0)
2588 return len + idx;
2589 return idx;
2592 /* Convert a pair of indexes (*firstPtr, *lastPtr) as normalized by JimRelToAbsIndex(),
2593 * into a form suitable for implementation of commands like [string range] and [lrange].
2595 * The resulting range is guaranteed to address valid elements of
2596 * the structure.
2598 static void JimRelToAbsRange(int len, int *firstPtr, int *lastPtr, int *rangeLenPtr)
2600 int rangeLen;
2602 if (*firstPtr > *lastPtr) {
2603 rangeLen = 0;
2605 else {
2606 rangeLen = *lastPtr - *firstPtr + 1;
2607 if (rangeLen) {
2608 if (*firstPtr < 0) {
2609 rangeLen += *firstPtr;
2610 *firstPtr = 0;
2612 if (*lastPtr >= len) {
2613 rangeLen -= (*lastPtr - (len - 1));
2614 *lastPtr = len - 1;
2618 if (rangeLen < 0)
2619 rangeLen = 0;
2621 *rangeLenPtr = rangeLen;
2624 static int JimStringGetRange(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr,
2625 int len, int *first, int *last, int *range)
2627 if (Jim_GetIndex(interp, firstObjPtr, first) != JIM_OK) {
2628 return JIM_ERR;
2630 if (Jim_GetIndex(interp, lastObjPtr, last) != JIM_OK) {
2631 return JIM_ERR;
2633 *first = JimRelToAbsIndex(len, *first);
2634 *last = JimRelToAbsIndex(len, *last);
2635 JimRelToAbsRange(len, first, last, range);
2636 return JIM_OK;
2639 Jim_Obj *Jim_StringByteRangeObj(Jim_Interp *interp,
2640 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2642 int first, last;
2643 const char *str;
2644 int rangeLen;
2645 int bytelen;
2647 str = Jim_GetString(strObjPtr, &bytelen);
2649 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, bytelen, &first, &last, &rangeLen) != JIM_OK) {
2650 return NULL;
2653 if (first == 0 && rangeLen == bytelen) {
2654 return strObjPtr;
2656 return Jim_NewStringObj(interp, str + first, rangeLen);
2659 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2660 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2662 #ifdef JIM_UTF8
2663 int first, last;
2664 const char *str;
2665 int len, rangeLen;
2666 int bytelen;
2668 str = Jim_GetString(strObjPtr, &bytelen);
2669 len = Jim_Utf8Length(interp, strObjPtr);
2671 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2672 return NULL;
2675 if (first == 0 && rangeLen == len) {
2676 return strObjPtr;
2678 if (len == bytelen) {
2679 /* ASCII optimisation */
2680 return Jim_NewStringObj(interp, str + first, rangeLen);
2682 return Jim_NewStringObjUtf8(interp, str + utf8_index(str, first), rangeLen);
2683 #else
2684 return Jim_StringByteRangeObj(interp, strObjPtr, firstObjPtr, lastObjPtr);
2685 #endif
2688 Jim_Obj *JimStringReplaceObj(Jim_Interp *interp,
2689 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr, Jim_Obj *newStrObj)
2691 int first, last;
2692 const char *str;
2693 int len, rangeLen;
2694 Jim_Obj *objPtr;
2696 len = Jim_Utf8Length(interp, strObjPtr);
2698 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2699 return NULL;
2702 if (last < first) {
2703 return strObjPtr;
2706 str = Jim_String(strObjPtr);
2708 /* Before part */
2709 objPtr = Jim_NewStringObjUtf8(interp, str, first);
2711 /* Replacement */
2712 if (newStrObj) {
2713 Jim_AppendObj(interp, objPtr, newStrObj);
2716 /* After part */
2717 Jim_AppendString(interp, objPtr, str + utf8_index(str, last + 1), len - last - 1);
2719 return objPtr;
2723 * Note: does not support embedded nulls.
2725 static void JimStrCopyUpperLower(char *dest, const char *str, int uc)
2727 while (*str) {
2728 int c;
2729 str += utf8_tounicode(str, &c);
2730 dest += utf8_getchars(dest, uc ? utf8_upper(c) : utf8_lower(c));
2732 *dest = 0;
2736 * Note: does not support embedded nulls.
2738 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2740 char *buf;
2741 int len;
2742 const char *str;
2744 str = Jim_GetString(strObjPtr, &len);
2746 #ifdef JIM_UTF8
2747 /* Case mapping can change the utf-8 length of the string.
2748 * But at worst it will be by one extra byte per char
2750 len *= 2;
2751 #endif
2752 buf = Jim_Alloc(len + 1);
2753 JimStrCopyUpperLower(buf, str, 0);
2754 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2758 * Note: does not support embedded nulls.
2760 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2762 char *buf;
2763 const char *str;
2764 int len;
2766 str = Jim_GetString(strObjPtr, &len);
2768 #ifdef JIM_UTF8
2769 /* Case mapping can change the utf-8 length of the string.
2770 * But at worst it will be by one extra byte per char
2772 len *= 2;
2773 #endif
2774 buf = Jim_Alloc(len + 1);
2775 JimStrCopyUpperLower(buf, str, 1);
2776 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2780 * Note: does not support embedded nulls.
2782 static Jim_Obj *JimStringToTitle(Jim_Interp *interp, Jim_Obj *strObjPtr)
2784 char *buf, *p;
2785 int len;
2786 int c;
2787 const char *str;
2789 str = Jim_GetString(strObjPtr, &len);
2791 #ifdef JIM_UTF8
2792 /* Case mapping can change the utf-8 length of the string.
2793 * But at worst it will be by one extra byte per char
2795 len *= 2;
2796 #endif
2797 buf = p = Jim_Alloc(len + 1);
2799 str += utf8_tounicode(str, &c);
2800 p += utf8_getchars(p, utf8_title(c));
2802 JimStrCopyUpperLower(p, str, 0);
2804 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2807 /* Similar to memchr() except searches a UTF-8 string 'str' of byte length 'len'
2808 * for unicode character 'c'.
2809 * Returns the position if found or NULL if not
2811 static const char *utf8_memchr(const char *str, int len, int c)
2813 #ifdef JIM_UTF8
2814 while (len) {
2815 int sc;
2816 int n = utf8_tounicode(str, &sc);
2817 if (sc == c) {
2818 return str;
2820 str += n;
2821 len -= n;
2823 return NULL;
2824 #else
2825 return memchr(str, c, len);
2826 #endif
2830 * Searches for the first non-trim char in string (str, len)
2832 * If none is found, returns just past the last char.
2834 * Lengths are in bytes.
2836 static const char *JimFindTrimLeft(const char *str, int len, const char *trimchars, int trimlen)
2838 while (len) {
2839 int c;
2840 int n = utf8_tounicode(str, &c);
2842 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2843 /* Not a trim char, so stop */
2844 break;
2846 str += n;
2847 len -= n;
2849 return str;
2853 * Searches backwards for a non-trim char in string (str, len).
2855 * Returns a pointer to just after the non-trim char, or NULL if not found.
2857 * Lengths are in bytes.
2859 static const char *JimFindTrimRight(const char *str, int len, const char *trimchars, int trimlen)
2861 str += len;
2863 while (len) {
2864 int c;
2865 int n = utf8_prev_len(str, len);
2867 len -= n;
2868 str -= n;
2870 n = utf8_tounicode(str, &c);
2872 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2873 return str + n;
2877 return NULL;
2880 static const char default_trim_chars[] = " \t\n\r";
2881 /* sizeof() here includes the null byte */
2882 static int default_trim_chars_len = sizeof(default_trim_chars);
2884 static Jim_Obj *JimStringTrimLeft(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2886 int len;
2887 const char *str = Jim_GetString(strObjPtr, &len);
2888 const char *trimchars = default_trim_chars;
2889 int trimcharslen = default_trim_chars_len;
2890 const char *newstr;
2892 if (trimcharsObjPtr) {
2893 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2896 newstr = JimFindTrimLeft(str, len, trimchars, trimcharslen);
2897 if (newstr == str) {
2898 return strObjPtr;
2901 return Jim_NewStringObj(interp, newstr, len - (newstr - str));
2904 static Jim_Obj *JimStringTrimRight(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2906 int len;
2907 const char *trimchars = default_trim_chars;
2908 int trimcharslen = default_trim_chars_len;
2909 const char *nontrim;
2911 if (trimcharsObjPtr) {
2912 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2915 SetStringFromAny(interp, strObjPtr);
2917 len = Jim_Length(strObjPtr);
2918 nontrim = JimFindTrimRight(strObjPtr->bytes, len, trimchars, trimcharslen);
2920 if (nontrim == NULL) {
2921 /* All trim, so return a zero-length string */
2922 return Jim_NewEmptyStringObj(interp);
2924 if (nontrim == strObjPtr->bytes + len) {
2925 /* All non-trim, so return the original object */
2926 return strObjPtr;
2929 if (Jim_IsShared(strObjPtr)) {
2930 strObjPtr = Jim_NewStringObj(interp, strObjPtr->bytes, (nontrim - strObjPtr->bytes));
2932 else {
2933 /* Can modify this string in place */
2934 strObjPtr->bytes[nontrim - strObjPtr->bytes] = 0;
2935 strObjPtr->length = (nontrim - strObjPtr->bytes);
2938 return strObjPtr;
2941 static Jim_Obj *JimStringTrim(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2943 /* First trim left. */
2944 Jim_Obj *objPtr = JimStringTrimLeft(interp, strObjPtr, trimcharsObjPtr);
2946 /* Now trim right */
2947 strObjPtr = JimStringTrimRight(interp, objPtr, trimcharsObjPtr);
2949 /* Note: refCount check is needed since objPtr may be emptyObj */
2950 if (objPtr != strObjPtr && objPtr->refCount == 0) {
2951 /* We don't want this object to be leaked */
2952 Jim_FreeNewObj(interp, objPtr);
2955 return strObjPtr;
2958 /* Some platforms don't have isascii - need a non-macro version */
2959 #ifdef HAVE_ISASCII
2960 #define jim_isascii isascii
2961 #else
2962 static int jim_isascii(int c)
2964 return !(c & ~0x7f);
2966 #endif
2968 static int JimStringIs(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *strClass, int strict)
2970 static const char * const strclassnames[] = {
2971 "integer", "alpha", "alnum", "ascii", "digit",
2972 "double", "lower", "upper", "space", "xdigit",
2973 "control", "print", "graph", "punct", "boolean",
2974 NULL
2976 enum {
2977 STR_IS_INTEGER, STR_IS_ALPHA, STR_IS_ALNUM, STR_IS_ASCII, STR_IS_DIGIT,
2978 STR_IS_DOUBLE, STR_IS_LOWER, STR_IS_UPPER, STR_IS_SPACE, STR_IS_XDIGIT,
2979 STR_IS_CONTROL, STR_IS_PRINT, STR_IS_GRAPH, STR_IS_PUNCT, STR_IS_BOOLEAN,
2981 int strclass;
2982 int len;
2983 int i;
2984 const char *str;
2985 int (*isclassfunc)(int c) = NULL;
2987 if (Jim_GetEnum(interp, strClass, strclassnames, &strclass, "class", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
2988 return JIM_ERR;
2991 str = Jim_GetString(strObjPtr, &len);
2992 if (len == 0) {
2993 Jim_SetResultBool(interp, !strict);
2994 return JIM_OK;
2997 switch (strclass) {
2998 case STR_IS_INTEGER:
3000 jim_wide w;
3001 Jim_SetResultBool(interp, JimGetWideNoErr(interp, strObjPtr, &w) == JIM_OK);
3002 return JIM_OK;
3005 case STR_IS_DOUBLE:
3007 double d;
3008 Jim_SetResultBool(interp, Jim_GetDouble(interp, strObjPtr, &d) == JIM_OK && errno != ERANGE);
3009 return JIM_OK;
3012 case STR_IS_BOOLEAN:
3014 int b;
3015 Jim_SetResultBool(interp, Jim_GetBoolean(interp, strObjPtr, &b) == JIM_OK);
3016 return JIM_OK;
3019 case STR_IS_ALPHA: isclassfunc = isalpha; break;
3020 case STR_IS_ALNUM: isclassfunc = isalnum; break;
3021 case STR_IS_ASCII: isclassfunc = jim_isascii; break;
3022 case STR_IS_DIGIT: isclassfunc = isdigit; break;
3023 case STR_IS_LOWER: isclassfunc = islower; break;
3024 case STR_IS_UPPER: isclassfunc = isupper; break;
3025 case STR_IS_SPACE: isclassfunc = isspace; break;
3026 case STR_IS_XDIGIT: isclassfunc = isxdigit; break;
3027 case STR_IS_CONTROL: isclassfunc = iscntrl; break;
3028 case STR_IS_PRINT: isclassfunc = isprint; break;
3029 case STR_IS_GRAPH: isclassfunc = isgraph; break;
3030 case STR_IS_PUNCT: isclassfunc = ispunct; break;
3031 default:
3032 return JIM_ERR;
3035 for (i = 0; i < len; i++) {
3036 if (!isclassfunc(UCHAR(str[i]))) {
3037 Jim_SetResultBool(interp, 0);
3038 return JIM_OK;
3041 Jim_SetResultBool(interp, 1);
3042 return JIM_OK;
3045 /* -----------------------------------------------------------------------------
3046 * Compared String Object
3047 * ---------------------------------------------------------------------------*/
3049 /* This is strange object that allows comparison of a C literal string
3050 * with a Jim object in a very short time if the same comparison is done
3051 * multiple times. For example every time the [if] command is executed,
3052 * Jim has to check if a given argument is "else".
3053 * If the code has no errors, this comparison is true most of the time,
3054 * so we can cache the pointer of the string of the last matching
3055 * comparison inside the object. Because most C compilers perform literal sharing,
3056 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
3057 * this works pretty well even if comparisons are at different places
3058 * inside the C code. */
3060 static const Jim_ObjType comparedStringObjType = {
3061 "compared-string",
3062 NULL,
3063 NULL,
3064 NULL,
3065 JIM_TYPE_REFERENCES,
3068 /* The only way this object is exposed to the API is via the following
3069 * function. Returns true if the string and the object string repr.
3070 * are the same, otherwise zero is returned.
3072 * Note: this isn't binary safe, but it hardly needs to be.*/
3073 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr, const char *str)
3075 if (objPtr->typePtr == &comparedStringObjType && objPtr->internalRep.ptr == str) {
3076 return 1;
3078 else {
3079 if (strcmp(str, Jim_String(objPtr)) != 0)
3080 return 0;
3082 if (objPtr->typePtr != &comparedStringObjType) {
3083 Jim_FreeIntRep(interp, objPtr);
3084 objPtr->typePtr = &comparedStringObjType;
3086 objPtr->internalRep.ptr = (char *)str; /*ATTENTION: const cast */
3087 return 1;
3091 static int qsortCompareStringPointers(const void *a, const void *b)
3093 char *const *sa = (char *const *)a;
3094 char *const *sb = (char *const *)b;
3096 return strcmp(*sa, *sb);
3100 /* -----------------------------------------------------------------------------
3101 * Source Object
3103 * This object is just a string from the language point of view, but
3104 * the internal representation contains the filename and line number
3105 * where this token was read. This information is used by
3106 * Jim_EvalObj() if the object passed happens to be of type "source".
3108 * This allows propagation of the information about line numbers and file
3109 * names and gives error messages with absolute line numbers.
3111 * Note that this object uses the internal representation of the Jim_Object,
3112 * so there is almost no memory overhead. (One Jim_Obj for each filename).
3114 * Also the object will be converted to something else if the given
3115 * token it represents in the source file is not something to be
3116 * evaluated (not a script), and will be specialized in some other way,
3117 * so the time overhead is also almost zero.
3118 * ---------------------------------------------------------------------------*/
3120 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3121 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3123 static const Jim_ObjType sourceObjType = {
3124 "source",
3125 FreeSourceInternalRep,
3126 DupSourceInternalRep,
3127 NULL,
3128 JIM_TYPE_REFERENCES,
3131 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3133 Jim_DecrRefCount(interp, objPtr->internalRep.sourceValue.fileNameObj);
3136 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3138 dupPtr->internalRep.sourceValue = srcPtr->internalRep.sourceValue;
3139 Jim_IncrRefCount(dupPtr->internalRep.sourceValue.fileNameObj);
3142 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
3143 Jim_Obj *fileNameObj, int lineNumber)
3145 JimPanic((Jim_IsShared(objPtr), "JimSetSourceInfo called with shared object"));
3146 JimPanic((objPtr->typePtr != NULL, "JimSetSourceInfo called with typed object"));
3147 Jim_IncrRefCount(fileNameObj);
3148 objPtr->internalRep.sourceValue.fileNameObj = fileNameObj;
3149 objPtr->internalRep.sourceValue.lineNumber = lineNumber;
3150 objPtr->typePtr = &sourceObjType;
3153 /* -----------------------------------------------------------------------------
3154 * ScriptLine Object
3156 * This object is used only in the Script internal represenation.
3157 * For each line of the script, it holds the number of tokens on the line
3158 * and the source line number.
3160 static const Jim_ObjType scriptLineObjType = {
3161 "scriptline",
3162 NULL,
3163 NULL,
3164 NULL,
3165 JIM_NONE,
3168 static Jim_Obj *JimNewScriptLineObj(Jim_Interp *interp, int argc, int line)
3170 Jim_Obj *objPtr;
3172 #ifdef DEBUG_SHOW_SCRIPT
3173 char buf[100];
3174 snprintf(buf, sizeof(buf), "line=%d, argc=%d", line, argc);
3175 objPtr = Jim_NewStringObj(interp, buf, -1);
3176 #else
3177 objPtr = Jim_NewEmptyStringObj(interp);
3178 #endif
3179 objPtr->typePtr = &scriptLineObjType;
3180 objPtr->internalRep.scriptLineValue.argc = argc;
3181 objPtr->internalRep.scriptLineValue.line = line;
3183 return objPtr;
3186 /* -----------------------------------------------------------------------------
3187 * Script Object
3189 * This object holds the parsed internal representation of a script.
3190 * This representation is help within an allocated ScriptObj (see below)
3192 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3193 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3195 static const Jim_ObjType scriptObjType = {
3196 "script",
3197 FreeScriptInternalRep,
3198 DupScriptInternalRep,
3199 NULL,
3200 JIM_TYPE_REFERENCES,
3203 /* Each token of a script is represented by a ScriptToken.
3204 * The ScriptToken contains a type and a Jim_Obj. The Jim_Obj
3205 * can be specialized by commands operating on it.
3207 typedef struct ScriptToken
3209 Jim_Obj *objPtr;
3210 int type;
3211 } ScriptToken;
3213 /* This is the script object internal representation. An array of
3214 * ScriptToken structures, including a pre-computed representation of the
3215 * command length and arguments.
3217 * For example the script:
3219 * puts hello
3220 * set $i $x$y [foo]BAR
3222 * will produce a ScriptObj with the following ScriptToken's:
3224 * LIN 2
3225 * ESC puts
3226 * ESC hello
3227 * LIN 4
3228 * ESC set
3229 * VAR i
3230 * WRD 2
3231 * VAR x
3232 * VAR y
3233 * WRD 2
3234 * CMD foo
3235 * ESC BAR
3237 * "puts hello" has two args (LIN 2), composed of single tokens.
3238 * (Note that the WRD token is omitted for the common case of a single token.)
3240 * "set $i $x$y [foo]BAR" has four (LIN 4) args, the first word
3241 * has 1 token (ESC SET), and the last has two tokens (WRD 2 CMD foo ESC BAR)
3243 * The precomputation of the command structure makes Jim_Eval() faster,
3244 * and simpler because there aren't dynamic lengths / allocations.
3246 * -- {expand}/{*} handling --
3248 * Expand is handled in a special way.
3250 * If a "word" begins with {*}, the word token count is -ve.
3252 * For example the command:
3254 * list {*}{a b}
3256 * Will produce the following cmdstruct array:
3258 * LIN 2
3259 * ESC list
3260 * WRD -1
3261 * STR a b
3263 * Note that the 'LIN' token also contains the source information for the
3264 * first word of the line for error reporting purposes
3266 * -- the substFlags field of the structure --
3268 * The scriptObj structure is used to represent both "script" objects
3269 * and "subst" objects. In the second case, there are no LIN and WRD
3270 * tokens. Instead SEP and EOL tokens are added as-is.
3271 * In addition, the field 'substFlags' is used to represent the flags used to turn
3272 * the string into the internal representation.
3273 * If these flags do not match what the application requires,
3274 * the scriptObj is created again. For example the script:
3276 * subst -nocommands $string
3277 * subst -novariables $string
3279 * Will (re)create the internal representation of the $string object
3280 * two times.
3282 typedef struct ScriptObj
3284 ScriptToken *token; /* Tokens array. */
3285 Jim_Obj *fileNameObj; /* Filename */
3286 int len; /* Length of token[] */
3287 int substFlags; /* flags used for the compilation of "subst" objects */
3288 int inUse; /* Used to share a ScriptObj. Currently
3289 only used by Jim_EvalObj() as protection against
3290 shimmering of the currently evaluated object. */
3291 int firstline; /* Line number of the first line */
3292 int linenr; /* Error line number, if any */
3293 int missing; /* Missing char if script failed to parse, (or space or backslash if OK) */
3294 } ScriptObj;
3296 static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3297 static int JimParseCheckMissing(Jim_Interp *interp, int ch);
3298 static ScriptObj *JimGetScript(Jim_Interp *interp, Jim_Obj *objPtr);
3300 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3302 int i;
3303 struct ScriptObj *script = (void *)objPtr->internalRep.ptr;
3305 if (--script->inUse != 0)
3306 return;
3307 for (i = 0; i < script->len; i++) {
3308 Jim_DecrRefCount(interp, script->token[i].objPtr);
3310 Jim_Free(script->token);
3311 Jim_DecrRefCount(interp, script->fileNameObj);
3312 Jim_Free(script);
3315 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3317 JIM_NOTUSED(interp);
3318 JIM_NOTUSED(srcPtr);
3320 /* Just return a simple string. We don't try to preserve the source info
3321 * since in practice scripts are never duplicated
3323 dupPtr->typePtr = NULL;
3326 /* A simple parse token.
3327 * As the script is parsed, the created tokens point into the script string rep.
3329 typedef struct
3331 const char *token; /* Pointer to the start of the token */
3332 int len; /* Length of this token */
3333 int type; /* Token type */
3334 int line; /* Line number */
3335 } ParseToken;
3337 /* A list of parsed tokens representing a script.
3338 * Tokens are added to this list as the script is parsed.
3339 * It grows as needed.
3341 typedef struct
3343 /* Start with a statically allocated list of tokens which will be expanded with realloc if needed */
3344 ParseToken *list; /* Array of tokens */
3345 int size; /* Current size of the list */
3346 int count; /* Number of entries used */
3347 ParseToken static_list[20]; /* Small initial token space to avoid allocation */
3348 } ParseTokenList;
3350 static void ScriptTokenListInit(ParseTokenList *tokenlist)
3352 tokenlist->list = tokenlist->static_list;
3353 tokenlist->size = sizeof(tokenlist->static_list) / sizeof(ParseToken);
3354 tokenlist->count = 0;
3357 static void ScriptTokenListFree(ParseTokenList *tokenlist)
3359 if (tokenlist->list != tokenlist->static_list) {
3360 Jim_Free(tokenlist->list);
3365 * Adds the new token to the tokenlist.
3366 * The token has the given length, type and line number.
3367 * The token list is resized as necessary.
3369 static void ScriptAddToken(ParseTokenList *tokenlist, const char *token, int len, int type,
3370 int line)
3372 ParseToken *t;
3374 if (tokenlist->count == tokenlist->size) {
3375 /* Resize the list */
3376 tokenlist->size *= 2;
3377 if (tokenlist->list != tokenlist->static_list) {
3378 tokenlist->list =
3379 Jim_Realloc(tokenlist->list, tokenlist->size * sizeof(*tokenlist->list));
3381 else {
3382 /* The list needs to become allocated */
3383 tokenlist->list = Jim_Alloc(tokenlist->size * sizeof(*tokenlist->list));
3384 memcpy(tokenlist->list, tokenlist->static_list,
3385 tokenlist->count * sizeof(*tokenlist->list));
3388 t = &tokenlist->list[tokenlist->count++];
3389 t->token = token;
3390 t->len = len;
3391 t->type = type;
3392 t->line = line;
3395 /* Counts the number of adjoining non-separator tokens.
3397 * Returns -ve if the first token is the expansion
3398 * operator (in which case the count doesn't include
3399 * that token).
3401 static int JimCountWordTokens(struct ScriptObj *script, ParseToken *t)
3403 int expand = 1;
3404 int count = 0;
3406 /* Is the first word {*} or {expand}? */
3407 if (t->type == JIM_TT_STR && !TOKEN_IS_SEP(t[1].type)) {
3408 if ((t->len == 1 && *t->token == '*') || (t->len == 6 && strncmp(t->token, "expand", 6) == 0)) {
3409 /* Create an expand token */
3410 expand = -1;
3411 t++;
3413 else {
3414 if (script->missing == ' ') {
3415 /* This is a "extra characters after close-brace" error. Report the first error */
3416 script->missing = '}';
3417 script->linenr = t[1].line;
3422 /* Now count non-separator words */
3423 while (!TOKEN_IS_SEP(t->type)) {
3424 t++;
3425 count++;
3428 return count * expand;
3432 * Create a script/subst object from the given token.
3434 static Jim_Obj *JimMakeScriptObj(Jim_Interp *interp, const ParseToken *t)
3436 Jim_Obj *objPtr;
3438 if (t->type == JIM_TT_ESC && memchr(t->token, '\\', t->len) != NULL) {
3439 /* Convert backlash escapes. The result will never be longer than the original */
3440 int len = t->len;
3441 char *str = Jim_Alloc(len + 1);
3442 len = JimEscape(str, t->token, len);
3443 objPtr = Jim_NewStringObjNoAlloc(interp, str, len);
3445 else {
3446 /* XXX: For strict Tcl compatibility, JIM_TT_STR should replace <backslash><newline><whitespace>
3447 * with a single space.
3449 objPtr = Jim_NewStringObj(interp, t->token, t->len);
3451 return objPtr;
3455 * Takes a tokenlist and creates the allocated list of script tokens
3456 * in script->token, of length script->len.
3458 * Unnecessary tokens are discarded, and LINE and WORD tokens are inserted
3459 * as required.
3461 * Also sets script->line to the line number of the first token
3463 static void ScriptObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3464 ParseTokenList *tokenlist)
3466 int i;
3467 struct ScriptToken *token;
3468 /* Number of tokens so far for the current command */
3469 int lineargs = 0;
3470 /* This is the first token for the current command */
3471 ScriptToken *linefirst;
3472 int count;
3473 int linenr;
3475 #ifdef DEBUG_SHOW_SCRIPT_TOKENS
3476 printf("==== Tokens ====\n");
3477 for (i = 0; i < tokenlist->count; i++) {
3478 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist->list[i].line, jim_tt_name(tokenlist->list[i].type),
3479 tokenlist->list[i].len, tokenlist->list[i].token);
3481 #endif
3483 /* May need up to one extra script token for each EOL in the worst case */
3484 count = tokenlist->count;
3485 for (i = 0; i < tokenlist->count; i++) {
3486 if (tokenlist->list[i].type == JIM_TT_EOL) {
3487 count++;
3490 linenr = script->firstline = tokenlist->list[0].line;
3492 token = script->token = Jim_Alloc(sizeof(ScriptToken) * count);
3494 /* This is the first token for the current command */
3495 linefirst = token++;
3497 for (i = 0; i < tokenlist->count; ) {
3498 /* Look ahead to find out how many tokens make up the next word */
3499 int wordtokens;
3501 /* Skip any leading separators */
3502 while (tokenlist->list[i].type == JIM_TT_SEP) {
3503 i++;
3506 wordtokens = JimCountWordTokens(script, tokenlist->list + i);
3508 if (wordtokens == 0) {
3509 /* None, so at end of line */
3510 if (lineargs) {
3511 linefirst->type = JIM_TT_LINE;
3512 linefirst->objPtr = JimNewScriptLineObj(interp, lineargs, linenr);
3513 Jim_IncrRefCount(linefirst->objPtr);
3515 /* Reset for new line */
3516 lineargs = 0;
3517 linefirst = token++;
3519 i++;
3520 continue;
3522 else if (wordtokens != 1) {
3523 /* More than 1, or {*}, so insert a WORD token */
3524 token->type = JIM_TT_WORD;
3525 token->objPtr = Jim_NewIntObj(interp, wordtokens);
3526 Jim_IncrRefCount(token->objPtr);
3527 token++;
3528 if (wordtokens < 0) {
3529 /* Skip the expand token */
3530 i++;
3531 wordtokens = -wordtokens - 1;
3532 lineargs--;
3536 if (lineargs == 0) {
3537 /* First real token on the line, so record the line number */
3538 linenr = tokenlist->list[i].line;
3540 lineargs++;
3542 /* Add each non-separator word token to the line */
3543 while (wordtokens--) {
3544 const ParseToken *t = &tokenlist->list[i++];
3546 token->type = t->type;
3547 token->objPtr = JimMakeScriptObj(interp, t);
3548 Jim_IncrRefCount(token->objPtr);
3550 /* Every object is initially a string of type 'source', but the
3551 * internal type may be specialized during execution of the
3552 * script. */
3553 JimSetSourceInfo(interp, token->objPtr, script->fileNameObj, t->line);
3554 token++;
3558 if (lineargs == 0) {
3559 token--;
3562 script->len = token - script->token;
3564 JimPanic((script->len >= count, "allocated script array is too short"));
3566 #ifdef DEBUG_SHOW_SCRIPT
3567 printf("==== Script (%s) ====\n", Jim_String(script->fileNameObj));
3568 for (i = 0; i < script->len; i++) {
3569 const ScriptToken *t = &script->token[i];
3570 printf("[%2d] %s %s\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
3572 #endif
3576 /* Parses the given string object to determine if it represents a complete script.
3578 * This is useful for interactive shells implementation, for [info complete].
3580 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
3581 * '{' on scripts incomplete missing one or more '}' to be balanced.
3582 * '[' on scripts incomplete missing one or more ']' to be balanced.
3583 * '"' on scripts incomplete missing a '"' char.
3584 * '\\' on scripts with a trailing backslash.
3586 * If the script is complete, 1 is returned, otherwise 0.
3588 * If the script has extra characters after a close brace, this still returns 1,
3589 * but sets *stateCharPtr to '}'
3590 * Evaluating the script will give the error "extra characters after close-brace".
3592 int Jim_ScriptIsComplete(Jim_Interp *interp, Jim_Obj *scriptObj, char *stateCharPtr)
3594 ScriptObj *script = JimGetScript(interp, scriptObj);
3595 if (stateCharPtr) {
3596 *stateCharPtr = script->missing;
3598 return script->missing == ' ' || script->missing == '}';
3602 * Sets an appropriate error message for a missing script/expression terminator.
3604 * Returns JIM_ERR if 'ch' represents an unmatched/missing character.
3606 * Note that a trailing backslash is not considered to be an error.
3608 static int JimParseCheckMissing(Jim_Interp *interp, int ch)
3610 const char *msg;
3612 switch (ch) {
3613 case '\\':
3614 case ' ':
3615 return JIM_OK;
3617 case '[':
3618 msg = "unmatched \"[\"";
3619 break;
3620 case '{':
3621 msg = "missing close-brace";
3622 break;
3623 case '}':
3624 msg = "extra characters after close-brace";
3625 break;
3626 case '"':
3627 default:
3628 msg = "missing quote";
3629 break;
3632 Jim_SetResultString(interp, msg, -1);
3633 return JIM_ERR;
3637 * Similar to ScriptObjAddTokens(), but for subst objects.
3639 static void SubstObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3640 ParseTokenList *tokenlist)
3642 int i;
3643 struct ScriptToken *token;
3645 token = script->token = Jim_Alloc(sizeof(ScriptToken) * tokenlist->count);
3647 for (i = 0; i < tokenlist->count; i++) {
3648 const ParseToken *t = &tokenlist->list[i];
3650 /* Create a token for 't' */
3651 token->type = t->type;
3652 token->objPtr = JimMakeScriptObj(interp, t);
3653 Jim_IncrRefCount(token->objPtr);
3654 token++;
3657 script->len = i;
3660 /* This method takes the string representation of an object
3661 * as a Tcl script, and generates the pre-parsed internal representation
3662 * of the script.
3664 * On parse error, sets an error message and returns JIM_ERR
3665 * (Note: the object is still converted to a script, even if an error occurs)
3667 static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3669 int scriptTextLen;
3670 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
3671 struct JimParserCtx parser;
3672 struct ScriptObj *script;
3673 ParseTokenList tokenlist;
3674 int line = 1;
3676 /* Try to get information about filename / line number */
3677 if (objPtr->typePtr == &sourceObjType) {
3678 line = objPtr->internalRep.sourceValue.lineNumber;
3681 /* Initially parse the script into tokens (in tokenlist) */
3682 ScriptTokenListInit(&tokenlist);
3684 JimParserInit(&parser, scriptText, scriptTextLen, line);
3685 while (!parser.eof) {
3686 JimParseScript(&parser);
3687 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
3688 parser.tline);
3691 /* Add a final EOF token */
3692 ScriptAddToken(&tokenlist, scriptText + scriptTextLen, 0, JIM_TT_EOF, 0);
3694 /* Create the "real" script tokens from the parsed tokens */
3695 script = Jim_Alloc(sizeof(*script));
3696 memset(script, 0, sizeof(*script));
3697 script->inUse = 1;
3698 if (objPtr->typePtr == &sourceObjType) {
3699 script->fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
3701 else {
3702 script->fileNameObj = interp->emptyObj;
3704 Jim_IncrRefCount(script->fileNameObj);
3705 script->missing = parser.missing.ch;
3706 script->linenr = parser.missing.line;
3708 ScriptObjAddTokens(interp, script, &tokenlist);
3710 /* No longer need the token list */
3711 ScriptTokenListFree(&tokenlist);
3713 /* Free the old internal rep and set the new one. */
3714 Jim_FreeIntRep(interp, objPtr);
3715 Jim_SetIntRepPtr(objPtr, script);
3716 objPtr->typePtr = &scriptObjType;
3719 static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script);
3722 * Returns the parsed script.
3723 * Note that if there is any possibility that the script is not valid,
3724 * call JimScriptValid() to check
3726 static ScriptObj *JimGetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3728 if (objPtr == interp->emptyObj) {
3729 /* Avoid converting emptyObj to a script. use nullScriptObj instead. */
3730 objPtr = interp->nullScriptObj;
3733 if (objPtr->typePtr != &scriptObjType || ((struct ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags) {
3734 JimSetScriptFromAny(interp, objPtr);
3737 return (ScriptObj *)Jim_GetIntRepPtr(objPtr);
3741 * Returns 1 if the script is valid (parsed ok), otherwise returns 0
3742 * and leaves an error message in the interp result.
3745 static int JimScriptValid(Jim_Interp *interp, ScriptObj *script)
3747 if (JimParseCheckMissing(interp, script->missing) == JIM_ERR) {
3748 JimAddErrorToStack(interp, script);
3749 return 0;
3751 return 1;
3755 /* -----------------------------------------------------------------------------
3756 * Commands
3757 * ---------------------------------------------------------------------------*/
3758 static void JimIncrCmdRefCount(Jim_Cmd *cmdPtr)
3760 cmdPtr->inUse++;
3763 static void JimDecrCmdRefCount(Jim_Interp *interp, Jim_Cmd *cmdPtr)
3765 if (--cmdPtr->inUse == 0) {
3766 if (cmdPtr->isproc) {
3767 Jim_DecrRefCount(interp, cmdPtr->u.proc.argListObjPtr);
3768 Jim_DecrRefCount(interp, cmdPtr->u.proc.bodyObjPtr);
3769 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
3770 if (cmdPtr->u.proc.staticVars) {
3771 Jim_FreeHashTable(cmdPtr->u.proc.staticVars);
3772 Jim_Free(cmdPtr->u.proc.staticVars);
3775 else {
3776 /* native (C) */
3777 if (cmdPtr->u.native.delProc) {
3778 cmdPtr->u.native.delProc(interp, cmdPtr->u.native.privData);
3781 if (cmdPtr->prevCmd) {
3782 /* Delete any pushed command too */
3783 JimDecrCmdRefCount(interp, cmdPtr->prevCmd);
3785 Jim_Free(cmdPtr);
3789 /* Variables HashTable Type.
3791 * Keys are dynamically allocated strings, Values are Jim_Var structures.
3793 static void JimVariablesHTValDestructor(void *interp, void *val)
3795 Jim_DecrRefCount(interp, ((Jim_Var *)val)->objPtr);
3796 Jim_Free(val);
3799 static const Jim_HashTableType JimVariablesHashTableType = {
3800 JimStringCopyHTHashFunction, /* hash function */
3801 JimStringCopyHTDup, /* key dup */
3802 NULL, /* val dup */
3803 JimStringCopyHTKeyCompare, /* key compare */
3804 JimStringCopyHTKeyDestructor, /* key destructor */
3805 JimVariablesHTValDestructor /* val destructor */
3808 /* Commands HashTable Type.
3810 * Keys are dynamic allocated strings, Values are Jim_Cmd structures.
3812 static void JimCommandsHT_ValDestructor(void *interp, void *val)
3814 JimDecrCmdRefCount(interp, val);
3817 static const Jim_HashTableType JimCommandsHashTableType = {
3818 JimStringCopyHTHashFunction, /* hash function */
3819 JimStringCopyHTDup, /* key dup */
3820 NULL, /* val dup */
3821 JimStringCopyHTKeyCompare, /* key compare */
3822 JimStringCopyHTKeyDestructor, /* key destructor */
3823 JimCommandsHT_ValDestructor /* val destructor */
3826 /* ------------------------- Commands related functions --------------------- */
3828 #ifdef jim_ext_namespace
3830 * Returns the "unscoped" version of the given namespace.
3831 * That is, the fully qualified name without the leading ::
3832 * The returned value is either nsObj, or an object with a zero ref count.
3834 static Jim_Obj *JimQualifyNameObj(Jim_Interp *interp, Jim_Obj *nsObj)
3836 const char *name = Jim_String(nsObj);
3837 if (name[0] == ':' && name[1] == ':') {
3838 /* This command is being defined in the global namespace */
3839 while (*++name == ':') {
3841 nsObj = Jim_NewStringObj(interp, name, -1);
3843 else if (Jim_Length(interp->framePtr->nsObj)) {
3844 /* This command is being defined in a non-global namespace */
3845 nsObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3846 Jim_AppendStrings(interp, nsObj, "::", name, NULL);
3848 return nsObj;
3852 * If nameObjPtr starts with "::", returns it.
3853 * Otherwise returns a new object with nameObjPtr prefixed with "::".
3854 * In this case, decrements the ref count of nameObjPtr.
3856 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3858 Jim_Obj *resultObj;
3860 const char *name = Jim_String(nameObjPtr);
3861 if (name[0] == ':' && name[1] == ':') {
3862 return nameObjPtr;
3864 Jim_IncrRefCount(nameObjPtr);
3865 resultObj = Jim_NewStringObj(interp, "::", -1);
3866 Jim_AppendObj(interp, resultObj, nameObjPtr);
3867 Jim_DecrRefCount(interp, nameObjPtr);
3869 return resultObj;
3873 * An efficient version of JimQualifyNameObj() where the name is
3874 * available (and needed) as a 'const char *'.
3875 * Avoids creating an object if not necessary.
3876 * The object stored in *objPtrPtr should be disposed of with JimFreeQualifiedName() after use.
3878 static const char *JimQualifyName(Jim_Interp *interp, const char *name, Jim_Obj **objPtrPtr)
3880 Jim_Obj *objPtr = interp->emptyObj;
3882 if (name[0] == ':' && name[1] == ':') {
3883 /* This command is being defined in the global namespace */
3884 while (*++name == ':') {
3887 else if (Jim_Length(interp->framePtr->nsObj)) {
3888 /* This command is being defined in a non-global namespace */
3889 objPtr = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3890 Jim_AppendStrings(interp, objPtr, "::", name, NULL);
3891 name = Jim_String(objPtr);
3893 Jim_IncrRefCount(objPtr);
3894 *objPtrPtr = objPtr;
3895 return name;
3898 #define JimFreeQualifiedName(INTERP, OBJ) Jim_DecrRefCount((INTERP), (OBJ))
3900 #else
3901 /* We can be more efficient in the no-namespace case */
3902 #define JimQualifyName(INTERP, NAME, DUMMY) (((NAME)[0] == ':' && (NAME)[1] == ':') ? (NAME) + 2 : (NAME))
3903 #define JimFreeQualifiedName(INTERP, DUMMY) (void)(DUMMY)
3905 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3907 return nameObjPtr;
3909 #endif
3911 static int JimCreateCommand(Jim_Interp *interp, const char *name, Jim_Cmd *cmd)
3913 /* It may already exist, so we try to delete the old one.
3914 * Note that reference count means that it won't be deleted yet if
3915 * it exists in the call stack.
3917 * BUT, if 'local' is in force, instead of deleting the existing
3918 * proc, we stash a reference to the old proc here.
3920 Jim_HashEntry *he = Jim_FindHashEntry(&interp->commands, name);
3921 if (he) {
3922 /* There was an old cmd with the same name,
3923 * so this requires a 'proc epoch' update. */
3925 /* If a procedure with the same name didn't exist there is no need
3926 * to increment the 'proc epoch' because creation of a new procedure
3927 * can never affect existing cached commands. We don't do
3928 * negative caching. */
3929 Jim_InterpIncrProcEpoch(interp);
3932 if (he && interp->local) {
3933 /* Push this command over the top of the previous one */
3934 cmd->prevCmd = Jim_GetHashEntryVal(he);
3935 Jim_SetHashVal(&interp->commands, he, cmd);
3937 else {
3938 if (he) {
3939 /* Replace the existing command */
3940 Jim_DeleteHashEntry(&interp->commands, name);
3943 Jim_AddHashEntry(&interp->commands, name, cmd);
3945 return JIM_OK;
3949 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdNameStr,
3950 Jim_CmdProc *cmdProc, void *privData, Jim_DelCmdProc *delProc)
3952 Jim_Cmd *cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3954 /* Store the new details for this command */
3955 memset(cmdPtr, 0, sizeof(*cmdPtr));
3956 cmdPtr->inUse = 1;
3957 cmdPtr->u.native.delProc = delProc;
3958 cmdPtr->u.native.cmdProc = cmdProc;
3959 cmdPtr->u.native.privData = privData;
3961 JimCreateCommand(interp, cmdNameStr, cmdPtr);
3963 return JIM_OK;
3966 static int JimCreateProcedureStatics(Jim_Interp *interp, Jim_Cmd *cmdPtr, Jim_Obj *staticsListObjPtr)
3968 int len, i;
3970 len = Jim_ListLength(interp, staticsListObjPtr);
3971 if (len == 0) {
3972 return JIM_OK;
3975 cmdPtr->u.proc.staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3976 Jim_InitHashTable(cmdPtr->u.proc.staticVars, &JimVariablesHashTableType, interp);
3977 for (i = 0; i < len; i++) {
3978 Jim_Obj *objPtr, *initObjPtr, *nameObjPtr;
3979 Jim_Var *varPtr;
3980 int subLen;
3982 objPtr = Jim_ListGetIndex(interp, staticsListObjPtr, i);
3983 /* Check if it's composed of two elements. */
3984 subLen = Jim_ListLength(interp, objPtr);
3985 if (subLen == 1 || subLen == 2) {
3986 /* Try to get the variable value from the current
3987 * environment. */
3988 nameObjPtr = Jim_ListGetIndex(interp, objPtr, 0);
3989 if (subLen == 1) {
3990 initObjPtr = Jim_GetVariable(interp, nameObjPtr, JIM_NONE);
3991 if (initObjPtr == NULL) {
3992 Jim_SetResultFormatted(interp,
3993 "variable for initialization of static \"%#s\" not found in the local context",
3994 nameObjPtr);
3995 return JIM_ERR;
3998 else {
3999 initObjPtr = Jim_ListGetIndex(interp, objPtr, 1);
4001 if (JimValidName(interp, "static variable", nameObjPtr) != JIM_OK) {
4002 return JIM_ERR;
4005 varPtr = Jim_Alloc(sizeof(*varPtr));
4006 varPtr->objPtr = initObjPtr;
4007 Jim_IncrRefCount(initObjPtr);
4008 varPtr->linkFramePtr = NULL;
4009 if (Jim_AddHashEntry(cmdPtr->u.proc.staticVars,
4010 Jim_String(nameObjPtr), varPtr) != JIM_OK) {
4011 Jim_SetResultFormatted(interp,
4012 "static variable name \"%#s\" duplicated in statics list", nameObjPtr);
4013 Jim_DecrRefCount(interp, initObjPtr);
4014 Jim_Free(varPtr);
4015 return JIM_ERR;
4018 else {
4019 Jim_SetResultFormatted(interp, "too many fields in static specifier \"%#s\"",
4020 objPtr);
4021 return JIM_ERR;
4024 return JIM_OK;
4028 * If the command is a proc, sets/updates the cached namespace (nsObj)
4029 * based on the command name.
4031 static void JimUpdateProcNamespace(Jim_Interp *interp, Jim_Cmd *cmdPtr, const char *cmdname)
4033 #ifdef jim_ext_namespace
4034 if (cmdPtr->isproc) {
4035 /* XXX: Really need JimNamespaceSplit() */
4036 const char *pt = strrchr(cmdname, ':');
4037 if (pt && pt != cmdname && pt[-1] == ':') {
4038 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
4039 cmdPtr->u.proc.nsObj = Jim_NewStringObj(interp, cmdname, pt - cmdname - 1);
4040 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
4042 if (Jim_FindHashEntry(&interp->commands, pt + 1)) {
4043 /* This command shadows a global command, so a proc epoch update is required */
4044 Jim_InterpIncrProcEpoch(interp);
4048 #endif
4051 static Jim_Cmd *JimCreateProcedureCmd(Jim_Interp *interp, Jim_Obj *argListObjPtr,
4052 Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr, Jim_Obj *nsObj)
4054 Jim_Cmd *cmdPtr;
4055 int argListLen;
4056 int i;
4058 argListLen = Jim_ListLength(interp, argListObjPtr);
4060 /* Allocate space for both the command pointer and the arg list */
4061 cmdPtr = Jim_Alloc(sizeof(*cmdPtr) + sizeof(struct Jim_ProcArg) * argListLen);
4062 memset(cmdPtr, 0, sizeof(*cmdPtr));
4063 cmdPtr->inUse = 1;
4064 cmdPtr->isproc = 1;
4065 cmdPtr->u.proc.argListObjPtr = argListObjPtr;
4066 cmdPtr->u.proc.argListLen = argListLen;
4067 cmdPtr->u.proc.bodyObjPtr = bodyObjPtr;
4068 cmdPtr->u.proc.argsPos = -1;
4069 cmdPtr->u.proc.arglist = (struct Jim_ProcArg *)(cmdPtr + 1);
4070 cmdPtr->u.proc.nsObj = nsObj ? nsObj : interp->emptyObj;
4071 Jim_IncrRefCount(argListObjPtr);
4072 Jim_IncrRefCount(bodyObjPtr);
4073 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
4075 /* Create the statics hash table. */
4076 if (staticsListObjPtr && JimCreateProcedureStatics(interp, cmdPtr, staticsListObjPtr) != JIM_OK) {
4077 goto err;
4080 /* Parse the args out into arglist, validating as we go */
4081 /* Examine the argument list for default parameters and 'args' */
4082 for (i = 0; i < argListLen; i++) {
4083 Jim_Obj *argPtr;
4084 Jim_Obj *nameObjPtr;
4085 Jim_Obj *defaultObjPtr;
4086 int len;
4088 /* Examine a parameter */
4089 argPtr = Jim_ListGetIndex(interp, argListObjPtr, i);
4090 len = Jim_ListLength(interp, argPtr);
4091 if (len == 0) {
4092 Jim_SetResultString(interp, "argument with no name", -1);
4093 err:
4094 JimDecrCmdRefCount(interp, cmdPtr);
4095 return NULL;
4097 if (len > 2) {
4098 Jim_SetResultFormatted(interp, "too many fields in argument specifier \"%#s\"", argPtr);
4099 goto err;
4102 if (len == 2) {
4103 /* Optional parameter */
4104 nameObjPtr = Jim_ListGetIndex(interp, argPtr, 0);
4105 defaultObjPtr = Jim_ListGetIndex(interp, argPtr, 1);
4107 else {
4108 /* Required parameter */
4109 nameObjPtr = argPtr;
4110 defaultObjPtr = NULL;
4114 if (Jim_CompareStringImmediate(interp, nameObjPtr, "args")) {
4115 if (cmdPtr->u.proc.argsPos >= 0) {
4116 Jim_SetResultString(interp, "'args' specified more than once", -1);
4117 goto err;
4119 cmdPtr->u.proc.argsPos = i;
4121 else {
4122 if (len == 2) {
4123 cmdPtr->u.proc.optArity++;
4125 else {
4126 cmdPtr->u.proc.reqArity++;
4130 cmdPtr->u.proc.arglist[i].nameObjPtr = nameObjPtr;
4131 cmdPtr->u.proc.arglist[i].defaultObjPtr = defaultObjPtr;
4134 return cmdPtr;
4137 int Jim_DeleteCommand(Jim_Interp *interp, const char *name)
4139 int ret = JIM_OK;
4140 Jim_Obj *qualifiedNameObj;
4141 const char *qualname = JimQualifyName(interp, name, &qualifiedNameObj);
4143 if (Jim_DeleteHashEntry(&interp->commands, qualname) == JIM_ERR) {
4144 Jim_SetResultFormatted(interp, "can't delete \"%s\": command doesn't exist", name);
4145 ret = JIM_ERR;
4147 else {
4148 Jim_InterpIncrProcEpoch(interp);
4151 JimFreeQualifiedName(interp, qualifiedNameObj);
4153 return ret;
4156 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName, const char *newName)
4158 int ret = JIM_ERR;
4159 Jim_HashEntry *he;
4160 Jim_Cmd *cmdPtr;
4161 Jim_Obj *qualifiedOldNameObj;
4162 Jim_Obj *qualifiedNewNameObj;
4163 const char *fqold;
4164 const char *fqnew;
4166 if (newName[0] == 0) {
4167 return Jim_DeleteCommand(interp, oldName);
4170 fqold = JimQualifyName(interp, oldName, &qualifiedOldNameObj);
4171 fqnew = JimQualifyName(interp, newName, &qualifiedNewNameObj);
4173 /* Does it exist? */
4174 he = Jim_FindHashEntry(&interp->commands, fqold);
4175 if (he == NULL) {
4176 Jim_SetResultFormatted(interp, "can't rename \"%s\": command doesn't exist", oldName);
4178 else if (Jim_FindHashEntry(&interp->commands, fqnew)) {
4179 Jim_SetResultFormatted(interp, "can't rename to \"%s\": command already exists", newName);
4181 else {
4182 /* Add the new name first */
4183 cmdPtr = Jim_GetHashEntryVal(he);
4184 JimIncrCmdRefCount(cmdPtr);
4185 JimUpdateProcNamespace(interp, cmdPtr, fqnew);
4186 Jim_AddHashEntry(&interp->commands, fqnew, cmdPtr);
4188 /* Now remove the old name */
4189 Jim_DeleteHashEntry(&interp->commands, fqold);
4191 /* Increment the epoch */
4192 Jim_InterpIncrProcEpoch(interp);
4194 ret = JIM_OK;
4197 JimFreeQualifiedName(interp, qualifiedOldNameObj);
4198 JimFreeQualifiedName(interp, qualifiedNewNameObj);
4200 return ret;
4203 /* -----------------------------------------------------------------------------
4204 * Command object
4205 * ---------------------------------------------------------------------------*/
4207 static void FreeCommandInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4209 Jim_DecrRefCount(interp, objPtr->internalRep.cmdValue.nsObj);
4212 static void DupCommandInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4214 dupPtr->internalRep.cmdValue = srcPtr->internalRep.cmdValue;
4215 dupPtr->typePtr = srcPtr->typePtr;
4216 Jim_IncrRefCount(dupPtr->internalRep.cmdValue.nsObj);
4219 static const Jim_ObjType commandObjType = {
4220 "command",
4221 FreeCommandInternalRep,
4222 DupCommandInternalRep,
4223 NULL,
4224 JIM_TYPE_REFERENCES,
4227 /* This function returns the command structure for the command name
4228 * stored in objPtr. It specializes the objPtr to contain
4229 * cached info instead of performing the lookup into the hash table
4230 * every time. The information cached may not be up-to-date, in this
4231 * case the lookup is performed and the cache updated.
4233 * Respects the 'upcall' setting.
4235 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4237 Jim_Cmd *cmd;
4239 /* In order to be valid, the proc epoch must match and
4240 * the lookup must have occurred in the same namespace
4242 if (objPtr->typePtr != &commandObjType ||
4243 objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch
4244 #ifdef jim_ext_namespace
4245 || !Jim_StringEqObj(objPtr->internalRep.cmdValue.nsObj, interp->framePtr->nsObj)
4246 #endif
4248 /* Not cached or out of date, so lookup */
4250 /* Do we need to try the local namespace? */
4251 const char *name = Jim_String(objPtr);
4252 Jim_HashEntry *he;
4254 if (name[0] == ':' && name[1] == ':') {
4255 while (*++name == ':') {
4258 #ifdef jim_ext_namespace
4259 else if (Jim_Length(interp->framePtr->nsObj)) {
4260 /* This command is being defined in a non-global namespace */
4261 Jim_Obj *nameObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
4262 Jim_AppendStrings(interp, nameObj, "::", name, NULL);
4263 he = Jim_FindHashEntry(&interp->commands, Jim_String(nameObj));
4264 Jim_FreeNewObj(interp, nameObj);
4265 if (he) {
4266 goto found;
4269 #endif
4271 /* Lookup in the global namespace */
4272 he = Jim_FindHashEntry(&interp->commands, name);
4273 if (he == NULL) {
4274 if (flags & JIM_ERRMSG) {
4275 Jim_SetResultFormatted(interp, "invalid command name \"%#s\"", objPtr);
4277 return NULL;
4279 #ifdef jim_ext_namespace
4280 found:
4281 #endif
4282 cmd = Jim_GetHashEntryVal(he);
4284 /* Free the old internal rep and set the new one. */
4285 Jim_FreeIntRep(interp, objPtr);
4286 objPtr->typePtr = &commandObjType;
4287 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
4288 objPtr->internalRep.cmdValue.cmdPtr = cmd;
4289 objPtr->internalRep.cmdValue.nsObj = interp->framePtr->nsObj;
4290 Jim_IncrRefCount(interp->framePtr->nsObj);
4292 else {
4293 cmd = objPtr->internalRep.cmdValue.cmdPtr;
4295 while (cmd->u.proc.upcall) {
4296 cmd = cmd->prevCmd;
4298 return cmd;
4301 /* -----------------------------------------------------------------------------
4302 * Variables
4303 * ---------------------------------------------------------------------------*/
4305 /* -----------------------------------------------------------------------------
4306 * Variable object
4307 * ---------------------------------------------------------------------------*/
4309 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
4311 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4313 static const Jim_ObjType variableObjType = {
4314 "variable",
4315 NULL,
4316 NULL,
4317 NULL,
4318 JIM_TYPE_REFERENCES,
4322 * Check that the name does not contain embedded nulls.
4324 * Variable and procedure names are manipulated as null terminated strings, so
4325 * don't allow names with embedded nulls.
4327 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr)
4329 /* Variable names and proc names can't contain embedded nulls */
4330 if (nameObjPtr->typePtr != &variableObjType) {
4331 int len;
4332 const char *str = Jim_GetString(nameObjPtr, &len);
4333 if (memchr(str, '\0', len)) {
4334 Jim_SetResultFormatted(interp, "%s name contains embedded null", type);
4335 return JIM_ERR;
4338 return JIM_OK;
4341 /* This method should be called only by the variable API.
4342 * It returns JIM_OK on success (variable already exists),
4343 * JIM_ERR if it does not exist, JIM_DICT_SUGAR if it's not
4344 * a variable name, but syntax glue for [dict] i.e. the last
4345 * character is ')' */
4346 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
4348 const char *varName;
4349 Jim_CallFrame *framePtr;
4350 Jim_HashEntry *he;
4351 int global;
4352 int len;
4354 /* Check if the object is already an uptodate variable */
4355 if (objPtr->typePtr == &variableObjType) {
4356 framePtr = objPtr->internalRep.varValue.global ? interp->topFramePtr : interp->framePtr;
4357 if (objPtr->internalRep.varValue.callFrameId == framePtr->id) {
4358 /* nothing to do */
4359 return JIM_OK;
4361 /* Need to re-resolve the variable in the updated callframe */
4363 else if (objPtr->typePtr == &dictSubstObjType) {
4364 return JIM_DICT_SUGAR;
4366 else if (JimValidName(interp, "variable", objPtr) != JIM_OK) {
4367 return JIM_ERR;
4371 varName = Jim_GetString(objPtr, &len);
4373 /* Make sure it's not syntax glue to get/set dict. */
4374 if (len && varName[len - 1] == ')' && strchr(varName, '(') != NULL) {
4375 return JIM_DICT_SUGAR;
4378 if (varName[0] == ':' && varName[1] == ':') {
4379 while (*++varName == ':') {
4381 global = 1;
4382 framePtr = interp->topFramePtr;
4384 else {
4385 global = 0;
4386 framePtr = interp->framePtr;
4389 /* Resolve this name in the variables hash table */
4390 he = Jim_FindHashEntry(&framePtr->vars, varName);
4391 if (he == NULL) {
4392 if (!global && framePtr->staticVars) {
4393 /* Try with static vars. */
4394 he = Jim_FindHashEntry(framePtr->staticVars, varName);
4396 if (he == NULL) {
4397 return JIM_ERR;
4401 /* Free the old internal repr and set the new one. */
4402 Jim_FreeIntRep(interp, objPtr);
4403 objPtr->typePtr = &variableObjType;
4404 objPtr->internalRep.varValue.callFrameId = framePtr->id;
4405 objPtr->internalRep.varValue.varPtr = Jim_GetHashEntryVal(he);
4406 objPtr->internalRep.varValue.global = global;
4407 return JIM_OK;
4410 /* -------------------- Variables related functions ------------------------- */
4411 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr, Jim_Obj *valObjPtr);
4412 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr, int flags);
4414 static Jim_Var *JimCreateVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4416 const char *name;
4417 Jim_CallFrame *framePtr;
4418 int global;
4420 /* New variable to create */
4421 Jim_Var *var = Jim_Alloc(sizeof(*var));
4423 var->objPtr = valObjPtr;
4424 Jim_IncrRefCount(valObjPtr);
4425 var->linkFramePtr = NULL;
4427 name = Jim_String(nameObjPtr);
4428 if (name[0] == ':' && name[1] == ':') {
4429 while (*++name == ':') {
4431 framePtr = interp->topFramePtr;
4432 global = 1;
4434 else {
4435 framePtr = interp->framePtr;
4436 global = 0;
4439 /* Insert the new variable */
4440 Jim_AddHashEntry(&framePtr->vars, name, var);
4442 /* Make the object int rep a variable */
4443 Jim_FreeIntRep(interp, nameObjPtr);
4444 nameObjPtr->typePtr = &variableObjType;
4445 nameObjPtr->internalRep.varValue.callFrameId = framePtr->id;
4446 nameObjPtr->internalRep.varValue.varPtr = var;
4447 nameObjPtr->internalRep.varValue.global = global;
4449 return var;
4452 /* For now that's dummy. Variables lookup should be optimized
4453 * in many ways, with caching of lookups, and possibly with
4454 * a table of pre-allocated vars in every CallFrame for local vars.
4455 * All the caching should also have an 'epoch' mechanism similar
4456 * to the one used by Tcl for procedures lookup caching. */
4459 * Set the variable nameObjPtr to value valObjptr.
4461 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4463 int err;
4464 Jim_Var *var;
4466 switch (SetVariableFromAny(interp, nameObjPtr)) {
4467 case JIM_DICT_SUGAR:
4468 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
4470 case JIM_ERR:
4471 if (JimValidName(interp, "variable", nameObjPtr) != JIM_OK) {
4472 return JIM_ERR;
4474 JimCreateVariable(interp, nameObjPtr, valObjPtr);
4475 break;
4477 case JIM_OK:
4478 var = nameObjPtr->internalRep.varValue.varPtr;
4479 if (var->linkFramePtr == NULL) {
4480 Jim_IncrRefCount(valObjPtr);
4481 Jim_DecrRefCount(interp, var->objPtr);
4482 var->objPtr = valObjPtr;
4484 else { /* Else handle the link */
4485 Jim_CallFrame *savedCallFrame;
4487 savedCallFrame = interp->framePtr;
4488 interp->framePtr = var->linkFramePtr;
4489 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
4490 interp->framePtr = savedCallFrame;
4491 if (err != JIM_OK)
4492 return err;
4495 return JIM_OK;
4498 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4500 Jim_Obj *nameObjPtr;
4501 int result;
4503 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4504 Jim_IncrRefCount(nameObjPtr);
4505 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
4506 Jim_DecrRefCount(interp, nameObjPtr);
4507 return result;
4510 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4512 Jim_CallFrame *savedFramePtr;
4513 int result;
4515 savedFramePtr = interp->framePtr;
4516 interp->framePtr = interp->topFramePtr;
4517 result = Jim_SetVariableStr(interp, name, objPtr);
4518 interp->framePtr = savedFramePtr;
4519 return result;
4522 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
4524 Jim_Obj *valObjPtr;
4525 int result;
4527 valObjPtr = Jim_NewStringObj(interp, val, -1);
4528 Jim_IncrRefCount(valObjPtr);
4529 result = Jim_SetVariableStr(interp, name, valObjPtr);
4530 Jim_DecrRefCount(interp, valObjPtr);
4531 return result;
4534 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
4535 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
4537 const char *varName;
4538 const char *targetName;
4539 Jim_CallFrame *framePtr;
4540 Jim_Var *varPtr;
4542 /* Check for an existing variable or link */
4543 switch (SetVariableFromAny(interp, nameObjPtr)) {
4544 case JIM_DICT_SUGAR:
4545 /* XXX: This message seem unnecessarily verbose, but it matches Tcl */
4546 Jim_SetResultFormatted(interp, "bad variable name \"%#s\": upvar won't create a scalar variable that looks like an array element", nameObjPtr);
4547 return JIM_ERR;
4549 case JIM_OK:
4550 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4552 if (varPtr->linkFramePtr == NULL) {
4553 Jim_SetResultFormatted(interp, "variable \"%#s\" already exists", nameObjPtr);
4554 return JIM_ERR;
4557 /* It exists, but is a link, so first delete the link */
4558 varPtr->linkFramePtr = NULL;
4559 break;
4562 /* Resolve the call frames for both variables */
4563 /* XXX: SetVariableFromAny() already did this! */
4564 varName = Jim_String(nameObjPtr);
4566 if (varName[0] == ':' && varName[1] == ':') {
4567 while (*++varName == ':') {
4569 /* Linking a global var does nothing */
4570 framePtr = interp->topFramePtr;
4572 else {
4573 framePtr = interp->framePtr;
4576 targetName = Jim_String(targetNameObjPtr);
4577 if (targetName[0] == ':' && targetName[1] == ':') {
4578 while (*++targetName == ':') {
4580 targetNameObjPtr = Jim_NewStringObj(interp, targetName, -1);
4581 targetCallFrame = interp->topFramePtr;
4583 Jim_IncrRefCount(targetNameObjPtr);
4585 if (framePtr->level < targetCallFrame->level) {
4586 Jim_SetResultFormatted(interp,
4587 "bad variable name \"%#s\": upvar won't create namespace variable that refers to procedure variable",
4588 nameObjPtr);
4589 Jim_DecrRefCount(interp, targetNameObjPtr);
4590 return JIM_ERR;
4593 /* Check for cycles. */
4594 if (framePtr == targetCallFrame) {
4595 Jim_Obj *objPtr = targetNameObjPtr;
4597 /* Cycles are only possible with 'uplevel 0' */
4598 while (1) {
4599 if (strcmp(Jim_String(objPtr), varName) == 0) {
4600 Jim_SetResultString(interp, "can't upvar from variable to itself", -1);
4601 Jim_DecrRefCount(interp, targetNameObjPtr);
4602 return JIM_ERR;
4604 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
4605 break;
4606 varPtr = objPtr->internalRep.varValue.varPtr;
4607 if (varPtr->linkFramePtr != targetCallFrame)
4608 break;
4609 objPtr = varPtr->objPtr;
4613 /* Perform the binding */
4614 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
4615 /* We are now sure 'nameObjPtr' type is variableObjType */
4616 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
4617 Jim_DecrRefCount(interp, targetNameObjPtr);
4618 return JIM_OK;
4621 /* Return the Jim_Obj pointer associated with a variable name,
4622 * or NULL if the variable was not found in the current context.
4623 * The same optimization discussed in the comment to the
4624 * 'SetVariable' function should apply here.
4626 * If JIM_UNSHARED is set and the variable is an array element (dict sugar)
4627 * in a dictionary which is shared, the array variable value is duplicated first.
4628 * This allows the array element to be updated (e.g. append, lappend) without
4629 * affecting other references to the dictionary.
4631 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4633 switch (SetVariableFromAny(interp, nameObjPtr)) {
4634 case JIM_OK:{
4635 Jim_Var *varPtr = nameObjPtr->internalRep.varValue.varPtr;
4637 if (varPtr->linkFramePtr == NULL) {
4638 return varPtr->objPtr;
4640 else {
4641 Jim_Obj *objPtr;
4643 /* The variable is a link? Resolve it. */
4644 Jim_CallFrame *savedCallFrame = interp->framePtr;
4646 interp->framePtr = varPtr->linkFramePtr;
4647 objPtr = Jim_GetVariable(interp, varPtr->objPtr, flags);
4648 interp->framePtr = savedCallFrame;
4649 if (objPtr) {
4650 return objPtr;
4652 /* Error, so fall through to the error message */
4655 break;
4657 case JIM_DICT_SUGAR:
4658 /* [dict] syntax sugar. */
4659 return JimDictSugarGet(interp, nameObjPtr, flags);
4661 if (flags & JIM_ERRMSG) {
4662 Jim_SetResultFormatted(interp, "can't read \"%#s\": no such variable", nameObjPtr);
4664 return NULL;
4667 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4669 Jim_CallFrame *savedFramePtr;
4670 Jim_Obj *objPtr;
4672 savedFramePtr = interp->framePtr;
4673 interp->framePtr = interp->topFramePtr;
4674 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4675 interp->framePtr = savedFramePtr;
4677 return objPtr;
4680 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
4682 Jim_Obj *nameObjPtr, *varObjPtr;
4684 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4685 Jim_IncrRefCount(nameObjPtr);
4686 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4687 Jim_DecrRefCount(interp, nameObjPtr);
4688 return varObjPtr;
4691 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name, int flags)
4693 Jim_CallFrame *savedFramePtr;
4694 Jim_Obj *objPtr;
4696 savedFramePtr = interp->framePtr;
4697 interp->framePtr = interp->topFramePtr;
4698 objPtr = Jim_GetVariableStr(interp, name, flags);
4699 interp->framePtr = savedFramePtr;
4701 return objPtr;
4704 /* Unset a variable.
4705 * Note: On success unset invalidates all the (cached) variable objects
4706 * by incrementing callFrameEpoch
4708 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4710 Jim_Var *varPtr;
4711 int retval;
4712 Jim_CallFrame *framePtr;
4714 retval = SetVariableFromAny(interp, nameObjPtr);
4715 if (retval == JIM_DICT_SUGAR) {
4716 /* [dict] syntax sugar. */
4717 return JimDictSugarSet(interp, nameObjPtr, NULL);
4719 else if (retval == JIM_OK) {
4720 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4722 /* If it's a link call UnsetVariable recursively */
4723 if (varPtr->linkFramePtr) {
4724 framePtr = interp->framePtr;
4725 interp->framePtr = varPtr->linkFramePtr;
4726 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
4727 interp->framePtr = framePtr;
4729 else {
4730 const char *name = Jim_String(nameObjPtr);
4731 if (nameObjPtr->internalRep.varValue.global) {
4732 name += 2;
4733 framePtr = interp->topFramePtr;
4735 else {
4736 framePtr = interp->framePtr;
4739 retval = Jim_DeleteHashEntry(&framePtr->vars, name);
4740 if (retval == JIM_OK) {
4741 /* Change the callframe id, invalidating var lookup caching */
4742 framePtr->id = interp->callFrameEpoch++;
4746 if (retval != JIM_OK && (flags & JIM_ERRMSG)) {
4747 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such variable", nameObjPtr);
4749 return retval;
4752 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
4754 /* Given a variable name for [dict] operation syntax sugar,
4755 * this function returns two objects, the first with the name
4756 * of the variable to set, and the second with the respective key.
4757 * For example "foo(bar)" will return objects with string repr. of
4758 * "foo" and "bar".
4760 * The returned objects have refcount = 1. The function can't fail. */
4761 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
4762 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
4764 const char *str, *p;
4765 int len, keyLen;
4766 Jim_Obj *varObjPtr, *keyObjPtr;
4768 str = Jim_GetString(objPtr, &len);
4770 p = strchr(str, '(');
4771 JimPanic((p == NULL, "JimDictSugarParseVarKey() called for non-dict-sugar (%s)", str));
4773 varObjPtr = Jim_NewStringObj(interp, str, p - str);
4775 p++;
4776 keyLen = (str + len) - p;
4777 if (str[len - 1] == ')') {
4778 keyLen--;
4781 /* Create the objects with the variable name and key. */
4782 keyObjPtr = Jim_NewStringObj(interp, p, keyLen);
4784 Jim_IncrRefCount(varObjPtr);
4785 Jim_IncrRefCount(keyObjPtr);
4786 *varPtrPtr = varObjPtr;
4787 *keyPtrPtr = keyObjPtr;
4790 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
4791 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
4792 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *valObjPtr)
4794 int err;
4796 SetDictSubstFromAny(interp, objPtr);
4798 err = Jim_SetDictKeysVector(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4799 &objPtr->internalRep.dictSubstValue.indexObjPtr, 1, valObjPtr, JIM_MUSTEXIST);
4801 if (err == JIM_OK) {
4802 /* Don't keep an extra ref to the result */
4803 Jim_SetEmptyResult(interp);
4805 else {
4806 if (!valObjPtr) {
4807 /* Better error message for unset a(2) where a exists but a(2) doesn't */
4808 if (Jim_GetVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_NONE)) {
4809 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such element in array",
4810 objPtr);
4811 return err;
4814 /* Make the error more informative and Tcl-compatible */
4815 Jim_SetResultFormatted(interp, "can't %s \"%#s\": variable isn't array",
4816 (valObjPtr ? "set" : "unset"), objPtr);
4818 return err;
4822 * Expands the array variable (dict sugar) and returns the result, or NULL on error.
4824 * If JIM_UNSHARED is set and the dictionary is shared, it will be duplicated
4825 * and stored back to the variable before expansion.
4827 static Jim_Obj *JimDictExpandArrayVariable(Jim_Interp *interp, Jim_Obj *varObjPtr,
4828 Jim_Obj *keyObjPtr, int flags)
4830 Jim_Obj *dictObjPtr;
4831 Jim_Obj *resObjPtr = NULL;
4832 int ret;
4834 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
4835 if (!dictObjPtr) {
4836 return NULL;
4839 ret = Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_NONE);
4840 if (ret != JIM_OK) {
4841 Jim_SetResultFormatted(interp,
4842 "can't read \"%#s(%#s)\": %s array", varObjPtr, keyObjPtr,
4843 ret < 0 ? "variable isn't" : "no such element in");
4845 else if ((flags & JIM_UNSHARED) && Jim_IsShared(dictObjPtr)) {
4846 /* Update the variable to have an unshared copy */
4847 Jim_SetVariable(interp, varObjPtr, Jim_DuplicateObj(interp, dictObjPtr));
4850 return resObjPtr;
4853 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
4854 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4856 SetDictSubstFromAny(interp, objPtr);
4858 return JimDictExpandArrayVariable(interp,
4859 objPtr->internalRep.dictSubstValue.varNameObjPtr,
4860 objPtr->internalRep.dictSubstValue.indexObjPtr, flags);
4863 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
4865 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4867 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
4868 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
4871 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4873 /* Copy the internal rep */
4874 dupPtr->internalRep = srcPtr->internalRep;
4875 /* Need to increment the ref counts */
4876 Jim_IncrRefCount(dupPtr->internalRep.dictSubstValue.varNameObjPtr);
4877 Jim_IncrRefCount(dupPtr->internalRep.dictSubstValue.indexObjPtr);
4880 /* Note: The object *must* be in dict-sugar format */
4881 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4883 if (objPtr->typePtr != &dictSubstObjType) {
4884 Jim_Obj *varObjPtr, *keyObjPtr;
4886 if (objPtr->typePtr == &interpolatedObjType) {
4887 /* An interpolated object in dict-sugar form */
4889 varObjPtr = objPtr->internalRep.dictSubstValue.varNameObjPtr;
4890 keyObjPtr = objPtr->internalRep.dictSubstValue.indexObjPtr;
4892 Jim_IncrRefCount(varObjPtr);
4893 Jim_IncrRefCount(keyObjPtr);
4895 else {
4896 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
4899 Jim_FreeIntRep(interp, objPtr);
4900 objPtr->typePtr = &dictSubstObjType;
4901 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
4902 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
4906 /* This function is used to expand [dict get] sugar in the form
4907 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
4908 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
4909 * object that is *guaranteed* to be in the form VARNAME(INDEX).
4910 * The 'index' part is [subst]ituted, and is used to lookup a key inside
4911 * the [dict]ionary contained in variable VARNAME. */
4912 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4914 Jim_Obj *resObjPtr = NULL;
4915 Jim_Obj *substKeyObjPtr = NULL;
4917 SetDictSubstFromAny(interp, objPtr);
4919 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
4920 &substKeyObjPtr, JIM_NONE)
4921 != JIM_OK) {
4922 return NULL;
4924 Jim_IncrRefCount(substKeyObjPtr);
4925 resObjPtr =
4926 JimDictExpandArrayVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4927 substKeyObjPtr, 0);
4928 Jim_DecrRefCount(interp, substKeyObjPtr);
4930 return resObjPtr;
4933 /* -----------------------------------------------------------------------------
4934 * CallFrame
4935 * ---------------------------------------------------------------------------*/
4937 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp, Jim_CallFrame *parent, Jim_Obj *nsObj)
4939 Jim_CallFrame *cf;
4941 if (interp->freeFramesList) {
4942 cf = interp->freeFramesList;
4943 interp->freeFramesList = cf->next;
4945 cf->argv = NULL;
4946 cf->argc = 0;
4947 cf->procArgsObjPtr = NULL;
4948 cf->procBodyObjPtr = NULL;
4949 cf->next = NULL;
4950 cf->staticVars = NULL;
4951 cf->localCommands = NULL;
4952 cf->tailcallObj = NULL;
4953 cf->tailcallCmd = NULL;
4955 else {
4956 cf = Jim_Alloc(sizeof(*cf));
4957 memset(cf, 0, sizeof(*cf));
4959 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
4962 cf->id = interp->callFrameEpoch++;
4963 cf->parent = parent;
4964 cf->level = parent ? parent->level + 1 : 0;
4965 cf->nsObj = nsObj;
4966 Jim_IncrRefCount(nsObj);
4968 return cf;
4971 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands)
4973 /* Delete any local procs */
4974 if (localCommands) {
4975 Jim_Obj *cmdNameObj;
4977 while ((cmdNameObj = Jim_StackPop(localCommands)) != NULL) {
4978 Jim_HashEntry *he;
4979 Jim_Obj *fqObjName;
4980 Jim_HashTable *ht = &interp->commands;
4982 const char *fqname = JimQualifyName(interp, Jim_String(cmdNameObj), &fqObjName);
4984 he = Jim_FindHashEntry(ht, fqname);
4986 if (he) {
4987 Jim_Cmd *cmd = Jim_GetHashEntryVal(he);
4988 if (cmd->prevCmd) {
4989 Jim_Cmd *prevCmd = cmd->prevCmd;
4990 cmd->prevCmd = NULL;
4992 /* Delete the old command */
4993 JimDecrCmdRefCount(interp, cmd);
4995 /* And restore the original */
4996 Jim_SetHashVal(ht, he, prevCmd);
4998 else {
4999 Jim_DeleteHashEntry(ht, fqname);
5001 Jim_InterpIncrProcEpoch(interp);
5003 Jim_DecrRefCount(interp, cmdNameObj);
5004 JimFreeQualifiedName(interp, fqObjName);
5006 Jim_FreeStack(localCommands);
5007 Jim_Free(localCommands);
5009 return JIM_OK;
5013 * Run any $jim::defer scripts for the current call frame.
5015 * retcode is the return code from the current proc.
5017 * Returns the new return code.
5019 static int JimInvokeDefer(Jim_Interp *interp, int retcode)
5021 Jim_Obj *objPtr;
5023 /* Fast check for the likely case that the variable doesn't exist */
5024 if (Jim_FindHashEntry(&interp->framePtr->vars, "jim::defer") == NULL) {
5025 return retcode;
5028 objPtr = Jim_GetVariableStr(interp, "jim::defer", JIM_NONE);
5030 if (objPtr) {
5031 int ret = JIM_OK;
5032 int i;
5033 int listLen = Jim_ListLength(interp, objPtr);
5034 Jim_Obj *resultObjPtr;
5036 Jim_IncrRefCount(objPtr);
5038 /* Need to save away the current interp result and
5039 * restore it if appropriate
5041 resultObjPtr = Jim_GetResult(interp);
5042 Jim_IncrRefCount(resultObjPtr);
5043 Jim_SetEmptyResult(interp);
5045 /* Invoke in reverse order */
5046 for (i = listLen; i > 0; i--) {
5047 /* If a defer script returns an error, don't evaluate remaining scripts */
5048 Jim_Obj *scriptObjPtr = Jim_ListGetIndex(interp, objPtr, i - 1);
5049 ret = Jim_EvalObj(interp, scriptObjPtr);
5050 if (ret != JIM_OK) {
5051 break;
5055 if (ret == JIM_OK || retcode == JIM_ERR) {
5056 /* defer script had no error, or proc had an error so restore proc result */
5057 Jim_SetResult(interp, resultObjPtr);
5059 else {
5060 retcode = ret;
5063 Jim_DecrRefCount(interp, resultObjPtr);
5064 Jim_DecrRefCount(interp, objPtr);
5066 return retcode;
5069 #define JIM_FCF_FULL 0 /* Always free the vars hash table */
5070 #define JIM_FCF_REUSE 1 /* Reuse the vars hash table if possible */
5071 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action)
5073 JimDeleteLocalProcs(interp, cf->localCommands);
5075 if (cf->procArgsObjPtr)
5076 Jim_DecrRefCount(interp, cf->procArgsObjPtr);
5077 if (cf->procBodyObjPtr)
5078 Jim_DecrRefCount(interp, cf->procBodyObjPtr);
5079 Jim_DecrRefCount(interp, cf->nsObj);
5080 if (action == JIM_FCF_FULL || cf->vars.size != JIM_HT_INITIAL_SIZE)
5081 Jim_FreeHashTable(&cf->vars);
5082 else {
5083 int i;
5084 Jim_HashEntry **table = cf->vars.table, *he;
5086 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
5087 he = table[i];
5088 while (he != NULL) {
5089 Jim_HashEntry *nextEntry = he->next;
5090 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
5092 Jim_DecrRefCount(interp, varPtr->objPtr);
5093 Jim_Free(Jim_GetHashEntryKey(he));
5094 Jim_Free(varPtr);
5095 Jim_Free(he);
5096 table[i] = NULL;
5097 he = nextEntry;
5100 cf->vars.used = 0;
5102 cf->next = interp->freeFramesList;
5103 interp->freeFramesList = cf;
5107 /* -----------------------------------------------------------------------------
5108 * References
5109 * ---------------------------------------------------------------------------*/
5110 #if defined(JIM_REFERENCES) && !defined(JIM_BOOTSTRAP)
5112 /* References HashTable Type.
5114 * Keys are unsigned long integers, dynamically allocated for now but in the
5115 * future it's worth to cache this 4 bytes objects. Values are pointers
5116 * to Jim_References. */
5117 static void JimReferencesHTValDestructor(void *interp, void *val)
5119 Jim_Reference *refPtr = (void *)val;
5121 Jim_DecrRefCount(interp, refPtr->objPtr);
5122 if (refPtr->finalizerCmdNamePtr != NULL) {
5123 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5125 Jim_Free(val);
5128 static unsigned int JimReferencesHTHashFunction(const void *key)
5130 /* Only the least significant bits are used. */
5131 const unsigned long *widePtr = key;
5132 unsigned int intValue = (unsigned int)*widePtr;
5134 return Jim_IntHashFunction(intValue);
5137 static void *JimReferencesHTKeyDup(void *privdata, const void *key)
5139 void *copy = Jim_Alloc(sizeof(unsigned long));
5141 JIM_NOTUSED(privdata);
5143 memcpy(copy, key, sizeof(unsigned long));
5144 return copy;
5147 static int JimReferencesHTKeyCompare(void *privdata, const void *key1, const void *key2)
5149 JIM_NOTUSED(privdata);
5151 return memcmp(key1, key2, sizeof(unsigned long)) == 0;
5154 static void JimReferencesHTKeyDestructor(void *privdata, void *key)
5156 JIM_NOTUSED(privdata);
5158 Jim_Free(key);
5161 static const Jim_HashTableType JimReferencesHashTableType = {
5162 JimReferencesHTHashFunction, /* hash function */
5163 JimReferencesHTKeyDup, /* key dup */
5164 NULL, /* val dup */
5165 JimReferencesHTKeyCompare, /* key compare */
5166 JimReferencesHTKeyDestructor, /* key destructor */
5167 JimReferencesHTValDestructor /* val destructor */
5170 /* -----------------------------------------------------------------------------
5171 * Reference object type and References API
5172 * ---------------------------------------------------------------------------*/
5174 /* The string representation of references has two features in order
5175 * to make the GC faster. The first is that every reference starts
5176 * with a non common character '<', in order to make the string matching
5177 * faster. The second is that the reference string rep is 42 characters
5178 * in length, this means that it is not necessary to check any object with a string
5179 * repr < 42, and usually there aren't many of these objects. */
5181 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
5183 static int JimFormatReference(char *buf, Jim_Reference *refPtr, unsigned long id)
5185 const char *fmt = "<reference.<%s>.%020lu>";
5187 sprintf(buf, fmt, refPtr->tag, id);
5188 return JIM_REFERENCE_SPACE;
5191 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
5193 static const Jim_ObjType referenceObjType = {
5194 "reference",
5195 NULL,
5196 NULL,
5197 UpdateStringOfReference,
5198 JIM_TYPE_REFERENCES,
5201 static void UpdateStringOfReference(struct Jim_Obj *objPtr)
5203 char buf[JIM_REFERENCE_SPACE + 1];
5205 JimFormatReference(buf, objPtr->internalRep.refValue.refPtr, objPtr->internalRep.refValue.id);
5206 JimSetStringBytes(objPtr, buf);
5209 /* returns true if 'c' is a valid reference tag character.
5210 * i.e. inside the range [_a-zA-Z0-9] */
5211 static int isrefchar(int c)
5213 return (c == '_' || isalnum(c));
5216 static int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5218 unsigned long value;
5219 int i, len;
5220 const char *str, *start, *end;
5221 char refId[21];
5222 Jim_Reference *refPtr;
5223 Jim_HashEntry *he;
5224 char *endptr;
5226 /* Get the string representation */
5227 str = Jim_GetString(objPtr, &len);
5228 /* Check if it looks like a reference */
5229 if (len < JIM_REFERENCE_SPACE)
5230 goto badformat;
5231 /* Trim spaces */
5232 start = str;
5233 end = str + len - 1;
5234 while (*start == ' ')
5235 start++;
5236 while (*end == ' ' && end > start)
5237 end--;
5238 if (end - start + 1 != JIM_REFERENCE_SPACE)
5239 goto badformat;
5240 /* <reference.<1234567>.%020> */
5241 if (memcmp(start, "<reference.<", 12) != 0)
5242 goto badformat;
5243 if (start[12 + JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>')
5244 goto badformat;
5245 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
5246 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5247 if (!isrefchar(start[12 + i]))
5248 goto badformat;
5250 /* Extract info from the reference. */
5251 memcpy(refId, start + 14 + JIM_REFERENCE_TAGLEN, 20);
5252 refId[20] = '\0';
5253 /* Try to convert the ID into an unsigned long */
5254 value = strtoul(refId, &endptr, 10);
5255 if (JimCheckConversion(refId, endptr) != JIM_OK)
5256 goto badformat;
5257 /* Check if the reference really exists! */
5258 he = Jim_FindHashEntry(&interp->references, &value);
5259 if (he == NULL) {
5260 Jim_SetResultFormatted(interp, "invalid reference id \"%#s\"", objPtr);
5261 return JIM_ERR;
5263 refPtr = Jim_GetHashEntryVal(he);
5264 /* Free the old internal repr and set the new one. */
5265 Jim_FreeIntRep(interp, objPtr);
5266 objPtr->typePtr = &referenceObjType;
5267 objPtr->internalRep.refValue.id = value;
5268 objPtr->internalRep.refValue.refPtr = refPtr;
5269 return JIM_OK;
5271 badformat:
5272 Jim_SetResultFormatted(interp, "expected reference but got \"%#s\"", objPtr);
5273 return JIM_ERR;
5276 /* Returns a new reference pointing to objPtr, having cmdNamePtr
5277 * as finalizer command (or NULL if there is no finalizer).
5278 * The returned reference object has refcount = 0. */
5279 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr, Jim_Obj *cmdNamePtr)
5281 struct Jim_Reference *refPtr;
5282 unsigned long id;
5283 Jim_Obj *refObjPtr;
5284 const char *tag;
5285 int tagLen, i;
5287 /* Perform the Garbage Collection if needed. */
5288 Jim_CollectIfNeeded(interp);
5290 refPtr = Jim_Alloc(sizeof(*refPtr));
5291 refPtr->objPtr = objPtr;
5292 Jim_IncrRefCount(objPtr);
5293 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5294 if (cmdNamePtr)
5295 Jim_IncrRefCount(cmdNamePtr);
5296 id = interp->referenceNextId++;
5297 Jim_AddHashEntry(&interp->references, &id, refPtr);
5298 refObjPtr = Jim_NewObj(interp);
5299 refObjPtr->typePtr = &referenceObjType;
5300 refObjPtr->bytes = NULL;
5301 refObjPtr->internalRep.refValue.id = id;
5302 refObjPtr->internalRep.refValue.refPtr = refPtr;
5303 interp->referenceNextId++;
5304 /* Set the tag. Trimmed at JIM_REFERENCE_TAGLEN. Everything
5305 * that does not pass the 'isrefchar' test is replaced with '_' */
5306 tag = Jim_GetString(tagPtr, &tagLen);
5307 if (tagLen > JIM_REFERENCE_TAGLEN)
5308 tagLen = JIM_REFERENCE_TAGLEN;
5309 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5310 if (i < tagLen && isrefchar(tag[i]))
5311 refPtr->tag[i] = tag[i];
5312 else
5313 refPtr->tag[i] = '_';
5315 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
5316 return refObjPtr;
5319 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
5321 if (objPtr->typePtr != &referenceObjType && SetReferenceFromAny(interp, objPtr) == JIM_ERR)
5322 return NULL;
5323 return objPtr->internalRep.refValue.refPtr;
5326 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
5328 Jim_Reference *refPtr;
5330 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5331 return JIM_ERR;
5332 Jim_IncrRefCount(cmdNamePtr);
5333 if (refPtr->finalizerCmdNamePtr)
5334 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5335 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5336 return JIM_OK;
5339 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
5341 Jim_Reference *refPtr;
5343 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5344 return JIM_ERR;
5345 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
5346 return JIM_OK;
5349 /* -----------------------------------------------------------------------------
5350 * References Garbage Collection
5351 * ---------------------------------------------------------------------------*/
5353 /* This the hash table type for the "MARK" phase of the GC */
5354 static const Jim_HashTableType JimRefMarkHashTableType = {
5355 JimReferencesHTHashFunction, /* hash function */
5356 JimReferencesHTKeyDup, /* key dup */
5357 NULL, /* val dup */
5358 JimReferencesHTKeyCompare, /* key compare */
5359 JimReferencesHTKeyDestructor, /* key destructor */
5360 NULL /* val destructor */
5363 /* Performs the garbage collection. */
5364 int Jim_Collect(Jim_Interp *interp)
5366 int collected = 0;
5367 Jim_HashTable marks;
5368 Jim_HashTableIterator htiter;
5369 Jim_HashEntry *he;
5370 Jim_Obj *objPtr;
5372 /* Avoid recursive calls */
5373 if (interp->lastCollectId == (unsigned long)~0) {
5374 /* Jim_Collect() already running. Return just now. */
5375 return 0;
5377 interp->lastCollectId = ~0;
5379 /* Mark all the references found into the 'mark' hash table.
5380 * The references are searched in every live object that
5381 * is of a type that can contain references. */
5382 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
5383 objPtr = interp->liveList;
5384 while (objPtr) {
5385 if (objPtr->typePtr == NULL || objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
5386 const char *str, *p;
5387 int len;
5389 /* If the object is of type reference, to get the
5390 * Id is simple... */
5391 if (objPtr->typePtr == &referenceObjType) {
5392 Jim_AddHashEntry(&marks, &objPtr->internalRep.refValue.id, NULL);
5393 #ifdef JIM_DEBUG_GC
5394 printf("MARK (reference): %d refcount: %d\n",
5395 (int)objPtr->internalRep.refValue.id, objPtr->refCount);
5396 #endif
5397 objPtr = objPtr->nextObjPtr;
5398 continue;
5400 /* Get the string repr of the object we want
5401 * to scan for references. */
5402 p = str = Jim_GetString(objPtr, &len);
5403 /* Skip objects too little to contain references. */
5404 if (len < JIM_REFERENCE_SPACE) {
5405 objPtr = objPtr->nextObjPtr;
5406 continue;
5408 /* Extract references from the object string repr. */
5409 while (1) {
5410 int i;
5411 unsigned long id;
5413 if ((p = strstr(p, "<reference.<")) == NULL)
5414 break;
5415 /* Check if it's a valid reference. */
5416 if (len - (p - str) < JIM_REFERENCE_SPACE)
5417 break;
5418 if (p[41] != '>' || p[19] != '>' || p[20] != '.')
5419 break;
5420 for (i = 21; i <= 40; i++)
5421 if (!isdigit(UCHAR(p[i])))
5422 break;
5423 /* Get the ID */
5424 id = strtoul(p + 21, NULL, 10);
5426 /* Ok, a reference for the given ID
5427 * was found. Mark it. */
5428 Jim_AddHashEntry(&marks, &id, NULL);
5429 #ifdef JIM_DEBUG_GC
5430 printf("MARK: %d\n", (int)id);
5431 #endif
5432 p += JIM_REFERENCE_SPACE;
5435 objPtr = objPtr->nextObjPtr;
5438 /* Run the references hash table to destroy every reference that
5439 * is not referenced outside (not present in the mark HT). */
5440 JimInitHashTableIterator(&interp->references, &htiter);
5441 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
5442 const unsigned long *refId;
5443 Jim_Reference *refPtr;
5445 refId = he->key;
5446 /* Check if in the mark phase we encountered
5447 * this reference. */
5448 if (Jim_FindHashEntry(&marks, refId) == NULL) {
5449 #ifdef JIM_DEBUG_GC
5450 printf("COLLECTING %d\n", (int)*refId);
5451 #endif
5452 collected++;
5453 /* Drop the reference, but call the
5454 * finalizer first if registered. */
5455 refPtr = Jim_GetHashEntryVal(he);
5456 if (refPtr->finalizerCmdNamePtr) {
5457 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE + 1);
5458 Jim_Obj *objv[3], *oldResult;
5460 JimFormatReference(refstr, refPtr, *refId);
5462 objv[0] = refPtr->finalizerCmdNamePtr;
5463 objv[1] = Jim_NewStringObjNoAlloc(interp, refstr, JIM_REFERENCE_SPACE);
5464 objv[2] = refPtr->objPtr;
5466 /* Drop the reference itself */
5467 /* Avoid the finaliser being freed here */
5468 Jim_IncrRefCount(objv[0]);
5469 /* Don't remove the reference from the hash table just yet
5470 * since that will free refPtr, and hence refPtr->objPtr
5473 /* Call the finalizer. Errors ignored. (should we use bgerror?) */
5474 oldResult = interp->result;
5475 Jim_IncrRefCount(oldResult);
5476 Jim_EvalObjVector(interp, 3, objv);
5477 Jim_SetResult(interp, oldResult);
5478 Jim_DecrRefCount(interp, oldResult);
5480 Jim_DecrRefCount(interp, objv[0]);
5482 Jim_DeleteHashEntry(&interp->references, refId);
5485 Jim_FreeHashTable(&marks);
5486 interp->lastCollectId = interp->referenceNextId;
5487 interp->lastCollectTime = time(NULL);
5488 return collected;
5491 #define JIM_COLLECT_ID_PERIOD 5000
5492 #define JIM_COLLECT_TIME_PERIOD 300
5494 void Jim_CollectIfNeeded(Jim_Interp *interp)
5496 unsigned long elapsedId;
5497 int elapsedTime;
5499 elapsedId = interp->referenceNextId - interp->lastCollectId;
5500 elapsedTime = time(NULL) - interp->lastCollectTime;
5503 if (elapsedId > JIM_COLLECT_ID_PERIOD || elapsedTime > JIM_COLLECT_TIME_PERIOD) {
5504 Jim_Collect(interp);
5507 #endif /* JIM_REFERENCES && !JIM_BOOTSTRAP */
5509 int Jim_IsBigEndian(void)
5511 union {
5512 unsigned short s;
5513 unsigned char c[2];
5514 } uval = {0x0102};
5516 return uval.c[0] == 1;
5519 /* -----------------------------------------------------------------------------
5520 * Interpreter related functions
5521 * ---------------------------------------------------------------------------*/
5523 Jim_Interp *Jim_CreateInterp(void)
5525 Jim_Interp *i = Jim_Alloc(sizeof(*i));
5527 memset(i, 0, sizeof(*i));
5529 i->maxCallFrameDepth = JIM_MAX_CALLFRAME_DEPTH;
5530 i->maxEvalDepth = JIM_MAX_EVAL_DEPTH;
5531 i->lastCollectTime = time(NULL);
5533 /* Note that we can create objects only after the
5534 * interpreter liveList and freeList pointers are
5535 * initialized to NULL. */
5536 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
5537 #ifdef JIM_REFERENCES
5538 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
5539 #endif
5540 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
5541 Jim_InitHashTable(&i->packages, &JimPackageHashTableType, NULL);
5542 i->emptyObj = Jim_NewEmptyStringObj(i);
5543 i->trueObj = Jim_NewIntObj(i, 1);
5544 i->falseObj = Jim_NewIntObj(i, 0);
5545 i->framePtr = i->topFramePtr = JimCreateCallFrame(i, NULL, i->emptyObj);
5546 i->errorFileNameObj = i->emptyObj;
5547 i->result = i->emptyObj;
5548 i->stackTrace = Jim_NewListObj(i, NULL, 0);
5549 i->unknown = Jim_NewStringObj(i, "unknown", -1);
5550 i->errorProc = i->emptyObj;
5551 i->currentScriptObj = Jim_NewEmptyStringObj(i);
5552 i->nullScriptObj = Jim_NewEmptyStringObj(i);
5553 Jim_IncrRefCount(i->emptyObj);
5554 Jim_IncrRefCount(i->errorFileNameObj);
5555 Jim_IncrRefCount(i->result);
5556 Jim_IncrRefCount(i->stackTrace);
5557 Jim_IncrRefCount(i->unknown);
5558 Jim_IncrRefCount(i->currentScriptObj);
5559 Jim_IncrRefCount(i->nullScriptObj);
5560 Jim_IncrRefCount(i->errorProc);
5561 Jim_IncrRefCount(i->trueObj);
5562 Jim_IncrRefCount(i->falseObj);
5564 /* Initialize key variables every interpreter should contain */
5565 Jim_SetVariableStrWithStr(i, JIM_LIBPATH, TCL_LIBRARY);
5566 Jim_SetVariableStrWithStr(i, JIM_INTERACTIVE, "0");
5568 Jim_SetVariableStrWithStr(i, "tcl_platform(engine)", "Jim");
5569 Jim_SetVariableStrWithStr(i, "tcl_platform(os)", TCL_PLATFORM_OS);
5570 Jim_SetVariableStrWithStr(i, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM);
5571 Jim_SetVariableStrWithStr(i, "tcl_platform(pathSeparator)", TCL_PLATFORM_PATH_SEPARATOR);
5572 Jim_SetVariableStrWithStr(i, "tcl_platform(byteOrder)", Jim_IsBigEndian() ? "bigEndian" : "littleEndian");
5573 Jim_SetVariableStrWithStr(i, "tcl_platform(threaded)", "0");
5574 Jim_SetVariableStr(i, "tcl_platform(pointerSize)", Jim_NewIntObj(i, sizeof(void *)));
5575 Jim_SetVariableStr(i, "tcl_platform(wordSize)", Jim_NewIntObj(i, sizeof(jim_wide)));
5577 return i;
5580 void Jim_FreeInterp(Jim_Interp *i)
5582 Jim_CallFrame *cf, *cfx;
5584 Jim_Obj *objPtr, *nextObjPtr;
5586 /* Free the active call frames list - must be done before i->commands is destroyed */
5587 for (cf = i->framePtr; cf; cf = cfx) {
5588 /* Note that we ignore any errors */
5589 JimInvokeDefer(i, JIM_OK);
5590 cfx = cf->parent;
5591 JimFreeCallFrame(i, cf, JIM_FCF_FULL);
5594 Jim_DecrRefCount(i, i->emptyObj);
5595 Jim_DecrRefCount(i, i->trueObj);
5596 Jim_DecrRefCount(i, i->falseObj);
5597 Jim_DecrRefCount(i, i->result);
5598 Jim_DecrRefCount(i, i->stackTrace);
5599 Jim_DecrRefCount(i, i->errorProc);
5600 Jim_DecrRefCount(i, i->unknown);
5601 Jim_DecrRefCount(i, i->errorFileNameObj);
5602 Jim_DecrRefCount(i, i->currentScriptObj);
5603 Jim_DecrRefCount(i, i->nullScriptObj);
5604 Jim_FreeHashTable(&i->commands);
5605 #ifdef JIM_REFERENCES
5606 Jim_FreeHashTable(&i->references);
5607 #endif
5608 Jim_FreeHashTable(&i->packages);
5609 Jim_Free(i->prngState);
5610 Jim_FreeHashTable(&i->assocData);
5612 /* Check that the live object list is empty, otherwise
5613 * there is a memory leak. */
5614 #ifdef JIM_MAINTAINER
5615 if (i->liveList != NULL) {
5616 objPtr = i->liveList;
5618 printf("\n-------------------------------------\n");
5619 printf("Objects still in the free list:\n");
5620 while (objPtr) {
5621 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "string";
5622 Jim_String(objPtr);
5624 if (objPtr->bytes && strlen(objPtr->bytes) > 20) {
5625 printf("%p (%d) %-10s: '%.20s...'\n",
5626 (void *)objPtr, objPtr->refCount, type, objPtr->bytes);
5628 else {
5629 printf("%p (%d) %-10s: '%s'\n",
5630 (void *)objPtr, objPtr->refCount, type, objPtr->bytes ? objPtr->bytes : "(null)");
5632 if (objPtr->typePtr == &sourceObjType) {
5633 printf("FILE %s LINE %d\n",
5634 Jim_String(objPtr->internalRep.sourceValue.fileNameObj),
5635 objPtr->internalRep.sourceValue.lineNumber);
5637 objPtr = objPtr->nextObjPtr;
5639 printf("-------------------------------------\n\n");
5640 JimPanic((1, "Live list non empty freeing the interpreter! Leak?"));
5642 #endif
5644 /* Free all the freed objects. */
5645 objPtr = i->freeList;
5646 while (objPtr) {
5647 nextObjPtr = objPtr->nextObjPtr;
5648 Jim_Free(objPtr);
5649 objPtr = nextObjPtr;
5652 /* Free the free call frames list */
5653 for (cf = i->freeFramesList; cf; cf = cfx) {
5654 cfx = cf->next;
5655 if (cf->vars.table)
5656 Jim_FreeHashTable(&cf->vars);
5657 Jim_Free(cf);
5660 /* Free the interpreter structure. */
5661 Jim_Free(i);
5664 /* Returns the call frame relative to the level represented by
5665 * levelObjPtr. If levelObjPtr == NULL, the level is assumed to be '1'.
5667 * This function accepts the 'level' argument in the form
5668 * of the commands [uplevel] and [upvar].
5670 * Returns NULL on error.
5672 * Note: for a function accepting a relative integer as level suitable
5673 * for implementation of [info level ?level?], see JimGetCallFrameByInteger()
5675 Jim_CallFrame *Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5677 long level;
5678 const char *str;
5679 Jim_CallFrame *framePtr;
5681 if (levelObjPtr) {
5682 str = Jim_String(levelObjPtr);
5683 if (str[0] == '#') {
5684 char *endptr;
5686 level = jim_strtol(str + 1, &endptr);
5687 if (str[1] == '\0' || endptr[0] != '\0') {
5688 level = -1;
5691 else {
5692 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0) {
5693 level = -1;
5695 else {
5696 /* Convert from a relative to an absolute level */
5697 level = interp->framePtr->level - level;
5701 else {
5702 str = "1"; /* Needed to format the error message. */
5703 level = interp->framePtr->level - 1;
5706 if (level == 0) {
5707 return interp->topFramePtr;
5709 if (level > 0) {
5710 /* Lookup */
5711 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5712 if (framePtr->level == level) {
5713 return framePtr;
5718 Jim_SetResultFormatted(interp, "bad level \"%s\"", str);
5719 return NULL;
5722 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
5723 * as a relative integer like in the [info level ?level?] command.
5725 static Jim_CallFrame *JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5727 long level;
5728 Jim_CallFrame *framePtr;
5730 if (Jim_GetLong(interp, levelObjPtr, &level) == JIM_OK) {
5731 if (level <= 0) {
5732 /* Convert from a relative to an absolute level */
5733 level = interp->framePtr->level + level;
5736 if (level == 0) {
5737 return interp->topFramePtr;
5740 /* Lookup */
5741 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5742 if (framePtr->level == level) {
5743 return framePtr;
5748 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
5749 return NULL;
5752 static void JimResetStackTrace(Jim_Interp *interp)
5754 Jim_DecrRefCount(interp, interp->stackTrace);
5755 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
5756 Jim_IncrRefCount(interp->stackTrace);
5759 static void JimSetStackTrace(Jim_Interp *interp, Jim_Obj *stackTraceObj)
5761 int len;
5763 /* Increment reference first in case these are the same object */
5764 Jim_IncrRefCount(stackTraceObj);
5765 Jim_DecrRefCount(interp, interp->stackTrace);
5766 interp->stackTrace = stackTraceObj;
5767 interp->errorFlag = 1;
5769 /* This is a bit ugly.
5770 * If the filename of the last entry of the stack trace is empty,
5771 * the next stack level should be added.
5773 len = Jim_ListLength(interp, interp->stackTrace);
5774 if (len >= 3) {
5775 if (Jim_Length(Jim_ListGetIndex(interp, interp->stackTrace, len - 2)) == 0) {
5776 interp->addStackTrace = 1;
5781 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
5782 Jim_Obj *fileNameObj, int linenr)
5784 if (strcmp(procname, "unknown") == 0) {
5785 procname = "";
5787 if (!*procname && !Jim_Length(fileNameObj)) {
5788 /* No useful info here */
5789 return;
5792 if (Jim_IsShared(interp->stackTrace)) {
5793 Jim_DecrRefCount(interp, interp->stackTrace);
5794 interp->stackTrace = Jim_DuplicateObj(interp, interp->stackTrace);
5795 Jim_IncrRefCount(interp->stackTrace);
5798 /* If we have no procname but the previous element did, merge with that frame */
5799 if (!*procname && Jim_Length(fileNameObj)) {
5800 /* Just a filename. Check the previous entry */
5801 int len = Jim_ListLength(interp, interp->stackTrace);
5803 if (len >= 3) {
5804 Jim_Obj *objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 3);
5805 if (Jim_Length(objPtr)) {
5806 /* Yes, the previous level had procname */
5807 objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 2);
5808 if (Jim_Length(objPtr) == 0) {
5809 /* But no filename, so merge the new info with that frame */
5810 ListSetIndex(interp, interp->stackTrace, len - 2, fileNameObj, 0);
5811 ListSetIndex(interp, interp->stackTrace, len - 1, Jim_NewIntObj(interp, linenr), 0);
5812 return;
5818 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewStringObj(interp, procname, -1));
5819 Jim_ListAppendElement(interp, interp->stackTrace, fileNameObj);
5820 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewIntObj(interp, linenr));
5823 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc * delProc,
5824 void *data)
5826 AssocDataValue *assocEntryPtr = (AssocDataValue *) Jim_Alloc(sizeof(AssocDataValue));
5828 assocEntryPtr->delProc = delProc;
5829 assocEntryPtr->data = data;
5830 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
5833 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
5835 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
5837 if (entryPtr != NULL) {
5838 AssocDataValue *assocEntryPtr = Jim_GetHashEntryVal(entryPtr);
5839 return assocEntryPtr->data;
5841 return NULL;
5844 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
5846 return Jim_DeleteHashEntry(&interp->assocData, key);
5849 int Jim_GetExitCode(Jim_Interp *interp)
5851 return interp->exitCode;
5854 /* -----------------------------------------------------------------------------
5855 * Integer object
5856 * ---------------------------------------------------------------------------*/
5857 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
5858 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
5860 static const Jim_ObjType intObjType = {
5861 "int",
5862 NULL,
5863 NULL,
5864 UpdateStringOfInt,
5865 JIM_TYPE_NONE,
5868 /* A coerced double is closer to an int than a double.
5869 * It is an int value temporarily masquerading as a double value.
5870 * i.e. it has the same string value as an int and Jim_GetWide()
5871 * succeeds, but also Jim_GetDouble() returns the value directly.
5873 static const Jim_ObjType coercedDoubleObjType = {
5874 "coerced-double",
5875 NULL,
5876 NULL,
5877 UpdateStringOfInt,
5878 JIM_TYPE_NONE,
5882 static void UpdateStringOfInt(struct Jim_Obj *objPtr)
5884 char buf[JIM_INTEGER_SPACE + 1];
5885 jim_wide wideValue = JimWideValue(objPtr);
5886 int pos = 0;
5888 if (wideValue == 0) {
5889 buf[pos++] = '0';
5891 else {
5892 char tmp[JIM_INTEGER_SPACE];
5893 int num = 0;
5894 int i;
5896 if (wideValue < 0) {
5897 buf[pos++] = '-';
5898 i = wideValue % 10;
5899 /* C89 is implementation defined as to whether (-106 % 10) is -6 or 4,
5900 * whereas C99 is always -6
5901 * coverity[dead_error_line]
5903 tmp[num++] = (i > 0) ? (10 - i) : -i;
5904 wideValue /= -10;
5907 while (wideValue) {
5908 tmp[num++] = wideValue % 10;
5909 wideValue /= 10;
5912 for (i = 0; i < num; i++) {
5913 buf[pos++] = '0' + tmp[num - i - 1];
5916 buf[pos] = 0;
5918 JimSetStringBytes(objPtr, buf);
5921 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
5923 jim_wide wideValue;
5924 const char *str;
5926 if (objPtr->typePtr == &coercedDoubleObjType) {
5927 /* Simple switch */
5928 objPtr->typePtr = &intObjType;
5929 return JIM_OK;
5932 /* Get the string representation */
5933 str = Jim_String(objPtr);
5934 /* Try to convert into a jim_wide */
5935 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
5936 if (flags & JIM_ERRMSG) {
5937 Jim_SetResultFormatted(interp, "expected integer but got \"%#s\"", objPtr);
5939 return JIM_ERR;
5941 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) && errno == ERANGE) {
5942 Jim_SetResultString(interp, "Integer value too big to be represented", -1);
5943 return JIM_ERR;
5945 /* Free the old internal repr and set the new one. */
5946 Jim_FreeIntRep(interp, objPtr);
5947 objPtr->typePtr = &intObjType;
5948 objPtr->internalRep.wideValue = wideValue;
5949 return JIM_OK;
5952 #ifdef JIM_OPTIMIZATION
5953 static int JimIsWide(Jim_Obj *objPtr)
5955 return objPtr->typePtr == &intObjType;
5957 #endif
5959 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5961 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
5962 return JIM_ERR;
5963 *widePtr = JimWideValue(objPtr);
5964 return JIM_OK;
5967 /* Get a wide but does not set an error if the format is bad. */
5968 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5970 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
5971 return JIM_ERR;
5972 *widePtr = JimWideValue(objPtr);
5973 return JIM_OK;
5976 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
5978 jim_wide wideValue;
5979 int retval;
5981 retval = Jim_GetWide(interp, objPtr, &wideValue);
5982 if (retval == JIM_OK) {
5983 *longPtr = (long)wideValue;
5984 return JIM_OK;
5986 return JIM_ERR;
5989 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
5991 Jim_Obj *objPtr;
5993 objPtr = Jim_NewObj(interp);
5994 objPtr->typePtr = &intObjType;
5995 objPtr->bytes = NULL;
5996 objPtr->internalRep.wideValue = wideValue;
5997 return objPtr;
6000 /* -----------------------------------------------------------------------------
6001 * Double object
6002 * ---------------------------------------------------------------------------*/
6003 #define JIM_DOUBLE_SPACE 30
6005 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
6006 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
6008 static const Jim_ObjType doubleObjType = {
6009 "double",
6010 NULL,
6011 NULL,
6012 UpdateStringOfDouble,
6013 JIM_TYPE_NONE,
6016 #ifndef HAVE_ISNAN
6017 #undef isnan
6018 #define isnan(X) ((X) != (X))
6019 #endif
6020 #ifndef HAVE_ISINF
6021 #undef isinf
6022 #define isinf(X) (1.0 / (X) == 0.0)
6023 #endif
6025 static void UpdateStringOfDouble(struct Jim_Obj *objPtr)
6027 double value = objPtr->internalRep.doubleValue;
6029 if (isnan(value)) {
6030 JimSetStringBytes(objPtr, "NaN");
6031 return;
6033 if (isinf(value)) {
6034 if (value < 0) {
6035 JimSetStringBytes(objPtr, "-Inf");
6037 else {
6038 JimSetStringBytes(objPtr, "Inf");
6040 return;
6043 char buf[JIM_DOUBLE_SPACE + 1];
6044 int i;
6045 int len = sprintf(buf, "%.12g", value);
6047 /* Add a final ".0" if necessary */
6048 for (i = 0; i < len; i++) {
6049 if (buf[i] == '.' || buf[i] == 'e') {
6050 #if defined(JIM_SPRINTF_DOUBLE_NEEDS_FIX)
6051 /* If 'buf' ends in e-0nn or e+0nn, remove
6052 * the 0 after the + or - and reduce the length by 1
6054 char *e = strchr(buf, 'e');
6055 if (e && (e[1] == '-' || e[1] == '+') && e[2] == '0') {
6056 /* Move it up */
6057 e += 2;
6058 memmove(e, e + 1, len - (e - buf));
6060 #endif
6061 break;
6064 if (buf[i] == '\0') {
6065 buf[i++] = '.';
6066 buf[i++] = '0';
6067 buf[i] = '\0';
6069 JimSetStringBytes(objPtr, buf);
6073 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6075 double doubleValue;
6076 jim_wide wideValue;
6077 const char *str;
6079 #ifdef HAVE_LONG_LONG
6080 /* Assume a 53 bit mantissa */
6081 #define MIN_INT_IN_DOUBLE -(1LL << 53)
6082 #define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1)
6084 if (objPtr->typePtr == &intObjType
6085 && JimWideValue(objPtr) >= MIN_INT_IN_DOUBLE
6086 && JimWideValue(objPtr) <= MAX_INT_IN_DOUBLE) {
6088 /* Direct conversion to coerced double */
6089 objPtr->typePtr = &coercedDoubleObjType;
6090 return JIM_OK;
6092 #endif
6093 /* Preserve the string representation.
6094 * Needed so we can convert back to int without loss
6096 str = Jim_String(objPtr);
6098 if (Jim_StringToWide(str, &wideValue, 10) == JIM_OK) {
6099 /* Managed to convert to an int, so we can use this as a cooerced double */
6100 Jim_FreeIntRep(interp, objPtr);
6101 objPtr->typePtr = &coercedDoubleObjType;
6102 objPtr->internalRep.wideValue = wideValue;
6103 return JIM_OK;
6105 else {
6106 /* Try to convert into a double */
6107 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
6108 Jim_SetResultFormatted(interp, "expected floating-point number but got \"%#s\"", objPtr);
6109 return JIM_ERR;
6111 /* Free the old internal repr and set the new one. */
6112 Jim_FreeIntRep(interp, objPtr);
6114 objPtr->typePtr = &doubleObjType;
6115 objPtr->internalRep.doubleValue = doubleValue;
6116 return JIM_OK;
6119 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
6121 if (objPtr->typePtr == &coercedDoubleObjType) {
6122 *doublePtr = JimWideValue(objPtr);
6123 return JIM_OK;
6125 if (objPtr->typePtr != &doubleObjType && SetDoubleFromAny(interp, objPtr) == JIM_ERR)
6126 return JIM_ERR;
6128 if (objPtr->typePtr == &coercedDoubleObjType) {
6129 *doublePtr = JimWideValue(objPtr);
6131 else {
6132 *doublePtr = objPtr->internalRep.doubleValue;
6134 return JIM_OK;
6137 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
6139 Jim_Obj *objPtr;
6141 objPtr = Jim_NewObj(interp);
6142 objPtr->typePtr = &doubleObjType;
6143 objPtr->bytes = NULL;
6144 objPtr->internalRep.doubleValue = doubleValue;
6145 return objPtr;
6148 /* -----------------------------------------------------------------------------
6149 * Boolean conversion
6150 * ---------------------------------------------------------------------------*/
6151 static int SetBooleanFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
6153 int Jim_GetBoolean(Jim_Interp *interp, Jim_Obj *objPtr, int * booleanPtr)
6155 if (objPtr->typePtr != &intObjType && SetBooleanFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
6156 return JIM_ERR;
6157 *booleanPtr = (int) JimWideValue(objPtr);
6158 return JIM_OK;
6161 static int SetBooleanFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
6163 static const char * const falses[] = {
6164 "0", "false", "no", "off", NULL
6166 static const char * const trues[] = {
6167 "1", "true", "yes", "on", NULL
6170 int boolean;
6172 int index;
6173 if (Jim_GetEnum(interp, objPtr, falses, &index, NULL, 0) == JIM_OK) {
6174 boolean = 0;
6175 } else if (Jim_GetEnum(interp, objPtr, trues, &index, NULL, 0) == JIM_OK) {
6176 boolean = 1;
6177 } else {
6178 if (flags & JIM_ERRMSG) {
6179 Jim_SetResultFormatted(interp, "expected boolean but got \"%#s\"", objPtr);
6181 return JIM_ERR;
6184 /* Free the old internal repr and set the new one. */
6185 Jim_FreeIntRep(interp, objPtr);
6186 objPtr->typePtr = &intObjType;
6187 objPtr->internalRep.wideValue = boolean;
6188 return JIM_OK;
6191 /* -----------------------------------------------------------------------------
6192 * List object
6193 * ---------------------------------------------------------------------------*/
6194 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec);
6195 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
6196 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6197 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6198 static void UpdateStringOfList(struct Jim_Obj *objPtr);
6199 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6201 /* Note that while the elements of the list may contain references,
6202 * the list object itself can't. This basically means that the
6203 * list object string representation as a whole can't contain references
6204 * that are not presents in the single elements. */
6205 static const Jim_ObjType listObjType = {
6206 "list",
6207 FreeListInternalRep,
6208 DupListInternalRep,
6209 UpdateStringOfList,
6210 JIM_TYPE_NONE,
6213 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6215 int i;
6217 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
6218 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
6220 Jim_Free(objPtr->internalRep.listValue.ele);
6223 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6225 int i;
6227 JIM_NOTUSED(interp);
6229 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
6230 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
6231 dupPtr->internalRep.listValue.ele =
6232 Jim_Alloc(sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.maxLen);
6233 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
6234 sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.len);
6235 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
6236 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
6238 dupPtr->typePtr = &listObjType;
6241 /* The following function checks if a given string can be encoded
6242 * into a list element without any kind of quoting, surrounded by braces,
6243 * or using escapes to quote. */
6244 #define JIM_ELESTR_SIMPLE 0
6245 #define JIM_ELESTR_BRACE 1
6246 #define JIM_ELESTR_QUOTE 2
6247 static unsigned char ListElementQuotingType(const char *s, int len)
6249 int i, level, blevel, trySimple = 1;
6251 /* Try with the SIMPLE case */
6252 if (len == 0)
6253 return JIM_ELESTR_BRACE;
6254 if (s[0] == '"' || s[0] == '{') {
6255 trySimple = 0;
6256 goto testbrace;
6258 for (i = 0; i < len; i++) {
6259 switch (s[i]) {
6260 case ' ':
6261 case '$':
6262 case '"':
6263 case '[':
6264 case ']':
6265 case ';':
6266 case '\\':
6267 case '\r':
6268 case '\n':
6269 case '\t':
6270 case '\f':
6271 case '\v':
6272 trySimple = 0;
6273 /* fall through */
6274 case '{':
6275 case '}':
6276 goto testbrace;
6279 return JIM_ELESTR_SIMPLE;
6281 testbrace:
6282 /* Test if it's possible to do with braces */
6283 if (s[len - 1] == '\\')
6284 return JIM_ELESTR_QUOTE;
6285 level = 0;
6286 blevel = 0;
6287 for (i = 0; i < len; i++) {
6288 switch (s[i]) {
6289 case '{':
6290 level++;
6291 break;
6292 case '}':
6293 level--;
6294 if (level < 0)
6295 return JIM_ELESTR_QUOTE;
6296 break;
6297 case '[':
6298 blevel++;
6299 break;
6300 case ']':
6301 blevel--;
6302 break;
6303 case '\\':
6304 if (s[i + 1] == '\n')
6305 return JIM_ELESTR_QUOTE;
6306 else if (s[i + 1] != '\0')
6307 i++;
6308 break;
6311 if (blevel < 0) {
6312 return JIM_ELESTR_QUOTE;
6315 if (level == 0) {
6316 if (!trySimple)
6317 return JIM_ELESTR_BRACE;
6318 for (i = 0; i < len; i++) {
6319 switch (s[i]) {
6320 case ' ':
6321 case '$':
6322 case '"':
6323 case '[':
6324 case ']':
6325 case ';':
6326 case '\\':
6327 case '\r':
6328 case '\n':
6329 case '\t':
6330 case '\f':
6331 case '\v':
6332 return JIM_ELESTR_BRACE;
6333 break;
6336 return JIM_ELESTR_SIMPLE;
6338 return JIM_ELESTR_QUOTE;
6341 /* Backslashes-escapes the null-terminated string 's' into the buffer at 'q'
6342 * The buffer must be at least strlen(s) * 2 + 1 bytes long for the worst-case
6343 * scenario.
6344 * Returns the length of the result.
6346 static int BackslashQuoteString(const char *s, int len, char *q)
6348 char *p = q;
6350 while (len--) {
6351 switch (*s) {
6352 case ' ':
6353 case '$':
6354 case '"':
6355 case '[':
6356 case ']':
6357 case '{':
6358 case '}':
6359 case ';':
6360 case '\\':
6361 *p++ = '\\';
6362 *p++ = *s++;
6363 break;
6364 case '\n':
6365 *p++ = '\\';
6366 *p++ = 'n';
6367 s++;
6368 break;
6369 case '\r':
6370 *p++ = '\\';
6371 *p++ = 'r';
6372 s++;
6373 break;
6374 case '\t':
6375 *p++ = '\\';
6376 *p++ = 't';
6377 s++;
6378 break;
6379 case '\f':
6380 *p++ = '\\';
6381 *p++ = 'f';
6382 s++;
6383 break;
6384 case '\v':
6385 *p++ = '\\';
6386 *p++ = 'v';
6387 s++;
6388 break;
6389 default:
6390 *p++ = *s++;
6391 break;
6394 *p = '\0';
6396 return p - q;
6399 static void JimMakeListStringRep(Jim_Obj *objPtr, Jim_Obj **objv, int objc)
6401 #define STATIC_QUOTING_LEN 32
6402 int i, bufLen, realLength;
6403 const char *strRep;
6404 char *p;
6405 unsigned char *quotingType, staticQuoting[STATIC_QUOTING_LEN];
6407 /* Estimate the space needed. */
6408 if (objc > STATIC_QUOTING_LEN) {
6409 quotingType = Jim_Alloc(objc);
6411 else {
6412 quotingType = staticQuoting;
6414 bufLen = 0;
6415 for (i = 0; i < objc; i++) {
6416 int len;
6418 strRep = Jim_GetString(objv[i], &len);
6419 quotingType[i] = ListElementQuotingType(strRep, len);
6420 switch (quotingType[i]) {
6421 case JIM_ELESTR_SIMPLE:
6422 if (i != 0 || strRep[0] != '#') {
6423 bufLen += len;
6424 break;
6426 /* Special case '#' on first element needs braces */
6427 quotingType[i] = JIM_ELESTR_BRACE;
6428 /* fall through */
6429 case JIM_ELESTR_BRACE:
6430 bufLen += len + 2;
6431 break;
6432 case JIM_ELESTR_QUOTE:
6433 bufLen += len * 2;
6434 break;
6436 bufLen++; /* elements separator. */
6438 bufLen++;
6440 /* Generate the string rep. */
6441 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
6442 realLength = 0;
6443 for (i = 0; i < objc; i++) {
6444 int len, qlen;
6446 strRep = Jim_GetString(objv[i], &len);
6448 switch (quotingType[i]) {
6449 case JIM_ELESTR_SIMPLE:
6450 memcpy(p, strRep, len);
6451 p += len;
6452 realLength += len;
6453 break;
6454 case JIM_ELESTR_BRACE:
6455 *p++ = '{';
6456 memcpy(p, strRep, len);
6457 p += len;
6458 *p++ = '}';
6459 realLength += len + 2;
6460 break;
6461 case JIM_ELESTR_QUOTE:
6462 if (i == 0 && strRep[0] == '#') {
6463 *p++ = '\\';
6464 realLength++;
6466 qlen = BackslashQuoteString(strRep, len, p);
6467 p += qlen;
6468 realLength += qlen;
6469 break;
6471 /* Add a separating space */
6472 if (i + 1 != objc) {
6473 *p++ = ' ';
6474 realLength++;
6477 *p = '\0'; /* nul term. */
6478 objPtr->length = realLength;
6480 if (quotingType != staticQuoting) {
6481 Jim_Free(quotingType);
6485 static void UpdateStringOfList(struct Jim_Obj *objPtr)
6487 JimMakeListStringRep(objPtr, objPtr->internalRep.listValue.ele, objPtr->internalRep.listValue.len);
6490 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6492 struct JimParserCtx parser;
6493 const char *str;
6494 int strLen;
6495 Jim_Obj *fileNameObj;
6496 int linenr;
6498 if (objPtr->typePtr == &listObjType) {
6499 return JIM_OK;
6502 /* Optimise dict -> list for object with no string rep. Note that this may only save a little time, but
6503 * it also preserves any source location of the dict elements
6504 * which can be very useful
6506 if (Jim_IsDict(objPtr) && objPtr->bytes == NULL) {
6507 Jim_Obj **listObjPtrPtr;
6508 int len;
6509 int i;
6511 listObjPtrPtr = JimDictPairs(objPtr, &len);
6512 for (i = 0; i < len; i++) {
6513 Jim_IncrRefCount(listObjPtrPtr[i]);
6516 /* Now just switch the internal rep */
6517 Jim_FreeIntRep(interp, objPtr);
6518 objPtr->typePtr = &listObjType;
6519 objPtr->internalRep.listValue.len = len;
6520 objPtr->internalRep.listValue.maxLen = len;
6521 objPtr->internalRep.listValue.ele = listObjPtrPtr;
6523 return JIM_OK;
6526 /* Try to preserve information about filename / line number */
6527 if (objPtr->typePtr == &sourceObjType) {
6528 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
6529 linenr = objPtr->internalRep.sourceValue.lineNumber;
6531 else {
6532 fileNameObj = interp->emptyObj;
6533 linenr = 1;
6535 Jim_IncrRefCount(fileNameObj);
6537 /* Get the string representation */
6538 str = Jim_GetString(objPtr, &strLen);
6540 /* Free the old internal repr just now and initialize the
6541 * new one just now. The string->list conversion can't fail. */
6542 Jim_FreeIntRep(interp, objPtr);
6543 objPtr->typePtr = &listObjType;
6544 objPtr->internalRep.listValue.len = 0;
6545 objPtr->internalRep.listValue.maxLen = 0;
6546 objPtr->internalRep.listValue.ele = NULL;
6548 /* Convert into a list */
6549 if (strLen) {
6550 JimParserInit(&parser, str, strLen, linenr);
6551 while (!parser.eof) {
6552 Jim_Obj *elementPtr;
6554 JimParseList(&parser);
6555 if (parser.tt != JIM_TT_STR && parser.tt != JIM_TT_ESC)
6556 continue;
6557 elementPtr = JimParserGetTokenObj(interp, &parser);
6558 JimSetSourceInfo(interp, elementPtr, fileNameObj, parser.tline);
6559 ListAppendElement(objPtr, elementPtr);
6562 Jim_DecrRefCount(interp, fileNameObj);
6563 return JIM_OK;
6566 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
6568 Jim_Obj *objPtr;
6570 objPtr = Jim_NewObj(interp);
6571 objPtr->typePtr = &listObjType;
6572 objPtr->bytes = NULL;
6573 objPtr->internalRep.listValue.ele = NULL;
6574 objPtr->internalRep.listValue.len = 0;
6575 objPtr->internalRep.listValue.maxLen = 0;
6577 if (len) {
6578 ListInsertElements(objPtr, 0, len, elements);
6581 return objPtr;
6584 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
6585 * length of the vector. Note that the user of this function should make
6586 * sure that the list object can't shimmer while the vector returned
6587 * is in use, this vector is the one stored inside the internal representation
6588 * of the list object. This function is not exported, extensions should
6589 * always access to the List object elements using Jim_ListIndex(). */
6590 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *listLen,
6591 Jim_Obj ***listVec)
6593 *listLen = Jim_ListLength(interp, listObj);
6594 *listVec = listObj->internalRep.listValue.ele;
6597 /* Sorting uses ints, but commands may return wide */
6598 static int JimSign(jim_wide w)
6600 if (w == 0) {
6601 return 0;
6603 else if (w < 0) {
6604 return -1;
6606 return 1;
6609 /* ListSortElements type values */
6610 struct lsort_info {
6611 jmp_buf jmpbuf;
6612 Jim_Obj *command;
6613 Jim_Interp *interp;
6614 enum {
6615 JIM_LSORT_ASCII,
6616 JIM_LSORT_NOCASE,
6617 JIM_LSORT_INTEGER,
6618 JIM_LSORT_REAL,
6619 JIM_LSORT_COMMAND
6620 } type;
6621 int order;
6622 int index;
6623 int indexed;
6624 int unique;
6625 int (*subfn)(Jim_Obj **, Jim_Obj **);
6628 static struct lsort_info *sort_info;
6630 static int ListSortIndexHelper(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6632 Jim_Obj *lObj, *rObj;
6634 if (Jim_ListIndex(sort_info->interp, *lhsObj, sort_info->index, &lObj, JIM_ERRMSG) != JIM_OK ||
6635 Jim_ListIndex(sort_info->interp, *rhsObj, sort_info->index, &rObj, JIM_ERRMSG) != JIM_OK) {
6636 longjmp(sort_info->jmpbuf, JIM_ERR);
6638 return sort_info->subfn(&lObj, &rObj);
6641 /* Sort the internal rep of a list. */
6642 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6644 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 0) * sort_info->order;
6647 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6649 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 1) * sort_info->order;
6652 static int ListSortInteger(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6654 jim_wide lhs = 0, rhs = 0;
6656 if (Jim_GetWide(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6657 Jim_GetWide(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6658 longjmp(sort_info->jmpbuf, JIM_ERR);
6661 return JimSign(lhs - rhs) * sort_info->order;
6664 static int ListSortReal(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6666 double lhs = 0, rhs = 0;
6668 if (Jim_GetDouble(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6669 Jim_GetDouble(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6670 longjmp(sort_info->jmpbuf, JIM_ERR);
6672 if (lhs == rhs) {
6673 return 0;
6675 if (lhs > rhs) {
6676 return sort_info->order;
6678 return -sort_info->order;
6681 static int ListSortCommand(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6683 Jim_Obj *compare_script;
6684 int rc;
6686 jim_wide ret = 0;
6688 /* This must be a valid list */
6689 compare_script = Jim_DuplicateObj(sort_info->interp, sort_info->command);
6690 Jim_ListAppendElement(sort_info->interp, compare_script, *lhsObj);
6691 Jim_ListAppendElement(sort_info->interp, compare_script, *rhsObj);
6693 rc = Jim_EvalObj(sort_info->interp, compare_script);
6695 if (rc != JIM_OK || Jim_GetWide(sort_info->interp, Jim_GetResult(sort_info->interp), &ret) != JIM_OK) {
6696 longjmp(sort_info->jmpbuf, rc);
6699 return JimSign(ret) * sort_info->order;
6702 /* Remove duplicate elements from the (sorted) list in-place, according to the
6703 * comparison function, comp.
6705 * Note that the last unique value is kept, not the first
6707 static void ListRemoveDuplicates(Jim_Obj *listObjPtr, int (*comp)(Jim_Obj **lhs, Jim_Obj **rhs))
6709 int src;
6710 int dst = 0;
6711 Jim_Obj **ele = listObjPtr->internalRep.listValue.ele;
6713 for (src = 1; src < listObjPtr->internalRep.listValue.len; src++) {
6714 if (comp(&ele[dst], &ele[src]) == 0) {
6715 /* Match, so replace the dest with the current source */
6716 Jim_DecrRefCount(sort_info->interp, ele[dst]);
6718 else {
6719 /* No match, so keep the current source and move to the next destination */
6720 dst++;
6722 ele[dst] = ele[src];
6725 /* At end of list, keep the final element unless all elements were kept */
6726 dst++;
6727 if (dst < listObjPtr->internalRep.listValue.len) {
6728 ele[dst] = ele[src];
6731 /* Set the new length */
6732 listObjPtr->internalRep.listValue.len = dst;
6735 /* Sort a list *in place*. MUST be called with a non-shared list. */
6736 static int ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, struct lsort_info *info)
6738 struct lsort_info *prev_info;
6740 typedef int (qsort_comparator) (const void *, const void *);
6741 int (*fn) (Jim_Obj **, Jim_Obj **);
6742 Jim_Obj **vector;
6743 int len;
6744 int rc;
6746 JimPanic((Jim_IsShared(listObjPtr), "ListSortElements called with shared object"));
6747 SetListFromAny(interp, listObjPtr);
6749 /* Allow lsort to be called reentrantly */
6750 prev_info = sort_info;
6751 sort_info = info;
6753 vector = listObjPtr->internalRep.listValue.ele;
6754 len = listObjPtr->internalRep.listValue.len;
6755 switch (info->type) {
6756 case JIM_LSORT_ASCII:
6757 fn = ListSortString;
6758 break;
6759 case JIM_LSORT_NOCASE:
6760 fn = ListSortStringNoCase;
6761 break;
6762 case JIM_LSORT_INTEGER:
6763 fn = ListSortInteger;
6764 break;
6765 case JIM_LSORT_REAL:
6766 fn = ListSortReal;
6767 break;
6768 case JIM_LSORT_COMMAND:
6769 fn = ListSortCommand;
6770 break;
6771 default:
6772 fn = NULL; /* avoid warning */
6773 JimPanic((1, "ListSort called with invalid sort type"));
6774 return -1; /* Should not be run but keeps static analysers happy */
6777 if (info->indexed) {
6778 /* Need to interpose a "list index" function */
6779 info->subfn = fn;
6780 fn = ListSortIndexHelper;
6783 if ((rc = setjmp(info->jmpbuf)) == 0) {
6784 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *) fn);
6786 if (info->unique && len > 1) {
6787 ListRemoveDuplicates(listObjPtr, fn);
6790 Jim_InvalidateStringRep(listObjPtr);
6792 sort_info = prev_info;
6794 return rc;
6797 /* This is the low-level function to insert elements into a list.
6798 * The higher-level Jim_ListInsertElements() performs shared object
6799 * check and invalidates the string repr. This version is used
6800 * in the internals of the List Object and is not exported.
6802 * NOTE: this function can be called only against objects
6803 * with internal type of List.
6805 * An insertion point (idx) of -1 means end-of-list.
6807 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec)
6809 int currentLen = listPtr->internalRep.listValue.len;
6810 int requiredLen = currentLen + elemc;
6811 int i;
6812 Jim_Obj **point;
6814 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
6815 if (requiredLen < 2) {
6816 /* Don't do allocations of under 4 pointers. */
6817 requiredLen = 4;
6819 else {
6820 requiredLen *= 2;
6823 listPtr->internalRep.listValue.ele = Jim_Realloc(listPtr->internalRep.listValue.ele,
6824 sizeof(Jim_Obj *) * requiredLen);
6826 listPtr->internalRep.listValue.maxLen = requiredLen;
6828 if (idx < 0) {
6829 idx = currentLen;
6831 point = listPtr->internalRep.listValue.ele + idx;
6832 memmove(point + elemc, point, (currentLen - idx) * sizeof(Jim_Obj *));
6833 for (i = 0; i < elemc; ++i) {
6834 point[i] = elemVec[i];
6835 Jim_IncrRefCount(point[i]);
6837 listPtr->internalRep.listValue.len += elemc;
6840 /* Convenience call to ListInsertElements() to append a single element.
6842 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
6844 ListInsertElements(listPtr, -1, 1, &objPtr);
6847 /* Appends every element of appendListPtr into listPtr.
6848 * Both have to be of the list type.
6849 * Convenience call to ListInsertElements()
6851 static void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6853 ListInsertElements(listPtr, -1,
6854 appendListPtr->internalRep.listValue.len, appendListPtr->internalRep.listValue.ele);
6857 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
6859 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendElement called with shared object"));
6860 SetListFromAny(interp, listPtr);
6861 Jim_InvalidateStringRep(listPtr);
6862 ListAppendElement(listPtr, objPtr);
6865 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6867 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendList called with shared object"));
6868 SetListFromAny(interp, listPtr);
6869 SetListFromAny(interp, appendListPtr);
6870 Jim_InvalidateStringRep(listPtr);
6871 ListAppendList(listPtr, appendListPtr);
6874 int Jim_ListLength(Jim_Interp *interp, Jim_Obj *objPtr)
6876 SetListFromAny(interp, objPtr);
6877 return objPtr->internalRep.listValue.len;
6880 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6881 int objc, Jim_Obj *const *objVec)
6883 JimPanic((Jim_IsShared(listPtr), "Jim_ListInsertElement called with shared object"));
6884 SetListFromAny(interp, listPtr);
6885 if (idx >= 0 && idx > listPtr->internalRep.listValue.len)
6886 idx = listPtr->internalRep.listValue.len;
6887 else if (idx < 0)
6888 idx = 0;
6889 Jim_InvalidateStringRep(listPtr);
6890 ListInsertElements(listPtr, idx, objc, objVec);
6893 Jim_Obj *Jim_ListGetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx)
6895 SetListFromAny(interp, listPtr);
6896 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6897 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6898 return NULL;
6900 if (idx < 0)
6901 idx = listPtr->internalRep.listValue.len + idx;
6902 return listPtr->internalRep.listValue.ele[idx];
6905 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx, Jim_Obj **objPtrPtr, int flags)
6907 *objPtrPtr = Jim_ListGetIndex(interp, listPtr, idx);
6908 if (*objPtrPtr == NULL) {
6909 if (flags & JIM_ERRMSG) {
6910 Jim_SetResultString(interp, "list index out of range", -1);
6912 return JIM_ERR;
6914 return JIM_OK;
6917 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6918 Jim_Obj *newObjPtr, int flags)
6920 SetListFromAny(interp, listPtr);
6921 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6922 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6923 if (flags & JIM_ERRMSG) {
6924 Jim_SetResultString(interp, "list index out of range", -1);
6926 return JIM_ERR;
6928 if (idx < 0)
6929 idx = listPtr->internalRep.listValue.len + idx;
6930 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[idx]);
6931 listPtr->internalRep.listValue.ele[idx] = newObjPtr;
6932 Jim_IncrRefCount(newObjPtr);
6933 return JIM_OK;
6936 /* Modify the list stored in the variable named 'varNamePtr'
6937 * setting the element specified by the 'indexc' indexes objects in 'indexv',
6938 * with the new element 'newObjptr'. (implements the [lset] command) */
6939 int Jim_ListSetIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
6940 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
6942 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
6943 int shared, i, idx;
6945 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG | JIM_UNSHARED);
6946 if (objPtr == NULL)
6947 return JIM_ERR;
6948 if ((shared = Jim_IsShared(objPtr)))
6949 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
6950 for (i = 0; i < indexc - 1; i++) {
6951 listObjPtr = objPtr;
6952 if (Jim_GetIndex(interp, indexv[i], &idx) != JIM_OK)
6953 goto err;
6954 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_ERRMSG) != JIM_OK) {
6955 goto err;
6957 if (Jim_IsShared(objPtr)) {
6958 objPtr = Jim_DuplicateObj(interp, objPtr);
6959 ListSetIndex(interp, listObjPtr, idx, objPtr, JIM_NONE);
6961 Jim_InvalidateStringRep(listObjPtr);
6963 if (Jim_GetIndex(interp, indexv[indexc - 1], &idx) != JIM_OK)
6964 goto err;
6965 if (ListSetIndex(interp, objPtr, idx, newObjPtr, JIM_ERRMSG) == JIM_ERR)
6966 goto err;
6967 Jim_InvalidateStringRep(objPtr);
6968 Jim_InvalidateStringRep(varObjPtr);
6969 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
6970 goto err;
6971 Jim_SetResult(interp, varObjPtr);
6972 return JIM_OK;
6973 err:
6974 if (shared) {
6975 Jim_FreeNewObj(interp, varObjPtr);
6977 return JIM_ERR;
6980 Jim_Obj *Jim_ListJoin(Jim_Interp *interp, Jim_Obj *listObjPtr, const char *joinStr, int joinStrLen)
6982 int i;
6983 int listLen = Jim_ListLength(interp, listObjPtr);
6984 Jim_Obj *resObjPtr = Jim_NewEmptyStringObj(interp);
6986 for (i = 0; i < listLen; ) {
6987 Jim_AppendObj(interp, resObjPtr, Jim_ListGetIndex(interp, listObjPtr, i));
6988 if (++i != listLen) {
6989 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
6992 return resObjPtr;
6995 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
6997 int i;
6999 /* If all the objects in objv are lists,
7000 * it's possible to return a list as result, that's the
7001 * concatenation of all the lists. */
7002 for (i = 0; i < objc; i++) {
7003 if (!Jim_IsList(objv[i]))
7004 break;
7006 if (i == objc) {
7007 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
7009 for (i = 0; i < objc; i++)
7010 ListAppendList(objPtr, objv[i]);
7011 return objPtr;
7013 else {
7014 /* Else... we have to glue strings together */
7015 int len = 0, objLen;
7016 char *bytes, *p;
7018 /* Compute the length */
7019 for (i = 0; i < objc; i++) {
7020 len += Jim_Length(objv[i]);
7022 if (objc)
7023 len += objc - 1;
7024 /* Create the string rep, and a string object holding it. */
7025 p = bytes = Jim_Alloc(len + 1);
7026 for (i = 0; i < objc; i++) {
7027 const char *s = Jim_GetString(objv[i], &objLen);
7029 /* Remove leading space */
7030 while (objLen && isspace(UCHAR(*s))) {
7031 s++;
7032 objLen--;
7033 len--;
7035 /* And trailing space */
7036 while (objLen && isspace(UCHAR(s[objLen - 1]))) {
7037 /* Handle trailing backslash-space case */
7038 if (objLen > 1 && s[objLen - 2] == '\\') {
7039 break;
7041 objLen--;
7042 len--;
7044 memcpy(p, s, objLen);
7045 p += objLen;
7046 if (i + 1 != objc) {
7047 if (objLen)
7048 *p++ = ' ';
7049 else {
7050 /* Drop the space calculated for this
7051 * element that is instead null. */
7052 len--;
7056 *p = '\0';
7057 return Jim_NewStringObjNoAlloc(interp, bytes, len);
7061 /* Returns a list composed of the elements in the specified range.
7062 * first and start are directly accepted as Jim_Objects and
7063 * processed for the end?-index? case. */
7064 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr,
7065 Jim_Obj *lastObjPtr)
7067 int first, last;
7068 int len, rangeLen;
7070 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
7071 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
7072 return NULL;
7073 len = Jim_ListLength(interp, listObjPtr); /* will convert into list */
7074 first = JimRelToAbsIndex(len, first);
7075 last = JimRelToAbsIndex(len, last);
7076 JimRelToAbsRange(len, &first, &last, &rangeLen);
7077 if (first == 0 && last == len) {
7078 return listObjPtr;
7080 return Jim_NewListObj(interp, listObjPtr->internalRep.listValue.ele + first, rangeLen);
7083 /* -----------------------------------------------------------------------------
7084 * Dict object
7085 * ---------------------------------------------------------------------------*/
7086 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
7087 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
7088 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
7089 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7091 /* Dict HashTable Type.
7093 * Keys and Values are Jim objects. */
7095 static unsigned int JimObjectHTHashFunction(const void *key)
7097 int len;
7098 const char *str = Jim_GetString((Jim_Obj *)key, &len);
7099 return Jim_GenHashFunction((const unsigned char *)str, len);
7102 static int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
7104 return Jim_StringEqObj((Jim_Obj *)key1, (Jim_Obj *)key2);
7107 static void *JimObjectHTKeyValDup(void *privdata, const void *val)
7109 Jim_IncrRefCount((Jim_Obj *)val);
7110 return (void *)val;
7113 static void JimObjectHTKeyValDestructor(void *interp, void *val)
7115 Jim_DecrRefCount(interp, (Jim_Obj *)val);
7118 static const Jim_HashTableType JimDictHashTableType = {
7119 JimObjectHTHashFunction, /* hash function */
7120 JimObjectHTKeyValDup, /* key dup */
7121 JimObjectHTKeyValDup, /* val dup */
7122 JimObjectHTKeyCompare, /* key compare */
7123 JimObjectHTKeyValDestructor, /* key destructor */
7124 JimObjectHTKeyValDestructor /* val destructor */
7127 /* Note that while the elements of the dict may contain references,
7128 * the list object itself can't. This basically means that the
7129 * dict object string representation as a whole can't contain references
7130 * that are not presents in the single elements. */
7131 static const Jim_ObjType dictObjType = {
7132 "dict",
7133 FreeDictInternalRep,
7134 DupDictInternalRep,
7135 UpdateStringOfDict,
7136 JIM_TYPE_NONE,
7139 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
7141 JIM_NOTUSED(interp);
7143 Jim_FreeHashTable(objPtr->internalRep.ptr);
7144 Jim_Free(objPtr->internalRep.ptr);
7147 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
7149 Jim_HashTable *ht, *dupHt;
7150 Jim_HashTableIterator htiter;
7151 Jim_HashEntry *he;
7153 /* Create a new hash table */
7154 ht = srcPtr->internalRep.ptr;
7155 dupHt = Jim_Alloc(sizeof(*dupHt));
7156 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
7157 if (ht->size != 0)
7158 Jim_ExpandHashTable(dupHt, ht->size);
7159 /* Copy every element from the source to the dup hash table */
7160 JimInitHashTableIterator(ht, &htiter);
7161 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7162 Jim_AddHashEntry(dupHt, he->key, he->u.val);
7165 dupPtr->internalRep.ptr = dupHt;
7166 dupPtr->typePtr = &dictObjType;
7169 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len)
7171 Jim_HashTable *ht;
7172 Jim_HashTableIterator htiter;
7173 Jim_HashEntry *he;
7174 Jim_Obj **objv;
7175 int i;
7177 ht = dictPtr->internalRep.ptr;
7179 /* Turn the hash table into a flat vector of Jim_Objects. */
7180 objv = Jim_Alloc((ht->used * 2) * sizeof(Jim_Obj *));
7181 JimInitHashTableIterator(ht, &htiter);
7182 i = 0;
7183 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7184 objv[i++] = Jim_GetHashEntryKey(he);
7185 objv[i++] = Jim_GetHashEntryVal(he);
7187 *len = i;
7188 return objv;
7191 static void UpdateStringOfDict(struct Jim_Obj *objPtr)
7193 /* Turn the hash table into a flat vector of Jim_Objects. */
7194 int len;
7195 Jim_Obj **objv = JimDictPairs(objPtr, &len);
7197 /* And now generate the string rep as a list */
7198 JimMakeListStringRep(objPtr, objv, len);
7200 Jim_Free(objv);
7203 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
7205 int listlen;
7207 if (objPtr->typePtr == &dictObjType) {
7208 return JIM_OK;
7211 if (Jim_IsList(objPtr) && Jim_IsShared(objPtr)) {
7212 /* A shared list, so get the string representation now to avoid
7213 * changing the order in case of fast conversion to dict.
7215 Jim_String(objPtr);
7218 /* For simplicity, convert a non-list object to a list and then to a dict */
7219 listlen = Jim_ListLength(interp, objPtr);
7220 if (listlen % 2) {
7221 Jim_SetResultString(interp, "missing value to go with key", -1);
7222 return JIM_ERR;
7224 else {
7225 /* Converting from a list to a dict can't fail */
7226 Jim_HashTable *ht;
7227 int i;
7229 ht = Jim_Alloc(sizeof(*ht));
7230 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
7232 for (i = 0; i < listlen; i += 2) {
7233 Jim_Obj *keyObjPtr = Jim_ListGetIndex(interp, objPtr, i);
7234 Jim_Obj *valObjPtr = Jim_ListGetIndex(interp, objPtr, i + 1);
7236 Jim_ReplaceHashEntry(ht, keyObjPtr, valObjPtr);
7239 Jim_FreeIntRep(interp, objPtr);
7240 objPtr->typePtr = &dictObjType;
7241 objPtr->internalRep.ptr = ht;
7243 return JIM_OK;
7247 /* Dict object API */
7249 /* Add an element to a dict. objPtr must be of the "dict" type.
7250 * The higher-level exported function is Jim_DictAddElement().
7251 * If an element with the specified key already exists, the value
7252 * associated is replaced with the new one.
7254 * if valueObjPtr == NULL, the key is instead removed if it exists. */
7255 static int DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7256 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7258 Jim_HashTable *ht = objPtr->internalRep.ptr;
7260 if (valueObjPtr == NULL) { /* unset */
7261 return Jim_DeleteHashEntry(ht, keyObjPtr);
7263 Jim_ReplaceHashEntry(ht, keyObjPtr, valueObjPtr);
7264 return JIM_OK;
7267 /* Add an element, higher-level interface for DictAddElement().
7268 * If valueObjPtr == NULL, the key is removed if it exists. */
7269 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7270 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7272 JimPanic((Jim_IsShared(objPtr), "Jim_DictAddElement called with shared object"));
7273 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
7274 return JIM_ERR;
7276 Jim_InvalidateStringRep(objPtr);
7277 return DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
7280 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
7282 Jim_Obj *objPtr;
7283 int i;
7285 JimPanic((len % 2, "Jim_NewDictObj() 'len' argument must be even"));
7287 objPtr = Jim_NewObj(interp);
7288 objPtr->typePtr = &dictObjType;
7289 objPtr->bytes = NULL;
7290 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
7291 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
7292 for (i = 0; i < len; i += 2)
7293 DictAddElement(interp, objPtr, elements[i], elements[i + 1]);
7294 return objPtr;
7297 /* Return the value associated to the specified dict key
7298 * Returns JIM_OK if OK, JIM_ERR if entry not found or -1 if can't create dict value
7300 * Sets *objPtrPtr to non-NULL only upon success.
7302 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
7303 Jim_Obj **objPtrPtr, int flags)
7305 Jim_HashEntry *he;
7306 Jim_HashTable *ht;
7308 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7309 return -1;
7311 ht = dictPtr->internalRep.ptr;
7312 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
7313 if (flags & JIM_ERRMSG) {
7314 Jim_SetResultFormatted(interp, "key \"%#s\" not known in dictionary", keyPtr);
7316 return JIM_ERR;
7318 else {
7319 *objPtrPtr = Jim_GetHashEntryVal(he);
7320 return JIM_OK;
7324 /* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */
7325 int Jim_DictPairs(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj ***objPtrPtr, int *len)
7327 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7328 return JIM_ERR;
7330 *objPtrPtr = JimDictPairs(dictPtr, len);
7332 return JIM_OK;
7336 /* Return the value associated to the specified dict keys */
7337 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
7338 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
7340 int i;
7342 if (keyc == 0) {
7343 *objPtrPtr = dictPtr;
7344 return JIM_OK;
7347 for (i = 0; i < keyc; i++) {
7348 Jim_Obj *objPtr;
7350 int rc = Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags);
7351 if (rc != JIM_OK) {
7352 return rc;
7354 dictPtr = objPtr;
7356 *objPtrPtr = dictPtr;
7357 return JIM_OK;
7360 /* Modify the dict stored into the variable named 'varNamePtr'
7361 * setting the element specified by the 'keyc' keys objects in 'keyv',
7362 * with the new value of the element 'newObjPtr'.
7364 * If newObjPtr == NULL the operation is to remove the given key
7365 * from the dictionary.
7367 * If flags & JIM_ERRMSG, then failure to remove the key is considered an error
7368 * and JIM_ERR is returned. Otherwise it is ignored and JIM_OK is returned.
7370 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
7371 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr, int flags)
7373 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
7374 int shared, i;
7376 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, flags);
7377 if (objPtr == NULL) {
7378 if (newObjPtr == NULL && (flags & JIM_MUSTEXIST)) {
7379 /* Cannot remove a key from non existing var */
7380 return JIM_ERR;
7382 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
7383 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
7384 Jim_FreeNewObj(interp, varObjPtr);
7385 return JIM_ERR;
7388 if ((shared = Jim_IsShared(objPtr)))
7389 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
7390 for (i = 0; i < keyc; i++) {
7391 dictObjPtr = objPtr;
7393 /* Check if it's a valid dictionary */
7394 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK) {
7395 goto err;
7398 if (i == keyc - 1) {
7399 /* Last key: Note that error on unset with missing last key is OK */
7400 if (Jim_DictAddElement(interp, objPtr, keyv[keyc - 1], newObjPtr) != JIM_OK) {
7401 if (newObjPtr || (flags & JIM_MUSTEXIST)) {
7402 goto err;
7405 break;
7408 /* Check if the given key exists. */
7409 Jim_InvalidateStringRep(dictObjPtr);
7410 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
7411 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK) {
7412 /* This key exists at the current level.
7413 * Make sure it's not shared!. */
7414 if (Jim_IsShared(objPtr)) {
7415 objPtr = Jim_DuplicateObj(interp, objPtr);
7416 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7419 else {
7420 /* Key not found. If it's an [unset] operation
7421 * this is an error. Only the last key may not
7422 * exist. */
7423 if (newObjPtr == NULL) {
7424 goto err;
7426 /* Otherwise set an empty dictionary
7427 * as key's value. */
7428 objPtr = Jim_NewDictObj(interp, NULL, 0);
7429 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7432 /* XXX: Is this necessary? */
7433 Jim_InvalidateStringRep(objPtr);
7434 Jim_InvalidateStringRep(varObjPtr);
7435 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK) {
7436 goto err;
7438 Jim_SetResult(interp, varObjPtr);
7439 return JIM_OK;
7440 err:
7441 if (shared) {
7442 Jim_FreeNewObj(interp, varObjPtr);
7444 return JIM_ERR;
7447 /* -----------------------------------------------------------------------------
7448 * Index object
7449 * ---------------------------------------------------------------------------*/
7450 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
7451 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7453 static const Jim_ObjType indexObjType = {
7454 "index",
7455 NULL,
7456 NULL,
7457 UpdateStringOfIndex,
7458 JIM_TYPE_NONE,
7461 static void UpdateStringOfIndex(struct Jim_Obj *objPtr)
7463 if (objPtr->internalRep.intValue == -1) {
7464 JimSetStringBytes(objPtr, "end");
7466 else {
7467 char buf[JIM_INTEGER_SPACE + 1];
7468 if (objPtr->internalRep.intValue >= 0) {
7469 sprintf(buf, "%d", objPtr->internalRep.intValue);
7471 else {
7472 /* Must be <= -2 */
7473 sprintf(buf, "end%d", objPtr->internalRep.intValue + 1);
7475 JimSetStringBytes(objPtr, buf);
7479 static int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7481 int idx, end = 0;
7482 const char *str;
7483 char *endptr;
7485 /* Get the string representation */
7486 str = Jim_String(objPtr);
7488 /* Try to convert into an index */
7489 if (strncmp(str, "end", 3) == 0) {
7490 end = 1;
7491 str += 3;
7492 idx = 0;
7494 else {
7495 idx = jim_strtol(str, &endptr);
7497 if (endptr == str) {
7498 goto badindex;
7500 str = endptr;
7503 /* Now str may include or +<num> or -<num> */
7504 if (*str == '+' || *str == '-') {
7505 int sign = (*str == '+' ? 1 : -1);
7507 idx += sign * jim_strtol(++str, &endptr);
7508 if (str == endptr || *endptr) {
7509 goto badindex;
7511 str = endptr;
7513 /* The only thing left should be spaces */
7514 while (isspace(UCHAR(*str))) {
7515 str++;
7517 if (*str) {
7518 goto badindex;
7520 if (end) {
7521 if (idx > 0) {
7522 idx = INT_MAX;
7524 else {
7525 /* end-1 is repesented as -2 */
7526 idx--;
7529 else if (idx < 0) {
7530 idx = -INT_MAX;
7533 /* Free the old internal repr and set the new one. */
7534 Jim_FreeIntRep(interp, objPtr);
7535 objPtr->typePtr = &indexObjType;
7536 objPtr->internalRep.intValue = idx;
7537 return JIM_OK;
7539 badindex:
7540 Jim_SetResultFormatted(interp,
7541 "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr);
7542 return JIM_ERR;
7545 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
7547 /* Avoid shimmering if the object is an integer. */
7548 if (objPtr->typePtr == &intObjType) {
7549 jim_wide val = JimWideValue(objPtr);
7551 if (val < 0)
7552 *indexPtr = -INT_MAX;
7553 else if (val > INT_MAX)
7554 *indexPtr = INT_MAX;
7555 else
7556 *indexPtr = (int)val;
7557 return JIM_OK;
7559 if (objPtr->typePtr != &indexObjType && SetIndexFromAny(interp, objPtr) == JIM_ERR)
7560 return JIM_ERR;
7561 *indexPtr = objPtr->internalRep.intValue;
7562 return JIM_OK;
7565 /* -----------------------------------------------------------------------------
7566 * Return Code Object.
7567 * ---------------------------------------------------------------------------*/
7569 /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
7570 static const char * const jimReturnCodes[] = {
7571 "ok",
7572 "error",
7573 "return",
7574 "break",
7575 "continue",
7576 "signal",
7577 "exit",
7578 "eval",
7579 NULL
7582 #define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes) - 1)
7584 static const Jim_ObjType returnCodeObjType = {
7585 "return-code",
7586 NULL,
7587 NULL,
7588 NULL,
7589 JIM_TYPE_NONE,
7592 /* Converts a (standard) return code to a string. Returns "?" for
7593 * non-standard return codes.
7595 const char *Jim_ReturnCode(int code)
7597 if (code < 0 || code >= (int)jimReturnCodesSize) {
7598 return "?";
7600 else {
7601 return jimReturnCodes[code];
7605 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7607 int returnCode;
7608 jim_wide wideValue;
7610 /* Try to convert into an integer */
7611 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
7612 returnCode = (int)wideValue;
7613 else if (Jim_GetEnum(interp, objPtr, jimReturnCodes, &returnCode, NULL, JIM_NONE) != JIM_OK) {
7614 Jim_SetResultFormatted(interp, "expected return code but got \"%#s\"", objPtr);
7615 return JIM_ERR;
7617 /* Free the old internal repr and set the new one. */
7618 Jim_FreeIntRep(interp, objPtr);
7619 objPtr->typePtr = &returnCodeObjType;
7620 objPtr->internalRep.intValue = returnCode;
7621 return JIM_OK;
7624 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
7626 if (objPtr->typePtr != &returnCodeObjType && SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
7627 return JIM_ERR;
7628 *intPtr = objPtr->internalRep.intValue;
7629 return JIM_OK;
7632 /* -----------------------------------------------------------------------------
7633 * Expression Parsing
7634 * ---------------------------------------------------------------------------*/
7635 static int JimParseExprOperator(struct JimParserCtx *pc);
7636 static int JimParseExprNumber(struct JimParserCtx *pc);
7637 static int JimParseExprIrrational(struct JimParserCtx *pc);
7638 static int JimParseExprBoolean(struct JimParserCtx *pc);
7640 /* expr operator opcodes. */
7641 enum
7643 /* Continues on from the JIM_TT_ space */
7645 /* Binary operators (numbers) */
7646 JIM_EXPROP_MUL = JIM_TT_EXPR_OP, /* 20 */
7647 JIM_EXPROP_DIV,
7648 JIM_EXPROP_MOD,
7649 JIM_EXPROP_SUB,
7650 JIM_EXPROP_ADD,
7651 JIM_EXPROP_LSHIFT,
7652 JIM_EXPROP_RSHIFT,
7653 JIM_EXPROP_ROTL,
7654 JIM_EXPROP_ROTR,
7655 JIM_EXPROP_LT,
7656 JIM_EXPROP_GT,
7657 JIM_EXPROP_LTE,
7658 JIM_EXPROP_GTE,
7659 JIM_EXPROP_NUMEQ,
7660 JIM_EXPROP_NUMNE,
7661 JIM_EXPROP_BITAND, /* 35 */
7662 JIM_EXPROP_BITXOR,
7663 JIM_EXPROP_BITOR,
7664 JIM_EXPROP_LOGICAND, /* 38 */
7665 JIM_EXPROP_LOGICOR, /* 39 */
7666 JIM_EXPROP_TERNARY, /* 40 */
7667 JIM_EXPROP_COLON, /* 41 */
7668 JIM_EXPROP_POW, /* 42 */
7670 /* Binary operators (strings) */
7671 JIM_EXPROP_STREQ, /* 43 */
7672 JIM_EXPROP_STRNE,
7673 JIM_EXPROP_STRIN,
7674 JIM_EXPROP_STRNI,
7676 /* Unary operators (numbers) */
7677 JIM_EXPROP_NOT, /* 47 */
7678 JIM_EXPROP_BITNOT,
7679 JIM_EXPROP_UNARYMINUS,
7680 JIM_EXPROP_UNARYPLUS,
7682 /* Functions */
7683 JIM_EXPROP_FUNC_INT, /* 51 */
7684 JIM_EXPROP_FUNC_WIDE,
7685 JIM_EXPROP_FUNC_ABS,
7686 JIM_EXPROP_FUNC_DOUBLE,
7687 JIM_EXPROP_FUNC_ROUND,
7688 JIM_EXPROP_FUNC_RAND,
7689 JIM_EXPROP_FUNC_SRAND,
7691 /* math functions from libm */
7692 JIM_EXPROP_FUNC_SIN, /* 65 */
7693 JIM_EXPROP_FUNC_COS,
7694 JIM_EXPROP_FUNC_TAN,
7695 JIM_EXPROP_FUNC_ASIN,
7696 JIM_EXPROP_FUNC_ACOS,
7697 JIM_EXPROP_FUNC_ATAN,
7698 JIM_EXPROP_FUNC_ATAN2,
7699 JIM_EXPROP_FUNC_SINH,
7700 JIM_EXPROP_FUNC_COSH,
7701 JIM_EXPROP_FUNC_TANH,
7702 JIM_EXPROP_FUNC_CEIL,
7703 JIM_EXPROP_FUNC_FLOOR,
7704 JIM_EXPROP_FUNC_EXP,
7705 JIM_EXPROP_FUNC_LOG,
7706 JIM_EXPROP_FUNC_LOG10,
7707 JIM_EXPROP_FUNC_SQRT,
7708 JIM_EXPROP_FUNC_POW,
7709 JIM_EXPROP_FUNC_HYPOT,
7710 JIM_EXPROP_FUNC_FMOD,
7713 /* A expression node is either a term or an operator
7714 * If a node is an operator, 'op' points to the details of the operator and it's terms.
7716 struct JimExprNode {
7717 int type; /* JIM_TT_xxx */
7718 struct Jim_Obj *objPtr; /* The object for a term, or NULL for an operator */
7720 struct JimExprNode *left; /* For all operators */
7721 struct JimExprNode *right; /* For binary operators */
7722 struct JimExprNode *ternary; /* For ternary operator only */
7725 /* Operators table */
7726 typedef struct Jim_ExprOperator
7728 const char *name;
7729 int (*funcop) (Jim_Interp *interp, struct JimExprNode *opnode);
7730 unsigned char precedence;
7731 unsigned char arity;
7732 unsigned char attr;
7733 unsigned char namelen;
7734 } Jim_ExprOperator;
7736 static int JimExprGetTerm(Jim_Interp *interp, struct JimExprNode *node, Jim_Obj **objPtrPtr);
7737 static int JimExprGetTermBoolean(Jim_Interp *interp, struct JimExprNode *node);
7738 static int JimExprEvalTermNode(Jim_Interp *interp, struct JimExprNode *node);
7740 static int JimExprOpNumUnary(Jim_Interp *interp, struct JimExprNode *node)
7742 int intresult = 1;
7743 int rc;
7744 double dA, dC = 0;
7745 jim_wide wA, wC = 0;
7746 Jim_Obj *A;
7748 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7749 return rc;
7752 if ((A->typePtr != &doubleObjType || A->bytes) && JimGetWideNoErr(interp, A, &wA) == JIM_OK) {
7753 switch (node->type) {
7754 case JIM_EXPROP_FUNC_INT:
7755 case JIM_EXPROP_FUNC_WIDE:
7756 case JIM_EXPROP_FUNC_ROUND:
7757 case JIM_EXPROP_UNARYPLUS:
7758 wC = wA;
7759 break;
7760 case JIM_EXPROP_FUNC_DOUBLE:
7761 dC = wA;
7762 intresult = 0;
7763 break;
7764 case JIM_EXPROP_FUNC_ABS:
7765 wC = wA >= 0 ? wA : -wA;
7766 break;
7767 case JIM_EXPROP_UNARYMINUS:
7768 wC = -wA;
7769 break;
7770 case JIM_EXPROP_NOT:
7771 wC = !wA;
7772 break;
7773 default:
7774 abort();
7777 else if ((rc = Jim_GetDouble(interp, A, &dA)) == JIM_OK) {
7778 switch (node->type) {
7779 case JIM_EXPROP_FUNC_INT:
7780 case JIM_EXPROP_FUNC_WIDE:
7781 wC = dA;
7782 break;
7783 case JIM_EXPROP_FUNC_ROUND:
7784 wC = dA < 0 ? (dA - 0.5) : (dA + 0.5);
7785 break;
7786 case JIM_EXPROP_FUNC_DOUBLE:
7787 case JIM_EXPROP_UNARYPLUS:
7788 dC = dA;
7789 intresult = 0;
7790 break;
7791 case JIM_EXPROP_FUNC_ABS:
7792 #ifdef JIM_MATH_FUNCTIONS
7793 dC = fabs(dA);
7794 #else
7795 dC = dA >= 0 ? dA : -dA;
7796 #endif
7797 intresult = 0;
7798 break;
7799 case JIM_EXPROP_UNARYMINUS:
7800 dC = -dA;
7801 intresult = 0;
7802 break;
7803 case JIM_EXPROP_NOT:
7804 wC = !dA;
7805 break;
7806 default:
7807 abort();
7811 if (rc == JIM_OK) {
7812 if (intresult) {
7813 Jim_SetResultInt(interp, wC);
7815 else {
7816 Jim_SetResult(interp, Jim_NewDoubleObj(interp, dC));
7820 Jim_DecrRefCount(interp, A);
7822 return rc;
7825 static double JimRandDouble(Jim_Interp *interp)
7827 unsigned long x;
7828 JimRandomBytes(interp, &x, sizeof(x));
7830 return (double)x / (unsigned long)~0;
7833 static int JimExprOpIntUnary(Jim_Interp *interp, struct JimExprNode *node)
7835 jim_wide wA;
7836 Jim_Obj *A;
7837 int rc;
7839 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7840 return rc;
7843 rc = Jim_GetWide(interp, A, &wA);
7844 if (rc == JIM_OK) {
7845 switch (node->type) {
7846 case JIM_EXPROP_BITNOT:
7847 Jim_SetResultInt(interp, ~wA);
7848 break;
7849 case JIM_EXPROP_FUNC_SRAND:
7850 JimPrngSeed(interp, (unsigned char *)&wA, sizeof(wA));
7851 Jim_SetResult(interp, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7852 break;
7853 default:
7854 abort();
7858 Jim_DecrRefCount(interp, A);
7860 return rc;
7863 static int JimExprOpNone(Jim_Interp *interp, struct JimExprNode *node)
7865 JimPanic((node->type != JIM_EXPROP_FUNC_RAND, "JimExprOpNone only support rand()"));
7867 Jim_SetResult(interp, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7869 return JIM_OK;
7872 #ifdef JIM_MATH_FUNCTIONS
7873 static int JimExprOpDoubleUnary(Jim_Interp *interp, struct JimExprNode *node)
7875 int rc;
7876 double dA, dC;
7877 Jim_Obj *A;
7879 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7880 return rc;
7883 rc = Jim_GetDouble(interp, A, &dA);
7884 if (rc == JIM_OK) {
7885 switch (node->type) {
7886 case JIM_EXPROP_FUNC_SIN:
7887 dC = sin(dA);
7888 break;
7889 case JIM_EXPROP_FUNC_COS:
7890 dC = cos(dA);
7891 break;
7892 case JIM_EXPROP_FUNC_TAN:
7893 dC = tan(dA);
7894 break;
7895 case JIM_EXPROP_FUNC_ASIN:
7896 dC = asin(dA);
7897 break;
7898 case JIM_EXPROP_FUNC_ACOS:
7899 dC = acos(dA);
7900 break;
7901 case JIM_EXPROP_FUNC_ATAN:
7902 dC = atan(dA);
7903 break;
7904 case JIM_EXPROP_FUNC_SINH:
7905 dC = sinh(dA);
7906 break;
7907 case JIM_EXPROP_FUNC_COSH:
7908 dC = cosh(dA);
7909 break;
7910 case JIM_EXPROP_FUNC_TANH:
7911 dC = tanh(dA);
7912 break;
7913 case JIM_EXPROP_FUNC_CEIL:
7914 dC = ceil(dA);
7915 break;
7916 case JIM_EXPROP_FUNC_FLOOR:
7917 dC = floor(dA);
7918 break;
7919 case JIM_EXPROP_FUNC_EXP:
7920 dC = exp(dA);
7921 break;
7922 case JIM_EXPROP_FUNC_LOG:
7923 dC = log(dA);
7924 break;
7925 case JIM_EXPROP_FUNC_LOG10:
7926 dC = log10(dA);
7927 break;
7928 case JIM_EXPROP_FUNC_SQRT:
7929 dC = sqrt(dA);
7930 break;
7931 default:
7932 abort();
7934 Jim_SetResult(interp, Jim_NewDoubleObj(interp, dC));
7937 Jim_DecrRefCount(interp, A);
7939 return rc;
7941 #endif
7943 /* A binary operation on two ints */
7944 static int JimExprOpIntBin(Jim_Interp *interp, struct JimExprNode *node)
7946 jim_wide wA, wB;
7947 int rc;
7948 Jim_Obj *A, *B;
7950 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7951 return rc;
7953 if ((rc = JimExprGetTerm(interp, node->right, &B)) != JIM_OK) {
7954 Jim_DecrRefCount(interp, A);
7955 return rc;
7958 rc = JIM_ERR;
7960 if (Jim_GetWide(interp, A, &wA) == JIM_OK && Jim_GetWide(interp, B, &wB) == JIM_OK) {
7961 jim_wide wC;
7963 rc = JIM_OK;
7965 switch (node->type) {
7966 case JIM_EXPROP_LSHIFT:
7967 wC = wA << wB;
7968 break;
7969 case JIM_EXPROP_RSHIFT:
7970 wC = wA >> wB;
7971 break;
7972 case JIM_EXPROP_BITAND:
7973 wC = wA & wB;
7974 break;
7975 case JIM_EXPROP_BITXOR:
7976 wC = wA ^ wB;
7977 break;
7978 case JIM_EXPROP_BITOR:
7979 wC = wA | wB;
7980 break;
7981 case JIM_EXPROP_MOD:
7982 if (wB == 0) {
7983 wC = 0;
7984 Jim_SetResultString(interp, "Division by zero", -1);
7985 rc = JIM_ERR;
7987 else {
7989 * From Tcl 8.x
7991 * This code is tricky: C doesn't guarantee much
7992 * about the quotient or remainder, but Tcl does.
7993 * The remainder always has the same sign as the
7994 * divisor and a smaller absolute value.
7996 int negative = 0;
7998 if (wB < 0) {
7999 wB = -wB;
8000 wA = -wA;
8001 negative = 1;
8003 wC = wA % wB;
8004 if (wC < 0) {
8005 wC += wB;
8007 if (negative) {
8008 wC = -wC;
8011 break;
8012 case JIM_EXPROP_ROTL:
8013 case JIM_EXPROP_ROTR:{
8014 /* uint32_t would be better. But not everyone has inttypes.h? */
8015 unsigned long uA = (unsigned long)wA;
8016 unsigned long uB = (unsigned long)wB;
8017 const unsigned int S = sizeof(unsigned long) * 8;
8019 /* Shift left by the word size or more is undefined. */
8020 uB %= S;
8022 if (node->type == JIM_EXPROP_ROTR) {
8023 uB = S - uB;
8025 wC = (unsigned long)(uA << uB) | (uA >> (S - uB));
8026 break;
8028 default:
8029 abort();
8031 Jim_SetResultInt(interp, wC);
8034 Jim_DecrRefCount(interp, A);
8035 Jim_DecrRefCount(interp, B);
8037 return rc;
8041 /* A binary operation on two ints or two doubles (or two strings for some ops) */
8042 static int JimExprOpBin(Jim_Interp *interp, struct JimExprNode *node)
8044 int rc = JIM_OK;
8045 double dA, dB, dC = 0;
8046 jim_wide wA, wB, wC = 0;
8047 Jim_Obj *A, *B;
8049 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
8050 return rc;
8052 if ((rc = JimExprGetTerm(interp, node->right, &B)) != JIM_OK) {
8053 Jim_DecrRefCount(interp, A);
8054 return rc;
8057 if ((A->typePtr != &doubleObjType || A->bytes) &&
8058 (B->typePtr != &doubleObjType || B->bytes) &&
8059 JimGetWideNoErr(interp, A, &wA) == JIM_OK && JimGetWideNoErr(interp, B, &wB) == JIM_OK) {
8061 /* Both are ints */
8063 switch (node->type) {
8064 case JIM_EXPROP_POW:
8065 case JIM_EXPROP_FUNC_POW:
8066 if (wA == 0 && wB < 0) {
8067 Jim_SetResultString(interp, "exponentiation of zero by negative power", -1);
8068 rc = JIM_ERR;
8069 goto done;
8071 wC = JimPowWide(wA, wB);
8072 goto intresult;
8073 case JIM_EXPROP_ADD:
8074 wC = wA + wB;
8075 goto intresult;
8076 case JIM_EXPROP_SUB:
8077 wC = wA - wB;
8078 goto intresult;
8079 case JIM_EXPROP_MUL:
8080 wC = wA * wB;
8081 goto intresult;
8082 case JIM_EXPROP_DIV:
8083 if (wB == 0) {
8084 Jim_SetResultString(interp, "Division by zero", -1);
8085 rc = JIM_ERR;
8086 goto done;
8088 else {
8090 * From Tcl 8.x
8092 * This code is tricky: C doesn't guarantee much
8093 * about the quotient or remainder, but Tcl does.
8094 * The remainder always has the same sign as the
8095 * divisor and a smaller absolute value.
8097 if (wB < 0) {
8098 wB = -wB;
8099 wA = -wA;
8101 wC = wA / wB;
8102 if (wA % wB < 0) {
8103 wC--;
8105 goto intresult;
8107 case JIM_EXPROP_LT:
8108 wC = wA < wB;
8109 goto intresult;
8110 case JIM_EXPROP_GT:
8111 wC = wA > wB;
8112 goto intresult;
8113 case JIM_EXPROP_LTE:
8114 wC = wA <= wB;
8115 goto intresult;
8116 case JIM_EXPROP_GTE:
8117 wC = wA >= wB;
8118 goto intresult;
8119 case JIM_EXPROP_NUMEQ:
8120 wC = wA == wB;
8121 goto intresult;
8122 case JIM_EXPROP_NUMNE:
8123 wC = wA != wB;
8124 goto intresult;
8127 if (Jim_GetDouble(interp, A, &dA) == JIM_OK && Jim_GetDouble(interp, B, &dB) == JIM_OK) {
8128 switch (node->type) {
8129 #ifndef JIM_MATH_FUNCTIONS
8130 case JIM_EXPROP_POW:
8131 case JIM_EXPROP_FUNC_POW:
8132 case JIM_EXPROP_FUNC_ATAN2:
8133 case JIM_EXPROP_FUNC_HYPOT:
8134 case JIM_EXPROP_FUNC_FMOD:
8135 Jim_SetResultString(interp, "unsupported", -1);
8136 rc = JIM_ERR;
8137 goto done;
8138 #else
8139 case JIM_EXPROP_POW:
8140 case JIM_EXPROP_FUNC_POW:
8141 dC = pow(dA, dB);
8142 goto doubleresult;
8143 case JIM_EXPROP_FUNC_ATAN2:
8144 dC = atan2(dA, dB);
8145 goto doubleresult;
8146 case JIM_EXPROP_FUNC_HYPOT:
8147 dC = hypot(dA, dB);
8148 goto doubleresult;
8149 case JIM_EXPROP_FUNC_FMOD:
8150 dC = fmod(dA, dB);
8151 goto doubleresult;
8152 #endif
8153 case JIM_EXPROP_ADD:
8154 dC = dA + dB;
8155 goto doubleresult;
8156 case JIM_EXPROP_SUB:
8157 dC = dA - dB;
8158 goto doubleresult;
8159 case JIM_EXPROP_MUL:
8160 dC = dA * dB;
8161 goto doubleresult;
8162 case JIM_EXPROP_DIV:
8163 if (dB == 0) {
8164 #ifdef INFINITY
8165 dC = dA < 0 ? -INFINITY : INFINITY;
8166 #else
8167 dC = (dA < 0 ? -1.0 : 1.0) * strtod("Inf", NULL);
8168 #endif
8170 else {
8171 dC = dA / dB;
8173 goto doubleresult;
8174 case JIM_EXPROP_LT:
8175 wC = dA < dB;
8176 goto intresult;
8177 case JIM_EXPROP_GT:
8178 wC = dA > dB;
8179 goto intresult;
8180 case JIM_EXPROP_LTE:
8181 wC = dA <= dB;
8182 goto intresult;
8183 case JIM_EXPROP_GTE:
8184 wC = dA >= dB;
8185 goto intresult;
8186 case JIM_EXPROP_NUMEQ:
8187 wC = dA == dB;
8188 goto intresult;
8189 case JIM_EXPROP_NUMNE:
8190 wC = dA != dB;
8191 goto intresult;
8194 else {
8195 /* Handle the string case */
8197 /* XXX: Could optimise the eq/ne case by checking lengths */
8198 int i = Jim_StringCompareObj(interp, A, B, 0);
8200 switch (node->type) {
8201 case JIM_EXPROP_LT:
8202 wC = i < 0;
8203 goto intresult;
8204 case JIM_EXPROP_GT:
8205 wC = i > 0;
8206 goto intresult;
8207 case JIM_EXPROP_LTE:
8208 wC = i <= 0;
8209 goto intresult;
8210 case JIM_EXPROP_GTE:
8211 wC = i >= 0;
8212 goto intresult;
8213 case JIM_EXPROP_NUMEQ:
8214 wC = i == 0;
8215 goto intresult;
8216 case JIM_EXPROP_NUMNE:
8217 wC = i != 0;
8218 goto intresult;
8221 /* If we get here, it is an error */
8222 rc = JIM_ERR;
8223 done:
8224 Jim_DecrRefCount(interp, A);
8225 Jim_DecrRefCount(interp, B);
8226 return rc;
8227 intresult:
8228 Jim_SetResultInt(interp, wC);
8229 goto done;
8230 doubleresult:
8231 Jim_SetResult(interp, Jim_NewDoubleObj(interp, dC));
8232 goto done;
8235 static int JimSearchList(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *valObj)
8237 int listlen;
8238 int i;
8240 listlen = Jim_ListLength(interp, listObjPtr);
8241 for (i = 0; i < listlen; i++) {
8242 if (Jim_StringEqObj(Jim_ListGetIndex(interp, listObjPtr, i), valObj)) {
8243 return 1;
8246 return 0;
8251 static int JimExprOpStrBin(Jim_Interp *interp, struct JimExprNode *node)
8253 Jim_Obj *A, *B;
8254 jim_wide wC;
8255 int rc;
8257 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
8258 return rc;
8260 if ((rc = JimExprGetTerm(interp, node->right, &B)) != JIM_OK) {
8261 Jim_DecrRefCount(interp, A);
8262 return rc;
8265 switch (node->type) {
8266 case JIM_EXPROP_STREQ:
8267 case JIM_EXPROP_STRNE:
8268 wC = Jim_StringEqObj(A, B);
8269 if (node->type == JIM_EXPROP_STRNE) {
8270 wC = !wC;
8272 break;
8273 case JIM_EXPROP_STRIN:
8274 wC = JimSearchList(interp, B, A);
8275 break;
8276 case JIM_EXPROP_STRNI:
8277 wC = !JimSearchList(interp, B, A);
8278 break;
8279 default:
8280 abort();
8282 Jim_SetResultInt(interp, wC);
8284 Jim_DecrRefCount(interp, A);
8285 Jim_DecrRefCount(interp, B);
8287 return rc;
8290 static int ExprBool(Jim_Interp *interp, Jim_Obj *obj)
8292 long l;
8293 double d;
8294 int b;
8295 int ret = -1;
8297 /* In case the object is interp->result with refcount 1*/
8298 Jim_IncrRefCount(obj);
8300 if (Jim_GetLong(interp, obj, &l) == JIM_OK) {
8301 ret = (l != 0);
8303 else if (Jim_GetDouble(interp, obj, &d) == JIM_OK) {
8304 ret = (d != 0);
8306 else if (Jim_GetBoolean(interp, obj, &b) == JIM_OK) {
8307 ret = (b != 0);
8310 Jim_DecrRefCount(interp, obj);
8311 return ret;
8314 static int JimExprOpAnd(Jim_Interp *interp, struct JimExprNode *node)
8316 /* evaluate left */
8317 int result = JimExprGetTermBoolean(interp, node->left);
8319 if (result == 1) {
8320 /* true so evaluate right */
8321 result = JimExprGetTermBoolean(interp, node->right);
8323 if (result == -1) {
8324 return JIM_ERR;
8326 Jim_SetResultInt(interp, result);
8327 return JIM_OK;
8330 static int JimExprOpOr(Jim_Interp *interp, struct JimExprNode *node)
8332 /* evaluate left */
8333 int result = JimExprGetTermBoolean(interp, node->left);
8335 if (result == 0) {
8336 /* false so evaluate right */
8337 result = JimExprGetTermBoolean(interp, node->right);
8339 if (result == -1) {
8340 return JIM_ERR;
8342 Jim_SetResultInt(interp, result);
8343 return JIM_OK;
8346 static int JimExprOpTernary(Jim_Interp *interp, struct JimExprNode *node)
8348 /* evaluate left */
8349 int result = JimExprGetTermBoolean(interp, node->left);
8351 if (result == 1) {
8352 /* true so select right */
8353 return JimExprEvalTermNode(interp, node->right);
8355 else if (result == 0) {
8356 /* false so select ternary */
8357 return JimExprEvalTermNode(interp, node->ternary);
8359 /* error */
8360 return JIM_ERR;
8363 enum
8365 OP_FUNC = 0x0001, /* function syntax */
8366 OP_RIGHT_ASSOC = 0x0002, /* right associative */
8369 /* name - precedence - arity - opcode
8371 * This array *must* be kept in sync with the JIM_EXPROP enum.
8373 * The following macros pre-compute the string length at compile time.
8375 #define OPRINIT_ATTR(N, P, ARITY, F, ATTR) {N, F, P, ARITY, ATTR, sizeof(N) - 1}
8376 #define OPRINIT(N, P, ARITY, F) OPRINIT_ATTR(N, P, ARITY, F, 0)
8378 static const struct Jim_ExprOperator Jim_ExprOperators[] = {
8379 OPRINIT("*", 110, 2, JimExprOpBin),
8380 OPRINIT("/", 110, 2, JimExprOpBin),
8381 OPRINIT("%", 110, 2, JimExprOpIntBin),
8383 OPRINIT("-", 100, 2, JimExprOpBin),
8384 OPRINIT("+", 100, 2, JimExprOpBin),
8386 OPRINIT("<<", 90, 2, JimExprOpIntBin),
8387 OPRINIT(">>", 90, 2, JimExprOpIntBin),
8389 OPRINIT("<<<", 90, 2, JimExprOpIntBin),
8390 OPRINIT(">>>", 90, 2, JimExprOpIntBin),
8392 OPRINIT("<", 80, 2, JimExprOpBin),
8393 OPRINIT(">", 80, 2, JimExprOpBin),
8394 OPRINIT("<=", 80, 2, JimExprOpBin),
8395 OPRINIT(">=", 80, 2, JimExprOpBin),
8397 OPRINIT("==", 70, 2, JimExprOpBin),
8398 OPRINIT("!=", 70, 2, JimExprOpBin),
8400 OPRINIT("&", 50, 2, JimExprOpIntBin),
8401 OPRINIT("^", 49, 2, JimExprOpIntBin),
8402 OPRINIT("|", 48, 2, JimExprOpIntBin),
8404 OPRINIT("&&", 10, 2, JimExprOpAnd),
8405 OPRINIT("||", 9, 2, JimExprOpOr),
8406 OPRINIT_ATTR("?", 5, 3, JimExprOpTernary, OP_RIGHT_ASSOC),
8407 OPRINIT_ATTR(":", 5, 3, NULL, OP_RIGHT_ASSOC),
8409 /* Precedence is higher than * and / but lower than ! and ~, and right-associative */
8410 OPRINIT_ATTR("**", 120, 2, JimExprOpBin, OP_RIGHT_ASSOC),
8412 OPRINIT("eq", 60, 2, JimExprOpStrBin),
8413 OPRINIT("ne", 60, 2, JimExprOpStrBin),
8415 OPRINIT("in", 55, 2, JimExprOpStrBin),
8416 OPRINIT("ni", 55, 2, JimExprOpStrBin),
8418 OPRINIT_ATTR("!", 150, 1, JimExprOpNumUnary, OP_RIGHT_ASSOC),
8419 OPRINIT_ATTR("~", 150, 1, JimExprOpIntUnary, OP_RIGHT_ASSOC),
8420 OPRINIT_ATTR(" -", 150, 1, JimExprOpNumUnary, OP_RIGHT_ASSOC),
8421 OPRINIT_ATTR(" +", 150, 1, JimExprOpNumUnary, OP_RIGHT_ASSOC),
8425 OPRINIT_ATTR("int", 200, 1, JimExprOpNumUnary, OP_FUNC),
8426 OPRINIT_ATTR("wide", 200, 1, JimExprOpNumUnary, OP_FUNC),
8427 OPRINIT_ATTR("abs", 200, 1, JimExprOpNumUnary, OP_FUNC),
8428 OPRINIT_ATTR("double", 200, 1, JimExprOpNumUnary, OP_FUNC),
8429 OPRINIT_ATTR("round", 200, 1, JimExprOpNumUnary, OP_FUNC),
8430 OPRINIT_ATTR("rand", 200, 0, JimExprOpNone, OP_FUNC),
8431 OPRINIT_ATTR("srand", 200, 1, JimExprOpIntUnary, OP_FUNC),
8433 #ifdef JIM_MATH_FUNCTIONS
8434 OPRINIT_ATTR("sin", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8435 OPRINIT_ATTR("cos", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8436 OPRINIT_ATTR("tan", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8437 OPRINIT_ATTR("asin", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8438 OPRINIT_ATTR("acos", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8439 OPRINIT_ATTR("atan", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8440 OPRINIT_ATTR("atan2", 200, 2, JimExprOpBin, OP_FUNC),
8441 OPRINIT_ATTR("sinh", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8442 OPRINIT_ATTR("cosh", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8443 OPRINIT_ATTR("tanh", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8444 OPRINIT_ATTR("ceil", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8445 OPRINIT_ATTR("floor", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8446 OPRINIT_ATTR("exp", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8447 OPRINIT_ATTR("log", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8448 OPRINIT_ATTR("log10", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8449 OPRINIT_ATTR("sqrt", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8450 OPRINIT_ATTR("pow", 200, 2, JimExprOpBin, OP_FUNC),
8451 OPRINIT_ATTR("hypot", 200, 2, JimExprOpBin, OP_FUNC),
8452 OPRINIT_ATTR("fmod", 200, 2, JimExprOpBin, OP_FUNC),
8453 #endif
8455 #undef OPRINIT
8456 #undef OPRINIT_ATTR
8458 #define JIM_EXPR_OPERATORS_NUM \
8459 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
8461 static int JimParseExpression(struct JimParserCtx *pc)
8463 /* Discard spaces and quoted newline */
8464 while (isspace(UCHAR(*pc->p)) || (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) {
8465 if (*pc->p == '\n') {
8466 pc->linenr++;
8468 pc->p++;
8469 pc->len--;
8472 /* Common case */
8473 pc->tline = pc->linenr;
8474 pc->tstart = pc->p;
8476 if (pc->len == 0) {
8477 pc->tend = pc->p;
8478 pc->tt = JIM_TT_EOL;
8479 pc->eof = 1;
8480 return JIM_OK;
8482 switch (*(pc->p)) {
8483 case '(':
8484 pc->tt = JIM_TT_SUBEXPR_START;
8485 goto singlechar;
8486 case ')':
8487 pc->tt = JIM_TT_SUBEXPR_END;
8488 goto singlechar;
8489 case ',':
8490 pc->tt = JIM_TT_SUBEXPR_COMMA;
8491 singlechar:
8492 pc->tend = pc->p;
8493 pc->p++;
8494 pc->len--;
8495 break;
8496 case '[':
8497 return JimParseCmd(pc);
8498 case '$':
8499 if (JimParseVar(pc) == JIM_ERR)
8500 return JimParseExprOperator(pc);
8501 else {
8502 /* Don't allow expr sugar in expressions */
8503 if (pc->tt == JIM_TT_EXPRSUGAR) {
8504 return JIM_ERR;
8506 return JIM_OK;
8508 break;
8509 case '0':
8510 case '1':
8511 case '2':
8512 case '3':
8513 case '4':
8514 case '5':
8515 case '6':
8516 case '7':
8517 case '8':
8518 case '9':
8519 case '.':
8520 return JimParseExprNumber(pc);
8521 case '"':
8522 return JimParseQuote(pc);
8523 case '{':
8524 return JimParseBrace(pc);
8526 case 'N':
8527 case 'I':
8528 case 'n':
8529 case 'i':
8530 if (JimParseExprIrrational(pc) == JIM_ERR)
8531 if (JimParseExprBoolean(pc) == JIM_ERR)
8532 return JimParseExprOperator(pc);
8533 break;
8534 case 't':
8535 case 'f':
8536 case 'o':
8537 case 'y':
8538 if (JimParseExprBoolean(pc) == JIM_ERR)
8539 return JimParseExprOperator(pc);
8540 break;
8541 default:
8542 return JimParseExprOperator(pc);
8543 break;
8545 return JIM_OK;
8548 static int JimParseExprNumber(struct JimParserCtx *pc)
8550 char *end;
8552 /* Assume an integer for now */
8553 pc->tt = JIM_TT_EXPR_INT;
8555 jim_strtoull(pc->p, (char **)&pc->p);
8556 /* Tried as an integer, but perhaps it parses as a double */
8557 if (strchr("eENnIi.", *pc->p) || pc->p == pc->tstart) {
8558 /* Some stupid compilers insist they are cleverer that
8559 * we are. Even a (void) cast doesn't prevent this warning!
8561 if (strtod(pc->tstart, &end)) { /* nothing */ }
8562 if (end == pc->tstart)
8563 return JIM_ERR;
8564 if (end > pc->p) {
8565 /* Yes, double captured more chars */
8566 pc->tt = JIM_TT_EXPR_DOUBLE;
8567 pc->p = end;
8570 pc->tend = pc->p - 1;
8571 pc->len -= (pc->p - pc->tstart);
8572 return JIM_OK;
8575 static int JimParseExprIrrational(struct JimParserCtx *pc)
8577 const char *irrationals[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL };
8578 int i;
8580 for (i = 0; irrationals[i]; i++) {
8581 const char *irr = irrationals[i];
8583 if (strncmp(irr, pc->p, 3) == 0) {
8584 pc->p += 3;
8585 pc->len -= 3;
8586 pc->tend = pc->p - 1;
8587 pc->tt = JIM_TT_EXPR_DOUBLE;
8588 return JIM_OK;
8591 return JIM_ERR;
8594 static int JimParseExprBoolean(struct JimParserCtx *pc)
8596 const char *booleans[] = { "false", "no", "off", "true", "yes", "on", NULL };
8597 const int lengths[] = { 5, 2, 3, 4, 3, 2, 0 };
8598 int i;
8600 for (i = 0; booleans[i]; i++) {
8601 const char *boolean = booleans[i];
8602 int length = lengths[i];
8604 if (strncmp(boolean, pc->p, length) == 0) {
8605 pc->p += length;
8606 pc->len -= length;
8607 pc->tend = pc->p - 1;
8608 pc->tt = JIM_TT_EXPR_BOOLEAN;
8609 return JIM_OK;
8612 return JIM_ERR;
8615 static const struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
8617 static Jim_ExprOperator dummy_op;
8618 if (opcode < JIM_TT_EXPR_OP) {
8619 return &dummy_op;
8621 return &Jim_ExprOperators[opcode - JIM_TT_EXPR_OP];
8624 static int JimParseExprOperator(struct JimParserCtx *pc)
8626 int i;
8627 const struct Jim_ExprOperator *bestOp = NULL;
8628 int bestLen = 0;
8630 /* Try to get the longest match. */
8631 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
8632 const struct Jim_ExprOperator *op = &Jim_ExprOperators[i];
8634 if (op->name[0] != pc->p[0]) {
8635 continue;
8638 if (op->namelen > bestLen && strncmp(op->name, pc->p, op->namelen) == 0) {
8639 bestOp = op;
8640 bestLen = op->namelen;
8643 if (bestOp == NULL) {
8644 return JIM_ERR;
8647 /* Validate paretheses around function arguments */
8648 if (bestOp->attr & OP_FUNC) {
8649 const char *p = pc->p + bestLen;
8650 int len = pc->len - bestLen;
8652 while (len && isspace(UCHAR(*p))) {
8653 len--;
8654 p++;
8656 if (*p != '(') {
8657 return JIM_ERR;
8660 pc->tend = pc->p + bestLen - 1;
8661 pc->p += bestLen;
8662 pc->len -= bestLen;
8664 pc->tt = (bestOp - Jim_ExprOperators) + JIM_TT_EXPR_OP;
8665 return JIM_OK;
8668 const char *jim_tt_name(int type)
8670 static const char * const tt_names[JIM_TT_EXPR_OP] =
8671 { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "LIN", "WRD", "(((", ")))", ",,,", "INT",
8672 "DBL", "BOO", "$()" };
8673 if (type < JIM_TT_EXPR_OP) {
8674 return tt_names[type];
8676 else if (type == JIM_EXPROP_UNARYMINUS) {
8677 return "-VE";
8679 else if (type == JIM_EXPROP_UNARYPLUS) {
8680 return "+VE";
8682 else {
8683 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(type);
8684 static char buf[20];
8686 if (op->name) {
8687 return op->name;
8689 sprintf(buf, "(%d)", type);
8690 return buf;
8694 /* -----------------------------------------------------------------------------
8695 * Expression Object
8696 * ---------------------------------------------------------------------------*/
8697 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
8698 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
8699 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
8701 static const Jim_ObjType exprObjType = {
8702 "expression",
8703 FreeExprInternalRep,
8704 DupExprInternalRep,
8705 NULL,
8706 JIM_TYPE_REFERENCES,
8709 /* expr tree structure */
8710 struct ExprTree
8712 struct JimExprNode *expr; /* The first operator or term */
8713 struct JimExprNode *nodes; /* Storage of all nodes in the tree */
8714 int len; /* Number of nodes in use */
8715 int inUse; /* Used for sharing. */
8718 static void ExprTreeFreeNodes(Jim_Interp *interp, struct JimExprNode *nodes, int num)
8720 int i;
8721 for (i = 0; i < num; i++) {
8722 if (nodes[i].objPtr) {
8723 Jim_DecrRefCount(interp, nodes[i].objPtr);
8726 Jim_Free(nodes);
8729 static void ExprTreeFree(Jim_Interp *interp, struct ExprTree *expr)
8731 ExprTreeFreeNodes(interp, expr->nodes, expr->len);
8732 Jim_Free(expr);
8735 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
8737 struct ExprTree *expr = (void *)objPtr->internalRep.ptr;
8739 if (expr) {
8740 if (--expr->inUse != 0) {
8741 return;
8744 ExprTreeFree(interp, expr);
8748 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
8750 JIM_NOTUSED(interp);
8751 JIM_NOTUSED(srcPtr);
8753 /* Just returns an simple string. */
8754 dupPtr->typePtr = NULL;
8757 struct ExprBuilder {
8758 int parencount; /* count of outstanding parentheses */
8759 int level; /* recursion depth */
8760 ParseToken *token; /* The current token */
8761 ParseToken *first_token; /* The first token */
8762 Jim_Stack stack; /* stack of pending terms */
8763 Jim_Obj *exprObjPtr; /* the original expression */
8764 Jim_Obj *fileNameObj; /* filename of the original expression */
8765 struct JimExprNode *nodes; /* storage for all nodes */
8766 struct JimExprNode *next; /* storage for the next node */
8769 #ifdef DEBUG_SHOW_EXPR
8770 static void JimShowExprNode(struct JimExprNode *node, int level)
8772 int i;
8773 for (i = 0; i < level; i++) {
8774 printf(" ");
8776 if (TOKEN_IS_EXPR_OP(node->type)) {
8777 printf("%s\n", jim_tt_name(node->type));
8778 if (node->left) {
8779 JimShowExprNode(node->left, level + 1);
8781 if (node->right) {
8782 JimShowExprNode(node->right, level + 1);
8784 if (node->ternary) {
8785 JimShowExprNode(node->ternary, level + 1);
8788 else {
8789 printf("[%s] %s\n", jim_tt_name(node->type), Jim_String(node->objPtr));
8792 #endif
8794 #define EXPR_UNTIL_CLOSE 0x0001
8795 #define EXPR_FUNC_ARGS 0x0002
8796 #define EXPR_TERNARY 0x0004
8799 * Parse the subexpression at builder->token and return with the node on the stack.
8800 * builder->token is advanced to the next unconsumed token.
8801 * Returns JIM_OK if OK or JIM_ERR on error and leaves a message in the interpreter result.
8803 * 'precedence' is the precedence of the current operator. Tokens are consumed until an operator
8804 * with an equal or lower precedence is reached (or strictly lower if right associative).
8806 * If EXPR_UNTIL_CLOSE is set, the subexpression extends up to and including the next close parenthesis.
8807 * If EXPR_FUNC_ARGS is set, multiple subexpressions (terms) are expected separated by comma
8808 * If EXPR_TERNARY is set, two subexpressions (terms) are expected separated by colon
8810 * 'exp_numterms' indicates how many terms are expected. Normally this is 1, but may be more for EXPR_FUNC_ARGS and EXPR_TERNARY.
8812 static int ExprTreeBuildTree(Jim_Interp *interp, struct ExprBuilder *builder, int precedence, int flags, int exp_numterms)
8814 int rc;
8815 struct JimExprNode *node;
8816 /* Calculate the stack length expected after pushing the number of expected terms */
8817 int exp_stacklen = builder->stack.len + exp_numterms;
8819 if (builder->level++ > 200) {
8820 Jim_SetResultString(interp, "Expression too complex", -1);
8821 return JIM_ERR;
8824 while (builder->token->type != JIM_TT_EOL) {
8825 ParseToken *t = builder->token++;
8826 int prevtt;
8828 if (t == builder->first_token) {
8829 prevtt = JIM_TT_NONE;
8831 else {
8832 prevtt = t[-1].type;
8835 if (t->type == JIM_TT_SUBEXPR_START) {
8836 if (builder->stack.len == exp_stacklen) {
8837 Jim_SetResultFormatted(interp, "unexpected open parenthesis in expression: \"%#s\"", builder->exprObjPtr);
8838 return JIM_ERR;
8840 builder->parencount++;
8841 rc = ExprTreeBuildTree(interp, builder, 0, EXPR_UNTIL_CLOSE, 1);
8842 if (rc != JIM_OK) {
8843 return rc;
8845 /* A complete subexpression is on the stack */
8847 else if (t->type == JIM_TT_SUBEXPR_END) {
8848 if (!(flags & EXPR_UNTIL_CLOSE)) {
8849 if (builder->stack.len == exp_stacklen && builder->level > 1) {
8850 builder->token--;
8851 builder->level--;
8852 return JIM_OK;
8854 Jim_SetResultFormatted(interp, "unexpected closing parenthesis in expression: \"%#s\"", builder->exprObjPtr);
8855 return JIM_ERR;
8857 builder->parencount--;
8858 if (builder->stack.len == exp_stacklen) {
8859 /* Return with the expected number of subexpressions on the stack */
8860 break;
8863 else if (t->type == JIM_TT_SUBEXPR_COMMA) {
8864 if (!(flags & EXPR_FUNC_ARGS)) {
8865 if (builder->stack.len == exp_stacklen) {
8866 /* handle the comma back at the parent level */
8867 builder->token--;
8868 builder->level--;
8869 return JIM_OK;
8871 Jim_SetResultFormatted(interp, "unexpected comma in expression: \"%#s\"", builder->exprObjPtr);
8872 return JIM_ERR;
8874 else {
8875 /* If we see more terms than expected, it is an error */
8876 if (builder->stack.len > exp_stacklen) {
8877 Jim_SetResultFormatted(interp, "too many arguments to math function");
8878 return JIM_ERR;
8881 /* just go onto the next arg */
8883 else if (t->type == JIM_EXPROP_COLON) {
8884 if (!(flags & EXPR_TERNARY)) {
8885 if (builder->level != 1) {
8886 /* handle the comma back at the parent level */
8887 builder->token--;
8888 builder->level--;
8889 return JIM_OK;
8891 Jim_SetResultFormatted(interp, ": without ? in expression: \"%#s\"", builder->exprObjPtr);
8892 return JIM_ERR;
8894 if (builder->stack.len == exp_stacklen) {
8895 /* handle the comma back at the parent level */
8896 builder->token--;
8897 builder->level--;
8898 return JIM_OK;
8900 /* just go onto the next term */
8902 else if (TOKEN_IS_EXPR_OP(t->type)) {
8903 const struct Jim_ExprOperator *op;
8905 /* Convert -/+ to unary minus or unary plus if necessary */
8906 if (TOKEN_IS_EXPR_OP(prevtt) || TOKEN_IS_EXPR_START(prevtt)) {
8907 if (t->type == JIM_EXPROP_SUB) {
8908 t->type = JIM_EXPROP_UNARYMINUS;
8910 else if (t->type == JIM_EXPROP_ADD) {
8911 t->type = JIM_EXPROP_UNARYPLUS;
8915 op = JimExprOperatorInfoByOpcode(t->type);
8917 if (op->precedence < precedence || (!(op->attr & OP_RIGHT_ASSOC) && op->precedence == precedence)) {
8918 /* next op is lower precedence, or equal and left associative, so done here */
8919 builder->token--;
8920 break;
8923 if (op->attr & OP_FUNC) {
8924 if (builder->token->type != JIM_TT_SUBEXPR_START) {
8925 Jim_SetResultString(interp, "missing arguments for math function", -1);
8926 return JIM_ERR;
8928 builder->token++;
8929 if (op->arity == 0) {
8930 if (builder->token->type != JIM_TT_SUBEXPR_END) {
8931 Jim_SetResultString(interp, "too many arguments for math function", -1);
8932 return JIM_ERR;
8934 builder->token++;
8935 goto noargs;
8937 builder->parencount++;
8939 /* This will push left and return right */
8940 rc = ExprTreeBuildTree(interp, builder, 0, EXPR_FUNC_ARGS | EXPR_UNTIL_CLOSE, op->arity);
8942 else if (t->type == JIM_EXPROP_TERNARY) {
8943 /* Collect the two arguments to the ternary operator */
8944 rc = ExprTreeBuildTree(interp, builder, op->precedence, EXPR_TERNARY, 2);
8946 else {
8947 /* Recursively handle everything on the right until we see a precendence <= op->precedence or == and right associative
8948 * and push that on the term stack
8950 rc = ExprTreeBuildTree(interp, builder, op->precedence, 0, 1);
8953 if (rc != JIM_OK) {
8954 return rc;
8957 noargs:
8958 node = builder->next++;
8959 node->type = t->type;
8961 if (op->arity >= 3) {
8962 node->ternary = Jim_StackPop(&builder->stack);
8963 if (node->ternary == NULL) {
8964 goto missingoperand;
8967 if (op->arity >= 2) {
8968 node->right = Jim_StackPop(&builder->stack);
8969 if (node->right == NULL) {
8970 goto missingoperand;
8973 if (op->arity >= 1) {
8974 node->left = Jim_StackPop(&builder->stack);
8975 if (node->left == NULL) {
8976 missingoperand:
8977 Jim_SetResultFormatted(interp, "missing operand to %s in expression: \"%#s\"", op->name, builder->exprObjPtr);
8978 builder->next--;
8979 return JIM_ERR;
8984 /* Now push the node */
8985 Jim_StackPush(&builder->stack, node);
8987 else {
8988 Jim_Obj *objPtr = NULL;
8990 /* This is a simple non-operator term, so create and push the appropriate object */
8992 /* Two consecutive terms without an operator is invalid */
8993 if (!TOKEN_IS_EXPR_START(prevtt) && !TOKEN_IS_EXPR_OP(prevtt)) {
8994 Jim_SetResultFormatted(interp, "missing operator in expression: \"%#s\"", builder->exprObjPtr);
8995 return JIM_ERR;
8998 /* Immediately create a double or int object? */
8999 if (t->type == JIM_TT_EXPR_INT || t->type == JIM_TT_EXPR_DOUBLE) {
9000 char *endptr;
9001 if (t->type == JIM_TT_EXPR_INT) {
9002 objPtr = Jim_NewIntObj(interp, jim_strtoull(t->token, &endptr));
9004 else {
9005 objPtr = Jim_NewDoubleObj(interp, strtod(t->token, &endptr));
9007 if (endptr != t->token + t->len) {
9008 /* Conversion failed, so just store it as a string */
9009 Jim_FreeNewObj(interp, objPtr);
9010 objPtr = NULL;
9014 if (!objPtr) {
9015 /* Everything else is stored a simple string term */
9016 objPtr = Jim_NewStringObj(interp, t->token, t->len);
9017 if (t->type == JIM_TT_CMD) {
9018 /* Only commands need source info */
9019 JimSetSourceInfo(interp, objPtr, builder->fileNameObj, t->line);
9023 /* Now push a term node */
9024 node = builder->next++;
9025 node->objPtr = objPtr;
9026 Jim_IncrRefCount(node->objPtr);
9027 node->type = t->type;
9028 Jim_StackPush(&builder->stack, node);
9032 if (builder->stack.len == exp_stacklen) {
9033 builder->level--;
9034 return JIM_OK;
9037 if ((flags & EXPR_FUNC_ARGS)) {
9038 Jim_SetResultFormatted(interp, "too %s arguments for math function", (builder->stack.len < exp_stacklen) ? "few" : "many");
9040 else {
9041 if (builder->stack.len < exp_stacklen) {
9042 if (builder->level == 0) {
9043 Jim_SetResultFormatted(interp, "empty expression");
9045 else {
9046 Jim_SetResultFormatted(interp, "syntax error in expression \"%#s\": premature end of expression", builder->exprObjPtr);
9049 else {
9050 Jim_SetResultFormatted(interp, "extra terms after expression");
9054 return JIM_ERR;
9057 static struct ExprTree *ExprTreeCreateTree(Jim_Interp *interp, const ParseTokenList *tokenlist, Jim_Obj *exprObjPtr, Jim_Obj *fileNameObj)
9059 struct ExprTree *expr;
9060 struct ExprBuilder builder;
9061 int rc;
9062 struct JimExprNode *top = NULL;
9064 builder.parencount = 0;
9065 builder.level = 0;
9066 builder.token = builder.first_token = tokenlist->list;
9067 builder.exprObjPtr = exprObjPtr;
9068 builder.fileNameObj = fileNameObj;
9069 /* The bytecode will never produce more nodes than there are tokens - 1 (for EOL)*/
9070 builder.nodes = malloc(sizeof(struct JimExprNode) * (tokenlist->count - 1));
9071 memset(builder.nodes, 0, sizeof(struct JimExprNode) * (tokenlist->count - 1));
9072 builder.next = builder.nodes;
9073 Jim_InitStack(&builder.stack);
9075 rc = ExprTreeBuildTree(interp, &builder, 0, 0, 1);
9077 if (rc == JIM_OK) {
9078 top = Jim_StackPop(&builder.stack);
9080 if (builder.parencount) {
9081 Jim_SetResultString(interp, "missing close parenthesis", -1);
9082 rc = JIM_ERR;
9086 /* Free the stack used for the compilation. */
9087 Jim_FreeStack(&builder.stack);
9089 if (rc != JIM_OK) {
9090 ExprTreeFreeNodes(interp, builder.nodes, builder.next - builder.nodes);
9091 return NULL;
9094 expr = Jim_Alloc(sizeof(*expr));
9095 expr->inUse = 1;
9096 expr->expr = top;
9097 expr->nodes = builder.nodes;
9098 expr->len = builder.next - builder.nodes;
9100 assert(expr->len <= tokenlist->count - 1);
9102 return expr;
9105 /* This method takes the string representation of an expression
9106 * and generates a program for the expr engine */
9107 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
9109 int exprTextLen;
9110 const char *exprText;
9111 struct JimParserCtx parser;
9112 struct ExprTree *expr;
9113 ParseTokenList tokenlist;
9114 int line;
9115 Jim_Obj *fileNameObj;
9116 int rc = JIM_ERR;
9118 /* Try to get information about filename / line number */
9119 if (objPtr->typePtr == &sourceObjType) {
9120 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
9121 line = objPtr->internalRep.sourceValue.lineNumber;
9123 else {
9124 fileNameObj = interp->emptyObj;
9125 line = 1;
9127 Jim_IncrRefCount(fileNameObj);
9129 exprText = Jim_GetString(objPtr, &exprTextLen);
9131 /* Initially tokenise the expression into tokenlist */
9132 ScriptTokenListInit(&tokenlist);
9134 JimParserInit(&parser, exprText, exprTextLen, line);
9135 while (!parser.eof) {
9136 if (JimParseExpression(&parser) != JIM_OK) {
9137 ScriptTokenListFree(&tokenlist);
9138 Jim_SetResultFormatted(interp, "syntax error in expression: \"%#s\"", objPtr);
9139 expr = NULL;
9140 goto err;
9143 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
9144 parser.tline);
9147 #ifdef DEBUG_SHOW_EXPR_TOKENS
9149 int i;
9150 printf("==== Expr Tokens (%s) ====\n", Jim_String(fileNameObj));
9151 for (i = 0; i < tokenlist.count; i++) {
9152 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist.list[i].line, jim_tt_name(tokenlist.list[i].type),
9153 tokenlist.list[i].len, tokenlist.list[i].token);
9156 #endif
9158 if (JimParseCheckMissing(interp, parser.missing.ch) == JIM_ERR) {
9159 ScriptTokenListFree(&tokenlist);
9160 Jim_DecrRefCount(interp, fileNameObj);
9161 return JIM_ERR;
9164 /* Now create the expression bytecode from the tokenlist */
9165 expr = ExprTreeCreateTree(interp, &tokenlist, objPtr, fileNameObj);
9167 /* No longer need the token list */
9168 ScriptTokenListFree(&tokenlist);
9170 if (!expr) {
9171 goto err;
9174 #ifdef DEBUG_SHOW_EXPR
9175 printf("==== Expr ====\n");
9176 JimShowExprNode(expr->expr, 0);
9177 #endif
9179 rc = JIM_OK;
9181 err:
9182 /* Free the old internal rep and set the new one. */
9183 Jim_DecrRefCount(interp, fileNameObj);
9184 Jim_FreeIntRep(interp, objPtr);
9185 Jim_SetIntRepPtr(objPtr, expr);
9186 objPtr->typePtr = &exprObjType;
9187 return rc;
9190 static struct ExprTree *JimGetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
9192 if (objPtr->typePtr != &exprObjType) {
9193 if (SetExprFromAny(interp, objPtr) != JIM_OK) {
9194 return NULL;
9197 return (struct ExprTree *) Jim_GetIntRepPtr(objPtr);
9200 #ifdef JIM_OPTIMIZATION
9201 static Jim_Obj *JimExprIntValOrVar(Jim_Interp *interp, struct JimExprNode *node)
9203 if (node->type == JIM_TT_EXPR_INT)
9204 return node->objPtr;
9205 else if (node->type == JIM_TT_VAR)
9206 return Jim_GetVariable(interp, node->objPtr, JIM_NONE);
9207 else if (node->type == JIM_TT_DICTSUGAR)
9208 return JimExpandDictSugar(interp, node->objPtr);
9209 else
9210 return NULL;
9212 #endif
9214 /* -----------------------------------------------------------------------------
9215 * Expressions evaluation.
9216 * Jim uses a recursive evaluation engine for expressions,
9217 * that takes advantage of the fact that expr's operators
9218 * can't be redefined.
9220 * Jim_EvalExpression() uses the expression tree compiled by
9221 * SetExprFromAny() method of the "expression" object.
9223 * On success a Tcl Object containing the result of the evaluation
9224 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
9225 * returned.
9226 * On error the function returns a retcode != to JIM_OK and set a suitable
9227 * error on the interp.
9228 * ---------------------------------------------------------------------------*/
9230 static int JimExprEvalTermNode(Jim_Interp *interp, struct JimExprNode *node)
9232 if (TOKEN_IS_EXPR_OP(node->type)) {
9233 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(node->type);
9234 return op->funcop(interp, node);
9236 else {
9237 Jim_Obj *objPtr;
9239 /* A term */
9240 switch (node->type) {
9241 case JIM_TT_EXPR_INT:
9242 case JIM_TT_EXPR_DOUBLE:
9243 case JIM_TT_EXPR_BOOLEAN:
9244 case JIM_TT_STR:
9245 Jim_SetResult(interp, node->objPtr);
9246 return JIM_OK;
9248 case JIM_TT_VAR:
9249 objPtr = Jim_GetVariable(interp, node->objPtr, JIM_ERRMSG);
9250 if (objPtr) {
9251 Jim_SetResult(interp, objPtr);
9252 return JIM_OK;
9254 return JIM_ERR;
9256 case JIM_TT_DICTSUGAR:
9257 objPtr = JimExpandDictSugar(interp, node->objPtr);
9258 if (objPtr) {
9259 Jim_SetResult(interp, objPtr);
9260 return JIM_OK;
9262 return JIM_ERR;
9264 case JIM_TT_ESC:
9265 if (Jim_SubstObj(interp, node->objPtr, &objPtr, JIM_NONE) == JIM_OK) {
9266 Jim_SetResult(interp, objPtr);
9267 return JIM_OK;
9269 return JIM_ERR;
9271 case JIM_TT_CMD:
9272 return Jim_EvalObj(interp, node->objPtr);
9274 default:
9275 /* Should never get here */
9276 return JIM_ERR;
9281 static int JimExprGetTerm(Jim_Interp *interp, struct JimExprNode *node, Jim_Obj **objPtrPtr)
9283 int rc = JimExprEvalTermNode(interp, node);
9284 if (rc == JIM_OK) {
9285 *objPtrPtr = Jim_GetResult(interp);
9286 Jim_IncrRefCount(*objPtrPtr);
9288 return rc;
9291 static int JimExprGetTermBoolean(Jim_Interp *interp, struct JimExprNode *node)
9293 if (JimExprEvalTermNode(interp, node) == JIM_OK) {
9294 return ExprBool(interp, Jim_GetResult(interp));
9296 return -1;
9299 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr)
9301 struct ExprTree *expr;
9302 int retcode = JIM_OK;
9304 expr = JimGetExpression(interp, exprObjPtr);
9305 if (!expr) {
9306 return JIM_ERR; /* error in expression. */
9309 #ifdef JIM_OPTIMIZATION
9310 /* Check for one of the following common expressions used by while/for
9312 * CONST
9313 * $a
9314 * !$a
9315 * $a < CONST, $a < $b
9316 * $a <= CONST, $a <= $b
9317 * $a > CONST, $a > $b
9318 * $a >= CONST, $a >= $b
9319 * $a != CONST, $a != $b
9320 * $a == CONST, $a == $b
9323 Jim_Obj *objPtr;
9325 /* STEP 1 -- Check if there are the conditions to run the specialized
9326 * version of while */
9328 switch (expr->len) {
9329 case 1:
9330 objPtr = JimExprIntValOrVar(interp, expr->expr);
9331 if (objPtr) {
9332 Jim_SetResult(interp, objPtr);
9333 return JIM_OK;
9335 break;
9337 case 2:
9338 if (expr->expr->type == JIM_EXPROP_NOT) {
9339 objPtr = JimExprIntValOrVar(interp, expr->expr->left);
9341 if (objPtr && JimIsWide(objPtr)) {
9342 Jim_SetResult(interp, JimWideValue(objPtr) ? interp->falseObj : interp->trueObj);
9343 return JIM_OK;
9346 break;
9348 case 3:
9349 objPtr = JimExprIntValOrVar(interp, expr->expr->left);
9350 if (objPtr && JimIsWide(objPtr)) {
9351 Jim_Obj *objPtr2 = JimExprIntValOrVar(interp, expr->expr->right);
9352 if (objPtr2 && JimIsWide(objPtr2)) {
9353 jim_wide wideValueA = JimWideValue(objPtr);
9354 jim_wide wideValueB = JimWideValue(objPtr2);
9355 int cmpRes;
9356 switch (expr->expr->type) {
9357 case JIM_EXPROP_LT:
9358 cmpRes = wideValueA < wideValueB;
9359 break;
9360 case JIM_EXPROP_LTE:
9361 cmpRes = wideValueA <= wideValueB;
9362 break;
9363 case JIM_EXPROP_GT:
9364 cmpRes = wideValueA > wideValueB;
9365 break;
9366 case JIM_EXPROP_GTE:
9367 cmpRes = wideValueA >= wideValueB;
9368 break;
9369 case JIM_EXPROP_NUMEQ:
9370 cmpRes = wideValueA == wideValueB;
9371 break;
9372 case JIM_EXPROP_NUMNE:
9373 cmpRes = wideValueA != wideValueB;
9374 break;
9375 default:
9376 goto noopt;
9378 Jim_SetResult(interp, cmpRes ? interp->trueObj : interp->falseObj);
9379 return JIM_OK;
9382 break;
9385 noopt:
9386 #endif
9388 /* In order to avoid the internal repr being freed due to
9389 * shimmering of the exprObjPtr's object, we make the internal rep
9390 * shared. */
9391 expr->inUse++;
9393 /* Evaluate with the recursive expr engine */
9394 retcode = JimExprEvalTermNode(interp, expr->expr);
9396 expr->inUse--;
9398 return retcode;
9401 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
9403 int retcode = Jim_EvalExpression(interp, exprObjPtr);
9405 if (retcode == JIM_OK) {
9406 switch (ExprBool(interp, Jim_GetResult(interp))) {
9407 case 0:
9408 *boolPtr = 0;
9409 break;
9411 case 1:
9412 *boolPtr = 1;
9413 break;
9415 case -1:
9416 retcode = JIM_ERR;
9417 break;
9420 return retcode;
9423 /* -----------------------------------------------------------------------------
9424 * ScanFormat String Object
9425 * ---------------------------------------------------------------------------*/
9427 /* This Jim_Obj will held a parsed representation of a format string passed to
9428 * the Jim_ScanString command. For error diagnostics, the scanformat string has
9429 * to be parsed in its entirely first and then, if correct, can be used for
9430 * scanning. To avoid endless re-parsing, the parsed representation will be
9431 * stored in an internal representation and re-used for performance reason. */
9433 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
9434 * scanformat string. This part will later be used to extract information
9435 * out from the string to be parsed by Jim_ScanString */
9437 typedef struct ScanFmtPartDescr
9439 const char *arg; /* Specification of a CHARSET conversion */
9440 const char *prefix; /* Prefix to be scanned literally before conversion */
9441 size_t width; /* Maximal width of input to be converted */
9442 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
9443 char type; /* Type of conversion (e.g. c, d, f) */
9444 char modifier; /* Modify type (e.g. l - long, h - short */
9445 } ScanFmtPartDescr;
9447 /* The ScanFmtStringObj will hold the internal representation of a scanformat
9448 * string parsed and separated in part descriptions. Furthermore it contains
9449 * the original string representation of the scanformat string to allow for
9450 * fast update of the Jim_Obj's string representation part.
9452 * As an add-on the internal object representation adds some scratch pad area
9453 * for usage by Jim_ScanString to avoid endless allocating and freeing of
9454 * memory for purpose of string scanning.
9456 * The error member points to a static allocated string in case of a mal-
9457 * formed scanformat string or it contains '0' (NULL) in case of a valid
9458 * parse representation.
9460 * The whole memory of the internal representation is allocated as a single
9461 * area of memory that will be internally separated. So freeing and duplicating
9462 * of such an object is cheap */
9464 typedef struct ScanFmtStringObj
9466 jim_wide size; /* Size of internal repr in bytes */
9467 char *stringRep; /* Original string representation */
9468 size_t count; /* Number of ScanFmtPartDescr contained */
9469 size_t convCount; /* Number of conversions that will assign */
9470 size_t maxPos; /* Max position index if XPG3 is used */
9471 const char *error; /* Ptr to error text (NULL if no error */
9472 char *scratch; /* Some scratch pad used by Jim_ScanString */
9473 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
9474 } ScanFmtStringObj;
9477 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
9478 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
9479 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
9481 static const Jim_ObjType scanFmtStringObjType = {
9482 "scanformatstring",
9483 FreeScanFmtInternalRep,
9484 DupScanFmtInternalRep,
9485 UpdateStringOfScanFmt,
9486 JIM_TYPE_NONE,
9489 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
9491 JIM_NOTUSED(interp);
9492 Jim_Free((char *)objPtr->internalRep.ptr);
9493 objPtr->internalRep.ptr = 0;
9496 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
9498 size_t size = (size_t) ((ScanFmtStringObj *) srcPtr->internalRep.ptr)->size;
9499 ScanFmtStringObj *newVec = (ScanFmtStringObj *) Jim_Alloc(size);
9501 JIM_NOTUSED(interp);
9502 memcpy(newVec, srcPtr->internalRep.ptr, size);
9503 dupPtr->internalRep.ptr = newVec;
9504 dupPtr->typePtr = &scanFmtStringObjType;
9507 static void UpdateStringOfScanFmt(Jim_Obj *objPtr)
9509 JimSetStringBytes(objPtr, ((ScanFmtStringObj *) objPtr->internalRep.ptr)->stringRep);
9512 /* SetScanFmtFromAny will parse a given string and create the internal
9513 * representation of the format specification. In case of an error
9514 * the error data member of the internal representation will be set
9515 * to an descriptive error text and the function will be left with
9516 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
9517 * specification */
9519 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
9521 ScanFmtStringObj *fmtObj;
9522 char *buffer;
9523 int maxCount, i, approxSize, lastPos = -1;
9524 const char *fmt = Jim_String(objPtr);
9525 int maxFmtLen = Jim_Length(objPtr);
9526 const char *fmtEnd = fmt + maxFmtLen;
9527 int curr;
9529 Jim_FreeIntRep(interp, objPtr);
9530 /* Count how many conversions could take place maximally */
9531 for (i = 0, maxCount = 0; i < maxFmtLen; ++i)
9532 if (fmt[i] == '%')
9533 ++maxCount;
9534 /* Calculate an approximation of the memory necessary */
9535 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
9536 +(maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
9537 +maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
9538 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
9539 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
9540 +(maxCount + 1) * sizeof(char) /* '\0' for every partial */
9541 +1; /* safety byte */
9542 fmtObj = (ScanFmtStringObj *) Jim_Alloc(approxSize);
9543 memset(fmtObj, 0, approxSize);
9544 fmtObj->size = approxSize;
9545 fmtObj->maxPos = 0;
9546 fmtObj->scratch = (char *)&fmtObj->descr[maxCount + 1];
9547 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
9548 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
9549 buffer = fmtObj->stringRep + maxFmtLen + 1;
9550 objPtr->internalRep.ptr = fmtObj;
9551 objPtr->typePtr = &scanFmtStringObjType;
9552 for (i = 0, curr = 0; fmt < fmtEnd; ++fmt) {
9553 int width = 0, skip;
9554 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
9556 fmtObj->count++;
9557 descr->width = 0; /* Assume width unspecified */
9558 /* Overread and store any "literal" prefix */
9559 if (*fmt != '%' || fmt[1] == '%') {
9560 descr->type = 0;
9561 descr->prefix = &buffer[i];
9562 for (; fmt < fmtEnd; ++fmt) {
9563 if (*fmt == '%') {
9564 if (fmt[1] != '%')
9565 break;
9566 ++fmt;
9568 buffer[i++] = *fmt;
9570 buffer[i++] = 0;
9572 /* Skip the conversion introducing '%' sign */
9573 ++fmt;
9574 /* End reached due to non-conversion literal only? */
9575 if (fmt >= fmtEnd)
9576 goto done;
9577 descr->pos = 0; /* Assume "natural" positioning */
9578 if (*fmt == '*') {
9579 descr->pos = -1; /* Okay, conversion will not be assigned */
9580 ++fmt;
9582 else
9583 fmtObj->convCount++; /* Otherwise count as assign-conversion */
9584 /* Check if next token is a number (could be width or pos */
9585 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9586 fmt += skip;
9587 /* Was the number a XPG3 position specifier? */
9588 if (descr->pos != -1 && *fmt == '$') {
9589 int prev;
9591 ++fmt;
9592 descr->pos = width;
9593 width = 0;
9594 /* Look if "natural" postioning and XPG3 one was mixed */
9595 if ((lastPos == 0 && descr->pos > 0)
9596 || (lastPos > 0 && descr->pos == 0)) {
9597 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
9598 return JIM_ERR;
9600 /* Look if this position was already used */
9601 for (prev = 0; prev < curr; ++prev) {
9602 if (fmtObj->descr[prev].pos == -1)
9603 continue;
9604 if (fmtObj->descr[prev].pos == descr->pos) {
9605 fmtObj->error =
9606 "variable is assigned by multiple \"%n$\" conversion specifiers";
9607 return JIM_ERR;
9610 if (descr->pos < 0) {
9611 fmtObj->error =
9612 "\"%n$\" conversion specifier is negative";
9613 return JIM_ERR;
9615 /* Try to find a width after the XPG3 specifier */
9616 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9617 descr->width = width;
9618 fmt += skip;
9620 if (descr->pos > 0 && (size_t) descr->pos > fmtObj->maxPos)
9621 fmtObj->maxPos = descr->pos;
9623 else {
9624 /* Number was not a XPG3, so it has to be a width */
9625 descr->width = width;
9628 /* If positioning mode was undetermined yet, fix this */
9629 if (lastPos == -1)
9630 lastPos = descr->pos;
9631 /* Handle CHARSET conversion type ... */
9632 if (*fmt == '[') {
9633 int swapped = 1, beg = i, end, j;
9635 descr->type = '[';
9636 descr->arg = &buffer[i];
9637 ++fmt;
9638 if (*fmt == '^')
9639 buffer[i++] = *fmt++;
9640 if (*fmt == ']')
9641 buffer[i++] = *fmt++;
9642 while (*fmt && *fmt != ']')
9643 buffer[i++] = *fmt++;
9644 if (*fmt != ']') {
9645 fmtObj->error = "unmatched [ in format string";
9646 return JIM_ERR;
9648 end = i;
9649 buffer[i++] = 0;
9650 /* In case a range fence was given "backwards", swap it */
9651 while (swapped) {
9652 swapped = 0;
9653 for (j = beg + 1; j < end - 1; ++j) {
9654 if (buffer[j] == '-' && buffer[j - 1] > buffer[j + 1]) {
9655 char tmp = buffer[j - 1];
9657 buffer[j - 1] = buffer[j + 1];
9658 buffer[j + 1] = tmp;
9659 swapped = 1;
9664 else {
9665 /* Remember any valid modifier if given */
9666 if (fmt < fmtEnd && strchr("hlL", *fmt))
9667 descr->modifier = tolower((int)*fmt++);
9669 if (fmt >= fmtEnd) {
9670 fmtObj->error = "missing scan conversion character";
9671 return JIM_ERR;
9674 descr->type = *fmt;
9675 if (strchr("efgcsndoxui", *fmt) == 0) {
9676 fmtObj->error = "bad scan conversion character";
9677 return JIM_ERR;
9679 else if (*fmt == 'c' && descr->width != 0) {
9680 fmtObj->error = "field width may not be specified in %c " "conversion";
9681 return JIM_ERR;
9683 else if (*fmt == 'u' && descr->modifier == 'l') {
9684 fmtObj->error = "unsigned wide not supported";
9685 return JIM_ERR;
9688 curr++;
9690 done:
9691 return JIM_OK;
9694 /* Some accessor macros to allow lowlevel access to fields of internal repr */
9696 #define FormatGetCnvCount(_fo_) \
9697 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
9698 #define FormatGetMaxPos(_fo_) \
9699 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
9700 #define FormatGetError(_fo_) \
9701 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
9703 /* JimScanAString is used to scan an unspecified string that ends with
9704 * next WS, or a string that is specified via a charset.
9707 static Jim_Obj *JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
9709 char *buffer = Jim_StrDup(str);
9710 char *p = buffer;
9712 while (*str) {
9713 int c;
9714 int n;
9716 if (!sdescr && isspace(UCHAR(*str)))
9717 break; /* EOS via WS if unspecified */
9719 n = utf8_tounicode(str, &c);
9720 if (sdescr && !JimCharsetMatch(sdescr, c, JIM_CHARSET_SCAN))
9721 break;
9722 while (n--)
9723 *p++ = *str++;
9725 *p = 0;
9726 return Jim_NewStringObjNoAlloc(interp, buffer, p - buffer);
9729 /* ScanOneEntry will scan one entry out of the string passed as argument.
9730 * It use the sscanf() function for this task. After extracting and
9731 * converting of the value, the count of scanned characters will be
9732 * returned of -1 in case of no conversion tool place and string was
9733 * already scanned thru */
9735 static int ScanOneEntry(Jim_Interp *interp, const char *str, int pos, int strLen,
9736 ScanFmtStringObj * fmtObj, long idx, Jim_Obj **valObjPtr)
9738 const char *tok;
9739 const ScanFmtPartDescr *descr = &fmtObj->descr[idx];
9740 size_t scanned = 0;
9741 size_t anchor = pos;
9742 int i;
9743 Jim_Obj *tmpObj = NULL;
9745 /* First pessimistically assume, we will not scan anything :-) */
9746 *valObjPtr = 0;
9747 if (descr->prefix) {
9748 /* There was a prefix given before the conversion, skip it and adjust
9749 * the string-to-be-parsed accordingly */
9750 for (i = 0; pos < strLen && descr->prefix[i]; ++i) {
9751 /* If prefix require, skip WS */
9752 if (isspace(UCHAR(descr->prefix[i])))
9753 while (pos < strLen && isspace(UCHAR(str[pos])))
9754 ++pos;
9755 else if (descr->prefix[i] != str[pos])
9756 break; /* Prefix do not match here, leave the loop */
9757 else
9758 ++pos; /* Prefix matched so far, next round */
9760 if (pos >= strLen) {
9761 return -1; /* All of str consumed: EOF condition */
9763 else if (descr->prefix[i] != 0)
9764 return 0; /* Not whole prefix consumed, no conversion possible */
9766 /* For all but following conversion, skip leading WS */
9767 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
9768 while (isspace(UCHAR(str[pos])))
9769 ++pos;
9770 /* Determine how much skipped/scanned so far */
9771 scanned = pos - anchor;
9773 /* %c is a special, simple case. no width */
9774 if (descr->type == 'n') {
9775 /* Return pseudo conversion means: how much scanned so far? */
9776 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
9778 else if (pos >= strLen) {
9779 /* Cannot scan anything, as str is totally consumed */
9780 return -1;
9782 else if (descr->type == 'c') {
9783 int c;
9784 scanned += utf8_tounicode(&str[pos], &c);
9785 *valObjPtr = Jim_NewIntObj(interp, c);
9786 return scanned;
9788 else {
9789 /* Processing of conversions follows ... */
9790 if (descr->width > 0) {
9791 /* Do not try to scan as fas as possible but only the given width.
9792 * To ensure this, we copy the part that should be scanned. */
9793 size_t sLen = utf8_strlen(&str[pos], strLen - pos);
9794 size_t tLen = descr->width > sLen ? sLen : descr->width;
9796 tmpObj = Jim_NewStringObjUtf8(interp, str + pos, tLen);
9797 tok = tmpObj->bytes;
9799 else {
9800 /* As no width was given, simply refer to the original string */
9801 tok = &str[pos];
9803 switch (descr->type) {
9804 case 'd':
9805 case 'o':
9806 case 'x':
9807 case 'u':
9808 case 'i':{
9809 char *endp; /* Position where the number finished */
9810 jim_wide w;
9812 int base = descr->type == 'o' ? 8
9813 : descr->type == 'x' ? 16 : descr->type == 'i' ? 0 : 10;
9815 /* Try to scan a number with the given base */
9816 if (base == 0) {
9817 w = jim_strtoull(tok, &endp);
9819 else {
9820 w = strtoull(tok, &endp, base);
9823 if (endp != tok) {
9824 /* There was some number sucessfully scanned! */
9825 *valObjPtr = Jim_NewIntObj(interp, w);
9827 /* Adjust the number-of-chars scanned so far */
9828 scanned += endp - tok;
9830 else {
9831 /* Nothing was scanned. We have to determine if this
9832 * happened due to e.g. prefix mismatch or input str
9833 * exhausted */
9834 scanned = *tok ? 0 : -1;
9836 break;
9838 case 's':
9839 case '[':{
9840 *valObjPtr = JimScanAString(interp, descr->arg, tok);
9841 scanned += Jim_Length(*valObjPtr);
9842 break;
9844 case 'e':
9845 case 'f':
9846 case 'g':{
9847 char *endp;
9848 double value = strtod(tok, &endp);
9850 if (endp != tok) {
9851 /* There was some number sucessfully scanned! */
9852 *valObjPtr = Jim_NewDoubleObj(interp, value);
9853 /* Adjust the number-of-chars scanned so far */
9854 scanned += endp - tok;
9856 else {
9857 /* Nothing was scanned. We have to determine if this
9858 * happened due to e.g. prefix mismatch or input str
9859 * exhausted */
9860 scanned = *tok ? 0 : -1;
9862 break;
9865 /* If a substring was allocated (due to pre-defined width) do not
9866 * forget to free it */
9867 if (tmpObj) {
9868 Jim_FreeNewObj(interp, tmpObj);
9871 return scanned;
9874 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
9875 * string and returns all converted (and not ignored) values in a list back
9876 * to the caller. If an error occured, a NULL pointer will be returned */
9878 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *fmtObjPtr, int flags)
9880 size_t i, pos;
9881 int scanned = 1;
9882 const char *str = Jim_String(strObjPtr);
9883 int strLen = Jim_Utf8Length(interp, strObjPtr);
9884 Jim_Obj *resultList = 0;
9885 Jim_Obj **resultVec = 0;
9886 int resultc;
9887 Jim_Obj *emptyStr = 0;
9888 ScanFmtStringObj *fmtObj;
9890 /* This should never happen. The format object should already be of the correct type */
9891 JimPanic((fmtObjPtr->typePtr != &scanFmtStringObjType, "Jim_ScanString() for non-scan format"));
9893 fmtObj = (ScanFmtStringObj *) fmtObjPtr->internalRep.ptr;
9894 /* Check if format specification was valid */
9895 if (fmtObj->error != 0) {
9896 if (flags & JIM_ERRMSG)
9897 Jim_SetResultString(interp, fmtObj->error, -1);
9898 return 0;
9900 /* Allocate a new "shared" empty string for all unassigned conversions */
9901 emptyStr = Jim_NewEmptyStringObj(interp);
9902 Jim_IncrRefCount(emptyStr);
9903 /* Create a list and fill it with empty strings up to max specified XPG3 */
9904 resultList = Jim_NewListObj(interp, NULL, 0);
9905 if (fmtObj->maxPos > 0) {
9906 for (i = 0; i < fmtObj->maxPos; ++i)
9907 Jim_ListAppendElement(interp, resultList, emptyStr);
9908 JimListGetElements(interp, resultList, &resultc, &resultVec);
9910 /* Now handle every partial format description */
9911 for (i = 0, pos = 0; i < fmtObj->count; ++i) {
9912 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
9913 Jim_Obj *value = 0;
9915 /* Only last type may be "literal" w/o conversion - skip it! */
9916 if (descr->type == 0)
9917 continue;
9918 /* As long as any conversion could be done, we will proceed */
9919 if (scanned > 0)
9920 scanned = ScanOneEntry(interp, str, pos, strLen, fmtObj, i, &value);
9921 /* In case our first try results in EOF, we will leave */
9922 if (scanned == -1 && i == 0)
9923 goto eof;
9924 /* Advance next pos-to-be-scanned for the amount scanned already */
9925 pos += scanned;
9927 /* value == 0 means no conversion took place so take empty string */
9928 if (value == 0)
9929 value = Jim_NewEmptyStringObj(interp);
9930 /* If value is a non-assignable one, skip it */
9931 if (descr->pos == -1) {
9932 Jim_FreeNewObj(interp, value);
9934 else if (descr->pos == 0)
9935 /* Otherwise append it to the result list if no XPG3 was given */
9936 Jim_ListAppendElement(interp, resultList, value);
9937 else if (resultVec[descr->pos - 1] == emptyStr) {
9938 /* But due to given XPG3, put the value into the corr. slot */
9939 Jim_DecrRefCount(interp, resultVec[descr->pos - 1]);
9940 Jim_IncrRefCount(value);
9941 resultVec[descr->pos - 1] = value;
9943 else {
9944 /* Otherwise, the slot was already used - free obj and ERROR */
9945 Jim_FreeNewObj(interp, value);
9946 goto err;
9949 Jim_DecrRefCount(interp, emptyStr);
9950 return resultList;
9951 eof:
9952 Jim_DecrRefCount(interp, emptyStr);
9953 Jim_FreeNewObj(interp, resultList);
9954 return (Jim_Obj *)EOF;
9955 err:
9956 Jim_DecrRefCount(interp, emptyStr);
9957 Jim_FreeNewObj(interp, resultList);
9958 return 0;
9961 /* -----------------------------------------------------------------------------
9962 * Pseudo Random Number Generation
9963 * ---------------------------------------------------------------------------*/
9964 /* Initialize the sbox with the numbers from 0 to 255 */
9965 static void JimPrngInit(Jim_Interp *interp)
9967 #define PRNG_SEED_SIZE 256
9968 int i;
9969 unsigned int *seed;
9970 time_t t = time(NULL);
9972 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
9974 seed = Jim_Alloc(PRNG_SEED_SIZE * sizeof(*seed));
9975 for (i = 0; i < PRNG_SEED_SIZE; i++) {
9976 seed[i] = (rand() ^ t ^ clock());
9978 JimPrngSeed(interp, (unsigned char *)seed, PRNG_SEED_SIZE * sizeof(*seed));
9979 Jim_Free(seed);
9982 /* Generates N bytes of random data */
9983 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
9985 Jim_PrngState *prng;
9986 unsigned char *destByte = (unsigned char *)dest;
9987 unsigned int si, sj, x;
9989 /* initialization, only needed the first time */
9990 if (interp->prngState == NULL)
9991 JimPrngInit(interp);
9992 prng = interp->prngState;
9993 /* generates 'len' bytes of pseudo-random numbers */
9994 for (x = 0; x < len; x++) {
9995 prng->i = (prng->i + 1) & 0xff;
9996 si = prng->sbox[prng->i];
9997 prng->j = (prng->j + si) & 0xff;
9998 sj = prng->sbox[prng->j];
9999 prng->sbox[prng->i] = sj;
10000 prng->sbox[prng->j] = si;
10001 *destByte++ = prng->sbox[(si + sj) & 0xff];
10005 /* Re-seed the generator with user-provided bytes */
10006 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen)
10008 int i;
10009 Jim_PrngState *prng;
10011 /* initialization, only needed the first time */
10012 if (interp->prngState == NULL)
10013 JimPrngInit(interp);
10014 prng = interp->prngState;
10016 /* Set the sbox[i] with i */
10017 for (i = 0; i < 256; i++)
10018 prng->sbox[i] = i;
10019 /* Now use the seed to perform a random permutation of the sbox */
10020 for (i = 0; i < seedLen; i++) {
10021 unsigned char t;
10023 t = prng->sbox[i & 0xFF];
10024 prng->sbox[i & 0xFF] = prng->sbox[seed[i]];
10025 prng->sbox[seed[i]] = t;
10027 prng->i = prng->j = 0;
10029 /* discard at least the first 256 bytes of stream.
10030 * borrow the seed buffer for this
10032 for (i = 0; i < 256; i += seedLen) {
10033 JimRandomBytes(interp, seed, seedLen);
10037 /* [incr] */
10038 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10040 jim_wide wideValue, increment = 1;
10041 Jim_Obj *intObjPtr;
10043 if (argc != 2 && argc != 3) {
10044 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
10045 return JIM_ERR;
10047 if (argc == 3) {
10048 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
10049 return JIM_ERR;
10051 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
10052 if (!intObjPtr) {
10053 /* Set missing variable to 0 */
10054 wideValue = 0;
10056 else if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK) {
10057 return JIM_ERR;
10059 if (!intObjPtr || Jim_IsShared(intObjPtr)) {
10060 intObjPtr = Jim_NewIntObj(interp, wideValue + increment);
10061 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
10062 Jim_FreeNewObj(interp, intObjPtr);
10063 return JIM_ERR;
10066 else {
10067 /* Can do it the quick way */
10068 Jim_InvalidateStringRep(intObjPtr);
10069 JimWideValue(intObjPtr) = wideValue + increment;
10071 /* The following step is required in order to invalidate the
10072 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
10073 if (argv[1]->typePtr != &variableObjType) {
10074 /* Note that this can't fail since GetVariable already succeeded */
10075 Jim_SetVariable(interp, argv[1], intObjPtr);
10078 Jim_SetResult(interp, intObjPtr);
10079 return JIM_OK;
10083 /* -----------------------------------------------------------------------------
10084 * Eval
10085 * ---------------------------------------------------------------------------*/
10086 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
10087 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
10089 /* Handle calls to the [unknown] command */
10090 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10092 int retcode;
10094 /* If JimUnknown() is recursively called too many times...
10095 * done here
10097 if (interp->unknown_called > 50) {
10098 return JIM_ERR;
10101 /* The object interp->unknown just contains
10102 * the "unknown" string, it is used in order to
10103 * avoid to lookup the unknown command every time
10104 * but instead to cache the result. */
10106 /* If the [unknown] command does not exist ... */
10107 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
10108 return JIM_ERR;
10110 interp->unknown_called++;
10111 /* XXX: Are we losing fileNameObj and linenr? */
10112 retcode = Jim_EvalObjPrefix(interp, interp->unknown, argc, argv);
10113 interp->unknown_called--;
10115 return retcode;
10118 static int JimInvokeCommand(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10120 int retcode;
10121 Jim_Cmd *cmdPtr;
10122 void *prevPrivData;
10124 #if 0
10125 printf("invoke");
10126 int j;
10127 for (j = 0; j < objc; j++) {
10128 printf(" '%s'", Jim_String(objv[j]));
10130 printf("\n");
10131 #endif
10133 if (interp->framePtr->tailcallCmd) {
10134 /* Special tailcall command was pre-resolved */
10135 cmdPtr = interp->framePtr->tailcallCmd;
10136 interp->framePtr->tailcallCmd = NULL;
10138 else {
10139 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
10140 if (cmdPtr == NULL) {
10141 return JimUnknown(interp, objc, objv);
10143 JimIncrCmdRefCount(cmdPtr);
10146 if (interp->evalDepth == interp->maxEvalDepth) {
10147 Jim_SetResultString(interp, "Infinite eval recursion", -1);
10148 retcode = JIM_ERR;
10149 goto out;
10151 interp->evalDepth++;
10152 prevPrivData = interp->cmdPrivData;
10154 /* Call it -- Make sure result is an empty object. */
10155 Jim_SetEmptyResult(interp);
10156 if (cmdPtr->isproc) {
10157 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
10159 else {
10160 interp->cmdPrivData = cmdPtr->u.native.privData;
10161 retcode = cmdPtr->u.native.cmdProc(interp, objc, objv);
10163 interp->cmdPrivData = prevPrivData;
10164 interp->evalDepth--;
10166 out:
10167 JimDecrCmdRefCount(interp, cmdPtr);
10169 return retcode;
10172 /* Eval the object vector 'objv' composed of 'objc' elements.
10173 * Every element is used as single argument.
10174 * Jim_EvalObj() will call this function every time its object
10175 * argument is of "list" type, with no string representation.
10177 * This is possible because the string representation of a
10178 * list object generated by the UpdateStringOfList is made
10179 * in a way that ensures that every list element is a different
10180 * command argument. */
10181 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10183 int i, retcode;
10185 /* Incr refcount of arguments. */
10186 for (i = 0; i < objc; i++)
10187 Jim_IncrRefCount(objv[i]);
10189 retcode = JimInvokeCommand(interp, objc, objv);
10191 /* Decr refcount of arguments and return the retcode */
10192 for (i = 0; i < objc; i++)
10193 Jim_DecrRefCount(interp, objv[i]);
10195 return retcode;
10199 * Invokes 'prefix' as a command with the objv array as arguments.
10201 int Jim_EvalObjPrefix(Jim_Interp *interp, Jim_Obj *prefix, int objc, Jim_Obj *const *objv)
10203 int ret;
10204 Jim_Obj **nargv = Jim_Alloc((objc + 1) * sizeof(*nargv));
10206 nargv[0] = prefix;
10207 memcpy(&nargv[1], &objv[0], sizeof(nargv[0]) * objc);
10208 ret = Jim_EvalObjVector(interp, objc + 1, nargv);
10209 Jim_Free(nargv);
10210 return ret;
10213 static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script)
10215 if (!interp->errorFlag) {
10216 /* This is the first error, so save the file/line information and reset the stack */
10217 interp->errorFlag = 1;
10218 Jim_IncrRefCount(script->fileNameObj);
10219 Jim_DecrRefCount(interp, interp->errorFileNameObj);
10220 interp->errorFileNameObj = script->fileNameObj;
10221 interp->errorLine = script->linenr;
10223 JimResetStackTrace(interp);
10224 /* Always add a level where the error first occurs */
10225 interp->addStackTrace++;
10228 /* Now if this is an "interesting" level, add it to the stack trace */
10229 if (interp->addStackTrace > 0) {
10230 /* Add the stack info for the current level */
10232 JimAppendStackTrace(interp, Jim_String(interp->errorProc), script->fileNameObj, script->linenr);
10234 /* Note: if we didn't have a filename for this level,
10235 * don't clear the addStackTrace flag
10236 * so we can pick it up at the next level
10238 if (Jim_Length(script->fileNameObj)) {
10239 interp->addStackTrace = 0;
10242 Jim_DecrRefCount(interp, interp->errorProc);
10243 interp->errorProc = interp->emptyObj;
10244 Jim_IncrRefCount(interp->errorProc);
10248 static int JimSubstOneToken(Jim_Interp *interp, const ScriptToken *token, Jim_Obj **objPtrPtr)
10250 Jim_Obj *objPtr;
10251 int ret = JIM_ERR;
10253 switch (token->type) {
10254 case JIM_TT_STR:
10255 case JIM_TT_ESC:
10256 objPtr = token->objPtr;
10257 break;
10258 case JIM_TT_VAR:
10259 objPtr = Jim_GetVariable(interp, token->objPtr, JIM_ERRMSG);
10260 break;
10261 case JIM_TT_DICTSUGAR:
10262 objPtr = JimExpandDictSugar(interp, token->objPtr);
10263 break;
10264 case JIM_TT_EXPRSUGAR:
10265 ret = Jim_EvalExpression(interp, token->objPtr);
10266 if (ret == JIM_OK) {
10267 objPtr = Jim_GetResult(interp);
10269 else {
10270 objPtr = NULL;
10272 break;
10273 case JIM_TT_CMD:
10274 ret = Jim_EvalObj(interp, token->objPtr);
10275 if (ret == JIM_OK || ret == JIM_RETURN) {
10276 objPtr = interp->result;
10277 } else {
10278 /* includes JIM_BREAK, JIM_CONTINUE */
10279 objPtr = NULL;
10281 break;
10282 default:
10283 JimPanic((1,
10284 "default token type (%d) reached " "in Jim_SubstObj().", token->type));
10285 objPtr = NULL;
10286 break;
10288 if (objPtr) {
10289 *objPtrPtr = objPtr;
10290 return JIM_OK;
10292 return ret;
10295 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
10296 * via *objPtrPtr. This function is only called by Jim_EvalObj() and Jim_SubstObj()
10297 * The returned object has refcount = 0.
10299 static Jim_Obj *JimInterpolateTokens(Jim_Interp *interp, const ScriptToken * token, int tokens, int flags)
10301 int totlen = 0, i;
10302 Jim_Obj **intv;
10303 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
10304 Jim_Obj *objPtr;
10305 char *s;
10307 if (tokens <= JIM_EVAL_SINTV_LEN)
10308 intv = sintv;
10309 else
10310 intv = Jim_Alloc(sizeof(Jim_Obj *) * tokens);
10312 /* Compute every token forming the argument
10313 * in the intv objects vector. */
10314 for (i = 0; i < tokens; i++) {
10315 switch (JimSubstOneToken(interp, &token[i], &intv[i])) {
10316 case JIM_OK:
10317 case JIM_RETURN:
10318 break;
10319 case JIM_BREAK:
10320 if (flags & JIM_SUBST_FLAG) {
10321 /* Stop here */
10322 tokens = i;
10323 continue;
10325 /* XXX: Should probably set an error about break outside loop */
10326 /* fall through to error */
10327 case JIM_CONTINUE:
10328 if (flags & JIM_SUBST_FLAG) {
10329 intv[i] = NULL;
10330 continue;
10332 /* XXX: Ditto continue outside loop */
10333 /* fall through to error */
10334 default:
10335 while (i--) {
10336 Jim_DecrRefCount(interp, intv[i]);
10338 if (intv != sintv) {
10339 Jim_Free(intv);
10341 return NULL;
10343 Jim_IncrRefCount(intv[i]);
10344 Jim_String(intv[i]);
10345 totlen += intv[i]->length;
10348 /* Fast path return for a single token */
10349 if (tokens == 1 && intv[0] && intv == sintv) {
10350 /* Reverse the Jim_IncrRefCount() above, but don't free the object */
10351 intv[0]->refCount--;
10352 return intv[0];
10355 /* Concatenate every token in an unique
10356 * object. */
10357 objPtr = Jim_NewStringObjNoAlloc(interp, NULL, 0);
10359 if (tokens == 4 && token[0].type == JIM_TT_ESC && token[1].type == JIM_TT_ESC
10360 && token[2].type == JIM_TT_VAR) {
10361 /* May be able to do fast interpolated object -> dictSubst */
10362 objPtr->typePtr = &interpolatedObjType;
10363 objPtr->internalRep.dictSubstValue.varNameObjPtr = token[0].objPtr;
10364 objPtr->internalRep.dictSubstValue.indexObjPtr = intv[2];
10365 Jim_IncrRefCount(intv[2]);
10367 else if (tokens && intv[0] && intv[0]->typePtr == &sourceObjType) {
10368 /* The first interpolated token is source, so preserve the source info */
10369 JimSetSourceInfo(interp, objPtr, intv[0]->internalRep.sourceValue.fileNameObj, intv[0]->internalRep.sourceValue.lineNumber);
10373 s = objPtr->bytes = Jim_Alloc(totlen + 1);
10374 objPtr->length = totlen;
10375 for (i = 0; i < tokens; i++) {
10376 if (intv[i]) {
10377 memcpy(s, intv[i]->bytes, intv[i]->length);
10378 s += intv[i]->length;
10379 Jim_DecrRefCount(interp, intv[i]);
10382 objPtr->bytes[totlen] = '\0';
10383 /* Free the intv vector if not static. */
10384 if (intv != sintv) {
10385 Jim_Free(intv);
10388 return objPtr;
10392 /* listPtr *must* be a list.
10393 * The contents of the list is evaluated with the first element as the command and
10394 * the remaining elements as the arguments.
10396 static int JimEvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10398 int retcode = JIM_OK;
10400 JimPanic((Jim_IsList(listPtr) == 0, "JimEvalObjList() invoked on non-list."));
10402 if (listPtr->internalRep.listValue.len) {
10403 Jim_IncrRefCount(listPtr);
10404 retcode = JimInvokeCommand(interp,
10405 listPtr->internalRep.listValue.len,
10406 listPtr->internalRep.listValue.ele);
10407 Jim_DecrRefCount(interp, listPtr);
10409 return retcode;
10412 int Jim_EvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10414 SetListFromAny(interp, listPtr);
10415 return JimEvalObjList(interp, listPtr);
10418 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
10420 int i;
10421 ScriptObj *script;
10422 ScriptToken *token;
10423 int retcode = JIM_OK;
10424 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL;
10425 Jim_Obj *prevScriptObj;
10427 /* If the object is of type "list", with no string rep we can call
10428 * a specialized version of Jim_EvalObj() */
10429 if (Jim_IsList(scriptObjPtr) && scriptObjPtr->bytes == NULL) {
10430 return JimEvalObjList(interp, scriptObjPtr);
10433 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
10434 script = JimGetScript(interp, scriptObjPtr);
10435 if (!JimScriptValid(interp, script)) {
10436 Jim_DecrRefCount(interp, scriptObjPtr);
10437 return JIM_ERR;
10440 /* Reset the interpreter result. This is useful to
10441 * return the empty result in the case of empty program. */
10442 Jim_SetEmptyResult(interp);
10444 token = script->token;
10446 #ifdef JIM_OPTIMIZATION
10447 /* Check for one of the following common scripts used by for, while
10449 * {}
10450 * incr a
10452 if (script->len == 0) {
10453 Jim_DecrRefCount(interp, scriptObjPtr);
10454 return JIM_OK;
10456 if (script->len == 3
10457 && token[1].objPtr->typePtr == &commandObjType
10458 && token[1].objPtr->internalRep.cmdValue.cmdPtr->isproc == 0
10459 && token[1].objPtr->internalRep.cmdValue.cmdPtr->u.native.cmdProc == Jim_IncrCoreCommand
10460 && token[2].objPtr->typePtr == &variableObjType) {
10462 Jim_Obj *objPtr = Jim_GetVariable(interp, token[2].objPtr, JIM_NONE);
10464 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
10465 JimWideValue(objPtr)++;
10466 Jim_InvalidateStringRep(objPtr);
10467 Jim_DecrRefCount(interp, scriptObjPtr);
10468 Jim_SetResult(interp, objPtr);
10469 return JIM_OK;
10472 #endif
10474 /* Now we have to make sure the internal repr will not be
10475 * freed on shimmering.
10477 * Think for example to this:
10479 * set x {llength $x; ... some more code ...}; eval $x
10481 * In order to preserve the internal rep, we increment the
10482 * inUse field of the script internal rep structure. */
10483 script->inUse++;
10485 /* Stash the current script */
10486 prevScriptObj = interp->currentScriptObj;
10487 interp->currentScriptObj = scriptObjPtr;
10489 interp->errorFlag = 0;
10490 argv = sargv;
10492 /* Execute every command sequentially until the end of the script
10493 * or an error occurs.
10495 for (i = 0; i < script->len && retcode == JIM_OK; ) {
10496 int argc;
10497 int j;
10499 /* First token of the line is always JIM_TT_LINE */
10500 argc = token[i].objPtr->internalRep.scriptLineValue.argc;
10501 script->linenr = token[i].objPtr->internalRep.scriptLineValue.line;
10503 /* Allocate the arguments vector if required */
10504 if (argc > JIM_EVAL_SARGV_LEN)
10505 argv = Jim_Alloc(sizeof(Jim_Obj *) * argc);
10507 /* Skip the JIM_TT_LINE token */
10508 i++;
10510 /* Populate the arguments objects.
10511 * If an error occurs, retcode will be set and
10512 * 'j' will be set to the number of args expanded
10514 for (j = 0; j < argc; j++) {
10515 long wordtokens = 1;
10516 int expand = 0;
10517 Jim_Obj *wordObjPtr = NULL;
10519 if (token[i].type == JIM_TT_WORD) {
10520 wordtokens = JimWideValue(token[i++].objPtr);
10521 if (wordtokens < 0) {
10522 expand = 1;
10523 wordtokens = -wordtokens;
10527 if (wordtokens == 1) {
10528 /* Fast path if the token does not
10529 * need interpolation */
10531 switch (token[i].type) {
10532 case JIM_TT_ESC:
10533 case JIM_TT_STR:
10534 wordObjPtr = token[i].objPtr;
10535 break;
10536 case JIM_TT_VAR:
10537 wordObjPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
10538 break;
10539 case JIM_TT_EXPRSUGAR:
10540 retcode = Jim_EvalExpression(interp, token[i].objPtr);
10541 if (retcode == JIM_OK) {
10542 wordObjPtr = Jim_GetResult(interp);
10544 else {
10545 wordObjPtr = NULL;
10547 break;
10548 case JIM_TT_DICTSUGAR:
10549 wordObjPtr = JimExpandDictSugar(interp, token[i].objPtr);
10550 break;
10551 case JIM_TT_CMD:
10552 retcode = Jim_EvalObj(interp, token[i].objPtr);
10553 if (retcode == JIM_OK) {
10554 wordObjPtr = Jim_GetResult(interp);
10556 break;
10557 default:
10558 JimPanic((1, "default token type reached " "in Jim_EvalObj()."));
10561 else {
10562 /* For interpolation we call a helper
10563 * function to do the work for us. */
10564 wordObjPtr = JimInterpolateTokens(interp, token + i, wordtokens, JIM_NONE);
10567 if (!wordObjPtr) {
10568 if (retcode == JIM_OK) {
10569 retcode = JIM_ERR;
10571 break;
10574 Jim_IncrRefCount(wordObjPtr);
10575 i += wordtokens;
10577 if (!expand) {
10578 argv[j] = wordObjPtr;
10580 else {
10581 /* Need to expand wordObjPtr into multiple args from argv[j] ... */
10582 int len = Jim_ListLength(interp, wordObjPtr);
10583 int newargc = argc + len - 1;
10584 int k;
10586 if (len > 1) {
10587 if (argv == sargv) {
10588 if (newargc > JIM_EVAL_SARGV_LEN) {
10589 argv = Jim_Alloc(sizeof(*argv) * newargc);
10590 memcpy(argv, sargv, sizeof(*argv) * j);
10593 else {
10594 /* Need to realloc to make room for (len - 1) more entries */
10595 argv = Jim_Realloc(argv, sizeof(*argv) * newargc);
10599 /* Now copy in the expanded version */
10600 for (k = 0; k < len; k++) {
10601 argv[j++] = wordObjPtr->internalRep.listValue.ele[k];
10602 Jim_IncrRefCount(wordObjPtr->internalRep.listValue.ele[k]);
10605 /* The original object reference is no longer needed,
10606 * after the expansion it is no longer present on
10607 * the argument vector, but the single elements are
10608 * in its place. */
10609 Jim_DecrRefCount(interp, wordObjPtr);
10611 /* And update the indexes */
10612 j--;
10613 argc += len - 1;
10617 if (retcode == JIM_OK && argc) {
10618 /* Invoke the command */
10619 retcode = JimInvokeCommand(interp, argc, argv);
10620 /* Check for a signal after each command */
10621 if (Jim_CheckSignal(interp)) {
10622 retcode = JIM_SIGNAL;
10626 /* Finished with the command, so decrement ref counts of each argument */
10627 while (j-- > 0) {
10628 Jim_DecrRefCount(interp, argv[j]);
10631 if (argv != sargv) {
10632 Jim_Free(argv);
10633 argv = sargv;
10637 /* Possibly add to the error stack trace */
10638 if (retcode == JIM_ERR) {
10639 JimAddErrorToStack(interp, script);
10641 /* Propagate the addStackTrace value through 'return -code error' */
10642 else if (retcode != JIM_RETURN || interp->returnCode != JIM_ERR) {
10643 /* No need to add stack trace */
10644 interp->addStackTrace = 0;
10647 /* Restore the current script */
10648 interp->currentScriptObj = prevScriptObj;
10650 /* Note that we don't have to decrement inUse, because the
10651 * following code transfers our use of the reference again to
10652 * the script object. */
10653 Jim_FreeIntRep(interp, scriptObjPtr);
10654 scriptObjPtr->typePtr = &scriptObjType;
10655 Jim_SetIntRepPtr(scriptObjPtr, script);
10656 Jim_DecrRefCount(interp, scriptObjPtr);
10658 return retcode;
10661 static int JimSetProcArg(Jim_Interp *interp, Jim_Obj *argNameObj, Jim_Obj *argValObj)
10663 int retcode;
10664 /* If argObjPtr begins with '&', do an automatic upvar */
10665 const char *varname = Jim_String(argNameObj);
10666 if (*varname == '&') {
10667 /* First check that the target variable exists */
10668 Jim_Obj *objPtr;
10669 Jim_CallFrame *savedCallFrame = interp->framePtr;
10671 interp->framePtr = interp->framePtr->parent;
10672 objPtr = Jim_GetVariable(interp, argValObj, JIM_ERRMSG);
10673 interp->framePtr = savedCallFrame;
10674 if (!objPtr) {
10675 return JIM_ERR;
10678 /* It exists, so perform the binding. */
10679 objPtr = Jim_NewStringObj(interp, varname + 1, -1);
10680 Jim_IncrRefCount(objPtr);
10681 retcode = Jim_SetVariableLink(interp, objPtr, argValObj, interp->framePtr->parent);
10682 Jim_DecrRefCount(interp, objPtr);
10684 else {
10685 retcode = Jim_SetVariable(interp, argNameObj, argValObj);
10687 return retcode;
10691 * Sets the interp result to be an error message indicating the required proc args.
10693 static void JimSetProcWrongArgs(Jim_Interp *interp, Jim_Obj *procNameObj, Jim_Cmd *cmd)
10695 /* Create a nice error message, consistent with Tcl 8.5 */
10696 Jim_Obj *argmsg = Jim_NewStringObj(interp, "", 0);
10697 int i;
10699 for (i = 0; i < cmd->u.proc.argListLen; i++) {
10700 Jim_AppendString(interp, argmsg, " ", 1);
10702 if (i == cmd->u.proc.argsPos) {
10703 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10704 /* Renamed args */
10705 Jim_AppendString(interp, argmsg, "?", 1);
10706 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].defaultObjPtr);
10707 Jim_AppendString(interp, argmsg, " ...?", -1);
10709 else {
10710 /* We have plain args */
10711 Jim_AppendString(interp, argmsg, "?arg...?", -1);
10714 else {
10715 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10716 Jim_AppendString(interp, argmsg, "?", 1);
10717 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].nameObjPtr);
10718 Jim_AppendString(interp, argmsg, "?", 1);
10720 else {
10721 const char *arg = Jim_String(cmd->u.proc.arglist[i].nameObjPtr);
10722 if (*arg == '&') {
10723 arg++;
10725 Jim_AppendString(interp, argmsg, arg, -1);
10729 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s%#s\"", procNameObj, argmsg);
10732 #ifdef jim_ext_namespace
10734 * [namespace eval]
10736 int Jim_EvalNamespace(Jim_Interp *interp, Jim_Obj *scriptObj, Jim_Obj *nsObj)
10738 Jim_CallFrame *callFramePtr;
10739 int retcode;
10741 /* Create a new callframe */
10742 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, nsObj);
10743 callFramePtr->argv = &interp->emptyObj;
10744 callFramePtr->argc = 0;
10745 callFramePtr->procArgsObjPtr = NULL;
10746 callFramePtr->procBodyObjPtr = scriptObj;
10747 callFramePtr->staticVars = NULL;
10748 callFramePtr->fileNameObj = interp->emptyObj;
10749 callFramePtr->line = 0;
10750 Jim_IncrRefCount(scriptObj);
10751 interp->framePtr = callFramePtr;
10753 /* Check if there are too nested calls */
10754 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10755 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10756 retcode = JIM_ERR;
10758 else {
10759 /* Eval the body */
10760 retcode = Jim_EvalObj(interp, scriptObj);
10763 /* Destroy the callframe */
10764 interp->framePtr = interp->framePtr->parent;
10765 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10767 return retcode;
10769 #endif
10771 /* Call a procedure implemented in Tcl.
10772 * It's possible to speed-up a lot this function, currently
10773 * the callframes are not cached, but allocated and
10774 * destroied every time. What is expecially costly is
10775 * to create/destroy the local vars hash table every time.
10777 * This can be fixed just implementing callframes caching
10778 * in JimCreateCallFrame() and JimFreeCallFrame(). */
10779 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv)
10781 Jim_CallFrame *callFramePtr;
10782 int i, d, retcode, optargs;
10783 ScriptObj *script;
10785 /* Check arity */
10786 if (argc - 1 < cmd->u.proc.reqArity ||
10787 (cmd->u.proc.argsPos < 0 && argc - 1 > cmd->u.proc.reqArity + cmd->u.proc.optArity)) {
10788 JimSetProcWrongArgs(interp, argv[0], cmd);
10789 return JIM_ERR;
10792 if (Jim_Length(cmd->u.proc.bodyObjPtr) == 0) {
10793 /* Optimise for procedure with no body - useful for optional debugging */
10794 return JIM_OK;
10797 /* Check if there are too nested calls */
10798 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10799 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10800 return JIM_ERR;
10803 /* Create a new callframe */
10804 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, cmd->u.proc.nsObj);
10805 callFramePtr->argv = argv;
10806 callFramePtr->argc = argc;
10807 callFramePtr->procArgsObjPtr = cmd->u.proc.argListObjPtr;
10808 callFramePtr->procBodyObjPtr = cmd->u.proc.bodyObjPtr;
10809 callFramePtr->staticVars = cmd->u.proc.staticVars;
10811 /* Remember where we were called from. */
10812 script = JimGetScript(interp, interp->currentScriptObj);
10813 callFramePtr->fileNameObj = script->fileNameObj;
10814 callFramePtr->line = script->linenr;
10816 Jim_IncrRefCount(cmd->u.proc.argListObjPtr);
10817 Jim_IncrRefCount(cmd->u.proc.bodyObjPtr);
10818 interp->framePtr = callFramePtr;
10820 /* How many optional args are available */
10821 optargs = (argc - 1 - cmd->u.proc.reqArity);
10823 /* Step 'i' along the actual args, and step 'd' along the formal args */
10824 i = 1;
10825 for (d = 0; d < cmd->u.proc.argListLen; d++) {
10826 Jim_Obj *nameObjPtr = cmd->u.proc.arglist[d].nameObjPtr;
10827 if (d == cmd->u.proc.argsPos) {
10828 /* assign $args */
10829 Jim_Obj *listObjPtr;
10830 int argsLen = 0;
10831 if (cmd->u.proc.reqArity + cmd->u.proc.optArity < argc - 1) {
10832 argsLen = argc - 1 - (cmd->u.proc.reqArity + cmd->u.proc.optArity);
10834 listObjPtr = Jim_NewListObj(interp, &argv[i], argsLen);
10836 /* It is possible to rename args. */
10837 if (cmd->u.proc.arglist[d].defaultObjPtr) {
10838 nameObjPtr =cmd->u.proc.arglist[d].defaultObjPtr;
10840 retcode = Jim_SetVariable(interp, nameObjPtr, listObjPtr);
10841 if (retcode != JIM_OK) {
10842 goto badargset;
10845 i += argsLen;
10846 continue;
10849 /* Optional or required? */
10850 if (cmd->u.proc.arglist[d].defaultObjPtr == NULL || optargs-- > 0) {
10851 retcode = JimSetProcArg(interp, nameObjPtr, argv[i++]);
10853 else {
10854 /* Ran out, so use the default */
10855 retcode = Jim_SetVariable(interp, nameObjPtr, cmd->u.proc.arglist[d].defaultObjPtr);
10857 if (retcode != JIM_OK) {
10858 goto badargset;
10862 /* Eval the body */
10863 retcode = Jim_EvalObj(interp, cmd->u.proc.bodyObjPtr);
10865 badargset:
10867 /* Invoke $jim::defer then destroy the callframe */
10868 retcode = JimInvokeDefer(interp, retcode);
10869 interp->framePtr = interp->framePtr->parent;
10870 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10872 /* Now chain any tailcalls in the parent frame */
10873 if (interp->framePtr->tailcallObj) {
10874 do {
10875 Jim_Obj *tailcallObj = interp->framePtr->tailcallObj;
10877 interp->framePtr->tailcallObj = NULL;
10879 if (retcode == JIM_EVAL) {
10880 retcode = Jim_EvalObjList(interp, tailcallObj);
10881 if (retcode == JIM_RETURN) {
10882 /* If the result of the tailcall is 'return', push
10883 * it up to the caller
10885 interp->returnLevel++;
10888 Jim_DecrRefCount(interp, tailcallObj);
10889 } while (interp->framePtr->tailcallObj);
10891 /* If the tailcall chain finished early, may need to manually discard the command */
10892 if (interp->framePtr->tailcallCmd) {
10893 JimDecrCmdRefCount(interp, interp->framePtr->tailcallCmd);
10894 interp->framePtr->tailcallCmd = NULL;
10898 /* Handle the JIM_RETURN return code */
10899 if (retcode == JIM_RETURN) {
10900 if (--interp->returnLevel <= 0) {
10901 retcode = interp->returnCode;
10902 interp->returnCode = JIM_OK;
10903 interp->returnLevel = 0;
10906 else if (retcode == JIM_ERR) {
10907 interp->addStackTrace++;
10908 Jim_DecrRefCount(interp, interp->errorProc);
10909 interp->errorProc = argv[0];
10910 Jim_IncrRefCount(interp->errorProc);
10913 return retcode;
10916 int Jim_EvalSource(Jim_Interp *interp, const char *filename, int lineno, const char *script)
10918 int retval;
10919 Jim_Obj *scriptObjPtr;
10921 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
10922 Jim_IncrRefCount(scriptObjPtr);
10924 if (filename) {
10925 Jim_Obj *prevScriptObj;
10927 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), lineno);
10929 prevScriptObj = interp->currentScriptObj;
10930 interp->currentScriptObj = scriptObjPtr;
10932 retval = Jim_EvalObj(interp, scriptObjPtr);
10934 interp->currentScriptObj = prevScriptObj;
10936 else {
10937 retval = Jim_EvalObj(interp, scriptObjPtr);
10939 Jim_DecrRefCount(interp, scriptObjPtr);
10940 return retval;
10943 int Jim_Eval(Jim_Interp *interp, const char *script)
10945 return Jim_EvalObj(interp, Jim_NewStringObj(interp, script, -1));
10948 /* Execute script in the scope of the global level */
10949 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
10951 int retval;
10952 Jim_CallFrame *savedFramePtr = interp->framePtr;
10954 interp->framePtr = interp->topFramePtr;
10955 retval = Jim_Eval(interp, script);
10956 interp->framePtr = savedFramePtr;
10958 return retval;
10961 int Jim_EvalFileGlobal(Jim_Interp *interp, const char *filename)
10963 int retval;
10964 Jim_CallFrame *savedFramePtr = interp->framePtr;
10966 interp->framePtr = interp->topFramePtr;
10967 retval = Jim_EvalFile(interp, filename);
10968 interp->framePtr = savedFramePtr;
10970 return retval;
10973 #include <sys/stat.h>
10975 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
10977 FILE *fp;
10978 char *buf;
10979 Jim_Obj *scriptObjPtr;
10980 Jim_Obj *prevScriptObj;
10981 struct stat sb;
10982 int retcode;
10983 int readlen;
10985 if (stat(filename, &sb) != 0 || (fp = fopen(filename, "rt")) == NULL) {
10986 Jim_SetResultFormatted(interp, "couldn't read file \"%s\": %s", filename, strerror(errno));
10987 return JIM_ERR;
10989 if (sb.st_size == 0) {
10990 fclose(fp);
10991 return JIM_OK;
10994 buf = Jim_Alloc(sb.st_size + 1);
10995 readlen = fread(buf, 1, sb.st_size, fp);
10996 if (ferror(fp)) {
10997 fclose(fp);
10998 Jim_Free(buf);
10999 Jim_SetResultFormatted(interp, "failed to load file \"%s\": %s", filename, strerror(errno));
11000 return JIM_ERR;
11002 fclose(fp);
11003 buf[readlen] = 0;
11005 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, buf, readlen);
11006 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), 1);
11007 Jim_IncrRefCount(scriptObjPtr);
11009 prevScriptObj = interp->currentScriptObj;
11010 interp->currentScriptObj = scriptObjPtr;
11012 retcode = Jim_EvalObj(interp, scriptObjPtr);
11014 /* Handle the JIM_RETURN return code */
11015 if (retcode == JIM_RETURN) {
11016 if (--interp->returnLevel <= 0) {
11017 retcode = interp->returnCode;
11018 interp->returnCode = JIM_OK;
11019 interp->returnLevel = 0;
11022 if (retcode == JIM_ERR) {
11023 /* EvalFile changes context, so add a stack frame here */
11024 interp->addStackTrace++;
11027 interp->currentScriptObj = prevScriptObj;
11029 Jim_DecrRefCount(interp, scriptObjPtr);
11031 return retcode;
11034 /* -----------------------------------------------------------------------------
11035 * Subst
11036 * ---------------------------------------------------------------------------*/
11037 static void JimParseSubst(struct JimParserCtx *pc, int flags)
11039 pc->tstart = pc->p;
11040 pc->tline = pc->linenr;
11042 if (pc->len == 0) {
11043 pc->tend = pc->p;
11044 pc->tt = JIM_TT_EOL;
11045 pc->eof = 1;
11046 return;
11048 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11049 JimParseCmd(pc);
11050 return;
11052 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11053 if (JimParseVar(pc) == JIM_OK) {
11054 return;
11056 /* Not a var, so treat as a string */
11057 pc->tstart = pc->p;
11058 flags |= JIM_SUBST_NOVAR;
11060 while (pc->len) {
11061 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11062 break;
11064 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11065 break;
11067 if (*pc->p == '\\' && pc->len > 1) {
11068 pc->p++;
11069 pc->len--;
11071 pc->p++;
11072 pc->len--;
11074 pc->tend = pc->p - 1;
11075 pc->tt = (flags & JIM_SUBST_NOESC) ? JIM_TT_STR : JIM_TT_ESC;
11078 /* The subst object type reuses most of the data structures and functions
11079 * of the script object. Script's data structures are a bit more complex
11080 * for what is needed for [subst]itution tasks, but the reuse helps to
11081 * deal with a single data structure at the cost of some more memory
11082 * usage for substitutions. */
11084 /* This method takes the string representation of an object
11085 * as a Tcl string where to perform [subst]itution, and generates
11086 * the pre-parsed internal representation. */
11087 static int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
11089 int scriptTextLen;
11090 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
11091 struct JimParserCtx parser;
11092 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
11093 ParseTokenList tokenlist;
11095 /* Initially parse the subst into tokens (in tokenlist) */
11096 ScriptTokenListInit(&tokenlist);
11098 JimParserInit(&parser, scriptText, scriptTextLen, 1);
11099 while (1) {
11100 JimParseSubst(&parser, flags);
11101 if (parser.eof) {
11102 /* Note that subst doesn't need the EOL token */
11103 break;
11105 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
11106 parser.tline);
11109 /* Create the "real" subst/script tokens from the initial token list */
11110 script->inUse = 1;
11111 script->substFlags = flags;
11112 script->fileNameObj = interp->emptyObj;
11113 Jim_IncrRefCount(script->fileNameObj);
11114 SubstObjAddTokens(interp, script, &tokenlist);
11116 /* No longer need the token list */
11117 ScriptTokenListFree(&tokenlist);
11119 #ifdef DEBUG_SHOW_SUBST
11121 int i;
11123 printf("==== Subst ====\n");
11124 for (i = 0; i < script->len; i++) {
11125 printf("[%2d] %s '%s'\n", i, jim_tt_name(script->token[i].type),
11126 Jim_String(script->token[i].objPtr));
11129 #endif
11131 /* Free the old internal rep and set the new one. */
11132 Jim_FreeIntRep(interp, objPtr);
11133 Jim_SetIntRepPtr(objPtr, script);
11134 objPtr->typePtr = &scriptObjType;
11135 return JIM_OK;
11138 static ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
11140 if (objPtr->typePtr != &scriptObjType || ((ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags != flags)
11141 SetSubstFromAny(interp, objPtr, flags);
11142 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
11145 /* Performs commands,variables,blackslashes substitution,
11146 * storing the result object (with refcount 0) into
11147 * resObjPtrPtr. */
11148 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr, Jim_Obj **resObjPtrPtr, int flags)
11150 ScriptObj *script;
11152 JimPanic((substObjPtr->refCount == 0, "Jim_SubstObj() called with zero refcount object"));
11154 script = Jim_GetSubst(interp, substObjPtr, flags);
11156 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
11157 /* In order to preserve the internal rep, we increment the
11158 * inUse field of the script internal rep structure. */
11159 script->inUse++;
11161 *resObjPtrPtr = JimInterpolateTokens(interp, script->token, script->len, flags);
11163 script->inUse--;
11164 Jim_DecrRefCount(interp, substObjPtr);
11165 if (*resObjPtrPtr == NULL) {
11166 return JIM_ERR;
11168 return JIM_OK;
11171 /* -----------------------------------------------------------------------------
11172 * Core commands utility functions
11173 * ---------------------------------------------------------------------------*/
11174 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv, const char *msg)
11176 Jim_Obj *objPtr;
11177 Jim_Obj *listObjPtr;
11179 JimPanic((argc == 0, "Jim_WrongNumArgs() called with argc=0"));
11181 listObjPtr = Jim_NewListObj(interp, argv, argc);
11183 if (msg && *msg) {
11184 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, msg, -1));
11186 Jim_IncrRefCount(listObjPtr);
11187 objPtr = Jim_ListJoin(interp, listObjPtr, " ", 1);
11188 Jim_DecrRefCount(interp, listObjPtr);
11190 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s\"", objPtr);
11194 * May add the key and/or value to the list.
11196 typedef void JimHashtableIteratorCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr,
11197 Jim_HashEntry *he, int type);
11199 #define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL)
11202 * For each key of the hash table 'ht' (with string keys) which matches the glob pattern (all if NULL),
11203 * invoke the callback to add entries to a list.
11204 * Returns the list.
11206 static Jim_Obj *JimHashtablePatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
11207 JimHashtableIteratorCallbackType *callback, int type)
11209 Jim_HashEntry *he;
11210 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
11212 /* Check for the non-pattern case. We can do this much more efficiently. */
11213 if (patternObjPtr && JimTrivialMatch(Jim_String(patternObjPtr))) {
11214 he = Jim_FindHashEntry(ht, Jim_String(patternObjPtr));
11215 if (he) {
11216 callback(interp, listObjPtr, he, type);
11219 else {
11220 Jim_HashTableIterator htiter;
11221 JimInitHashTableIterator(ht, &htiter);
11222 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
11223 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), he->key, 0)) {
11224 callback(interp, listObjPtr, he, type);
11228 return listObjPtr;
11231 /* Keep these in order */
11232 #define JIM_CMDLIST_COMMANDS 0
11233 #define JIM_CMDLIST_PROCS 1
11234 #define JIM_CMDLIST_CHANNELS 2
11237 * Adds matching command names (procs, channels) to the list.
11239 static void JimCommandMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11240 Jim_HashEntry *he, int type)
11242 Jim_Cmd *cmdPtr = Jim_GetHashEntryVal(he);
11243 Jim_Obj *objPtr;
11245 if (type == JIM_CMDLIST_PROCS && !cmdPtr->isproc) {
11246 /* not a proc */
11247 return;
11250 objPtr = Jim_NewStringObj(interp, he->key, -1);
11251 Jim_IncrRefCount(objPtr);
11253 if (type != JIM_CMDLIST_CHANNELS || Jim_AioFilehandle(interp, objPtr)) {
11254 Jim_ListAppendElement(interp, listObjPtr, objPtr);
11256 Jim_DecrRefCount(interp, objPtr);
11259 /* type is JIM_CMDLIST_xxx */
11260 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int type)
11262 return JimHashtablePatternMatch(interp, &interp->commands, patternObjPtr, JimCommandMatch, type);
11265 /* Keep these in order */
11266 #define JIM_VARLIST_GLOBALS 0
11267 #define JIM_VARLIST_LOCALS 1
11268 #define JIM_VARLIST_VARS 2
11270 #define JIM_VARLIST_VALUES 0x1000
11273 * Adds matching variable names to the list.
11275 static void JimVariablesMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11276 Jim_HashEntry *he, int type)
11278 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
11280 if (type != JIM_VARLIST_LOCALS || varPtr->linkFramePtr == NULL) {
11281 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, he->key, -1));
11282 if (type & JIM_VARLIST_VALUES) {
11283 Jim_ListAppendElement(interp, listObjPtr, varPtr->objPtr);
11288 /* mode is JIM_VARLIST_xxx */
11289 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int mode)
11291 if (mode == JIM_VARLIST_LOCALS && interp->framePtr == interp->topFramePtr) {
11292 /* For [info locals], if we are at top level an emtpy list
11293 * is returned. I don't agree, but we aim at compatibility (SS) */
11294 return interp->emptyObj;
11296 else {
11297 Jim_CallFrame *framePtr = (mode == JIM_VARLIST_GLOBALS) ? interp->topFramePtr : interp->framePtr;
11298 return JimHashtablePatternMatch(interp, &framePtr->vars, patternObjPtr, JimVariablesMatch, mode);
11302 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
11303 Jim_Obj **objPtrPtr, int info_level_cmd)
11305 Jim_CallFrame *targetCallFrame;
11307 targetCallFrame = JimGetCallFrameByInteger(interp, levelObjPtr);
11308 if (targetCallFrame == NULL) {
11309 return JIM_ERR;
11311 /* No proc call at toplevel callframe */
11312 if (targetCallFrame == interp->topFramePtr) {
11313 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
11314 return JIM_ERR;
11316 if (info_level_cmd) {
11317 *objPtrPtr = Jim_NewListObj(interp, targetCallFrame->argv, targetCallFrame->argc);
11319 else {
11320 Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0);
11322 Jim_ListAppendElement(interp, listObj, targetCallFrame->argv[0]);
11323 Jim_ListAppendElement(interp, listObj, targetCallFrame->fileNameObj);
11324 Jim_ListAppendElement(interp, listObj, Jim_NewIntObj(interp, targetCallFrame->line));
11325 *objPtrPtr = listObj;
11327 return JIM_OK;
11330 /* -----------------------------------------------------------------------------
11331 * Core commands
11332 * ---------------------------------------------------------------------------*/
11334 /* fake [puts] -- not the real puts, just for debugging. */
11335 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11337 if (argc != 2 && argc != 3) {
11338 Jim_WrongNumArgs(interp, 1, argv, "?-nonewline? string");
11339 return JIM_ERR;
11341 if (argc == 3) {
11342 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline")) {
11343 Jim_SetResultString(interp, "The second argument must " "be -nonewline", -1);
11344 return JIM_ERR;
11346 else {
11347 fputs(Jim_String(argv[2]), stdout);
11350 else {
11351 puts(Jim_String(argv[1]));
11353 return JIM_OK;
11356 /* Helper for [+] and [*] */
11357 static int JimAddMulHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11359 jim_wide wideValue, res;
11360 double doubleValue, doubleRes;
11361 int i;
11363 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
11365 for (i = 1; i < argc; i++) {
11366 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
11367 goto trydouble;
11368 if (op == JIM_EXPROP_ADD)
11369 res += wideValue;
11370 else
11371 res *= wideValue;
11373 Jim_SetResultInt(interp, res);
11374 return JIM_OK;
11375 trydouble:
11376 doubleRes = (double)res;
11377 for (; i < argc; i++) {
11378 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11379 return JIM_ERR;
11380 if (op == JIM_EXPROP_ADD)
11381 doubleRes += doubleValue;
11382 else
11383 doubleRes *= doubleValue;
11385 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11386 return JIM_OK;
11389 /* Helper for [-] and [/] */
11390 static int JimSubDivHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11392 jim_wide wideValue, res = 0;
11393 double doubleValue, doubleRes = 0;
11394 int i = 2;
11396 if (argc < 2) {
11397 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
11398 return JIM_ERR;
11400 else if (argc == 2) {
11401 /* The arity = 2 case is different. For [- x] returns -x,
11402 * while [/ x] returns 1/x. */
11403 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
11404 if (Jim_GetDouble(interp, argv[1], &doubleValue) != JIM_OK) {
11405 return JIM_ERR;
11407 else {
11408 if (op == JIM_EXPROP_SUB)
11409 doubleRes = -doubleValue;
11410 else
11411 doubleRes = 1.0 / doubleValue;
11412 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11413 return JIM_OK;
11416 if (op == JIM_EXPROP_SUB) {
11417 res = -wideValue;
11418 Jim_SetResultInt(interp, res);
11420 else {
11421 doubleRes = 1.0 / wideValue;
11422 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11424 return JIM_OK;
11426 else {
11427 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
11428 if (Jim_GetDouble(interp, argv[1], &doubleRes)
11429 != JIM_OK) {
11430 return JIM_ERR;
11432 else {
11433 goto trydouble;
11437 for (i = 2; i < argc; i++) {
11438 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
11439 doubleRes = (double)res;
11440 goto trydouble;
11442 if (op == JIM_EXPROP_SUB)
11443 res -= wideValue;
11444 else {
11445 if (wideValue == 0) {
11446 Jim_SetResultString(interp, "Division by zero", -1);
11447 return JIM_ERR;
11449 res /= wideValue;
11452 Jim_SetResultInt(interp, res);
11453 return JIM_OK;
11454 trydouble:
11455 for (; i < argc; i++) {
11456 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11457 return JIM_ERR;
11458 if (op == JIM_EXPROP_SUB)
11459 doubleRes -= doubleValue;
11460 else
11461 doubleRes /= doubleValue;
11463 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11464 return JIM_OK;
11468 /* [+] */
11469 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11471 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
11474 /* [*] */
11475 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11477 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
11480 /* [-] */
11481 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11483 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
11486 /* [/] */
11487 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11489 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
11492 /* [set] */
11493 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11495 if (argc != 2 && argc != 3) {
11496 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
11497 return JIM_ERR;
11499 if (argc == 2) {
11500 Jim_Obj *objPtr;
11502 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11503 if (!objPtr)
11504 return JIM_ERR;
11505 Jim_SetResult(interp, objPtr);
11506 return JIM_OK;
11508 /* argc == 3 case. */
11509 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
11510 return JIM_ERR;
11511 Jim_SetResult(interp, argv[2]);
11512 return JIM_OK;
11515 /* [unset]
11517 * unset ?-nocomplain? ?--? ?varName ...?
11519 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11521 int i = 1;
11522 int complain = 1;
11524 while (i < argc) {
11525 if (Jim_CompareStringImmediate(interp, argv[i], "--")) {
11526 i++;
11527 break;
11529 if (Jim_CompareStringImmediate(interp, argv[i], "-nocomplain")) {
11530 complain = 0;
11531 i++;
11532 continue;
11534 break;
11537 while (i < argc) {
11538 if (Jim_UnsetVariable(interp, argv[i], complain ? JIM_ERRMSG : JIM_NONE) != JIM_OK
11539 && complain) {
11540 return JIM_ERR;
11542 i++;
11544 return JIM_OK;
11547 /* [while] */
11548 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11550 if (argc != 3) {
11551 Jim_WrongNumArgs(interp, 1, argv, "condition body");
11552 return JIM_ERR;
11555 /* The general purpose implementation of while starts here */
11556 while (1) {
11557 int boolean, retval;
11559 if ((retval = Jim_GetBoolFromExpr(interp, argv[1], &boolean)) != JIM_OK)
11560 return retval;
11561 if (!boolean)
11562 break;
11564 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
11565 switch (retval) {
11566 case JIM_BREAK:
11567 goto out;
11568 break;
11569 case JIM_CONTINUE:
11570 continue;
11571 break;
11572 default:
11573 return retval;
11577 out:
11578 Jim_SetEmptyResult(interp);
11579 return JIM_OK;
11582 /* [for] */
11583 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11585 int retval;
11586 int boolean = 1;
11587 Jim_Obj *varNamePtr = NULL;
11588 Jim_Obj *stopVarNamePtr = NULL;
11590 if (argc != 5) {
11591 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
11592 return JIM_ERR;
11595 /* Do the initialisation */
11596 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK) {
11597 return retval;
11600 /* And do the first test now. Better for optimisation
11601 * if we can do next/test at the bottom of the loop
11603 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11605 /* Ready to do the body as follows:
11606 * while (1) {
11607 * body // check retcode
11608 * next // check retcode
11609 * test // check retcode/test bool
11613 #ifdef JIM_OPTIMIZATION
11614 /* Check if the for is on the form:
11615 * for ... {$i < CONST} {incr i}
11616 * for ... {$i < $j} {incr i}
11618 if (retval == JIM_OK && boolean) {
11619 ScriptObj *incrScript;
11620 struct ExprTree *expr;
11621 jim_wide stop, currentVal;
11622 Jim_Obj *objPtr;
11623 int cmpOffset;
11625 /* Do it only if there aren't shared arguments */
11626 expr = JimGetExpression(interp, argv[2]);
11627 incrScript = JimGetScript(interp, argv[3]);
11629 /* Ensure proper lengths to start */
11630 if (incrScript == NULL || incrScript->len != 3 || !expr || expr->len != 3) {
11631 goto evalstart;
11633 /* Ensure proper token types. */
11634 if (incrScript->token[1].type != JIM_TT_ESC) {
11635 goto evalstart;
11638 if (expr->expr->type == JIM_EXPROP_LT) {
11639 cmpOffset = 0;
11641 else if (expr->expr->type == JIM_EXPROP_LTE) {
11642 cmpOffset = 1;
11644 else {
11645 goto evalstart;
11648 if (expr->expr->left->type != JIM_TT_VAR) {
11649 goto evalstart;
11652 if (expr->expr->right->type != JIM_TT_VAR && expr->expr->right->type != JIM_TT_EXPR_INT) {
11653 goto evalstart;
11656 /* Update command must be incr */
11657 if (!Jim_CompareStringImmediate(interp, incrScript->token[1].objPtr, "incr")) {
11658 goto evalstart;
11661 /* incr, expression must be about the same variable */
11662 if (!Jim_StringEqObj(incrScript->token[2].objPtr, expr->expr->left->objPtr)) {
11663 goto evalstart;
11666 /* Get the stop condition (must be a variable or integer) */
11667 if (expr->expr->right->type == JIM_TT_EXPR_INT) {
11668 if (Jim_GetWide(interp, expr->expr->right->objPtr, &stop) == JIM_ERR) {
11669 goto evalstart;
11672 else {
11673 stopVarNamePtr = expr->expr->right->objPtr;
11674 Jim_IncrRefCount(stopVarNamePtr);
11675 /* Keep the compiler happy */
11676 stop = 0;
11679 /* Initialization */
11680 varNamePtr = expr->expr->left->objPtr;
11681 Jim_IncrRefCount(varNamePtr);
11683 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
11684 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK) {
11685 goto testcond;
11688 /* --- OPTIMIZED FOR --- */
11689 while (retval == JIM_OK) {
11690 /* === Check condition === */
11691 /* Note that currentVal is already set here */
11693 /* Immediate or Variable? get the 'stop' value if the latter. */
11694 if (stopVarNamePtr) {
11695 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
11696 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &stop) != JIM_OK) {
11697 goto testcond;
11701 if (currentVal >= stop + cmpOffset) {
11702 break;
11705 /* Eval body */
11706 retval = Jim_EvalObj(interp, argv[4]);
11707 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11708 retval = JIM_OK;
11710 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
11712 /* Increment */
11713 if (objPtr == NULL) {
11714 retval = JIM_ERR;
11715 goto out;
11717 if (!Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11718 currentVal = ++JimWideValue(objPtr);
11719 Jim_InvalidateStringRep(objPtr);
11721 else {
11722 if (Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK ||
11723 Jim_SetVariable(interp, varNamePtr, Jim_NewIntObj(interp,
11724 ++currentVal)) != JIM_OK) {
11725 goto evalnext;
11730 goto out;
11732 evalstart:
11733 #endif
11735 while (boolean && (retval == JIM_OK || retval == JIM_CONTINUE)) {
11736 /* Body */
11737 retval = Jim_EvalObj(interp, argv[4]);
11739 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11740 /* increment */
11741 JIM_IF_OPTIM(evalnext:)
11742 retval = Jim_EvalObj(interp, argv[3]);
11743 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11744 /* test */
11745 JIM_IF_OPTIM(testcond:)
11746 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11750 JIM_IF_OPTIM(out:)
11751 if (stopVarNamePtr) {
11752 Jim_DecrRefCount(interp, stopVarNamePtr);
11754 if (varNamePtr) {
11755 Jim_DecrRefCount(interp, varNamePtr);
11758 if (retval == JIM_CONTINUE || retval == JIM_BREAK || retval == JIM_OK) {
11759 Jim_SetEmptyResult(interp);
11760 return JIM_OK;
11763 return retval;
11766 /* [loop] */
11767 static int Jim_LoopCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11769 int retval;
11770 jim_wide i;
11771 jim_wide limit;
11772 jim_wide incr = 1;
11773 Jim_Obj *bodyObjPtr;
11775 if (argc != 5 && argc != 6) {
11776 Jim_WrongNumArgs(interp, 1, argv, "var first limit ?incr? body");
11777 return JIM_ERR;
11780 if (Jim_GetWide(interp, argv[2], &i) != JIM_OK ||
11781 Jim_GetWide(interp, argv[3], &limit) != JIM_OK ||
11782 (argc == 6 && Jim_GetWide(interp, argv[4], &incr) != JIM_OK)) {
11783 return JIM_ERR;
11785 bodyObjPtr = (argc == 5) ? argv[4] : argv[5];
11787 retval = Jim_SetVariable(interp, argv[1], argv[2]);
11789 while (((i < limit && incr > 0) || (i > limit && incr < 0)) && retval == JIM_OK) {
11790 retval = Jim_EvalObj(interp, bodyObjPtr);
11791 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11792 Jim_Obj *objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11794 retval = JIM_OK;
11796 /* Increment */
11797 i += incr;
11799 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11800 if (argv[1]->typePtr != &variableObjType) {
11801 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11802 return JIM_ERR;
11805 JimWideValue(objPtr) = i;
11806 Jim_InvalidateStringRep(objPtr);
11808 /* The following step is required in order to invalidate the
11809 * string repr of "FOO" if the var name is of the form of "FOO(IDX)" */
11810 if (argv[1]->typePtr != &variableObjType) {
11811 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11812 retval = JIM_ERR;
11813 break;
11817 else {
11818 objPtr = Jim_NewIntObj(interp, i);
11819 retval = Jim_SetVariable(interp, argv[1], objPtr);
11820 if (retval != JIM_OK) {
11821 Jim_FreeNewObj(interp, objPtr);
11827 if (retval == JIM_OK || retval == JIM_CONTINUE || retval == JIM_BREAK) {
11828 Jim_SetEmptyResult(interp);
11829 return JIM_OK;
11831 return retval;
11834 /* List iterators make it easy to iterate over a list.
11835 * At some point iterators will be expanded to support generators.
11837 typedef struct {
11838 Jim_Obj *objPtr;
11839 int idx;
11840 } Jim_ListIter;
11843 * Initialise the iterator at the start of the list.
11845 static void JimListIterInit(Jim_ListIter *iter, Jim_Obj *objPtr)
11847 iter->objPtr = objPtr;
11848 iter->idx = 0;
11852 * Returns the next object from the list, or NULL on end-of-list.
11854 static Jim_Obj *JimListIterNext(Jim_Interp *interp, Jim_ListIter *iter)
11856 if (iter->idx >= Jim_ListLength(interp, iter->objPtr)) {
11857 return NULL;
11859 return iter->objPtr->internalRep.listValue.ele[iter->idx++];
11863 * Returns 1 if end-of-list has been reached.
11865 static int JimListIterDone(Jim_Interp *interp, Jim_ListIter *iter)
11867 return iter->idx >= Jim_ListLength(interp, iter->objPtr);
11870 /* foreach + lmap implementation. */
11871 static int JimForeachMapHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int doMap)
11873 int result = JIM_OK;
11874 int i, numargs;
11875 Jim_ListIter twoiters[2]; /* Avoid allocation for a single list */
11876 Jim_ListIter *iters;
11877 Jim_Obj *script;
11878 Jim_Obj *resultObj;
11880 if (argc < 4 || argc % 2 != 0) {
11881 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
11882 return JIM_ERR;
11884 script = argv[argc - 1]; /* Last argument is a script */
11885 numargs = (argc - 1 - 1); /* argc - 'foreach' - script */
11887 if (numargs == 2) {
11888 iters = twoiters;
11890 else {
11891 iters = Jim_Alloc(numargs * sizeof(*iters));
11893 for (i = 0; i < numargs; i++) {
11894 JimListIterInit(&iters[i], argv[i + 1]);
11895 if (i % 2 == 0 && JimListIterDone(interp, &iters[i])) {
11896 result = JIM_ERR;
11899 if (result != JIM_OK) {
11900 Jim_SetResultString(interp, "foreach varlist is empty", -1);
11901 goto empty_varlist;
11904 if (doMap) {
11905 resultObj = Jim_NewListObj(interp, NULL, 0);
11907 else {
11908 resultObj = interp->emptyObj;
11910 Jim_IncrRefCount(resultObj);
11912 while (1) {
11913 /* Have we expired all lists? */
11914 for (i = 0; i < numargs; i += 2) {
11915 if (!JimListIterDone(interp, &iters[i + 1])) {
11916 break;
11919 if (i == numargs) {
11920 /* All done */
11921 break;
11924 /* For each list */
11925 for (i = 0; i < numargs; i += 2) {
11926 Jim_Obj *varName;
11928 /* foreach var */
11929 JimListIterInit(&iters[i], argv[i + 1]);
11930 while ((varName = JimListIterNext(interp, &iters[i])) != NULL) {
11931 Jim_Obj *valObj = JimListIterNext(interp, &iters[i + 1]);
11932 if (!valObj) {
11933 /* Ran out, so store the empty string */
11934 valObj = interp->emptyObj;
11936 /* Avoid shimmering */
11937 Jim_IncrRefCount(valObj);
11938 result = Jim_SetVariable(interp, varName, valObj);
11939 Jim_DecrRefCount(interp, valObj);
11940 if (result != JIM_OK) {
11941 goto err;
11945 switch (result = Jim_EvalObj(interp, script)) {
11946 case JIM_OK:
11947 if (doMap) {
11948 Jim_ListAppendElement(interp, resultObj, interp->result);
11950 break;
11951 case JIM_CONTINUE:
11952 break;
11953 case JIM_BREAK:
11954 goto out;
11955 default:
11956 goto err;
11959 out:
11960 result = JIM_OK;
11961 Jim_SetResult(interp, resultObj);
11962 err:
11963 Jim_DecrRefCount(interp, resultObj);
11964 empty_varlist:
11965 if (numargs > 2) {
11966 Jim_Free(iters);
11968 return result;
11971 /* [foreach] */
11972 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11974 return JimForeachMapHelper(interp, argc, argv, 0);
11977 /* [lmap] */
11978 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11980 return JimForeachMapHelper(interp, argc, argv, 1);
11983 /* [lassign] */
11984 static int Jim_LassignCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11986 int result = JIM_ERR;
11987 int i;
11988 Jim_ListIter iter;
11989 Jim_Obj *resultObj;
11991 if (argc < 2) {
11992 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varName ...?");
11993 return JIM_ERR;
11996 JimListIterInit(&iter, argv[1]);
11998 for (i = 2; i < argc; i++) {
11999 Jim_Obj *valObj = JimListIterNext(interp, &iter);
12000 result = Jim_SetVariable(interp, argv[i], valObj ? valObj : interp->emptyObj);
12001 if (result != JIM_OK) {
12002 return result;
12006 resultObj = Jim_NewListObj(interp, NULL, 0);
12007 while (!JimListIterDone(interp, &iter)) {
12008 Jim_ListAppendElement(interp, resultObj, JimListIterNext(interp, &iter));
12011 Jim_SetResult(interp, resultObj);
12013 return JIM_OK;
12016 /* [if] */
12017 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12019 int boolean, retval, current = 1, falsebody = 0;
12021 if (argc >= 3) {
12022 while (1) {
12023 /* Far not enough arguments given! */
12024 if (current >= argc)
12025 goto err;
12026 if ((retval = Jim_GetBoolFromExpr(interp, argv[current++], &boolean))
12027 != JIM_OK)
12028 return retval;
12029 /* There lacks something, isn't it? */
12030 if (current >= argc)
12031 goto err;
12032 if (Jim_CompareStringImmediate(interp, argv[current], "then"))
12033 current++;
12034 /* Tsk tsk, no then-clause? */
12035 if (current >= argc)
12036 goto err;
12037 if (boolean)
12038 return Jim_EvalObj(interp, argv[current]);
12039 /* Ok: no else-clause follows */
12040 if (++current >= argc) {
12041 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
12042 return JIM_OK;
12044 falsebody = current++;
12045 if (Jim_CompareStringImmediate(interp, argv[falsebody], "else")) {
12046 /* IIICKS - else-clause isn't last cmd? */
12047 if (current != argc - 1)
12048 goto err;
12049 return Jim_EvalObj(interp, argv[current]);
12051 else if (Jim_CompareStringImmediate(interp, argv[falsebody], "elseif"))
12052 /* Ok: elseif follows meaning all the stuff
12053 * again (how boring...) */
12054 continue;
12055 /* OOPS - else-clause is not last cmd? */
12056 else if (falsebody != argc - 1)
12057 goto err;
12058 return Jim_EvalObj(interp, argv[falsebody]);
12060 return JIM_OK;
12062 err:
12063 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
12064 return JIM_ERR;
12068 /* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)*/
12069 int Jim_CommandMatchObj(Jim_Interp *interp, Jim_Obj *commandObj, Jim_Obj *patternObj,
12070 Jim_Obj *stringObj, int nocase)
12072 Jim_Obj *parms[4];
12073 int argc = 0;
12074 long eq;
12075 int rc;
12077 parms[argc++] = commandObj;
12078 if (nocase) {
12079 parms[argc++] = Jim_NewStringObj(interp, "-nocase", -1);
12081 parms[argc++] = patternObj;
12082 parms[argc++] = stringObj;
12084 rc = Jim_EvalObjVector(interp, argc, parms);
12086 if (rc != JIM_OK || Jim_GetLong(interp, Jim_GetResult(interp), &eq) != JIM_OK) {
12087 eq = -rc;
12090 return eq;
12093 /* [switch] */
12094 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12096 enum { SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD };
12097 int matchOpt = SWITCH_EXACT, opt = 1, patCount, i;
12098 Jim_Obj *command = NULL, *scriptObj = NULL, *strObj;
12099 Jim_Obj **caseList;
12101 if (argc < 3) {
12102 wrongnumargs:
12103 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
12104 "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}");
12105 return JIM_ERR;
12107 for (opt = 1; opt < argc; ++opt) {
12108 const char *option = Jim_String(argv[opt]);
12110 if (*option != '-')
12111 break;
12112 else if (strncmp(option, "--", 2) == 0) {
12113 ++opt;
12114 break;
12116 else if (strncmp(option, "-exact", 2) == 0)
12117 matchOpt = SWITCH_EXACT;
12118 else if (strncmp(option, "-glob", 2) == 0)
12119 matchOpt = SWITCH_GLOB;
12120 else if (strncmp(option, "-regexp", 2) == 0)
12121 matchOpt = SWITCH_RE;
12122 else if (strncmp(option, "-command", 2) == 0) {
12123 matchOpt = SWITCH_CMD;
12124 if ((argc - opt) < 2)
12125 goto wrongnumargs;
12126 command = argv[++opt];
12128 else {
12129 Jim_SetResultFormatted(interp,
12130 "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --",
12131 argv[opt]);
12132 return JIM_ERR;
12134 if ((argc - opt) < 2)
12135 goto wrongnumargs;
12137 strObj = argv[opt++];
12138 patCount = argc - opt;
12139 if (patCount == 1) {
12140 JimListGetElements(interp, argv[opt], &patCount, &caseList);
12142 else
12143 caseList = (Jim_Obj **)&argv[opt];
12144 if (patCount == 0 || patCount % 2 != 0)
12145 goto wrongnumargs;
12146 for (i = 0; scriptObj == NULL && i < patCount; i += 2) {
12147 Jim_Obj *patObj = caseList[i];
12149 if (!Jim_CompareStringImmediate(interp, patObj, "default")
12150 || i < (patCount - 2)) {
12151 switch (matchOpt) {
12152 case SWITCH_EXACT:
12153 if (Jim_StringEqObj(strObj, patObj))
12154 scriptObj = caseList[i + 1];
12155 break;
12156 case SWITCH_GLOB:
12157 if (Jim_StringMatchObj(interp, patObj, strObj, 0))
12158 scriptObj = caseList[i + 1];
12159 break;
12160 case SWITCH_RE:
12161 command = Jim_NewStringObj(interp, "regexp", -1);
12162 /* Fall thru intentionally */
12163 case SWITCH_CMD:{
12164 int rc = Jim_CommandMatchObj(interp, command, patObj, strObj, 0);
12166 /* After the execution of a command we need to
12167 * make sure to reconvert the object into a list
12168 * again. Only for the single-list style [switch]. */
12169 if (argc - opt == 1) {
12170 JimListGetElements(interp, argv[opt], &patCount, &caseList);
12172 /* command is here already decref'd */
12173 if (rc < 0) {
12174 return -rc;
12176 if (rc)
12177 scriptObj = caseList[i + 1];
12178 break;
12182 else {
12183 scriptObj = caseList[i + 1];
12186 for (; i < patCount && Jim_CompareStringImmediate(interp, scriptObj, "-"); i += 2)
12187 scriptObj = caseList[i + 1];
12188 if (scriptObj && Jim_CompareStringImmediate(interp, scriptObj, "-")) {
12189 Jim_SetResultFormatted(interp, "no body specified for pattern \"%#s\"", caseList[i - 2]);
12190 return JIM_ERR;
12192 Jim_SetEmptyResult(interp);
12193 if (scriptObj) {
12194 return Jim_EvalObj(interp, scriptObj);
12196 return JIM_OK;
12199 /* [list] */
12200 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12202 Jim_Obj *listObjPtr;
12204 listObjPtr = Jim_NewListObj(interp, argv + 1, argc - 1);
12205 Jim_SetResult(interp, listObjPtr);
12206 return JIM_OK;
12209 /* [lindex] */
12210 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12212 Jim_Obj *objPtr, *listObjPtr;
12213 int i;
12214 int idx;
12216 if (argc < 2) {
12217 Jim_WrongNumArgs(interp, 1, argv, "list ?index ...?");
12218 return JIM_ERR;
12220 objPtr = argv[1];
12221 Jim_IncrRefCount(objPtr);
12222 for (i = 2; i < argc; i++) {
12223 listObjPtr = objPtr;
12224 if (Jim_GetIndex(interp, argv[i], &idx) != JIM_OK) {
12225 Jim_DecrRefCount(interp, listObjPtr);
12226 return JIM_ERR;
12228 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_NONE) != JIM_OK) {
12229 /* Returns an empty object if the index
12230 * is out of range. */
12231 Jim_DecrRefCount(interp, listObjPtr);
12232 Jim_SetEmptyResult(interp);
12233 return JIM_OK;
12235 Jim_IncrRefCount(objPtr);
12236 Jim_DecrRefCount(interp, listObjPtr);
12238 Jim_SetResult(interp, objPtr);
12239 Jim_DecrRefCount(interp, objPtr);
12240 return JIM_OK;
12243 /* [llength] */
12244 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12246 if (argc != 2) {
12247 Jim_WrongNumArgs(interp, 1, argv, "list");
12248 return JIM_ERR;
12250 Jim_SetResultInt(interp, Jim_ListLength(interp, argv[1]));
12251 return JIM_OK;
12254 /* [lsearch] */
12255 static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12257 static const char * const options[] = {
12258 "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
12259 NULL
12261 enum
12262 { OPT_BOOL, OPT_NOT, OPT_NOCASE, OPT_EXACT, OPT_GLOB, OPT_REGEXP, OPT_ALL, OPT_INLINE,
12263 OPT_COMMAND };
12264 int i;
12265 int opt_bool = 0;
12266 int opt_not = 0;
12267 int opt_nocase = 0;
12268 int opt_all = 0;
12269 int opt_inline = 0;
12270 int opt_match = OPT_EXACT;
12271 int listlen;
12272 int rc = JIM_OK;
12273 Jim_Obj *listObjPtr = NULL;
12274 Jim_Obj *commandObj = NULL;
12276 if (argc < 3) {
12277 wrongargs:
12278 Jim_WrongNumArgs(interp, 1, argv,
12279 "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
12280 return JIM_ERR;
12283 for (i = 1; i < argc - 2; i++) {
12284 int option;
12286 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG) != JIM_OK) {
12287 return JIM_ERR;
12289 switch (option) {
12290 case OPT_BOOL:
12291 opt_bool = 1;
12292 opt_inline = 0;
12293 break;
12294 case OPT_NOT:
12295 opt_not = 1;
12296 break;
12297 case OPT_NOCASE:
12298 opt_nocase = 1;
12299 break;
12300 case OPT_INLINE:
12301 opt_inline = 1;
12302 opt_bool = 0;
12303 break;
12304 case OPT_ALL:
12305 opt_all = 1;
12306 break;
12307 case OPT_COMMAND:
12308 if (i >= argc - 2) {
12309 goto wrongargs;
12311 commandObj = argv[++i];
12312 /* fallthru */
12313 case OPT_EXACT:
12314 case OPT_GLOB:
12315 case OPT_REGEXP:
12316 opt_match = option;
12317 break;
12321 argv += i;
12323 if (opt_all) {
12324 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12326 if (opt_match == OPT_REGEXP) {
12327 commandObj = Jim_NewStringObj(interp, "regexp", -1);
12329 if (commandObj) {
12330 Jim_IncrRefCount(commandObj);
12333 listlen = Jim_ListLength(interp, argv[0]);
12334 for (i = 0; i < listlen; i++) {
12335 int eq = 0;
12336 Jim_Obj *objPtr = Jim_ListGetIndex(interp, argv[0], i);
12338 switch (opt_match) {
12339 case OPT_EXACT:
12340 eq = Jim_StringCompareObj(interp, argv[1], objPtr, opt_nocase) == 0;
12341 break;
12343 case OPT_GLOB:
12344 eq = Jim_StringMatchObj(interp, argv[1], objPtr, opt_nocase);
12345 break;
12347 case OPT_REGEXP:
12348 case OPT_COMMAND:
12349 eq = Jim_CommandMatchObj(interp, commandObj, argv[1], objPtr, opt_nocase);
12350 if (eq < 0) {
12351 if (listObjPtr) {
12352 Jim_FreeNewObj(interp, listObjPtr);
12354 rc = JIM_ERR;
12355 goto done;
12357 break;
12360 /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
12361 if (!eq && opt_bool && opt_not && !opt_all) {
12362 continue;
12365 if ((!opt_bool && eq == !opt_not) || (opt_bool && (eq || opt_all))) {
12366 /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
12367 Jim_Obj *resultObj;
12369 if (opt_bool) {
12370 resultObj = Jim_NewIntObj(interp, eq ^ opt_not);
12372 else if (!opt_inline) {
12373 resultObj = Jim_NewIntObj(interp, i);
12375 else {
12376 resultObj = objPtr;
12379 if (opt_all) {
12380 Jim_ListAppendElement(interp, listObjPtr, resultObj);
12382 else {
12383 Jim_SetResult(interp, resultObj);
12384 goto done;
12389 if (opt_all) {
12390 Jim_SetResult(interp, listObjPtr);
12392 else {
12393 /* No match */
12394 if (opt_bool) {
12395 Jim_SetResultBool(interp, opt_not);
12397 else if (!opt_inline) {
12398 Jim_SetResultInt(interp, -1);
12402 done:
12403 if (commandObj) {
12404 Jim_DecrRefCount(interp, commandObj);
12406 return rc;
12409 /* [lappend] */
12410 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12412 Jim_Obj *listObjPtr;
12413 int new_obj = 0;
12414 int i;
12416 if (argc < 2) {
12417 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
12418 return JIM_ERR;
12420 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12421 if (!listObjPtr) {
12422 /* Create the list if it does not exist */
12423 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12424 new_obj = 1;
12426 else if (Jim_IsShared(listObjPtr)) {
12427 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
12428 new_obj = 1;
12430 for (i = 2; i < argc; i++)
12431 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
12432 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
12433 if (new_obj)
12434 Jim_FreeNewObj(interp, listObjPtr);
12435 return JIM_ERR;
12437 Jim_SetResult(interp, listObjPtr);
12438 return JIM_OK;
12441 /* [linsert] */
12442 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12444 int idx, len;
12445 Jim_Obj *listPtr;
12447 if (argc < 3) {
12448 Jim_WrongNumArgs(interp, 1, argv, "list index ?element ...?");
12449 return JIM_ERR;
12451 listPtr = argv[1];
12452 if (Jim_IsShared(listPtr))
12453 listPtr = Jim_DuplicateObj(interp, listPtr);
12454 if (Jim_GetIndex(interp, argv[2], &idx) != JIM_OK)
12455 goto err;
12456 len = Jim_ListLength(interp, listPtr);
12457 if (idx >= len)
12458 idx = len;
12459 else if (idx < 0)
12460 idx = len + idx + 1;
12461 Jim_ListInsertElements(interp, listPtr, idx, argc - 3, &argv[3]);
12462 Jim_SetResult(interp, listPtr);
12463 return JIM_OK;
12464 err:
12465 if (listPtr != argv[1]) {
12466 Jim_FreeNewObj(interp, listPtr);
12468 return JIM_ERR;
12471 /* [lreplace] */
12472 static int Jim_LreplaceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12474 int first, last, len, rangeLen;
12475 Jim_Obj *listObj;
12476 Jim_Obj *newListObj;
12478 if (argc < 4) {
12479 Jim_WrongNumArgs(interp, 1, argv, "list first last ?element ...?");
12480 return JIM_ERR;
12482 if (Jim_GetIndex(interp, argv[2], &first) != JIM_OK ||
12483 Jim_GetIndex(interp, argv[3], &last) != JIM_OK) {
12484 return JIM_ERR;
12487 listObj = argv[1];
12488 len = Jim_ListLength(interp, listObj);
12490 first = JimRelToAbsIndex(len, first);
12491 last = JimRelToAbsIndex(len, last);
12492 JimRelToAbsRange(len, &first, &last, &rangeLen);
12494 /* Now construct a new list which consists of:
12495 * <elements before first> <supplied elements> <elements after last>
12498 /* Trying to replace past the end of the list means end of list
12499 * See TIP #505
12501 if (first > len) {
12502 first = len;
12505 /* Add the first set of elements */
12506 newListObj = Jim_NewListObj(interp, listObj->internalRep.listValue.ele, first);
12508 /* Add supplied elements */
12509 ListInsertElements(newListObj, -1, argc - 4, argv + 4);
12511 /* Add the remaining elements */
12512 ListInsertElements(newListObj, -1, len - first - rangeLen, listObj->internalRep.listValue.ele + first + rangeLen);
12514 Jim_SetResult(interp, newListObj);
12515 return JIM_OK;
12518 /* [lset] */
12519 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12521 if (argc < 3) {
12522 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
12523 return JIM_ERR;
12525 else if (argc == 3) {
12526 /* With no indexes, simply implements [set] */
12527 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
12528 return JIM_ERR;
12529 Jim_SetResult(interp, argv[2]);
12530 return JIM_OK;
12532 return Jim_ListSetIndex(interp, argv[1], argv + 2, argc - 3, argv[argc - 1]);
12535 /* [lsort] */
12536 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
12538 static const char * const options[] = {
12539 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", NULL
12541 enum
12542 { OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_REAL, OPT_INDEX, OPT_UNIQUE };
12543 Jim_Obj *resObj;
12544 int i;
12545 int retCode;
12546 int shared;
12548 struct lsort_info info;
12550 if (argc < 2) {
12551 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
12552 return JIM_ERR;
12555 info.type = JIM_LSORT_ASCII;
12556 info.order = 1;
12557 info.indexed = 0;
12558 info.unique = 0;
12559 info.command = NULL;
12560 info.interp = interp;
12562 for (i = 1; i < (argc - 1); i++) {
12563 int option;
12565 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ENUM_ABBREV | JIM_ERRMSG)
12566 != JIM_OK)
12567 return JIM_ERR;
12568 switch (option) {
12569 case OPT_ASCII:
12570 info.type = JIM_LSORT_ASCII;
12571 break;
12572 case OPT_NOCASE:
12573 info.type = JIM_LSORT_NOCASE;
12574 break;
12575 case OPT_INTEGER:
12576 info.type = JIM_LSORT_INTEGER;
12577 break;
12578 case OPT_REAL:
12579 info.type = JIM_LSORT_REAL;
12580 break;
12581 case OPT_INCREASING:
12582 info.order = 1;
12583 break;
12584 case OPT_DECREASING:
12585 info.order = -1;
12586 break;
12587 case OPT_UNIQUE:
12588 info.unique = 1;
12589 break;
12590 case OPT_COMMAND:
12591 if (i >= (argc - 2)) {
12592 Jim_SetResultString(interp, "\"-command\" option must be followed by comparison command", -1);
12593 return JIM_ERR;
12595 info.type = JIM_LSORT_COMMAND;
12596 info.command = argv[i + 1];
12597 i++;
12598 break;
12599 case OPT_INDEX:
12600 if (i >= (argc - 2)) {
12601 Jim_SetResultString(interp, "\"-index\" option must be followed by list index", -1);
12602 return JIM_ERR;
12604 if (Jim_GetIndex(interp, argv[i + 1], &info.index) != JIM_OK) {
12605 return JIM_ERR;
12607 info.indexed = 1;
12608 i++;
12609 break;
12612 resObj = argv[argc - 1];
12613 if ((shared = Jim_IsShared(resObj)))
12614 resObj = Jim_DuplicateObj(interp, resObj);
12615 retCode = ListSortElements(interp, resObj, &info);
12616 if (retCode == JIM_OK) {
12617 Jim_SetResult(interp, resObj);
12619 else if (shared) {
12620 Jim_FreeNewObj(interp, resObj);
12622 return retCode;
12625 /* [append] */
12626 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12628 Jim_Obj *stringObjPtr;
12629 int i;
12631 if (argc < 2) {
12632 Jim_WrongNumArgs(interp, 1, argv, "varName ?value ...?");
12633 return JIM_ERR;
12635 if (argc == 2) {
12636 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
12637 if (!stringObjPtr)
12638 return JIM_ERR;
12640 else {
12641 int new_obj = 0;
12642 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12643 if (!stringObjPtr) {
12644 /* Create the string if it doesn't exist */
12645 stringObjPtr = Jim_NewEmptyStringObj(interp);
12646 new_obj = 1;
12648 else if (Jim_IsShared(stringObjPtr)) {
12649 new_obj = 1;
12650 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
12652 for (i = 2; i < argc; i++) {
12653 Jim_AppendObj(interp, stringObjPtr, argv[i]);
12655 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
12656 if (new_obj) {
12657 Jim_FreeNewObj(interp, stringObjPtr);
12659 return JIM_ERR;
12662 Jim_SetResult(interp, stringObjPtr);
12663 return JIM_OK;
12666 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12668 * Returns a zero-refcount list describing the expression at 'node'
12670 static Jim_Obj *JimGetExprAsList(Jim_Interp *interp, struct JimExprNode *node)
12672 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
12674 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, jim_tt_name(node->type), -1));
12675 if (TOKEN_IS_EXPR_OP(node->type)) {
12676 if (node->left) {
12677 Jim_ListAppendElement(interp, listObjPtr, JimGetExprAsList(interp, node->left));
12679 if (node->right) {
12680 Jim_ListAppendElement(interp, listObjPtr, JimGetExprAsList(interp, node->right));
12682 if (node->ternary) {
12683 Jim_ListAppendElement(interp, listObjPtr, JimGetExprAsList(interp, node->ternary));
12686 else {
12687 Jim_ListAppendElement(interp, listObjPtr, node->objPtr);
12689 return listObjPtr;
12691 #endif /* JIM_DEBUG_COMMAND && !JIM_BOOTSTRAP */
12693 /* [debug] */
12694 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12696 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12697 static const char * const options[] = {
12698 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
12699 "exprbc", "show",
12700 NULL
12702 enum
12704 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
12705 OPT_EXPRLEN, OPT_EXPRBC, OPT_SHOW,
12707 int option;
12709 if (argc < 2) {
12710 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?...?");
12711 return JIM_ERR;
12713 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK)
12714 return Jim_CheckShowCommands(interp, argv[1], options);
12715 if (option == OPT_REFCOUNT) {
12716 if (argc != 3) {
12717 Jim_WrongNumArgs(interp, 2, argv, "object");
12718 return JIM_ERR;
12720 Jim_SetResultInt(interp, argv[2]->refCount);
12721 return JIM_OK;
12723 else if (option == OPT_OBJCOUNT) {
12724 int freeobj = 0, liveobj = 0;
12725 char buf[256];
12726 Jim_Obj *objPtr;
12728 if (argc != 2) {
12729 Jim_WrongNumArgs(interp, 2, argv, "");
12730 return JIM_ERR;
12732 /* Count the number of free objects. */
12733 objPtr = interp->freeList;
12734 while (objPtr) {
12735 freeobj++;
12736 objPtr = objPtr->nextObjPtr;
12738 /* Count the number of live objects. */
12739 objPtr = interp->liveList;
12740 while (objPtr) {
12741 liveobj++;
12742 objPtr = objPtr->nextObjPtr;
12744 /* Set the result string and return. */
12745 sprintf(buf, "free %d used %d", freeobj, liveobj);
12746 Jim_SetResultString(interp, buf, -1);
12747 return JIM_OK;
12749 else if (option == OPT_OBJECTS) {
12750 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
12752 /* Count the number of live objects. */
12753 objPtr = interp->liveList;
12754 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12755 while (objPtr) {
12756 char buf[128];
12757 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "";
12759 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
12760 sprintf(buf, "%p", objPtr);
12761 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, buf, -1));
12762 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, type, -1));
12763 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewIntObj(interp, objPtr->refCount));
12764 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
12765 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
12766 objPtr = objPtr->nextObjPtr;
12768 Jim_SetResult(interp, listObjPtr);
12769 return JIM_OK;
12771 else if (option == OPT_INVSTR) {
12772 Jim_Obj *objPtr;
12774 if (argc != 3) {
12775 Jim_WrongNumArgs(interp, 2, argv, "object");
12776 return JIM_ERR;
12778 objPtr = argv[2];
12779 if (objPtr->typePtr != NULL)
12780 Jim_InvalidateStringRep(objPtr);
12781 Jim_SetEmptyResult(interp);
12782 return JIM_OK;
12784 else if (option == OPT_SHOW) {
12785 const char *s;
12786 int len, charlen;
12788 if (argc != 3) {
12789 Jim_WrongNumArgs(interp, 2, argv, "object");
12790 return JIM_ERR;
12792 s = Jim_GetString(argv[2], &len);
12793 #ifdef JIM_UTF8
12794 charlen = utf8_strlen(s, len);
12795 #else
12796 charlen = len;
12797 #endif
12798 printf("refcount: %d, type: %s\n", argv[2]->refCount, JimObjTypeName(argv[2]));
12799 printf("chars (%d): <<%s>>\n", charlen, s);
12800 printf("bytes (%d):", len);
12801 while (len--) {
12802 printf(" %02x", (unsigned char)*s++);
12804 printf("\n");
12805 return JIM_OK;
12807 else if (option == OPT_SCRIPTLEN) {
12808 ScriptObj *script;
12810 if (argc != 3) {
12811 Jim_WrongNumArgs(interp, 2, argv, "script");
12812 return JIM_ERR;
12814 script = JimGetScript(interp, argv[2]);
12815 if (script == NULL)
12816 return JIM_ERR;
12817 Jim_SetResultInt(interp, script->len);
12818 return JIM_OK;
12820 else if (option == OPT_EXPRLEN) {
12821 struct ExprTree *expr;
12823 if (argc != 3) {
12824 Jim_WrongNumArgs(interp, 2, argv, "expression");
12825 return JIM_ERR;
12827 expr = JimGetExpression(interp, argv[2]);
12828 if (expr == NULL)
12829 return JIM_ERR;
12830 Jim_SetResultInt(interp, expr->len);
12831 return JIM_OK;
12833 else if (option == OPT_EXPRBC) {
12834 struct ExprTree *expr;
12836 if (argc != 3) {
12837 Jim_WrongNumArgs(interp, 2, argv, "expression");
12838 return JIM_ERR;
12840 expr = JimGetExpression(interp, argv[2]);
12841 if (expr == NULL)
12842 return JIM_ERR;
12843 Jim_SetResult(interp, JimGetExprAsList(interp, expr->expr));
12844 return JIM_OK;
12846 else {
12847 Jim_SetResultString(interp,
12848 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
12849 return JIM_ERR;
12851 /* unreached */
12852 #endif /* JIM_DEBUG_COMMAND && !JIM_BOOTSTRAP */
12853 #if !defined(JIM_DEBUG_COMMAND)
12854 Jim_SetResultString(interp, "unsupported", -1);
12855 return JIM_ERR;
12856 #endif
12859 /* [eval] */
12860 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12862 int rc;
12864 if (argc < 2) {
12865 Jim_WrongNumArgs(interp, 1, argv, "arg ?arg ...?");
12866 return JIM_ERR;
12869 if (argc == 2) {
12870 rc = Jim_EvalObj(interp, argv[1]);
12872 else {
12873 rc = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12876 if (rc == JIM_ERR) {
12877 /* eval is "interesting", so add a stack frame here */
12878 interp->addStackTrace++;
12880 return rc;
12883 /* [uplevel] */
12884 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12886 if (argc >= 2) {
12887 int retcode;
12888 Jim_CallFrame *savedCallFrame, *targetCallFrame;
12889 const char *str;
12891 /* Save the old callframe pointer */
12892 savedCallFrame = interp->framePtr;
12894 /* Lookup the target frame pointer */
12895 str = Jim_String(argv[1]);
12896 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#') {
12897 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
12898 argc--;
12899 argv++;
12901 else {
12902 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
12904 if (targetCallFrame == NULL) {
12905 return JIM_ERR;
12907 if (argc < 2) {
12908 Jim_WrongNumArgs(interp, 1, argv - 1, "?level? command ?arg ...?");
12909 return JIM_ERR;
12911 /* Eval the code in the target callframe. */
12912 interp->framePtr = targetCallFrame;
12913 if (argc == 2) {
12914 retcode = Jim_EvalObj(interp, argv[1]);
12916 else {
12917 retcode = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12919 interp->framePtr = savedCallFrame;
12920 return retcode;
12922 else {
12923 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
12924 return JIM_ERR;
12928 /* [expr] */
12929 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12931 int retcode;
12933 if (argc == 2) {
12934 retcode = Jim_EvalExpression(interp, argv[1]);
12936 else if (argc > 2) {
12937 Jim_Obj *objPtr;
12939 objPtr = Jim_ConcatObj(interp, argc - 1, argv + 1);
12940 Jim_IncrRefCount(objPtr);
12941 retcode = Jim_EvalExpression(interp, objPtr);
12942 Jim_DecrRefCount(interp, objPtr);
12944 else {
12945 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
12946 return JIM_ERR;
12948 if (retcode != JIM_OK)
12949 return retcode;
12950 return JIM_OK;
12953 /* [break] */
12954 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12956 if (argc != 1) {
12957 Jim_WrongNumArgs(interp, 1, argv, "");
12958 return JIM_ERR;
12960 return JIM_BREAK;
12963 /* [continue] */
12964 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12966 if (argc != 1) {
12967 Jim_WrongNumArgs(interp, 1, argv, "");
12968 return JIM_ERR;
12970 return JIM_CONTINUE;
12973 /* [return] */
12974 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12976 int i;
12977 Jim_Obj *stackTraceObj = NULL;
12978 Jim_Obj *errorCodeObj = NULL;
12979 int returnCode = JIM_OK;
12980 long level = 1;
12982 for (i = 1; i < argc - 1; i += 2) {
12983 if (Jim_CompareStringImmediate(interp, argv[i], "-code")) {
12984 if (Jim_GetReturnCode(interp, argv[i + 1], &returnCode) == JIM_ERR) {
12985 return JIM_ERR;
12988 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorinfo")) {
12989 stackTraceObj = argv[i + 1];
12991 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorcode")) {
12992 errorCodeObj = argv[i + 1];
12994 else if (Jim_CompareStringImmediate(interp, argv[i], "-level")) {
12995 if (Jim_GetLong(interp, argv[i + 1], &level) != JIM_OK || level < 0) {
12996 Jim_SetResultFormatted(interp, "bad level \"%#s\"", argv[i + 1]);
12997 return JIM_ERR;
13000 else {
13001 break;
13005 if (i != argc - 1 && i != argc) {
13006 Jim_WrongNumArgs(interp, 1, argv,
13007 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
13010 /* If a stack trace is supplied and code is error, set the stack trace */
13011 if (stackTraceObj && returnCode == JIM_ERR) {
13012 JimSetStackTrace(interp, stackTraceObj);
13014 /* If an error code list is supplied, set the global $errorCode */
13015 if (errorCodeObj && returnCode == JIM_ERR) {
13016 Jim_SetGlobalVariableStr(interp, "errorCode", errorCodeObj);
13018 interp->returnCode = returnCode;
13019 interp->returnLevel = level;
13021 if (i == argc - 1) {
13022 Jim_SetResult(interp, argv[i]);
13024 return JIM_RETURN;
13027 /* [tailcall] */
13028 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13030 if (interp->framePtr->level == 0) {
13031 Jim_SetResultString(interp, "tailcall can only be called from a proc or lambda", -1);
13032 return JIM_ERR;
13034 else if (argc >= 2) {
13035 /* Need to resolve the tailcall command in the current context */
13036 Jim_CallFrame *cf = interp->framePtr->parent;
13038 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13039 if (cmdPtr == NULL) {
13040 return JIM_ERR;
13043 JimPanic((cf->tailcallCmd != NULL, "Already have a tailcallCmd"));
13045 /* And stash this pre-resolved command */
13046 JimIncrCmdRefCount(cmdPtr);
13047 cf->tailcallCmd = cmdPtr;
13049 /* And stash the command list */
13050 JimPanic((cf->tailcallObj != NULL, "Already have a tailcallobj"));
13052 cf->tailcallObj = Jim_NewListObj(interp, argv + 1, argc - 1);
13053 Jim_IncrRefCount(cf->tailcallObj);
13055 /* When the stack unwinds to the previous proc, the stashed command will be evaluated */
13056 return JIM_EVAL;
13058 return JIM_OK;
13061 static int JimAliasCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13063 Jim_Obj *cmdList;
13064 Jim_Obj *prefixListObj = Jim_CmdPrivData(interp);
13066 /* prefixListObj is a list to which the args need to be appended */
13067 cmdList = Jim_DuplicateObj(interp, prefixListObj);
13068 Jim_ListInsertElements(interp, cmdList, Jim_ListLength(interp, cmdList), argc - 1, argv + 1);
13070 return JimEvalObjList(interp, cmdList);
13073 static void JimAliasCmdDelete(Jim_Interp *interp, void *privData)
13075 Jim_Obj *prefixListObj = privData;
13076 Jim_DecrRefCount(interp, prefixListObj);
13079 static int Jim_AliasCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13081 Jim_Obj *prefixListObj;
13082 const char *newname;
13084 if (argc < 3) {
13085 Jim_WrongNumArgs(interp, 1, argv, "newname command ?args ...?");
13086 return JIM_ERR;
13089 prefixListObj = Jim_NewListObj(interp, argv + 2, argc - 2);
13090 Jim_IncrRefCount(prefixListObj);
13091 newname = Jim_String(argv[1]);
13092 if (newname[0] == ':' && newname[1] == ':') {
13093 while (*++newname == ':') {
13097 Jim_SetResult(interp, argv[1]);
13099 return Jim_CreateCommand(interp, newname, JimAliasCmd, prefixListObj, JimAliasCmdDelete);
13102 /* [proc] */
13103 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13105 Jim_Cmd *cmd;
13107 if (argc != 4 && argc != 5) {
13108 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
13109 return JIM_ERR;
13112 if (JimValidName(interp, "procedure", argv[1]) != JIM_OK) {
13113 return JIM_ERR;
13116 if (argc == 4) {
13117 cmd = JimCreateProcedureCmd(interp, argv[2], NULL, argv[3], NULL);
13119 else {
13120 cmd = JimCreateProcedureCmd(interp, argv[2], argv[3], argv[4], NULL);
13123 if (cmd) {
13124 /* Add the new command */
13125 Jim_Obj *qualifiedCmdNameObj;
13126 const char *cmdname = JimQualifyName(interp, Jim_String(argv[1]), &qualifiedCmdNameObj);
13128 JimCreateCommand(interp, cmdname, cmd);
13130 /* Calculate and set the namespace for this proc */
13131 JimUpdateProcNamespace(interp, cmd, cmdname);
13133 JimFreeQualifiedName(interp, qualifiedCmdNameObj);
13135 /* Unlike Tcl, set the name of the proc as the result */
13136 Jim_SetResult(interp, argv[1]);
13137 return JIM_OK;
13139 return JIM_ERR;
13142 /* [local] */
13143 static int Jim_LocalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13145 int retcode;
13147 if (argc < 2) {
13148 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13149 return JIM_ERR;
13152 /* Evaluate the arguments with 'local' in force */
13153 interp->local++;
13154 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13155 interp->local--;
13158 /* If OK, and the result is a proc, add it to the list of local procs */
13159 if (retcode == 0) {
13160 Jim_Obj *cmdNameObj = Jim_GetResult(interp);
13162 if (Jim_GetCommand(interp, cmdNameObj, JIM_ERRMSG) == NULL) {
13163 return JIM_ERR;
13165 if (interp->framePtr->localCommands == NULL) {
13166 interp->framePtr->localCommands = Jim_Alloc(sizeof(*interp->framePtr->localCommands));
13167 Jim_InitStack(interp->framePtr->localCommands);
13169 Jim_IncrRefCount(cmdNameObj);
13170 Jim_StackPush(interp->framePtr->localCommands, cmdNameObj);
13173 return retcode;
13176 /* [upcall] */
13177 static int Jim_UpcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13179 if (argc < 2) {
13180 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13181 return JIM_ERR;
13183 else {
13184 int retcode;
13186 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13187 if (cmdPtr == NULL || !cmdPtr->isproc || !cmdPtr->prevCmd) {
13188 Jim_SetResultFormatted(interp, "no previous command: \"%#s\"", argv[1]);
13189 return JIM_ERR;
13191 /* OK. Mark this command as being in an upcall */
13192 cmdPtr->u.proc.upcall++;
13193 JimIncrCmdRefCount(cmdPtr);
13195 /* Invoke the command as normal */
13196 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13198 /* No longer in an upcall */
13199 cmdPtr->u.proc.upcall--;
13200 JimDecrCmdRefCount(interp, cmdPtr);
13202 return retcode;
13206 /* [apply] */
13207 static int Jim_ApplyCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13209 if (argc < 2) {
13210 Jim_WrongNumArgs(interp, 1, argv, "lambdaExpr ?arg ...?");
13211 return JIM_ERR;
13213 else {
13214 int ret;
13215 Jim_Cmd *cmd;
13216 Jim_Obj *argListObjPtr;
13217 Jim_Obj *bodyObjPtr;
13218 Jim_Obj *nsObj = NULL;
13219 Jim_Obj **nargv;
13221 int len = Jim_ListLength(interp, argv[1]);
13222 if (len != 2 && len != 3) {
13223 Jim_SetResultFormatted(interp, "can't interpret \"%#s\" as a lambda expression", argv[1]);
13224 return JIM_ERR;
13227 if (len == 3) {
13228 #ifdef jim_ext_namespace
13229 /* Need to canonicalise the given namespace. */
13230 nsObj = JimQualifyNameObj(interp, Jim_ListGetIndex(interp, argv[1], 2));
13231 #else
13232 Jim_SetResultString(interp, "namespaces not enabled", -1);
13233 return JIM_ERR;
13234 #endif
13236 argListObjPtr = Jim_ListGetIndex(interp, argv[1], 0);
13237 bodyObjPtr = Jim_ListGetIndex(interp, argv[1], 1);
13239 cmd = JimCreateProcedureCmd(interp, argListObjPtr, NULL, bodyObjPtr, nsObj);
13241 if (cmd) {
13242 /* Create a new argv array with a dummy argv[0], for error messages */
13243 nargv = Jim_Alloc((argc - 2 + 1) * sizeof(*nargv));
13244 nargv[0] = Jim_NewStringObj(interp, "apply lambdaExpr", -1);
13245 Jim_IncrRefCount(nargv[0]);
13246 memcpy(&nargv[1], argv + 2, (argc - 2) * sizeof(*nargv));
13247 ret = JimCallProcedure(interp, cmd, argc - 2 + 1, nargv);
13248 Jim_DecrRefCount(interp, nargv[0]);
13249 Jim_Free(nargv);
13251 JimDecrCmdRefCount(interp, cmd);
13252 return ret;
13254 return JIM_ERR;
13259 /* [concat] */
13260 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13262 Jim_SetResult(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13263 return JIM_OK;
13266 /* [upvar] */
13267 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13269 int i;
13270 Jim_CallFrame *targetCallFrame;
13272 /* Lookup the target frame pointer */
13273 if (argc > 3 && (argc % 2 == 0)) {
13274 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
13275 argc--;
13276 argv++;
13278 else {
13279 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
13281 if (targetCallFrame == NULL) {
13282 return JIM_ERR;
13285 /* Check for arity */
13286 if (argc < 3) {
13287 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
13288 return JIM_ERR;
13291 /* Now... for every other/local couple: */
13292 for (i = 1; i < argc; i += 2) {
13293 if (Jim_SetVariableLink(interp, argv[i + 1], argv[i], targetCallFrame) != JIM_OK)
13294 return JIM_ERR;
13296 return JIM_OK;
13299 /* [global] */
13300 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13302 int i;
13304 if (argc < 2) {
13305 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
13306 return JIM_ERR;
13308 /* Link every var to the toplevel having the same name */
13309 if (interp->framePtr->level == 0)
13310 return JIM_OK; /* global at toplevel... */
13311 for (i = 1; i < argc; i++) {
13312 /* global ::blah does nothing */
13313 const char *name = Jim_String(argv[i]);
13314 if (name[0] != ':' || name[1] != ':') {
13315 if (Jim_SetVariableLink(interp, argv[i], argv[i], interp->topFramePtr) != JIM_OK)
13316 return JIM_ERR;
13319 return JIM_OK;
13322 /* does the [string map] operation. On error NULL is returned,
13323 * otherwise a new string object with the result, having refcount = 0,
13324 * is returned. */
13325 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
13326 Jim_Obj *objPtr, int nocase)
13328 int numMaps;
13329 const char *str, *noMatchStart = NULL;
13330 int strLen, i;
13331 Jim_Obj *resultObjPtr;
13333 numMaps = Jim_ListLength(interp, mapListObjPtr);
13334 if (numMaps % 2) {
13335 Jim_SetResultString(interp, "list must contain an even number of elements", -1);
13336 return NULL;
13339 str = Jim_String(objPtr);
13340 strLen = Jim_Utf8Length(interp, objPtr);
13342 /* Map it */
13343 resultObjPtr = Jim_NewStringObj(interp, "", 0);
13344 while (strLen) {
13345 for (i = 0; i < numMaps; i += 2) {
13346 Jim_Obj *eachObjPtr;
13347 const char *k;
13348 int kl;
13350 eachObjPtr = Jim_ListGetIndex(interp, mapListObjPtr, i);
13351 k = Jim_String(eachObjPtr);
13352 kl = Jim_Utf8Length(interp, eachObjPtr);
13354 if (strLen >= kl && kl) {
13355 int rc;
13356 rc = JimStringCompareLen(str, k, kl, nocase);
13357 if (rc == 0) {
13358 if (noMatchStart) {
13359 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13360 noMatchStart = NULL;
13362 Jim_AppendObj(interp, resultObjPtr, Jim_ListGetIndex(interp, mapListObjPtr, i + 1));
13363 str += utf8_index(str, kl);
13364 strLen -= kl;
13365 break;
13369 if (i == numMaps) { /* no match */
13370 int c;
13371 if (noMatchStart == NULL)
13372 noMatchStart = str;
13373 str += utf8_tounicode(str, &c);
13374 strLen--;
13377 if (noMatchStart) {
13378 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13380 return resultObjPtr;
13383 /* [string] */
13384 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13386 int len;
13387 int opt_case = 1;
13388 int option;
13389 static const char * const options[] = {
13390 "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "replace",
13391 "map", "repeat", "reverse", "index", "first", "last", "cat",
13392 "trim", "trimleft", "trimright", "tolower", "toupper", "totitle", NULL
13394 enum
13396 OPT_BYTELENGTH, OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_IS, OPT_BYTERANGE, OPT_RANGE, OPT_REPLACE,
13397 OPT_MAP, OPT_REPEAT, OPT_REVERSE, OPT_INDEX, OPT_FIRST, OPT_LAST, OPT_CAT,
13398 OPT_TRIM, OPT_TRIMLEFT, OPT_TRIMRIGHT, OPT_TOLOWER, OPT_TOUPPER, OPT_TOTITLE
13400 static const char * const nocase_options[] = {
13401 "-nocase", NULL
13403 static const char * const nocase_length_options[] = {
13404 "-nocase", "-length", NULL
13407 if (argc < 2) {
13408 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
13409 return JIM_ERR;
13411 if (Jim_GetEnum(interp, argv[1], options, &option, NULL,
13412 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK)
13413 return Jim_CheckShowCommands(interp, argv[1], options);
13415 switch (option) {
13416 case OPT_LENGTH:
13417 case OPT_BYTELENGTH:
13418 if (argc != 3) {
13419 Jim_WrongNumArgs(interp, 2, argv, "string");
13420 return JIM_ERR;
13422 if (option == OPT_LENGTH) {
13423 len = Jim_Utf8Length(interp, argv[2]);
13425 else {
13426 len = Jim_Length(argv[2]);
13428 Jim_SetResultInt(interp, len);
13429 return JIM_OK;
13431 case OPT_CAT:{
13432 Jim_Obj *objPtr;
13433 if (argc == 3) {
13434 /* optimise the one-arg case */
13435 objPtr = argv[2];
13437 else {
13438 int i;
13440 objPtr = Jim_NewStringObj(interp, "", 0);
13442 for (i = 2; i < argc; i++) {
13443 Jim_AppendObj(interp, objPtr, argv[i]);
13446 Jim_SetResult(interp, objPtr);
13447 return JIM_OK;
13450 case OPT_COMPARE:
13451 case OPT_EQUAL:
13453 /* n is the number of remaining option args */
13454 long opt_length = -1;
13455 int n = argc - 4;
13456 int i = 2;
13457 while (n > 0) {
13458 int subopt;
13459 if (Jim_GetEnum(interp, argv[i++], nocase_length_options, &subopt, NULL,
13460 JIM_ENUM_ABBREV) != JIM_OK) {
13461 badcompareargs:
13462 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? ?-length int? string1 string2");
13463 return JIM_ERR;
13465 if (subopt == 0) {
13466 /* -nocase */
13467 opt_case = 0;
13468 n--;
13470 else {
13471 /* -length */
13472 if (n < 2) {
13473 goto badcompareargs;
13475 if (Jim_GetLong(interp, argv[i++], &opt_length) != JIM_OK) {
13476 return JIM_ERR;
13478 n -= 2;
13481 if (n) {
13482 goto badcompareargs;
13484 argv += argc - 2;
13485 if (opt_length < 0 && option != OPT_COMPARE && opt_case) {
13486 /* Fast version - [string equal], case sensitive, no length */
13487 Jim_SetResultBool(interp, Jim_StringEqObj(argv[0], argv[1]));
13489 else {
13490 if (opt_length >= 0) {
13491 n = JimStringCompareLen(Jim_String(argv[0]), Jim_String(argv[1]), opt_length, !opt_case);
13493 else {
13494 n = Jim_StringCompareObj(interp, argv[0], argv[1], !opt_case);
13496 Jim_SetResultInt(interp, option == OPT_COMPARE ? n : n == 0);
13498 return JIM_OK;
13501 case OPT_MATCH:
13502 if (argc != 4 &&
13503 (argc != 5 ||
13504 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13505 JIM_ENUM_ABBREV) != JIM_OK)) {
13506 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern string");
13507 return JIM_ERR;
13509 if (opt_case == 0) {
13510 argv++;
13512 Jim_SetResultBool(interp, Jim_StringMatchObj(interp, argv[2], argv[3], !opt_case));
13513 return JIM_OK;
13515 case OPT_MAP:{
13516 Jim_Obj *objPtr;
13518 if (argc != 4 &&
13519 (argc != 5 ||
13520 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13521 JIM_ENUM_ABBREV) != JIM_OK)) {
13522 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList string");
13523 return JIM_ERR;
13526 if (opt_case == 0) {
13527 argv++;
13529 objPtr = JimStringMap(interp, argv[2], argv[3], !opt_case);
13530 if (objPtr == NULL) {
13531 return JIM_ERR;
13533 Jim_SetResult(interp, objPtr);
13534 return JIM_OK;
13537 case OPT_RANGE:
13538 case OPT_BYTERANGE:{
13539 Jim_Obj *objPtr;
13541 if (argc != 5) {
13542 Jim_WrongNumArgs(interp, 2, argv, "string first last");
13543 return JIM_ERR;
13545 if (option == OPT_RANGE) {
13546 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
13548 else
13550 objPtr = Jim_StringByteRangeObj(interp, argv[2], argv[3], argv[4]);
13553 if (objPtr == NULL) {
13554 return JIM_ERR;
13556 Jim_SetResult(interp, objPtr);
13557 return JIM_OK;
13560 case OPT_REPLACE:{
13561 Jim_Obj *objPtr;
13563 if (argc != 5 && argc != 6) {
13564 Jim_WrongNumArgs(interp, 2, argv, "string first last ?string?");
13565 return JIM_ERR;
13567 objPtr = JimStringReplaceObj(interp, argv[2], argv[3], argv[4], argc == 6 ? argv[5] : NULL);
13568 if (objPtr == NULL) {
13569 return JIM_ERR;
13571 Jim_SetResult(interp, objPtr);
13572 return JIM_OK;
13576 case OPT_REPEAT:{
13577 Jim_Obj *objPtr;
13578 jim_wide count;
13580 if (argc != 4) {
13581 Jim_WrongNumArgs(interp, 2, argv, "string count");
13582 return JIM_ERR;
13584 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK) {
13585 return JIM_ERR;
13587 objPtr = Jim_NewStringObj(interp, "", 0);
13588 if (count > 0) {
13589 while (count--) {
13590 Jim_AppendObj(interp, objPtr, argv[2]);
13593 Jim_SetResult(interp, objPtr);
13594 return JIM_OK;
13597 case OPT_REVERSE:{
13598 char *buf, *p;
13599 const char *str;
13600 int i;
13602 if (argc != 3) {
13603 Jim_WrongNumArgs(interp, 2, argv, "string");
13604 return JIM_ERR;
13607 str = Jim_GetString(argv[2], &len);
13608 buf = Jim_Alloc(len + 1);
13609 p = buf + len;
13610 *p = 0;
13611 for (i = 0; i < len; ) {
13612 int c;
13613 int l = utf8_tounicode(str, &c);
13614 memcpy(p - l, str, l);
13615 p -= l;
13616 i += l;
13617 str += l;
13619 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
13620 return JIM_OK;
13623 case OPT_INDEX:{
13624 int idx;
13625 const char *str;
13627 if (argc != 4) {
13628 Jim_WrongNumArgs(interp, 2, argv, "string index");
13629 return JIM_ERR;
13631 if (Jim_GetIndex(interp, argv[3], &idx) != JIM_OK) {
13632 return JIM_ERR;
13634 str = Jim_String(argv[2]);
13635 len = Jim_Utf8Length(interp, argv[2]);
13636 if (idx != INT_MIN && idx != INT_MAX) {
13637 idx = JimRelToAbsIndex(len, idx);
13639 if (idx < 0 || idx >= len || str == NULL) {
13640 Jim_SetResultString(interp, "", 0);
13642 else if (len == Jim_Length(argv[2])) {
13643 /* ASCII optimisation */
13644 Jim_SetResultString(interp, str + idx, 1);
13646 else {
13647 int c;
13648 int i = utf8_index(str, idx);
13649 Jim_SetResultString(interp, str + i, utf8_tounicode(str + i, &c));
13651 return JIM_OK;
13654 case OPT_FIRST:
13655 case OPT_LAST:{
13656 int idx = 0, l1, l2;
13657 const char *s1, *s2;
13659 if (argc != 4 && argc != 5) {
13660 Jim_WrongNumArgs(interp, 2, argv, "subString string ?index?");
13661 return JIM_ERR;
13663 s1 = Jim_String(argv[2]);
13664 s2 = Jim_String(argv[3]);
13665 l1 = Jim_Utf8Length(interp, argv[2]);
13666 l2 = Jim_Utf8Length(interp, argv[3]);
13667 if (argc == 5) {
13668 if (Jim_GetIndex(interp, argv[4], &idx) != JIM_OK) {
13669 return JIM_ERR;
13671 idx = JimRelToAbsIndex(l2, idx);
13673 else if (option == OPT_LAST) {
13674 idx = l2;
13676 if (option == OPT_FIRST) {
13677 Jim_SetResultInt(interp, JimStringFirst(s1, l1, s2, l2, idx));
13679 else {
13680 #ifdef JIM_UTF8
13681 Jim_SetResultInt(interp, JimStringLastUtf8(s1, l1, s2, idx));
13682 #else
13683 Jim_SetResultInt(interp, JimStringLast(s1, l1, s2, idx));
13684 #endif
13686 return JIM_OK;
13689 case OPT_TRIM:
13690 case OPT_TRIMLEFT:
13691 case OPT_TRIMRIGHT:{
13692 Jim_Obj *trimchars;
13694 if (argc != 3 && argc != 4) {
13695 Jim_WrongNumArgs(interp, 2, argv, "string ?trimchars?");
13696 return JIM_ERR;
13698 trimchars = (argc == 4 ? argv[3] : NULL);
13699 if (option == OPT_TRIM) {
13700 Jim_SetResult(interp, JimStringTrim(interp, argv[2], trimchars));
13702 else if (option == OPT_TRIMLEFT) {
13703 Jim_SetResult(interp, JimStringTrimLeft(interp, argv[2], trimchars));
13705 else if (option == OPT_TRIMRIGHT) {
13706 Jim_SetResult(interp, JimStringTrimRight(interp, argv[2], trimchars));
13708 return JIM_OK;
13711 case OPT_TOLOWER:
13712 case OPT_TOUPPER:
13713 case OPT_TOTITLE:
13714 if (argc != 3) {
13715 Jim_WrongNumArgs(interp, 2, argv, "string");
13716 return JIM_ERR;
13718 if (option == OPT_TOLOWER) {
13719 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
13721 else if (option == OPT_TOUPPER) {
13722 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
13724 else {
13725 Jim_SetResult(interp, JimStringToTitle(interp, argv[2]));
13727 return JIM_OK;
13729 case OPT_IS:
13730 if (argc == 4 || (argc == 5 && Jim_CompareStringImmediate(interp, argv[3], "-strict"))) {
13731 return JimStringIs(interp, argv[argc - 1], argv[2], argc == 5);
13733 Jim_WrongNumArgs(interp, 2, argv, "class ?-strict? str");
13734 return JIM_ERR;
13736 return JIM_OK;
13739 /* [time] */
13740 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13742 long i, count = 1;
13743 jim_wide start, elapsed;
13744 char buf[60];
13745 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
13747 if (argc < 2) {
13748 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
13749 return JIM_ERR;
13751 if (argc == 3) {
13752 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
13753 return JIM_ERR;
13755 if (count < 0)
13756 return JIM_OK;
13757 i = count;
13758 start = JimClock();
13759 while (i-- > 0) {
13760 int retval;
13762 retval = Jim_EvalObj(interp, argv[1]);
13763 if (retval != JIM_OK) {
13764 return retval;
13767 elapsed = JimClock() - start;
13768 sprintf(buf, fmt, count == 0 ? 0 : elapsed / count);
13769 Jim_SetResultString(interp, buf, -1);
13770 return JIM_OK;
13773 /* [exit] */
13774 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13776 long exitCode = 0;
13778 if (argc > 2) {
13779 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
13780 return JIM_ERR;
13782 if (argc == 2) {
13783 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
13784 return JIM_ERR;
13786 interp->exitCode = exitCode;
13787 return JIM_EXIT;
13790 /* [catch] */
13791 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13793 int exitCode = 0;
13794 int i;
13795 int sig = 0;
13797 /* Which return codes are ignored (passed through)? By default, only exit, eval and signal */
13798 jim_wide ignore_mask = (1 << JIM_EXIT) | (1 << JIM_EVAL) | (1 << JIM_SIGNAL);
13799 static const int max_ignore_code = sizeof(ignore_mask) * 8;
13801 /* Reset the error code before catch.
13802 * Note that this is not strictly correct.
13804 Jim_SetGlobalVariableStr(interp, "errorCode", Jim_NewStringObj(interp, "NONE", -1));
13806 for (i = 1; i < argc - 1; i++) {
13807 const char *arg = Jim_String(argv[i]);
13808 jim_wide option;
13809 int ignore;
13811 /* It's a pity we can't use Jim_GetEnum here :-( */
13812 if (strcmp(arg, "--") == 0) {
13813 i++;
13814 break;
13816 if (*arg != '-') {
13817 break;
13820 if (strncmp(arg, "-no", 3) == 0) {
13821 arg += 3;
13822 ignore = 1;
13824 else {
13825 arg++;
13826 ignore = 0;
13829 if (Jim_StringToWide(arg, &option, 10) != JIM_OK) {
13830 option = -1;
13832 if (option < 0) {
13833 option = Jim_FindByName(arg, jimReturnCodes, jimReturnCodesSize);
13835 if (option < 0) {
13836 goto wrongargs;
13839 if (ignore) {
13840 ignore_mask |= ((jim_wide)1 << option);
13842 else {
13843 ignore_mask &= (~((jim_wide)1 << option));
13847 argc -= i;
13848 if (argc < 1 || argc > 3) {
13849 wrongargs:
13850 Jim_WrongNumArgs(interp, 1, argv,
13851 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
13852 return JIM_ERR;
13854 argv += i;
13856 if ((ignore_mask & (1 << JIM_SIGNAL)) == 0) {
13857 sig++;
13860 interp->signal_level += sig;
13861 if (Jim_CheckSignal(interp)) {
13862 /* If a signal is set, don't even try to execute the body */
13863 exitCode = JIM_SIGNAL;
13865 else {
13866 exitCode = Jim_EvalObj(interp, argv[0]);
13867 /* Don't want any caught error included in a later stack trace */
13868 interp->errorFlag = 0;
13870 interp->signal_level -= sig;
13872 /* Catch or pass through? Only the first 32/64 codes can be passed through */
13873 if (exitCode >= 0 && exitCode < max_ignore_code && (((unsigned jim_wide)1 << exitCode) & ignore_mask)) {
13874 /* Not caught, pass it up */
13875 return exitCode;
13878 if (sig && exitCode == JIM_SIGNAL) {
13879 /* Catch the signal at this level */
13880 if (interp->signal_set_result) {
13881 interp->signal_set_result(interp, interp->sigmask);
13883 else {
13884 Jim_SetResultInt(interp, interp->sigmask);
13886 interp->sigmask = 0;
13889 if (argc >= 2) {
13890 if (Jim_SetVariable(interp, argv[1], Jim_GetResult(interp)) != JIM_OK) {
13891 return JIM_ERR;
13893 if (argc == 3) {
13894 Jim_Obj *optListObj = Jim_NewListObj(interp, NULL, 0);
13896 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-code", -1));
13897 Jim_ListAppendElement(interp, optListObj,
13898 Jim_NewIntObj(interp, exitCode == JIM_RETURN ? interp->returnCode : exitCode));
13899 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-level", -1));
13900 Jim_ListAppendElement(interp, optListObj, Jim_NewIntObj(interp, interp->returnLevel));
13901 if (exitCode == JIM_ERR) {
13902 Jim_Obj *errorCode;
13903 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorinfo",
13904 -1));
13905 Jim_ListAppendElement(interp, optListObj, interp->stackTrace);
13907 errorCode = Jim_GetGlobalVariableStr(interp, "errorCode", JIM_NONE);
13908 if (errorCode) {
13909 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorcode", -1));
13910 Jim_ListAppendElement(interp, optListObj, errorCode);
13913 if (Jim_SetVariable(interp, argv[2], optListObj) != JIM_OK) {
13914 return JIM_ERR;
13918 Jim_SetResultInt(interp, exitCode);
13919 return JIM_OK;
13922 #if defined(JIM_REFERENCES) && !defined(JIM_BOOTSTRAP)
13924 /* [ref] */
13925 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13927 if (argc != 3 && argc != 4) {
13928 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
13929 return JIM_ERR;
13931 if (argc == 3) {
13932 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
13934 else {
13935 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], argv[3]));
13937 return JIM_OK;
13940 /* [getref] */
13941 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13943 Jim_Reference *refPtr;
13945 if (argc != 2) {
13946 Jim_WrongNumArgs(interp, 1, argv, "reference");
13947 return JIM_ERR;
13949 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
13950 return JIM_ERR;
13951 Jim_SetResult(interp, refPtr->objPtr);
13952 return JIM_OK;
13955 /* [setref] */
13956 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13958 Jim_Reference *refPtr;
13960 if (argc != 3) {
13961 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
13962 return JIM_ERR;
13964 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
13965 return JIM_ERR;
13966 Jim_IncrRefCount(argv[2]);
13967 Jim_DecrRefCount(interp, refPtr->objPtr);
13968 refPtr->objPtr = argv[2];
13969 Jim_SetResult(interp, argv[2]);
13970 return JIM_OK;
13973 /* [collect] */
13974 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13976 if (argc != 1) {
13977 Jim_WrongNumArgs(interp, 1, argv, "");
13978 return JIM_ERR;
13980 Jim_SetResultInt(interp, Jim_Collect(interp));
13982 /* Free all the freed objects. */
13983 while (interp->freeList) {
13984 Jim_Obj *nextObjPtr = interp->freeList->nextObjPtr;
13985 Jim_Free(interp->freeList);
13986 interp->freeList = nextObjPtr;
13989 return JIM_OK;
13992 /* [finalize] reference ?newValue? */
13993 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13995 if (argc != 2 && argc != 3) {
13996 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
13997 return JIM_ERR;
13999 if (argc == 2) {
14000 Jim_Obj *cmdNamePtr;
14002 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
14003 return JIM_ERR;
14004 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
14005 Jim_SetResult(interp, cmdNamePtr);
14007 else {
14008 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
14009 return JIM_ERR;
14010 Jim_SetResult(interp, argv[2]);
14012 return JIM_OK;
14015 /* [info references] */
14016 static int JimInfoReferences(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14018 Jim_Obj *listObjPtr;
14019 Jim_HashTableIterator htiter;
14020 Jim_HashEntry *he;
14022 listObjPtr = Jim_NewListObj(interp, NULL, 0);
14024 JimInitHashTableIterator(&interp->references, &htiter);
14025 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14026 char buf[JIM_REFERENCE_SPACE + 1];
14027 Jim_Reference *refPtr = Jim_GetHashEntryVal(he);
14028 const unsigned long *refId = he->key;
14030 JimFormatReference(buf, refPtr, *refId);
14031 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, buf, -1));
14033 Jim_SetResult(interp, listObjPtr);
14034 return JIM_OK;
14036 #endif /* JIM_REFERENCES && !JIM_BOOTSTRAP */
14038 /* [rename] */
14039 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14041 if (argc != 3) {
14042 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
14043 return JIM_ERR;
14046 if (JimValidName(interp, "new procedure", argv[2])) {
14047 return JIM_ERR;
14050 return Jim_RenameCommand(interp, Jim_String(argv[1]), Jim_String(argv[2]));
14053 #define JIM_DICTMATCH_KEYS 0x0001
14054 #define JIM_DICTMATCH_VALUES 0x002
14057 * match_type must be one of JIM_DICTMATCH_KEYS or JIM_DICTMATCH_VALUES
14058 * return_types should be either or both
14060 int Jim_DictMatchTypes(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObj, int match_type, int return_types)
14062 Jim_HashEntry *he;
14063 Jim_Obj *listObjPtr;
14064 Jim_HashTableIterator htiter;
14066 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14067 return JIM_ERR;
14070 listObjPtr = Jim_NewListObj(interp, NULL, 0);
14072 JimInitHashTableIterator(objPtr->internalRep.ptr, &htiter);
14073 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14074 if (patternObj) {
14075 Jim_Obj *matchObj = (match_type == JIM_DICTMATCH_KEYS) ? (Jim_Obj *)he->key : Jim_GetHashEntryVal(he);
14076 if (!JimGlobMatch(Jim_String(patternObj), Jim_String(matchObj), 0)) {
14077 /* no match */
14078 continue;
14081 if (return_types & JIM_DICTMATCH_KEYS) {
14082 Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->key);
14084 if (return_types & JIM_DICTMATCH_VALUES) {
14085 Jim_ListAppendElement(interp, listObjPtr, Jim_GetHashEntryVal(he));
14089 Jim_SetResult(interp, listObjPtr);
14090 return JIM_OK;
14093 int Jim_DictSize(Jim_Interp *interp, Jim_Obj *objPtr)
14095 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14096 return -1;
14098 return ((Jim_HashTable *)objPtr->internalRep.ptr)->used;
14102 * Must be called with at least one object.
14103 * Returns the new dictionary, or NULL on error.
14105 Jim_Obj *Jim_DictMerge(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
14107 Jim_Obj *objPtr = Jim_NewDictObj(interp, NULL, 0);
14108 int i;
14110 JimPanic((objc == 0, "Jim_DictMerge called with objc=0"));
14112 /* Note that we don't optimise the trivial case of a single argument */
14114 for (i = 0; i < objc; i++) {
14115 Jim_HashTable *ht;
14116 Jim_HashTableIterator htiter;
14117 Jim_HashEntry *he;
14119 if (SetDictFromAny(interp, objv[i]) != JIM_OK) {
14120 Jim_FreeNewObj(interp, objPtr);
14121 return NULL;
14123 ht = objv[i]->internalRep.ptr;
14124 JimInitHashTableIterator(ht, &htiter);
14125 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14126 Jim_ReplaceHashEntry(objPtr->internalRep.ptr, Jim_GetHashEntryKey(he), Jim_GetHashEntryVal(he));
14129 return objPtr;
14132 int Jim_DictInfo(Jim_Interp *interp, Jim_Obj *objPtr)
14134 Jim_HashTable *ht;
14135 unsigned int i;
14136 char buffer[100];
14137 int sum = 0;
14138 int nonzero_count = 0;
14139 Jim_Obj *output;
14140 int bucket_counts[11] = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 };
14142 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14143 return JIM_ERR;
14146 ht = (Jim_HashTable *)objPtr->internalRep.ptr;
14148 /* Note that this uses internal knowledge of the hash table */
14149 snprintf(buffer, sizeof(buffer), "%d entries in table, %d buckets\n", ht->used, ht->size);
14150 output = Jim_NewStringObj(interp, buffer, -1);
14152 for (i = 0; i < ht->size; i++) {
14153 Jim_HashEntry *he = ht->table[i];
14154 int entries = 0;
14155 while (he) {
14156 entries++;
14157 he = he->next;
14159 if (entries > 9) {
14160 bucket_counts[10]++;
14162 else {
14163 bucket_counts[entries]++;
14165 if (entries) {
14166 sum += entries;
14167 nonzero_count++;
14170 for (i = 0; i < 10; i++) {
14171 snprintf(buffer, sizeof(buffer), "number of buckets with %d entries: %d\n", i, bucket_counts[i]);
14172 Jim_AppendString(interp, output, buffer, -1);
14174 snprintf(buffer, sizeof(buffer), "number of buckets with 10 or more entries: %d\n", bucket_counts[10]);
14175 Jim_AppendString(interp, output, buffer, -1);
14176 snprintf(buffer, sizeof(buffer), "average search distance for entry: %.1f", nonzero_count ? (double)sum / nonzero_count : 0.0);
14177 Jim_AppendString(interp, output, buffer, -1);
14178 Jim_SetResult(interp, output);
14179 return JIM_OK;
14182 static int Jim_EvalEnsemble(Jim_Interp *interp, const char *basecmd, const char *subcmd, int argc, Jim_Obj *const *argv)
14184 Jim_Obj *prefixObj = Jim_NewStringObj(interp, basecmd, -1);
14186 Jim_AppendString(interp, prefixObj, " ", 1);
14187 Jim_AppendString(interp, prefixObj, subcmd, -1);
14189 return Jim_EvalObjPrefix(interp, prefixObj, argc, argv);
14193 * Implements the [dict with] command
14195 static int JimDictWith(Jim_Interp *interp, Jim_Obj *dictVarName, Jim_Obj *const *keyv, int keyc, Jim_Obj *scriptObj)
14197 int i;
14198 Jim_Obj *objPtr;
14199 Jim_Obj *dictObj;
14200 Jim_Obj **dictValues;
14201 int len;
14202 int ret = JIM_OK;
14204 /* Open up the appropriate level of the dictionary */
14205 dictObj = Jim_GetVariable(interp, dictVarName, JIM_ERRMSG);
14206 if (dictObj == NULL || Jim_DictKeysVector(interp, dictObj, keyv, keyc, &objPtr, JIM_ERRMSG) != JIM_OK) {
14207 return JIM_ERR;
14209 /* Set the local variables */
14210 if (Jim_DictPairs(interp, objPtr, &dictValues, &len) == JIM_ERR) {
14211 return JIM_ERR;
14213 for (i = 0; i < len; i += 2) {
14214 if (Jim_SetVariable(interp, dictValues[i], dictValues[i + 1]) == JIM_ERR) {
14215 Jim_Free(dictValues);
14216 return JIM_ERR;
14220 /* As an optimisation, if the script is empty, no need to evaluate it or update the dict */
14221 if (Jim_Length(scriptObj)) {
14222 ret = Jim_EvalObj(interp, scriptObj);
14224 /* Now if the dictionary still exists, update it based on the local variables */
14225 if (ret == JIM_OK && Jim_GetVariable(interp, dictVarName, 0) != NULL) {
14226 /* We need a copy of keyv with one extra element at the end for Jim_SetDictKeysVector() */
14227 Jim_Obj **newkeyv = Jim_Alloc(sizeof(*newkeyv) * (keyc + 1));
14228 for (i = 0; i < keyc; i++) {
14229 newkeyv[i] = keyv[i];
14232 for (i = 0; i < len; i += 2) {
14233 /* This will be NULL if the variable no longer exists, thus deleting the variable */
14234 objPtr = Jim_GetVariable(interp, dictValues[i], 0);
14235 newkeyv[keyc] = dictValues[i];
14236 Jim_SetDictKeysVector(interp, dictVarName, newkeyv, keyc + 1, objPtr, 0);
14238 Jim_Free(newkeyv);
14242 Jim_Free(dictValues);
14244 return ret;
14247 /* [dict] */
14248 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14250 Jim_Obj *objPtr;
14251 int types = JIM_DICTMATCH_KEYS;
14252 int option;
14253 static const char * const options[] = {
14254 "create", "get", "set", "unset", "exists", "keys", "size", "info",
14255 "merge", "with", "append", "lappend", "incr", "remove", "values", "for",
14256 "replace", "update", NULL
14258 enum
14260 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXISTS, OPT_KEYS, OPT_SIZE, OPT_INFO,
14261 OPT_MERGE, OPT_WITH, OPT_APPEND, OPT_LAPPEND, OPT_INCR, OPT_REMOVE, OPT_VALUES, OPT_FOR,
14262 OPT_REPLACE, OPT_UPDATE,
14265 if (argc < 2) {
14266 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?arguments ...?");
14267 return JIM_ERR;
14270 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK) {
14271 return Jim_CheckShowCommands(interp, argv[1], options);
14274 switch (option) {
14275 case OPT_GET:
14276 if (argc < 3) {
14277 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?key ...?");
14278 return JIM_ERR;
14280 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr,
14281 JIM_ERRMSG) != JIM_OK) {
14282 return JIM_ERR;
14284 Jim_SetResult(interp, objPtr);
14285 return JIM_OK;
14287 case OPT_SET:
14288 if (argc < 5) {
14289 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
14290 return JIM_ERR;
14292 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 4, argv[argc - 1], JIM_ERRMSG);
14294 case OPT_EXISTS:
14295 if (argc < 4) {
14296 Jim_WrongNumArgs(interp, 2, argv, "dictionary key ?key ...?");
14297 return JIM_ERR;
14299 else {
14300 int rc = Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr, JIM_ERRMSG);
14301 if (rc < 0) {
14302 return JIM_ERR;
14304 Jim_SetResultBool(interp, rc == JIM_OK);
14305 return JIM_OK;
14308 case OPT_UNSET:
14309 if (argc < 4) {
14310 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
14311 return JIM_ERR;
14313 if (Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 3, NULL, 0) != JIM_OK) {
14314 return JIM_ERR;
14316 return JIM_OK;
14318 case OPT_VALUES:
14319 types = JIM_DICTMATCH_VALUES;
14320 /* fallthru */
14321 case OPT_KEYS:
14322 if (argc != 3 && argc != 4) {
14323 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?pattern?");
14324 return JIM_ERR;
14326 return Jim_DictMatchTypes(interp, argv[2], argc == 4 ? argv[3] : NULL, types, types);
14328 case OPT_SIZE:
14329 if (argc != 3) {
14330 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14331 return JIM_ERR;
14333 else if (Jim_DictSize(interp, argv[2]) < 0) {
14334 return JIM_ERR;
14336 Jim_SetResultInt(interp, Jim_DictSize(interp, argv[2]));
14337 return JIM_OK;
14339 case OPT_MERGE:
14340 if (argc == 2) {
14341 return JIM_OK;
14343 objPtr = Jim_DictMerge(interp, argc - 2, argv + 2);
14344 if (objPtr == NULL) {
14345 return JIM_ERR;
14347 Jim_SetResult(interp, objPtr);
14348 return JIM_OK;
14350 case OPT_UPDATE:
14351 if (argc < 6 || argc % 2) {
14352 /* Better error message */
14353 argc = 2;
14355 break;
14357 case OPT_CREATE:
14358 if (argc % 2) {
14359 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
14360 return JIM_ERR;
14362 objPtr = Jim_NewDictObj(interp, argv + 2, argc - 2);
14363 Jim_SetResult(interp, objPtr);
14364 return JIM_OK;
14366 case OPT_INFO:
14367 if (argc != 3) {
14368 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14369 return JIM_ERR;
14371 return Jim_DictInfo(interp, argv[2]);
14373 case OPT_WITH:
14374 if (argc < 4) {
14375 Jim_WrongNumArgs(interp, 2, argv, "dictVar ?key ...? script");
14376 return JIM_ERR;
14378 return JimDictWith(interp, argv[2], argv + 3, argc - 4, argv[argc - 1]);
14380 /* Handle command as an ensemble */
14381 return Jim_EvalEnsemble(interp, "dict", options[option], argc - 2, argv + 2);
14384 /* [subst] */
14385 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14387 static const char * const options[] = {
14388 "-nobackslashes", "-nocommands", "-novariables", NULL
14390 enum
14391 { OPT_NOBACKSLASHES, OPT_NOCOMMANDS, OPT_NOVARIABLES };
14392 int i;
14393 int flags = JIM_SUBST_FLAG;
14394 Jim_Obj *objPtr;
14396 if (argc < 2) {
14397 Jim_WrongNumArgs(interp, 1, argv, "?options? string");
14398 return JIM_ERR;
14400 for (i = 1; i < (argc - 1); i++) {
14401 int option;
14403 if (Jim_GetEnum(interp, argv[i], options, &option, NULL,
14404 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14405 return JIM_ERR;
14407 switch (option) {
14408 case OPT_NOBACKSLASHES:
14409 flags |= JIM_SUBST_NOESC;
14410 break;
14411 case OPT_NOCOMMANDS:
14412 flags |= JIM_SUBST_NOCMD;
14413 break;
14414 case OPT_NOVARIABLES:
14415 flags |= JIM_SUBST_NOVAR;
14416 break;
14419 if (Jim_SubstObj(interp, argv[argc - 1], &objPtr, flags) != JIM_OK) {
14420 return JIM_ERR;
14422 Jim_SetResult(interp, objPtr);
14423 return JIM_OK;
14426 /* [info] */
14427 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14429 int cmd;
14430 Jim_Obj *objPtr;
14431 int mode = 0;
14433 static const char * const commands[] = {
14434 "body", "statics", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
14435 "vars", "version", "patchlevel", "complete", "args", "hostname",
14436 "script", "source", "stacktrace", "nameofexecutable", "returncodes",
14437 "references", "alias", NULL
14439 enum
14440 { INFO_BODY, INFO_STATICS, INFO_COMMANDS, INFO_PROCS, INFO_CHANNELS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
14441 INFO_FRAME, INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_PATCHLEVEL, INFO_COMPLETE, INFO_ARGS,
14442 INFO_HOSTNAME, INFO_SCRIPT, INFO_SOURCE, INFO_STACKTRACE, INFO_NAMEOFEXECUTABLE,
14443 INFO_RETURNCODES, INFO_REFERENCES, INFO_ALIAS,
14446 #ifdef jim_ext_namespace
14447 int nons = 0;
14449 if (argc > 2 && Jim_CompareStringImmediate(interp, argv[1], "-nons")) {
14450 /* This is for internal use only */
14451 argc--;
14452 argv++;
14453 nons = 1;
14455 #endif
14457 if (argc < 2) {
14458 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?args ...?");
14459 return JIM_ERR;
14461 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "subcommand", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14462 return Jim_CheckShowCommands(interp, argv[1], commands);
14465 /* Test for the most common commands first, just in case it makes a difference */
14466 switch (cmd) {
14467 case INFO_EXISTS:
14468 if (argc != 3) {
14469 Jim_WrongNumArgs(interp, 2, argv, "varName");
14470 return JIM_ERR;
14472 Jim_SetResultBool(interp, Jim_GetVariable(interp, argv[2], 0) != NULL);
14473 break;
14475 case INFO_ALIAS:{
14476 Jim_Cmd *cmdPtr;
14478 if (argc != 3) {
14479 Jim_WrongNumArgs(interp, 2, argv, "command");
14480 return JIM_ERR;
14482 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14483 return JIM_ERR;
14485 if (cmdPtr->isproc || cmdPtr->u.native.cmdProc != JimAliasCmd) {
14486 Jim_SetResultFormatted(interp, "command \"%#s\" is not an alias", argv[2]);
14487 return JIM_ERR;
14489 Jim_SetResult(interp, (Jim_Obj *)cmdPtr->u.native.privData);
14490 return JIM_OK;
14493 case INFO_CHANNELS:
14494 mode++; /* JIM_CMDLIST_CHANNELS */
14495 #ifndef jim_ext_aio
14496 Jim_SetResultString(interp, "aio not enabled", -1);
14497 return JIM_ERR;
14498 #endif
14499 /* fall through */
14500 case INFO_PROCS:
14501 mode++; /* JIM_CMDLIST_PROCS */
14502 /* fall through */
14503 case INFO_COMMANDS:
14504 /* mode 0 => JIM_CMDLIST_COMMANDS */
14505 if (argc != 2 && argc != 3) {
14506 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14507 return JIM_ERR;
14509 #ifdef jim_ext_namespace
14510 if (!nons) {
14511 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14512 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14515 #endif
14516 Jim_SetResult(interp, JimCommandsList(interp, (argc == 3) ? argv[2] : NULL, mode));
14517 break;
14519 case INFO_VARS:
14520 mode++; /* JIM_VARLIST_VARS */
14521 /* fall through */
14522 case INFO_LOCALS:
14523 mode++; /* JIM_VARLIST_LOCALS */
14524 /* fall through */
14525 case INFO_GLOBALS:
14526 /* mode 0 => JIM_VARLIST_GLOBALS */
14527 if (argc != 2 && argc != 3) {
14528 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14529 return JIM_ERR;
14531 #ifdef jim_ext_namespace
14532 if (!nons) {
14533 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14534 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14537 #endif
14538 Jim_SetResult(interp, JimVariablesList(interp, argc == 3 ? argv[2] : NULL, mode));
14539 break;
14541 case INFO_SCRIPT:
14542 if (argc != 2) {
14543 Jim_WrongNumArgs(interp, 2, argv, "");
14544 return JIM_ERR;
14546 Jim_SetResult(interp, JimGetScript(interp, interp->currentScriptObj)->fileNameObj);
14547 break;
14549 case INFO_SOURCE:{
14550 jim_wide line;
14551 Jim_Obj *resObjPtr;
14552 Jim_Obj *fileNameObj;
14554 if (argc != 3 && argc != 5) {
14555 Jim_WrongNumArgs(interp, 2, argv, "source ?filename line?");
14556 return JIM_ERR;
14558 if (argc == 5) {
14559 if (Jim_GetWide(interp, argv[4], &line) != JIM_OK) {
14560 return JIM_ERR;
14562 resObjPtr = Jim_NewStringObj(interp, Jim_String(argv[2]), Jim_Length(argv[2]));
14563 JimSetSourceInfo(interp, resObjPtr, argv[3], line);
14565 else {
14566 if (argv[2]->typePtr == &sourceObjType) {
14567 fileNameObj = argv[2]->internalRep.sourceValue.fileNameObj;
14568 line = argv[2]->internalRep.sourceValue.lineNumber;
14570 else if (argv[2]->typePtr == &scriptObjType) {
14571 ScriptObj *script = JimGetScript(interp, argv[2]);
14572 fileNameObj = script->fileNameObj;
14573 line = script->firstline;
14575 else {
14576 fileNameObj = interp->emptyObj;
14577 line = 1;
14579 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14580 Jim_ListAppendElement(interp, resObjPtr, fileNameObj);
14581 Jim_ListAppendElement(interp, resObjPtr, Jim_NewIntObj(interp, line));
14583 Jim_SetResult(interp, resObjPtr);
14584 break;
14587 case INFO_STACKTRACE:
14588 Jim_SetResult(interp, interp->stackTrace);
14589 break;
14591 case INFO_LEVEL:
14592 case INFO_FRAME:
14593 switch (argc) {
14594 case 2:
14595 Jim_SetResultInt(interp, interp->framePtr->level);
14596 break;
14598 case 3:
14599 if (JimInfoLevel(interp, argv[2], &objPtr, cmd == INFO_LEVEL) != JIM_OK) {
14600 return JIM_ERR;
14602 Jim_SetResult(interp, objPtr);
14603 break;
14605 default:
14606 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
14607 return JIM_ERR;
14609 break;
14611 case INFO_BODY:
14612 case INFO_STATICS:
14613 case INFO_ARGS:{
14614 Jim_Cmd *cmdPtr;
14616 if (argc != 3) {
14617 Jim_WrongNumArgs(interp, 2, argv, "procname");
14618 return JIM_ERR;
14620 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14621 return JIM_ERR;
14623 if (!cmdPtr->isproc) {
14624 Jim_SetResultFormatted(interp, "command \"%#s\" is not a procedure", argv[2]);
14625 return JIM_ERR;
14627 switch (cmd) {
14628 case INFO_BODY:
14629 Jim_SetResult(interp, cmdPtr->u.proc.bodyObjPtr);
14630 break;
14631 case INFO_ARGS:
14632 Jim_SetResult(interp, cmdPtr->u.proc.argListObjPtr);
14633 break;
14634 case INFO_STATICS:
14635 if (cmdPtr->u.proc.staticVars) {
14636 Jim_SetResult(interp, JimHashtablePatternMatch(interp, cmdPtr->u.proc.staticVars,
14637 NULL, JimVariablesMatch, JIM_VARLIST_LOCALS | JIM_VARLIST_VALUES));
14639 break;
14641 break;
14644 case INFO_VERSION:
14645 case INFO_PATCHLEVEL:{
14646 char buf[(JIM_INTEGER_SPACE * 2) + 1];
14648 sprintf(buf, "%d.%d", JIM_VERSION / 100, JIM_VERSION % 100);
14649 Jim_SetResultString(interp, buf, -1);
14650 break;
14653 case INFO_COMPLETE:
14654 if (argc != 3 && argc != 4) {
14655 Jim_WrongNumArgs(interp, 2, argv, "script ?missing?");
14656 return JIM_ERR;
14658 else {
14659 char missing;
14661 Jim_SetResultBool(interp, Jim_ScriptIsComplete(interp, argv[2], &missing));
14662 if (missing != ' ' && argc == 4) {
14663 Jim_SetVariable(interp, argv[3], Jim_NewStringObj(interp, &missing, 1));
14666 break;
14668 case INFO_HOSTNAME:
14669 /* Redirect to os.gethostname if it exists */
14670 return Jim_Eval(interp, "os.gethostname");
14672 case INFO_NAMEOFEXECUTABLE:
14673 /* Redirect to Tcl proc */
14674 return Jim_Eval(interp, "{info nameofexecutable}");
14676 case INFO_RETURNCODES:
14677 if (argc == 2) {
14678 int i;
14679 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14681 for (i = 0; jimReturnCodes[i]; i++) {
14682 Jim_ListAppendElement(interp, listObjPtr, Jim_NewIntObj(interp, i));
14683 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp,
14684 jimReturnCodes[i], -1));
14687 Jim_SetResult(interp, listObjPtr);
14689 else if (argc == 3) {
14690 long code;
14691 const char *name;
14693 if (Jim_GetLong(interp, argv[2], &code) != JIM_OK) {
14694 return JIM_ERR;
14696 name = Jim_ReturnCode(code);
14697 if (*name == '?') {
14698 Jim_SetResultInt(interp, code);
14700 else {
14701 Jim_SetResultString(interp, name, -1);
14704 else {
14705 Jim_WrongNumArgs(interp, 2, argv, "?code?");
14706 return JIM_ERR;
14708 break;
14709 case INFO_REFERENCES:
14710 #ifdef JIM_REFERENCES
14711 return JimInfoReferences(interp, argc, argv);
14712 #else
14713 Jim_SetResultString(interp, "not supported", -1);
14714 return JIM_ERR;
14715 #endif
14717 return JIM_OK;
14720 /* [exists] */
14721 static int Jim_ExistsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14723 Jim_Obj *objPtr;
14724 int result = 0;
14726 static const char * const options[] = {
14727 "-command", "-proc", "-alias", "-var", NULL
14729 enum
14731 OPT_COMMAND, OPT_PROC, OPT_ALIAS, OPT_VAR
14733 int option;
14735 if (argc == 2) {
14736 option = OPT_VAR;
14737 objPtr = argv[1];
14739 else if (argc == 3) {
14740 if (Jim_GetEnum(interp, argv[1], options, &option, NULL, JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14741 return JIM_ERR;
14743 objPtr = argv[2];
14745 else {
14746 Jim_WrongNumArgs(interp, 1, argv, "?option? name");
14747 return JIM_ERR;
14750 if (option == OPT_VAR) {
14751 result = Jim_GetVariable(interp, objPtr, 0) != NULL;
14753 else {
14754 /* Now different kinds of commands */
14755 Jim_Cmd *cmd = Jim_GetCommand(interp, objPtr, JIM_NONE);
14757 if (cmd) {
14758 switch (option) {
14759 case OPT_COMMAND:
14760 result = 1;
14761 break;
14763 case OPT_ALIAS:
14764 result = cmd->isproc == 0 && cmd->u.native.cmdProc == JimAliasCmd;
14765 break;
14767 case OPT_PROC:
14768 result = cmd->isproc;
14769 break;
14773 Jim_SetResultBool(interp, result);
14774 return JIM_OK;
14777 /* [split] */
14778 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14780 const char *str, *splitChars, *noMatchStart;
14781 int splitLen, strLen;
14782 Jim_Obj *resObjPtr;
14783 int c;
14784 int len;
14786 if (argc != 2 && argc != 3) {
14787 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
14788 return JIM_ERR;
14791 str = Jim_GetString(argv[1], &len);
14792 if (len == 0) {
14793 return JIM_OK;
14795 strLen = Jim_Utf8Length(interp, argv[1]);
14797 /* Init */
14798 if (argc == 2) {
14799 splitChars = " \n\t\r";
14800 splitLen = 4;
14802 else {
14803 splitChars = Jim_String(argv[2]);
14804 splitLen = Jim_Utf8Length(interp, argv[2]);
14807 noMatchStart = str;
14808 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14810 /* Split */
14811 if (splitLen) {
14812 Jim_Obj *objPtr;
14813 while (strLen--) {
14814 const char *sc = splitChars;
14815 int scLen = splitLen;
14816 int sl = utf8_tounicode(str, &c);
14817 while (scLen--) {
14818 int pc;
14819 sc += utf8_tounicode(sc, &pc);
14820 if (c == pc) {
14821 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14822 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14823 noMatchStart = str + sl;
14824 break;
14827 str += sl;
14829 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14830 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14832 else {
14833 /* This handles the special case of splitchars eq {}
14834 * Optimise by sharing common (ASCII) characters
14836 Jim_Obj **commonObj = NULL;
14837 #define NUM_COMMON (128 - 9)
14838 while (strLen--) {
14839 int n = utf8_tounicode(str, &c);
14840 #ifdef JIM_OPTIMIZATION
14841 if (c >= 9 && c < 128) {
14842 /* Common ASCII char. Note that 9 is the tab character */
14843 c -= 9;
14844 if (!commonObj) {
14845 commonObj = Jim_Alloc(sizeof(*commonObj) * NUM_COMMON);
14846 memset(commonObj, 0, sizeof(*commonObj) * NUM_COMMON);
14848 if (!commonObj[c]) {
14849 commonObj[c] = Jim_NewStringObj(interp, str, 1);
14851 Jim_ListAppendElement(interp, resObjPtr, commonObj[c]);
14852 str++;
14853 continue;
14855 #endif
14856 Jim_ListAppendElement(interp, resObjPtr, Jim_NewStringObjUtf8(interp, str, 1));
14857 str += n;
14859 Jim_Free(commonObj);
14862 Jim_SetResult(interp, resObjPtr);
14863 return JIM_OK;
14866 /* [join] */
14867 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14869 const char *joinStr;
14870 int joinStrLen;
14872 if (argc != 2 && argc != 3) {
14873 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
14874 return JIM_ERR;
14876 /* Init */
14877 if (argc == 2) {
14878 joinStr = " ";
14879 joinStrLen = 1;
14881 else {
14882 joinStr = Jim_GetString(argv[2], &joinStrLen);
14884 Jim_SetResult(interp, Jim_ListJoin(interp, argv[1], joinStr, joinStrLen));
14885 return JIM_OK;
14888 /* [format] */
14889 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14891 Jim_Obj *objPtr;
14893 if (argc < 2) {
14894 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
14895 return JIM_ERR;
14897 objPtr = Jim_FormatString(interp, argv[1], argc - 2, argv + 2);
14898 if (objPtr == NULL)
14899 return JIM_ERR;
14900 Jim_SetResult(interp, objPtr);
14901 return JIM_OK;
14904 /* [scan] */
14905 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14907 Jim_Obj *listPtr, **outVec;
14908 int outc, i;
14910 if (argc < 3) {
14911 Jim_WrongNumArgs(interp, 1, argv, "string format ?varName varName ...?");
14912 return JIM_ERR;
14914 if (argv[2]->typePtr != &scanFmtStringObjType)
14915 SetScanFmtFromAny(interp, argv[2]);
14916 if (FormatGetError(argv[2]) != 0) {
14917 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
14918 return JIM_ERR;
14920 if (argc > 3) {
14921 int maxPos = FormatGetMaxPos(argv[2]);
14922 int count = FormatGetCnvCount(argv[2]);
14924 if (maxPos > argc - 3) {
14925 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
14926 return JIM_ERR;
14928 else if (count > argc - 3) {
14929 Jim_SetResultString(interp, "different numbers of variable names and "
14930 "field specifiers", -1);
14931 return JIM_ERR;
14933 else if (count < argc - 3) {
14934 Jim_SetResultString(interp, "variable is not assigned by any "
14935 "conversion specifiers", -1);
14936 return JIM_ERR;
14939 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
14940 if (listPtr == 0)
14941 return JIM_ERR;
14942 if (argc > 3) {
14943 int rc = JIM_OK;
14944 int count = 0;
14946 if (listPtr != 0 && listPtr != (Jim_Obj *)EOF) {
14947 int len = Jim_ListLength(interp, listPtr);
14949 if (len != 0) {
14950 JimListGetElements(interp, listPtr, &outc, &outVec);
14951 for (i = 0; i < outc; ++i) {
14952 if (Jim_Length(outVec[i]) > 0) {
14953 ++count;
14954 if (Jim_SetVariable(interp, argv[3 + i], outVec[i]) != JIM_OK) {
14955 rc = JIM_ERR;
14960 Jim_FreeNewObj(interp, listPtr);
14962 else {
14963 count = -1;
14965 if (rc == JIM_OK) {
14966 Jim_SetResultInt(interp, count);
14968 return rc;
14970 else {
14971 if (listPtr == (Jim_Obj *)EOF) {
14972 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
14973 return JIM_OK;
14975 Jim_SetResult(interp, listPtr);
14977 return JIM_OK;
14980 /* [error] */
14981 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14983 if (argc != 2 && argc != 3) {
14984 Jim_WrongNumArgs(interp, 1, argv, "message ?stacktrace?");
14985 return JIM_ERR;
14987 Jim_SetResult(interp, argv[1]);
14988 if (argc == 3) {
14989 JimSetStackTrace(interp, argv[2]);
14990 return JIM_ERR;
14992 interp->addStackTrace++;
14993 return JIM_ERR;
14996 /* [lrange] */
14997 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14999 Jim_Obj *objPtr;
15001 if (argc != 4) {
15002 Jim_WrongNumArgs(interp, 1, argv, "list first last");
15003 return JIM_ERR;
15005 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
15006 return JIM_ERR;
15007 Jim_SetResult(interp, objPtr);
15008 return JIM_OK;
15011 /* [lrepeat] */
15012 static int Jim_LrepeatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15014 Jim_Obj *objPtr;
15015 long count;
15017 if (argc < 2 || Jim_GetLong(interp, argv[1], &count) != JIM_OK || count < 0) {
15018 Jim_WrongNumArgs(interp, 1, argv, "count ?value ...?");
15019 return JIM_ERR;
15022 if (count == 0 || argc == 2) {
15023 return JIM_OK;
15026 argc -= 2;
15027 argv += 2;
15029 objPtr = Jim_NewListObj(interp, argv, argc);
15030 while (--count) {
15031 ListInsertElements(objPtr, -1, argc, argv);
15034 Jim_SetResult(interp, objPtr);
15035 return JIM_OK;
15038 char **Jim_GetEnviron(void)
15040 #if defined(HAVE__NSGETENVIRON)
15041 return *_NSGetEnviron();
15042 #else
15043 #if !defined(NO_ENVIRON_EXTERN)
15044 extern char **environ;
15045 #endif
15047 return environ;
15048 #endif
15051 void Jim_SetEnviron(char **env)
15053 #if defined(HAVE__NSGETENVIRON)
15054 *_NSGetEnviron() = env;
15055 #else
15056 #if !defined(NO_ENVIRON_EXTERN)
15057 extern char **environ;
15058 #endif
15060 environ = env;
15061 #endif
15064 /* [env] */
15065 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15067 const char *key;
15068 const char *val;
15070 if (argc == 1) {
15071 char **e = Jim_GetEnviron();
15073 int i;
15074 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
15076 for (i = 0; e[i]; i++) {
15077 const char *equals = strchr(e[i], '=');
15079 if (equals) {
15080 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, e[i],
15081 equals - e[i]));
15082 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
15086 Jim_SetResult(interp, listObjPtr);
15087 return JIM_OK;
15090 if (argc < 2) {
15091 Jim_WrongNumArgs(interp, 1, argv, "varName ?default?");
15092 return JIM_ERR;
15094 key = Jim_String(argv[1]);
15095 val = getenv(key);
15096 if (val == NULL) {
15097 if (argc < 3) {
15098 Jim_SetResultFormatted(interp, "environment variable \"%#s\" does not exist", argv[1]);
15099 return JIM_ERR;
15101 val = Jim_String(argv[2]);
15103 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
15104 return JIM_OK;
15107 /* [source] */
15108 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15110 int retval;
15112 if (argc != 2) {
15113 Jim_WrongNumArgs(interp, 1, argv, "fileName");
15114 return JIM_ERR;
15116 retval = Jim_EvalFile(interp, Jim_String(argv[1]));
15117 if (retval == JIM_RETURN)
15118 return JIM_OK;
15119 return retval;
15122 /* [lreverse] */
15123 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15125 Jim_Obj *revObjPtr, **ele;
15126 int len;
15128 if (argc != 2) {
15129 Jim_WrongNumArgs(interp, 1, argv, "list");
15130 return JIM_ERR;
15132 JimListGetElements(interp, argv[1], &len, &ele);
15133 len--;
15134 revObjPtr = Jim_NewListObj(interp, NULL, 0);
15135 while (len >= 0)
15136 ListAppendElement(revObjPtr, ele[len--]);
15137 Jim_SetResult(interp, revObjPtr);
15138 return JIM_OK;
15141 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
15143 jim_wide len;
15145 if (step == 0)
15146 return -1;
15147 if (start == end)
15148 return 0;
15149 else if (step > 0 && start > end)
15150 return -1;
15151 else if (step < 0 && end > start)
15152 return -1;
15153 len = end - start;
15154 if (len < 0)
15155 len = -len; /* abs(len) */
15156 if (step < 0)
15157 step = -step; /* abs(step) */
15158 len = 1 + ((len - 1) / step);
15159 /* We can truncate safely to INT_MAX, the range command
15160 * will always return an error for a such long range
15161 * because Tcl lists can't be so long. */
15162 if (len > INT_MAX)
15163 len = INT_MAX;
15164 return (int)((len < 0) ? -1 : len);
15167 /* [range] */
15168 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15170 jim_wide start = 0, end, step = 1;
15171 int len, i;
15172 Jim_Obj *objPtr;
15174 if (argc < 2 || argc > 4) {
15175 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
15176 return JIM_ERR;
15178 if (argc == 2) {
15179 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
15180 return JIM_ERR;
15182 else {
15183 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
15184 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
15185 return JIM_ERR;
15186 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
15187 return JIM_ERR;
15189 if ((len = JimRangeLen(start, end, step)) == -1) {
15190 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
15191 return JIM_ERR;
15193 objPtr = Jim_NewListObj(interp, NULL, 0);
15194 for (i = 0; i < len; i++)
15195 ListAppendElement(objPtr, Jim_NewIntObj(interp, start + i * step));
15196 Jim_SetResult(interp, objPtr);
15197 return JIM_OK;
15200 /* [rand] */
15201 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15203 jim_wide min = 0, max = 0, len, maxMul;
15205 if (argc < 1 || argc > 3) {
15206 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
15207 return JIM_ERR;
15209 if (argc == 1) {
15210 max = JIM_WIDE_MAX;
15211 } else if (argc == 2) {
15212 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
15213 return JIM_ERR;
15214 } else if (argc == 3) {
15215 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
15216 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
15217 return JIM_ERR;
15219 len = max-min;
15220 if (len < 0) {
15221 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
15222 return JIM_ERR;
15224 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
15225 while (1) {
15226 jim_wide r;
15228 JimRandomBytes(interp, &r, sizeof(jim_wide));
15229 if (r < 0 || r >= maxMul) continue;
15230 r = (len == 0) ? 0 : r%len;
15231 Jim_SetResultInt(interp, min+r);
15232 return JIM_OK;
15236 static const struct {
15237 const char *name;
15238 Jim_CmdProc *cmdProc;
15239 } Jim_CoreCommandsTable[] = {
15240 {"alias", Jim_AliasCoreCommand},
15241 {"set", Jim_SetCoreCommand},
15242 {"unset", Jim_UnsetCoreCommand},
15243 {"puts", Jim_PutsCoreCommand},
15244 {"+", Jim_AddCoreCommand},
15245 {"*", Jim_MulCoreCommand},
15246 {"-", Jim_SubCoreCommand},
15247 {"/", Jim_DivCoreCommand},
15248 {"incr", Jim_IncrCoreCommand},
15249 {"while", Jim_WhileCoreCommand},
15250 {"loop", Jim_LoopCoreCommand},
15251 {"for", Jim_ForCoreCommand},
15252 {"foreach", Jim_ForeachCoreCommand},
15253 {"lmap", Jim_LmapCoreCommand},
15254 {"lassign", Jim_LassignCoreCommand},
15255 {"if", Jim_IfCoreCommand},
15256 {"switch", Jim_SwitchCoreCommand},
15257 {"list", Jim_ListCoreCommand},
15258 {"lindex", Jim_LindexCoreCommand},
15259 {"lset", Jim_LsetCoreCommand},
15260 {"lsearch", Jim_LsearchCoreCommand},
15261 {"llength", Jim_LlengthCoreCommand},
15262 {"lappend", Jim_LappendCoreCommand},
15263 {"linsert", Jim_LinsertCoreCommand},
15264 {"lreplace", Jim_LreplaceCoreCommand},
15265 {"lsort", Jim_LsortCoreCommand},
15266 {"append", Jim_AppendCoreCommand},
15267 {"debug", Jim_DebugCoreCommand},
15268 {"eval", Jim_EvalCoreCommand},
15269 {"uplevel", Jim_UplevelCoreCommand},
15270 {"expr", Jim_ExprCoreCommand},
15271 {"break", Jim_BreakCoreCommand},
15272 {"continue", Jim_ContinueCoreCommand},
15273 {"proc", Jim_ProcCoreCommand},
15274 {"concat", Jim_ConcatCoreCommand},
15275 {"return", Jim_ReturnCoreCommand},
15276 {"upvar", Jim_UpvarCoreCommand},
15277 {"global", Jim_GlobalCoreCommand},
15278 {"string", Jim_StringCoreCommand},
15279 {"time", Jim_TimeCoreCommand},
15280 {"exit", Jim_ExitCoreCommand},
15281 {"catch", Jim_CatchCoreCommand},
15282 #ifdef JIM_REFERENCES
15283 {"ref", Jim_RefCoreCommand},
15284 {"getref", Jim_GetrefCoreCommand},
15285 {"setref", Jim_SetrefCoreCommand},
15286 {"finalize", Jim_FinalizeCoreCommand},
15287 {"collect", Jim_CollectCoreCommand},
15288 #endif
15289 {"rename", Jim_RenameCoreCommand},
15290 {"dict", Jim_DictCoreCommand},
15291 {"subst", Jim_SubstCoreCommand},
15292 {"info", Jim_InfoCoreCommand},
15293 {"exists", Jim_ExistsCoreCommand},
15294 {"split", Jim_SplitCoreCommand},
15295 {"join", Jim_JoinCoreCommand},
15296 {"format", Jim_FormatCoreCommand},
15297 {"scan", Jim_ScanCoreCommand},
15298 {"error", Jim_ErrorCoreCommand},
15299 {"lrange", Jim_LrangeCoreCommand},
15300 {"lrepeat", Jim_LrepeatCoreCommand},
15301 {"env", Jim_EnvCoreCommand},
15302 {"source", Jim_SourceCoreCommand},
15303 {"lreverse", Jim_LreverseCoreCommand},
15304 {"range", Jim_RangeCoreCommand},
15305 {"rand", Jim_RandCoreCommand},
15306 {"tailcall", Jim_TailcallCoreCommand},
15307 {"local", Jim_LocalCoreCommand},
15308 {"upcall", Jim_UpcallCoreCommand},
15309 {"apply", Jim_ApplyCoreCommand},
15310 {NULL, NULL},
15313 void Jim_RegisterCoreCommands(Jim_Interp *interp)
15315 int i = 0;
15317 while (Jim_CoreCommandsTable[i].name != NULL) {
15318 Jim_CreateCommand(interp,
15319 Jim_CoreCommandsTable[i].name, Jim_CoreCommandsTable[i].cmdProc, NULL, NULL);
15320 i++;
15324 /* -----------------------------------------------------------------------------
15325 * Interactive prompt
15326 * ---------------------------------------------------------------------------*/
15327 void Jim_MakeErrorMessage(Jim_Interp *interp)
15329 Jim_Obj *argv[2];
15331 argv[0] = Jim_NewStringObj(interp, "errorInfo", -1);
15332 argv[1] = interp->result;
15334 Jim_EvalObjVector(interp, 2, argv);
15338 * Given a null terminated array of strings, returns an allocated, sorted
15339 * copy of the array.
15341 static char **JimSortStringTable(const char *const *tablePtr)
15343 int count;
15344 char **tablePtrSorted;
15346 /* Find the size of the table */
15347 for (count = 0; tablePtr[count]; count++) {
15350 /* Allocate one extra for the terminating NULL pointer */
15351 tablePtrSorted = Jim_Alloc(sizeof(char *) * (count + 1));
15352 memcpy(tablePtrSorted, tablePtr, sizeof(char *) * count);
15353 qsort(tablePtrSorted, count, sizeof(char *), qsortCompareStringPointers);
15354 tablePtrSorted[count] = NULL;
15356 return tablePtrSorted;
15359 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
15360 const char *prefix, const char *const *tablePtr, const char *name)
15362 char **tablePtrSorted;
15363 int i;
15365 if (name == NULL) {
15366 name = "option";
15369 Jim_SetResultFormatted(interp, "%s%s \"%s\": must be ", badtype, name, arg);
15370 tablePtrSorted = JimSortStringTable(tablePtr);
15371 for (i = 0; tablePtrSorted[i]; i++) {
15372 if (tablePtrSorted[i + 1] == NULL && i > 0) {
15373 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
15375 Jim_AppendStrings(interp, Jim_GetResult(interp), prefix, tablePtrSorted[i], NULL);
15376 if (tablePtrSorted[i + 1]) {
15377 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
15380 Jim_Free(tablePtrSorted);
15385 * If objPtr is "-commands" sets the Jim result as a sorted list of options in the table
15386 * and returns JIM_OK.
15388 * Otherwise returns JIM_ERR.
15390 int Jim_CheckShowCommands(Jim_Interp *interp, Jim_Obj *objPtr, const char *const *tablePtr)
15392 if (Jim_CompareStringImmediate(interp, objPtr, "-commands")) {
15393 int i;
15394 char **tablePtrSorted = JimSortStringTable(tablePtr);
15395 Jim_SetResult(interp, Jim_NewListObj(interp, NULL, 0));
15396 for (i = 0; tablePtrSorted[i]; i++) {
15397 Jim_ListAppendElement(interp, Jim_GetResult(interp), Jim_NewStringObj(interp, tablePtrSorted[i], -1));
15399 Jim_Free(tablePtrSorted);
15400 return JIM_OK;
15402 return JIM_ERR;
15405 /* internal rep is stored in ptrIntvalue
15406 * ptr = tablePtr
15407 * int1 = flags
15408 * int2 = index
15410 static const Jim_ObjType getEnumObjType = {
15411 "get-enum",
15412 NULL,
15413 NULL,
15414 NULL,
15415 JIM_TYPE_REFERENCES
15418 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
15419 const char *const *tablePtr, int *indexPtr, const char *name, int flags)
15421 const char *bad = "bad ";
15422 const char *const *entryPtr = NULL;
15423 int i;
15424 int match = -1;
15425 int arglen;
15426 const char *arg;
15428 if (objPtr->typePtr == &getEnumObjType) {
15429 if (objPtr->internalRep.ptrIntValue.ptr == tablePtr && objPtr->internalRep.ptrIntValue.int1 == flags) {
15430 *indexPtr = objPtr->internalRep.ptrIntValue.int2;
15431 return JIM_OK;
15435 arg = Jim_GetString(objPtr, &arglen);
15437 *indexPtr = -1;
15439 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
15440 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
15441 /* Found an exact match */
15442 match = i;
15443 goto found;
15445 if (flags & JIM_ENUM_ABBREV) {
15446 /* Accept an unambiguous abbreviation.
15447 * Note that '-' doesnt' consitute a valid abbreviation
15449 if (strncmp(arg, *entryPtr, arglen) == 0) {
15450 if (*arg == '-' && arglen == 1) {
15451 break;
15453 if (match >= 0) {
15454 bad = "ambiguous ";
15455 goto ambiguous;
15457 match = i;
15462 /* If we had an unambiguous partial match */
15463 if (match >= 0) {
15464 found:
15465 /* Record the match in the object */
15466 Jim_FreeIntRep(interp, objPtr);
15467 objPtr->typePtr = &getEnumObjType;
15468 objPtr->internalRep.ptrIntValue.ptr = (void *)tablePtr;
15469 objPtr->internalRep.ptrIntValue.int1 = flags;
15470 objPtr->internalRep.ptrIntValue.int2 = match;
15471 /* Return the result */
15472 *indexPtr = match;
15473 return JIM_OK;
15476 ambiguous:
15477 if (flags & JIM_ERRMSG) {
15478 JimSetFailedEnumResult(interp, arg, bad, "", tablePtr, name);
15480 return JIM_ERR;
15483 int Jim_FindByName(const char *name, const char * const array[], size_t len)
15485 int i;
15487 for (i = 0; i < (int)len; i++) {
15488 if (array[i] && strcmp(array[i], name) == 0) {
15489 return i;
15492 return -1;
15495 int Jim_IsDict(Jim_Obj *objPtr)
15497 return objPtr->typePtr == &dictObjType;
15500 int Jim_IsList(Jim_Obj *objPtr)
15502 return objPtr->typePtr == &listObjType;
15506 * Very simple printf-like formatting, designed for error messages.
15508 * The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
15509 * The resulting string is created and set as the result.
15511 * Each '%s' should correspond to a regular string parameter.
15512 * Each '%#s' should correspond to a (Jim_Obj *) parameter.
15513 * Any other printf specifier is not allowed (but %% is allowed for the % character).
15515 * e.g. Jim_SetResultFormatted(interp, "Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
15517 * Note: We take advantage of the fact that printf has the same behaviour for both %s and %#s
15519 * Note that any Jim_Obj parameters with zero ref count will be freed as a result of this call.
15521 void Jim_SetResultFormatted(Jim_Interp *interp, const char *format, ...)
15523 /* Initial space needed */
15524 int len = strlen(format);
15525 int extra = 0;
15526 int n = 0;
15527 const char *params[5];
15528 int nobjparam = 0;
15529 Jim_Obj *objparam[5];
15530 char *buf;
15531 va_list args;
15532 int i;
15534 va_start(args, format);
15536 for (i = 0; i < len && n < 5; i++) {
15537 int l;
15539 if (strncmp(format + i, "%s", 2) == 0) {
15540 params[n] = va_arg(args, char *);
15542 l = strlen(params[n]);
15544 else if (strncmp(format + i, "%#s", 3) == 0) {
15545 Jim_Obj *objPtr = va_arg(args, Jim_Obj *);
15547 params[n] = Jim_GetString(objPtr, &l);
15548 objparam[nobjparam++] = objPtr;
15549 Jim_IncrRefCount(objPtr);
15551 else {
15552 if (format[i] == '%') {
15553 i++;
15555 continue;
15557 n++;
15558 extra += l;
15561 len += extra;
15562 buf = Jim_Alloc(len + 1);
15563 len = snprintf(buf, len + 1, format, params[0], params[1], params[2], params[3], params[4]);
15565 va_end(args);
15567 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
15569 for (i = 0; i < nobjparam; i++) {
15570 Jim_DecrRefCount(interp, objparam[i]);
15574 /* stubs */
15575 #ifndef jim_ext_package
15576 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver, int flags)
15578 return JIM_OK;
15580 #endif
15581 #ifndef jim_ext_aio
15582 FILE *Jim_AioFilehandle(Jim_Interp *interp, Jim_Obj *fhObj)
15584 Jim_SetResultString(interp, "aio not enabled", -1);
15585 return NULL;
15587 #endif
15591 * Local Variables: ***
15592 * c-basic-offset: 4 ***
15593 * tab-width: 4 ***
15594 * End: ***